From: julie Date: Mon, 5 Oct 2015 00:04:38 +0000 (+0000) Subject: Adding xlascl to LAPACKE X-Git-Tag: accepted/tizen/5.0/unified/20181102.024111~323 X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=a532e8376812a7a7da0feb1663793e72231cf56b;p=platform%2Fupstream%2Flapack.git Adding xlascl to LAPACKE --- diff --git a/LAPACKE/include/lapacke.h b/LAPACKE/include/lapacke.h index 9bb29ad..f386b13 100644 --- a/LAPACKE/include/lapacke.h +++ b/LAPACKE/include/lapacke.h @@ -2429,6 +2429,23 @@ lapack_int LAPACKE_clarnv( lapack_int idist, lapack_int* iseed, lapack_int n, lapack_int LAPACKE_zlarnv( lapack_int idist, lapack_int* iseed, lapack_int n, lapack_complex_double* x ); +lapack_int LAPACKE_slascl( int matrix_layout, char type, lapack_int kl, + lapack_int ku, float cfrom, float cto, + lapack_int m, lapack_int n, float* a, + lapack_int lda ); +lapack_int LAPACKE_dlascl( int matrix_layout, char type, lapack_int kl, + lapack_int ku, double cfrom, double cto, + lapack_int m, lapack_int n, double* a, + lapack_int lda ); +lapack_int LAPACKE_clascl( int matrix_layout, char type, lapack_int kl, + lapack_int ku, float cfrom, float cto, + lapack_int m, lapack_int n, lapack_complex_float* a, + lapack_int lda ); +lapack_int LAPACKE_zlascl( int matrix_layout, char type, lapack_int kl, + lapack_int ku, double cfrom, double cto, + lapack_int m, lapack_int n, lapack_complex_double* a, + lapack_int lda ); + lapack_int LAPACKE_slaset( int matrix_layout, char uplo, lapack_int m, lapack_int n, float alpha, float beta, float* a, lapack_int lda ); @@ -7500,6 +7517,24 @@ lapack_int LAPACKE_clarnv_work( lapack_int idist, lapack_int* iseed, lapack_int LAPACKE_zlarnv_work( lapack_int idist, lapack_int* iseed, lapack_int n, lapack_complex_double* x ); + +lapack_int LAPACKE_slascl_work( int matrix_layout, char type, lapack_int kl, + lapack_int ku, float cfrom, float cto, + lapack_int m, lapack_int n, float* a, + lapack_int lda ); +lapack_int LAPACKE_dlascl_work( int matrix_layout, char type, lapack_int kl, + lapack_int ku, double cfrom, double cto, + lapack_int m, lapack_int n, double* a, + lapack_int lda ); +lapack_int LAPACKE_clascl_work( int matrix_layout, char type, lapack_int kl, + lapack_int ku, float cfrom, float cto, + lapack_int m, lapack_int n, lapack_complex_float* a, + lapack_int lda ); +lapack_int LAPACKE_zlascl_work( int matrix_layout, char type, lapack_int kl, + lapack_int ku, double cfrom, double cto, + lapack_int m, lapack_int n, lapack_complex_double* a, + lapack_int lda ); + lapack_int LAPACKE_slaset_work( int matrix_layout, char uplo, lapack_int m, lapack_int n, float alpha, float beta, float* a, lapack_int lda ); @@ -12099,6 +12134,10 @@ void LAPACKE_ilaver( const lapack_int* vers_major, #define LAPACK_dlagge LAPACK_GLOBAL(dlagge,DLAGGE) #define LAPACK_clagge LAPACK_GLOBAL(clagge,CLAGGE) #define LAPACK_zlagge LAPACK_GLOBAL(zlagge,ZLAGGE) +#define LAPACK_slascl LAPACK_GLOBAL(slascl,SLASCL) +#define LAPACK_dlascl LAPACK_GLOBAL(dlascl,DLASCL) +#define LAPACK_clascl LAPACK_GLOBAL(clascl,CLASCL) +#define LAPACK_zlascl LAPACK_GLOBAL(zlascl,ZLASCL) #define LAPACK_slaset LAPACK_GLOBAL(slaset,SLASET) #define LAPACK_dlaset LAPACK_GLOBAL(dlaset,DLASET) #define LAPACK_claset LAPACK_GLOBAL(claset,CLASET) @@ -16585,6 +16624,18 @@ void LAPACK_zlagge( lapack_int* m, lapack_int* n, lapack_int* kl, lapack_int* ku, const double* d, lapack_complex_double* a, lapack_int* lda, lapack_int* iseed, lapack_complex_double* work, lapack_int *info ); +void LAPACK_slascl( char* type, lapack_int* kl, lapack_int* ku, float* cfrom, + float* cto, lapack_int* m, lapack_int* n, float* a, + lapack_int* lda, lapack_int *info ); +void LAPACK_dlascl( char* type, lapack_int* kl, lapack_int* ku, double* cfrom, + double* cto, lapack_int* m, lapack_int* n, double* a, + lapack_int* lda, lapack_int *info ); +void LAPACK_clascl( char* type, lapack_int* kl, lapack_int* ku, float* cfrom, + float* cto, lapack_int* m, lapack_int* n, lapack_complex_float* a, + lapack_int* lda, lapack_int *info ); +void LAPACK_zlascl( char* type, lapack_int* kl, lapack_int* ku, double* cfrom, + double* cto, lapack_int* m, lapack_int* n, lapack_complex_double* a, + lapack_int* lda, lapack_int *info ); void LAPACK_slaset( char* uplo, lapack_int* m, lapack_int* n, float* alpha, float* beta, float* a, lapack_int* lda ); void LAPACK_dlaset( char* uplo, lapack_int* m, lapack_int* n, double* alpha, diff --git a/LAPACKE/src/CMakeLists.txt b/LAPACKE/src/CMakeLists.txt index 0535ce5..47f3d74 100644 --- a/LAPACKE/src/CMakeLists.txt +++ b/LAPACKE/src/CMakeLists.txt @@ -269,6 +269,8 @@ lapacke_clarfx.c lapacke_clarfx_work.c lapacke_clarnv.c lapacke_clarnv_work.c +lapacke_clascl.c +lapacke_clascl_work.c lapacke_claset.c lapacke_claset_work.c lapacke_claswp.c @@ -697,6 +699,8 @@ lapacke_dlartgp.c lapacke_dlartgp_work.c lapacke_dlartgs.c lapacke_dlartgs_work.c +lapacke_dlascl.c +lapacke_dlascl_work.c lapacke_dlaset.c lapacke_dlaset_work.c lapacke_dlasrt.c @@ -1195,6 +1199,8 @@ lapacke_slartgp.c lapacke_slartgp_work.c lapacke_slartgs.c lapacke_slartgs_work.c +lapacke_slascl.c +lapacke_slascl_work.c lapacke_slaset.c lapacke_slaset_work.c lapacke_slasrt.c @@ -1775,6 +1781,8 @@ lapacke_zlarfx.c lapacke_zlarfx_work.c lapacke_zlarnv.c lapacke_zlarnv_work.c +lapacke_zlascl.c +lapacke_zlascl_work.c lapacke_zlaset.c lapacke_zlaset_work.c lapacke_zlaswp.c diff --git a/LAPACKE/src/Makefile b/LAPACKE/src/Makefile index 4460d24..86a1045 100644 --- a/LAPACKE/src/Makefile +++ b/LAPACKE/src/Makefile @@ -303,6 +303,8 @@ lapacke_clarfx.o \ lapacke_clarfx_work.o \ lapacke_clarnv.o \ lapacke_clarnv_work.o \ +lapacke_clascl.o \ +lapacke_clascl_work.o \ lapacke_claset.o \ lapacke_claset_work.o \ lapacke_claswp.o \ @@ -731,6 +733,8 @@ lapacke_dlartgp.o \ lapacke_dlartgp_work.o \ lapacke_dlartgs.o \ lapacke_dlartgs_work.o \ +lapacke_dlascl.o \ +lapacke_dlascl_work.o \ lapacke_dlaset.o \ lapacke_dlaset_work.o \ lapacke_dlasrt.o \ @@ -1229,6 +1233,8 @@ lapacke_slartgp.o \ lapacke_slartgp_work.o \ lapacke_slartgs.o \ lapacke_slartgs_work.o \ +lapacke_slascl.o \ +lapacke_slascl_work.o \ lapacke_slaset.o \ lapacke_slaset_work.o \ lapacke_slasrt.o \ @@ -1809,6 +1815,8 @@ lapacke_zlarfx.o \ lapacke_zlarfx_work.o \ lapacke_zlarnv.o \ lapacke_zlarnv_work.o \ +lapacke_zlascl.o \ +lapacke_zlascl_work.o \ lapacke_zlaset.o \ lapacke_zlaset_work.o \ lapacke_zlaswp.o \ diff --git a/LAPACKE/src/lapacke_clascl.c b/LAPACKE/src/lapacke_clascl.c new file mode 100644 index 0000000..71924bf --- /dev/null +++ b/LAPACKE/src/lapacke_clascl.c @@ -0,0 +1,97 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native high-level C interface to LAPACK function slaswp +* Author: Intel Corporation +* Generated November, 2011 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_clascl( int matrix_layout, char type, lapack_int kl, + lapack_int ku, float cfrom, float cto, + lapack_int m, lapack_int n, lapack_complex_float* a, + lapack_int lda ) +{ + if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { + LAPACKE_xerbla( "LAPACKE_clascl", -1 ); + return -1; + } +#ifndef LAPACK_DISABLE_NAN_CHECK + /* Optionally check input matrices for NaNs */ + switch (type) { + case 'G': + if( LAPACKE_cge_nancheck( matrix_layout, lda, n, a, lda ) ) { + return -9; + } + break; + case 'L': + // TYPE = 'L' - lower triangular matrix. + if( LAPACKE_ctr_nancheck( matrix_layout, 'L', 'N', n, a, lda ) ) { + return -9; + } + break; + case 'U': + // TYPE = 'U' - upper triangular matrix + if( LAPACKE_ctr_nancheck( matrix_layout, 'U', 'N', n, a, lda ) ) { + return -9; + } + break; + case 'H': + // TYPE = 'H' - upper Hessenberg matrix + if( LAPACKE_chs_nancheck( matrix_layout, n, a, lda ) ) { + return -9; + } + break; + case 'B': + // TYPE = 'B' - A is a symmetric band matrix with lower bandwidth KL + // and upper bandwidth KU and with the only the lower + // half stored. + if( LAPACKE_csb_nancheck( matrix_layout, 'L', n, kl, a, lda ) ) { + return -9; + } + break; + case 'Q': + // TYPE = 'Q' - A is a symmetric band matrix with lower bandwidth KL + // and upper bandwidth KU and with the only the upper + // half stored. + if( LAPACKE_csb_nancheck( matrix_layout, 'U', n, ku, a, lda ) ) { + return -9; + } + break; + case 'Z': + // TYPE = 'Z' - A is a band matrix with lower bandwidth KL and upper + // bandwidth KU. See DGBTRF for storage details. + if( LAPACKE_cgb_nancheck( matrix_layout, n, n, kl, kl+ku, a, lda ) ) { + return -6; + } + break; + } +#endif + return LAPACKE_clascl_work( matrix_layout, type, kl, ku, cfrom, cto, m, n, a, lda ); +} diff --git a/LAPACKE/src/lapacke_clascl_work.c b/LAPACKE/src/lapacke_clascl_work.c new file mode 100644 index 0000000..18ac1ef --- /dev/null +++ b/LAPACKE/src/lapacke_clascl_work.c @@ -0,0 +1,82 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native middle-level C interface to LAPACK function slaswp +* Author: Intel Corporation +* Generated November, 2011 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_clascl_work( int matrix_layout, char type, lapack_int kl, + lapack_int ku, float cfrom, float cto, + lapack_int m, lapack_int n, lapack_complex_float* a, + lapack_int lda ) +{ + lapack_int info = 0; + if( matrix_layout == LAPACK_COL_MAJOR ) { + /* Call LAPACK function and adjust info */ + LAPACK_clascl( &type, &kl, &ku, &cfrom, &cto, &m, &n, a, &lda, &info); + if( info < 0 ) { + info = info - 1; + } + } else if( matrix_layout == LAPACK_ROW_MAJOR ) { + lapack_int lda_t = MAX(1,lda); + lapack_complex_float* a_t = NULL; + /* Check leading dimension(s) */ + if( lda < n ) { + info = -9; + LAPACKE_xerbla( "LAPACKE_clascl_work", info ); + return info; + } + /* Allocate memory for temporary array(s) */ + a_t = (lapack_complex_float*) + LAPACKE_malloc( sizeof(lapack_complex_float) * lda_t * MAX(1,n) ); + if( a_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_0; + } + /* Transpose input matrices */ + LAPACKE_cge_trans( matrix_layout, lda, n, a, lda, a_t, lda_t ); + /* Call LAPACK function and adjust info */ + LAPACK_clascl( &type, &kl, &ku, &cfrom, &cto, &m, &n, a_t, &lda_t, &info); + info = 0; /* LAPACK call is ok! */ + /* Transpose output matrices */ + LAPACKE_cge_trans( LAPACK_COL_MAJOR, lda, n, a_t, lda_t, a, lda ); + /* Release memory and exit */ + LAPACKE_free( a_t ); +exit_level_0: + if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_clascl_work", info ); + } + } else { + info = -1; + LAPACKE_xerbla( "LAPACKE_clascl_work", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_dlascl.c b/LAPACKE/src/lapacke_dlascl.c new file mode 100644 index 0000000..d3a2f49 --- /dev/null +++ b/LAPACKE/src/lapacke_dlascl.c @@ -0,0 +1,97 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native high-level C interface to LAPACK function dlaswp +* Author: Intel Corporation +* Generated November, 2011 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_dlascl( int matrix_layout, char type, lapack_int kl, + lapack_int ku, double cfrom, double cto, + lapack_int m, lapack_int n, double* a, + lapack_int lda ) +{ + if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { + LAPACKE_xerbla( "LAPACKE_dlascl", -1 ); + return -1; + } +#ifndef LAPACK_DISABLE_NAN_CHECK + /* Optionally check input matrices for NaNs */ + switch (type) { + case 'G': + if( LAPACKE_dge_nancheck( matrix_layout, lda, n, a, lda ) ) { + return -9; + } + break; + case 'L': + // TYPE = 'L' - lower triangular matrix. + if( LAPACKE_dtr_nancheck( matrix_layout, 'L', 'N', n, a, lda ) ) { + return -9; + } + break; + case 'U': + // TYPE = 'U' - upper triangular matrix + if( LAPACKE_dtr_nancheck( matrix_layout, 'U', 'N', n, a, lda ) ) { + return -9; + } + break; + case 'H': + // TYPE = 'H' - upper Hessenberg matrix + if( LAPACKE_dhs_nancheck( matrix_layout, n, a, lda ) ) { + return -9; + } + break; + case 'B': + // TYPE = 'B' - A is a symmetric band matrix with lower bandwidth KL + // and upper bandwidth KU and with the only the lower + // half stored. + if( LAPACKE_dsb_nancheck( matrix_layout, 'L', n, kl, a, lda ) ) { + return -9; + } + break; + case 'Q': + // TYPE = 'Q' - A is a symmetric band matrix with lower bandwidth KL + // and upper bandwidth KU and with the only the upper + // half stored. + if( LAPACKE_dsb_nancheck( matrix_layout, 'U', n, ku, a, lda ) ) { + return -9; + } + break; + case 'Z': + // TYPE = 'Z' - A is a band matrix with lower bandwidth KL and upper + // bandwidth KU. See DGBTRF for storage details. + if( LAPACKE_dgb_nancheck( matrix_layout, n, n, kl, kl+ku, a, lda ) ) { + return -6; + } + break; + } +#endif + return LAPACKE_dlascl_work( matrix_layout, type, kl, ku, cfrom, cto, m, n, a, lda ); +} diff --git a/LAPACKE/src/lapacke_dlascl_work.c b/LAPACKE/src/lapacke_dlascl_work.c new file mode 100644 index 0000000..a98f3c8 --- /dev/null +++ b/LAPACKE/src/lapacke_dlascl_work.c @@ -0,0 +1,81 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native middle-level C interface to LAPACK function dlaswp +* Author: Intel Corporation +* Generated November, 2011 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_dlascl_work( int matrix_layout, char type, lapack_int kl, + lapack_int ku, double cfrom, double cto, + lapack_int m, lapack_int n, double* a, + lapack_int lda ) +{ + lapack_int info = 0; + if( matrix_layout == LAPACK_COL_MAJOR ) { + /* Call LAPACK function and adjust info */ + LAPACK_dlascl( &type, &kl, &ku, &cfrom, &cto, &m, &n, a, &lda, &info); + if( info < 0 ) { + info = info - 1; + } + } else if( matrix_layout == LAPACK_ROW_MAJOR ) { + lapack_int lda_t = MAX(1,lda); + double* a_t = NULL; + /* Check leading dimension(s) */ + if( lda < n ) { + info = -9; + LAPACKE_xerbla( "LAPACKE_dlascl_work", info ); + return info; + } + /* Allocate memory for temporary array(s) */ + a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) ); + if( a_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_0; + } + /* Transpose input matrices */ + LAPACKE_dge_trans( matrix_layout, lda, n, a, lda, a_t, lda_t ); + /* Call LAPACK function and adjust info */ + LAPACK_dlascl( &type, &kl, &ku, &cfrom, &cto, &m, &n, a_t, &lda_t, &info); + info = 0; /* LAPACK call is ok! */ + /* Transpose output matrices */ + LAPACKE_dge_trans( LAPACK_COL_MAJOR, lda, n, a_t, lda_t, a, lda ); + /* Release memory and exit */ + LAPACKE_free( a_t ); +exit_level_0: + if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_dlascl_work", info ); + } + } else { + info = -1; + LAPACKE_xerbla( "LAPACKE_dlascl_work", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_slascl.c b/LAPACKE/src/lapacke_slascl.c new file mode 100644 index 0000000..0d5bd95 --- /dev/null +++ b/LAPACKE/src/lapacke_slascl.c @@ -0,0 +1,97 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native high-level C interface to LAPACK function slaswp +* Author: Intel Corporation +* Generated November, 2011 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_slascl( int matrix_layout, char type, lapack_int kl, + lapack_int ku, float cfrom, float cto, + lapack_int m, lapack_int n, float* a, + lapack_int lda ) +{ + if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { + LAPACKE_xerbla( "LAPACKE_slascl", -1 ); + return -1; + } +#ifndef LAPACK_DISABLE_NAN_CHECK + /* Optionally check input matrices for NaNs */ + switch (type) { + case 'G': + if( LAPACKE_sge_nancheck( matrix_layout, lda, n, a, lda ) ) { + return -9; + } + break; + case 'L': + // TYPE = 'L' - lower triangular matrix. + if( LAPACKE_str_nancheck( matrix_layout, 'L', 'N', n, a, lda ) ) { + return -9; + } + break; + case 'U': + // TYPE = 'U' - upper triangular matrix + if( LAPACKE_str_nancheck( matrix_layout, 'U', 'N', n, a, lda ) ) { + return -9; + } + break; + case 'H': + // TYPE = 'H' - upper Hessenberg matrix + if( LAPACKE_shs_nancheck( matrix_layout, n, a, lda ) ) { + return -9; + } + break; + case 'B': + // TYPE = 'B' - A is a symmetric band matrix with lower bandwidth KL + // and upper bandwidth KU and with the only the lower + // half stored. + if( LAPACKE_ssb_nancheck( matrix_layout, 'L', n, kl, a, lda ) ) { + return -9; + } + break; + case 'Q': + // TYPE = 'Q' - A is a symmetric band matrix with lower bandwidth KL + // and upper bandwidth KU and with the only the upper + // half stored. + if( LAPACKE_ssb_nancheck( matrix_layout, 'U', n, ku, a, lda ) ) { + return -9; + } + break; + case 'Z': + // TYPE = 'Z' - A is a band matrix with lower bandwidth KL and upper + // bandwidth KU. See DGBTRF for storage details. + if( LAPACKE_sgb_nancheck( matrix_layout, n, n, kl, kl+ku, a, lda ) ) { + return -6; + } + break; + } +#endif + return LAPACKE_slascl_work( matrix_layout, type, kl, ku, cfrom, cto, m, n, a, lda ); +} diff --git a/LAPACKE/src/lapacke_slascl_work.c b/LAPACKE/src/lapacke_slascl_work.c new file mode 100644 index 0000000..4abb59c --- /dev/null +++ b/LAPACKE/src/lapacke_slascl_work.c @@ -0,0 +1,81 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native middle-level C interface to LAPACK function slaswp +* Author: Intel Corporation +* Generated November, 2011 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_slascl_work( int matrix_layout, char type, lapack_int kl, + lapack_int ku, float cfrom, float cto, + lapack_int m, lapack_int n, float* a, + lapack_int lda ) +{ + lapack_int info = 0; + if( matrix_layout == LAPACK_COL_MAJOR ) { + /* Call LAPACK function and adjust info */ + LAPACK_slascl( &type, &kl, &ku, &cfrom, &cto, &m, &n, a, &lda, &info); + if( info < 0 ) { + info = info - 1; + } + } else if( matrix_layout == LAPACK_ROW_MAJOR ) { + lapack_int lda_t = MAX(1,lda); + float* a_t = NULL; + /* Check leading dimension(s) */ + if( lda < n ) { + info = -9; + LAPACKE_xerbla( "LAPACKE_slascl_work", info ); + return info; + } + /* Allocate memory for temporary array(s) */ + a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) ); + if( a_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_0; + } + /* Transpose input matrices */ + LAPACKE_sge_trans( matrix_layout, lda, n, a, lda, a_t, lda_t ); + /* Call LAPACK function and adjust info */ + LAPACK_slascl( &type, &kl, &ku, &cfrom, &cto, &m, &n, a_t, &lda_t, &info); + info = 0; /* LAPACK call is ok! */ + /* Transpose output matrices */ + LAPACKE_sge_trans( LAPACK_COL_MAJOR, lda, n, a_t, lda_t, a, lda ); + /* Release memory and exit */ + LAPACKE_free( a_t ); +exit_level_0: + if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_slascl_work", info ); + } + } else { + info = -1; + LAPACKE_xerbla( "LAPACKE_slascl_work", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_zlascl.c b/LAPACKE/src/lapacke_zlascl.c new file mode 100644 index 0000000..500a366 --- /dev/null +++ b/LAPACKE/src/lapacke_zlascl.c @@ -0,0 +1,97 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native high-level C interface to LAPACK function dlaswp +* Author: Intel Corporation +* Generated November, 2011 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_zlascl( int matrix_layout, char type, lapack_int kl, + lapack_int ku, double cfrom, double cto, + lapack_int m, lapack_int n, lapack_complex_double* a, + lapack_int lda ) +{ + if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { + LAPACKE_xerbla( "LAPACKE_zlascl", -1 ); + return -1; + } +#ifndef LAPACK_zISABLE_NAN_CHECK + /* Optionally check input matrices for NaNs */ + switch (type) { + case 'G': + if( LAPACKE_zge_nancheck( matrix_layout, lda, n, a, lda ) ) { + return -9; + } + break; + case 'L': + // TYPE = 'L' - lower triangular matrix. + if( LAPACKE_ztr_nancheck( matrix_layout, 'L', 'N', n, a, lda ) ) { + return -9; + } + break; + case 'U': + // TYPE = 'U' - upper triangular matrix + if( LAPACKE_ztr_nancheck( matrix_layout, 'U', 'N', n, a, lda ) ) { + return -9; + } + break; + case 'H': + // TYPE = 'H' - upper Hessenberg matrix + if( LAPACKE_zhs_nancheck( matrix_layout, n, a, lda ) ) { + return -9; + } + break; + case 'B': + // TYPE = 'B' - A is a symmetric band matrix with lower bandwidth KL + // and upper bandwidth KU and with the only the lower + // half stored. + if( LAPACKE_zsb_nancheck( matrix_layout, 'L', n, kl, a, lda ) ) { + return -9; + } + break; + case 'Q': + // TYPE = 'Q' - A is a symmetric band matrix with lower bandwidth KL + // and upper bandwidth KU and with the only the upper + // half stored. + if( LAPACKE_zsb_nancheck( matrix_layout, 'U', n, ku, a, lda ) ) { + return -9; + } + break; + case 'Z': + // TYPE = 'Z' - A is a band matrix with lower bandwidth KL and upper + // bandwidth KU. See DGBTRF for storage details. + if( LAPACKE_zgb_nancheck( matrix_layout, n, n, kl, kl+ku, a, lda ) ) { + return -6; + } + break; + } +#endif + return LAPACKE_zlascl_work( matrix_layout, type, kl, ku, cfrom, cto, m, n, a, lda ); +} diff --git a/LAPACKE/src/lapacke_zlascl_work.c b/LAPACKE/src/lapacke_zlascl_work.c new file mode 100644 index 0000000..d8a76a8 --- /dev/null +++ b/LAPACKE/src/lapacke_zlascl_work.c @@ -0,0 +1,82 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native middle-level C interface to LAPACK function dlaswp +* Author: Intel Corporation +* Generated November, 2011 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_zlascl_work( int matrix_layout, char type, lapack_int kl, + lapack_int ku, double cfrom, double cto, + lapack_int m, lapack_int n, lapack_complex_double* a, + lapack_int lda ) +{ + lapack_int info = 0; + if( matrix_layout == LAPACK_COL_MAJOR ) { + /* Call LAPACK function and adjust info */ + LAPACK_zlascl( &type, &kl, &ku, &cfrom, &cto, &m, &n, a, &lda, &info); + if( info < 0 ) { + info = info - 1; + } + } else if( matrix_layout == LAPACK_ROW_MAJOR ) { + lapack_int lda_t = MAX(1,lda); + lapack_complex_double* a_t = NULL; + /* Check leading dimension(s) */ + if( lda < n ) { + info = -9; + LAPACKE_xerbla( "LAPACKE_zlascl_work", info ); + return info; + } + /* Allocate memory for temporary array(s) */ + a_t = (lapack_complex_double*) + LAPACKE_malloc( sizeof(lapack_complex_double) * lda_t * MAX(1,n) ); + if( a_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_0; + } + /* Transpose input matrices */ + LAPACKE_zge_trans( matrix_layout, lda, n, a, lda, a_t, lda_t ); + /* Call LAPACK function and adjust info */ + LAPACK_zlascl( &type, &kl, &ku, &cfrom, &cto, &m, &n, a_t, &lda_t, &info); + info = 0; /* LAPACK call is ok! */ + /* Transpose output matrices */ + LAPACKE_zge_trans( LAPACK_COL_MAJOR, lda, n, a_t, lda_t, a, lda ); + /* Release memory and exit */ + LAPACKE_free( a_t ); +exit_level_0: + if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_zlascl_work", info ); + } + } else { + info = -1; + LAPACKE_xerbla( "LAPACKE_zlascl_work", info ); + } + return info; +}