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


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