spprfs_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 * spprfs_1 is the test program for the C interface to LAPACK
00036 * routine spprfs
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_spprfs( char *uplo, lapack_int *n, lapack_int *nrhs,
00055                                  lapack_int *ldb, lapack_int *ldx );
00056 static void init_ap( lapack_int size, float *ap );
00057 static void init_afp( lapack_int size, float *afp );
00058 static void init_b( lapack_int size, float *b );
00059 static void init_x( lapack_int size, float *x );
00060 static void init_ferr( lapack_int size, float *ferr );
00061 static void init_berr( lapack_int size, float *berr );
00062 static void init_work( lapack_int size, float *work );
00063 static void init_iwork( lapack_int size, lapack_int *iwork );
00064 static int compare_spprfs( float *x, float *x_i, float *ferr, float *ferr_i,
00065                            float *berr, float *berr_i, lapack_int info,
00066                            lapack_int info_i, lapack_int ldx, lapack_int nrhs );
00067 
00068 int main(void)
00069 {
00070     /* Local scalars */
00071     char uplo, uplo_i;
00072     lapack_int n, n_i;
00073     lapack_int nrhs, nrhs_i;
00074     lapack_int ldb, ldb_i;
00075     lapack_int ldb_r;
00076     lapack_int ldx, ldx_i;
00077     lapack_int ldx_r;
00078     lapack_int info, info_i;
00079     lapack_int i;
00080     int failed;
00081 
00082     /* Local arrays */
00083     float *ap = NULL, *ap_i = NULL;
00084     float *afp = NULL, *afp_i = NULL;
00085     float *b = NULL, *b_i = NULL;
00086     float *x = NULL, *x_i = NULL;
00087     float *ferr = NULL, *ferr_i = NULL;
00088     float *berr = NULL, *berr_i = NULL;
00089     float *work = NULL, *work_i = NULL;
00090     lapack_int *iwork = NULL, *iwork_i = NULL;
00091     float *x_save = NULL;
00092     float *ferr_save = NULL;
00093     float *berr_save = NULL;
00094     float *ap_r = NULL;
00095     float *afp_r = NULL;
00096     float *b_r = NULL;
00097     float *x_r = NULL;
00098 
00099     /* Iniitialize the scalar parameters */
00100     init_scalars_spprfs( &uplo, &n, &nrhs, &ldb, &ldx );
00101     ldb_r = nrhs+2;
00102     ldx_r = nrhs+2;
00103     uplo_i = uplo;
00104     n_i = n;
00105     nrhs_i = nrhs;
00106     ldb_i = ldb;
00107     ldx_i = ldx;
00108 
00109     /* Allocate memory for the LAPACK routine arrays */
00110     ap = (float *)LAPACKE_malloc( ((n*(n+1)/2)) * sizeof(float) );
00111     afp = (float *)LAPACKE_malloc( ((n*(n+1)/2)) * sizeof(float) );
00112     b = (float *)LAPACKE_malloc( ldb*nrhs * sizeof(float) );
00113     x = (float *)LAPACKE_malloc( ldx*nrhs * sizeof(float) );
00114     ferr = (float *)LAPACKE_malloc( nrhs * sizeof(float) );
00115     berr = (float *)LAPACKE_malloc( nrhs * sizeof(float) );
00116     work = (float *)LAPACKE_malloc( 3*n * sizeof(float) );
00117     iwork = (lapack_int *)LAPACKE_malloc( n * sizeof(lapack_int) );
00118 
00119     /* Allocate memory for the C interface function arrays */
00120     ap_i = (float *)LAPACKE_malloc( ((n*(n+1)/2)) * sizeof(float) );
00121     afp_i = (float *)LAPACKE_malloc( ((n*(n+1)/2)) * sizeof(float) );
00122     b_i = (float *)LAPACKE_malloc( ldb*nrhs * sizeof(float) );
00123     x_i = (float *)LAPACKE_malloc( ldx*nrhs * sizeof(float) );
00124     ferr_i = (float *)LAPACKE_malloc( nrhs * sizeof(float) );
00125     berr_i = (float *)LAPACKE_malloc( nrhs * sizeof(float) );
00126     work_i = (float *)LAPACKE_malloc( 3*n * sizeof(float) );
00127     iwork_i = (lapack_int *)LAPACKE_malloc( n * sizeof(lapack_int) );
00128 
00129     /* Allocate memory for the backup arrays */
00130     x_save = (float *)LAPACKE_malloc( ldx*nrhs * sizeof(float) );
00131     ferr_save = (float *)LAPACKE_malloc( nrhs * sizeof(float) );
00132     berr_save = (float *)LAPACKE_malloc( nrhs * sizeof(float) );
00133 
00134     /* Allocate memory for the row-major arrays */
00135     ap_r = (float *)LAPACKE_malloc( n*(n+1)/2 * sizeof(float) );
00136     afp_r = (float *)LAPACKE_malloc( n*(n+1)/2 * sizeof(float) );
00137     b_r = (float *)LAPACKE_malloc( n*(nrhs+2) * sizeof(float) );
00138     x_r = (float *)LAPACKE_malloc( n*(nrhs+2) * sizeof(float) );
00139 
00140     /* Initialize input arrays */
00141     init_ap( (n*(n+1)/2), ap );
00142     init_afp( (n*(n+1)/2), afp );
00143     init_b( ldb*nrhs, b );
00144     init_x( ldx*nrhs, x );
00145     init_ferr( nrhs, ferr );
00146     init_berr( nrhs, berr );
00147     init_work( 3*n, work );
00148     init_iwork( n, iwork );
00149 
00150     /* Backup the ouptut arrays */
00151     for( i = 0; i < ldx*nrhs; i++ ) {
00152         x_save[i] = x[i];
00153     }
00154     for( i = 0; i < nrhs; i++ ) {
00155         ferr_save[i] = ferr[i];
00156     }
00157     for( i = 0; i < nrhs; i++ ) {
00158         berr_save[i] = berr[i];
00159     }
00160 
00161     /* Call the LAPACK routine */
00162     spprfs_( &uplo, &n, &nrhs, ap, afp, b, &ldb, x, &ldx, ferr, berr, work,
00163              iwork, &info );
00164 
00165     /* Initialize input data, call the column-major middle-level
00166      * interface to LAPACK routine and check the results */
00167     for( i = 0; i < (n*(n+1)/2); i++ ) {
00168         ap_i[i] = ap[i];
00169     }
00170     for( i = 0; i < (n*(n+1)/2); i++ ) {
00171         afp_i[i] = afp[i];
00172     }
00173     for( i = 0; i < ldb*nrhs; i++ ) {
00174         b_i[i] = b[i];
00175     }
00176     for( i = 0; i < ldx*nrhs; i++ ) {
00177         x_i[i] = x_save[i];
00178     }
00179     for( i = 0; i < nrhs; i++ ) {
00180         ferr_i[i] = ferr_save[i];
00181     }
00182     for( i = 0; i < nrhs; i++ ) {
00183         berr_i[i] = berr_save[i];
00184     }
00185     for( i = 0; i < 3*n; i++ ) {
00186         work_i[i] = work[i];
00187     }
00188     for( i = 0; i < n; i++ ) {
00189         iwork_i[i] = iwork[i];
00190     }
00191     info_i = LAPACKE_spprfs_work( LAPACK_COL_MAJOR, uplo_i, n_i, nrhs_i, ap_i,
00192                                   afp_i, b_i, ldb_i, x_i, ldx_i, ferr_i, berr_i,
00193                                   work_i, iwork_i );
00194 
00195     failed = compare_spprfs( x, x_i, ferr, ferr_i, berr, berr_i, info, info_i,
00196                              ldx, nrhs );
00197     if( failed == 0 ) {
00198         printf( "PASSED: column-major middle-level interface to spprfs\n" );
00199     } else {
00200         printf( "FAILED: column-major middle-level interface to spprfs\n" );
00201     }
00202 
00203     /* Initialize input data, call the column-major high-level
00204      * interface to LAPACK routine and check the results */
00205     for( i = 0; i < (n*(n+1)/2); i++ ) {
00206         ap_i[i] = ap[i];
00207     }
00208     for( i = 0; i < (n*(n+1)/2); i++ ) {
00209         afp_i[i] = afp[i];
00210     }
00211     for( i = 0; i < ldb*nrhs; i++ ) {
00212         b_i[i] = b[i];
00213     }
00214     for( i = 0; i < ldx*nrhs; i++ ) {
00215         x_i[i] = x_save[i];
00216     }
00217     for( i = 0; i < nrhs; i++ ) {
00218         ferr_i[i] = ferr_save[i];
00219     }
00220     for( i = 0; i < nrhs; i++ ) {
00221         berr_i[i] = berr_save[i];
00222     }
00223     for( i = 0; i < 3*n; i++ ) {
00224         work_i[i] = work[i];
00225     }
00226     for( i = 0; i < n; i++ ) {
00227         iwork_i[i] = iwork[i];
00228     }
00229     info_i = LAPACKE_spprfs( LAPACK_COL_MAJOR, uplo_i, n_i, nrhs_i, ap_i, afp_i,
00230                              b_i, ldb_i, x_i, ldx_i, ferr_i, berr_i );
00231 
00232     failed = compare_spprfs( x, x_i, ferr, ferr_i, berr, berr_i, info, info_i,
00233                              ldx, nrhs );
00234     if( failed == 0 ) {
00235         printf( "PASSED: column-major high-level interface to spprfs\n" );
00236     } else {
00237         printf( "FAILED: column-major high-level interface to spprfs\n" );
00238     }
00239 
00240     /* Initialize input data, call the row-major middle-level
00241      * interface to LAPACK routine and check the results */
00242     for( i = 0; i < (n*(n+1)/2); i++ ) {
00243         ap_i[i] = ap[i];
00244     }
00245     for( i = 0; i < (n*(n+1)/2); i++ ) {
00246         afp_i[i] = afp[i];
00247     }
00248     for( i = 0; i < ldb*nrhs; i++ ) {
00249         b_i[i] = b[i];
00250     }
00251     for( i = 0; i < ldx*nrhs; i++ ) {
00252         x_i[i] = x_save[i];
00253     }
00254     for( i = 0; i < nrhs; i++ ) {
00255         ferr_i[i] = ferr_save[i];
00256     }
00257     for( i = 0; i < nrhs; i++ ) {
00258         berr_i[i] = berr_save[i];
00259     }
00260     for( i = 0; i < 3*n; i++ ) {
00261         work_i[i] = work[i];
00262     }
00263     for( i = 0; i < n; i++ ) {
00264         iwork_i[i] = iwork[i];
00265     }
00266 
00267     LAPACKE_spp_trans( LAPACK_COL_MAJOR, uplo, n, ap_i, ap_r );
00268     LAPACKE_spp_trans( LAPACK_COL_MAJOR, uplo, n, afp_i, afp_r );
00269     LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_i, ldb, b_r, nrhs+2 );
00270     LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, x_i, ldx, x_r, nrhs+2 );
00271     info_i = LAPACKE_spprfs_work( LAPACK_ROW_MAJOR, uplo_i, n_i, nrhs_i, ap_r,
00272                                   afp_r, b_r, ldb_r, x_r, ldx_r, ferr_i, berr_i,
00273                                   work_i, iwork_i );
00274 
00275     LAPACKE_sge_trans( LAPACK_ROW_MAJOR, n, nrhs, x_r, nrhs+2, x_i, ldx );
00276 
00277     failed = compare_spprfs( x, x_i, ferr, ferr_i, berr, berr_i, info, info_i,
00278                              ldx, nrhs );
00279     if( failed == 0 ) {
00280         printf( "PASSED: row-major middle-level interface to spprfs\n" );
00281     } else {
00282         printf( "FAILED: row-major middle-level interface to spprfs\n" );
00283     }
00284 
00285     /* Initialize input data, call the row-major high-level
00286      * interface to LAPACK routine and check the results */
00287     for( i = 0; i < (n*(n+1)/2); i++ ) {
00288         ap_i[i] = ap[i];
00289     }
00290     for( i = 0; i < (n*(n+1)/2); i++ ) {
00291         afp_i[i] = afp[i];
00292     }
00293     for( i = 0; i < ldb*nrhs; i++ ) {
00294         b_i[i] = b[i];
00295     }
00296     for( i = 0; i < ldx*nrhs; i++ ) {
00297         x_i[i] = x_save[i];
00298     }
00299     for( i = 0; i < nrhs; i++ ) {
00300         ferr_i[i] = ferr_save[i];
00301     }
00302     for( i = 0; i < nrhs; i++ ) {
00303         berr_i[i] = berr_save[i];
00304     }
00305     for( i = 0; i < 3*n; i++ ) {
00306         work_i[i] = work[i];
00307     }
00308     for( i = 0; i < n; i++ ) {
00309         iwork_i[i] = iwork[i];
00310     }
00311 
00312     /* Init row_major arrays */
00313     LAPACKE_spp_trans( LAPACK_COL_MAJOR, uplo, n, ap_i, ap_r );
00314     LAPACKE_spp_trans( LAPACK_COL_MAJOR, uplo, n, afp_i, afp_r );
00315     LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_i, ldb, b_r, nrhs+2 );
00316     LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, x_i, ldx, x_r, nrhs+2 );
00317     info_i = LAPACKE_spprfs( LAPACK_ROW_MAJOR, uplo_i, n_i, nrhs_i, ap_r, afp_r,
00318                              b_r, ldb_r, x_r, ldx_r, ferr_i, berr_i );
00319 
00320     LAPACKE_sge_trans( LAPACK_ROW_MAJOR, n, nrhs, x_r, nrhs+2, x_i, ldx );
00321 
00322     failed = compare_spprfs( x, x_i, ferr, ferr_i, berr, berr_i, info, info_i,
00323                              ldx, nrhs );
00324     if( failed == 0 ) {
00325         printf( "PASSED: row-major high-level interface to spprfs\n" );
00326     } else {
00327         printf( "FAILED: row-major high-level interface to spprfs\n" );
00328     }
00329 
00330     /* Release memory */
00331     if( ap != NULL ) {
00332         LAPACKE_free( ap );
00333     }
00334     if( ap_i != NULL ) {
00335         LAPACKE_free( ap_i );
00336     }
00337     if( ap_r != NULL ) {
00338         LAPACKE_free( ap_r );
00339     }
00340     if( afp != NULL ) {
00341         LAPACKE_free( afp );
00342     }
00343     if( afp_i != NULL ) {
00344         LAPACKE_free( afp_i );
00345     }
00346     if( afp_r != NULL ) {
00347         LAPACKE_free( afp_r );
00348     }
00349     if( b != NULL ) {
00350         LAPACKE_free( b );
00351     }
00352     if( b_i != NULL ) {
00353         LAPACKE_free( b_i );
00354     }
00355     if( b_r != NULL ) {
00356         LAPACKE_free( b_r );
00357     }
00358     if( x != NULL ) {
00359         LAPACKE_free( x );
00360     }
00361     if( x_i != NULL ) {
00362         LAPACKE_free( x_i );
00363     }
00364     if( x_r != NULL ) {
00365         LAPACKE_free( x_r );
00366     }
00367     if( x_save != NULL ) {
00368         LAPACKE_free( x_save );
00369     }
00370     if( ferr != NULL ) {
00371         LAPACKE_free( ferr );
00372     }
00373     if( ferr_i != NULL ) {
00374         LAPACKE_free( ferr_i );
00375     }
00376     if( ferr_save != NULL ) {
00377         LAPACKE_free( ferr_save );
00378     }
00379     if( berr != NULL ) {
00380         LAPACKE_free( berr );
00381     }
00382     if( berr_i != NULL ) {
00383         LAPACKE_free( berr_i );
00384     }
00385     if( berr_save != NULL ) {
00386         LAPACKE_free( berr_save );
00387     }
00388     if( work != NULL ) {
00389         LAPACKE_free( work );
00390     }
00391     if( work_i != NULL ) {
00392         LAPACKE_free( work_i );
00393     }
00394     if( iwork != NULL ) {
00395         LAPACKE_free( iwork );
00396     }
00397     if( iwork_i != NULL ) {
00398         LAPACKE_free( iwork_i );
00399     }
00400 
00401     return 0;
00402 }
00403 
00404 /* Auxiliary function: spprfs scalar parameters initialization */
00405 static void init_scalars_spprfs( char *uplo, lapack_int *n, lapack_int *nrhs,
00406                                  lapack_int *ldb, lapack_int *ldx )
00407 {
00408     *uplo = 'L';
00409     *n = 4;
00410     *nrhs = 2;
00411     *ldb = 8;
00412     *ldx = 8;
00413 
00414     return;
00415 }
00416 
00417 /* Auxiliary functions: spprfs array parameters initialization */
00418 static void init_ap( lapack_int size, float *ap ) {
00419     lapack_int i;
00420     for( i = 0; i < size; i++ ) {
00421         ap[i] = 0;
00422     }
00423     ap[0] = 4.159999847e+000;
00424     ap[1] = -3.119999886e+000;
00425     ap[2] = 5.600000024e-001;
00426     ap[3] = -1.000000015e-001;
00427     ap[4] = 5.030000210e+000;
00428     ap[5] = -8.299999833e-001;
00429     ap[6] = 1.179999948e+000;
00430     ap[7] = 7.599999905e-001;
00431     ap[8] = 3.400000036e-001;
00432     ap[9] = 1.179999948e+000;
00433 }
00434 static void init_afp( lapack_int size, float *afp ) {
00435     lapack_int i;
00436     for( i = 0; i < size; i++ ) {
00437         afp[i] = 0;
00438     }
00439     afp[0] = 2.039607763e+000;
00440     afp[1] = -1.529705763e+000;
00441     afp[2] = 2.745625973e-001;
00442     afp[3] = -4.902903363e-002;
00443     afp[4] = 1.640122056e+000;
00444     afp[5] = -2.499813884e-001;
00445     afp[6] = 6.737302542e-001;
00446     afp[7] = 7.887488008e-001;
00447     afp[8] = 6.616575122e-001;
00448     afp[9] = 5.346895456e-001;
00449 }
00450 static void init_b( lapack_int size, float *b ) {
00451     lapack_int i;
00452     for( i = 0; i < size; i++ ) {
00453         b[i] = 0;
00454     }
00455     b[0] = 8.699999809e+000;  /* b[0,0] */
00456     b[8] = 8.300000191e+000;  /* b[0,1] */
00457     b[1] = -1.335000038e+001;  /* b[1,0] */
00458     b[9] = 2.130000114e+000;  /* b[1,1] */
00459     b[2] = 1.889999986e+000;  /* b[2,0] */
00460     b[10] = 1.610000014e+000;  /* b[2,1] */
00461     b[3] = -4.139999866e+000;  /* b[3,0] */
00462     b[11] = 5.000000000e+000;  /* b[3,1] */
00463 }
00464 static void init_x( lapack_int size, float *x ) {
00465     lapack_int i;
00466     for( i = 0; i < size; i++ ) {
00467         x[i] = 0;
00468     }
00469     x[0] = 9.999995232e-001;  /* x[0,0] */
00470     x[8] = 3.999998569e+000;  /* x[0,1] */
00471     x[1] = -1.000000596e+000;  /* x[1,0] */
00472     x[9] = 2.999997139e+000;  /* x[1,1] */
00473     x[2] = 1.999999523e+000;  /* x[2,0] */
00474     x[10] = 1.999995947e+000;  /* x[2,1] */
00475     x[3] = -2.999999762e+000;  /* x[3,0] */
00476     x[11] = 1.000004292e+000;  /* x[3,1] */
00477 }
00478 static void init_ferr( lapack_int size, float *ferr ) {
00479     lapack_int i;
00480     for( i = 0; i < size; i++ ) {
00481         ferr[i] = 0;
00482     }
00483 }
00484 static void init_berr( lapack_int size, float *berr ) {
00485     lapack_int i;
00486     for( i = 0; i < size; i++ ) {
00487         berr[i] = 0;
00488     }
00489 }
00490 static void init_work( lapack_int size, float *work ) {
00491     lapack_int i;
00492     for( i = 0; i < size; i++ ) {
00493         work[i] = 0;
00494     }
00495 }
00496 static void init_iwork( lapack_int size, lapack_int *iwork ) {
00497     lapack_int i;
00498     for( i = 0; i < size; i++ ) {
00499         iwork[i] = 0;
00500     }
00501 }
00502 
00503 /* Auxiliary function: C interface to spprfs results check */
00504 /* Return value: 0 - test is passed, non-zero - test is failed */
00505 static int compare_spprfs( float *x, float *x_i, float *ferr, float *ferr_i,
00506                            float *berr, float *berr_i, lapack_int info,
00507                            lapack_int info_i, lapack_int ldx, lapack_int nrhs )
00508 {
00509     lapack_int i;
00510     int failed = 0;
00511     for( i = 0; i < ldx*nrhs; i++ ) {
00512         failed += compare_floats(x[i],x_i[i]);
00513     }
00514     for( i = 0; i < nrhs; i++ ) {
00515         failed += compare_floats(ferr[i],ferr_i[i]);
00516     }
00517     for( i = 0; i < nrhs; i++ ) {
00518         failed += compare_floats(berr[i],berr_i[i]);
00519     }
00520     failed += (info == info_i) ? 0 : 1;
00521     if( info != 0 || info_i != 0 ) {
00522         printf( "info=%d, info_i=%d\n",(int)info,(int)info_i );
00523     }
00524 
00525     return failed;
00526 }


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