dsytrs_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 * dsytrs_1 is the test program for the C interface to LAPACK
00036 * routine dsytrs
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_dsytrs( char *uplo, lapack_int *n, lapack_int *nrhs,
00055                                  lapack_int *lda, lapack_int *ldb );
00056 static void init_a( lapack_int size, double *a );
00057 static void init_ipiv( lapack_int size, lapack_int *ipiv );
00058 static void init_b( lapack_int size, double *b );
00059 static int compare_dsytrs( double *b, double *b_i, lapack_int info,
00060                            lapack_int info_i, lapack_int ldb, lapack_int nrhs );
00061 
00062 int main(void)
00063 {
00064     /* Local scalars */
00065     char uplo, uplo_i;
00066     lapack_int n, n_i;
00067     lapack_int nrhs, nrhs_i;
00068     lapack_int lda, lda_i;
00069     lapack_int lda_r;
00070     lapack_int ldb, ldb_i;
00071     lapack_int ldb_r;
00072     lapack_int info, info_i;
00073     lapack_int i;
00074     int failed;
00075 
00076     /* Local arrays */
00077     double *a = NULL, *a_i = NULL;
00078     lapack_int *ipiv = NULL, *ipiv_i = NULL;
00079     double *b = NULL, *b_i = NULL;
00080     double *b_save = NULL;
00081     double *a_r = NULL;
00082     double *b_r = NULL;
00083 
00084     /* Iniitialize the scalar parameters */
00085     init_scalars_dsytrs( &uplo, &n, &nrhs, &lda, &ldb );
00086     lda_r = n+2;
00087     ldb_r = nrhs+2;
00088     uplo_i = uplo;
00089     n_i = n;
00090     nrhs_i = nrhs;
00091     lda_i = lda;
00092     ldb_i = ldb;
00093 
00094     /* Allocate memory for the LAPACK routine arrays */
00095     a = (double *)LAPACKE_malloc( lda*n * sizeof(double) );
00096     ipiv = (lapack_int *)LAPACKE_malloc( n * sizeof(lapack_int) );
00097     b = (double *)LAPACKE_malloc( ldb*nrhs * sizeof(double) );
00098 
00099     /* Allocate memory for the C interface function arrays */
00100     a_i = (double *)LAPACKE_malloc( lda*n * sizeof(double) );
00101     ipiv_i = (lapack_int *)LAPACKE_malloc( n * sizeof(lapack_int) );
00102     b_i = (double *)LAPACKE_malloc( ldb*nrhs * sizeof(double) );
00103 
00104     /* Allocate memory for the backup arrays */
00105     b_save = (double *)LAPACKE_malloc( ldb*nrhs * sizeof(double) );
00106 
00107     /* Allocate memory for the row-major arrays */
00108     a_r = (double *)LAPACKE_malloc( n*(n+2) * sizeof(double) );
00109     b_r = (double *)LAPACKE_malloc( n*(nrhs+2) * sizeof(double) );
00110 
00111     /* Initialize input arrays */
00112     init_a( lda*n, a );
00113     init_ipiv( n, ipiv );
00114     init_b( ldb*nrhs, b );
00115 
00116     /* Backup the ouptut arrays */
00117     for( i = 0; i < ldb*nrhs; i++ ) {
00118         b_save[i] = b[i];
00119     }
00120 
00121     /* Call the LAPACK routine */
00122     dsytrs_( &uplo, &n, &nrhs, a, &lda, ipiv, b, &ldb, &info );
00123 
00124     /* Initialize input data, call the column-major middle-level
00125      * interface to LAPACK routine and check the results */
00126     for( i = 0; i < lda*n; i++ ) {
00127         a_i[i] = a[i];
00128     }
00129     for( i = 0; i < n; i++ ) {
00130         ipiv_i[i] = ipiv[i];
00131     }
00132     for( i = 0; i < ldb*nrhs; i++ ) {
00133         b_i[i] = b_save[i];
00134     }
00135     info_i = LAPACKE_dsytrs_work( LAPACK_COL_MAJOR, uplo_i, n_i, nrhs_i, a_i,
00136                                   lda_i, ipiv_i, b_i, ldb_i );
00137 
00138     failed = compare_dsytrs( b, b_i, info, info_i, ldb, nrhs );
00139     if( failed == 0 ) {
00140         printf( "PASSED: column-major middle-level interface to dsytrs\n" );
00141     } else {
00142         printf( "FAILED: column-major middle-level interface to dsytrs\n" );
00143     }
00144 
00145     /* Initialize input data, call the column-major high-level
00146      * interface to LAPACK routine and check the results */
00147     for( i = 0; i < lda*n; i++ ) {
00148         a_i[i] = a[i];
00149     }
00150     for( i = 0; i < n; i++ ) {
00151         ipiv_i[i] = ipiv[i];
00152     }
00153     for( i = 0; i < ldb*nrhs; i++ ) {
00154         b_i[i] = b_save[i];
00155     }
00156     info_i = LAPACKE_dsytrs( LAPACK_COL_MAJOR, uplo_i, n_i, nrhs_i, a_i, lda_i,
00157                              ipiv_i, b_i, ldb_i );
00158 
00159     failed = compare_dsytrs( b, b_i, info, info_i, ldb, nrhs );
00160     if( failed == 0 ) {
00161         printf( "PASSED: column-major high-level interface to dsytrs\n" );
00162     } else {
00163         printf( "FAILED: column-major high-level interface to dsytrs\n" );
00164     }
00165 
00166     /* Initialize input data, call the row-major middle-level
00167      * interface to LAPACK routine and check the results */
00168     for( i = 0; i < lda*n; i++ ) {
00169         a_i[i] = a[i];
00170     }
00171     for( i = 0; i < n; i++ ) {
00172         ipiv_i[i] = ipiv[i];
00173     }
00174     for( i = 0; i < ldb*nrhs; i++ ) {
00175         b_i[i] = b_save[i];
00176     }
00177 
00178     LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, a_i, lda, a_r, n+2 );
00179     LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, b_i, ldb, b_r, nrhs+2 );
00180     info_i = LAPACKE_dsytrs_work( LAPACK_ROW_MAJOR, uplo_i, n_i, nrhs_i, a_r,
00181                                   lda_r, ipiv_i, b_r, ldb_r );
00182 
00183     LAPACKE_dge_trans( LAPACK_ROW_MAJOR, n, nrhs, b_r, nrhs+2, b_i, ldb );
00184 
00185     failed = compare_dsytrs( b, b_i, info, info_i, ldb, nrhs );
00186     if( failed == 0 ) {
00187         printf( "PASSED: row-major middle-level interface to dsytrs\n" );
00188     } else {
00189         printf( "FAILED: row-major middle-level interface to dsytrs\n" );
00190     }
00191 
00192     /* Initialize input data, call the row-major high-level
00193      * interface to LAPACK routine and check the results */
00194     for( i = 0; i < lda*n; i++ ) {
00195         a_i[i] = a[i];
00196     }
00197     for( i = 0; i < n; i++ ) {
00198         ipiv_i[i] = ipiv[i];
00199     }
00200     for( i = 0; i < ldb*nrhs; i++ ) {
00201         b_i[i] = b_save[i];
00202     }
00203 
00204     /* Init row_major arrays */
00205     LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, a_i, lda, a_r, n+2 );
00206     LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, b_i, ldb, b_r, nrhs+2 );
00207     info_i = LAPACKE_dsytrs( LAPACK_ROW_MAJOR, uplo_i, n_i, nrhs_i, a_r, lda_r,
00208                              ipiv_i, b_r, ldb_r );
00209 
00210     LAPACKE_dge_trans( LAPACK_ROW_MAJOR, n, nrhs, b_r, nrhs+2, b_i, ldb );
00211 
00212     failed = compare_dsytrs( b, b_i, info, info_i, ldb, nrhs );
00213     if( failed == 0 ) {
00214         printf( "PASSED: row-major high-level interface to dsytrs\n" );
00215     } else {
00216         printf( "FAILED: row-major high-level interface to dsytrs\n" );
00217     }
00218 
00219     /* Release memory */
00220     if( a != NULL ) {
00221         LAPACKE_free( a );
00222     }
00223     if( a_i != NULL ) {
00224         LAPACKE_free( a_i );
00225     }
00226     if( a_r != NULL ) {
00227         LAPACKE_free( a_r );
00228     }
00229     if( ipiv != NULL ) {
00230         LAPACKE_free( ipiv );
00231     }
00232     if( ipiv_i != NULL ) {
00233         LAPACKE_free( ipiv_i );
00234     }
00235     if( b != NULL ) {
00236         LAPACKE_free( b );
00237     }
00238     if( b_i != NULL ) {
00239         LAPACKE_free( b_i );
00240     }
00241     if( b_r != NULL ) {
00242         LAPACKE_free( b_r );
00243     }
00244     if( b_save != NULL ) {
00245         LAPACKE_free( b_save );
00246     }
00247 
00248     return 0;
00249 }
00250 
00251 /* Auxiliary function: dsytrs scalar parameters initialization */
00252 static void init_scalars_dsytrs( char *uplo, lapack_int *n, lapack_int *nrhs,
00253                                  lapack_int *lda, lapack_int *ldb )
00254 {
00255     *uplo = 'L';
00256     *n = 4;
00257     *nrhs = 2;
00258     *lda = 8;
00259     *ldb = 8;
00260 
00261     return;
00262 }
00263 
00264 /* Auxiliary functions: dsytrs array parameters initialization */
00265 static void init_a( lapack_int size, double *a ) {
00266     lapack_int i;
00267     for( i = 0; i < size; i++ ) {
00268         a[i] = 0;
00269     }
00270     a[0] = 2.06999999999999980e+000;  /* a[0,0] */
00271     a[8] = 0.00000000000000000e+000;  /* a[0,1] */
00272     a[16] = 0.00000000000000000e+000;  /* a[0,2] */
00273     a[24] = 0.00000000000000000e+000;  /* a[0,3] */
00274     a[1] = 4.20000000000000020e+000;  /* a[1,0] */
00275     a[9] = 1.14999999999999990e+000;  /* a[1,1] */
00276     a[17] = 0.00000000000000000e+000;  /* a[1,2] */
00277     a[25] = 0.00000000000000000e+000;  /* a[1,3] */
00278     a[2] = 2.23041384055834070e-001;  /* a[2,0] */
00279     a[10] = 8.11501032143910230e-001;  /* a[2,1] */
00280     a[18] = -2.59067708640519000e+000;  /* a[2,2] */
00281     a[26] = 0.00000000000000000e+000;  /* a[2,3] */
00282     a[3] = 6.53658376748910360e-001;  /* a[3,0] */
00283     a[11] = -5.95969723778629450e-001;  /* a[3,1] */
00284     a[19] = 3.03084679550618070e-001;  /* a[3,2] */
00285     a[27] = 4.07385198134887610e-001;  /* a[3,3] */
00286 }
00287 static void init_ipiv( lapack_int size, lapack_int *ipiv ) {
00288     lapack_int i;
00289     for( i = 0; i < size; i++ ) {
00290         ipiv[i] = 0;
00291     }
00292     ipiv[0] = -3;
00293     ipiv[1] = -3;
00294     ipiv[2] = 3;
00295     ipiv[3] = 4;
00296 }
00297 static void init_b( lapack_int size, double *b ) {
00298     lapack_int i;
00299     for( i = 0; i < size; i++ ) {
00300         b[i] = 0;
00301     }
00302     b[0] = -9.50000000000000000e+000;  /* b[0,0] */
00303     b[8] = 2.78500000000000010e+001;  /* b[0,1] */
00304     b[1] = -8.38000000000000080e+000;  /* b[1,0] */
00305     b[9] = 9.90000000000000040e+000;  /* b[1,1] */
00306     b[2] = -6.07000000000000030e+000;  /* b[2,0] */
00307     b[10] = 1.92500000000000000e+001;  /* b[2,1] */
00308     b[3] = -9.59999999999999960e-001;  /* b[3,0] */
00309     b[11] = 3.93000000000000020e+000;  /* b[3,1] */
00310 }
00311 
00312 /* Auxiliary function: C interface to dsytrs results check */
00313 /* Return value: 0 - test is passed, non-zero - test is failed */
00314 static int compare_dsytrs( double *b, double *b_i, lapack_int info,
00315                            lapack_int info_i, lapack_int ldb, lapack_int nrhs )
00316 {
00317     lapack_int i;
00318     int failed = 0;
00319     for( i = 0; i < ldb*nrhs; i++ ) {
00320         failed += compare_doubles(b[i],b_i[i]);
00321     }
00322     failed += (info == info_i) ? 0 : 1;
00323     if( info != 0 || info_i != 0 ) {
00324         printf( "info=%d, info_i=%d\n",(int)info,(int)info_i );
00325     }
00326 
00327     return failed;
00328 }


swiftnav
Author(s):
autogenerated on Sat Jun 8 2019 18:55:49