zunmqr_2.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 * zunmqr_2 is the test program for the C interface to LAPACK
00036 * routine zunmqr
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_zunmqr( char *side, char *trans, lapack_int *m,
00055                                  lapack_int *n, lapack_int *k, lapack_int *lda,
00056                                  lapack_int *ldc, lapack_int *lwork );
00057 static void init_a( lapack_int size, lapack_complex_double *a );
00058 static void init_tau( lapack_int size, lapack_complex_double *tau );
00059 static void init_c( lapack_int size, lapack_complex_double *c );
00060 static void init_work( lapack_int size, lapack_complex_double *work );
00061 static int compare_zunmqr( lapack_complex_double *c, lapack_complex_double *c_i,
00062                            lapack_int info, lapack_int info_i, lapack_int ldc,
00063                            lapack_int n );
00064 
00065 int main(void)
00066 {
00067     /* Local scalars */
00068     char side, side_i;
00069     char trans, trans_i;
00070     lapack_int m, m_i;
00071     lapack_int n, n_i;
00072     lapack_int k, k_i;
00073     lapack_int lda, lda_i;
00074     lapack_int lda_r;
00075     lapack_int ldc, ldc_i;
00076     lapack_int ldc_r;
00077     lapack_int lwork, lwork_i;
00078     lapack_int info, info_i;
00079     /* Declare scalars */
00080     lapack_int r;
00081     lapack_int i;
00082     int failed;
00083 
00084     /* Local arrays */
00085     lapack_complex_double *a = NULL, *a_i = NULL;
00086     lapack_complex_double *tau = NULL, *tau_i = NULL;
00087     lapack_complex_double *c = NULL, *c_i = NULL;
00088     lapack_complex_double *work = NULL, *work_i = NULL;
00089     lapack_complex_double *c_save = NULL;
00090     lapack_complex_double *a_r = NULL;
00091     lapack_complex_double *c_r = NULL;
00092 
00093     /* Iniitialize the scalar parameters */
00094     init_scalars_zunmqr( &side, &trans, &m, &n, &k, &lda, &ldc, &lwork );
00095     r = LAPACKE_lsame( side, 'l' ) ? m : n;
00096     lda_r = k+2;
00097     ldc_r = n+2;
00098     side_i = side;
00099     trans_i = trans;
00100     m_i = m;
00101     n_i = n;
00102     k_i = k;
00103     lda_i = lda;
00104     ldc_i = ldc;
00105     lwork_i = lwork;
00106 
00107     /* Allocate memory for the LAPACK routine arrays */
00108     a = (lapack_complex_double *)
00109         LAPACKE_malloc( lda*k * sizeof(lapack_complex_double) );
00110     tau = (lapack_complex_double *)
00111         LAPACKE_malloc( k * sizeof(lapack_complex_double) );
00112     c = (lapack_complex_double *)
00113         LAPACKE_malloc( ldc*n * sizeof(lapack_complex_double) );
00114     work = (lapack_complex_double *)
00115         LAPACKE_malloc( lwork * sizeof(lapack_complex_double) );
00116 
00117     /* Allocate memory for the C interface function arrays */
00118     a_i = (lapack_complex_double *)
00119         LAPACKE_malloc( lda*k * sizeof(lapack_complex_double) );
00120     tau_i = (lapack_complex_double *)
00121         LAPACKE_malloc( k * sizeof(lapack_complex_double) );
00122     c_i = (lapack_complex_double *)
00123         LAPACKE_malloc( ldc*n * sizeof(lapack_complex_double) );
00124     work_i = (lapack_complex_double *)
00125         LAPACKE_malloc( lwork * sizeof(lapack_complex_double) );
00126 
00127     /* Allocate memory for the backup arrays */
00128     c_save = (lapack_complex_double *)
00129         LAPACKE_malloc( ldc*n * sizeof(lapack_complex_double) );
00130 
00131     /* Allocate memory for the row-major arrays */
00132     a_r = (lapack_complex_double *)
00133         LAPACKE_malloc( r*(k+2) * sizeof(lapack_complex_double) );
00134     c_r = (lapack_complex_double *)
00135         LAPACKE_malloc( m*(n+2) * sizeof(lapack_complex_double) );
00136 
00137     /* Initialize input arrays */
00138     init_a( lda*k, a );
00139     init_tau( k, tau );
00140     init_c( ldc*n, c );
00141     init_work( lwork, work );
00142 
00143     /* Backup the ouptut arrays */
00144     for( i = 0; i < ldc*n; i++ ) {
00145         c_save[i] = c[i];
00146     }
00147 
00148     /* Call the LAPACK routine */
00149     zunmqr_( &side, &trans, &m, &n, &k, a, &lda, tau, c, &ldc, work, &lwork,
00150              &info );
00151 
00152     /* Initialize input data, call the column-major middle-level
00153      * interface to LAPACK routine and check the results */
00154     for( i = 0; i < lda*k; i++ ) {
00155         a_i[i] = a[i];
00156     }
00157     for( i = 0; i < k; i++ ) {
00158         tau_i[i] = tau[i];
00159     }
00160     for( i = 0; i < ldc*n; i++ ) {
00161         c_i[i] = c_save[i];
00162     }
00163     for( i = 0; i < lwork; i++ ) {
00164         work_i[i] = work[i];
00165     }
00166     info_i = LAPACKE_zunmqr_work( LAPACK_COL_MAJOR, side_i, trans_i, m_i, n_i,
00167                                   k_i, a_i, lda_i, tau_i, c_i, ldc_i, work_i,
00168                                   lwork_i );
00169 
00170     failed = compare_zunmqr( c, c_i, info, info_i, ldc, n );
00171     if( failed == 0 ) {
00172         printf( "PASSED: column-major middle-level interface to zunmqr\n" );
00173     } else {
00174         printf( "FAILED: column-major middle-level interface to zunmqr\n" );
00175     }
00176 
00177     /* Initialize input data, call the column-major high-level
00178      * interface to LAPACK routine and check the results */
00179     for( i = 0; i < lda*k; i++ ) {
00180         a_i[i] = a[i];
00181     }
00182     for( i = 0; i < k; i++ ) {
00183         tau_i[i] = tau[i];
00184     }
00185     for( i = 0; i < ldc*n; i++ ) {
00186         c_i[i] = c_save[i];
00187     }
00188     for( i = 0; i < lwork; i++ ) {
00189         work_i[i] = work[i];
00190     }
00191     info_i = LAPACKE_zunmqr( LAPACK_COL_MAJOR, side_i, trans_i, m_i, n_i, k_i,
00192                              a_i, lda_i, tau_i, c_i, ldc_i );
00193 
00194     failed = compare_zunmqr( c, c_i, info, info_i, ldc, n );
00195     if( failed == 0 ) {
00196         printf( "PASSED: column-major high-level interface to zunmqr\n" );
00197     } else {
00198         printf( "FAILED: column-major high-level interface to zunmqr\n" );
00199     }
00200 
00201     /* Initialize input data, call the row-major middle-level
00202      * interface to LAPACK routine and check the results */
00203     for( i = 0; i < lda*k; i++ ) {
00204         a_i[i] = a[i];
00205     }
00206     for( i = 0; i < k; i++ ) {
00207         tau_i[i] = tau[i];
00208     }
00209     for( i = 0; i < ldc*n; i++ ) {
00210         c_i[i] = c_save[i];
00211     }
00212     for( i = 0; i < lwork; i++ ) {
00213         work_i[i] = work[i];
00214     }
00215 
00216     LAPACKE_zge_trans( LAPACK_COL_MAJOR, r, k, a_i, lda, a_r, k+2 );
00217     LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, c_i, ldc, c_r, n+2 );
00218     info_i = LAPACKE_zunmqr_work( LAPACK_ROW_MAJOR, side_i, trans_i, m_i, n_i,
00219                                   k_i, a_r, lda_r, tau_i, c_r, ldc_r, work_i,
00220                                   lwork_i );
00221 
00222     LAPACKE_zge_trans( LAPACK_ROW_MAJOR, m, n, c_r, n+2, c_i, ldc );
00223 
00224     failed = compare_zunmqr( c, c_i, info, info_i, ldc, n );
00225     if( failed == 0 ) {
00226         printf( "PASSED: row-major middle-level interface to zunmqr\n" );
00227     } else {
00228         printf( "FAILED: row-major middle-level interface to zunmqr\n" );
00229     }
00230 
00231     /* Initialize input data, call the row-major high-level
00232      * interface to LAPACK routine and check the results */
00233     for( i = 0; i < lda*k; i++ ) {
00234         a_i[i] = a[i];
00235     }
00236     for( i = 0; i < k; i++ ) {
00237         tau_i[i] = tau[i];
00238     }
00239     for( i = 0; i < ldc*n; i++ ) {
00240         c_i[i] = c_save[i];
00241     }
00242     for( i = 0; i < lwork; i++ ) {
00243         work_i[i] = work[i];
00244     }
00245 
00246     /* Init row_major arrays */
00247     LAPACKE_zge_trans( LAPACK_COL_MAJOR, r, k, a_i, lda, a_r, k+2 );
00248     LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, c_i, ldc, c_r, n+2 );
00249     info_i = LAPACKE_zunmqr( LAPACK_ROW_MAJOR, side_i, trans_i, m_i, n_i, k_i,
00250                              a_r, lda_r, tau_i, c_r, ldc_r );
00251 
00252     LAPACKE_zge_trans( LAPACK_ROW_MAJOR, m, n, c_r, n+2, c_i, ldc );
00253 
00254     failed = compare_zunmqr( c, c_i, info, info_i, ldc, n );
00255     if( failed == 0 ) {
00256         printf( "PASSED: row-major high-level interface to zunmqr\n" );
00257     } else {
00258         printf( "FAILED: row-major high-level interface to zunmqr\n" );
00259     }
00260 
00261     /* Release memory */
00262     if( a != NULL ) {
00263         LAPACKE_free( a );
00264     }
00265     if( a_i != NULL ) {
00266         LAPACKE_free( a_i );
00267     }
00268     if( a_r != NULL ) {
00269         LAPACKE_free( a_r );
00270     }
00271     if( tau != NULL ) {
00272         LAPACKE_free( tau );
00273     }
00274     if( tau_i != NULL ) {
00275         LAPACKE_free( tau_i );
00276     }
00277     if( c != NULL ) {
00278         LAPACKE_free( c );
00279     }
00280     if( c_i != NULL ) {
00281         LAPACKE_free( c_i );
00282     }
00283     if( c_r != NULL ) {
00284         LAPACKE_free( c_r );
00285     }
00286     if( c_save != NULL ) {
00287         LAPACKE_free( c_save );
00288     }
00289     if( work != NULL ) {
00290         LAPACKE_free( work );
00291     }
00292     if( work_i != NULL ) {
00293         LAPACKE_free( work_i );
00294     }
00295 
00296     return 0;
00297 }
00298 
00299 /* Auxiliary function: zunmqr scalar parameters initialization */
00300 static void init_scalars_zunmqr( char *side, char *trans, lapack_int *m,
00301                                  lapack_int *n, lapack_int *k, lapack_int *lda,
00302                                  lapack_int *ldc, lapack_int *lwork )
00303 {
00304     *side = 'L';
00305     *trans = 'C';
00306     *m = 6;
00307     *n = 2;
00308     *k = 4;
00309     *lda = 8;
00310     *ldc = 8;
00311     *lwork = 512;
00312 
00313     return;
00314 }
00315 
00316 /* Auxiliary functions: zunmqr array parameters initialization */
00317 static void init_a( lapack_int size, lapack_complex_double *a ) {
00318     lapack_int i;
00319     for( i = 0; i < size; i++ ) {
00320         a[i] = lapack_make_complex_double( 0.0, 0.0 );
00321     }
00322     a[0] = lapack_make_complex_double( -3.08700502105195800e+000,
00323                                        0.00000000000000000e+000 );
00324     a[8] = lapack_make_complex_double( -4.88499367417976620e-001,
00325                                        -1.14168910512461390e+000 );
00326     a[16] = lapack_make_complex_double( 3.77356043173210700e-001,
00327                                         -1.24372975548049110e+000 );
00328     a[24] = lapack_make_complex_double( -8.55165437696762120e-001,
00329                                         -7.07319873181135650e-001 );
00330     a[1] = lapack_make_complex_double( -3.26978431123342020e-001,
00331                                        4.23806608064021150e-001 );
00332     a[9] = lapack_make_complex_double( 1.51631604729093160e+000,
00333                                        0.00000000000000000e+000 );
00334     a[17] = lapack_make_complex_double( 1.37305509662697790e+000,
00335                                         -8.17629335421158570e-001 );
00336     a[25] = lapack_make_complex_double( -2.50862720262847670e-001,
00337                                         8.20348604045144430e-001 );
00338     a[2] = lapack_make_complex_double( 1.69172476430465120e-001,
00339                                        -7.98047673307239890e-002 );
00340     a[10] = lapack_make_complex_double( -4.53710486149829670e-001,
00341                                         -6.49149959135295050e-003 );
00342     a[18] = lapack_make_complex_double( -2.17134536255717010e+000,
00343                                         0.00000000000000000e+000 );
00344     a[26] = lapack_make_complex_double( -2.27267620328359900e-001,
00345                                         -2.95731405907064150e-001 );
00346     a[3] = lapack_make_complex_double( -1.05973629513027950e-001,
00347                                        7.26861860966964010e-002 );
00348     a[11] = lapack_make_complex_double( -2.73407174139646880e-001,
00349                                         9.78078838704348470e-002 );
00350     a[19] = lapack_make_complex_double( -2.91822737804995960e-001,
00351                                         4.88808144155306160e-001 );
00352     a[27] = lapack_make_complex_double( -2.35337610655542080e+000,
00353                                         0.00000000000000000e+000 );
00354     a[4] = lapack_make_complex_double( 1.72939632545932170e-001,
00355                                        1.60632640429298590e-001 );
00356     a[12] = lapack_make_complex_double( -3.23630471463261900e-001,
00357                                         1.23000700219973860e-001 );
00358     a[20] = lapack_make_complex_double( 2.72768506164479230e-001,
00359                                         4.69769330690376700e-002 );
00360     a[28] = lapack_make_complex_double( 7.05422688603155710e-001,
00361                                         2.51508056610988850e-001 );
00362     a[5] = lapack_make_complex_double( 2.69899674468747240e-001,
00363                                        -1.51670836485297000e-002 );
00364     a[13] = lapack_make_complex_double( -1.64593543935458470e-001,
00365                                         3.38900720348261240e-001 );
00366     a[21] = lapack_make_complex_double( 5.34839525361778920e-001,
00367                                         3.98829067784022160e-001 );
00368     a[29] = lapack_make_complex_double( 2.70306990523076050e-001,
00369                                         -7.26878326406570770e-002 );
00370 }
00371 static void init_tau( lapack_int size, lapack_complex_double *tau ) {
00372     lapack_int i;
00373     for( i = 0; i < size; i++ ) {
00374         tau[i] = lapack_make_complex_double( 0.0, 0.0 );
00375     }
00376     tau[0] = lapack_make_complex_double( 1.31098102965600650e+000,
00377                                          -2.62390243772255500e-001 );
00378     tau[1] = lapack_make_complex_double( 1.10510398911057410e+000,
00379                                          -4.50362538745018080e-001 );
00380     tau[2] = lapack_make_complex_double( 1.04025187161551910e+000,
00381                                          2.12175810726109660e-001 );
00382     tau[3] = lapack_make_complex_double( 1.18595901116610980e+000,
00383                                          2.01183600330743640e-001 );
00384 }
00385 static void init_c( lapack_int size, lapack_complex_double *c ) {
00386     lapack_int i;
00387     for( i = 0; i < size; i++ ) {
00388         c[i] = lapack_make_complex_double( 0.0, 0.0 );
00389     }
00390     c[0] = lapack_make_complex_double( -1.54000000000000000e+000,
00391                                        7.60000000000000010e-001 );
00392     c[8] = lapack_make_complex_double( 3.16999999999999990e+000,
00393                                        -2.08999999999999990e+000 );
00394     c[1] = lapack_make_complex_double( 1.20000000000000000e-001,
00395                                        -1.91999999999999990e+000 );
00396     c[9] = lapack_make_complex_double( -6.53000000000000020e+000,
00397                                        4.17999999999999970e+000 );
00398     c[2] = lapack_make_complex_double( -9.08000000000000010e+000,
00399                                        -4.30999999999999960e+000 );
00400     c[10] = lapack_make_complex_double( 7.28000000000000020e+000,
00401                                         7.29999999999999980e-001 );
00402     c[3] = lapack_make_complex_double( 7.49000000000000020e+000,
00403                                        3.64999999999999990e+000 );
00404     c[11] = lapack_make_complex_double( 9.10000000000000030e-001,
00405                                         -3.97000000000000020e+000 );
00406     c[4] = lapack_make_complex_double( -5.62999999999999990e+000,
00407                                        -2.12000000000000010e+000 );
00408     c[12] = lapack_make_complex_double( -5.46000000000000000e+000,
00409                                         -1.63999999999999990e+000 );
00410     c[5] = lapack_make_complex_double( 2.37000000000000010e+000,
00411                                        8.02999999999999940e+000 );
00412     c[13] = lapack_make_complex_double( -2.83999999999999990e+000,
00413                                         -5.86000000000000030e+000 );
00414 }
00415 static void init_work( lapack_int size, lapack_complex_double *work ) {
00416     lapack_int i;
00417     for( i = 0; i < size; i++ ) {
00418         work[i] = lapack_make_complex_double( 0.0, 0.0 );
00419     }
00420 }
00421 
00422 /* Auxiliary function: C interface to zunmqr results check */
00423 /* Return value: 0 - test is passed, non-zero - test is failed */
00424 static int compare_zunmqr( lapack_complex_double *c, lapack_complex_double *c_i,
00425                            lapack_int info, lapack_int info_i, lapack_int ldc,
00426                            lapack_int n )
00427 {
00428     lapack_int i;
00429     int failed = 0;
00430     for( i = 0; i < ldc*n; i++ ) {
00431         failed += compare_complex_doubles(c[i],c_i[i]);
00432     }
00433     failed += (info == info_i) ? 0 : 1;
00434     if( info != 0 || info_i != 0 ) {
00435         printf( "info=%d, info_i=%d\n",(int)info,(int)info_i );
00436     }
00437 
00438     return failed;
00439 }


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