diff --git a/frame/base/noopt/bli_dlamch.c b/frame/base/noopt/bli_dlamch.c index f3b101da7..c17b9ad0f 100644 --- a/frame/base/noopt/bli_dlamch.c +++ b/frame/base/noopt/bli_dlamch.c @@ -7,8 +7,6 @@ extern "C" { #endif #include "blis.h" -#include "bli_f2c.h" -#include "stdio.h" double bli_pow_di( doublereal* a, integer* n ); diff --git a/frame/base/noopt/bli_lsame.c b/frame/base/noopt/bli_lsame.c index a39dfda13..82d360db0 100644 --- a/frame/base/noopt/bli_lsame.c +++ b/frame/base/noopt/bli_lsame.c @@ -7,7 +7,6 @@ extern "C" { #endif #include "blis.h" -#include "bli_f2c.h" logical bli_lsame(character *ca, character *cb, ftnlen ca_len, ftnlen cb_len) { diff --git a/frame/base/noopt/bli_slamch.c b/frame/base/noopt/bli_slamch.c index d6da05501..c093f7deb 100644 --- a/frame/base/noopt/bli_slamch.c +++ b/frame/base/noopt/bli_slamch.c @@ -7,8 +7,6 @@ extern "C" { #endif #include "blis.h" -#include "bli_f2c.h" -#include "stdio.h" double bli_pow_ri( real* a, integer* n ); diff --git a/frame/compat/bla_gemm.c b/frame/compat/bla_gemm.c index c27751f0e..a37c56eba 100644 --- a/frame/compat/bla_gemm.c +++ b/frame/compat/bla_gemm.c @@ -60,6 +60,18 @@ void PASTEF77(ch,blasname)( \ inc_t rs_a, cs_a; \ inc_t rs_b, cs_b; \ inc_t rs_c, cs_c; \ +\ + /* Perform BLAS parameter checking. */ \ + PASTEBLACHK(blasname)( MKSTR(ch), \ + MKSTR(blasname), \ + transa, \ + transb, \ + m, \ + n, \ + k, \ + lda, \ + ldb, \ + ldc ); \ \ /* Map BLAS chars to their corresponding BLIS enumerated type value. */ \ bli_param_map_netlib_to_blis_trans( *transa, &blis_transa ); \ diff --git a/frame/compat/bla_gemv.c b/frame/compat/bla_gemv.c index 3c9c4bb68..0678cc801 100644 --- a/frame/compat/bla_gemv.c +++ b/frame/compat/bla_gemv.c @@ -60,6 +60,16 @@ void PASTEF77(ch,blasname)( \ inc_t incx0; \ inc_t incy0; \ inc_t rs_a, cs_a; \ +\ + /* Perform BLAS parameter checking. */ \ + PASTEBLACHK(blasname)( MKSTR(ch), \ + MKSTR(blasname), \ + transa, \ + m, \ + n, \ + lda, \ + incx, \ + incy ); \ \ /* Map BLAS chars to their corresponding BLIS enumerated type value. */ \ bli_param_map_netlib_to_blis_trans( *transa, &blis_transa ); \ diff --git a/frame/compat/bla_ger.c b/frame/compat/bla_ger.c index 9c4dfc983..625f1e7ff 100644 --- a/frame/compat/bla_ger.c +++ b/frame/compat/bla_ger.c @@ -56,6 +56,15 @@ void PASTEF772(chxy,blasname,chc)( \ inc_t incx0; \ inc_t incy0; \ inc_t rs_a, cs_a; \ +\ + /* Perform BLAS parameter checking. */ \ + PASTEBLACHK(blasname)( MKSTR(ch), \ + MKSTR(blasname), \ + m, \ + n, \ + incx, \ + incy, \ + lda ); \ \ /* Convert negative values of m and n to zero. */ \ bli_convert_blas_dim1( *m, m0 ); \ diff --git a/frame/compat/bla_hemm.c b/frame/compat/bla_hemm.c index 76902e9b2..81b0bf7e2 100644 --- a/frame/compat/bla_hemm.c +++ b/frame/compat/bla_hemm.c @@ -59,6 +59,17 @@ void PASTEF77(ch,blasname)( \ inc_t rs_a, cs_a; \ inc_t rs_b, cs_b; \ inc_t rs_c, cs_c; \ +\ + /* Perform BLAS parameter checking. */ \ + PASTEBLACHK(blasname)( MKSTR(ch), \ + MKSTR(blasname), \ + side, \ + uploa, \ + m, \ + n, \ + lda, \ + ldb, \ + ldc ); \ \ /* Map BLAS chars to their corresponding BLIS enumerated type value. */ \ bli_param_map_netlib_to_blis_side( *side, &blis_side ); \ diff --git a/frame/compat/bla_hemv.c b/frame/compat/bla_hemv.c index 795705f37..f77c0c0a9 100644 --- a/frame/compat/bla_hemv.c +++ b/frame/compat/bla_hemv.c @@ -58,6 +58,15 @@ void PASTEF77(ch,blasname)( \ inc_t incx0; \ inc_t incy0; \ inc_t rs_a, cs_a; \ +\ + /* Perform BLAS parameter checking. */ \ + PASTEBLACHK(blasname)( MKSTR(ch), \ + MKSTR(blasname), \ + uploa, \ + m, \ + lda, \ + incx, \ + incy ); \ \ /* Map BLAS chars to their corresponding BLIS enumerated type value. */ \ bli_param_map_netlib_to_blis_uplo( *uploa, &blis_uploa ); \ diff --git a/frame/compat/bla_her.c b/frame/compat/bla_her.c index 5220cb598..55d55eee1 100644 --- a/frame/compat/bla_her.c +++ b/frame/compat/bla_her.c @@ -54,6 +54,14 @@ void PASTEF77(ch,blasname)( \ ftype* x0; \ inc_t incx0; \ inc_t rs_a, cs_a; \ +\ + /* Perform BLAS parameter checking. */ \ + PASTEBLACHK(blasname)( MKSTR(ch), \ + MKSTR(blasname), \ + uploa, \ + m, \ + incx, \ + lda ); \ \ /* Map BLAS chars to their corresponding BLIS enumerated type value. */ \ bli_param_map_netlib_to_blis_uplo( *uploa, &blis_uploa ); \ diff --git a/frame/compat/bla_her2.c b/frame/compat/bla_her2.c index 00e71dee0..945dcc12b 100644 --- a/frame/compat/bla_her2.c +++ b/frame/compat/bla_her2.c @@ -57,6 +57,15 @@ void PASTEF77(ch,blasname)( \ inc_t incx0; \ inc_t incy0; \ inc_t rs_a, cs_a; \ +\ + /* Perform BLAS parameter checking. */ \ + PASTEBLACHK(blasname)( MKSTR(ch), \ + MKSTR(blasname), \ + uploa, \ + m, \ + incx, \ + incy, \ + lda ); \ \ /* Map BLAS chars to their corresponding BLIS enumerated type value. */ \ bli_param_map_netlib_to_blis_uplo( *uploa, &blis_uploa ); \ diff --git a/frame/compat/bla_her2k.c b/frame/compat/bla_her2k.c index 1fbdfc550..a14507bbf 100644 --- a/frame/compat/bla_her2k.c +++ b/frame/compat/bla_her2k.c @@ -59,6 +59,17 @@ void PASTEF77(ch,blasname)( \ inc_t rs_a, cs_a; \ inc_t rs_b, cs_b; \ inc_t rs_c, cs_c; \ +\ + /* Perform BLAS parameter checking. */ \ + PASTEBLACHK(blasname)( MKSTR(ch), \ + MKSTR(blasname), \ + uploc, \ + transa, \ + m, \ + k, \ + lda, \ + ldb, \ + ldc ); \ \ /* Map BLAS chars to their corresponding BLIS enumerated type value. */ \ bli_param_map_netlib_to_blis_uplo( *uploc, &blis_uploc ); \ diff --git a/frame/compat/bla_herk.c b/frame/compat/bla_herk.c index c71aa0590..a99f928de 100644 --- a/frame/compat/bla_herk.c +++ b/frame/compat/bla_herk.c @@ -57,6 +57,16 @@ void PASTEF77(ch,blasname)( \ dim_t m0, k0; \ inc_t rs_a, cs_a; \ inc_t rs_c, cs_c; \ +\ + /* Perform BLAS parameter checking. */ \ + PASTEBLACHK(blasname)( MKSTR(ch), \ + MKSTR(blasname), \ + uploc, \ + transa, \ + m, \ + k, \ + lda, \ + ldc ); \ \ /* Map BLAS chars to their corresponding BLIS enumerated type value. */ \ bli_param_map_netlib_to_blis_uplo( *uploc, &blis_uploc ); \ diff --git a/frame/compat/bla_symm.c b/frame/compat/bla_symm.c index 46bd02ea1..7178a0e86 100644 --- a/frame/compat/bla_symm.c +++ b/frame/compat/bla_symm.c @@ -59,6 +59,17 @@ void PASTEF77(ch,blasname)( \ inc_t rs_a, cs_a; \ inc_t rs_b, cs_b; \ inc_t rs_c, cs_c; \ +\ + /* Perform BLAS parameter checking. */ \ + PASTEBLACHK(blasname)( MKSTR(ch), \ + MKSTR(blasname), \ + side, \ + uploa, \ + m, \ + n, \ + lda, \ + ldb, \ + ldc ); \ \ /* Map BLAS chars to their corresponding BLIS enumerated type value. */ \ bli_param_map_netlib_to_blis_side( *side, &blis_side ); \ diff --git a/frame/compat/bla_symv.c b/frame/compat/bla_symv.c index 8a1328c48..de8472490 100644 --- a/frame/compat/bla_symv.c +++ b/frame/compat/bla_symv.c @@ -58,6 +58,15 @@ void PASTEF77(ch,blasname)( \ inc_t incx0; \ inc_t incy0; \ inc_t rs_a, cs_a; \ +\ + /* Perform BLAS parameter checking. */ \ + PASTEBLACHK(blasname)( MKSTR(ch), \ + MKSTR(blasname), \ + uploa, \ + m, \ + lda, \ + incx, \ + incy ); \ \ /* Map BLAS chars to their corresponding BLIS enumerated type value. */ \ bli_param_map_netlib_to_blis_uplo( *uploa, &blis_uploa ); \ diff --git a/frame/compat/bla_syr.c b/frame/compat/bla_syr.c index 3ec541b0f..4899e7869 100644 --- a/frame/compat/bla_syr.c +++ b/frame/compat/bla_syr.c @@ -54,6 +54,14 @@ void PASTEF77(ch,blasname)( \ ftype* x0; \ inc_t incx0; \ inc_t rs_a, cs_a; \ +\ + /* Perform BLAS parameter checking. */ \ + PASTEBLACHK(blasname)( MKSTR(ch), \ + MKSTR(blasname), \ + uploa, \ + m, \ + incx, \ + lda ); \ \ /* Map BLAS chars to their corresponding BLIS enumerated type value. */ \ bli_param_map_netlib_to_blis_uplo( *uploa, &blis_uploa ); \ diff --git a/frame/compat/bla_syr2.c b/frame/compat/bla_syr2.c index 3e71fb034..eaa764400 100644 --- a/frame/compat/bla_syr2.c +++ b/frame/compat/bla_syr2.c @@ -57,6 +57,15 @@ void PASTEF77(ch,blasname)( \ inc_t incx0; \ inc_t incy0; \ inc_t rs_a, cs_a; \ +\ + /* Perform BLAS parameter checking. */ \ + PASTEBLACHK(blasname)( MKSTR(ch), \ + MKSTR(blasname), \ + uploa, \ + m, \ + incx, \ + incy, \ + lda ); \ \ /* Map BLAS chars to their corresponding BLIS enumerated type value. */ \ bli_param_map_netlib_to_blis_uplo( *uploa, &blis_uploa ); \ diff --git a/frame/compat/bla_syr2k.c b/frame/compat/bla_syr2k.c index bcd073159..4e017f8ce 100644 --- a/frame/compat/bla_syr2k.c +++ b/frame/compat/bla_syr2k.c @@ -59,6 +59,17 @@ void PASTEF77(ch,blasname)( \ inc_t rs_a, cs_a; \ inc_t rs_b, cs_b; \ inc_t rs_c, cs_c; \ +\ + /* Perform BLAS parameter checking. */ \ + PASTEBLACHK(blasname)( MKSTR(ch), \ + MKSTR(blasname), \ + uploc, \ + transa, \ + m, \ + k, \ + lda, \ + ldb, \ + ldc ); \ \ /* Map BLAS chars to their corresponding BLIS enumerated type value. */ \ bli_param_map_netlib_to_blis_uplo( *uploc, &blis_uploc ); \ diff --git a/frame/compat/bla_syrk.c b/frame/compat/bla_syrk.c index 1d0b9e32f..6ed24a2df 100644 --- a/frame/compat/bla_syrk.c +++ b/frame/compat/bla_syrk.c @@ -57,6 +57,16 @@ void PASTEF77(ch,blasname)( \ dim_t m0, k0; \ inc_t rs_a, cs_a; \ inc_t rs_c, cs_c; \ +\ + /* Perform BLAS parameter checking. */ \ + PASTEBLACHK(blasname)( MKSTR(ch), \ + MKSTR(blasname), \ + uploc, \ + transa, \ + m, \ + k, \ + lda, \ + ldc ); \ \ /* Map BLAS chars to their corresponding BLIS enumerated type value. */ \ bli_param_map_netlib_to_blis_uplo( *uploc, &blis_uploc ); \ diff --git a/frame/compat/bla_trmm.c b/frame/compat/bla_trmm.c index df216b4c9..bc28cd83a 100644 --- a/frame/compat/bla_trmm.c +++ b/frame/compat/bla_trmm.c @@ -60,6 +60,18 @@ void PASTEF77(ch,blasname)( \ dim_t m0, n0; \ inc_t rs_a, cs_a; \ inc_t rs_b, cs_b; \ +\ + /* Perform BLAS parameter checking. */ \ + PASTEBLACHK(blasname)( MKSTR(ch), \ + MKSTR(blasname), \ + side, \ + uploa, \ + transa, \ + diaga, \ + m, \ + n, \ + lda, \ + ldb ); \ \ /* Map BLAS chars to their corresponding BLIS enumerated type value. */ \ bli_param_map_netlib_to_blis_side( *side, &blis_side ); \ diff --git a/frame/compat/bla_trmv.c b/frame/compat/bla_trmv.c index b7db63dba..bbbd8e985 100644 --- a/frame/compat/bla_trmv.c +++ b/frame/compat/bla_trmv.c @@ -58,6 +58,16 @@ void PASTEF77(ch,blasname)( \ inc_t incx0; \ inc_t rs_a, cs_a; \ ftype one; \ +\ + /* Perform BLAS parameter checking. */ \ + PASTEBLACHK(blasname)( MKSTR(ch), \ + MKSTR(blasname), \ + uploa, \ + transa, \ + diaga, \ + m, \ + lda, \ + incx ); \ \ /* Initialize a local scalar since we don't assume that the global scalar constants have been initialized yet. */ \ diff --git a/frame/compat/bla_trsm.c b/frame/compat/bla_trsm.c index d0facdeeb..998bacb31 100644 --- a/frame/compat/bla_trsm.c +++ b/frame/compat/bla_trsm.c @@ -60,6 +60,18 @@ void PASTEF77(ch,blasname)( \ dim_t m0, n0; \ inc_t rs_a, cs_a; \ inc_t rs_b, cs_b; \ +\ + /* Perform BLAS parameter checking. */ \ + PASTEBLACHK(blasname)( MKSTR(ch), \ + MKSTR(blasname), \ + side, \ + uploa, \ + transa, \ + diaga, \ + m, \ + n, \ + lda, \ + ldb ); \ \ /* Map BLAS chars to their corresponding BLIS enumerated type value. */ \ bli_param_map_netlib_to_blis_side( *side, &blis_side ); \ diff --git a/frame/compat/bla_trsv.c b/frame/compat/bla_trsv.c index d8d5c1a08..5df81a8f2 100644 --- a/frame/compat/bla_trsv.c +++ b/frame/compat/bla_trsv.c @@ -58,6 +58,16 @@ void PASTEF77(ch,blasname)( \ inc_t incx0; \ inc_t rs_a, cs_a; \ ftype one; \ +\ + /* Perform BLAS parameter checking. */ \ + PASTEBLACHK(blasname)( MKSTR(ch), \ + MKSTR(blasname), \ + uploa, \ + transa, \ + diaga, \ + m, \ + lda, \ + incx ); \ \ /* Initialize a local scalar since we don't assume that the global scalar constants have been initialized yet. */ \ diff --git a/frame/compat/bli_blas.h b/frame/compat/bli_blas.h index 72c0161b8..37d9f449c 100644 --- a/frame/compat/bli_blas.h +++ b/frame/compat/bli_blas.h @@ -32,7 +32,33 @@ */ -// -- Level-1 BLAS -- + +#ifdef BLIS_ENABLE_BLAS2BLIS + + +// -- System headers needed by BLAS compatibility layer -- + +#include // for toupper(), used in xerbla() + + +// -- Constants -- + +#define BLIS_MAX_BLAS_FUNC_STR_LENGTH (6+1) + + +// -- Utility macros -- + +#include "bla_r_cnjg.h" +#include "bla_d_cnjg.h" +#include "bla_r_imag.h" +#include "bla_d_imag.h" +#include "bla_c_div.h" +#include "bla_z_div.h" +#include "bla_lsame.h" +#include "bla_xerbla.h" + + +// -- Level-1 BLAS prototypes -- #include "bla_amax.h" #include "bla_asum.h" @@ -40,15 +66,15 @@ #include "bla_copy.h" #include "bla_dot.h" #include "bla_nrm2.h" -//#include "bla_rot.h" -//#include "bla_rotg.h" -//#include "bla_rotm.h" -//#include "bla_rotmg.h" +#include "bla_rot.h" +#include "bla_rotg.h" +#include "bla_rotm.h" +#include "bla_rotmg.h" #include "bla_scal.h" #include "bla_swap.h" -// -- Level-2 BLAS -- +// -- Level-2 BLAS prototypes -- // dense @@ -63,27 +89,38 @@ #include "bla_trmv.h" #include "bla_trsv.h" +#include "bla_gemv_check.h" +#include "bla_ger_check.h" +#include "bla_hemv_check.h" +#include "bla_her_check.h" +#include "bla_her2_check.h" +#include "bla_symv_check.h" +#include "bla_syr_check.h" +#include "bla_syr2_check.h" +#include "bla_trmv_check.h" +#include "bla_trsv_check.h" + // packed -//#include "bla_hpmv.h" -//#include "bla_hpr.h" -//#include "bla_hpr2.h" -//#include "bla_spmv.h" -//#include "bla_spr.h" -//#include "bla_spr2.h" -//#include "bla_tpmv.h" -//#include "bla_tpsv.h" +#include "bla_hpmv.h" +#include "bla_hpr.h" +#include "bla_hpr2.h" +#include "bla_spmv.h" +#include "bla_spr.h" +#include "bla_spr2.h" +#include "bla_tpmv.h" +#include "bla_tpsv.h" // banded -//#include "bla_gbmv.h" -//#include "bla_hbmv.h" -//#include "bla_sbmv.h" -//#include "bla_tbmv.h" -//#include "bla_tbsv.h" +#include "bla_gbmv.h" +#include "bla_hbmv.h" +#include "bla_sbmv.h" +#include "bla_tbmv.h" +#include "bla_tbsv.h" -// -- Level-3 BLAS -- +// -- Level-3 BLAS prototypes -- #include "bla_gemm.h" #include "bla_hemm.h" @@ -95,4 +132,15 @@ #include "bla_trmm.h" #include "bla_trsm.h" +#include "bla_gemm_check.h" +#include "bla_hemm_check.h" +#include "bla_herk_check.h" +#include "bla_her2k_check.h" +#include "bla_symm_check.h" +#include "bla_syrk_check.h" +#include "bla_syr2k_check.h" +#include "bla_trmm_check.h" +#include "bla_trsm_check.h" + +#endif // BLIS_ENABLE_BLAS2BLIS diff --git a/frame/compat/check/bla_gemm_check.c b/frame/compat/check/bla_gemm_check.c new file mode 100644 index 000000000..f5cb309b8 --- /dev/null +++ b/frame/compat/check/bla_gemm_check.c @@ -0,0 +1,96 @@ +/* + + BLIS + An object-based framework for developing high-performance BLAS-like + libraries. + + Copyright (C) 2013, The University of Texas + + 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 The University of Texas 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 + HOLDER 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. + +*/ + +#include "blis.h" + +#ifdef BLIS_ENABLE_BLIS2BLAS + +void bla_gemm_check( char* dt_str, + char* op_str, + f77_char* transa, + f77_char* transb, + f77_int* m, + f77_int* n, + f77_int* k, + f77_int* lda, + f77_int* ldb, + f77_int* ldc ) +{ + f77_int info = 0; + f77_int nota, notb; + f77_int conja, conjb; + f77_int ta, tb; + f77_int nrowa, nrowb; + f77_int ncola; + + nota = PASTEF770(lsame)( transa, "N", (ftnlen)1, (ftnlen)1 ); + notb = PASTEF770(lsame)( transb, "N", (ftnlen)1, (ftnlen)1 ); + conja = PASTEF770(lsame)( transa, "C", (ftnlen)1, (ftnlen)1 ); + conjb = PASTEF770(lsame)( transb, "C", (ftnlen)1, (ftnlen)1 ); + ta = PASTEF770(lsame)( transa, "T", (ftnlen)1, (ftnlen)1 ); + tb = PASTEF770(lsame)( transb, "T", (ftnlen)1, (ftnlen)1 ); + + if ( nota ) { nrowa = *m; ncola = *k; } + else { nrowa = *k; ncola = *m; } + if ( notb ) { nrowb = *k; } + else { nrowb = *n; } + + if ( !nota && !conja && !ta ) + info = 1; + else if ( !notb && !conjb && !tb ) + info = 2; + else if ( *m < 0 ) + info = 3; + else if ( *n < 0 ) + info = 4; + else if ( *k < 0 ) + info = 5; + else if ( *lda < bli_max( 1, nrowa ) ) + info = 8; + else if ( *ldb < bli_max( 1, nrowb ) ) + info = 10; + else if ( *ldc < bli_max( 1, *m ) ) + info = 13; + + if ( info != 0 ) + { + char func_str[ BLIS_MAX_BLAS_FUNC_STR_LENGTH ]; + + sprintf( func_str, "%s%-5s", dt_str, op_str ); + + PASTEF770(xerbla)( func_str, &info, (ftnlen)6 ); + } +} + +#endif diff --git a/frame/compat/check/bla_gemm_check.h b/frame/compat/check/bla_gemm_check.h new file mode 100644 index 000000000..4078f6c06 --- /dev/null +++ b/frame/compat/check/bla_gemm_check.h @@ -0,0 +1,48 @@ +/* + + BLIS + An object-based framework for developing high-performance BLAS-like + libraries. + + Copyright (C) 2013, The University of Texas + + 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 The University of Texas 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 + HOLDER 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. + +*/ + +#ifdef BLIS_ENABLE_BLAS2BLIS + +void bla_gemm_check( char* dt_str, + char* op_str, + f77_char* transa, + f77_char* transb, + f77_int* m, + f77_int* n, + f77_int* k, + f77_int* lda, + f77_int* ldb, + f77_int* ldc ); + +#endif diff --git a/frame/compat/check/bla_gemv_check.c b/frame/compat/check/bla_gemv_check.c new file mode 100644 index 000000000..711074d36 --- /dev/null +++ b/frame/compat/check/bla_gemv_check.c @@ -0,0 +1,78 @@ +/* + + BLIS + An object-based framework for developing high-performance BLAS-like + libraries. + + Copyright (C) 2013, The University of Texas + + 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 The University of Texas 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 + HOLDER 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. + +*/ + +#include "blis.h" + +#ifdef BLIS_ENABLE_BLIS2BLAS + +void bla_gemv_check( char* dt_str, + char* op_str, + f77_char* transa, + f77_int* m, + f77_int* n, + f77_int* lda, + f77_int* incx, + f77_int* incy ) +{ + f77_int info = 0; + f77_int nota, ta, conja; + + nota = PASTEF770(lsame)( transa, "N", (ftnlen)1, (ftnlen)1 ); + ta = PASTEF770(lsame)( transa, "T", (ftnlen)1, (ftnlen)1 ); + conja = PASTEF770(lsame)( transa, "C", (ftnlen)1, (ftnlen)1 ); + + if ( !nota && !ta && !conja ) + info = 1; + else if ( *m < 0 ) + info = 2; + else if ( *n < 0 ) + info = 3; + else if ( *lda < bli_max( 1, *m ) ) + info = 6; + else if ( *incx == 0 ) + info = 8; + else if ( *incy == 0 ) + info = 11; + + if ( info != 0 ) + { + char func_str[ BLIS_MAX_BLAS_FUNC_STR_LENGTH ]; + + sprintf( func_str, "%s%-5s", dt_str, op_str ); + + PASTEF770(xerbla)( func_str, &info, (ftnlen)6 ); + } +} + +#endif diff --git a/frame/compat/check/bla_gemv_check.h b/frame/compat/check/bla_gemv_check.h new file mode 100644 index 000000000..362cc85e8 --- /dev/null +++ b/frame/compat/check/bla_gemv_check.h @@ -0,0 +1,46 @@ +/* + + BLIS + An object-based framework for developing high-performance BLAS-like + libraries. + + Copyright (C) 2013, The University of Texas + + 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 The University of Texas 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 + HOLDER 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. + +*/ + +#ifdef BLIS_ENABLE_BLAS2BLIS + +void bla_gemv_check( char* dt_str, + char* op_str, + f77_char* transa, + f77_int* m, + f77_int* n, + f77_int* lda, + f77_int* incx, + f77_int* incy ); + +#endif diff --git a/frame/compat/check/bla_ger_check.c b/frame/compat/check/bla_ger_check.c new file mode 100644 index 000000000..0000e4902 --- /dev/null +++ b/frame/compat/check/bla_ger_check.c @@ -0,0 +1,70 @@ +/* + + BLIS + An object-based framework for developing high-performance BLAS-like + libraries. + + Copyright (C) 2013, The University of Texas + + 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 The University of Texas 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 + HOLDER 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. + +*/ + +#include "blis.h" + +#ifdef BLIS_ENABLE_BLIS2BLAS + +void bla_ger_check( char* dt_str, + char* op_str, + f77_int* m, + f77_int* n, + f77_int* lda, + f77_int* incx, + f77_int* incy ) +{ + f77_int info = 0; + + if ( *m < 0 ) + info = 1; + else if ( *n < 0 ) + info = 2; + else if ( *incx == 0 ) + info = 5; + else if ( *incy == 0 ) + info = 7; + else if ( *lda < bli_max( 1, *m ) ) + info = 9; + + if ( info != 0 ) + { + char func_str[ BLIS_MAX_BLAS_FUNC_STR_LENGTH ]; + + sprintf( func_str, "%s%-5s", dt_str, op_str ); + + PASTEF770(xerbla)( func_str, &info, (ftnlen)6 ); + } +} + +#endif diff --git a/frame/compat/check/bla_ger_check.h b/frame/compat/check/bla_ger_check.h new file mode 100644 index 000000000..81099fced --- /dev/null +++ b/frame/compat/check/bla_ger_check.h @@ -0,0 +1,45 @@ +/* + + BLIS + An object-based framework for developing high-performance BLAS-like + libraries. + + Copyright (C) 2013, The University of Texas + + 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 The University of Texas 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 + HOLDER 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. + +*/ + +#ifdef BLIS_ENABLE_BLAS2BLIS + +void bla_ger_check( char* dt_str, + char* op_str, + f77_int* m, + f77_int* n, + f77_int* lda, + f77_int* incx, + f77_int* incy ); + +#endif diff --git a/frame/compat/check/bla_hemm_check.c b/frame/compat/check/bla_hemm_check.c new file mode 100644 index 000000000..ad99e7ce0 --- /dev/null +++ b/frame/compat/check/bla_hemm_check.c @@ -0,0 +1,87 @@ +/* + + BLIS + An object-based framework for developing high-performance BLAS-like + libraries. + + Copyright (C) 2013, The University of Texas + + 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 The University of Texas 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 + HOLDER 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. + +*/ + +#include "blis.h" + +#ifdef BLIS_ENABLE_BLIS2BLAS + +void bla_hemm_check( char* dt_str, + char* op_str, + f77_char* sidea, + f77_char* uploa, + f77_int* m, + f77_int* n, + f77_int* lda, + f77_int* ldb, + f77_int* ldc ) +{ + f77_int info = 0; + f77_int left, right; + f77_int lower, upper; + f77_int nrowa; + + left = PASTEF770(lsame)( sidea, "L", (ftnlen)1, (ftnlen)1 ); + right = PASTEF770(lsame)( sidea, "R", (ftnlen)1, (ftnlen)1 ); + lower = PASTEF770(lsame)( uploa, "L", (ftnlen)1, (ftnlen)1 ); + upper = PASTEF770(lsame)( uploa, "U", (ftnlen)1, (ftnlen)1 ); + + if ( left ) { nrowa = *m } + else { nrowa = *n } + + if ( !left && !right ) + info = 1; + else if ( !lower && !upper ) + info = 2; + else if ( *m < 0 ) + info = 3; + else if ( *n < 0 ) + info = 4; + else if ( *lda < bli_max( 1, nrowa ) ) + info = 7; + else if ( *ldb < bli_max( 1, *m ) ) + info = 9; + else if ( *ldc < bli_max( 1, *m ) ) + info = 12; + + if ( info != 0 ) + { + char func_str[ BLIS_MAX_BLAS_FUNC_STR_LENGTH ]; + + sprintf( func_str, "%s%-5s", dt_str, op_str ); + + PASTEF770(xerbla)( func_str, &info, (ftnlen)6 ); + } +} + +#endif diff --git a/frame/compat/check/bla_hemm_check.h b/frame/compat/check/bla_hemm_check.h new file mode 100644 index 000000000..1e99a45c7 --- /dev/null +++ b/frame/compat/check/bla_hemm_check.h @@ -0,0 +1,47 @@ +/* + + BLIS + An object-based framework for developing high-performance BLAS-like + libraries. + + Copyright (C) 2013, The University of Texas + + 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 The University of Texas 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 + HOLDER 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. + +*/ + +#ifdef BLIS_ENABLE_BLAS2BLIS + +void bla_hemm_check( char* dt_str, + char* op_str, + f77_char* sidea, + f77_char* uploa, + f77_int* m, + f77_int* n, + f77_int* lda, + f77_int* ldb, + f77_int* ldc ); + +#endif diff --git a/frame/compat/check/bla_hemv_check.c b/frame/compat/check/bla_hemv_check.c new file mode 100644 index 000000000..dbff9ce8d --- /dev/null +++ b/frame/compat/check/bla_hemv_check.c @@ -0,0 +1,74 @@ +/* + + BLIS + An object-based framework for developing high-performance BLAS-like + libraries. + + Copyright (C) 2013, The University of Texas + + 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 The University of Texas 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 + HOLDER 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. + +*/ + +#include "blis.h" + +#ifdef BLIS_ENABLE_BLIS2BLAS + +void bla_hemv_check( char* dt_str, + char* op_str, + f77_char* uploa, + f77_int* m, + f77_int* lda, + f77_int* incx, + f77_int* incy ) +{ + f77_int info = 0; + f77_int lower, upper; + + lower = PASTEF770(lsame)( uploa, "L", (ftnlen)1, (ftnlen)1 ); + upper = PASTEF770(lsame)( uploa, "U", (ftnlen)1, (ftnlen)1 ); + + if ( !lower && !upper ) + info = 1; + else if ( *m < 0 ) + info = 2; + else if ( *lda < bli_max( 1, *m ) ) + info = 5; + else if ( *incx == 0 ) + info = 7; + else if ( *incy == 0 ) + info = 10; + + if ( info != 0 ) + { + char func_str[ BLIS_MAX_BLAS_FUNC_STR_LENGTH ]; + + sprintf( func_str, "%s%-5s", dt_str, op_str ); + + PASTEF770(xerbla)( func_str, &info, (ftnlen)6 ); + } +} + +#endif diff --git a/frame/compat/check/bla_hemv_check.h b/frame/compat/check/bla_hemv_check.h new file mode 100644 index 000000000..3eb971325 --- /dev/null +++ b/frame/compat/check/bla_hemv_check.h @@ -0,0 +1,45 @@ +/* + + BLIS + An object-based framework for developing high-performance BLAS-like + libraries. + + Copyright (C) 2013, The University of Texas + + 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 The University of Texas 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 + HOLDER 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. + +*/ + +#ifdef BLIS_ENABLE_BLAS2BLIS + +void bla_hemv_check( char* dt_str, + char* op_str, + f77_char* uploa, + f77_int* m, + f77_int* lda, + f77_int* incx, + f77_int* incy ); + +#endif diff --git a/frame/compat/check/bla_her2_check.c b/frame/compat/check/bla_her2_check.c new file mode 100644 index 000000000..beff198f1 --- /dev/null +++ b/frame/compat/check/bla_her2_check.c @@ -0,0 +1,74 @@ +/* + + BLIS + An object-based framework for developing high-performance BLAS-like + libraries. + + Copyright (C) 2013, The University of Texas + + 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 The University of Texas 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 + HOLDER 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. + +*/ + +#include "blis.h" + +#ifdef BLIS_ENABLE_BLIS2BLAS + +void bla_her2_check( char* dt_str, + char* op_str, + f77_char* uploc, + f77_int* m, + f77_int* incx, + f77_int* incy, + f77_int* lda ) +{ + f77_int info = 0; + f77_int lower, upper; + + lower = PASTEF770(lsame)( uploc, "L", (ftnlen)1, (ftnlen)1 ); + upper = PASTEF770(lsame)( uploc, "U", (ftnlen)1, (ftnlen)1 ); + + if ( !lower && !upper ) + info = 1; + else if ( *m < 0 ) + info = 2; + else if ( *incx == 0 ) + info = 5; + else if ( *incy == 0 ) + info = 7; + else if ( *lda < bli_max( 1, *m ) ) + info = 9; + + if ( info != 0 ) + { + char func_str[ BLIS_MAX_BLAS_FUNC_STR_LENGTH ]; + + sprintf( func_str, "%s%-5s", dt_str, op_str ); + + PASTEF770(xerbla)( func_str, &info, (ftnlen)6 ); + } +} + +#endif diff --git a/frame/compat/check/bla_her2_check.h b/frame/compat/check/bla_her2_check.h new file mode 100644 index 000000000..a737199f1 --- /dev/null +++ b/frame/compat/check/bla_her2_check.h @@ -0,0 +1,45 @@ +/* + + BLIS + An object-based framework for developing high-performance BLAS-like + libraries. + + Copyright (C) 2013, The University of Texas + + 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 The University of Texas 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 + HOLDER 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. + +*/ + +#ifdef BLIS_ENABLE_BLAS2BLIS + +void bla_her2_check( char* dt_str, + char* op_str, + f77_char* uploa, + f77_int* m, + f77_int* incx, + f77_int* incy, + f77_int* lda ); + +#endif diff --git a/frame/compat/check/bla_her2k_check.c b/frame/compat/check/bla_her2k_check.c new file mode 100644 index 000000000..9d783c4cb --- /dev/null +++ b/frame/compat/check/bla_her2k_check.c @@ -0,0 +1,87 @@ +/* + + BLIS + An object-based framework for developing high-performance BLAS-like + libraries. + + Copyright (C) 2013, The University of Texas + + 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 The University of Texas 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 + HOLDER 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. + +*/ + +#include "blis.h" + +#ifdef BLIS_ENABLE_BLIS2BLAS + +void bla_her2k_check( char* dt_str, + char* op_str, + f77_char* uploa, + f77_char* trans, + f77_int* m, + f77_int* k, + f77_int* lda, + f77_int* ldb, + f77_int* ldc ) +{ + f77_int info = 0; + f77_int nota, conja; + f77_int lower, upper; + f77_int nrowa; + + nota = PASTEF770(lsame)( trans, "N", (ftnlen)1, (ftnlen)1 ); + conja = PASTEF770(lsame)( trans, "C", (ftnlen)1, (ftnlen)1 ); + lower = PASTEF770(lsame)( uploa, "L", (ftnlen)1, (ftnlen)1 ); + upper = PASTEF770(lsame)( uploa, "U", (ftnlen)1, (ftnlen)1 ); + + if ( nota ) { nrowa = *m } + else { nrowa = *k } + + if ( !lower && !upper ) + info = 1; + else if ( !nota && !conja ) + info = 2; + else if ( *m < 0 ) + info = 3; + else if ( *k < 0 ) + info = 4; + else if ( *lda < bli_max( 1, nrowa ) ) + info = 7; + else if ( *ldb < bli_max( 1, nrowa ) ) + info = 9; + else if ( *ldc < bli_max( 1, *m ) ) + info = 12; + + if ( info != 0 ) + { + char func_str[ BLIS_MAX_BLAS_FUNC_STR_LENGTH ]; + + sprintf( func_str, "%s%-5s", dt_str, op_str ); + + PASTEF770(xerbla)( func_str, &info, (ftnlen)6 ); + } +} + +#endif diff --git a/frame/compat/check/bla_her2k_check.h b/frame/compat/check/bla_her2k_check.h new file mode 100644 index 000000000..468a6b2e2 --- /dev/null +++ b/frame/compat/check/bla_her2k_check.h @@ -0,0 +1,47 @@ +/* + + BLIS + An object-based framework for developing high-performance BLAS-like + libraries. + + Copyright (C) 2013, The University of Texas + + 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 The University of Texas 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 + HOLDER 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. + +*/ + +#ifdef BLIS_ENABLE_BLAS2BLIS + +void bla_her2k_check( char* dt_str, + char* op_str, + f77_char* uploa, + f77_char* transa, + f77_int* m, + f77_int* k, + f77_int* lda, + f77_int* ldb, + f77_int* ldc ); + +#endif diff --git a/frame/compat/check/bla_her_check.c b/frame/compat/check/bla_her_check.c new file mode 100644 index 000000000..60812a69d --- /dev/null +++ b/frame/compat/check/bla_her_check.c @@ -0,0 +1,71 @@ +/* + + BLIS + An object-based framework for developing high-performance BLAS-like + libraries. + + Copyright (C) 2013, The University of Texas + + 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 The University of Texas 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 + HOLDER 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. + +*/ + +#include "blis.h" + +#ifdef BLIS_ENABLE_BLIS2BLAS + +void bla_her_check( char* dt_str, + char* op_str, + f77_char* uploc, + f77_int* m, + f77_int* incx, + f77_int* lda ) +{ + f77_int info = 0; + f77_int lower, upper; + + lower = PASTEF770(lsame)( uploc, "L", (ftnlen)1, (ftnlen)1 ); + upper = PASTEF770(lsame)( uploc, "U", (ftnlen)1, (ftnlen)1 ); + + if ( !lower && !upper ) + info = 1; + else if ( *m < 0 ) + info = 2; + else if ( *incx == 0 ) + info = 5; + else if ( *lda < bli_max( 1, *m ) ) + info = 7; + + if ( info != 0 ) + { + char func_str[ BLIS_MAX_BLAS_FUNC_STR_LENGTH ]; + + sprintf( func_str, "%s%-5s", dt_str, op_str ); + + PASTEF770(xerbla)( func_str, &info, (ftnlen)6 ); + } +} + +#endif diff --git a/frame/compat/check/bla_her_check.h b/frame/compat/check/bla_her_check.h new file mode 100644 index 000000000..991f23599 --- /dev/null +++ b/frame/compat/check/bla_her_check.h @@ -0,0 +1,44 @@ +/* + + BLIS + An object-based framework for developing high-performance BLAS-like + libraries. + + Copyright (C) 2013, The University of Texas + + 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 The University of Texas 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 + HOLDER 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. + +*/ + +#ifdef BLIS_ENABLE_BLAS2BLIS + +void bla_her_check( char* dt_str, + char* op_str, + f77_char* uploa, + f77_int* m, + f77_int* incx, + f77_int* lda ); + +#endif diff --git a/frame/compat/check/bla_herk_check.c b/frame/compat/check/bla_herk_check.c new file mode 100644 index 000000000..45f2c46d4 --- /dev/null +++ b/frame/compat/check/bla_herk_check.c @@ -0,0 +1,84 @@ +/* + + BLIS + An object-based framework for developing high-performance BLAS-like + libraries. + + Copyright (C) 2013, The University of Texas + + 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 The University of Texas 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 + HOLDER 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. + +*/ + +#include "blis.h" + +#ifdef BLIS_ENABLE_BLIS2BLAS + +void bla_herk_check( char* dt_str, + char* op_str, + f77_char* uploc, + f77_char* transa, + f77_int* m, + f77_int* k, + f77_int* lda, + f77_int* ldc ) +{ + f77_int info = 0; + f77_int nota, conja; + f77_int lower, upper; + f77_int nrowa; + + nota = PASTEF770(lsame)( transa, "N", (ftnlen)1, (ftnlen)1 ); + conja = PASTEF770(lsame)( transa, "C", (ftnlen)1, (ftnlen)1 ); + lower = PASTEF770(lsame)( uploc, "L", (ftnlen)1, (ftnlen)1 ); + upper = PASTEF770(lsame)( uploc, "U", (ftnlen)1, (ftnlen)1 ); + + if ( nota ) { nrowa = *m } + else { nrowa = *k } + + if ( !lower && !upper ) + info = 1; + else if ( !nota && !conja ) + info = 2; + else if ( *m < 0 ) + info = 3; + else if ( *k < 0 ) + info = 4; + else if ( *lda < bli_max( 1, nrowa ) ) + info = 7; + else if ( *ldc < bli_max( 1, *m ) ) + info = 10; + + if ( info != 0 ) + { + char func_str[ BLIS_MAX_BLAS_FUNC_STR_LENGTH ]; + + sprintf( func_str, "%s%-5s", dt_str, op_str ); + + PASTEF770(xerbla)( func_str, &info, (ftnlen)6 ); + } +} + +#endif diff --git a/frame/compat/check/bla_herk_check.h b/frame/compat/check/bla_herk_check.h new file mode 100644 index 000000000..5cf446c33 --- /dev/null +++ b/frame/compat/check/bla_herk_check.h @@ -0,0 +1,46 @@ +/* + + BLIS + An object-based framework for developing high-performance BLAS-like + libraries. + + Copyright (C) 2013, The University of Texas + + 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 The University of Texas 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 + HOLDER 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. + +*/ + +#ifdef BLIS_ENABLE_BLAS2BLIS + +void bla_herk_check( char* dt_str, + char* op_str, + f77_char* uploc, + f77_char* transa, + f77_int* m, + f77_int* k, + f77_int* lda, + f77_int* ldc ); + +#endif diff --git a/frame/compat/check/bla_symm_check.c b/frame/compat/check/bla_symm_check.c new file mode 100644 index 000000000..29e63a6ae --- /dev/null +++ b/frame/compat/check/bla_symm_check.c @@ -0,0 +1,60 @@ +/* + + BLIS + An object-based framework for developing high-performance BLAS-like + libraries. + + Copyright (C) 2013, The University of Texas + + 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 The University of Texas 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 + HOLDER 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. + +*/ + +#include "blis.h" + +#ifdef BLIS_ENABLE_BLIS2BLAS + +void bla_symm_check( char* dt_str, + char* op_str, + f77_char* sidea, + f77_char* uploa, + f77_int* m, + f77_int* n, + f77_int* lda, + f77_int* ldb, + f77_int* ldc ) +{ + bla_hemm_check( dt_str, + op_str, + sidea, + uploa, + m, + n, + lda, + ldb, + ldc ); +} + +#endif diff --git a/frame/compat/check/bla_symm_check.h b/frame/compat/check/bla_symm_check.h new file mode 100644 index 000000000..0ecf111d9 --- /dev/null +++ b/frame/compat/check/bla_symm_check.h @@ -0,0 +1,47 @@ +/* + + BLIS + An object-based framework for developing high-performance BLAS-like + libraries. + + Copyright (C) 2013, The University of Texas + + 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 The University of Texas 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 + HOLDER 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. + +*/ + +#ifdef BLIS_ENABLE_BLAS2BLIS + +void bla_symm_check( char* dt_str, + char* op_str, + f77_char* sidea, + f77_char* uploa, + f77_int* m, + f77_int* n, + f77_int* lda, + f77_int* ldb, + f77_int* ldc ); + +#endif diff --git a/frame/compat/check/bla_symv_check.c b/frame/compat/check/bla_symv_check.c new file mode 100644 index 000000000..c5f6ad6ee --- /dev/null +++ b/frame/compat/check/bla_symv_check.c @@ -0,0 +1,56 @@ +/* + + BLIS + An object-based framework for developing high-performance BLAS-like + libraries. + + Copyright (C) 2013, The University of Texas + + 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 The University of Texas 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 + HOLDER 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. + +*/ + +#include "blis.h" + +#ifdef BLIS_ENABLE_BLIS2BLAS + +void bla_symv_check( char* dt_str, + char* op_str, + f77_char* uploa, + f77_int* m, + f77_int* lda, + f77_int* incx, + f77_int* incy ) +{ + bla_hemv_check( dt_str, + op_str, + uploa, + m, + lda, + incx, + incy ); +} + +#endif diff --git a/frame/compat/check/bla_symv_check.h b/frame/compat/check/bla_symv_check.h new file mode 100644 index 000000000..3d24b455e --- /dev/null +++ b/frame/compat/check/bla_symv_check.h @@ -0,0 +1,45 @@ +/* + + BLIS + An object-based framework for developing high-performance BLAS-like + libraries. + + Copyright (C) 2013, The University of Texas + + 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 The University of Texas 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 + HOLDER 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. + +*/ + +#ifdef BLIS_ENABLE_BLAS2BLIS + +void bla_symv_check( char* dt_str, + char* op_str, + f77_char* uploa, + f77_int* m, + f77_int* lda, + f77_int* incx, + f77_int* incy ); + +#endif diff --git a/frame/compat/check/bla_syr2_check.c b/frame/compat/check/bla_syr2_check.c new file mode 100644 index 000000000..a547a14f3 --- /dev/null +++ b/frame/compat/check/bla_syr2_check.c @@ -0,0 +1,56 @@ +/* + + BLIS + An object-based framework for developing high-performance BLAS-like + libraries. + + Copyright (C) 2013, The University of Texas + + 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 The University of Texas 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 + HOLDER 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. + +*/ + +#include "blis.h" + +#ifdef BLIS_ENABLE_BLIS2BLAS + +void bla_syr2_check( char* dt_str, + char* op_str, + f77_char* uploc, + f77_int* m, + f77_int* incx, + f77_int* incy, + f77_int* lda ) +{ + bla_her2_check( dt_str, + op_str, + uploc, + m, + incx, + incy, + lda ); +} + +#endif diff --git a/frame/compat/check/bla_syr2_check.h b/frame/compat/check/bla_syr2_check.h new file mode 100644 index 000000000..99b1d1c7c --- /dev/null +++ b/frame/compat/check/bla_syr2_check.h @@ -0,0 +1,45 @@ +/* + + BLIS + An object-based framework for developing high-performance BLAS-like + libraries. + + Copyright (C) 2013, The University of Texas + + 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 The University of Texas 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 + HOLDER 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. + +*/ + +#ifdef BLIS_ENABLE_BLAS2BLIS + +void bla_syr2_check( char* dt_str, + char* op_str, + f77_char* uploa, + f77_int* m, + f77_int* incx, + f77_int* incy, + f77_int* lda ); + +#endif diff --git a/frame/compat/check/bla_syr2k_check.c b/frame/compat/check/bla_syr2k_check.c new file mode 100644 index 000000000..bad0f6cb0 --- /dev/null +++ b/frame/compat/check/bla_syr2k_check.c @@ -0,0 +1,87 @@ +/* + + BLIS + An object-based framework for developing high-performance BLAS-like + libraries. + + Copyright (C) 2013, The University of Texas + + 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 The University of Texas 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 + HOLDER 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. + +*/ + +#include "blis.h" + +#ifdef BLIS_ENABLE_BLIS2BLAS + +void bla_syr2k_check( char* dt_str, + char* op_str, + f77_char* uploa, + f77_char* trans, + f77_int* m, + f77_int* k, + f77_int* lda, + f77_int* ldb, + f77_int* ldc ) +{ + f77_int info = 0; + f77_int nota, ta; + f77_int lower, upper; + f77_int nrowa; + + nota = PASTEF770(lsame)( trans, "N", (ftnlen)1, (ftnlen)1 ); + ta = PASTEF770(lsame)( trans, "T", (ftnlen)1, (ftnlen)1 ); + lower = PASTEF770(lsame)( uploa, "L", (ftnlen)1, (ftnlen)1 ); + upper = PASTEF770(lsame)( uploa, "U", (ftnlen)1, (ftnlen)1 ); + + if ( nota ) { nrowa = *m } + else { nrowa = *k } + + if ( !lower && !upper ) + info = 1; + else if ( !nota && !ta ) + info = 2; + else if ( *m < 0 ) + info = 3; + else if ( *k < 0 ) + info = 4; + else if ( *lda < bli_max( 1, nrowa ) ) + info = 7; + else if ( *ldb < bli_max( 1, nrowa ) ) + info = 9; + else if ( *ldc < bli_max( 1, *m ) ) + info = 12; + + if ( info != 0 ) + { + char func_str[ BLIS_MAX_BLAS_FUNC_STR_LENGTH ]; + + sprintf( func_str, "%s%-5s", dt_str, op_str ); + + PASTEF770(xerbla)( func_str, &info, (ftnlen)6 ); + } +} + +#endif diff --git a/frame/compat/check/bla_syr2k_check.h b/frame/compat/check/bla_syr2k_check.h new file mode 100644 index 000000000..38a563cbb --- /dev/null +++ b/frame/compat/check/bla_syr2k_check.h @@ -0,0 +1,47 @@ +/* + + BLIS + An object-based framework for developing high-performance BLAS-like + libraries. + + Copyright (C) 2013, The University of Texas + + 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 The University of Texas 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 + HOLDER 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. + +*/ + +#ifdef BLIS_ENABLE_BLAS2BLIS + +void bla_syr2k_check( char* dt_str, + char* op_str, + f77_char* uploa, + f77_char* trans, + f77_int* m, + f77_int* k, + f77_int* lda, + f77_int* ldb, + f77_int* ldc ); + +#endif diff --git a/frame/compat/check/bla_syr_check.c b/frame/compat/check/bla_syr_check.c new file mode 100644 index 000000000..4cca2b685 --- /dev/null +++ b/frame/compat/check/bla_syr_check.c @@ -0,0 +1,54 @@ +/* + + BLIS + An object-based framework for developing high-performance BLAS-like + libraries. + + Copyright (C) 2013, The University of Texas + + 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 The University of Texas 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 + HOLDER 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. + +*/ + +#include "blis.h" + +#ifdef BLIS_ENABLE_BLIS2BLAS + +void bla_syr_check( char* dt_str, + char* op_str, + f77_char* uploc, + f77_int* m, + f77_int* incx, + f77_int* lda ) +{ + bla_her_check( dt_str, + op_str, + uploc, + m, + incx, + lda ); +} + +#endif diff --git a/frame/compat/check/bla_syr_check.h b/frame/compat/check/bla_syr_check.h new file mode 100644 index 000000000..aac319e95 --- /dev/null +++ b/frame/compat/check/bla_syr_check.h @@ -0,0 +1,44 @@ +/* + + BLIS + An object-based framework for developing high-performance BLAS-like + libraries. + + Copyright (C) 2013, The University of Texas + + 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 The University of Texas 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 + HOLDER 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. + +*/ + +#ifdef BLIS_ENABLE_BLAS2BLIS + +void bla_syr_check( char* dt_str, + char* op_str, + f77_char* uploa, + f77_int* m, + f77_int* incx, + f77_int* lda ); + +#endif diff --git a/frame/compat/check/bla_syrk_check.c b/frame/compat/check/bla_syrk_check.c new file mode 100644 index 000000000..ca6da5c77 --- /dev/null +++ b/frame/compat/check/bla_syrk_check.c @@ -0,0 +1,84 @@ +/* + + BLIS + An object-based framework for developing high-performance BLAS-like + libraries. + + Copyright (C) 2013, The University of Texas + + 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 The University of Texas 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 + HOLDER 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. + +*/ + +#include "blis.h" + +#ifdef BLIS_ENABLE_BLIS2BLAS + +void bla_syrk_check( char* dt_str, + char* op_str, + f77_char* uploc, + f77_char* transa, + f77_int* m, + f77_int* k, + f77_int* lda, + f77_int* ldc ) +{ + f77_int info = 0; + f77_int nota, ta; + f77_int lower, upper; + f77_int nrowa; + + nota = PASTEF770(lsame)( transa, "N", (ftnlen)1, (ftnlen)1 ); + ta = PASTEF770(lsame)( transa, "T", (ftnlen)1, (ftnlen)1 ); + lower = PASTEF770(lsame)( uploc, "L", (ftnlen)1, (ftnlen)1 ); + upper = PASTEF770(lsame)( uploc, "U", (ftnlen)1, (ftnlen)1 ); + + if ( nota ) { nrowa = *m } + else { nrowa = *k } + + if ( !lower && !upper ) + info = 1; + else if ( !nota && !ta ) + info = 2; + else if ( *m < 0 ) + info = 3; + else if ( *k < 0 ) + info = 4; + else if ( *lda < bli_max( 1, nrowa ) ) + info = 7; + else if ( *ldc < bli_max( 1, *m ) ) + info = 10; + + if ( info != 0 ) + { + char func_str[ BLIS_MAX_BLAS_FUNC_STR_LENGTH ]; + + sprintf( func_str, "%s%-5s", dt_str, op_str ); + + PASTEF770(xerbla)( func_str, &info, (ftnlen)6 ); + } +} + +#endif diff --git a/frame/compat/check/bla_syrk_check.h b/frame/compat/check/bla_syrk_check.h new file mode 100644 index 000000000..c95c35901 --- /dev/null +++ b/frame/compat/check/bla_syrk_check.h @@ -0,0 +1,46 @@ +/* + + BLIS + An object-based framework for developing high-performance BLAS-like + libraries. + + Copyright (C) 2013, The University of Texas + + 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 The University of Texas 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 + HOLDER 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. + +*/ + +#ifdef BLIS_ENABLE_BLAS2BLIS + +void bla_syrk_check( char* dt_str, + char* op_str, + f77_char* uploc, + f77_char* transa, + f77_int* m, + f77_int* k, + f77_int* lda, + f77_int* ldc ); + +#endif diff --git a/frame/compat/check/bla_trmm_check.c b/frame/compat/check/bla_trmm_check.c new file mode 100644 index 000000000..3a051a2a1 --- /dev/null +++ b/frame/compat/check/bla_trmm_check.c @@ -0,0 +1,97 @@ +/* + + BLIS + An object-based framework for developing high-performance BLAS-like + libraries. + + Copyright (C) 2013, The University of Texas + + 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 The University of Texas 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 + HOLDER 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. + +*/ + +#include "blis.h" + +#ifdef BLIS_ENABLE_BLIS2BLAS + +void bla_trmm_check( char* dt_str, + char* op_str, + f77_char* sidea, + f77_char* uploa, + f77_char* transa, + f77_char* diaga, + f77_int* m, + f77_int* n, + f77_int* lda, + f77_int* ldb ) +{ + f77_int info = 0; + f77_int left, right; + f77_int lower, upper; + f77_int nota, ta, conja; + f77_int unita, nonua; + f77_int nrowa; + + left = PASTEF770(lsame)( sidea, "L", (ftnlen)1, (ftnlen)1 ); + right = PASTEF770(lsame)( sidea, "R", (ftnlen)1, (ftnlen)1 ); + lower = PASTEF770(lsame)( uploa, "L", (ftnlen)1, (ftnlen)1 ); + upper = PASTEF770(lsame)( uploa, "U", (ftnlen)1, (ftnlen)1 ); + nota = PASTEF770(lsame)( transa, "N", (ftnlen)1, (ftnlen)1 ); + ta = PASTEF770(lsame)( transa, "T", (ftnlen)1, (ftnlen)1 ); + conja = PASTEF770(lsame)( transa, "C", (ftnlen)1, (ftnlen)1 ); + unita = PASTEF770(lsame)( diaga, "U", (ftnlen)1, (ftnlen)1 ); + nonua = PASTEF770(lsame)( diaga, "N", (ftnlen)1, (ftnlen)1 ); + + if ( left ) { nrowa = *m } + else { nrowa = *n } + + if ( !left && !right ) + info = 1; + else if ( !lower && !upper ) + info = 2; + else if ( !nota && !ta && !conja ) + info = 3; + else if ( !unita && !nonua ) + info = 4; + else if ( *m < 0 ) + info = 5; + else if ( *n < 0 ) + info = 6; + else if ( *lda < bli_max( 1, nrowa ) ) + info = 9; + else if ( *ldb < bli_max( 1, *m ) ) + info = 11; + + if ( info != 0 ) + { + char func_str[ BLIS_MAX_BLAS_FUNC_STR_LENGTH ]; + + sprintf( func_str, "%s%-5s", dt_str, op_str ); + + PASTEF770(xerbla)( func_str, &info, (ftnlen)6 ); + } +} + +#endif diff --git a/frame/compat/check/bla_trmm_check.h b/frame/compat/check/bla_trmm_check.h new file mode 100644 index 000000000..24c152b3f --- /dev/null +++ b/frame/compat/check/bla_trmm_check.h @@ -0,0 +1,48 @@ +/* + + BLIS + An object-based framework for developing high-performance BLAS-like + libraries. + + Copyright (C) 2013, The University of Texas + + 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 The University of Texas 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 + HOLDER 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. + +*/ + +#ifdef BLIS_ENABLE_BLAS2BLIS + +void bla_trmm_check( char* dt_str, + char* op_str, + f77_char* sidea, + f77_char* uploa, + f77_char* transa, + f77_char* diaga, + f77_int* m, + f77_int* n, + f77_int* lda, + f77_int* ldb ); + +#endif diff --git a/frame/compat/check/bla_trmv_check.c b/frame/compat/check/bla_trmv_check.c new file mode 100644 index 000000000..cd23dfd01 --- /dev/null +++ b/frame/compat/check/bla_trmv_check.c @@ -0,0 +1,82 @@ +/* + + BLIS + An object-based framework for developing high-performance BLAS-like + libraries. + + Copyright (C) 2013, The University of Texas + + 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 The University of Texas 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 + HOLDER 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. + +*/ + +#include "blis.h" + +#ifdef BLIS_ENABLE_BLIS2BLAS + +void bla_trmv_check( char* dt_str, + char* op_str, + f77_char* uploa, + f77_char* transa, + f77_char* diaga, + f77_int* m, + f77_int* lda, + f77_int* incx ) +{ + f77_int info = 0; + f77_int lower, upper; + + lower = PASTEF770(lsame)( uploa, "L", (ftnlen)1, (ftnlen)1 ); + upper = PASTEF770(lsame)( uploa, "U", (ftnlen)1, (ftnlen)1 ); + nota = PASTEF770(lsame)( transa, "N", (ftnlen)1, (ftnlen)1 ); + ta = PASTEF770(lsame)( transa, "T", (ftnlen)1, (ftnlen)1 ); + conja = PASTEF770(lsame)( transa, "C", (ftnlen)1, (ftnlen)1 ); + unita = PASTEF770(lsame)( diaga, "U", (ftnlen)1, (ftnlen)1 ); + nonua = PASTEF770(lsame)( diaga, "N", (ftnlen)1, (ftnlen)1 ); + + if ( !lower && !upper ) + info = 1; + else if ( !nota && !ta && !conja ) + info = 2; + else if ( !unita && !nonua ) + info = 3; + else if ( *m < 0 ) + info = 4; + else if ( *lda < bli_max( 1, *m ) ) + info = 6; + else if ( *incx == 0 ) + info = 8; + + if ( info != 0 ) + { + char func_str[ BLIS_MAX_BLAS_FUNC_STR_LENGTH ]; + + sprintf( func_str, "%s%-5s", dt_str, op_str ); + + PASTEF770(xerbla)( func_str, &info, (ftnlen)6 ); + } +} + +#endif diff --git a/frame/compat/check/bla_trmv_check.h b/frame/compat/check/bla_trmv_check.h new file mode 100644 index 000000000..a72c9124a --- /dev/null +++ b/frame/compat/check/bla_trmv_check.h @@ -0,0 +1,46 @@ +/* + + BLIS + An object-based framework for developing high-performance BLAS-like + libraries. + + Copyright (C) 2013, The University of Texas + + 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 The University of Texas 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 + HOLDER 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. + +*/ + +#ifdef BLIS_ENABLE_BLAS2BLIS + +void bla_trmv_check( char* dt_str, + char* op_str, + f77_char* uploa, + f77_char* transa, + f77_char* diaga, + f77_int* m, + f77_int* lda, + f77_int* incx ); + +#endif diff --git a/frame/compat/check/bla_trsm_check.c b/frame/compat/check/bla_trsm_check.c new file mode 100644 index 000000000..8b6efc401 --- /dev/null +++ b/frame/compat/check/bla_trsm_check.c @@ -0,0 +1,62 @@ +/* + + BLIS + An object-based framework for developing high-performance BLAS-like + libraries. + + Copyright (C) 2013, The University of Texas + + 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 The University of Texas 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 + HOLDER 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. + +*/ + +#include "blis.h" + +#ifdef BLIS_ENABLE_BLIS2BLAS + +void bla_trsm_check( char* dt_str, + char* op_str, + f77_char* sidea, + f77_char* uploa, + f77_char* transa, + f77_char* diaga, + f77_int* m, + f77_int* n, + f77_int* lda, + f77_int* ldb ) +{ + bla_trmm_check( dt_str, + op_str, + sidea, + uploa, + transa, + diaga, + m, + n, + lda, + ldb ); +} + +#endif diff --git a/frame/compat/check/bla_trsm_check.h b/frame/compat/check/bla_trsm_check.h new file mode 100644 index 000000000..4e9f1f1cf --- /dev/null +++ b/frame/compat/check/bla_trsm_check.h @@ -0,0 +1,48 @@ +/* + + BLIS + An object-based framework for developing high-performance BLAS-like + libraries. + + Copyright (C) 2013, The University of Texas + + 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 The University of Texas 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 + HOLDER 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. + +*/ + +#ifdef BLIS_ENABLE_BLAS2BLIS + +void bla_trsm_check( char* dt_str, + char* op_str, + f77_char* sidea, + f77_char* uploa, + f77_char* transa, + f77_char* diaga, + f77_int* m, + f77_int* n, + f77_int* lda, + f77_int* ldb ); + +#endif diff --git a/frame/compat/check/bla_trsv_check.c b/frame/compat/check/bla_trsv_check.c new file mode 100644 index 000000000..42ac1d7b0 --- /dev/null +++ b/frame/compat/check/bla_trsv_check.c @@ -0,0 +1,58 @@ +/* + + BLIS + An object-based framework for developing high-performance BLAS-like + libraries. + + Copyright (C) 2013, The University of Texas + + 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 The University of Texas 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 + HOLDER 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. + +*/ + +#include "blis.h" + +#ifdef BLIS_ENABLE_BLIS2BLAS + +void bla_trsv_check( char* dt_str, + char* op_str, + f77_char* uploa, + f77_char* transa, + f77_char* diaga, + f77_int* m, + f77_int* lda, + f77_int* incx ) +{ + bla_trmv_check( dt_str, + op_str, + uploa, + transa, + diaga, + m, + lda, + incx ); +} + +#endif diff --git a/frame/compat/check/bla_trsv_check.h b/frame/compat/check/bla_trsv_check.h new file mode 100644 index 000000000..81e683906 --- /dev/null +++ b/frame/compat/check/bla_trsv_check.h @@ -0,0 +1,46 @@ +/* + + BLIS + An object-based framework for developing high-performance BLAS-like + libraries. + + Copyright (C) 2013, The University of Texas + + 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 The University of Texas 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 + HOLDER 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. + +*/ + +#ifdef BLIS_ENABLE_BLAS2BLIS + +void bla_trsv_check( char* dt_str, + char* op_str, + f77_char* uploa, + f77_char* transa, + f77_char* diaga, + f77_int* m, + f77_int* lda, + f77_int* incx ); + +#endif diff --git a/frame/compat/f2c/bla_gbmv.c b/frame/compat/f2c/bla_gbmv.c index 5c297913f..1a89ab2c4 100644 --- a/frame/compat/f2c/bla_gbmv.c +++ b/frame/compat/f2c/bla_gbmv.c @@ -36,31 +36,27 @@ #ifdef BLIS_ENABLE_BLAS2BLIS -#include "bli_f2c.h" - /* cgbmv.f -- translated by f2c (version 19991025). You must link the resulting object file with the libraries: -lf2c -lm (in that order) */ -/* Subroutine */ int PASTEF77(c,gbmv)(character *trans, integer *m, integer *n, integer *kl, - integer *ku, singlecomplex *alpha, singlecomplex *a, integer *lda, singlecomplex *x, - integer *incx, singlecomplex *beta, singlecomplex *y, integer *incy) +/* Subroutine */ int PASTEF77(c,gbmv)(character *trans, integer *m, integer *n, integer *kl, integer *ku, singlecomplex *alpha, singlecomplex *a, integer *lda, singlecomplex *x, integer *incx, singlecomplex *beta, singlecomplex *y, integer *incy) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5, i__6; singlecomplex q__1, q__2, q__3; /* Builtin functions */ - void r_cnjg(singlecomplex *, singlecomplex *); + void bla_r_cnjg(singlecomplex *, singlecomplex *); /* Local variables */ integer info; singlecomplex temp; integer lenx, leny, i__, j, k; - extern logical lsame_(character *, character *, ftnlen, ftnlen); + extern logical PASTEF770(lsame)(character *, character *, ftnlen, ftnlen); integer ix, iy, jx, jy, kx, ky; - extern /* Subroutine */ int xerbla_(character *, integer *, ftnlen); + extern /* Subroutine */ int PASTEF770(xerbla)(character *, integer *, ftnlen); logical noconj; integer kup1; @@ -207,8 +203,8 @@ /* Function Body */ info = 0; - if (! lsame_(trans, "N", (ftnlen)1, (ftnlen)1) && ! lsame_(trans, "T", ( - ftnlen)1, (ftnlen)1) && ! lsame_(trans, "C", (ftnlen)1, (ftnlen)1) + if (! PASTEF770(lsame)(trans, "N", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(trans, "T", ( + ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(trans, "C", (ftnlen)1, (ftnlen)1) ) { info = 1; } else if (*m < 0) { @@ -227,7 +223,7 @@ info = 13; } if (info != 0) { - xerbla_("CGBMV ", &info, (ftnlen)6); + PASTEF770(xerbla)("CGBMV ", &info, (ftnlen)6); return 0; } @@ -238,12 +234,12 @@ return 0; } - noconj = lsame_(trans, "T", (ftnlen)1, (ftnlen)1); + noconj = PASTEF770(lsame)(trans, "T", (ftnlen)1, (ftnlen)1); /* Set LENX and LENY, the lengths of the vectors x and y, and set */ /* up the start points in X and Y. */ - if (lsame_(trans, "N", (ftnlen)1, (ftnlen)1)) { + if (PASTEF770(lsame)(trans, "N", (ftnlen)1, (ftnlen)1)) { lenx = *n; leny = *m; } else { @@ -316,7 +312,7 @@ return 0; } kup1 = *ku + 1; - if (lsame_(trans, "N", (ftnlen)1, (ftnlen)1)) { + if (PASTEF770(lsame)(trans, "N", (ftnlen)1, (ftnlen)1)) { /* Form y := alpha*A*x + y. */ @@ -424,7 +420,7 @@ i__5 = *m, i__6 = j + *kl; i__4 = f2c_min(i__5,i__6); for (i__ = f2c_max(i__2,i__3); i__ <= i__4; ++i__) { - r_cnjg(&q__3, &a[k + i__ + j * a_dim1]); + bla_r_cnjg(&q__3, &a[k + i__ + j * a_dim1]); i__2 = i__; q__2.real = q__3.real * x[i__2].real - q__3.imag * x[i__2].imag, q__2.imag = q__3.real * x[i__2].imag + q__3.imag * x[i__2] @@ -473,7 +469,7 @@ i__5 = *m, i__6 = j + *kl; i__2 = f2c_min(i__5,i__6); for (i__ = f2c_max(i__3,i__4); i__ <= i__2; ++i__) { - r_cnjg(&q__3, &a[k + i__ + j * a_dim1]); + bla_r_cnjg(&q__3, &a[k + i__ + j * a_dim1]); i__3 = ix; q__2.real = q__3.real * x[i__3].real - q__3.imag * x[i__3].imag, q__2.imag = q__3.real * x[i__3].imag + q__3.imag * x[i__3] @@ -510,10 +506,7 @@ -lf2c -lm (in that order) */ -/* Subroutine */ int PASTEF77(d,gbmv)(character *trans, integer *m, integer *n, integer *kl, - integer *ku, doublereal *alpha, doublereal *a, integer *lda, - doublereal *x, integer *incx, doublereal *beta, doublereal *y, - integer *incy) +/* Subroutine */ int PASTEF77(d,gbmv)(character *trans, integer *m, integer *n, integer *kl, integer *ku, doublereal *alpha, doublereal *a, integer *lda, doublereal *x, integer *incx, doublereal *beta, doublereal *y, integer *incy) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5, i__6; @@ -522,9 +515,9 @@ integer info; doublereal temp; integer lenx, leny, i__, j, k; - extern logical lsame_(character *, character *, ftnlen, ftnlen); + extern logical PASTEF770(lsame)(character *, character *, ftnlen, ftnlen); integer ix, iy, jx, jy, kx, ky; - extern /* Subroutine */ int xerbla_(character *, integer *, ftnlen); + extern /* Subroutine */ int PASTEF770(xerbla)(character *, integer *, ftnlen); integer kup1; /* .. Scalar Arguments .. */ @@ -666,8 +659,8 @@ /* Function Body */ info = 0; - if (! lsame_(trans, "N", (ftnlen)1, (ftnlen)1) && ! lsame_(trans, "T", ( - ftnlen)1, (ftnlen)1) && ! lsame_(trans, "C", (ftnlen)1, (ftnlen)1) + if (! PASTEF770(lsame)(trans, "N", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(trans, "T", ( + ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(trans, "C", (ftnlen)1, (ftnlen)1) ) { info = 1; } else if (*m < 0) { @@ -686,7 +679,7 @@ info = 13; } if (info != 0) { - xerbla_("DGBMV ", &info, (ftnlen)6); + PASTEF770(xerbla)("DGBMV ", &info, (ftnlen)6); return 0; } @@ -699,7 +692,7 @@ /* Set LENX and LENY, the lengths of the vectors x and y, and set */ /* up the start points in X and Y. */ - if (lsame_(trans, "N", (ftnlen)1, (ftnlen)1)) { + if (PASTEF770(lsame)(trans, "N", (ftnlen)1, (ftnlen)1)) { lenx = *n; leny = *m; } else { @@ -760,7 +753,7 @@ return 0; } kup1 = *ku + 1; - if (lsame_(trans, "N", (ftnlen)1, (ftnlen)1)) { + if (PASTEF770(lsame)(trans, "N", (ftnlen)1, (ftnlen)1)) { /* Form y := alpha*A*x + y. */ @@ -869,9 +862,7 @@ -lf2c -lm (in that order) */ -/* Subroutine */ int PASTEF77(s,gbmv)(character *trans, integer *m, integer *n, integer *kl, - integer *ku, real *alpha, real *a, integer *lda, real *x, integer * - incx, real *beta, real *y, integer *incy) +/* Subroutine */ int PASTEF77(s,gbmv)(character *trans, integer *m, integer *n, integer *kl, integer *ku, real *alpha, real *a, integer *lda, real *x, integer * incx, real *beta, real *y, integer *incy) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5, i__6; @@ -880,9 +871,9 @@ integer info; real temp; integer lenx, leny, i__, j, k; - extern logical lsame_(character *, character *, ftnlen, ftnlen); + extern logical PASTEF770(lsame)(character *, character *, ftnlen, ftnlen); integer ix, iy, jx, jy, kx, ky; - extern /* Subroutine */ int xerbla_(character *, integer *, ftnlen); + extern /* Subroutine */ int PASTEF770(xerbla)(character *, integer *, ftnlen); integer kup1; /* .. Scalar Arguments .. */ @@ -1024,8 +1015,8 @@ /* Function Body */ info = 0; - if (! lsame_(trans, "N", (ftnlen)1, (ftnlen)1) && ! lsame_(trans, "T", ( - ftnlen)1, (ftnlen)1) && ! lsame_(trans, "C", (ftnlen)1, (ftnlen)1) + if (! PASTEF770(lsame)(trans, "N", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(trans, "T", ( + ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(trans, "C", (ftnlen)1, (ftnlen)1) ) { info = 1; } else if (*m < 0) { @@ -1044,7 +1035,7 @@ info = 13; } if (info != 0) { - xerbla_("SGBMV ", &info, (ftnlen)6); + PASTEF770(xerbla)("SGBMV ", &info, (ftnlen)6); return 0; } @@ -1057,7 +1048,7 @@ /* Set LENX and LENY, the lengths of the vectors x and y, and set */ /* up the start points in X and Y. */ - if (lsame_(trans, "N", (ftnlen)1, (ftnlen)1)) { + if (PASTEF770(lsame)(trans, "N", (ftnlen)1, (ftnlen)1)) { lenx = *n; leny = *m; } else { @@ -1118,7 +1109,7 @@ return 0; } kup1 = *ku + 1; - if (lsame_(trans, "N", (ftnlen)1, (ftnlen)1)) { + if (PASTEF770(lsame)(trans, "N", (ftnlen)1, (ftnlen)1)) { /* Form y := alpha*A*x + y. */ @@ -1227,25 +1218,22 @@ -lf2c -lm (in that order) */ -/* Subroutine */ int PASTEF77(z,gbmv)(character *trans, integer *m, integer *n, integer *kl, - integer *ku, doublecomplex *alpha, doublecomplex *a, integer *lda, - doublecomplex *x, integer *incx, doublecomplex *beta, doublecomplex * - y, integer *incy) +/* Subroutine */ int PASTEF77(z,gbmv)(character *trans, integer *m, integer *n, integer *kl, integer *ku, doublecomplex *alpha, doublecomplex *a, integer *lda, doublecomplex *x, integer *incx, doublecomplex *beta, doublecomplex * y, integer *incy) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5, i__6; doublecomplex z__1, z__2, z__3; /* Builtin functions */ - void d_cnjg(doublecomplex *, doublecomplex *); + void bla_d_cnjg(doublecomplex *, doublecomplex *); /* Local variables */ integer info; doublecomplex temp; integer lenx, leny, i__, j, k; - extern logical lsame_(character *, character *, ftnlen, ftnlen); + extern logical PASTEF770(lsame)(character *, character *, ftnlen, ftnlen); integer ix, iy, jx, jy, kx, ky; - extern /* Subroutine */ int xerbla_(character *, integer *, ftnlen); + extern /* Subroutine */ int PASTEF770(xerbla)(character *, integer *, ftnlen); logical noconj; integer kup1; @@ -1392,8 +1380,8 @@ /* Function Body */ info = 0; - if (! lsame_(trans, "N", (ftnlen)1, (ftnlen)1) && ! lsame_(trans, "T", ( - ftnlen)1, (ftnlen)1) && ! lsame_(trans, "C", (ftnlen)1, (ftnlen)1) + if (! PASTEF770(lsame)(trans, "N", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(trans, "T", ( + ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(trans, "C", (ftnlen)1, (ftnlen)1) ) { info = 1; } else if (*m < 0) { @@ -1412,7 +1400,7 @@ info = 13; } if (info != 0) { - xerbla_("ZGBMV ", &info, (ftnlen)6); + PASTEF770(xerbla)("ZGBMV ", &info, (ftnlen)6); return 0; } @@ -1423,12 +1411,12 @@ return 0; } - noconj = lsame_(trans, "T", (ftnlen)1, (ftnlen)1); + noconj = PASTEF770(lsame)(trans, "T", (ftnlen)1, (ftnlen)1); /* Set LENX and LENY, the lengths of the vectors x and y, and set */ /* up the start points in X and Y. */ - if (lsame_(trans, "N", (ftnlen)1, (ftnlen)1)) { + if (PASTEF770(lsame)(trans, "N", (ftnlen)1, (ftnlen)1)) { lenx = *n; leny = *m; } else { @@ -1501,7 +1489,7 @@ return 0; } kup1 = *ku + 1; - if (lsame_(trans, "N", (ftnlen)1, (ftnlen)1)) { + if (PASTEF770(lsame)(trans, "N", (ftnlen)1, (ftnlen)1)) { /* Form y := alpha*A*x + y. */ @@ -1609,7 +1597,7 @@ i__5 = *m, i__6 = j + *kl; i__4 = f2c_min(i__5,i__6); for (i__ = f2c_max(i__2,i__3); i__ <= i__4; ++i__) { - d_cnjg(&z__3, &a[k + i__ + j * a_dim1]); + bla_d_cnjg(&z__3, &a[k + i__ + j * a_dim1]); i__2 = i__; z__2.real = z__3.real * x[i__2].real - z__3.imag * x[i__2].imag, z__2.imag = z__3.real * x[i__2].imag + z__3.imag * x[i__2] @@ -1658,7 +1646,7 @@ i__5 = *m, i__6 = j + *kl; i__2 = f2c_min(i__5,i__6); for (i__ = f2c_max(i__3,i__4); i__ <= i__2; ++i__) { - d_cnjg(&z__3, &a[k + i__ + j * a_dim1]); + bla_d_cnjg(&z__3, &a[k + i__ + j * a_dim1]); i__3 = ix; z__2.real = z__3.real * x[i__3].real - z__3.imag * x[i__3].imag, z__2.imag = z__3.real * x[i__3].imag + z__3.imag * x[i__3] diff --git a/frame/compat/f2c/bla_gbmv.h b/frame/compat/f2c/bla_gbmv.h new file mode 100644 index 000000000..f366571c4 --- /dev/null +++ b/frame/compat/f2c/bla_gbmv.h @@ -0,0 +1,44 @@ +/* + + BLIS + An object-based framework for developing high-performance BLAS-like + libraries. + + Copyright (C) 2013, The University of Texas + + 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 The University of Texas 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 + HOLDER 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. + +*/ + +#include "blis.h" + +#ifdef BLIS_ENABLE_BLAS2BLIS + +int PASTEF77(c,gbmv)(character *trans, integer *m, integer *n, integer *kl, integer *ku, singlecomplex *alpha, singlecomplex *a, integer *lda, singlecomplex *x, integer *incx, singlecomplex *beta, singlecomplex *y, integer *incy); +int PASTEF77(d,gbmv)(character *trans, integer *m, integer *n, integer *kl, integer *ku, doublereal *alpha, doublereal *a, integer *lda, doublereal *x, integer *incx, doublereal *beta, doublereal *y, integer *incy); +int PASTEF77(s,gbmv)(character *trans, integer *m, integer *n, integer *kl, integer *ku, real *alpha, real *a, integer *lda, real *x, integer * incx, real *beta, real *y, integer *incy); +int PASTEF77(z,gbmv)(character *trans, integer *m, integer *n, integer *kl, integer *ku, doublecomplex *alpha, doublecomplex *a, integer *lda, doublecomplex *x, integer *incx, doublecomplex *beta, doublecomplex * y, integer *incy); + +#endif diff --git a/frame/compat/f2c/bla_hbmv.c b/frame/compat/f2c/bla_hbmv.c index d836840b0..595ffd6c8 100644 --- a/frame/compat/f2c/bla_hbmv.c +++ b/frame/compat/f2c/bla_hbmv.c @@ -36,16 +36,12 @@ #ifdef BLIS_ENABLE_BLAS2BLIS -#include "bli_f2c.h" - /* chbmv.f -- translated by f2c (version 19991025). You must link the resulting object file with the libraries: -lf2c -lm (in that order) */ -/* Subroutine */ int PASTEF77(c,hbmv)(character *uplo, integer *n, integer *k, singlecomplex * - alpha, singlecomplex *a, integer *lda, singlecomplex *x, integer *incx, singlecomplex * - beta, singlecomplex *y, integer *incy) +/* Subroutine */ int PASTEF77(c,hbmv)(character *uplo, integer *n, integer *k, singlecomplex * alpha, singlecomplex *a, integer *lda, singlecomplex *x, integer *incx, singlecomplex *beta, singlecomplex *y, integer *incy) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5; @@ -53,15 +49,15 @@ singlecomplex q__1, q__2, q__3, q__4; /* Builtin functions */ - void r_cnjg(singlecomplex *, singlecomplex *); + void bla_r_cnjg(singlecomplex *, singlecomplex *); /* Local variables */ integer info; singlecomplex temp1, temp2; integer i__, j, l; - extern logical lsame_(character *, character *, ftnlen, ftnlen); + extern logical PASTEF770(lsame)(character *, character *, ftnlen, ftnlen); integer kplus1, ix, iy, jx, jy, kx, ky; - extern /* Subroutine */ int xerbla_(character *, integer *, ftnlen); + extern /* Subroutine */ int PASTEF770(xerbla)(character *, integer *, ftnlen); /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ @@ -208,7 +204,7 @@ /* Function Body */ info = 0; - if (! lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && ! lsame_(uplo, "L", ( + if (! PASTEF770(lsame)(uplo, "U", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(uplo, "L", ( ftnlen)1, (ftnlen)1)) { info = 1; } else if (*n < 0) { @@ -223,7 +219,7 @@ info = 11; } if (info != 0) { - xerbla_("CHBMV ", &info, (ftnlen)6); + PASTEF770(xerbla)("CHBMV ", &info, (ftnlen)6); return 0; } @@ -301,7 +297,7 @@ if (alpha->real == 0.f && alpha->imag == 0.f) { return 0; } - if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) { + if (PASTEF770(lsame)(uplo, "U", (ftnlen)1, (ftnlen)1)) { /* Form y when upper triangle of A is stored. */ @@ -327,7 +323,7 @@ .real; q__1.real = y[i__3].real + q__2.real, q__1.imag = y[i__3].imag + q__2.imag; y[i__2].real = q__1.real, y[i__2].imag = q__1.imag; - r_cnjg(&q__3, &a[l + i__ + j * a_dim1]); + bla_r_cnjg(&q__3, &a[l + i__ + j * a_dim1]); i__2 = i__; q__2.real = q__3.real * x[i__2].real - q__3.imag * x[i__2].imag, q__2.imag = q__3.real * x[i__2].imag + q__3.imag * x[i__2].real; @@ -372,7 +368,7 @@ .real; q__1.real = y[i__2].real + q__2.real, q__1.imag = y[i__2].imag + q__2.imag; y[i__4].real = q__1.real, y[i__4].imag = q__1.imag; - r_cnjg(&q__3, &a[l + i__ + j * a_dim1]); + bla_r_cnjg(&q__3, &a[l + i__ + j * a_dim1]); i__4 = ix; q__2.real = q__3.real * x[i__4].real - q__3.imag * x[i__4].imag, q__2.imag = q__3.real * x[i__4].imag + q__3.imag * x[i__4].real; @@ -433,7 +429,7 @@ .real; q__1.real = y[i__2].real + q__2.real, q__1.imag = y[i__2].imag + q__2.imag; y[i__4].real = q__1.real, y[i__4].imag = q__1.imag; - r_cnjg(&q__3, &a[l + i__ + j * a_dim1]); + bla_r_cnjg(&q__3, &a[l + i__ + j * a_dim1]); i__4 = i__; q__2.real = q__3.real * x[i__4].real - q__3.imag * x[i__4].imag, q__2.imag = q__3.real * x[i__4].imag + q__3.imag * x[i__4].real; @@ -483,7 +479,7 @@ .real; q__1.real = y[i__2].real + q__2.real, q__1.imag = y[i__2].imag + q__2.imag; y[i__4].real = q__1.real, y[i__4].imag = q__1.imag; - r_cnjg(&q__3, &a[l + i__ + j * a_dim1]); + bla_r_cnjg(&q__3, &a[l + i__ + j * a_dim1]); i__4 = ix; q__2.real = q__3.real * x[i__4].real - q__3.imag * x[i__4].imag, q__2.imag = q__3.real * x[i__4].imag + q__3.imag * x[i__4].real; @@ -515,9 +511,7 @@ -lf2c -lm (in that order) */ -/* Subroutine */ int PASTEF77(z,hbmv)(character *uplo, integer *n, integer *k, doublecomplex - *alpha, doublecomplex *a, integer *lda, doublecomplex *x, integer * - incx, doublecomplex *beta, doublecomplex *y, integer *incy) +/* Subroutine */ int PASTEF77(z,hbmv)(character *uplo, integer *n, integer *k, doublecomplex *alpha, doublecomplex *a, integer *lda, doublecomplex *x, integer * incx, doublecomplex *beta, doublecomplex *y, integer *incy) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5; @@ -525,15 +519,15 @@ doublecomplex z__1, z__2, z__3, z__4; /* Builtin functions */ - void d_cnjg(doublecomplex *, doublecomplex *); + void bla_d_cnjg(doublecomplex *, doublecomplex *); /* Local variables */ integer info; doublecomplex temp1, temp2; integer i__, j, l; - extern logical lsame_(character *, character *, ftnlen, ftnlen); + extern logical PASTEF770(lsame)(character *, character *, ftnlen, ftnlen); integer kplus1, ix, iy, jx, jy, kx, ky; - extern /* Subroutine */ int xerbla_(character *, integer *, ftnlen); + extern /* Subroutine */ int PASTEF770(xerbla)(character *, integer *, ftnlen); /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ @@ -680,7 +674,7 @@ /* Function Body */ info = 0; - if (! lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && ! lsame_(uplo, "L", ( + if (! PASTEF770(lsame)(uplo, "U", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(uplo, "L", ( ftnlen)1, (ftnlen)1)) { info = 1; } else if (*n < 0) { @@ -695,7 +689,7 @@ info = 11; } if (info != 0) { - xerbla_("ZHBMV ", &info, (ftnlen)6); + PASTEF770(xerbla)("ZHBMV ", &info, (ftnlen)6); return 0; } @@ -773,7 +767,7 @@ if (alpha->real == 0. && alpha->imag == 0.) { return 0; } - if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) { + if (PASTEF770(lsame)(uplo, "U", (ftnlen)1, (ftnlen)1)) { /* Form y when upper triangle of A is stored. */ @@ -799,7 +793,7 @@ .real; z__1.real = y[i__3].real + z__2.real, z__1.imag = y[i__3].imag + z__2.imag; y[i__2].real = z__1.real, y[i__2].imag = z__1.imag; - d_cnjg(&z__3, &a[l + i__ + j * a_dim1]); + bla_d_cnjg(&z__3, &a[l + i__ + j * a_dim1]); i__2 = i__; z__2.real = z__3.real * x[i__2].real - z__3.imag * x[i__2].imag, z__2.imag = z__3.real * x[i__2].imag + z__3.imag * x[i__2].real; @@ -844,7 +838,7 @@ .real; z__1.real = y[i__2].real + z__2.real, z__1.imag = y[i__2].imag + z__2.imag; y[i__4].real = z__1.real, y[i__4].imag = z__1.imag; - d_cnjg(&z__3, &a[l + i__ + j * a_dim1]); + bla_d_cnjg(&z__3, &a[l + i__ + j * a_dim1]); i__4 = ix; z__2.real = z__3.real * x[i__4].real - z__3.imag * x[i__4].imag, z__2.imag = z__3.real * x[i__4].imag + z__3.imag * x[i__4].real; @@ -905,7 +899,7 @@ .real; z__1.real = y[i__2].real + z__2.real, z__1.imag = y[i__2].imag + z__2.imag; y[i__4].real = z__1.real, y[i__4].imag = z__1.imag; - d_cnjg(&z__3, &a[l + i__ + j * a_dim1]); + bla_d_cnjg(&z__3, &a[l + i__ + j * a_dim1]); i__4 = i__; z__2.real = z__3.real * x[i__4].real - z__3.imag * x[i__4].imag, z__2.imag = z__3.real * x[i__4].imag + z__3.imag * x[i__4].real; @@ -955,7 +949,7 @@ .real; z__1.real = y[i__2].real + z__2.real, z__1.imag = y[i__2].imag + z__2.imag; y[i__4].real = z__1.real, y[i__4].imag = z__1.imag; - d_cnjg(&z__3, &a[l + i__ + j * a_dim1]); + bla_d_cnjg(&z__3, &a[l + i__ + j * a_dim1]); i__4 = ix; z__2.real = z__3.real * x[i__4].real - z__3.imag * x[i__4].imag, z__2.imag = z__3.real * x[i__4].imag + z__3.imag * x[i__4].real; diff --git a/frame/compat/f2c/bla_hbmv.h b/frame/compat/f2c/bla_hbmv.h new file mode 100644 index 000000000..40371f504 --- /dev/null +++ b/frame/compat/f2c/bla_hbmv.h @@ -0,0 +1,42 @@ +/* + + BLIS + An object-based framework for developing high-performance BLAS-like + libraries. + + Copyright (C) 2013, The University of Texas + + 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 The University of Texas 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 + HOLDER 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. + +*/ + +#include "blis.h" + +#ifdef BLIS_ENABLE_BLAS2BLIS + +int PASTEF77(c,hbmv)(character *uplo, integer *n, integer *k, singlecomplex * alpha, singlecomplex *a, integer *lda, singlecomplex *x, integer *incx, singlecomplex *beta, singlecomplex *y, integer *incy); +int PASTEF77(z,hbmv)(character *uplo, integer *n, integer *k, doublecomplex *alpha, doublecomplex *a, integer *lda, doublecomplex *x, integer * incx, doublecomplex *beta, doublecomplex *y, integer *incy); + +#endif diff --git a/frame/compat/f2c/bla_hpmv.c b/frame/compat/f2c/bla_hpmv.c index 7e674ded1..ac1e6ba17 100644 --- a/frame/compat/f2c/bla_hpmv.c +++ b/frame/compat/f2c/bla_hpmv.c @@ -36,16 +36,12 @@ #ifdef BLIS_ENABLE_BLAS2BLIS -#include "bli_f2c.h" - /* chpmv.f -- translated by f2c (version 19991025). You must link the resulting object file with the libraries: -lf2c -lm (in that order) */ -/* Subroutine */ int PASTEF77(c,hpmv)(character *uplo, integer *n, singlecomplex *alpha, singlecomplex * - ap, singlecomplex *x, integer *incx, singlecomplex *beta, singlecomplex *y, integer * - incy) +/* Subroutine */ int PASTEF77(c,hpmv)(character *uplo, integer *n, singlecomplex *alpha, singlecomplex * ap, singlecomplex *x, integer *incx, singlecomplex *beta, singlecomplex *y, integer *incy) { /* System generated locals */ integer i__1, i__2, i__3, i__4, i__5; @@ -53,15 +49,15 @@ singlecomplex q__1, q__2, q__3, q__4; /* Builtin functions */ - void r_cnjg(singlecomplex *, singlecomplex *); + void bla_r_cnjg(singlecomplex *, singlecomplex *); /* Local variables */ integer info; singlecomplex temp1, temp2; integer i__, j, k; - extern logical lsame_(character *, character *, ftnlen, ftnlen); + extern logical PASTEF770(lsame)(character *, character *, ftnlen, ftnlen); integer kk, ix, iy, jx, jy, kx, ky; - extern /* Subroutine */ int xerbla_(character *, integer *, ftnlen); + extern /* Subroutine */ int PASTEF770(xerbla)(character *, integer *, ftnlen); /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ @@ -172,7 +168,7 @@ /* Function Body */ info = 0; - if (! lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && ! lsame_(uplo, "L", ( + if (! PASTEF770(lsame)(uplo, "U", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(uplo, "L", ( ftnlen)1, (ftnlen)1)) { info = 1; } else if (*n < 0) { @@ -183,7 +179,7 @@ info = 9; } if (info != 0) { - xerbla_("CHPMV ", &info, (ftnlen)6); + PASTEF770(xerbla)("CHPMV ", &info, (ftnlen)6); return 0; } @@ -262,7 +258,7 @@ return 0; } kk = 1; - if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) { + if (PASTEF770(lsame)(uplo, "U", (ftnlen)1, (ftnlen)1)) { /* Form y when AP contains the upper triangle. */ @@ -285,7 +281,7 @@ .real; q__1.real = y[i__4].real + q__2.real, q__1.imag = y[i__4].imag + q__2.imag; y[i__3].real = q__1.real, y[i__3].imag = q__1.imag; - r_cnjg(&q__3, &ap[k]); + bla_r_cnjg(&q__3, &ap[k]); i__3 = i__; q__2.real = q__3.real * x[i__3].real - q__3.imag * x[i__3].imag, q__2.imag = q__3.real * x[i__3].imag + q__3.imag * x[i__3].real; @@ -329,7 +325,7 @@ .real; q__1.real = y[i__4].real + q__2.real, q__1.imag = y[i__4].imag + q__2.imag; y[i__3].real = q__1.real, y[i__3].imag = q__1.imag; - r_cnjg(&q__3, &ap[k]); + bla_r_cnjg(&q__3, &ap[k]); i__3 = ix; q__2.real = q__3.real * x[i__3].real - q__3.imag * x[i__3].imag, q__2.imag = q__3.real * x[i__3].imag + q__3.imag * x[i__3].real; @@ -385,7 +381,7 @@ .real; q__1.real = y[i__4].real + q__2.real, q__1.imag = y[i__4].imag + q__2.imag; y[i__3].real = q__1.real, y[i__3].imag = q__1.imag; - r_cnjg(&q__3, &ap[k]); + bla_r_cnjg(&q__3, &ap[k]); i__3 = i__; q__2.real = q__3.real * x[i__3].real - q__3.imag * x[i__3].imag, q__2.imag = q__3.real * x[i__3].imag + q__3.imag * x[i__3].real; @@ -434,7 +430,7 @@ .real; q__1.real = y[i__4].real + q__2.real, q__1.imag = y[i__4].imag + q__2.imag; y[i__3].real = q__1.real, y[i__3].imag = q__1.imag; - r_cnjg(&q__3, &ap[k]); + bla_r_cnjg(&q__3, &ap[k]); i__3 = ix; q__2.real = q__3.real * x[i__3].real - q__3.imag * x[i__3].imag, q__2.imag = q__3.real * x[i__3].imag + q__3.imag * x[i__3].real; @@ -467,9 +463,7 @@ -lf2c -lm (in that order) */ -/* Subroutine */ int PASTEF77(z,hpmv)(character *uplo, integer *n, doublecomplex *alpha, - doublecomplex *ap, doublecomplex *x, integer *incx, doublecomplex * - beta, doublecomplex *y, integer *incy) +/* Subroutine */ int PASTEF77(z,hpmv)(character *uplo, integer *n, doublecomplex *alpha, doublecomplex *ap, doublecomplex *x, integer *incx, doublecomplex *beta, doublecomplex *y, integer *incy) { /* System generated locals */ integer i__1, i__2, i__3, i__4, i__5; @@ -477,15 +471,15 @@ doublecomplex z__1, z__2, z__3, z__4; /* Builtin functions */ - void d_cnjg(doublecomplex *, doublecomplex *); + void bla_d_cnjg(doublecomplex *, doublecomplex *); /* Local variables */ integer info; doublecomplex temp1, temp2; integer i__, j, k; - extern logical lsame_(character *, character *, ftnlen, ftnlen); + extern logical PASTEF770(lsame)(character *, character *, ftnlen, ftnlen); integer kk, ix, iy, jx, jy, kx, ky; - extern /* Subroutine */ int xerbla_(character *, integer *, ftnlen); + extern /* Subroutine */ int PASTEF770(xerbla)(character *, integer *, ftnlen); /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ @@ -596,7 +590,7 @@ /* Function Body */ info = 0; - if (! lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && ! lsame_(uplo, "L", ( + if (! PASTEF770(lsame)(uplo, "U", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(uplo, "L", ( ftnlen)1, (ftnlen)1)) { info = 1; } else if (*n < 0) { @@ -607,7 +601,7 @@ info = 9; } if (info != 0) { - xerbla_("ZHPMV ", &info, (ftnlen)6); + PASTEF770(xerbla)("ZHPMV ", &info, (ftnlen)6); return 0; } @@ -686,7 +680,7 @@ return 0; } kk = 1; - if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) { + if (PASTEF770(lsame)(uplo, "U", (ftnlen)1, (ftnlen)1)) { /* Form y when AP contains the upper triangle. */ @@ -709,7 +703,7 @@ .real; z__1.real = y[i__4].real + z__2.real, z__1.imag = y[i__4].imag + z__2.imag; y[i__3].real = z__1.real, y[i__3].imag = z__1.imag; - d_cnjg(&z__3, &ap[k]); + bla_d_cnjg(&z__3, &ap[k]); i__3 = i__; z__2.real = z__3.real * x[i__3].real - z__3.imag * x[i__3].imag, z__2.imag = z__3.real * x[i__3].imag + z__3.imag * x[i__3].real; @@ -753,7 +747,7 @@ .real; z__1.real = y[i__4].real + z__2.real, z__1.imag = y[i__4].imag + z__2.imag; y[i__3].real = z__1.real, y[i__3].imag = z__1.imag; - d_cnjg(&z__3, &ap[k]); + bla_d_cnjg(&z__3, &ap[k]); i__3 = ix; z__2.real = z__3.real * x[i__3].real - z__3.imag * x[i__3].imag, z__2.imag = z__3.real * x[i__3].imag + z__3.imag * x[i__3].real; @@ -809,7 +803,7 @@ .real; z__1.real = y[i__4].real + z__2.real, z__1.imag = y[i__4].imag + z__2.imag; y[i__3].real = z__1.real, y[i__3].imag = z__1.imag; - d_cnjg(&z__3, &ap[k]); + bla_d_cnjg(&z__3, &ap[k]); i__3 = i__; z__2.real = z__3.real * x[i__3].real - z__3.imag * x[i__3].imag, z__2.imag = z__3.real * x[i__3].imag + z__3.imag * x[i__3].real; @@ -858,7 +852,7 @@ .real; z__1.real = y[i__4].real + z__2.real, z__1.imag = y[i__4].imag + z__2.imag; y[i__3].real = z__1.real, y[i__3].imag = z__1.imag; - d_cnjg(&z__3, &ap[k]); + bla_d_cnjg(&z__3, &ap[k]); i__3 = ix; z__2.real = z__3.real * x[i__3].real - z__3.imag * x[i__3].imag, z__2.imag = z__3.real * x[i__3].imag + z__3.imag * x[i__3].real; diff --git a/frame/compat/f2c/bla_hpmv.h b/frame/compat/f2c/bla_hpmv.h new file mode 100644 index 000000000..0de19e92c --- /dev/null +++ b/frame/compat/f2c/bla_hpmv.h @@ -0,0 +1,42 @@ +/* + + BLIS + An object-based framework for developing high-performance BLAS-like + libraries. + + Copyright (C) 2013, The University of Texas + + 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 The University of Texas 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 + HOLDER 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. + +*/ + +#include "blis.h" + +#ifdef BLIS_ENABLE_BLAS2BLIS + +int PASTEF77(c,hpmv)(character *uplo, integer *n, singlecomplex *alpha, singlecomplex * ap, singlecomplex *x, integer *incx, singlecomplex *beta, singlecomplex *y, integer *incy); +int PASTEF77(z,hpmv)(character *uplo, integer *n, doublecomplex *alpha, doublecomplex *ap, doublecomplex *x, integer *incx, doublecomplex *beta, doublecomplex *y, integer *incy); + +#endif diff --git a/frame/compat/f2c/bla_hpr.c b/frame/compat/f2c/bla_hpr.c index b58f28a75..69cb81806 100644 --- a/frame/compat/f2c/bla_hpr.c +++ b/frame/compat/f2c/bla_hpr.c @@ -36,15 +36,12 @@ #ifdef BLIS_ENABLE_BLAS2BLIS -#include "bli_f2c.h" - /* chpr.f -- translated by f2c (version 19991025). You must link the resulting object file with the libraries: -lf2c -lm (in that order) */ -/* Subroutine */ int PASTEF77(c,hpr)(character *uplo, integer *n, real *alpha, singlecomplex *x, - integer *incx, singlecomplex *ap) +/* Subroutine */ int PASTEF77(c,hpr)(character *uplo, integer *n, real *alpha, singlecomplex *x, integer *incx, singlecomplex *ap) { /* System generated locals */ integer i__1, i__2, i__3, i__4, i__5; @@ -52,15 +49,15 @@ singlecomplex q__1, q__2; /* Builtin functions */ - void r_cnjg(singlecomplex *, singlecomplex *); + void bla_r_cnjg(singlecomplex *, singlecomplex *); /* Local variables */ integer info; singlecomplex temp; integer i__, j, k; - extern logical lsame_(character *, character *, ftnlen, ftnlen); + extern logical PASTEF770(lsame)(character *, character *, ftnlen, ftnlen); integer kk, ix, jx, kx = 0; - extern /* Subroutine */ int xerbla_(character *, integer *, ftnlen); + extern /* Subroutine */ int PASTEF770(xerbla)(character *, integer *, ftnlen); /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ @@ -158,7 +155,7 @@ /* Function Body */ info = 0; - if (! lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && ! lsame_(uplo, "L", ( + if (! PASTEF770(lsame)(uplo, "U", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(uplo, "L", ( ftnlen)1, (ftnlen)1)) { info = 1; } else if (*n < 0) { @@ -167,7 +164,7 @@ info = 5; } if (info != 0) { - xerbla_("CHPR ", &info, (ftnlen)6); + PASTEF770(xerbla)("CHPR ", &info, (ftnlen)6); return 0; } @@ -189,7 +186,7 @@ /* are accessed sequentially with one pass through AP. */ kk = 1; - if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) { + if (PASTEF770(lsame)(uplo, "U", (ftnlen)1, (ftnlen)1)) { /* Form A when upper triangle is stored in AP. */ @@ -198,7 +195,7 @@ for (j = 1; j <= i__1; ++j) { i__2 = j; if (x[i__2].real != 0.f || x[i__2].imag != 0.f) { - r_cnjg(&q__2, &x[j]); + bla_r_cnjg(&q__2, &x[j]); q__1.real = *alpha * q__2.real, q__1.imag = *alpha * q__2.imag; temp.real = q__1.real, temp.imag = q__1.imag; k = kk; @@ -238,7 +235,7 @@ for (j = 1; j <= i__1; ++j) { i__2 = jx; if (x[i__2].real != 0.f || x[i__2].imag != 0.f) { - r_cnjg(&q__2, &x[jx]); + bla_r_cnjg(&q__2, &x[jx]); q__1.real = *alpha * q__2.real, q__1.imag = *alpha * q__2.imag; temp.real = q__1.real, temp.imag = q__1.imag; ix = kx; @@ -283,7 +280,7 @@ for (j = 1; j <= i__1; ++j) { i__2 = j; if (x[i__2].real != 0.f || x[i__2].imag != 0.f) { - r_cnjg(&q__2, &x[j]); + bla_r_cnjg(&q__2, &x[j]); q__1.real = *alpha * q__2.real, q__1.imag = *alpha * q__2.imag; temp.real = q__1.real, temp.imag = q__1.imag; i__2 = kk; @@ -323,7 +320,7 @@ for (j = 1; j <= i__1; ++j) { i__2 = jx; if (x[i__2].real != 0.f || x[i__2].imag != 0.f) { - r_cnjg(&q__2, &x[jx]); + bla_r_cnjg(&q__2, &x[jx]); q__1.real = *alpha * q__2.real, q__1.imag = *alpha * q__2.imag; temp.real = q__1.real, temp.imag = q__1.imag; i__2 = kk; @@ -372,8 +369,7 @@ -lf2c -lm (in that order) */ -/* Subroutine */ int PASTEF77(z,hpr)(character *uplo, integer *n, doublereal *alpha, - doublecomplex *x, integer *incx, doublecomplex *ap) +/* Subroutine */ int PASTEF77(z,hpr)(character *uplo, integer *n, doublereal *alpha, doublecomplex *x, integer *incx, doublecomplex *ap) { /* System generated locals */ integer i__1, i__2, i__3, i__4, i__5; @@ -381,15 +377,15 @@ doublecomplex z__1, z__2; /* Builtin functions */ - void d_cnjg(doublecomplex *, doublecomplex *); + void bla_d_cnjg(doublecomplex *, doublecomplex *); /* Local variables */ integer info; doublecomplex temp; integer i__, j, k; - extern logical lsame_(character *, character *, ftnlen, ftnlen); + extern logical PASTEF770(lsame)(character *, character *, ftnlen, ftnlen); integer kk, ix, jx, kx = 0; - extern /* Subroutine */ int xerbla_(character *, integer *, ftnlen); + extern /* Subroutine */ int PASTEF770(xerbla)(character *, integer *, ftnlen); /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ @@ -487,7 +483,7 @@ /* Function Body */ info = 0; - if (! lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && ! lsame_(uplo, "L", ( + if (! PASTEF770(lsame)(uplo, "U", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(uplo, "L", ( ftnlen)1, (ftnlen)1)) { info = 1; } else if (*n < 0) { @@ -496,7 +492,7 @@ info = 5; } if (info != 0) { - xerbla_("ZHPR ", &info, (ftnlen)6); + PASTEF770(xerbla)("ZHPR ", &info, (ftnlen)6); return 0; } @@ -518,7 +514,7 @@ /* are accessed sequentially with one pass through AP. */ kk = 1; - if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) { + if (PASTEF770(lsame)(uplo, "U", (ftnlen)1, (ftnlen)1)) { /* Form A when upper triangle is stored in AP. */ @@ -527,7 +523,7 @@ for (j = 1; j <= i__1; ++j) { i__2 = j; if (x[i__2].real != 0. || x[i__2].imag != 0.) { - d_cnjg(&z__2, &x[j]); + bla_d_cnjg(&z__2, &x[j]); z__1.real = *alpha * z__2.real, z__1.imag = *alpha * z__2.imag; temp.real = z__1.real, temp.imag = z__1.imag; k = kk; @@ -567,7 +563,7 @@ for (j = 1; j <= i__1; ++j) { i__2 = jx; if (x[i__2].real != 0. || x[i__2].imag != 0.) { - d_cnjg(&z__2, &x[jx]); + bla_d_cnjg(&z__2, &x[jx]); z__1.real = *alpha * z__2.real, z__1.imag = *alpha * z__2.imag; temp.real = z__1.real, temp.imag = z__1.imag; ix = kx; @@ -612,7 +608,7 @@ for (j = 1; j <= i__1; ++j) { i__2 = j; if (x[i__2].real != 0. || x[i__2].imag != 0.) { - d_cnjg(&z__2, &x[j]); + bla_d_cnjg(&z__2, &x[j]); z__1.real = *alpha * z__2.real, z__1.imag = *alpha * z__2.imag; temp.real = z__1.real, temp.imag = z__1.imag; i__2 = kk; @@ -652,7 +648,7 @@ for (j = 1; j <= i__1; ++j) { i__2 = jx; if (x[i__2].real != 0. || x[i__2].imag != 0.) { - d_cnjg(&z__2, &x[jx]); + bla_d_cnjg(&z__2, &x[jx]); z__1.real = *alpha * z__2.real, z__1.imag = *alpha * z__2.imag; temp.real = z__1.real, temp.imag = z__1.imag; i__2 = kk; diff --git a/frame/compat/f2c/bla_hpr.h b/frame/compat/f2c/bla_hpr.h new file mode 100644 index 000000000..2b421f59f --- /dev/null +++ b/frame/compat/f2c/bla_hpr.h @@ -0,0 +1,42 @@ +/* + + BLIS + An object-based framework for developing high-performance BLAS-like + libraries. + + Copyright (C) 2013, The University of Texas + + 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 The University of Texas 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 + HOLDER 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. + +*/ + +#include "blis.h" + +#ifdef BLIS_ENABLE_BLAS2BLIS + +int PASTEF77(c,hpr)(character *uplo, integer *n, real *alpha, singlecomplex *x, integer *incx, singlecomplex *ap); +int PASTEF77(z,hpr)(character *uplo, integer *n, doublereal *alpha, doublecomplex *x, integer *incx, doublecomplex *ap); + +#endif diff --git a/frame/compat/f2c/bla_hpr2.c b/frame/compat/f2c/bla_hpr2.c index 2a69cb8ca..d82f71f63 100644 --- a/frame/compat/f2c/bla_hpr2.c +++ b/frame/compat/f2c/bla_hpr2.c @@ -36,15 +36,12 @@ #ifdef BLIS_ENABLE_BLAS2BLIS -#include "bli_f2c.h" - /* chpr2.f -- translated by f2c (version 19991025). You must link the resulting object file with the libraries: -lf2c -lm (in that order) */ -/* Subroutine */ int PASTEF77(c,hpr2)(character *uplo, integer *n, singlecomplex *alpha, singlecomplex * - x, integer *incx, singlecomplex *y, integer *incy, singlecomplex *ap) +/* Subroutine */ int PASTEF77(c,hpr2)(character *uplo, integer *n, singlecomplex *alpha, singlecomplex *x, integer *incx, singlecomplex *y, integer *incy, singlecomplex *ap) { /* System generated locals */ integer i__1, i__2, i__3, i__4, i__5, i__6; @@ -52,15 +49,15 @@ singlecomplex q__1, q__2, q__3, q__4; /* Builtin functions */ - void r_cnjg(singlecomplex *, singlecomplex *); + void bla_r_cnjg(singlecomplex *, singlecomplex *); /* Local variables */ integer info; singlecomplex temp1, temp2; integer i__, j, k; - extern logical lsame_(character *, character *, ftnlen, ftnlen); + extern logical PASTEF770(lsame)(character *, character *, ftnlen, ftnlen); integer kk, ix, iy, jx = 0, jy = 0, kx = 0, ky = 0; - extern /* Subroutine */ int xerbla_(character *, integer *, ftnlen); + extern /* Subroutine */ int PASTEF770(xerbla)(character *, integer *, ftnlen); /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ @@ -170,7 +167,7 @@ /* Function Body */ info = 0; - if (! lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && ! lsame_(uplo, "L", ( + if (! PASTEF770(lsame)(uplo, "U", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(uplo, "L", ( ftnlen)1, (ftnlen)1)) { info = 1; } else if (*n < 0) { @@ -181,7 +178,7 @@ info = 7; } if (info != 0) { - xerbla_("CHPR2 ", &info, (ftnlen)6); + PASTEF770(xerbla)("CHPR2 ", &info, (ftnlen)6); return 0; } @@ -213,7 +210,7 @@ /* are accessed sequentially with one pass through AP. */ kk = 1; - if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) { + if (PASTEF770(lsame)(uplo, "U", (ftnlen)1, (ftnlen)1)) { /* Form A when upper triangle is stored in AP. */ @@ -224,7 +221,7 @@ i__3 = j; if (x[i__2].real != 0.f || x[i__2].imag != 0.f || (y[i__3].real != 0.f || y[i__3].imag != 0.f)) { - r_cnjg(&q__2, &y[j]); + bla_r_cnjg(&q__2, &y[j]); q__1.real = alpha->real * q__2.real - alpha->imag * q__2.imag, q__1.imag = alpha->real * q__2.imag + alpha->imag * q__2.real; temp1.real = q__1.real, temp1.imag = q__1.imag; @@ -232,7 +229,7 @@ q__2.real = alpha->real * x[i__2].real - alpha->imag * x[i__2].imag, q__2.imag = alpha->real * x[i__2].imag + alpha->imag * x[i__2] .real; - r_cnjg(&q__1, &q__2); + bla_r_cnjg(&q__1, &q__2); temp2.real = q__1.real, temp2.imag = q__1.imag; k = kk; i__2 = j - 1; @@ -283,7 +280,7 @@ i__3 = jy; if (x[i__2].real != 0.f || x[i__2].imag != 0.f || (y[i__3].real != 0.f || y[i__3].imag != 0.f)) { - r_cnjg(&q__2, &y[jy]); + bla_r_cnjg(&q__2, &y[jy]); q__1.real = alpha->real * q__2.real - alpha->imag * q__2.imag, q__1.imag = alpha->real * q__2.imag + alpha->imag * q__2.real; temp1.real = q__1.real, temp1.imag = q__1.imag; @@ -291,7 +288,7 @@ q__2.real = alpha->real * x[i__2].real - alpha->imag * x[i__2].imag, q__2.imag = alpha->real * x[i__2].imag + alpha->imag * x[i__2] .real; - r_cnjg(&q__1, &q__2); + bla_r_cnjg(&q__1, &q__2); temp2.real = q__1.real, temp2.imag = q__1.imag; ix = kx; iy = ky; @@ -351,7 +348,7 @@ i__3 = j; if (x[i__2].real != 0.f || x[i__2].imag != 0.f || (y[i__3].real != 0.f || y[i__3].imag != 0.f)) { - r_cnjg(&q__2, &y[j]); + bla_r_cnjg(&q__2, &y[j]); q__1.real = alpha->real * q__2.real - alpha->imag * q__2.imag, q__1.imag = alpha->real * q__2.imag + alpha->imag * q__2.real; temp1.real = q__1.real, temp1.imag = q__1.imag; @@ -359,7 +356,7 @@ q__2.real = alpha->real * x[i__2].real - alpha->imag * x[i__2].imag, q__2.imag = alpha->real * x[i__2].imag + alpha->imag * x[i__2] .real; - r_cnjg(&q__1, &q__2); + bla_r_cnjg(&q__1, &q__2); temp2.real = q__1.real, temp2.imag = q__1.imag; i__2 = kk; i__3 = kk; @@ -410,7 +407,7 @@ i__3 = jy; if (x[i__2].real != 0.f || x[i__2].imag != 0.f || (y[i__3].real != 0.f || y[i__3].imag != 0.f)) { - r_cnjg(&q__2, &y[jy]); + bla_r_cnjg(&q__2, &y[jy]); q__1.real = alpha->real * q__2.real - alpha->imag * q__2.imag, q__1.imag = alpha->real * q__2.imag + alpha->imag * q__2.real; temp1.real = q__1.real, temp1.imag = q__1.imag; @@ -418,7 +415,7 @@ q__2.real = alpha->real * x[i__2].real - alpha->imag * x[i__2].imag, q__2.imag = alpha->real * x[i__2].imag + alpha->imag * x[i__2] .real; - r_cnjg(&q__1, &q__2); + bla_r_cnjg(&q__1, &q__2); temp2.real = q__1.real, temp2.imag = q__1.imag; i__2 = kk; i__3 = kk; @@ -480,9 +477,7 @@ -lf2c -lm (in that order) */ -/* Subroutine */ int PASTEF77(z,hpr2)(character *uplo, integer *n, doublecomplex *alpha, - doublecomplex *x, integer *incx, doublecomplex *y, integer *incy, - doublecomplex *ap) +/* Subroutine */ int PASTEF77(z,hpr2)(character *uplo, integer *n, doublecomplex *alpha, doublecomplex *x, integer *incx, doublecomplex *y, integer *incy, doublecomplex *ap) { /* System generated locals */ integer i__1, i__2, i__3, i__4, i__5, i__6; @@ -490,15 +485,15 @@ doublecomplex z__1, z__2, z__3, z__4; /* Builtin functions */ - void d_cnjg(doublecomplex *, doublecomplex *); + void bla_d_cnjg(doublecomplex *, doublecomplex *); /* Local variables */ integer info; doublecomplex temp1, temp2; integer i__, j, k; - extern logical lsame_(character *, character *, ftnlen, ftnlen); + extern logical PASTEF770(lsame)(character *, character *, ftnlen, ftnlen); integer kk, ix, iy, jx = 0, jy = 0, kx = 0, ky = 0; - extern /* Subroutine */ int xerbla_(character *, integer *, ftnlen); + extern /* Subroutine */ int PASTEF770(xerbla)(character *, integer *, ftnlen); /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ @@ -608,7 +603,7 @@ /* Function Body */ info = 0; - if (! lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && ! lsame_(uplo, "L", ( + if (! PASTEF770(lsame)(uplo, "U", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(uplo, "L", ( ftnlen)1, (ftnlen)1)) { info = 1; } else if (*n < 0) { @@ -619,7 +614,7 @@ info = 7; } if (info != 0) { - xerbla_("ZHPR2 ", &info, (ftnlen)6); + PASTEF770(xerbla)("ZHPR2 ", &info, (ftnlen)6); return 0; } @@ -651,7 +646,7 @@ /* are accessed sequentially with one pass through AP. */ kk = 1; - if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) { + if (PASTEF770(lsame)(uplo, "U", (ftnlen)1, (ftnlen)1)) { /* Form A when upper triangle is stored in AP. */ @@ -662,7 +657,7 @@ i__3 = j; if (x[i__2].real != 0. || x[i__2].imag != 0. || (y[i__3].real != 0. || y[i__3].imag != 0.)) { - d_cnjg(&z__2, &y[j]); + bla_d_cnjg(&z__2, &y[j]); z__1.real = alpha->real * z__2.real - alpha->imag * z__2.imag, z__1.imag = alpha->real * z__2.imag + alpha->imag * z__2.real; temp1.real = z__1.real, temp1.imag = z__1.imag; @@ -670,7 +665,7 @@ z__2.real = alpha->real * x[i__2].real - alpha->imag * x[i__2].imag, z__2.imag = alpha->real * x[i__2].imag + alpha->imag * x[i__2] .real; - d_cnjg(&z__1, &z__2); + bla_d_cnjg(&z__1, &z__2); temp2.real = z__1.real, temp2.imag = z__1.imag; k = kk; i__2 = j - 1; @@ -721,7 +716,7 @@ i__3 = jy; if (x[i__2].real != 0. || x[i__2].imag != 0. || (y[i__3].real != 0. || y[i__3].imag != 0.)) { - d_cnjg(&z__2, &y[jy]); + bla_d_cnjg(&z__2, &y[jy]); z__1.real = alpha->real * z__2.real - alpha->imag * z__2.imag, z__1.imag = alpha->real * z__2.imag + alpha->imag * z__2.real; temp1.real = z__1.real, temp1.imag = z__1.imag; @@ -729,7 +724,7 @@ z__2.real = alpha->real * x[i__2].real - alpha->imag * x[i__2].imag, z__2.imag = alpha->real * x[i__2].imag + alpha->imag * x[i__2] .real; - d_cnjg(&z__1, &z__2); + bla_d_cnjg(&z__1, &z__2); temp2.real = z__1.real, temp2.imag = z__1.imag; ix = kx; iy = ky; @@ -789,7 +784,7 @@ i__3 = j; if (x[i__2].real != 0. || x[i__2].imag != 0. || (y[i__3].real != 0. || y[i__3].imag != 0.)) { - d_cnjg(&z__2, &y[j]); + bla_d_cnjg(&z__2, &y[j]); z__1.real = alpha->real * z__2.real - alpha->imag * z__2.imag, z__1.imag = alpha->real * z__2.imag + alpha->imag * z__2.real; temp1.real = z__1.real, temp1.imag = z__1.imag; @@ -797,7 +792,7 @@ z__2.real = alpha->real * x[i__2].real - alpha->imag * x[i__2].imag, z__2.imag = alpha->real * x[i__2].imag + alpha->imag * x[i__2] .real; - d_cnjg(&z__1, &z__2); + bla_d_cnjg(&z__1, &z__2); temp2.real = z__1.real, temp2.imag = z__1.imag; i__2 = kk; i__3 = kk; @@ -848,7 +843,7 @@ i__3 = jy; if (x[i__2].real != 0. || x[i__2].imag != 0. || (y[i__3].real != 0. || y[i__3].imag != 0.)) { - d_cnjg(&z__2, &y[jy]); + bla_d_cnjg(&z__2, &y[jy]); z__1.real = alpha->real * z__2.real - alpha->imag * z__2.imag, z__1.imag = alpha->real * z__2.imag + alpha->imag * z__2.real; temp1.real = z__1.real, temp1.imag = z__1.imag; @@ -856,7 +851,7 @@ z__2.real = alpha->real * x[i__2].real - alpha->imag * x[i__2].imag, z__2.imag = alpha->real * x[i__2].imag + alpha->imag * x[i__2] .real; - d_cnjg(&z__1, &z__2); + bla_d_cnjg(&z__1, &z__2); temp2.real = z__1.real, temp2.imag = z__1.imag; i__2 = kk; i__3 = kk; diff --git a/frame/compat/f2c/bla_hpr2.h b/frame/compat/f2c/bla_hpr2.h new file mode 100644 index 000000000..16ad20b4c --- /dev/null +++ b/frame/compat/f2c/bla_hpr2.h @@ -0,0 +1,42 @@ +/* + + BLIS + An object-based framework for developing high-performance BLAS-like + libraries. + + Copyright (C) 2013, The University of Texas + + 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 The University of Texas 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 + HOLDER 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. + +*/ + +#include "blis.h" + +#ifdef BLIS_ENABLE_BLAS2BLIS + +int PASTEF77(c,hpr2)(character *uplo, integer *n, singlecomplex *alpha, singlecomplex *x, integer *incx, singlecomplex *y, integer *incy, singlecomplex *ap); +int PASTEF77(z,hpr2)(character *uplo, integer *n, doublecomplex *alpha, doublecomplex *x, integer *incx, doublecomplex *y, integer *incy, doublecomplex *ap); + +#endif diff --git a/frame/compat/f2c/bla_lsame.c b/frame/compat/f2c/bla_lsame.c new file mode 100644 index 000000000..3c8cc3f1d --- /dev/null +++ b/frame/compat/f2c/bla_lsame.c @@ -0,0 +1,149 @@ +/* + + BLIS + An object-based framework for developing high-performance BLAS-like + libraries. + + Copyright (C) 2013, The University of Texas + + 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 The University of Texas 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 + HOLDER 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. + +*/ + +#include "blis.h" + +#ifdef BLIS_ENABLE_BLAS2BLIS + +/* lsame.f -- translated by f2c (version 19991025). + You must link the resulting object file with the libraries: + -lf2c -lm (in that order) +*/ + +logical PASTEF770(lsame)(character *ca, character *cb, ftnlen ca_len, ftnlen cb_len) +{ + /* System generated locals */ + logical ret_val; + + /* Local variables */ + integer inta, intb, zcode; + + +/* -- LAPACK auxiliary routine (version 2.0) -- */ +/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */ +/* Courant Institute, Argonne National Lab, and Rice University */ +/* January 31, 1994 */ + +/* .. Scalar Arguments .. */ +/* .. */ + +/* Purpose */ +/* ======= */ + +/* LSAME returns .TRUE. if CA is the same letter as CB regardless of */ +/* case. */ + +/* Arguments */ +/* ========= */ + +/* CA (input) CHARACTER*1 */ +/* CB (input) CHARACTER*1 */ +/* CA and CB specify the single characters to be compared. */ + +/* ===================================================================== */ + +/* .. Intrinsic Functions .. */ +/* .. */ +/* .. Local Scalars .. */ +/* .. */ +/* .. Executable Statements .. */ + +/* Test if the characters are equal */ + + ret_val = *(unsigned char *)ca == *(unsigned char *)cb; + if (ret_val) { + return ret_val; + } + +/* Now test for equivalence if both characters are alphabetic. */ + + zcode = 'Z'; + +/* Use 'Z' rather than 'A' so that ASCII can be detected on Prime */ +/* machines, on which ICHAR returns a value with bit 8 set. */ +/* ICHAR('A') on Prime machines returns 193 which is the same as */ +/* ICHAR('A') on an EBCDIC machine. */ + + inta = *(unsigned char *)ca; + intb = *(unsigned char *)cb; + + if (zcode == 90 || zcode == 122) { + +/* ASCII is assumed - ZCODE is the ASCII code of either lower or */ +/* upper case 'Z'. */ + + if (inta >= 97 && inta <= 122) { + inta += -32; + } + if (intb >= 97 && intb <= 122) { + intb += -32; + } + + } else if (zcode == 233 || zcode == 169) { + +/* EBCDIC is assumed - ZCODE is the EBCDIC code of either lower or */ +/* upper case 'Z'. */ + + if ((inta >= 129 && inta <= 137) || (inta >= 145 && inta <= 153) || (inta + >= 162 && inta <= 169)) { + inta += 64; + } + if ((intb >= 129 && intb <= 137) || (intb >= 145 && intb <= 153) || (intb + >= 162 && intb <= 169)) { + intb += 64; + } + + } else if (zcode == 218 || zcode == 250) { + +/* ASCII is assumed, on Prime machines - ZCODE is the ASCII code */ +/* plus 128 of either lower or upper case 'Z'. */ + + if (inta >= 225 && inta <= 250) { + inta += -32; + } + if (intb >= 225 && intb <= 250) { + intb += -32; + } + } + ret_val = inta == intb; + +/* RETURN */ + +/* End of LSAME */ + + return ret_val; +} /* lsame */ + +#endif + diff --git a/frame/compat/f2c/bla_lsame.h b/frame/compat/f2c/bla_lsame.h new file mode 100644 index 000000000..b4a5cf342 --- /dev/null +++ b/frame/compat/f2c/bla_lsame.h @@ -0,0 +1,41 @@ +/* + + BLIS + An object-based framework for developing high-performance BLAS-like + libraries. + + Copyright (C) 2013, The University of Texas + + 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 The University of Texas 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 + HOLDER 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. + +*/ + +#include "blis.h" + +#ifdef BLIS_ENABLE_BLAS2BLIS + +logical PASTEF770(lsame)(character *ca, character *cb, ftnlen ca_len, ftnlen cb_len); + +#endif diff --git a/frame/compat/f2c/bla_rot.c b/frame/compat/f2c/bla_rot.c index 890be1c38..e4c648351 100644 --- a/frame/compat/f2c/bla_rot.c +++ b/frame/compat/f2c/bla_rot.c @@ -36,15 +36,12 @@ #ifdef BLIS_ENABLE_BLAS2BLIS -#include "bli_f2c.h" - /* srot.f -- translated by f2c (version 19991025). You must link the resulting object file with the libraries: -lf2c -lm (in that order) */ -/* Subroutine */ int PASTEF77(s,rot)(integer *n, real *sx, integer *incx, real *sy, - integer *incy, real *c__, real *s) +/* Subroutine */ int PASTEF77(s,rot)(integer *n, real *sx, integer *incx, real *sy, integer *incy, real *c__, real *s) { /* System generated locals */ integer i__1; @@ -112,8 +109,7 @@ L20: -lf2c -lm (in that order) */ -/* Subroutine */ int PASTEF77(d,rot)(integer *n, doublereal *dx, integer *incx, - doublereal *dy, integer *incy, doublereal *c__, doublereal *s) +/* Subroutine */ int PASTEF77(d,rot)(integer *n, doublereal *dx, integer *incx, doublereal *dy, integer *incy, doublereal *c__, doublereal *s) { /* System generated locals */ integer i__1; @@ -181,8 +177,7 @@ L20: -lf2c -lm (in that order) */ -/* Subroutine */ int PASTEF77(cs,rot)(integer *n, singlecomplex *cx, integer *incx, singlecomplex * - cy, integer *incy, real *c__, real *s) +/* Subroutine */ int PASTEF77(cs,rot)(integer *n, singlecomplex *cx, integer *incx, singlecomplex *cy, integer *incy, real *c__, real *s) { /* System generated locals */ integer i__1, i__2, i__3, i__4; @@ -275,8 +270,7 @@ L20: -lf2c -lm (in that order) */ -/* Subroutine */ int PASTEF77(zd,rot)(integer *n, doublecomplex *zx, integer *incx, - doublecomplex *zy, integer *incy, doublereal *c__, doublereal *s) +/* Subroutine */ int PASTEF77(zd,rot)(integer *n, doublecomplex *zx, integer *incx, doublecomplex *zy, integer *incy, doublereal *c__, doublereal *s) { /* System generated locals */ integer i__1, i__2, i__3, i__4; diff --git a/frame/compat/f2c/bla_rot.h b/frame/compat/f2c/bla_rot.h new file mode 100644 index 000000000..18b748b72 --- /dev/null +++ b/frame/compat/f2c/bla_rot.h @@ -0,0 +1,44 @@ +/* + + BLIS + An object-based framework for developing high-performance BLAS-like + libraries. + + Copyright (C) 2013, The University of Texas + + 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 The University of Texas 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 + HOLDER 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. + +*/ + +#include "blis.h" + +#ifdef BLIS_ENABLE_BLAS2BLIS + +int PASTEF77(s,rot)(integer *n, real *sx, integer *incx, real *sy, integer *incy, real *c__, real *s); +int PASTEF77(d,rot)(integer *n, doublereal *dx, integer *incx, doublereal *dy, integer *incy, doublereal *c__, doublereal *s); +int PASTEF77(cs,rot)(integer *n, singlecomplex *cx, integer *incx, singlecomplex *cy, integer *incy, real *c__, real *s); +int PASTEF77(zd,rot)(integer *n, doublecomplex *zx, integer *incx, doublecomplex *zy, integer *incy, doublereal *c__, doublereal *s); + +#endif diff --git a/frame/compat/f2c/bla_rotg.c b/frame/compat/f2c/bla_rotg.c index b8b9d35d1..5aa3bd569 100644 --- a/frame/compat/f2c/bla_rotg.c +++ b/frame/compat/f2c/bla_rotg.c @@ -36,8 +36,6 @@ #ifdef BLIS_ENABLE_BLAS2BLIS -#include "bli_f2c.h" - /* srotg.f -- translated by f2c (version 19991025). You must link the resulting object file with the libraries: -lf2c -lm (in that order) @@ -107,8 +105,7 @@ L20: static doublereal dc_b4 = 1.; -/* Subroutine */ int PASTEF77(d,rotg)(doublereal *da, doublereal *db, doublereal *c__, - doublereal *s) +/* Subroutine */ int PASTEF77(d,rotg)(doublereal *da, doublereal *db, doublereal *c__, doublereal *s) { /* System generated locals */ doublereal d__1, d__2; @@ -172,7 +169,7 @@ L20: /* Builtin functions */ double c_abs(singlecomplex *), sqrt(doublereal); - void r_cnjg(singlecomplex *, singlecomplex *); + void bla_r_cnjg(singlecomplex *, singlecomplex *); /* Local variables */ real norm; @@ -199,7 +196,7 @@ L10: q__1.real = ca->real / r__1, q__1.imag = ca->imag / r__1; alpha.real = q__1.real, alpha.imag = q__1.imag; *c__ = c_abs(ca) / norm; - r_cnjg(&q__3, cb); + bla_r_cnjg(&q__3, cb); q__2.real = alpha.real * q__3.real - alpha.imag * q__3.imag, q__2.imag = alpha.real * q__3.imag + alpha.imag * q__3.real; q__1.real = q__2.real / norm, q__1.imag = q__2.imag / norm; @@ -215,8 +212,7 @@ L20: -lf2c -lm (in that order) */ -/* Subroutine */ int PASTEF77(z,rotg)(doublecomplex *ca, doublecomplex *cb, doublereal * - c__, doublecomplex *s) +/* Subroutine */ int PASTEF77(z,rotg)(doublecomplex *ca, doublecomplex *cb, doublereal *c__, doublecomplex *s) { /* System generated locals */ doublereal d__1, d__2; @@ -224,9 +220,9 @@ L20: /* Builtin functions */ double z_abs(doublecomplex *); - void z_div(doublecomplex *, doublecomplex *, doublecomplex *); + void bla_z_div(doublecomplex *, doublecomplex *, doublecomplex *); double sqrt(doublereal); - void d_cnjg(doublecomplex *, doublecomplex *); + void bla_d_cnjg(doublecomplex *, doublecomplex *); /* Local variables */ doublereal norm; @@ -243,11 +239,11 @@ L20: L10: scale = z_abs(ca) + z_abs(cb); z__2.real = scale, z__2.imag = 0.; - z_div(&z__1, ca, &z__2); + bla_z_div(&z__1, ca, &z__2); /* Computing 2nd power */ d__1 = z_abs(&z__1); z__4.real = scale, z__4.imag = 0.; - z_div(&z__3, cb, &z__4); + bla_z_div(&z__3, cb, &z__4); /* Computing 2nd power */ d__2 = z_abs(&z__3); norm = scale * sqrt(d__1 * d__1 + d__2 * d__2); @@ -255,7 +251,7 @@ L10: z__1.real = ca->real / d__1, z__1.imag = ca->imag / d__1; alpha.real = z__1.real, alpha.imag = z__1.imag; *c__ = z_abs(ca) / norm; - d_cnjg(&z__3, cb); + bla_d_cnjg(&z__3, cb); z__2.real = alpha.real * z__3.real - alpha.imag * z__3.imag, z__2.imag = alpha.real * z__3.imag + alpha.imag * z__3.real; z__1.real = z__2.real / norm, z__1.imag = z__2.imag / norm; diff --git a/frame/compat/f2c/bla_rotg.h b/frame/compat/f2c/bla_rotg.h new file mode 100644 index 000000000..d783232bc --- /dev/null +++ b/frame/compat/f2c/bla_rotg.h @@ -0,0 +1,44 @@ +/* + + BLIS + An object-based framework for developing high-performance BLAS-like + libraries. + + Copyright (C) 2013, The University of Texas + + 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 The University of Texas 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 + HOLDER 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. + +*/ + +#include "blis.h" + +#ifdef BLIS_ENABLE_BLAS2BLIS + +int PASTEF77(s,rotg)(real *sa, real *sb, real *c__, real *s); +int PASTEF77(d,rotg)(doublereal *da, doublereal *db, doublereal *c__, doublereal *s); +int PASTEF77(c,rotg)(singlecomplex *ca, singlecomplex *cb, real *c__, singlecomplex *s); +int PASTEF77(z,rotg)(doublecomplex *ca, doublecomplex *cb, doublereal *c__, doublecomplex *s); + +#endif diff --git a/frame/compat/f2c/bla_rotm.c b/frame/compat/f2c/bla_rotm.c index 0fdd4c77e..ed2142e8e 100644 --- a/frame/compat/f2c/bla_rotm.c +++ b/frame/compat/f2c/bla_rotm.c @@ -36,15 +36,12 @@ #ifdef BLIS_ENABLE_BLAS2BLIS -#include "bli_f2c.h" - /* srotm.f -- translated by f2c (version 19991025). You must link the resulting object file with the libraries: -lf2c -lm (in that order) */ -/* Subroutine */ int PASTEF77(s,rotm)(integer *n, real *sx, integer *incx, real *sy, - integer *incy, real *sparam) +/* Subroutine */ int PASTEF77(s,rotm)(integer *n, real *sx, integer *incx, real *sy, integer *incy, real *sparam) { /* Initialized data */ @@ -210,8 +207,7 @@ L140: -lf2c -lm (in that order) */ -/* Subroutine */ int PASTEF77(d,rotm)(integer *n, doublereal *dx, integer *incx, - doublereal *dy, integer *incy, doublereal *dparam) +/* Subroutine */ int PASTEF77(d,rotm)(integer *n, doublereal *dx, integer *incx, doublereal *dy, integer *incy, doublereal *dparam) { /* Initialized data */ diff --git a/frame/compat/f2c/bla_rotm.h b/frame/compat/f2c/bla_rotm.h new file mode 100644 index 000000000..39e0a8cc6 --- /dev/null +++ b/frame/compat/f2c/bla_rotm.h @@ -0,0 +1,42 @@ +/* + + BLIS + An object-based framework for developing high-performance BLAS-like + libraries. + + Copyright (C) 2013, The University of Texas + + 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 The University of Texas 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 + HOLDER 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. + +*/ + +#include "blis.h" + +#ifdef BLIS_ENABLE_BLAS2BLIS + +int PASTEF77(s,rotm)(integer *n, real *sx, integer *incx, real *sy, integer *incy, real *sparam); +int PASTEF77(d,rotm)(integer *n, doublereal *dx, integer *incx, doublereal *dy, integer *incy, doublereal *dparam); + +#endif diff --git a/frame/compat/f2c/bla_rotmg.c b/frame/compat/f2c/bla_rotmg.c index 4f2ca26de..2fb63c150 100644 --- a/frame/compat/f2c/bla_rotmg.c +++ b/frame/compat/f2c/bla_rotmg.c @@ -36,15 +36,12 @@ #ifdef BLIS_ENABLE_BLAS2BLIS -#include "bli_f2c.h" - /* srotmg.f -- translated by f2c (version 19991025). You must link the resulting object file with the libraries: -lf2c -lm (in that order) */ -/* Subroutine */ int PASTEF77(s,rotmg)(real *sd1, real *sd2, real *sx1, real *sy1, real - *sparam) +/* Subroutine */ int PASTEF77(s,rotmg)(real *sd1, real *sd2, real *sx1, real *sy1, real *sparam) { /* Initialized data */ @@ -293,8 +290,7 @@ L260: -lf2c -lm (in that order) */ -/* Subroutine */ int PASTEF77(d,rotmg)(doublereal *dd1, doublereal *dd2, doublereal * - dx1, doublereal *dy1, doublereal *dparam) +/* Subroutine */ int PASTEF77(d,rotmg)(doublereal *dd1, doublereal *dd2, doublereal *dx1, doublereal *dy1, doublereal *dparam) { /* Initialized data */ diff --git a/frame/compat/f2c/bla_rotmg.h b/frame/compat/f2c/bla_rotmg.h new file mode 100644 index 000000000..6dc740ede --- /dev/null +++ b/frame/compat/f2c/bla_rotmg.h @@ -0,0 +1,42 @@ +/* + + BLIS + An object-based framework for developing high-performance BLAS-like + libraries. + + Copyright (C) 2013, The University of Texas + + 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 The University of Texas 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 + HOLDER 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. + +*/ + +#include "blis.h" + +#ifdef BLIS_ENABLE_BLAS2BLIS + +int PASTEF77(s,rotmg)(real *sd1, real *sd2, real *sx1, real *sy1, real *sparam); +int PASTEF77(d,rotmg)(doublereal *dd1, doublereal *dd2, doublereal *dx1, doublereal *dy1, doublereal *dparam); + +#endif diff --git a/frame/compat/f2c/bla_sbmv.c b/frame/compat/f2c/bla_sbmv.c index 388b5f525..4646e9376 100644 --- a/frame/compat/f2c/bla_sbmv.c +++ b/frame/compat/f2c/bla_sbmv.c @@ -36,16 +36,12 @@ #ifdef BLIS_ENABLE_BLAS2BLIS -#include "bli_f2c.h" - /* dsbmv.f -- translated by f2c (version 19991025). You must link the resulting object file with the libraries: -lf2c -lm (in that order) */ -/* Subroutine */ int PASTEF77(d,sbmv)(character *uplo, integer *n, integer *k, doublereal * - alpha, doublereal *a, integer *lda, doublereal *x, integer *incx, - doublereal *beta, doublereal *y, integer *incy) +/* Subroutine */ int PASTEF77(d,sbmv)(character *uplo, integer *n, integer *k, doublereal *alpha, doublereal *a, integer *lda, doublereal *x, integer *incx, doublereal *beta, doublereal *y, integer *incy) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3, i__4; @@ -54,9 +50,9 @@ integer info; doublereal temp1, temp2; integer i__, j, l; - extern logical lsame_(character *, character *, ftnlen, ftnlen); + extern logical PASTEF770(lsame)(character *, character *, ftnlen, ftnlen); integer kplus1, ix, iy, jx, jy, kx, ky; - extern /* Subroutine */ int xerbla_(character *, integer *, ftnlen); + extern /* Subroutine */ int PASTEF770(xerbla)(character *, integer *, ftnlen); /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ @@ -201,7 +197,7 @@ /* Function Body */ info = 0; - if (! lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && ! lsame_(uplo, "L", ( + if (! PASTEF770(lsame)(uplo, "U", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(uplo, "L", ( ftnlen)1, (ftnlen)1)) { info = 1; } else if (*n < 0) { @@ -216,7 +212,7 @@ info = 11; } if (info != 0) { - xerbla_("DSBMV ", &info, (ftnlen)6); + PASTEF770(xerbla)("DSBMV ", &info, (ftnlen)6); return 0; } @@ -281,7 +277,7 @@ if (*alpha == 0.) { return 0; } - if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) { + if (PASTEF770(lsame)(uplo, "U", (ftnlen)1, (ftnlen)1)) { /* Form y when upper triangle of A is stored. */ @@ -396,9 +392,7 @@ -lf2c -lm (in that order) */ -/* Subroutine */ int PASTEF77(s,sbmv)(character *uplo, integer *n, integer *k, real *alpha, - real *a, integer *lda, real *x, integer *incx, real *beta, real *y, - integer *incy) +/* Subroutine */ int PASTEF77(s,sbmv)(character *uplo, integer *n, integer *k, real *alpha, real *a, integer *lda, real *x, integer *incx, real *beta, real *y, integer *incy) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3, i__4; @@ -407,9 +401,9 @@ integer info; real temp1, temp2; integer i__, j, l; - extern logical lsame_(character *, character *, ftnlen, ftnlen); + extern logical PASTEF770(lsame)(character *, character *, ftnlen, ftnlen); integer kplus1, ix, iy, jx, jy, kx, ky; - extern /* Subroutine */ int xerbla_(character *, integer *, ftnlen); + extern /* Subroutine */ int PASTEF770(xerbla)(character *, integer *, ftnlen); /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ @@ -554,7 +548,7 @@ /* Function Body */ info = 0; - if (! lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && ! lsame_(uplo, "L", ( + if (! PASTEF770(lsame)(uplo, "U", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(uplo, "L", ( ftnlen)1, (ftnlen)1)) { info = 1; } else if (*n < 0) { @@ -569,7 +563,7 @@ info = 11; } if (info != 0) { - xerbla_("SSBMV ", &info, (ftnlen)6); + PASTEF770(xerbla)("SSBMV ", &info, (ftnlen)6); return 0; } @@ -634,7 +628,7 @@ if (*alpha == 0.f) { return 0; } - if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) { + if (PASTEF770(lsame)(uplo, "U", (ftnlen)1, (ftnlen)1)) { /* Form y when upper triangle of A is stored. */ diff --git a/frame/compat/f2c/bla_sbmv.h b/frame/compat/f2c/bla_sbmv.h new file mode 100644 index 000000000..c12cc4288 --- /dev/null +++ b/frame/compat/f2c/bla_sbmv.h @@ -0,0 +1,42 @@ +/* + + BLIS + An object-based framework for developing high-performance BLAS-like + libraries. + + Copyright (C) 2013, The University of Texas + + 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 The University of Texas 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 + HOLDER 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. + +*/ + +#include "blis.h" + +#ifdef BLIS_ENABLE_BLAS2BLIS + +int PASTEF77(d,sbmv)(character *uplo, integer *n, integer *k, doublereal *alpha, doublereal *a, integer *lda, doublereal *x, integer *incx, doublereal *beta, doublereal *y, integer *incy); +int PASTEF77(s,sbmv)(character *uplo, integer *n, integer *k, real *alpha, real *a, integer *lda, real *x, integer *incx, real *beta, real *y, integer *incy); + +#endif diff --git a/frame/compat/f2c/bla_spmv.c b/frame/compat/f2c/bla_spmv.c index 6655b8774..23e79fbfb 100644 --- a/frame/compat/f2c/bla_spmv.c +++ b/frame/compat/f2c/bla_spmv.c @@ -36,16 +36,12 @@ #ifdef BLIS_ENABLE_BLAS2BLIS -#include "bli_f2c.h" - /* dspmv.f -- translated by f2c (version 19991025). You must link the resulting object file with the libraries: -lf2c -lm (in that order) */ -/* Subroutine */ int PASTEF77(d,spmv)(character *uplo, integer *n, doublereal *alpha, - doublereal *ap, doublereal *x, integer *incx, doublereal *beta, - doublereal *y, integer *incy) +/* Subroutine */ int PASTEF77(d,spmv)(character *uplo, integer *n, doublereal *alpha, doublereal *ap, doublereal *x, integer *incx, doublereal *beta, doublereal *y, integer *incy) { /* System generated locals */ integer i__1, i__2; @@ -54,9 +50,9 @@ integer info; doublereal temp1, temp2; integer i__, j, k; - extern logical lsame_(character *, character *, ftnlen, ftnlen); + extern logical PASTEF770(lsame)(character *, character *, ftnlen, ftnlen); integer kk, ix, iy, jx, jy, kx, ky; - extern /* Subroutine */ int xerbla_(character *, integer *, ftnlen); + extern /* Subroutine */ int PASTEF770(xerbla)(character *, integer *, ftnlen); /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ @@ -164,7 +160,7 @@ /* Function Body */ info = 0; - if (! lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && ! lsame_(uplo, "L", ( + if (! PASTEF770(lsame)(uplo, "U", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(uplo, "L", ( ftnlen)1, (ftnlen)1)) { info = 1; } else if (*n < 0) { @@ -175,7 +171,7 @@ info = 9; } if (info != 0) { - xerbla_("DSPMV ", &info, (ftnlen)6); + PASTEF770(xerbla)("DSPMV ", &info, (ftnlen)6); return 0; } @@ -241,7 +237,7 @@ return 0; } kk = 1; - if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) { + if (PASTEF770(lsame)(uplo, "U", (ftnlen)1, (ftnlen)1)) { /* Form y when AP contains the upper triangle. */ @@ -346,8 +342,7 @@ -lf2c -lm (in that order) */ -/* Subroutine */ int PASTEF77(s,spmv)(character *uplo, integer *n, real *alpha, real *ap, - real *x, integer *incx, real *beta, real *y, integer *incy) +/* Subroutine */ int PASTEF77(s,spmv)(character *uplo, integer *n, real *alpha, real *ap, real *x, integer *incx, real *beta, real *y, integer *incy) { /* System generated locals */ integer i__1, i__2; @@ -356,9 +351,9 @@ integer info; real temp1, temp2; integer i__, j, k; - extern logical lsame_(character *, character *, ftnlen, ftnlen); + extern logical PASTEF770(lsame)(character *, character *, ftnlen, ftnlen); integer kk, ix, iy, jx, jy, kx, ky; - extern /* Subroutine */ int xerbla_(character *, integer *, ftnlen); + extern /* Subroutine */ int PASTEF770(xerbla)(character *, integer *, ftnlen); /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ @@ -466,7 +461,7 @@ /* Function Body */ info = 0; - if (! lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && ! lsame_(uplo, "L", ( + if (! PASTEF770(lsame)(uplo, "U", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(uplo, "L", ( ftnlen)1, (ftnlen)1)) { info = 1; } else if (*n < 0) { @@ -477,7 +472,7 @@ info = 9; } if (info != 0) { - xerbla_("SSPMV ", &info, (ftnlen)6); + PASTEF770(xerbla)("SSPMV ", &info, (ftnlen)6); return 0; } @@ -543,7 +538,7 @@ return 0; } kk = 1; - if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) { + if (PASTEF770(lsame)(uplo, "U", (ftnlen)1, (ftnlen)1)) { /* Form y when AP contains the upper triangle. */ diff --git a/frame/compat/f2c/bla_spmv.h b/frame/compat/f2c/bla_spmv.h new file mode 100644 index 000000000..aef1db8ea --- /dev/null +++ b/frame/compat/f2c/bla_spmv.h @@ -0,0 +1,42 @@ +/* + + BLIS + An object-based framework for developing high-performance BLAS-like + libraries. + + Copyright (C) 2013, The University of Texas + + 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 The University of Texas 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 + HOLDER 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. + +*/ + +#include "blis.h" + +#ifdef BLIS_ENABLE_BLAS2BLIS + +int PASTEF77(d,spmv)(character *uplo, integer *n, doublereal *alpha, doublereal *ap, doublereal *x, integer *incx, doublereal *beta, doublereal *y, integer *incy); +int PASTEF77(s,spmv)(character *uplo, integer *n, real *alpha, real *ap, real *x, integer *incx, real *beta, real *y, integer *incy); + +#endif diff --git a/frame/compat/f2c/bla_spr.c b/frame/compat/f2c/bla_spr.c index bd370040a..a7eea5ea0 100644 --- a/frame/compat/f2c/bla_spr.c +++ b/frame/compat/f2c/bla_spr.c @@ -36,15 +36,12 @@ #ifdef BLIS_ENABLE_BLAS2BLIS -#include "bli_f2c.h" - /* dspr.f -- translated by f2c (version 19991025). You must link the resulting object file with the libraries: -lf2c -lm (in that order) */ -/* Subroutine */ int PASTEF77(d,spr)(character *uplo, integer *n, doublereal *alpha, - doublereal *x, integer *incx, doublereal *ap) +/* Subroutine */ int PASTEF77(d,spr)(character *uplo, integer *n, doublereal *alpha, doublereal *x, integer *incx, doublereal *ap) { /* System generated locals */ integer i__1, i__2; @@ -53,9 +50,9 @@ integer info; doublereal temp; integer i__, j, k; - extern logical lsame_(character *, character *, ftnlen, ftnlen); + extern logical PASTEF770(lsame)(character *, character *, ftnlen, ftnlen); integer kk, ix, jx, kx = 0; - extern /* Subroutine */ int xerbla_(character *, integer *, ftnlen); + extern /* Subroutine */ int PASTEF770(xerbla)(character *, integer *, ftnlen); /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ @@ -149,7 +146,7 @@ /* Function Body */ info = 0; - if (! lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && ! lsame_(uplo, "L", ( + if (! PASTEF770(lsame)(uplo, "U", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(uplo, "L", ( ftnlen)1, (ftnlen)1)) { info = 1; } else if (*n < 0) { @@ -158,7 +155,7 @@ info = 5; } if (info != 0) { - xerbla_("DSPR ", &info, (ftnlen)6); + PASTEF770(xerbla)("DSPR ", &info, (ftnlen)6); return 0; } @@ -180,7 +177,7 @@ /* are accessed sequentially with one pass through AP. */ kk = 1; - if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) { + if (PASTEF770(lsame)(uplo, "U", (ftnlen)1, (ftnlen)1)) { /* Form A when upper triangle is stored in AP. */ @@ -271,8 +268,7 @@ -lf2c -lm (in that order) */ -/* Subroutine */ int PASTEF77(s,spr)(character *uplo, integer *n, real *alpha, real *x, - integer *incx, real *ap) +/* Subroutine */ int PASTEF77(s,spr)(character *uplo, integer *n, real *alpha, real *x, integer *incx, real *ap) { /* System generated locals */ integer i__1, i__2; @@ -281,9 +277,9 @@ integer info; real temp; integer i__, j, k; - extern logical lsame_(character *, character *, ftnlen, ftnlen); + extern logical PASTEF770(lsame)(character *, character *, ftnlen, ftnlen); integer kk, ix, jx, kx = 0; - extern /* Subroutine */ int xerbla_(character *, integer *, ftnlen); + extern /* Subroutine */ int PASTEF770(xerbla)(character *, integer *, ftnlen); /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ @@ -377,7 +373,7 @@ /* Function Body */ info = 0; - if (! lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && ! lsame_(uplo, "L", ( + if (! PASTEF770(lsame)(uplo, "U", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(uplo, "L", ( ftnlen)1, (ftnlen)1)) { info = 1; } else if (*n < 0) { @@ -386,7 +382,7 @@ info = 5; } if (info != 0) { - xerbla_("SSPR ", &info, (ftnlen)6); + PASTEF770(xerbla)("SSPR ", &info, (ftnlen)6); return 0; } @@ -408,7 +404,7 @@ /* are accessed sequentially with one pass through AP. */ kk = 1; - if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) { + if (PASTEF770(lsame)(uplo, "U", (ftnlen)1, (ftnlen)1)) { /* Form A when upper triangle is stored in AP. */ diff --git a/frame/compat/f2c/bla_spr.h b/frame/compat/f2c/bla_spr.h new file mode 100644 index 000000000..3c1668822 --- /dev/null +++ b/frame/compat/f2c/bla_spr.h @@ -0,0 +1,42 @@ +/* + + BLIS + An object-based framework for developing high-performance BLAS-like + libraries. + + Copyright (C) 2013, The University of Texas + + 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 The University of Texas 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 + HOLDER 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. + +*/ + +#include "blis.h" + +#ifdef BLIS_ENABLE_BLAS2BLIS + +int PASTEF77(d,spr)(character *uplo, integer *n, doublereal *alpha, doublereal *x, integer *incx, doublereal *ap); +int PASTEF77(s,spr)(character *uplo, integer *n, real *alpha, real *x, integer *incx, real *ap); + +#endif diff --git a/frame/compat/f2c/bla_spr2.c b/frame/compat/f2c/bla_spr2.c index 9814322fc..c2cb0c583 100644 --- a/frame/compat/f2c/bla_spr2.c +++ b/frame/compat/f2c/bla_spr2.c @@ -36,16 +36,12 @@ #ifdef BLIS_ENABLE_BLAS2BLIS -#include "bli_f2c.h" - /* dspr2.f -- translated by f2c (version 19991025). You must link the resulting object file with the libraries: -lf2c -lm (in that order) */ -/* Subroutine */ int PASTEF77(d,spr2)(character *uplo, integer *n, doublereal *alpha, - doublereal *x, integer *incx, doublereal *y, integer *incy, - doublereal *ap) +/* Subroutine */ int PASTEF77(d,spr2)(character *uplo, integer *n, doublereal *alpha, doublereal *x, integer *incx, doublereal *y, integer *incy, doublereal *ap) { /* System generated locals */ integer i__1, i__2; @@ -54,9 +50,9 @@ integer info; doublereal temp1, temp2; integer i__, j, k; - extern logical lsame_(character *, character *, ftnlen, ftnlen); + extern logical PASTEF770(lsame)(character *, character *, ftnlen, ftnlen); integer kk, ix, iy, jx = 0, jy = 0, kx = 0, ky = 0; - extern /* Subroutine */ int xerbla_(character *, integer *, ftnlen); + extern /* Subroutine */ int PASTEF770(xerbla)(character *, integer *, ftnlen); /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ @@ -162,7 +158,7 @@ /* Function Body */ info = 0; - if (! lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && ! lsame_(uplo, "L", ( + if (! PASTEF770(lsame)(uplo, "U", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(uplo, "L", ( ftnlen)1, (ftnlen)1)) { info = 1; } else if (*n < 0) { @@ -173,7 +169,7 @@ info = 7; } if (info != 0) { - xerbla_("DSPR2 ", &info, (ftnlen)6); + PASTEF770(xerbla)("DSPR2 ", &info, (ftnlen)6); return 0; } @@ -205,7 +201,7 @@ /* are accessed sequentially with one pass through AP. */ kk = 1; - if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) { + if (PASTEF770(lsame)(uplo, "U", (ftnlen)1, (ftnlen)1)) { /* Form A when upper triangle is stored in AP. */ @@ -304,8 +300,7 @@ -lf2c -lm (in that order) */ -/* Subroutine */ int PASTEF77(s,spr2)(character *uplo, integer *n, real *alpha, real *x, - integer *incx, real *y, integer *incy, real *ap) +/* Subroutine */ int PASTEF77(s,spr2)(character *uplo, integer *n, real *alpha, real *x, integer *incx, real *y, integer *incy, real *ap) { /* System generated locals */ integer i__1, i__2; @@ -314,9 +309,9 @@ integer info; real temp1, temp2; integer i__, j, k; - extern logical lsame_(character *, character *, ftnlen, ftnlen); + extern logical PASTEF770(lsame)(character *, character *, ftnlen, ftnlen); integer kk, ix, iy, jx = 0, jy = 0, kx = 0, ky = 0; - extern /* Subroutine */ int xerbla_(character *, integer *, ftnlen); + extern /* Subroutine */ int PASTEF770(xerbla)(character *, integer *, ftnlen); /* .. Scalar Arguments .. */ /* .. Array Arguments .. */ @@ -422,7 +417,7 @@ /* Function Body */ info = 0; - if (! lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && ! lsame_(uplo, "L", ( + if (! PASTEF770(lsame)(uplo, "U", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(uplo, "L", ( ftnlen)1, (ftnlen)1)) { info = 1; } else if (*n < 0) { @@ -433,7 +428,7 @@ info = 7; } if (info != 0) { - xerbla_("SSPR2 ", &info, (ftnlen)6); + PASTEF770(xerbla)("SSPR2 ", &info, (ftnlen)6); return 0; } @@ -465,7 +460,7 @@ /* are accessed sequentially with one pass through AP. */ kk = 1; - if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) { + if (PASTEF770(lsame)(uplo, "U", (ftnlen)1, (ftnlen)1)) { /* Form A when upper triangle is stored in AP. */ diff --git a/frame/compat/f2c/bla_spr2.h b/frame/compat/f2c/bla_spr2.h new file mode 100644 index 000000000..bc7b05850 --- /dev/null +++ b/frame/compat/f2c/bla_spr2.h @@ -0,0 +1,42 @@ +/* + + BLIS + An object-based framework for developing high-performance BLAS-like + libraries. + + Copyright (C) 2013, The University of Texas + + 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 The University of Texas 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 + HOLDER 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. + +*/ + +#include "blis.h" + +#ifdef BLIS_ENABLE_BLAS2BLIS + +int PASTEF77(d,spr2)(character *uplo, integer *n, doublereal *alpha, doublereal *x, integer *incx, doublereal *y, integer *incy, doublereal *ap); +int PASTEF77(s,spr2)(character *uplo, integer *n, real *alpha, real *x, integer *incx, real *y, integer *incy, real *ap); + +#endif diff --git a/frame/compat/f2c/bla_tbmv.c b/frame/compat/f2c/bla_tbmv.c index c4089d69a..74bce2d83 100644 --- a/frame/compat/f2c/bla_tbmv.c +++ b/frame/compat/f2c/bla_tbmv.c @@ -36,30 +36,27 @@ #ifdef BLIS_ENABLE_BLAS2BLIS -#include "bli_f2c.h" - /* ctbmv.f -- translated by f2c (version 19991025). You must link the resulting object file with the libraries: -lf2c -lm (in that order) */ -/* Subroutine */ int PASTEF77(c,tbmv)(character *uplo, character *trans, character *diag, integer *n, - integer *k, singlecomplex *a, integer *lda, singlecomplex *x, integer *incx) +/* Subroutine */ int PASTEF77(c,tbmv)(character *uplo, character *trans, character *diag, integer *n, integer *k, singlecomplex *a, integer *lda, singlecomplex *x, integer *incx) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5; singlecomplex q__1, q__2, q__3; /* Builtin functions */ - void r_cnjg(singlecomplex *, singlecomplex *); + void bla_r_cnjg(singlecomplex *, singlecomplex *); /* Local variables */ integer info; singlecomplex temp; integer i__, j, l; - extern logical lsame_(character *, character *, ftnlen, ftnlen); + extern logical PASTEF770(lsame)(character *, character *, ftnlen, ftnlen); integer kplus1, ix, jx, kx = 0; - extern /* Subroutine */ int xerbla_(character *, integer *, ftnlen); + extern /* Subroutine */ int PASTEF770(xerbla)(character *, integer *, ftnlen); logical noconj, nounit; /* .. Scalar Arguments .. */ @@ -212,14 +209,14 @@ /* Function Body */ info = 0; - if (! lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && ! lsame_(uplo, "L", ( + if (! PASTEF770(lsame)(uplo, "U", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(uplo, "L", ( ftnlen)1, (ftnlen)1)) { info = 1; - } else if (! lsame_(trans, "N", (ftnlen)1, (ftnlen)1) && ! lsame_(trans, - "T", (ftnlen)1, (ftnlen)1) && ! lsame_(trans, "C", (ftnlen)1, ( + } else if (! PASTEF770(lsame)(trans, "N", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(trans, + "T", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(trans, "C", (ftnlen)1, ( ftnlen)1)) { info = 2; - } else if (! lsame_(diag, "U", (ftnlen)1, (ftnlen)1) && ! lsame_(diag, + } else if (! PASTEF770(lsame)(diag, "U", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(diag, "N", (ftnlen)1, (ftnlen)1)) { info = 3; } else if (*n < 0) { @@ -232,7 +229,7 @@ info = 9; } if (info != 0) { - xerbla_("CTBMV ", &info, (ftnlen)6); + PASTEF770(xerbla)("CTBMV ", &info, (ftnlen)6); return 0; } @@ -242,8 +239,8 @@ return 0; } - noconj = lsame_(trans, "T", (ftnlen)1, (ftnlen)1); - nounit = lsame_(diag, "N", (ftnlen)1, (ftnlen)1); + noconj = PASTEF770(lsame)(trans, "T", (ftnlen)1, (ftnlen)1); + nounit = PASTEF770(lsame)(diag, "N", (ftnlen)1, (ftnlen)1); /* Set up the start point in X if the increment is not unity. This */ /* will be ( N - 1 )*INCX too small for descending loops. */ @@ -257,11 +254,11 @@ /* Start the operations. In this version the elements of A are */ /* accessed sequentially with one pass through A. */ - if (lsame_(trans, "N", (ftnlen)1, (ftnlen)1)) { + if (PASTEF770(lsame)(trans, "N", (ftnlen)1, (ftnlen)1)) { /* Form x := A*x. */ - if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) { + if (PASTEF770(lsame)(uplo, "U", (ftnlen)1, (ftnlen)1)) { kplus1 = *k + 1; if (*incx == 1) { i__1 = *n; @@ -424,7 +421,7 @@ /* Form x := A'*x or x := conjg( A' )*x. */ - if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) { + if (PASTEF770(lsame)(uplo, "U", (ftnlen)1, (ftnlen)1)) { kplus1 = *k + 1; if (*incx == 1) { for (j = *n; j >= 1; --j) { @@ -455,7 +452,7 @@ } } else { if (nounit) { - r_cnjg(&q__2, &a[kplus1 + j * a_dim1]); + bla_r_cnjg(&q__2, &a[kplus1 + j * a_dim1]); q__1.real = temp.real * q__2.real - temp.imag * q__2.imag, q__1.imag = temp.real * q__2.imag + temp.imag * q__2.real; @@ -465,7 +462,7 @@ i__4 = 1, i__1 = j - *k; i__3 = f2c_max(i__4,i__1); for (i__ = j - 1; i__ >= i__3; --i__) { - r_cnjg(&q__3, &a[l + i__ + j * a_dim1]); + bla_r_cnjg(&q__3, &a[l + i__ + j * a_dim1]); i__4 = i__; q__2.real = q__3.real * x[i__4].real - q__3.imag * x[i__4].imag, q__2.imag = q__3.real * x[i__4].imag + q__3.imag * x[ @@ -514,7 +511,7 @@ } } else { if (nounit) { - r_cnjg(&q__2, &a[kplus1 + j * a_dim1]); + bla_r_cnjg(&q__2, &a[kplus1 + j * a_dim1]); q__1.real = temp.real * q__2.real - temp.imag * q__2.imag, q__1.imag = temp.real * q__2.imag + temp.imag * q__2.real; @@ -524,7 +521,7 @@ i__4 = 1, i__1 = j - *k; i__3 = f2c_max(i__4,i__1); for (i__ = j - 1; i__ >= i__3; --i__) { - r_cnjg(&q__3, &a[l + i__ + j * a_dim1]); + bla_r_cnjg(&q__3, &a[l + i__ + j * a_dim1]); i__4 = ix; q__2.real = q__3.real * x[i__4].real - q__3.imag * x[i__4].imag, q__2.imag = q__3.real * x[i__4].imag + q__3.imag * x[ @@ -573,7 +570,7 @@ } } else { if (nounit) { - r_cnjg(&q__2, &a[j * a_dim1 + 1]); + bla_r_cnjg(&q__2, &a[j * a_dim1 + 1]); q__1.real = temp.real * q__2.real - temp.imag * q__2.imag, q__1.imag = temp.real * q__2.imag + temp.imag * q__2.real; @@ -583,7 +580,7 @@ i__1 = *n, i__2 = j + *k; i__4 = f2c_min(i__1,i__2); for (i__ = j + 1; i__ <= i__4; ++i__) { - r_cnjg(&q__3, &a[l + i__ + j * a_dim1]); + bla_r_cnjg(&q__3, &a[l + i__ + j * a_dim1]); i__1 = i__; q__2.real = q__3.real * x[i__1].real - q__3.imag * x[i__1].imag, q__2.imag = q__3.real * x[i__1].imag + q__3.imag * x[ @@ -632,7 +629,7 @@ } } else { if (nounit) { - r_cnjg(&q__2, &a[j * a_dim1 + 1]); + bla_r_cnjg(&q__2, &a[j * a_dim1 + 1]); q__1.real = temp.real * q__2.real - temp.imag * q__2.imag, q__1.imag = temp.real * q__2.imag + temp.imag * q__2.real; @@ -642,7 +639,7 @@ i__1 = *n, i__2 = j + *k; i__4 = f2c_min(i__1,i__2); for (i__ = j + 1; i__ <= i__4; ++i__) { - r_cnjg(&q__3, &a[l + i__ + j * a_dim1]); + bla_r_cnjg(&q__3, &a[l + i__ + j * a_dim1]); i__1 = ix; q__2.real = q__3.real * x[i__1].real - q__3.imag * x[i__1].imag, q__2.imag = q__3.real * x[i__1].imag + q__3.imag * x[ @@ -674,8 +671,7 @@ -lf2c -lm (in that order) */ -/* Subroutine */ int PASTEF77(d,tbmv)(character *uplo, character *trans, character *diag, integer *n, - integer *k, doublereal *a, integer *lda, doublereal *x, integer *incx) +/* Subroutine */ int PASTEF77(d,tbmv)(character *uplo, character *trans, character *diag, integer *n, integer *k, doublereal *a, integer *lda, doublereal *x, integer *incx) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3, i__4; @@ -684,9 +680,9 @@ integer info; doublereal temp; integer i__, j, l; - extern logical lsame_(character *, character *, ftnlen, ftnlen); + extern logical PASTEF770(lsame)(character *, character *, ftnlen, ftnlen); integer kplus1, ix, jx, kx = 0; - extern /* Subroutine */ int xerbla_(character *, integer *, ftnlen); + extern /* Subroutine */ int PASTEF770(xerbla)(character *, integer *, ftnlen); logical nounit; /* .. Scalar Arguments .. */ @@ -839,14 +835,14 @@ /* Function Body */ info = 0; - if (! lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && ! lsame_(uplo, "L", ( + if (! PASTEF770(lsame)(uplo, "U", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(uplo, "L", ( ftnlen)1, (ftnlen)1)) { info = 1; - } else if (! lsame_(trans, "N", (ftnlen)1, (ftnlen)1) && ! lsame_(trans, - "T", (ftnlen)1, (ftnlen)1) && ! lsame_(trans, "C", (ftnlen)1, ( + } else if (! PASTEF770(lsame)(trans, "N", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(trans, + "T", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(trans, "C", (ftnlen)1, ( ftnlen)1)) { info = 2; - } else if (! lsame_(diag, "U", (ftnlen)1, (ftnlen)1) && ! lsame_(diag, + } else if (! PASTEF770(lsame)(diag, "U", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(diag, "N", (ftnlen)1, (ftnlen)1)) { info = 3; } else if (*n < 0) { @@ -859,7 +855,7 @@ info = 9; } if (info != 0) { - xerbla_("DTBMV ", &info, (ftnlen)6); + PASTEF770(xerbla)("DTBMV ", &info, (ftnlen)6); return 0; } @@ -869,7 +865,7 @@ return 0; } - nounit = lsame_(diag, "N", (ftnlen)1, (ftnlen)1); + nounit = PASTEF770(lsame)(diag, "N", (ftnlen)1, (ftnlen)1); /* Set up the start point in X if the increment is not unity. This */ /* will be ( N - 1 )*INCX too small for descending loops. */ @@ -883,11 +879,11 @@ /* Start the operations. In this version the elements of A are */ /* accessed sequentially with one pass through A. */ - if (lsame_(trans, "N", (ftnlen)1, (ftnlen)1)) { + if (PASTEF770(lsame)(trans, "N", (ftnlen)1, (ftnlen)1)) { /* Form x := A*x. */ - if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) { + if (PASTEF770(lsame)(uplo, "U", (ftnlen)1, (ftnlen)1)) { kplus1 = *k + 1; if (*incx == 1) { i__1 = *n; @@ -986,7 +982,7 @@ /* Form x := A'*x. */ - if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) { + if (PASTEF770(lsame)(uplo, "U", (ftnlen)1, (ftnlen)1)) { kplus1 = *k + 1; if (*incx == 1) { for (j = *n; j >= 1; --j) { @@ -1086,8 +1082,7 @@ -lf2c -lm (in that order) */ -/* Subroutine */ int PASTEF77(s,tbmv)(character *uplo, character *trans, character *diag, integer *n, - integer *k, real *a, integer *lda, real *x, integer *incx) +/* Subroutine */ int PASTEF77(s,tbmv)(character *uplo, character *trans, character *diag, integer *n, integer *k, real *a, integer *lda, real *x, integer *incx) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3, i__4; @@ -1096,9 +1091,9 @@ integer info; real temp; integer i__, j, l; - extern logical lsame_(character *, character *, ftnlen, ftnlen); + extern logical PASTEF770(lsame)(character *, character *, ftnlen, ftnlen); integer kplus1, ix, jx, kx = 0; - extern /* Subroutine */ int xerbla_(character *, integer *, ftnlen); + extern /* Subroutine */ int PASTEF770(xerbla)(character *, integer *, ftnlen); logical nounit; /* .. Scalar Arguments .. */ @@ -1251,14 +1246,14 @@ /* Function Body */ info = 0; - if (! lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && ! lsame_(uplo, "L", ( + if (! PASTEF770(lsame)(uplo, "U", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(uplo, "L", ( ftnlen)1, (ftnlen)1)) { info = 1; - } else if (! lsame_(trans, "N", (ftnlen)1, (ftnlen)1) && ! lsame_(trans, - "T", (ftnlen)1, (ftnlen)1) && ! lsame_(trans, "C", (ftnlen)1, ( + } else if (! PASTEF770(lsame)(trans, "N", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(trans, + "T", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(trans, "C", (ftnlen)1, ( ftnlen)1)) { info = 2; - } else if (! lsame_(diag, "U", (ftnlen)1, (ftnlen)1) && ! lsame_(diag, + } else if (! PASTEF770(lsame)(diag, "U", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(diag, "N", (ftnlen)1, (ftnlen)1)) { info = 3; } else if (*n < 0) { @@ -1271,7 +1266,7 @@ info = 9; } if (info != 0) { - xerbla_("STBMV ", &info, (ftnlen)6); + PASTEF770(xerbla)("STBMV ", &info, (ftnlen)6); return 0; } @@ -1281,7 +1276,7 @@ return 0; } - nounit = lsame_(diag, "N", (ftnlen)1, (ftnlen)1); + nounit = PASTEF770(lsame)(diag, "N", (ftnlen)1, (ftnlen)1); /* Set up the start point in X if the increment is not unity. This */ /* will be ( N - 1 )*INCX too small for descending loops. */ @@ -1295,11 +1290,11 @@ /* Start the operations. In this version the elements of A are */ /* accessed sequentially with one pass through A. */ - if (lsame_(trans, "N", (ftnlen)1, (ftnlen)1)) { + if (PASTEF770(lsame)(trans, "N", (ftnlen)1, (ftnlen)1)) { /* Form x := A*x. */ - if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) { + if (PASTEF770(lsame)(uplo, "U", (ftnlen)1, (ftnlen)1)) { kplus1 = *k + 1; if (*incx == 1) { i__1 = *n; @@ -1398,7 +1393,7 @@ /* Form x := A'*x. */ - if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) { + if (PASTEF770(lsame)(uplo, "U", (ftnlen)1, (ftnlen)1)) { kplus1 = *k + 1; if (*incx == 1) { for (j = *n; j >= 1; --j) { @@ -1498,24 +1493,22 @@ -lf2c -lm (in that order) */ -/* Subroutine */ int PASTEF77(z,tbmv)(character *uplo, character *trans, character *diag, integer *n, - integer *k, doublecomplex *a, integer *lda, doublecomplex *x, integer - *incx) +/* Subroutine */ int PASTEF77(z,tbmv)(character *uplo, character *trans, character *diag, integer *n, integer *k, doublecomplex *a, integer *lda, doublecomplex *x, integer *incx) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5; doublecomplex z__1, z__2, z__3; /* Builtin functions */ - void d_cnjg(doublecomplex *, doublecomplex *); + void bla_d_cnjg(doublecomplex *, doublecomplex *); /* Local variables */ integer info; doublecomplex temp; integer i__, j, l; - extern logical lsame_(character *, character *, ftnlen, ftnlen); + extern logical PASTEF770(lsame)(character *, character *, ftnlen, ftnlen); integer kplus1, ix, jx, kx = 0; - extern /* Subroutine */ int xerbla_(character *, integer *, ftnlen); + extern /* Subroutine */ int PASTEF770(xerbla)(character *, integer *, ftnlen); logical noconj, nounit; /* .. Scalar Arguments .. */ @@ -1668,14 +1661,14 @@ /* Function Body */ info = 0; - if (! lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && ! lsame_(uplo, "L", ( + if (! PASTEF770(lsame)(uplo, "U", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(uplo, "L", ( ftnlen)1, (ftnlen)1)) { info = 1; - } else if (! lsame_(trans, "N", (ftnlen)1, (ftnlen)1) && ! lsame_(trans, - "T", (ftnlen)1, (ftnlen)1) && ! lsame_(trans, "C", (ftnlen)1, ( + } else if (! PASTEF770(lsame)(trans, "N", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(trans, + "T", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(trans, "C", (ftnlen)1, ( ftnlen)1)) { info = 2; - } else if (! lsame_(diag, "U", (ftnlen)1, (ftnlen)1) && ! lsame_(diag, + } else if (! PASTEF770(lsame)(diag, "U", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(diag, "N", (ftnlen)1, (ftnlen)1)) { info = 3; } else if (*n < 0) { @@ -1688,7 +1681,7 @@ info = 9; } if (info != 0) { - xerbla_("ZTBMV ", &info, (ftnlen)6); + PASTEF770(xerbla)("ZTBMV ", &info, (ftnlen)6); return 0; } @@ -1698,8 +1691,8 @@ return 0; } - noconj = lsame_(trans, "T", (ftnlen)1, (ftnlen)1); - nounit = lsame_(diag, "N", (ftnlen)1, (ftnlen)1); + noconj = PASTEF770(lsame)(trans, "T", (ftnlen)1, (ftnlen)1); + nounit = PASTEF770(lsame)(diag, "N", (ftnlen)1, (ftnlen)1); /* Set up the start point in X if the increment is not unity. This */ /* will be ( N - 1 )*INCX too small for descending loops. */ @@ -1713,11 +1706,11 @@ /* Start the operations. In this version the elements of A are */ /* accessed sequentially with one pass through A. */ - if (lsame_(trans, "N", (ftnlen)1, (ftnlen)1)) { + if (PASTEF770(lsame)(trans, "N", (ftnlen)1, (ftnlen)1)) { /* Form x := A*x. */ - if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) { + if (PASTEF770(lsame)(uplo, "U", (ftnlen)1, (ftnlen)1)) { kplus1 = *k + 1; if (*incx == 1) { i__1 = *n; @@ -1880,7 +1873,7 @@ /* Form x := A'*x or x := conjg( A' )*x. */ - if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) { + if (PASTEF770(lsame)(uplo, "U", (ftnlen)1, (ftnlen)1)) { kplus1 = *k + 1; if (*incx == 1) { for (j = *n; j >= 1; --j) { @@ -1911,7 +1904,7 @@ } } else { if (nounit) { - d_cnjg(&z__2, &a[kplus1 + j * a_dim1]); + bla_d_cnjg(&z__2, &a[kplus1 + j * a_dim1]); z__1.real = temp.real * z__2.real - temp.imag * z__2.imag, z__1.imag = temp.real * z__2.imag + temp.imag * z__2.real; @@ -1921,7 +1914,7 @@ i__4 = 1, i__1 = j - *k; i__3 = f2c_max(i__4,i__1); for (i__ = j - 1; i__ >= i__3; --i__) { - d_cnjg(&z__3, &a[l + i__ + j * a_dim1]); + bla_d_cnjg(&z__3, &a[l + i__ + j * a_dim1]); i__4 = i__; z__2.real = z__3.real * x[i__4].real - z__3.imag * x[i__4].imag, z__2.imag = z__3.real * x[i__4].imag + z__3.imag * x[ @@ -1970,7 +1963,7 @@ } } else { if (nounit) { - d_cnjg(&z__2, &a[kplus1 + j * a_dim1]); + bla_d_cnjg(&z__2, &a[kplus1 + j * a_dim1]); z__1.real = temp.real * z__2.real - temp.imag * z__2.imag, z__1.imag = temp.real * z__2.imag + temp.imag * z__2.real; @@ -1980,7 +1973,7 @@ i__4 = 1, i__1 = j - *k; i__3 = f2c_max(i__4,i__1); for (i__ = j - 1; i__ >= i__3; --i__) { - d_cnjg(&z__3, &a[l + i__ + j * a_dim1]); + bla_d_cnjg(&z__3, &a[l + i__ + j * a_dim1]); i__4 = ix; z__2.real = z__3.real * x[i__4].real - z__3.imag * x[i__4].imag, z__2.imag = z__3.real * x[i__4].imag + z__3.imag * x[ @@ -2029,7 +2022,7 @@ } } else { if (nounit) { - d_cnjg(&z__2, &a[j * a_dim1 + 1]); + bla_d_cnjg(&z__2, &a[j * a_dim1 + 1]); z__1.real = temp.real * z__2.real - temp.imag * z__2.imag, z__1.imag = temp.real * z__2.imag + temp.imag * z__2.real; @@ -2039,7 +2032,7 @@ i__1 = *n, i__2 = j + *k; i__4 = f2c_min(i__1,i__2); for (i__ = j + 1; i__ <= i__4; ++i__) { - d_cnjg(&z__3, &a[l + i__ + j * a_dim1]); + bla_d_cnjg(&z__3, &a[l + i__ + j * a_dim1]); i__1 = i__; z__2.real = z__3.real * x[i__1].real - z__3.imag * x[i__1].imag, z__2.imag = z__3.real * x[i__1].imag + z__3.imag * x[ @@ -2088,7 +2081,7 @@ } } else { if (nounit) { - d_cnjg(&z__2, &a[j * a_dim1 + 1]); + bla_d_cnjg(&z__2, &a[j * a_dim1 + 1]); z__1.real = temp.real * z__2.real - temp.imag * z__2.imag, z__1.imag = temp.real * z__2.imag + temp.imag * z__2.real; @@ -2098,7 +2091,7 @@ i__1 = *n, i__2 = j + *k; i__4 = f2c_min(i__1,i__2); for (i__ = j + 1; i__ <= i__4; ++i__) { - d_cnjg(&z__3, &a[l + i__ + j * a_dim1]); + bla_d_cnjg(&z__3, &a[l + i__ + j * a_dim1]); i__1 = ix; z__2.real = z__3.real * x[i__1].real - z__3.imag * x[i__1].imag, z__2.imag = z__3.real * x[i__1].imag + z__3.imag * x[ diff --git a/frame/compat/f2c/bla_tbmv.h b/frame/compat/f2c/bla_tbmv.h new file mode 100644 index 000000000..483c48d92 --- /dev/null +++ b/frame/compat/f2c/bla_tbmv.h @@ -0,0 +1,44 @@ +/* + + BLIS + An object-based framework for developing high-performance BLAS-like + libraries. + + Copyright (C) 2013, The University of Texas + + 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 The University of Texas 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 + HOLDER 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. + +*/ + +#include "blis.h" + +#ifdef BLIS_ENABLE_BLAS2BLIS + +int PASTEF77(c,tbmv)(character *uplo, character *trans, character *diag, integer *n, integer *k, singlecomplex *a, integer *lda, singlecomplex *x, integer *incx); +int PASTEF77(d,tbmv)(character *uplo, character *trans, character *diag, integer *n, integer *k, doublereal *a, integer *lda, doublereal *x, integer *incx); +int PASTEF77(s,tbmv)(character *uplo, character *trans, character *diag, integer *n, integer *k, real *a, integer *lda, real *x, integer *incx); +int PASTEF77(z,tbmv)(character *uplo, character *trans, character *diag, integer *n, integer *k, doublecomplex *a, integer *lda, doublecomplex *x, integer *incx); + +#endif diff --git a/frame/compat/f2c/bla_tbsv.c b/frame/compat/f2c/bla_tbsv.c index ac3e31acf..920dd7552 100644 --- a/frame/compat/f2c/bla_tbsv.c +++ b/frame/compat/f2c/bla_tbsv.c @@ -36,30 +36,27 @@ #ifdef BLIS_ENABLE_BLAS2BLIS -#include "bli_f2c.h" - /* ctbsv.f -- translated by f2c (version 19991025). You must link the resulting object file with the libraries: -lf2c -lm (in that order) */ -/* Subroutine */ int PASTEF77(c,tbsv)(character *uplo, character *trans, character *diag, integer *n, - integer *k, singlecomplex *a, integer *lda, singlecomplex *x, integer *incx) +/* Subroutine */ int PASTEF77(c,tbsv)(character *uplo, character *trans, character *diag, integer *n, integer *k, singlecomplex *a, integer *lda, singlecomplex *x, integer *incx) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5; singlecomplex q__1, q__2, q__3; /* Builtin functions */ - void c_div(singlecomplex *, singlecomplex *, singlecomplex *), r_cnjg(singlecomplex *, singlecomplex *); + void bla_c_div(singlecomplex *, singlecomplex *, singlecomplex *), bla_r_cnjg(singlecomplex *, singlecomplex *); /* Local variables */ integer info; singlecomplex temp; integer i__, j, l; - extern logical lsame_(character *, character *, ftnlen, ftnlen); + extern logical PASTEF770(lsame)(character *, character *, ftnlen, ftnlen); integer kplus1, ix, jx, kx = 0; - extern /* Subroutine */ int xerbla_(character *, integer *, ftnlen); + extern /* Subroutine */ int PASTEF770(xerbla)(character *, integer *, ftnlen); logical noconj, nounit; /* .. Scalar Arguments .. */ @@ -216,14 +213,14 @@ /* Function Body */ info = 0; - if (! lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && ! lsame_(uplo, "L", ( + if (! PASTEF770(lsame)(uplo, "U", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(uplo, "L", ( ftnlen)1, (ftnlen)1)) { info = 1; - } else if (! lsame_(trans, "N", (ftnlen)1, (ftnlen)1) && ! lsame_(trans, - "T", (ftnlen)1, (ftnlen)1) && ! lsame_(trans, "C", (ftnlen)1, ( + } else if (! PASTEF770(lsame)(trans, "N", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(trans, + "T", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(trans, "C", (ftnlen)1, ( ftnlen)1)) { info = 2; - } else if (! lsame_(diag, "U", (ftnlen)1, (ftnlen)1) && ! lsame_(diag, + } else if (! PASTEF770(lsame)(diag, "U", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(diag, "N", (ftnlen)1, (ftnlen)1)) { info = 3; } else if (*n < 0) { @@ -236,7 +233,7 @@ info = 9; } if (info != 0) { - xerbla_("CTBSV ", &info, (ftnlen)6); + PASTEF770(xerbla)("CTBSV ", &info, (ftnlen)6); return 0; } @@ -246,8 +243,8 @@ return 0; } - noconj = lsame_(trans, "T", (ftnlen)1, (ftnlen)1); - nounit = lsame_(diag, "N", (ftnlen)1, (ftnlen)1); + noconj = PASTEF770(lsame)(trans, "T", (ftnlen)1, (ftnlen)1); + nounit = PASTEF770(lsame)(diag, "N", (ftnlen)1, (ftnlen)1); /* Set up the start point in X if the increment is not unity. This */ /* will be ( N - 1 )*INCX too small for descending loops. */ @@ -261,11 +258,11 @@ /* Start the operations. In this version the elements of A are */ /* accessed by sequentially with one pass through A. */ - if (lsame_(trans, "N", (ftnlen)1, (ftnlen)1)) { + if (PASTEF770(lsame)(trans, "N", (ftnlen)1, (ftnlen)1)) { /* Form x := inv( A )*x. */ - if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) { + if (PASTEF770(lsame)(uplo, "U", (ftnlen)1, (ftnlen)1)) { kplus1 = *k + 1; if (*incx == 1) { for (j = *n; j >= 1; --j) { @@ -274,7 +271,7 @@ l = kplus1 - j; if (nounit) { i__1 = j; - c_div(&q__1, &x[j], &a[kplus1 + j * a_dim1]); + bla_c_div(&q__1, &x[j], &a[kplus1 + j * a_dim1]); x[i__1].real = q__1.real, x[i__1].imag = q__1.imag; } i__1 = j; @@ -308,7 +305,7 @@ l = kplus1 - j; if (nounit) { i__1 = jx; - c_div(&q__1, &x[jx], &a[kplus1 + j * a_dim1]); + bla_c_div(&q__1, &x[jx], &a[kplus1 + j * a_dim1]); x[i__1].real = q__1.real, x[i__1].imag = q__1.imag; } i__1 = jx; @@ -343,7 +340,7 @@ l = 1 - j; if (nounit) { i__2 = j; - c_div(&q__1, &x[j], &a[j * a_dim1 + 1]); + bla_c_div(&q__1, &x[j], &a[j * a_dim1 + 1]); x[i__2].real = q__1.real, x[i__2].imag = q__1.imag; } i__2 = j; @@ -377,7 +374,7 @@ l = 1 - j; if (nounit) { i__2 = jx; - c_div(&q__1, &x[jx], &a[j * a_dim1 + 1]); + bla_c_div(&q__1, &x[jx], &a[j * a_dim1 + 1]); x[i__2].real = q__1.real, x[i__2].imag = q__1.imag; } i__2 = jx; @@ -408,7 +405,7 @@ /* Form x := inv( A' )*x or x := inv( conjg( A') )*x. */ - if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) { + if (PASTEF770(lsame)(uplo, "U", (ftnlen)1, (ftnlen)1)) { kplus1 = *k + 1; if (*incx == 1) { i__1 = *n; @@ -432,7 +429,7 @@ /* L90: */ } if (nounit) { - c_div(&q__1, &temp, &a[kplus1 + j * a_dim1]); + bla_c_div(&q__1, &temp, &a[kplus1 + j * a_dim1]); temp.real = q__1.real, temp.imag = q__1.imag; } } else { @@ -440,7 +437,7 @@ i__4 = 1, i__2 = j - *k; i__3 = j - 1; for (i__ = f2c_max(i__4,i__2); i__ <= i__3; ++i__) { - r_cnjg(&q__3, &a[l + i__ + j * a_dim1]); + bla_r_cnjg(&q__3, &a[l + i__ + j * a_dim1]); i__4 = i__; q__2.real = q__3.real * x[i__4].real - q__3.imag * x[i__4].imag, q__2.imag = q__3.real * x[i__4].imag + q__3.imag * x[ @@ -451,8 +448,8 @@ /* L100: */ } if (nounit) { - r_cnjg(&q__2, &a[kplus1 + j * a_dim1]); - c_div(&q__1, &temp, &q__2); + bla_r_cnjg(&q__2, &a[kplus1 + j * a_dim1]); + bla_c_div(&q__1, &temp, &q__2); temp.real = q__1.real, temp.imag = q__1.imag; } } @@ -485,7 +482,7 @@ /* L120: */ } if (nounit) { - c_div(&q__1, &temp, &a[kplus1 + j * a_dim1]); + bla_c_div(&q__1, &temp, &a[kplus1 + j * a_dim1]); temp.real = q__1.real, temp.imag = q__1.imag; } } else { @@ -493,7 +490,7 @@ i__2 = 1, i__3 = j - *k; i__4 = j - 1; for (i__ = f2c_max(i__2,i__3); i__ <= i__4; ++i__) { - r_cnjg(&q__3, &a[l + i__ + j * a_dim1]); + bla_r_cnjg(&q__3, &a[l + i__ + j * a_dim1]); i__2 = ix; q__2.real = q__3.real * x[i__2].real - q__3.imag * x[i__2].imag, q__2.imag = q__3.real * x[i__2].imag + q__3.imag * x[ @@ -505,8 +502,8 @@ /* L130: */ } if (nounit) { - r_cnjg(&q__2, &a[kplus1 + j * a_dim1]); - c_div(&q__1, &temp, &q__2); + bla_r_cnjg(&q__2, &a[kplus1 + j * a_dim1]); + bla_c_div(&q__1, &temp, &q__2); temp.real = q__1.real, temp.imag = q__1.imag; } } @@ -541,7 +538,7 @@ /* L150: */ } if (nounit) { - c_div(&q__1, &temp, &a[j * a_dim1 + 1]); + bla_c_div(&q__1, &temp, &a[j * a_dim1 + 1]); temp.real = q__1.real, temp.imag = q__1.imag; } } else { @@ -549,7 +546,7 @@ i__2 = *n, i__1 = j + *k; i__4 = j + 1; for (i__ = f2c_min(i__2,i__1); i__ >= i__4; --i__) { - r_cnjg(&q__3, &a[l + i__ + j * a_dim1]); + bla_r_cnjg(&q__3, &a[l + i__ + j * a_dim1]); i__2 = i__; q__2.real = q__3.real * x[i__2].real - q__3.imag * x[i__2].imag, q__2.imag = q__3.real * x[i__2].imag + q__3.imag * x[ @@ -560,8 +557,8 @@ /* L160: */ } if (nounit) { - r_cnjg(&q__2, &a[j * a_dim1 + 1]); - c_div(&q__1, &temp, &q__2); + bla_r_cnjg(&q__2, &a[j * a_dim1 + 1]); + bla_c_div(&q__1, &temp, &q__2); temp.real = q__1.real, temp.imag = q__1.imag; } } @@ -594,7 +591,7 @@ /* L180: */ } if (nounit) { - c_div(&q__1, &temp, &a[j * a_dim1 + 1]); + bla_c_div(&q__1, &temp, &a[j * a_dim1 + 1]); temp.real = q__1.real, temp.imag = q__1.imag; } } else { @@ -602,7 +599,7 @@ i__1 = *n, i__4 = j + *k; i__2 = j + 1; for (i__ = f2c_min(i__1,i__4); i__ >= i__2; --i__) { - r_cnjg(&q__3, &a[l + i__ + j * a_dim1]); + bla_r_cnjg(&q__3, &a[l + i__ + j * a_dim1]); i__1 = ix; q__2.real = q__3.real * x[i__1].real - q__3.imag * x[i__1].imag, q__2.imag = q__3.real * x[i__1].imag + q__3.imag * x[ @@ -614,8 +611,8 @@ /* L190: */ } if (nounit) { - r_cnjg(&q__2, &a[j * a_dim1 + 1]); - c_div(&q__1, &temp, &q__2); + bla_r_cnjg(&q__2, &a[j * a_dim1 + 1]); + bla_c_div(&q__1, &temp, &q__2); temp.real = q__1.real, temp.imag = q__1.imag; } } @@ -642,8 +639,7 @@ -lf2c -lm (in that order) */ -/* Subroutine */ int PASTEF77(d,tbsv)(character *uplo, character *trans, character *diag, integer *n, - integer *k, doublereal *a, integer *lda, doublereal *x, integer *incx) +/* Subroutine */ int PASTEF77(d,tbsv)(character *uplo, character *trans, character *diag, integer *n, integer *k, doublereal *a, integer *lda, doublereal *x, integer *incx) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3, i__4; @@ -652,9 +648,9 @@ integer info; doublereal temp; integer i__, j, l; - extern logical lsame_(character *, character *, ftnlen, ftnlen); + extern logical PASTEF770(lsame)(character *, character *, ftnlen, ftnlen); integer kplus1, ix, jx, kx = 0; - extern /* Subroutine */ int xerbla_(character *, integer *, ftnlen); + extern /* Subroutine */ int PASTEF770(xerbla)(character *, integer *, ftnlen); logical nounit; /* .. Scalar Arguments .. */ @@ -811,14 +807,14 @@ /* Function Body */ info = 0; - if (! lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && ! lsame_(uplo, "L", ( + if (! PASTEF770(lsame)(uplo, "U", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(uplo, "L", ( ftnlen)1, (ftnlen)1)) { info = 1; - } else if (! lsame_(trans, "N", (ftnlen)1, (ftnlen)1) && ! lsame_(trans, - "T", (ftnlen)1, (ftnlen)1) && ! lsame_(trans, "C", (ftnlen)1, ( + } else if (! PASTEF770(lsame)(trans, "N", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(trans, + "T", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(trans, "C", (ftnlen)1, ( ftnlen)1)) { info = 2; - } else if (! lsame_(diag, "U", (ftnlen)1, (ftnlen)1) && ! lsame_(diag, + } else if (! PASTEF770(lsame)(diag, "U", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(diag, "N", (ftnlen)1, (ftnlen)1)) { info = 3; } else if (*n < 0) { @@ -831,7 +827,7 @@ info = 9; } if (info != 0) { - xerbla_("DTBSV ", &info, (ftnlen)6); + PASTEF770(xerbla)("DTBSV ", &info, (ftnlen)6); return 0; } @@ -841,7 +837,7 @@ return 0; } - nounit = lsame_(diag, "N", (ftnlen)1, (ftnlen)1); + nounit = PASTEF770(lsame)(diag, "N", (ftnlen)1, (ftnlen)1); /* Set up the start point in X if the increment is not unity. This */ /* will be ( N - 1 )*INCX too small for descending loops. */ @@ -855,11 +851,11 @@ /* Start the operations. In this version the elements of A are */ /* accessed by sequentially with one pass through A. */ - if (lsame_(trans, "N", (ftnlen)1, (ftnlen)1)) { + if (PASTEF770(lsame)(trans, "N", (ftnlen)1, (ftnlen)1)) { /* Form x := inv( A )*x. */ - if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) { + if (PASTEF770(lsame)(uplo, "U", (ftnlen)1, (ftnlen)1)) { kplus1 = *k + 1; if (*incx == 1) { for (j = *n; j >= 1; --j) { @@ -954,7 +950,7 @@ /* Form x := inv( A')*x. */ - if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) { + if (PASTEF770(lsame)(uplo, "U", (ftnlen)1, (ftnlen)1)) { kplus1 = *k + 1; if (*incx == 1) { i__1 = *n; @@ -1058,8 +1054,7 @@ -lf2c -lm (in that order) */ -/* Subroutine */ int PASTEF77(s,tbsv)(character *uplo, character *trans, character *diag, integer *n, - integer *k, real *a, integer *lda, real *x, integer *incx) +/* Subroutine */ int PASTEF77(s,tbsv)(character *uplo, character *trans, character *diag, integer *n, integer *k, real *a, integer *lda, real *x, integer *incx) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3, i__4; @@ -1068,9 +1063,9 @@ integer info; real temp; integer i__, j, l; - extern logical lsame_(character *, character *, ftnlen, ftnlen); + extern logical PASTEF770(lsame)(character *, character *, ftnlen, ftnlen); integer kplus1, ix, jx, kx = 0; - extern /* Subroutine */ int xerbla_(character *, integer *, ftnlen); + extern /* Subroutine */ int PASTEF770(xerbla)(character *, integer *, ftnlen); logical nounit; /* .. Scalar Arguments .. */ @@ -1227,14 +1222,14 @@ /* Function Body */ info = 0; - if (! lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && ! lsame_(uplo, "L", ( + if (! PASTEF770(lsame)(uplo, "U", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(uplo, "L", ( ftnlen)1, (ftnlen)1)) { info = 1; - } else if (! lsame_(trans, "N", (ftnlen)1, (ftnlen)1) && ! lsame_(trans, - "T", (ftnlen)1, (ftnlen)1) && ! lsame_(trans, "C", (ftnlen)1, ( + } else if (! PASTEF770(lsame)(trans, "N", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(trans, + "T", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(trans, "C", (ftnlen)1, ( ftnlen)1)) { info = 2; - } else if (! lsame_(diag, "U", (ftnlen)1, (ftnlen)1) && ! lsame_(diag, + } else if (! PASTEF770(lsame)(diag, "U", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(diag, "N", (ftnlen)1, (ftnlen)1)) { info = 3; } else if (*n < 0) { @@ -1247,7 +1242,7 @@ info = 9; } if (info != 0) { - xerbla_("STBSV ", &info, (ftnlen)6); + PASTEF770(xerbla)("STBSV ", &info, (ftnlen)6); return 0; } @@ -1257,7 +1252,7 @@ return 0; } - nounit = lsame_(diag, "N", (ftnlen)1, (ftnlen)1); + nounit = PASTEF770(lsame)(diag, "N", (ftnlen)1, (ftnlen)1); /* Set up the start point in X if the increment is not unity. This */ /* will be ( N - 1 )*INCX too small for descending loops. */ @@ -1271,11 +1266,11 @@ /* Start the operations. In this version the elements of A are */ /* accessed by sequentially with one pass through A. */ - if (lsame_(trans, "N", (ftnlen)1, (ftnlen)1)) { + if (PASTEF770(lsame)(trans, "N", (ftnlen)1, (ftnlen)1)) { /* Form x := inv( A )*x. */ - if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) { + if (PASTEF770(lsame)(uplo, "U", (ftnlen)1, (ftnlen)1)) { kplus1 = *k + 1; if (*incx == 1) { for (j = *n; j >= 1; --j) { @@ -1370,7 +1365,7 @@ /* Form x := inv( A')*x. */ - if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) { + if (PASTEF770(lsame)(uplo, "U", (ftnlen)1, (ftnlen)1)) { kplus1 = *k + 1; if (*incx == 1) { i__1 = *n; @@ -1474,25 +1469,23 @@ -lf2c -lm (in that order) */ -/* Subroutine */ int PASTEF77(z,tbsv)(character *uplo, character *trans, character *diag, integer *n, - integer *k, doublecomplex *a, integer *lda, doublecomplex *x, integer - *incx) +/* Subroutine */ int PASTEF77(z,tbsv)(character *uplo, character *trans, character *diag, integer *n, integer *k, doublecomplex *a, integer *lda, doublecomplex *x, integer *incx) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5; doublecomplex z__1, z__2, z__3; /* Builtin functions */ - void z_div(doublecomplex *, doublecomplex *, doublecomplex *), d_cnjg( + void bla_z_div(doublecomplex *, doublecomplex *, doublecomplex *), bla_d_cnjg( doublecomplex *, doublecomplex *); /* Local variables */ integer info; doublecomplex temp; integer i__, j, l; - extern logical lsame_(character *, character *, ftnlen, ftnlen); + extern logical PASTEF770(lsame)(character *, character *, ftnlen, ftnlen); integer kplus1, ix, jx, kx = 0; - extern /* Subroutine */ int xerbla_(character *, integer *, ftnlen); + extern /* Subroutine */ int PASTEF770(xerbla)(character *, integer *, ftnlen); logical noconj, nounit; /* .. Scalar Arguments .. */ @@ -1649,14 +1642,14 @@ /* Function Body */ info = 0; - if (! lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && ! lsame_(uplo, "L", ( + if (! PASTEF770(lsame)(uplo, "U", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(uplo, "L", ( ftnlen)1, (ftnlen)1)) { info = 1; - } else if (! lsame_(trans, "N", (ftnlen)1, (ftnlen)1) && ! lsame_(trans, - "T", (ftnlen)1, (ftnlen)1) && ! lsame_(trans, "C", (ftnlen)1, ( + } else if (! PASTEF770(lsame)(trans, "N", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(trans, + "T", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(trans, "C", (ftnlen)1, ( ftnlen)1)) { info = 2; - } else if (! lsame_(diag, "U", (ftnlen)1, (ftnlen)1) && ! lsame_(diag, + } else if (! PASTEF770(lsame)(diag, "U", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(diag, "N", (ftnlen)1, (ftnlen)1)) { info = 3; } else if (*n < 0) { @@ -1669,7 +1662,7 @@ info = 9; } if (info != 0) { - xerbla_("ZTBSV ", &info, (ftnlen)6); + PASTEF770(xerbla)("ZTBSV ", &info, (ftnlen)6); return 0; } @@ -1679,8 +1672,8 @@ return 0; } - noconj = lsame_(trans, "T", (ftnlen)1, (ftnlen)1); - nounit = lsame_(diag, "N", (ftnlen)1, (ftnlen)1); + noconj = PASTEF770(lsame)(trans, "T", (ftnlen)1, (ftnlen)1); + nounit = PASTEF770(lsame)(diag, "N", (ftnlen)1, (ftnlen)1); /* Set up the start point in X if the increment is not unity. This */ /* will be ( N - 1 )*INCX too small for descending loops. */ @@ -1694,11 +1687,11 @@ /* Start the operations. In this version the elements of A are */ /* accessed by sequentially with one pass through A. */ - if (lsame_(trans, "N", (ftnlen)1, (ftnlen)1)) { + if (PASTEF770(lsame)(trans, "N", (ftnlen)1, (ftnlen)1)) { /* Form x := inv( A )*x. */ - if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) { + if (PASTEF770(lsame)(uplo, "U", (ftnlen)1, (ftnlen)1)) { kplus1 = *k + 1; if (*incx == 1) { for (j = *n; j >= 1; --j) { @@ -1707,7 +1700,7 @@ l = kplus1 - j; if (nounit) { i__1 = j; - z_div(&z__1, &x[j], &a[kplus1 + j * a_dim1]); + bla_z_div(&z__1, &x[j], &a[kplus1 + j * a_dim1]); x[i__1].real = z__1.real, x[i__1].imag = z__1.imag; } i__1 = j; @@ -1741,7 +1734,7 @@ l = kplus1 - j; if (nounit) { i__1 = jx; - z_div(&z__1, &x[jx], &a[kplus1 + j * a_dim1]); + bla_z_div(&z__1, &x[jx], &a[kplus1 + j * a_dim1]); x[i__1].real = z__1.real, x[i__1].imag = z__1.imag; } i__1 = jx; @@ -1776,7 +1769,7 @@ l = 1 - j; if (nounit) { i__2 = j; - z_div(&z__1, &x[j], &a[j * a_dim1 + 1]); + bla_z_div(&z__1, &x[j], &a[j * a_dim1 + 1]); x[i__2].real = z__1.real, x[i__2].imag = z__1.imag; } i__2 = j; @@ -1810,7 +1803,7 @@ l = 1 - j; if (nounit) { i__2 = jx; - z_div(&z__1, &x[jx], &a[j * a_dim1 + 1]); + bla_z_div(&z__1, &x[jx], &a[j * a_dim1 + 1]); x[i__2].real = z__1.real, x[i__2].imag = z__1.imag; } i__2 = jx; @@ -1841,7 +1834,7 @@ /* Form x := inv( A' )*x or x := inv( conjg( A') )*x. */ - if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) { + if (PASTEF770(lsame)(uplo, "U", (ftnlen)1, (ftnlen)1)) { kplus1 = *k + 1; if (*incx == 1) { i__1 = *n; @@ -1865,7 +1858,7 @@ /* L90: */ } if (nounit) { - z_div(&z__1, &temp, &a[kplus1 + j * a_dim1]); + bla_z_div(&z__1, &temp, &a[kplus1 + j * a_dim1]); temp.real = z__1.real, temp.imag = z__1.imag; } } else { @@ -1873,7 +1866,7 @@ i__4 = 1, i__2 = j - *k; i__3 = j - 1; for (i__ = f2c_max(i__4,i__2); i__ <= i__3; ++i__) { - d_cnjg(&z__3, &a[l + i__ + j * a_dim1]); + bla_d_cnjg(&z__3, &a[l + i__ + j * a_dim1]); i__4 = i__; z__2.real = z__3.real * x[i__4].real - z__3.imag * x[i__4].imag, z__2.imag = z__3.real * x[i__4].imag + z__3.imag * x[ @@ -1884,8 +1877,8 @@ /* L100: */ } if (nounit) { - d_cnjg(&z__2, &a[kplus1 + j * a_dim1]); - z_div(&z__1, &temp, &z__2); + bla_d_cnjg(&z__2, &a[kplus1 + j * a_dim1]); + bla_z_div(&z__1, &temp, &z__2); temp.real = z__1.real, temp.imag = z__1.imag; } } @@ -1918,7 +1911,7 @@ /* L120: */ } if (nounit) { - z_div(&z__1, &temp, &a[kplus1 + j * a_dim1]); + bla_z_div(&z__1, &temp, &a[kplus1 + j * a_dim1]); temp.real = z__1.real, temp.imag = z__1.imag; } } else { @@ -1926,7 +1919,7 @@ i__2 = 1, i__3 = j - *k; i__4 = j - 1; for (i__ = f2c_max(i__2,i__3); i__ <= i__4; ++i__) { - d_cnjg(&z__3, &a[l + i__ + j * a_dim1]); + bla_d_cnjg(&z__3, &a[l + i__ + j * a_dim1]); i__2 = ix; z__2.real = z__3.real * x[i__2].real - z__3.imag * x[i__2].imag, z__2.imag = z__3.real * x[i__2].imag + z__3.imag * x[ @@ -1938,8 +1931,8 @@ /* L130: */ } if (nounit) { - d_cnjg(&z__2, &a[kplus1 + j * a_dim1]); - z_div(&z__1, &temp, &z__2); + bla_d_cnjg(&z__2, &a[kplus1 + j * a_dim1]); + bla_z_div(&z__1, &temp, &z__2); temp.real = z__1.real, temp.imag = z__1.imag; } } @@ -1974,7 +1967,7 @@ /* L150: */ } if (nounit) { - z_div(&z__1, &temp, &a[j * a_dim1 + 1]); + bla_z_div(&z__1, &temp, &a[j * a_dim1 + 1]); temp.real = z__1.real, temp.imag = z__1.imag; } } else { @@ -1982,7 +1975,7 @@ i__2 = *n, i__1 = j + *k; i__4 = j + 1; for (i__ = f2c_min(i__2,i__1); i__ >= i__4; --i__) { - d_cnjg(&z__3, &a[l + i__ + j * a_dim1]); + bla_d_cnjg(&z__3, &a[l + i__ + j * a_dim1]); i__2 = i__; z__2.real = z__3.real * x[i__2].real - z__3.imag * x[i__2].imag, z__2.imag = z__3.real * x[i__2].imag + z__3.imag * x[ @@ -1993,8 +1986,8 @@ /* L160: */ } if (nounit) { - d_cnjg(&z__2, &a[j * a_dim1 + 1]); - z_div(&z__1, &temp, &z__2); + bla_d_cnjg(&z__2, &a[j * a_dim1 + 1]); + bla_z_div(&z__1, &temp, &z__2); temp.real = z__1.real, temp.imag = z__1.imag; } } @@ -2027,7 +2020,7 @@ /* L180: */ } if (nounit) { - z_div(&z__1, &temp, &a[j * a_dim1 + 1]); + bla_z_div(&z__1, &temp, &a[j * a_dim1 + 1]); temp.real = z__1.real, temp.imag = z__1.imag; } } else { @@ -2035,7 +2028,7 @@ i__1 = *n, i__4 = j + *k; i__2 = j + 1; for (i__ = f2c_min(i__1,i__4); i__ >= i__2; --i__) { - d_cnjg(&z__3, &a[l + i__ + j * a_dim1]); + bla_d_cnjg(&z__3, &a[l + i__ + j * a_dim1]); i__1 = ix; z__2.real = z__3.real * x[i__1].real - z__3.imag * x[i__1].imag, z__2.imag = z__3.real * x[i__1].imag + z__3.imag * x[ @@ -2047,8 +2040,8 @@ /* L190: */ } if (nounit) { - d_cnjg(&z__2, &a[j * a_dim1 + 1]); - z_div(&z__1, &temp, &z__2); + bla_d_cnjg(&z__2, &a[j * a_dim1 + 1]); + bla_z_div(&z__1, &temp, &z__2); temp.real = z__1.real, temp.imag = z__1.imag; } } diff --git a/frame/compat/f2c/bla_tbsv.h b/frame/compat/f2c/bla_tbsv.h new file mode 100644 index 000000000..6ccc3497e --- /dev/null +++ b/frame/compat/f2c/bla_tbsv.h @@ -0,0 +1,44 @@ +/* + + BLIS + An object-based framework for developing high-performance BLAS-like + libraries. + + Copyright (C) 2013, The University of Texas + + 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 The University of Texas 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 + HOLDER 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. + +*/ + +#include "blis.h" + +#ifdef BLIS_ENABLE_BLAS2BLIS + +int PASTEF77(c,tbsv)(character *uplo, character *trans, character *diag, integer *n, integer *k, singlecomplex *a, integer *lda, singlecomplex *x, integer *incx); +int PASTEF77(d,tbsv)(character *uplo, character *trans, character *diag, integer *n, integer *k, doublereal *a, integer *lda, doublereal *x, integer *incx); +int PASTEF77(s,tbsv)(character *uplo, character *trans, character *diag, integer *n, integer *k, real *a, integer *lda, real *x, integer *incx); +int PASTEF77(z,tbsv)(character *uplo, character *trans, character *diag, integer *n, integer *k, doublecomplex *a, integer *lda, doublecomplex *x, integer *incx); + +#endif diff --git a/frame/compat/f2c/bla_tpmv.c b/frame/compat/f2c/bla_tpmv.c index 541bf254f..10bf7dc15 100644 --- a/frame/compat/f2c/bla_tpmv.c +++ b/frame/compat/f2c/bla_tpmv.c @@ -36,30 +36,27 @@ #ifdef BLIS_ENABLE_BLAS2BLIS -#include "bli_f2c.h" - /* ctpmv.f -- translated by f2c (version 19991025). You must link the resulting object file with the libraries: -lf2c -lm (in that order) */ -/* Subroutine */ int PASTEF77(c,tpmv)(character *uplo, character *trans, character *diag, integer *n, - singlecomplex *ap, singlecomplex *x, integer *incx) +/* Subroutine */ int PASTEF77(c,tpmv)(character *uplo, character *trans, character *diag, integer *n, singlecomplex *ap, singlecomplex *x, integer *incx) { /* System generated locals */ integer i__1, i__2, i__3, i__4, i__5; singlecomplex q__1, q__2, q__3; /* Builtin functions */ - void r_cnjg(singlecomplex *, singlecomplex *); + void bla_r_cnjg(singlecomplex *, singlecomplex *); /* Local variables */ integer info; singlecomplex temp; integer i__, j, k; - extern logical lsame_(character *, character *, ftnlen, ftnlen); + extern logical PASTEF770(lsame)(character *, character *, ftnlen, ftnlen); integer kk, ix, jx, kx = 0; - extern /* Subroutine */ int xerbla_(character *, integer *, ftnlen); + extern /* Subroutine */ int PASTEF770(xerbla)(character *, integer *, ftnlen); logical noconj, nounit; /* .. Scalar Arguments .. */ @@ -170,14 +167,14 @@ /* Function Body */ info = 0; - if (! lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && ! lsame_(uplo, "L", ( + if (! PASTEF770(lsame)(uplo, "U", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(uplo, "L", ( ftnlen)1, (ftnlen)1)) { info = 1; - } else if (! lsame_(trans, "N", (ftnlen)1, (ftnlen)1) && ! lsame_(trans, - "T", (ftnlen)1, (ftnlen)1) && ! lsame_(trans, "C", (ftnlen)1, ( + } else if (! PASTEF770(lsame)(trans, "N", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(trans, + "T", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(trans, "C", (ftnlen)1, ( ftnlen)1)) { info = 2; - } else if (! lsame_(diag, "U", (ftnlen)1, (ftnlen)1) && ! lsame_(diag, + } else if (! PASTEF770(lsame)(diag, "U", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(diag, "N", (ftnlen)1, (ftnlen)1)) { info = 3; } else if (*n < 0) { @@ -186,7 +183,7 @@ info = 7; } if (info != 0) { - xerbla_("CTPMV ", &info, (ftnlen)6); + PASTEF770(xerbla)("CTPMV ", &info, (ftnlen)6); return 0; } @@ -196,8 +193,8 @@ return 0; } - noconj = lsame_(trans, "T", (ftnlen)1, (ftnlen)1); - nounit = lsame_(diag, "N", (ftnlen)1, (ftnlen)1); + noconj = PASTEF770(lsame)(trans, "T", (ftnlen)1, (ftnlen)1); + nounit = PASTEF770(lsame)(diag, "N", (ftnlen)1, (ftnlen)1); /* Set up the start point in X if the increment is not unity. This */ /* will be ( N - 1 )*INCX too small for descending loops. */ @@ -211,11 +208,11 @@ /* Start the operations. In this version the elements of AP are */ /* accessed sequentially with one pass through AP. */ - if (lsame_(trans, "N", (ftnlen)1, (ftnlen)1)) { + if (PASTEF770(lsame)(trans, "N", (ftnlen)1, (ftnlen)1)) { /* Form x:= A*x. */ - if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) { + if (PASTEF770(lsame)(uplo, "U", (ftnlen)1, (ftnlen)1)) { kk = 1; if (*incx == 1) { i__1 = *n; @@ -369,7 +366,7 @@ /* Form x := A'*x or x := conjg( A' )*x. */ - if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) { + if (PASTEF770(lsame)(uplo, "U", (ftnlen)1, (ftnlen)1)) { kk = *n * (*n + 1) / 2; if (*incx == 1) { for (j = *n; j >= 1; --j) { @@ -398,14 +395,14 @@ } } else { if (nounit) { - r_cnjg(&q__2, &ap[kk]); + bla_r_cnjg(&q__2, &ap[kk]); q__1.real = temp.real * q__2.real - temp.imag * q__2.imag, q__1.imag = temp.real * q__2.imag + temp.imag * q__2.real; temp.real = q__1.real, temp.imag = q__1.imag; } for (i__ = j - 1; i__ >= 1; --i__) { - r_cnjg(&q__3, &ap[k]); + bla_r_cnjg(&q__3, &ap[k]); i__1 = i__; q__2.real = q__3.real * x[i__1].real - q__3.imag * x[i__1].imag, q__2.imag = q__3.real * x[i__1].imag + q__3.imag * x[ @@ -451,7 +448,7 @@ } } else { if (nounit) { - r_cnjg(&q__2, &ap[kk]); + bla_r_cnjg(&q__2, &ap[kk]); q__1.real = temp.real * q__2.real - temp.imag * q__2.imag, q__1.imag = temp.real * q__2.imag + temp.imag * q__2.real; @@ -460,7 +457,7 @@ i__1 = kk - j + 1; for (k = kk - 1; k >= i__1; --k) { ix -= *incx; - r_cnjg(&q__3, &ap[k]); + bla_r_cnjg(&q__3, &ap[k]); i__2 = ix; q__2.real = q__3.real * x[i__2].real - q__3.imag * x[i__2].imag, q__2.imag = q__3.real * x[i__2].imag + q__3.imag * x[ @@ -509,7 +506,7 @@ } } else { if (nounit) { - r_cnjg(&q__2, &ap[kk]); + bla_r_cnjg(&q__2, &ap[kk]); q__1.real = temp.real * q__2.real - temp.imag * q__2.imag, q__1.imag = temp.real * q__2.imag + temp.imag * q__2.real; @@ -517,7 +514,7 @@ } i__2 = *n; for (i__ = j + 1; i__ <= i__2; ++i__) { - r_cnjg(&q__3, &ap[k]); + bla_r_cnjg(&q__3, &ap[k]); i__3 = i__; q__2.real = q__3.real * x[i__3].real - q__3.imag * x[i__3].imag, q__2.imag = q__3.real * x[i__3].imag + q__3.imag * x[ @@ -564,7 +561,7 @@ } } else { if (nounit) { - r_cnjg(&q__2, &ap[kk]); + bla_r_cnjg(&q__2, &ap[kk]); q__1.real = temp.real * q__2.real - temp.imag * q__2.imag, q__1.imag = temp.real * q__2.imag + temp.imag * q__2.real; @@ -573,7 +570,7 @@ i__2 = kk + *n - j; for (k = kk + 1; k <= i__2; ++k) { ix += *incx; - r_cnjg(&q__3, &ap[k]); + bla_r_cnjg(&q__3, &ap[k]); i__3 = ix; q__2.real = q__3.real * x[i__3].real - q__3.imag * x[i__3].imag, q__2.imag = q__3.real * x[i__3].imag + q__3.imag * x[ @@ -605,8 +602,7 @@ -lf2c -lm (in that order) */ -/* Subroutine */ int PASTEF77(d,tpmv)(character *uplo, character *trans, character *diag, integer *n, - doublereal *ap, doublereal *x, integer *incx) +/* Subroutine */ int PASTEF77(d,tpmv)(character *uplo, character *trans, character *diag, integer *n, doublereal *ap, doublereal *x, integer *incx) { /* System generated locals */ integer i__1, i__2; @@ -615,9 +611,9 @@ integer info; doublereal temp; integer i__, j, k; - extern logical lsame_(character *, character *, ftnlen, ftnlen); + extern logical PASTEF770(lsame)(character *, character *, ftnlen, ftnlen); integer kk, ix, jx, kx = 0; - extern /* Subroutine */ int xerbla_(character *, integer *, ftnlen); + extern /* Subroutine */ int PASTEF770(xerbla)(character *, integer *, ftnlen); logical nounit; /* .. Scalar Arguments .. */ @@ -727,14 +723,14 @@ /* Function Body */ info = 0; - if (! lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && ! lsame_(uplo, "L", ( + if (! PASTEF770(lsame)(uplo, "U", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(uplo, "L", ( ftnlen)1, (ftnlen)1)) { info = 1; - } else if (! lsame_(trans, "N", (ftnlen)1, (ftnlen)1) && ! lsame_(trans, - "T", (ftnlen)1, (ftnlen)1) && ! lsame_(trans, "C", (ftnlen)1, ( + } else if (! PASTEF770(lsame)(trans, "N", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(trans, + "T", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(trans, "C", (ftnlen)1, ( ftnlen)1)) { info = 2; - } else if (! lsame_(diag, "U", (ftnlen)1, (ftnlen)1) && ! lsame_(diag, + } else if (! PASTEF770(lsame)(diag, "U", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(diag, "N", (ftnlen)1, (ftnlen)1)) { info = 3; } else if (*n < 0) { @@ -743,7 +739,7 @@ info = 7; } if (info != 0) { - xerbla_("DTPMV ", &info, (ftnlen)6); + PASTEF770(xerbla)("DTPMV ", &info, (ftnlen)6); return 0; } @@ -753,7 +749,7 @@ return 0; } - nounit = lsame_(diag, "N", (ftnlen)1, (ftnlen)1); + nounit = PASTEF770(lsame)(diag, "N", (ftnlen)1, (ftnlen)1); /* Set up the start point in X if the increment is not unity. This */ /* will be ( N - 1 )*INCX too small for descending loops. */ @@ -767,11 +763,11 @@ /* Start the operations. In this version the elements of AP are */ /* accessed sequentially with one pass through AP. */ - if (lsame_(trans, "N", (ftnlen)1, (ftnlen)1)) { + if (PASTEF770(lsame)(trans, "N", (ftnlen)1, (ftnlen)1)) { /* Form x:= A*x. */ - if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) { + if (PASTEF770(lsame)(uplo, "U", (ftnlen)1, (ftnlen)1)) { kk = 1; if (*incx == 1) { i__1 = *n; @@ -861,7 +857,7 @@ /* Form x := A'*x. */ - if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) { + if (PASTEF770(lsame)(uplo, "U", (ftnlen)1, (ftnlen)1)) { kk = *n * (*n + 1) / 2; if (*incx == 1) { for (j = *n; j >= 1; --j) { @@ -954,8 +950,7 @@ -lf2c -lm (in that order) */ -/* Subroutine */ int PASTEF77(s,tpmv)(character *uplo, character *trans, character *diag, integer *n, - real *ap, real *x, integer *incx) +/* Subroutine */ int PASTEF77(s,tpmv)(character *uplo, character *trans, character *diag, integer *n, real *ap, real *x, integer *incx) { /* System generated locals */ integer i__1, i__2; @@ -964,9 +959,9 @@ integer info; real temp; integer i__, j, k; - extern logical lsame_(character *, character *, ftnlen, ftnlen); + extern logical PASTEF770(lsame)(character *, character *, ftnlen, ftnlen); integer kk, ix, jx, kx = 0; - extern /* Subroutine */ int xerbla_(character *, integer *, ftnlen); + extern /* Subroutine */ int PASTEF770(xerbla)(character *, integer *, ftnlen); logical nounit; /* .. Scalar Arguments .. */ @@ -1076,14 +1071,14 @@ /* Function Body */ info = 0; - if (! lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && ! lsame_(uplo, "L", ( + if (! PASTEF770(lsame)(uplo, "U", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(uplo, "L", ( ftnlen)1, (ftnlen)1)) { info = 1; - } else if (! lsame_(trans, "N", (ftnlen)1, (ftnlen)1) && ! lsame_(trans, - "T", (ftnlen)1, (ftnlen)1) && ! lsame_(trans, "C", (ftnlen)1, ( + } else if (! PASTEF770(lsame)(trans, "N", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(trans, + "T", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(trans, "C", (ftnlen)1, ( ftnlen)1)) { info = 2; - } else if (! lsame_(diag, "U", (ftnlen)1, (ftnlen)1) && ! lsame_(diag, + } else if (! PASTEF770(lsame)(diag, "U", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(diag, "N", (ftnlen)1, (ftnlen)1)) { info = 3; } else if (*n < 0) { @@ -1092,7 +1087,7 @@ info = 7; } if (info != 0) { - xerbla_("STPMV ", &info, (ftnlen)6); + PASTEF770(xerbla)("STPMV ", &info, (ftnlen)6); return 0; } @@ -1102,7 +1097,7 @@ return 0; } - nounit = lsame_(diag, "N", (ftnlen)1, (ftnlen)1); + nounit = PASTEF770(lsame)(diag, "N", (ftnlen)1, (ftnlen)1); /* Set up the start point in X if the increment is not unity. This */ /* will be ( N - 1 )*INCX too small for descending loops. */ @@ -1116,11 +1111,11 @@ /* Start the operations. In this version the elements of AP are */ /* accessed sequentially with one pass through AP. */ - if (lsame_(trans, "N", (ftnlen)1, (ftnlen)1)) { + if (PASTEF770(lsame)(trans, "N", (ftnlen)1, (ftnlen)1)) { /* Form x:= A*x. */ - if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) { + if (PASTEF770(lsame)(uplo, "U", (ftnlen)1, (ftnlen)1)) { kk = 1; if (*incx == 1) { i__1 = *n; @@ -1210,7 +1205,7 @@ /* Form x := A'*x. */ - if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) { + if (PASTEF770(lsame)(uplo, "U", (ftnlen)1, (ftnlen)1)) { kk = *n * (*n + 1) / 2; if (*incx == 1) { for (j = *n; j >= 1; --j) { @@ -1303,23 +1298,22 @@ -lf2c -lm (in that order) */ -/* Subroutine */ int PASTEF77(z,tpmv)(character *uplo, character *trans, character *diag, integer *n, - doublecomplex *ap, doublecomplex *x, integer *incx) +/* Subroutine */ int PASTEF77(z,tpmv)(character *uplo, character *trans, character *diag, integer *n, doublecomplex *ap, doublecomplex *x, integer *incx) { /* System generated locals */ integer i__1, i__2, i__3, i__4, i__5; doublecomplex z__1, z__2, z__3; /* Builtin functions */ - void d_cnjg(doublecomplex *, doublecomplex *); + void bla_d_cnjg(doublecomplex *, doublecomplex *); /* Local variables */ integer info; doublecomplex temp; integer i__, j, k; - extern logical lsame_(character *, character *, ftnlen, ftnlen); + extern logical PASTEF770(lsame)(character *, character *, ftnlen, ftnlen); integer kk, ix, jx, kx = 0; - extern /* Subroutine */ int xerbla_(character *, integer *, ftnlen); + extern /* Subroutine */ int PASTEF770(xerbla)(character *, integer *, ftnlen); logical noconj, nounit; /* .. Scalar Arguments .. */ @@ -1430,14 +1424,14 @@ /* Function Body */ info = 0; - if (! lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && ! lsame_(uplo, "L", ( + if (! PASTEF770(lsame)(uplo, "U", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(uplo, "L", ( ftnlen)1, (ftnlen)1)) { info = 1; - } else if (! lsame_(trans, "N", (ftnlen)1, (ftnlen)1) && ! lsame_(trans, - "T", (ftnlen)1, (ftnlen)1) && ! lsame_(trans, "C", (ftnlen)1, ( + } else if (! PASTEF770(lsame)(trans, "N", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(trans, + "T", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(trans, "C", (ftnlen)1, ( ftnlen)1)) { info = 2; - } else if (! lsame_(diag, "U", (ftnlen)1, (ftnlen)1) && ! lsame_(diag, + } else if (! PASTEF770(lsame)(diag, "U", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(diag, "N", (ftnlen)1, (ftnlen)1)) { info = 3; } else if (*n < 0) { @@ -1446,7 +1440,7 @@ info = 7; } if (info != 0) { - xerbla_("ZTPMV ", &info, (ftnlen)6); + PASTEF770(xerbla)("ZTPMV ", &info, (ftnlen)6); return 0; } @@ -1456,8 +1450,8 @@ return 0; } - noconj = lsame_(trans, "T", (ftnlen)1, (ftnlen)1); - nounit = lsame_(diag, "N", (ftnlen)1, (ftnlen)1); + noconj = PASTEF770(lsame)(trans, "T", (ftnlen)1, (ftnlen)1); + nounit = PASTEF770(lsame)(diag, "N", (ftnlen)1, (ftnlen)1); /* Set up the start point in X if the increment is not unity. This */ /* will be ( N - 1 )*INCX too small for descending loops. */ @@ -1471,11 +1465,11 @@ /* Start the operations. In this version the elements of AP are */ /* accessed sequentially with one pass through AP. */ - if (lsame_(trans, "N", (ftnlen)1, (ftnlen)1)) { + if (PASTEF770(lsame)(trans, "N", (ftnlen)1, (ftnlen)1)) { /* Form x:= A*x. */ - if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) { + if (PASTEF770(lsame)(uplo, "U", (ftnlen)1, (ftnlen)1)) { kk = 1; if (*incx == 1) { i__1 = *n; @@ -1629,7 +1623,7 @@ /* Form x := A'*x or x := conjg( A' )*x. */ - if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) { + if (PASTEF770(lsame)(uplo, "U", (ftnlen)1, (ftnlen)1)) { kk = *n * (*n + 1) / 2; if (*incx == 1) { for (j = *n; j >= 1; --j) { @@ -1658,14 +1652,14 @@ } } else { if (nounit) { - d_cnjg(&z__2, &ap[kk]); + bla_d_cnjg(&z__2, &ap[kk]); z__1.real = temp.real * z__2.real - temp.imag * z__2.imag, z__1.imag = temp.real * z__2.imag + temp.imag * z__2.real; temp.real = z__1.real, temp.imag = z__1.imag; } for (i__ = j - 1; i__ >= 1; --i__) { - d_cnjg(&z__3, &ap[k]); + bla_d_cnjg(&z__3, &ap[k]); i__1 = i__; z__2.real = z__3.real * x[i__1].real - z__3.imag * x[i__1].imag, z__2.imag = z__3.real * x[i__1].imag + z__3.imag * x[ @@ -1711,7 +1705,7 @@ } } else { if (nounit) { - d_cnjg(&z__2, &ap[kk]); + bla_d_cnjg(&z__2, &ap[kk]); z__1.real = temp.real * z__2.real - temp.imag * z__2.imag, z__1.imag = temp.real * z__2.imag + temp.imag * z__2.real; @@ -1720,7 +1714,7 @@ i__1 = kk - j + 1; for (k = kk - 1; k >= i__1; --k) { ix -= *incx; - d_cnjg(&z__3, &ap[k]); + bla_d_cnjg(&z__3, &ap[k]); i__2 = ix; z__2.real = z__3.real * x[i__2].real - z__3.imag * x[i__2].imag, z__2.imag = z__3.real * x[i__2].imag + z__3.imag * x[ @@ -1769,7 +1763,7 @@ } } else { if (nounit) { - d_cnjg(&z__2, &ap[kk]); + bla_d_cnjg(&z__2, &ap[kk]); z__1.real = temp.real * z__2.real - temp.imag * z__2.imag, z__1.imag = temp.real * z__2.imag + temp.imag * z__2.real; @@ -1777,7 +1771,7 @@ } i__2 = *n; for (i__ = j + 1; i__ <= i__2; ++i__) { - d_cnjg(&z__3, &ap[k]); + bla_d_cnjg(&z__3, &ap[k]); i__3 = i__; z__2.real = z__3.real * x[i__3].real - z__3.imag * x[i__3].imag, z__2.imag = z__3.real * x[i__3].imag + z__3.imag * x[ @@ -1824,7 +1818,7 @@ } } else { if (nounit) { - d_cnjg(&z__2, &ap[kk]); + bla_d_cnjg(&z__2, &ap[kk]); z__1.real = temp.real * z__2.real - temp.imag * z__2.imag, z__1.imag = temp.real * z__2.imag + temp.imag * z__2.real; @@ -1833,7 +1827,7 @@ i__2 = kk + *n - j; for (k = kk + 1; k <= i__2; ++k) { ix += *incx; - d_cnjg(&z__3, &ap[k]); + bla_d_cnjg(&z__3, &ap[k]); i__3 = ix; z__2.real = z__3.real * x[i__3].real - z__3.imag * x[i__3].imag, z__2.imag = z__3.real * x[i__3].imag + z__3.imag * x[ diff --git a/frame/compat/f2c/bla_tpmv.h b/frame/compat/f2c/bla_tpmv.h new file mode 100644 index 000000000..e2c111ae6 --- /dev/null +++ b/frame/compat/f2c/bla_tpmv.h @@ -0,0 +1,44 @@ +/* + + BLIS + An object-based framework for developing high-performance BLAS-like + libraries. + + Copyright (C) 2013, The University of Texas + + 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 The University of Texas 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 + HOLDER 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. + +*/ + +#include "blis.h" + +#ifdef BLIS_ENABLE_BLAS2BLIS + +int PASTEF77(c,tpmv)(character *uplo, character *trans, character *diag, integer *n, singlecomplex *ap, singlecomplex *x, integer *incx); +int PASTEF77(d,tpmv)(character *uplo, character *trans, character *diag, integer *n, doublereal *ap, doublereal *x, integer *incx); +int PASTEF77(s,tpmv)(character *uplo, character *trans, character *diag, integer *n, real *ap, real *x, integer *incx); +int PASTEF77(z,tpmv)(character *uplo, character *trans, character *diag, integer *n, doublecomplex *ap, doublecomplex *x, integer *incx); + +#endif diff --git a/frame/compat/f2c/bla_tpsv.c b/frame/compat/f2c/bla_tpsv.c index 161c7dc2d..b917753d3 100644 --- a/frame/compat/f2c/bla_tpsv.c +++ b/frame/compat/f2c/bla_tpsv.c @@ -36,30 +36,27 @@ #ifdef BLIS_ENABLE_BLAS2BLIS -#include "bli_f2c.h" - /* ctpsv.f -- translated by f2c (version 19991025). You must link the resulting object file with the libraries: -lf2c -lm (in that order) */ -/* Subroutine */ int PASTEF77(c,tpsv)(character *uplo, character *trans, character *diag, integer *n, - singlecomplex *ap, singlecomplex *x, integer *incx) +/* Subroutine */ int PASTEF77(c,tpsv)(character *uplo, character *trans, character *diag, integer *n, singlecomplex *ap, singlecomplex *x, integer *incx) { /* System generated locals */ integer i__1, i__2, i__3, i__4, i__5; singlecomplex q__1, q__2, q__3; /* Builtin functions */ - void c_div(singlecomplex *, singlecomplex *, singlecomplex *), r_cnjg(singlecomplex *, singlecomplex *); + void bla_c_div(singlecomplex *, singlecomplex *, singlecomplex *), bla_r_cnjg(singlecomplex *, singlecomplex *); /* Local variables */ integer info; singlecomplex temp; integer i__, j, k; - extern logical lsame_(character *, character *, ftnlen, ftnlen); + extern logical PASTEF770(lsame)(character *, character *, ftnlen, ftnlen); integer kk, ix, jx, kx = 0; - extern /* Subroutine */ int xerbla_(character *, integer *, ftnlen); + extern /* Subroutine */ int PASTEF770(xerbla)(character *, integer *, ftnlen); logical noconj, nounit; /* .. Scalar Arguments .. */ @@ -173,14 +170,14 @@ /* Function Body */ info = 0; - if (! lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && ! lsame_(uplo, "L", ( + if (! PASTEF770(lsame)(uplo, "U", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(uplo, "L", ( ftnlen)1, (ftnlen)1)) { info = 1; - } else if (! lsame_(trans, "N", (ftnlen)1, (ftnlen)1) && ! lsame_(trans, - "T", (ftnlen)1, (ftnlen)1) && ! lsame_(trans, "C", (ftnlen)1, ( + } else if (! PASTEF770(lsame)(trans, "N", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(trans, + "T", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(trans, "C", (ftnlen)1, ( ftnlen)1)) { info = 2; - } else if (! lsame_(diag, "U", (ftnlen)1, (ftnlen)1) && ! lsame_(diag, + } else if (! PASTEF770(lsame)(diag, "U", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(diag, "N", (ftnlen)1, (ftnlen)1)) { info = 3; } else if (*n < 0) { @@ -189,7 +186,7 @@ info = 7; } if (info != 0) { - xerbla_("CTPSV ", &info, (ftnlen)6); + PASTEF770(xerbla)("CTPSV ", &info, (ftnlen)6); return 0; } @@ -199,8 +196,8 @@ return 0; } - noconj = lsame_(trans, "T", (ftnlen)1, (ftnlen)1); - nounit = lsame_(diag, "N", (ftnlen)1, (ftnlen)1); + noconj = PASTEF770(lsame)(trans, "T", (ftnlen)1, (ftnlen)1); + nounit = PASTEF770(lsame)(diag, "N", (ftnlen)1, (ftnlen)1); /* Set up the start point in X if the increment is not unity. This */ /* will be ( N - 1 )*INCX too small for descending loops. */ @@ -214,11 +211,11 @@ /* Start the operations. In this version the elements of AP are */ /* accessed sequentially with one pass through AP. */ - if (lsame_(trans, "N", (ftnlen)1, (ftnlen)1)) { + if (PASTEF770(lsame)(trans, "N", (ftnlen)1, (ftnlen)1)) { /* Form x := inv( A )*x. */ - if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) { + if (PASTEF770(lsame)(uplo, "U", (ftnlen)1, (ftnlen)1)) { kk = *n * (*n + 1) / 2; if (*incx == 1) { for (j = *n; j >= 1; --j) { @@ -226,7 +223,7 @@ if (x[i__1].real != 0.f || x[i__1].imag != 0.f) { if (nounit) { i__1 = j; - c_div(&q__1, &x[j], &ap[kk]); + bla_c_div(&q__1, &x[j], &ap[kk]); x[i__1].real = q__1.real, x[i__1].imag = q__1.imag; } i__1 = j; @@ -256,7 +253,7 @@ if (x[i__1].real != 0.f || x[i__1].imag != 0.f) { if (nounit) { i__1 = jx; - c_div(&q__1, &x[jx], &ap[kk]); + bla_c_div(&q__1, &x[jx], &ap[kk]); x[i__1].real = q__1.real, x[i__1].imag = q__1.imag; } i__1 = jx; @@ -291,7 +288,7 @@ if (x[i__2].real != 0.f || x[i__2].imag != 0.f) { if (nounit) { i__2 = j; - c_div(&q__1, &x[j], &ap[kk]); + bla_c_div(&q__1, &x[j], &ap[kk]); x[i__2].real = q__1.real, x[i__2].imag = q__1.imag; } i__2 = j; @@ -323,7 +320,7 @@ if (x[i__2].real != 0.f || x[i__2].imag != 0.f) { if (nounit) { i__2 = jx; - c_div(&q__1, &x[jx], &ap[kk]); + bla_c_div(&q__1, &x[jx], &ap[kk]); x[i__2].real = q__1.real, x[i__2].imag = q__1.imag; } i__2 = jx; @@ -354,7 +351,7 @@ /* Form x := inv( A' )*x or x := inv( conjg( A' ) )*x. */ - if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) { + if (PASTEF770(lsame)(uplo, "U", (ftnlen)1, (ftnlen)1)) { kk = 1; if (*incx == 1) { i__1 = *n; @@ -377,13 +374,13 @@ /* L90: */ } if (nounit) { - c_div(&q__1, &temp, &ap[kk + j - 1]); + bla_c_div(&q__1, &temp, &ap[kk + j - 1]); temp.real = q__1.real, temp.imag = q__1.imag; } } else { i__2 = j - 1; for (i__ = 1; i__ <= i__2; ++i__) { - r_cnjg(&q__3, &ap[k]); + bla_r_cnjg(&q__3, &ap[k]); i__3 = i__; q__2.real = q__3.real * x[i__3].real - q__3.imag * x[i__3].imag, q__2.imag = q__3.real * x[i__3].imag + q__3.imag * x[ @@ -395,8 +392,8 @@ /* L100: */ } if (nounit) { - r_cnjg(&q__2, &ap[kk + j - 1]); - c_div(&q__1, &temp, &q__2); + bla_r_cnjg(&q__2, &ap[kk + j - 1]); + bla_c_div(&q__1, &temp, &q__2); temp.real = q__1.real, temp.imag = q__1.imag; } } @@ -427,13 +424,13 @@ /* L120: */ } if (nounit) { - c_div(&q__1, &temp, &ap[kk + j - 1]); + bla_c_div(&q__1, &temp, &ap[kk + j - 1]); temp.real = q__1.real, temp.imag = q__1.imag; } } else { i__2 = kk + j - 2; for (k = kk; k <= i__2; ++k) { - r_cnjg(&q__3, &ap[k]); + bla_r_cnjg(&q__3, &ap[k]); i__3 = ix; q__2.real = q__3.real * x[i__3].real - q__3.imag * x[i__3].imag, q__2.imag = q__3.real * x[i__3].imag + q__3.imag * x[ @@ -445,8 +442,8 @@ /* L130: */ } if (nounit) { - r_cnjg(&q__2, &ap[kk + j - 1]); - c_div(&q__1, &temp, &q__2); + bla_r_cnjg(&q__2, &ap[kk + j - 1]); + bla_c_div(&q__1, &temp, &q__2); temp.real = q__1.real, temp.imag = q__1.imag; } } @@ -479,13 +476,13 @@ /* L150: */ } if (nounit) { - c_div(&q__1, &temp, &ap[kk - *n + j]); + bla_c_div(&q__1, &temp, &ap[kk - *n + j]); temp.real = q__1.real, temp.imag = q__1.imag; } } else { i__1 = j + 1; for (i__ = *n; i__ >= i__1; --i__) { - r_cnjg(&q__3, &ap[k]); + bla_r_cnjg(&q__3, &ap[k]); i__2 = i__; q__2.real = q__3.real * x[i__2].real - q__3.imag * x[i__2].imag, q__2.imag = q__3.real * x[i__2].imag + q__3.imag * x[ @@ -497,8 +494,8 @@ /* L160: */ } if (nounit) { - r_cnjg(&q__2, &ap[kk - *n + j]); - c_div(&q__1, &temp, &q__2); + bla_r_cnjg(&q__2, &ap[kk - *n + j]); + bla_c_div(&q__1, &temp, &q__2); temp.real = q__1.real, temp.imag = q__1.imag; } } @@ -529,13 +526,13 @@ /* L180: */ } if (nounit) { - c_div(&q__1, &temp, &ap[kk - *n + j]); + bla_c_div(&q__1, &temp, &ap[kk - *n + j]); temp.real = q__1.real, temp.imag = q__1.imag; } } else { i__1 = kk - (*n - (j + 1)); for (k = kk; k >= i__1; --k) { - r_cnjg(&q__3, &ap[k]); + bla_r_cnjg(&q__3, &ap[k]); i__2 = ix; q__2.real = q__3.real * x[i__2].real - q__3.imag * x[i__2].imag, q__2.imag = q__3.real * x[i__2].imag + q__3.imag * x[ @@ -547,8 +544,8 @@ /* L190: */ } if (nounit) { - r_cnjg(&q__2, &ap[kk - *n + j]); - c_div(&q__1, &temp, &q__2); + bla_r_cnjg(&q__2, &ap[kk - *n + j]); + bla_c_div(&q__1, &temp, &q__2); temp.real = q__1.real, temp.imag = q__1.imag; } } @@ -573,8 +570,7 @@ -lf2c -lm (in that order) */ -/* Subroutine */ int PASTEF77(d,tpsv)(character *uplo, character *trans, character *diag, integer *n, - doublereal *ap, doublereal *x, integer *incx) +/* Subroutine */ int PASTEF77(d,tpsv)(character *uplo, character *trans, character *diag, integer *n, doublereal *ap, doublereal *x, integer *incx) { /* System generated locals */ integer i__1, i__2; @@ -583,9 +579,9 @@ integer info; doublereal temp; integer i__, j, k; - extern logical lsame_(character *, character *, ftnlen, ftnlen); + extern logical PASTEF770(lsame)(character *, character *, ftnlen, ftnlen); integer kk, ix, jx, kx = 0; - extern /* Subroutine */ int xerbla_(character *, integer *, ftnlen); + extern /* Subroutine */ int PASTEF770(xerbla)(character *, integer *, ftnlen); logical nounit; /* .. Scalar Arguments .. */ @@ -698,14 +694,14 @@ /* Function Body */ info = 0; - if (! lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && ! lsame_(uplo, "L", ( + if (! PASTEF770(lsame)(uplo, "U", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(uplo, "L", ( ftnlen)1, (ftnlen)1)) { info = 1; - } else if (! lsame_(trans, "N", (ftnlen)1, (ftnlen)1) && ! lsame_(trans, - "T", (ftnlen)1, (ftnlen)1) && ! lsame_(trans, "C", (ftnlen)1, ( + } else if (! PASTEF770(lsame)(trans, "N", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(trans, + "T", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(trans, "C", (ftnlen)1, ( ftnlen)1)) { info = 2; - } else if (! lsame_(diag, "U", (ftnlen)1, (ftnlen)1) && ! lsame_(diag, + } else if (! PASTEF770(lsame)(diag, "U", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(diag, "N", (ftnlen)1, (ftnlen)1)) { info = 3; } else if (*n < 0) { @@ -714,7 +710,7 @@ info = 7; } if (info != 0) { - xerbla_("DTPSV ", &info, (ftnlen)6); + PASTEF770(xerbla)("DTPSV ", &info, (ftnlen)6); return 0; } @@ -724,7 +720,7 @@ return 0; } - nounit = lsame_(diag, "N", (ftnlen)1, (ftnlen)1); + nounit = PASTEF770(lsame)(diag, "N", (ftnlen)1, (ftnlen)1); /* Set up the start point in X if the increment is not unity. This */ /* will be ( N - 1 )*INCX too small for descending loops. */ @@ -738,11 +734,11 @@ /* Start the operations. In this version the elements of AP are */ /* accessed sequentially with one pass through AP. */ - if (lsame_(trans, "N", (ftnlen)1, (ftnlen)1)) { + if (PASTEF770(lsame)(trans, "N", (ftnlen)1, (ftnlen)1)) { /* Form x := inv( A )*x. */ - if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) { + if (PASTEF770(lsame)(uplo, "U", (ftnlen)1, (ftnlen)1)) { kk = *n * (*n + 1) / 2; if (*incx == 1) { for (j = *n; j >= 1; --j) { @@ -830,7 +826,7 @@ /* Form x := inv( A' )*x. */ - if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) { + if (PASTEF770(lsame)(uplo, "U", (ftnlen)1, (ftnlen)1)) { kk = 1; if (*incx == 1) { i__1 = *n; @@ -925,8 +921,7 @@ -lf2c -lm (in that order) */ -/* Subroutine */ int PASTEF77(s,tpsv)(character *uplo, character *trans, character *diag, integer *n, - real *ap, real *x, integer *incx) +/* Subroutine */ int PASTEF77(s,tpsv)(character *uplo, character *trans, character *diag, integer *n, real *ap, real *x, integer *incx) { /* System generated locals */ integer i__1, i__2; @@ -935,9 +930,9 @@ integer info; real temp; integer i__, j, k; - extern logical lsame_(character *, character *, ftnlen, ftnlen); + extern logical PASTEF770(lsame)(character *, character *, ftnlen, ftnlen); integer kk, ix, jx, kx = 0; - extern /* Subroutine */ int xerbla_(character *, integer *, ftnlen); + extern /* Subroutine */ int PASTEF770(xerbla)(character *, integer *, ftnlen); logical nounit; /* .. Scalar Arguments .. */ @@ -1050,14 +1045,14 @@ /* Function Body */ info = 0; - if (! lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && ! lsame_(uplo, "L", ( + if (! PASTEF770(lsame)(uplo, "U", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(uplo, "L", ( ftnlen)1, (ftnlen)1)) { info = 1; - } else if (! lsame_(trans, "N", (ftnlen)1, (ftnlen)1) && ! lsame_(trans, - "T", (ftnlen)1, (ftnlen)1) && ! lsame_(trans, "C", (ftnlen)1, ( + } else if (! PASTEF770(lsame)(trans, "N", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(trans, + "T", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(trans, "C", (ftnlen)1, ( ftnlen)1)) { info = 2; - } else if (! lsame_(diag, "U", (ftnlen)1, (ftnlen)1) && ! lsame_(diag, + } else if (! PASTEF770(lsame)(diag, "U", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(diag, "N", (ftnlen)1, (ftnlen)1)) { info = 3; } else if (*n < 0) { @@ -1066,7 +1061,7 @@ info = 7; } if (info != 0) { - xerbla_("STPSV ", &info, (ftnlen)6); + PASTEF770(xerbla)("STPSV ", &info, (ftnlen)6); return 0; } @@ -1076,7 +1071,7 @@ return 0; } - nounit = lsame_(diag, "N", (ftnlen)1, (ftnlen)1); + nounit = PASTEF770(lsame)(diag, "N", (ftnlen)1, (ftnlen)1); /* Set up the start point in X if the increment is not unity. This */ /* will be ( N - 1 )*INCX too small for descending loops. */ @@ -1090,11 +1085,11 @@ /* Start the operations. In this version the elements of AP are */ /* accessed sequentially with one pass through AP. */ - if (lsame_(trans, "N", (ftnlen)1, (ftnlen)1)) { + if (PASTEF770(lsame)(trans, "N", (ftnlen)1, (ftnlen)1)) { /* Form x := inv( A )*x. */ - if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) { + if (PASTEF770(lsame)(uplo, "U", (ftnlen)1, (ftnlen)1)) { kk = *n * (*n + 1) / 2; if (*incx == 1) { for (j = *n; j >= 1; --j) { @@ -1182,7 +1177,7 @@ /* Form x := inv( A' )*x. */ - if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) { + if (PASTEF770(lsame)(uplo, "U", (ftnlen)1, (ftnlen)1)) { kk = 1; if (*incx == 1) { i__1 = *n; @@ -1277,24 +1272,23 @@ -lf2c -lm (in that order) */ -/* Subroutine */ int PASTEF77(z,tpsv)(character *uplo, character *trans, character *diag, integer *n, - doublecomplex *ap, doublecomplex *x, integer *incx) +/* Subroutine */ int PASTEF77(z,tpsv)(character *uplo, character *trans, character *diag, integer *n, doublecomplex *ap, doublecomplex *x, integer *incx) { /* System generated locals */ integer i__1, i__2, i__3, i__4, i__5; doublecomplex z__1, z__2, z__3; /* Builtin functions */ - void z_div(doublecomplex *, doublecomplex *, doublecomplex *), d_cnjg( + void bla_z_div(doublecomplex *, doublecomplex *, doublecomplex *), bla_d_cnjg( doublecomplex *, doublecomplex *); /* Local variables */ integer info; doublecomplex temp; integer i__, j, k; - extern logical lsame_(character *, character *, ftnlen, ftnlen); + extern logical PASTEF770(lsame)(character *, character *, ftnlen, ftnlen); integer kk, ix, jx, kx = 0; - extern /* Subroutine */ int xerbla_(character *, integer *, ftnlen); + extern /* Subroutine */ int PASTEF770(xerbla)(character *, integer *, ftnlen); logical noconj, nounit; /* .. Scalar Arguments .. */ @@ -1408,14 +1402,14 @@ /* Function Body */ info = 0; - if (! lsame_(uplo, "U", (ftnlen)1, (ftnlen)1) && ! lsame_(uplo, "L", ( + if (! PASTEF770(lsame)(uplo, "U", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(uplo, "L", ( ftnlen)1, (ftnlen)1)) { info = 1; - } else if (! lsame_(trans, "N", (ftnlen)1, (ftnlen)1) && ! lsame_(trans, - "T", (ftnlen)1, (ftnlen)1) && ! lsame_(trans, "C", (ftnlen)1, ( + } else if (! PASTEF770(lsame)(trans, "N", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(trans, + "T", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(trans, "C", (ftnlen)1, ( ftnlen)1)) { info = 2; - } else if (! lsame_(diag, "U", (ftnlen)1, (ftnlen)1) && ! lsame_(diag, + } else if (! PASTEF770(lsame)(diag, "U", (ftnlen)1, (ftnlen)1) && ! PASTEF770(lsame)(diag, "N", (ftnlen)1, (ftnlen)1)) { info = 3; } else if (*n < 0) { @@ -1424,7 +1418,7 @@ info = 7; } if (info != 0) { - xerbla_("ZTPSV ", &info, (ftnlen)6); + PASTEF770(xerbla)("ZTPSV ", &info, (ftnlen)6); return 0; } @@ -1434,8 +1428,8 @@ return 0; } - noconj = lsame_(trans, "T", (ftnlen)1, (ftnlen)1); - nounit = lsame_(diag, "N", (ftnlen)1, (ftnlen)1); + noconj = PASTEF770(lsame)(trans, "T", (ftnlen)1, (ftnlen)1); + nounit = PASTEF770(lsame)(diag, "N", (ftnlen)1, (ftnlen)1); /* Set up the start point in X if the increment is not unity. This */ /* will be ( N - 1 )*INCX too small for descending loops. */ @@ -1449,11 +1443,11 @@ /* Start the operations. In this version the elements of AP are */ /* accessed sequentially with one pass through AP. */ - if (lsame_(trans, "N", (ftnlen)1, (ftnlen)1)) { + if (PASTEF770(lsame)(trans, "N", (ftnlen)1, (ftnlen)1)) { /* Form x := inv( A )*x. */ - if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) { + if (PASTEF770(lsame)(uplo, "U", (ftnlen)1, (ftnlen)1)) { kk = *n * (*n + 1) / 2; if (*incx == 1) { for (j = *n; j >= 1; --j) { @@ -1461,7 +1455,7 @@ if (x[i__1].real != 0. || x[i__1].imag != 0.) { if (nounit) { i__1 = j; - z_div(&z__1, &x[j], &ap[kk]); + bla_z_div(&z__1, &x[j], &ap[kk]); x[i__1].real = z__1.real, x[i__1].imag = z__1.imag; } i__1 = j; @@ -1491,7 +1485,7 @@ if (x[i__1].real != 0. || x[i__1].imag != 0.) { if (nounit) { i__1 = jx; - z_div(&z__1, &x[jx], &ap[kk]); + bla_z_div(&z__1, &x[jx], &ap[kk]); x[i__1].real = z__1.real, x[i__1].imag = z__1.imag; } i__1 = jx; @@ -1526,7 +1520,7 @@ if (x[i__2].real != 0. || x[i__2].imag != 0.) { if (nounit) { i__2 = j; - z_div(&z__1, &x[j], &ap[kk]); + bla_z_div(&z__1, &x[j], &ap[kk]); x[i__2].real = z__1.real, x[i__2].imag = z__1.imag; } i__2 = j; @@ -1558,7 +1552,7 @@ if (x[i__2].real != 0. || x[i__2].imag != 0.) { if (nounit) { i__2 = jx; - z_div(&z__1, &x[jx], &ap[kk]); + bla_z_div(&z__1, &x[jx], &ap[kk]); x[i__2].real = z__1.real, x[i__2].imag = z__1.imag; } i__2 = jx; @@ -1589,7 +1583,7 @@ /* Form x := inv( A' )*x or x := inv( conjg( A' ) )*x. */ - if (lsame_(uplo, "U", (ftnlen)1, (ftnlen)1)) { + if (PASTEF770(lsame)(uplo, "U", (ftnlen)1, (ftnlen)1)) { kk = 1; if (*incx == 1) { i__1 = *n; @@ -1612,13 +1606,13 @@ /* L90: */ } if (nounit) { - z_div(&z__1, &temp, &ap[kk + j - 1]); + bla_z_div(&z__1, &temp, &ap[kk + j - 1]); temp.real = z__1.real, temp.imag = z__1.imag; } } else { i__2 = j - 1; for (i__ = 1; i__ <= i__2; ++i__) { - d_cnjg(&z__3, &ap[k]); + bla_d_cnjg(&z__3, &ap[k]); i__3 = i__; z__2.real = z__3.real * x[i__3].real - z__3.imag * x[i__3].imag, z__2.imag = z__3.real * x[i__3].imag + z__3.imag * x[ @@ -1630,8 +1624,8 @@ /* L100: */ } if (nounit) { - d_cnjg(&z__2, &ap[kk + j - 1]); - z_div(&z__1, &temp, &z__2); + bla_d_cnjg(&z__2, &ap[kk + j - 1]); + bla_z_div(&z__1, &temp, &z__2); temp.real = z__1.real, temp.imag = z__1.imag; } } @@ -1662,13 +1656,13 @@ /* L120: */ } if (nounit) { - z_div(&z__1, &temp, &ap[kk + j - 1]); + bla_z_div(&z__1, &temp, &ap[kk + j - 1]); temp.real = z__1.real, temp.imag = z__1.imag; } } else { i__2 = kk + j - 2; for (k = kk; k <= i__2; ++k) { - d_cnjg(&z__3, &ap[k]); + bla_d_cnjg(&z__3, &ap[k]); i__3 = ix; z__2.real = z__3.real * x[i__3].real - z__3.imag * x[i__3].imag, z__2.imag = z__3.real * x[i__3].imag + z__3.imag * x[ @@ -1680,8 +1674,8 @@ /* L130: */ } if (nounit) { - d_cnjg(&z__2, &ap[kk + j - 1]); - z_div(&z__1, &temp, &z__2); + bla_d_cnjg(&z__2, &ap[kk + j - 1]); + bla_z_div(&z__1, &temp, &z__2); temp.real = z__1.real, temp.imag = z__1.imag; } } @@ -1714,13 +1708,13 @@ /* L150: */ } if (nounit) { - z_div(&z__1, &temp, &ap[kk - *n + j]); + bla_z_div(&z__1, &temp, &ap[kk - *n + j]); temp.real = z__1.real, temp.imag = z__1.imag; } } else { i__1 = j + 1; for (i__ = *n; i__ >= i__1; --i__) { - d_cnjg(&z__3, &ap[k]); + bla_d_cnjg(&z__3, &ap[k]); i__2 = i__; z__2.real = z__3.real * x[i__2].real - z__3.imag * x[i__2].imag, z__2.imag = z__3.real * x[i__2].imag + z__3.imag * x[ @@ -1732,8 +1726,8 @@ /* L160: */ } if (nounit) { - d_cnjg(&z__2, &ap[kk - *n + j]); - z_div(&z__1, &temp, &z__2); + bla_d_cnjg(&z__2, &ap[kk - *n + j]); + bla_z_div(&z__1, &temp, &z__2); temp.real = z__1.real, temp.imag = z__1.imag; } } @@ -1764,13 +1758,13 @@ /* L180: */ } if (nounit) { - z_div(&z__1, &temp, &ap[kk - *n + j]); + bla_z_div(&z__1, &temp, &ap[kk - *n + j]); temp.real = z__1.real, temp.imag = z__1.imag; } } else { i__1 = kk - (*n - (j + 1)); for (k = kk; k >= i__1; --k) { - d_cnjg(&z__3, &ap[k]); + bla_d_cnjg(&z__3, &ap[k]); i__2 = ix; z__2.real = z__3.real * x[i__2].real - z__3.imag * x[i__2].imag, z__2.imag = z__3.real * x[i__2].imag + z__3.imag * x[ @@ -1782,8 +1776,8 @@ /* L190: */ } if (nounit) { - d_cnjg(&z__2, &ap[kk - *n + j]); - z_div(&z__1, &temp, &z__2); + bla_d_cnjg(&z__2, &ap[kk - *n + j]); + bla_z_div(&z__1, &temp, &z__2); temp.real = z__1.real, temp.imag = z__1.imag; } } diff --git a/frame/compat/f2c/bla_tpsv.h b/frame/compat/f2c/bla_tpsv.h new file mode 100644 index 000000000..0e08b7310 --- /dev/null +++ b/frame/compat/f2c/bla_tpsv.h @@ -0,0 +1,44 @@ +/* + + BLIS + An object-based framework for developing high-performance BLAS-like + libraries. + + Copyright (C) 2013, The University of Texas + + 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 The University of Texas 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 + HOLDER 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. + +*/ + +#include "blis.h" + +#ifdef BLIS_ENABLE_BLAS2BLIS + +int PASTEF77(c,tpsv)(character *uplo, character *trans, character *diag, integer *n, singlecomplex *ap, singlecomplex *x, integer *incx); +int PASTEF77(d,tpsv)(character *uplo, character *trans, character *diag, integer *n, doublereal *ap, doublereal *x, integer *incx); +int PASTEF77(s,tpsv)(character *uplo, character *trans, character *diag, integer *n, real *ap, real *x, integer *incx); +int PASTEF77(z,tpsv)(character *uplo, character *trans, character *diag, integer *n, doublecomplex *ap, doublecomplex *x, integer *incx); + +#endif diff --git a/frame/compat/f2c/bla_xerbla.c b/frame/compat/f2c/bla_xerbla.c index ffbf6290e..1c2df43f4 100644 --- a/frame/compat/f2c/bla_xerbla.c +++ b/frame/compat/f2c/bla_xerbla.c @@ -36,9 +36,6 @@ #ifdef BLIS_ENABLE_BLAS2BLIS -#include "bli_f2c.h" -#include "stdio.h" - /* xerbla.f -- translated by f2c (version 19991025). You must link the resulting object file with the libraries: -lf2c -lm (in that order) @@ -46,7 +43,7 @@ /* Table of constant values */ -/* Subroutine */ int xerbla_(character *srname, integer *info, ftnlen srname_len) +/* Subroutine */ int PASTEF770(xerbla)(character *srname, integer *info, ftnlen srname_len) { /* -- LAPACK auxiliary routine (preliminary version) -- */ /* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */ @@ -75,14 +72,20 @@ /* INFO (input) INTEGER */ /* The position of the invalid parameter in the parameter list */ /* of the calling routine. */ + int i; + + for ( i = 0; i < srname_len; ++i ) + srname[i] = toupper( srname[i] ); printf("** On entry to %6s, parameter number %2i had an illegal value\n", srname, (int)*info); + bli_abort(); + /* End of XERBLA */ return 0; -} /* xerbla_ */ +} /* xerbla */ #endif diff --git a/frame/compat/f2c/bla_xerbla.h b/frame/compat/f2c/bla_xerbla.h new file mode 100644 index 000000000..c981669c4 --- /dev/null +++ b/frame/compat/f2c/bla_xerbla.h @@ -0,0 +1,41 @@ +/* + + BLIS + An object-based framework for developing high-performance BLAS-like + libraries. + + Copyright (C) 2013, The University of Texas + + 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 The University of Texas 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 + HOLDER 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. + +*/ + +#include "blis.h" + +#ifdef BLIS_ENABLE_BLAS2BLIS + +int PASTEF770(xerbla)(character *srname, integer *info, ftnlen srname_len); + +#endif diff --git a/frame/compat/f2c/util/bla_c_div.c b/frame/compat/f2c/util/bla_c_div.c index e048c7645..0962d0c0c 100644 --- a/frame/compat/f2c/util/bla_c_div.c +++ b/frame/compat/f2c/util/bla_c_div.c @@ -36,18 +36,10 @@ #ifdef BLIS_ENABLE_BLAS2BLIS -#include "bli_f2c.h" - -void c_div(singlecomplex *cp, singlecomplex *ap, singlecomplex *bp) +void bla_c_div(singlecomplex *cp, singlecomplex *ap, singlecomplex *bp) { - singlecomplex a = *ap; - singlecomplex b = *bp; - real temp; - - temp = b.real * b.real + b.imag * b.imag; - - cp->real = ( a.real * b.real + a.imag * b.imag ) / temp; - cp->imag = ( a.imag * b.real - a.real * b.imag ) / temp; + bli_ccopys( *ap, *cp ); + bli_cinvscals( *bp, *cp ); } #endif diff --git a/frame/compat/f2c/util/bla_c_div.h b/frame/compat/f2c/util/bla_c_div.h new file mode 100644 index 000000000..c74afd983 --- /dev/null +++ b/frame/compat/f2c/util/bla_c_div.h @@ -0,0 +1,42 @@ +/* + + BLIS + An object-based framework for developing high-performance BLAS-like + libraries. + + Copyright (C) 2013, The University of Texas + + 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 The University of Texas 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 + HOLDER 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. + +*/ + +#include "blis.h" + +#ifdef BLIS_ENABLE_BLAS2BLIS + +void bla_c_div(singlecomplex *cp, singlecomplex *ap, singlecomplex *bp); + +#endif + diff --git a/frame/compat/f2c/util/bla_d_cnjg.c b/frame/compat/f2c/util/bla_d_cnjg.c index 9af8a50cb..d9fe88fe3 100644 --- a/frame/compat/f2c/util/bla_d_cnjg.c +++ b/frame/compat/f2c/util/bla_d_cnjg.c @@ -36,12 +36,9 @@ #ifdef BLIS_ENABLE_BLAS2BLIS -#include "bli_f2c.h" - -void d_cnjg(doublecomplex *dest, doublecomplex *src) +void bla_d_cnjg(doublecomplex *dest, doublecomplex *src) { - dest->real = src->real ; - dest->imag = -(src->imag); + bli_zcopyjs( *src, *dest ); } #endif diff --git a/frame/compat/f2c/util/bla_d_cnjg.h b/frame/compat/f2c/util/bla_d_cnjg.h new file mode 100644 index 000000000..0d2308e93 --- /dev/null +++ b/frame/compat/f2c/util/bla_d_cnjg.h @@ -0,0 +1,42 @@ +/* + + BLIS + An object-based framework for developing high-performance BLAS-like + libraries. + + Copyright (C) 2013, The University of Texas + + 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 The University of Texas 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 + HOLDER 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. + +*/ + +#include "blis.h" + +#ifdef BLIS_ENABLE_BLAS2BLIS + +void bla_d_cnjg(doublecomplex *dest, doublecomplex *src); + +#endif + diff --git a/frame/compat/f2c/util/bla_d_imag.c b/frame/compat/f2c/util/bla_d_imag.c index b3df5e5b0..6f53eaf34 100644 --- a/frame/compat/f2c/util/bla_d_imag.c +++ b/frame/compat/f2c/util/bla_d_imag.c @@ -36,11 +36,9 @@ #ifdef BLIS_ENABLE_BLAS2BLIS -#include "bli_f2c.h" - double d_imag(doublecomplex *z) { - return(z->imag); + return bli_zimag( *z ); } #endif diff --git a/frame/compat/f2c/util/bla_d_imag.h b/frame/compat/f2c/util/bla_d_imag.h new file mode 100644 index 000000000..cba8bdbdf --- /dev/null +++ b/frame/compat/f2c/util/bla_d_imag.h @@ -0,0 +1,42 @@ +/* + + BLIS + An object-based framework for developing high-performance BLAS-like + libraries. + + Copyright (C) 2013, The University of Texas + + 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 The University of Texas 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 + HOLDER 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. + +*/ + +#include "blis.h" + +#ifdef BLIS_ENABLE_BLAS2BLIS + +double d_imag(doublecomplex *z); + +#endif + diff --git a/frame/compat/f2c/util/bla_r_cnjg.c b/frame/compat/f2c/util/bla_r_cnjg.c index f55f80c3b..2da8afa6d 100644 --- a/frame/compat/f2c/util/bla_r_cnjg.c +++ b/frame/compat/f2c/util/bla_r_cnjg.c @@ -36,12 +36,9 @@ #ifdef BLIS_ENABLE_BLAS2BLIS -#include "bli_f2c.h" - -void r_cnjg(singlecomplex *dest, singlecomplex *src) +void bla_r_cnjg(singlecomplex *dest, singlecomplex *src) { - dest->real = src->real ; - dest->imag = -(src->imag); + bli_ccopyjs( *src, *dest ); } #endif diff --git a/frame/compat/f2c/util/bla_r_cnjg.h b/frame/compat/f2c/util/bla_r_cnjg.h new file mode 100644 index 000000000..be9a17a32 --- /dev/null +++ b/frame/compat/f2c/util/bla_r_cnjg.h @@ -0,0 +1,42 @@ +/* + + BLIS + An object-based framework for developing high-performance BLAS-like + libraries. + + Copyright (C) 2013, The University of Texas + + 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 The University of Texas 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 + HOLDER 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. + +*/ + +#include "blis.h" + +#ifdef BLIS_ENABLE_BLAS2BLIS + +void bla_r_cnjg(singlecomplex *dest, singlecomplex *src); + +#endif + diff --git a/frame/compat/f2c/util/bla_r_imag.c b/frame/compat/f2c/util/bla_r_imag.c index 84dafec70..7406f9f45 100644 --- a/frame/compat/f2c/util/bla_r_imag.c +++ b/frame/compat/f2c/util/bla_r_imag.c @@ -36,11 +36,9 @@ #ifdef BLIS_ENABLE_BLAS2BLIS -#include "bli_f2c.h" - real r_imag(singlecomplex *z) { - return(z->imag); + return bli_cimag( *z ); } #endif diff --git a/frame/compat/f2c/util/bla_r_imag.h b/frame/compat/f2c/util/bla_r_imag.h new file mode 100644 index 000000000..3f6b23efa --- /dev/null +++ b/frame/compat/f2c/util/bla_r_imag.h @@ -0,0 +1,42 @@ +/* + + BLIS + An object-based framework for developing high-performance BLAS-like + libraries. + + Copyright (C) 2013, The University of Texas + + 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 The University of Texas 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 + HOLDER 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. + +*/ + +#include "blis.h" + +#ifdef BLIS_ENABLE_BLAS2BLIS + +real r_imag(singlecomplex *z); + +#endif + diff --git a/frame/compat/f2c/util/bla_z_div.c b/frame/compat/f2c/util/bla_z_div.c index d08d05ed8..2ec389d35 100644 --- a/frame/compat/f2c/util/bla_z_div.c +++ b/frame/compat/f2c/util/bla_z_div.c @@ -36,18 +36,10 @@ #ifdef BLIS_ENABLE_BLAS2BLIS -#include "bli_f2c.h" - -void z_div(doublecomplex *cp, doublecomplex *ap, doublecomplex *bp) +void bla_z_div(doublecomplex *cp, doublecomplex *ap, doublecomplex *bp) { - doublecomplex a = *ap; - doublecomplex b = *bp; - double temp; - - temp = b.real * b.real + b.imag * b.imag; - - cp->real = ( a.real * b.real + a.imag * b.imag ) / temp; - cp->imag = ( a.imag * b.real - a.real * b.imag ) / temp; + bli_zcopys( *ap, *cp ); + bli_zinvscals( *bp, *cp ); } #endif diff --git a/frame/compat/f2c/util/bla_z_div.h b/frame/compat/f2c/util/bla_z_div.h new file mode 100644 index 000000000..01d4bf2d4 --- /dev/null +++ b/frame/compat/f2c/util/bla_z_div.h @@ -0,0 +1,42 @@ +/* + + BLIS + An object-based framework for developing high-performance BLAS-like + libraries. + + Copyright (C) 2013, The University of Texas + + 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 The University of Texas 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 + HOLDER 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. + +*/ + +#include "blis.h" + +#ifdef BLIS_ENABLE_BLAS2BLIS + +void bla_z_div(doublecomplex *cp, doublecomplex *ap, doublecomplex *bp); + +#endif + diff --git a/test/test_blis2.c b/test/test_blis2.c index b79daf31c..dc775ff03 100644 --- a/test/test_blis2.c +++ b/test/test_blis2.c @@ -39,13 +39,13 @@ double FLA_Clock( void ); extern gemm_t* gemm_cntl; // trans m n alpha a lda x incx beta y incy -void dgemv_( char*, int*, int*, double*, double*, int*, double*, int*, double*, double*, int* ); -void dger_( int*, int*, double*, double*, int*, double*, int*, double*, int* ); -void dsymv_( char*, int*, double*, double*, int*, double*, int*, double*, double*, int* ); -void dsyr_( char*, int*, double*, double*, int*, double*, int* ); -void dsyr2_( char*, int*, double*, double*, int*, double*, int*, double*, int* ); -void dtrmv_( char*, char*, char*, int*, double*, int*, double*, int* ); -void dtrsv_( char*, char*, char*, int*, double*, int*, double*, int* ); +//void dgemv_( char*, int*, int*, double*, double*, int*, double*, int*, double*, double*, int* ); +//void dger_( int*, int*, double*, double*, int*, double*, int*, double*, int* ); +//void dsymv_( char*, int*, double*, double*, int*, double*, int*, double*, double*, int* ); +//void dsyr_( char*, int*, double*, double*, int*, double*, int* ); +//void dsyr2_( char*, int*, double*, double*, int*, double*, int*, double*, int* ); +//void dtrmv_( char*, char*, char*, int*, double*, int*, double*, int* ); +//void dtrsv_( char*, char*, char*, int*, double*, int*, double*, int* ); // trans trans m n k alpha a lda b ldb beta c ldc void dgemm_( char*, char*, int*, int*, int*, double*, double*, int*, double*, int*, double*, double*, int* ); diff --git a/test/test_gemm.c b/test/test_gemm.c index 7f7a4e4ba..281f36f9f 100644 --- a/test/test_gemm.c +++ b/test/test_gemm.c @@ -36,7 +36,7 @@ #include "blis.h" // transa transb m n k alpha a lda b ldb beta c ldc -void dgemm_( char*, char*, int*, int*, int*, double*, double*, int*, double*, int*, double*, double*, int* ); +//void dgemm_( char*, char*, int*, int*, int*, double*, double*, int*, double*, int*, double*, double*, int* ); //#define PRINT @@ -83,12 +83,12 @@ int main( int argc, char** argv ) n_repeats = 3; #ifndef PRINT - p_begin = 40; + p_begin = 100; p_end = 2000; - p_inc = 40; + p_inc = 100; m_input = -1; - n_input = -1; + n_input = 384; k_input = -1; //k_input = 200; #else @@ -96,9 +96,9 @@ int main( int argc, char** argv ) p_end = 16; p_inc = 1; - m_input = 10; - k_input = 10; - n_input = 10; + m_input = 8; + k_input = 16; + n_input = 16; #endif dt_a = BLIS_DOUBLE; @@ -249,19 +249,19 @@ int main( int argc, char** argv ) #else - char transa = 'N'; - char transb = 'N'; - int mm = bli_obj_length( c ); - int kk = bli_obj_width_after_trans( a ); - int nn = bli_obj_width( c ); - int lda = bli_obj_col_stride( a ); - int ldb = bli_obj_col_stride( b ); - int ldc = bli_obj_col_stride( c ); - double* alphap = bli_obj_buffer( alpha ); - double* ap = bli_obj_buffer( a ); - double* bp = bli_obj_buffer( b ); - double* betap = bli_obj_buffer( beta ); - double* cp = bli_obj_buffer( c ); + f77_char transa = 'N'; + f77_char transb = 'N'; + f77_int mm = bli_obj_length( c ); + f77_int kk = bli_obj_width_after_trans( a ); + f77_int nn = bli_obj_width( c ); + f77_int lda = bli_obj_col_stride( a ); + f77_int ldb = bli_obj_col_stride( b ); + f77_int ldc = bli_obj_col_stride( c ); + double* alphap = bli_obj_buffer( alpha ); + double* ap = bli_obj_buffer( a ); + double* bp = bli_obj_buffer( b ); + double* betap = bli_obj_buffer( beta ); + double* cp = bli_obj_buffer( c ); dgemm_( &transa, &transb, diff --git a/test/test_gemv.c b/test/test_gemv.c index f5fd8968f..2b79dee6d 100644 --- a/test/test_gemv.c +++ b/test/test_gemv.c @@ -36,7 +36,7 @@ #include "blis.h" // transa m n alpha a lda x incx beta y incy -void dgemv_( char*, int*, int*, double*, double*, int*, double*, int*, double*, double*, int* ); +//void dgemv_( char*, int*, int*, double*, double*, int*, double*, int*, double*, double*, int* ); //#define PRINT @@ -158,17 +158,17 @@ int main( int argc, char** argv ) #else - char transa = 'N'; - int mm = bli_obj_length( a_tl ); - int nn = bli_obj_width( a_tl ); - int lda = bli_obj_col_stride( a_tl ); - int incx = bli_obj_vector_inc( x_t ); - int incy = bli_obj_vector_inc( y_t ); - double* alphap = bli_obj_buffer( alpha ); - double* ap = bli_obj_buffer( a_tl ); - double* xp = bli_obj_buffer( x_t ); - double* betap = bli_obj_buffer( beta ); - double* yp = bli_obj_buffer( y_t ); + f77_char transa = 'N'; + f77_int mm = bli_obj_length( a_tl ); + f77_int nn = bli_obj_width( a_tl ); + f77_int lda = bli_obj_col_stride( a_tl ); + f77_int incx = bli_obj_vector_inc( x_t ); + f77_int incy = bli_obj_vector_inc( y_t ); + double* alphap = bli_obj_buffer( alpha ); + double* ap = bli_obj_buffer( a_tl ); + double* xp = bli_obj_buffer( x_t ); + double* betap = bli_obj_buffer( beta ); + double* yp = bli_obj_buffer( y_t ); dgemv_( &transa, &mm, diff --git a/test/test_ger.c b/test/test_ger.c index 6f8498240..3fb590580 100644 --- a/test/test_ger.c +++ b/test/test_ger.c @@ -36,7 +36,7 @@ #include "blis.h" // m n alpha x incx y incy a lda -void dger_( int*, int*, double*, double*, int*, double*, int*, double*, int* ); +//void dger_( int*, int*, double*, double*, int*, double*, int*, double*, int* ); //#define PRINT @@ -132,15 +132,15 @@ int main( int argc, char** argv ) #else - int mm = bli_obj_length( a ); - int nn = bli_obj_width( a ); - int incx = bli_obj_vector_inc( x ); - int incy = bli_obj_vector_inc( y ); - int lda = bli_obj_col_stride( a ); - double* alphap = bli_obj_buffer( alpha ); - double* xp = bli_obj_buffer( x ); - double* yp = bli_obj_buffer( y ); - double* ap = bli_obj_buffer( a ); + f77_int mm = bli_obj_length( a ); + f77_int nn = bli_obj_width( a ); + f77_int incx = bli_obj_vector_inc( x ); + f77_int incy = bli_obj_vector_inc( y ); + f77_int lda = bli_obj_col_stride( a ); + double* alphap = bli_obj_buffer( alpha ); + double* xp = bli_obj_buffer( x ); + double* yp = bli_obj_buffer( y ); + double* ap = bli_obj_buffer( a ); dger_( &mm, &nn, diff --git a/test/test_hemm.c b/test/test_hemm.c index 33f11ea94..f66c39531 100644 --- a/test/test_hemm.c +++ b/test/test_hemm.c @@ -36,7 +36,7 @@ #include "blis.h" // side uploa m n alpha a lda b ldb beta c ldc -void dsymm_( char*, char*, int*, int*, double*, double*, int*, double*, int*, double*, double*, int* ); +//void dsymm_( char*, char*, int*, int*, double*, double*, int*, double*, int*, double*, double*, int* ); //#define PRINT @@ -257,18 +257,18 @@ int main( int argc, char** argv ) #else - char side = 'R'; - char uplo = 'U'; - int mm = bli_obj_length( c ); - int nn = bli_obj_width( c ); - int lda = bli_obj_col_stride( a ); - int ldb = bli_obj_col_stride( b ); - int ldc = bli_obj_col_stride( c ); - double* alphap = bli_obj_buffer( alpha ); - double* ap = bli_obj_buffer( a ); - double* bp = bli_obj_buffer( b ); - double* betap = bli_obj_buffer( beta ); - double* cp = bli_obj_buffer( c ); + f77_char side = 'R'; + f77_char uplo = 'U'; + f77_int mm = bli_obj_length( c ); + f77_int nn = bli_obj_width( c ); + f77_int lda = bli_obj_col_stride( a ); + f77_int ldb = bli_obj_col_stride( b ); + f77_int ldc = bli_obj_col_stride( c ); + double* alphap = bli_obj_buffer( alpha ); + double* ap = bli_obj_buffer( a ); + double* bp = bli_obj_buffer( b ); + double* betap = bli_obj_buffer( beta ); + double* cp = bli_obj_buffer( c ); dsymm_( &side, &uplo, diff --git a/test/test_hemv.c b/test/test_hemv.c index c6f31e2d9..902354998 100644 --- a/test/test_hemv.c +++ b/test/test_hemv.c @@ -36,7 +36,7 @@ #include "blis.h" // uploa m alpha a lda x incx beta y incy -void dsymv_( char*, int*, double*, double*, int*, double*, int*, double*, double*, int* ); +//void dsymv_( char*, int*, double*, double*, int*, double*, int*, double*, double*, int* ); //#define PRINT @@ -148,16 +148,16 @@ int main( int argc, char** argv ) #else - char uploa = 'L'; - int mm = bli_obj_length( a ); - int lda = bli_obj_col_stride( a ); - int incx = bli_obj_vector_inc( x ); - int incy = bli_obj_vector_inc( y ); - double* alphap = bli_obj_buffer( alpha ); - double* ap = bli_obj_buffer( a ); - double* xp = bli_obj_buffer( x ); - double* betap = bli_obj_buffer( beta ); - double* yp = bli_obj_buffer( y ); + f77_char uploa = 'L'; + f77_int mm = bli_obj_length( a ); + f77_int lda = bli_obj_col_stride( a ); + f77_int incx = bli_obj_vector_inc( x ); + f77_int incy = bli_obj_vector_inc( y ); + double* alphap = bli_obj_buffer( alpha ); + double* ap = bli_obj_buffer( a ); + double* xp = bli_obj_buffer( x ); + double* betap = bli_obj_buffer( beta ); + double* yp = bli_obj_buffer( y ); dsymv_( &uploa, &mm, diff --git a/test/test_her.c b/test/test_her.c index 6ccf6451f..ef3a2a8e1 100644 --- a/test/test_her.c +++ b/test/test_her.c @@ -36,8 +36,8 @@ #include "blis.h" // uplo m alpha x incx a lda -void dsyr_( char*, int*, double*, double*, int*, double*, int* ); -void zher_( char*, int*, double*, dcomplex*, int*, dcomplex*, int* ); +//void dsyr_( char*, int*, double*, double*, int*, double*, int* ); +//void zher_( char*, int*, double*, dcomplex*, int*, dcomplex*, int* ); //#define PRINT @@ -137,13 +137,13 @@ int main( int argc, char** argv ) #else - char uplo = 'L'; - int mm = bli_obj_length( a ); - int incx = bli_obj_vector_inc( x ); - int lda = bli_obj_col_stride( a ); - double* alphap = bli_obj_buffer( alpha ); - double* xp = bli_obj_buffer( x ); - double* ap = bli_obj_buffer( a ); + f77_char uplo = 'L'; + f77_int mm = bli_obj_length( a ); + f77_int incx = bli_obj_vector_inc( x ); + f77_int lda = bli_obj_col_stride( a ); + double* alphap = bli_obj_buffer( alpha ); + double* xp = bli_obj_buffer( x ); + double* ap = bli_obj_buffer( a ); /* dcomplex* xp = bli_obj_buffer( x ); dcomplex* ap = bli_obj_buffer( a ); diff --git a/test/test_her2.c b/test/test_her2.c index 6bd335ee1..f114dfd85 100644 --- a/test/test_her2.c +++ b/test/test_her2.c @@ -36,7 +36,7 @@ #include "blis.h" // uplo m alpha x incx y incy a lda -void dsyr2_( char*, int*, double*, double*, int*, double*, int*, double*, int* ); +//void dsyr2_( char*, int*, double*, double*, int*, double*, int*, double*, int* ); //#define PRINT @@ -145,15 +145,15 @@ int main( int argc, char** argv ) #else - char uplo = 'L'; - int mm = bli_obj_length( a ); - int incx = bli_obj_vector_inc( x ); - int incy = bli_obj_vector_inc( y ); - int lda = bli_obj_col_stride( a ); - double* alphap = bli_obj_buffer( alpha ); - double* xp = bli_obj_buffer( x ); - double* yp = bli_obj_buffer( y ); - double* ap = bli_obj_buffer( a ); + f77_char uplo = 'L'; + f77_int mm = bli_obj_length( a ); + f77_int incx = bli_obj_vector_inc( x ); + f77_int incy = bli_obj_vector_inc( y ); + f77_int lda = bli_obj_col_stride( a ); + double* alphap = bli_obj_buffer( alpha ); + double* xp = bli_obj_buffer( x ); + double* yp = bli_obj_buffer( y ); + double* ap = bli_obj_buffer( a ); dsyr2_( &uplo, &mm, diff --git a/test/test_her2k.c b/test/test_her2k.c index 44e2ab305..132692e01 100644 --- a/test/test_her2k.c +++ b/test/test_her2k.c @@ -36,7 +36,7 @@ #include "blis.h" // uploa transa m k alpha a lda b ldb beta c ldc -void dsyr2k_( char*, char*, int*, int*, double*, double*, int*, double*, int*, double*, double*, int* ); +//void dsyr2k_( char*, char*, int*, int*, double*, double*, int*, double*, int*, double*, double*, int* ); //#define PRINT @@ -246,19 +246,18 @@ int main( int argc, char** argv ) #else - char uploa = 'L'; - //char uploa = 'U'; - char transa = 'N'; - int mm = bli_obj_length( c ); - int kk = bli_obj_width_after_trans( a ); - int lda = bli_obj_col_stride( a ); - int ldb = bli_obj_col_stride( b ); - int ldc = bli_obj_col_stride( c ); - double* alphap = bli_obj_buffer( alpha ); - double* ap = bli_obj_buffer( a ); - double* bp = bli_obj_buffer( b ); - double* betap = bli_obj_buffer( beta ); - double* cp = bli_obj_buffer( c ); + f77_char uploa = 'L'; + f77_char transa = 'N'; + f77_int mm = bli_obj_length( c ); + f77_int kk = bli_obj_width_after_trans( a ); + f77_int lda = bli_obj_col_stride( a ); + f77_int ldb = bli_obj_col_stride( b ); + f77_int ldc = bli_obj_col_stride( c ); + double* alphap = bli_obj_buffer( alpha ); + double* ap = bli_obj_buffer( a ); + double* bp = bli_obj_buffer( b ); + double* betap = bli_obj_buffer( beta ); + double* cp = bli_obj_buffer( c ); dsyr2k_( &uploa, &transa, diff --git a/test/test_herk.c b/test/test_herk.c index eb9e1a397..c42b48558 100644 --- a/test/test_herk.c +++ b/test/test_herk.c @@ -36,7 +36,7 @@ #include "blis.h" // uploa transa m k alpha a lda beta c ldc -void dsyrk_( char*, char*, int*, int*, double*, double*, int*, double*, double*, int* ); +//void dsyrk_( char*, char*, int*, int*, double*, double*, int*, double*, double*, int* ); //#define PRINT @@ -241,16 +241,16 @@ int main( int argc, char** argv ) #else - char uploa = 'L'; - char transa = 'N'; - int mm = bli_obj_length( c ); - int kk = bli_obj_width_after_trans( a ); - int lda = bli_obj_col_stride( a ); - int ldc = bli_obj_col_stride( c ); - double* alphap = bli_obj_buffer( alpha ); - double* ap = bli_obj_buffer( a ); - double* betap = bli_obj_buffer( beta ); - double* cp = bli_obj_buffer( c ); + f77_char uploa = 'L'; + f77_char transa = 'N'; + f77_int mm = bli_obj_length( c ); + f77_int kk = bli_obj_width_after_trans( a ); + f77_int lda = bli_obj_col_stride( a ); + f77_int ldc = bli_obj_col_stride( c ); + double* alphap = bli_obj_buffer( alpha ); + double* ap = bli_obj_buffer( a ); + double* betap = bli_obj_buffer( beta ); + double* cp = bli_obj_buffer( c ); dsyrk_( &uploa, &transa, diff --git a/test/test_trmm.c b/test/test_trmm.c index 585aaccd2..a789cf39a 100644 --- a/test/test_trmm.c +++ b/test/test_trmm.c @@ -36,7 +36,7 @@ #include "blis.h" // side uplo trans diag m n alpha a lda b ldb -void dtrmm_( char*, char*, char*, char*, int*, int*, double*, double*, int*, double*, int* ); +//void dtrmm_( char*, char*, char*, char*, int*, int*, double*, double*, int*, double*, int* ); //#define PRINT @@ -94,8 +94,8 @@ int main( int argc, char** argv ) p_end = 16; p_inc = 1; - m_input = 16; - n_input = 16; + m_input = 8; + n_input = 4; #endif dt_a = BLIS_DOUBLE; @@ -128,8 +128,8 @@ int main( int argc, char** argv ) bli_obj_create( dt_c, m, n, 0, 0, &c_save ); bli_obj_set_struc( BLIS_TRIANGULAR, a ); - bli_obj_set_uplo( BLIS_UPPER, a ); - //bli_obj_set_uplo( BLIS_LOWER, a ); + //bli_obj_set_uplo( BLIS_UPPER, a ); + bli_obj_set_uplo( BLIS_LOWER, a ); bli_randm( &a ); bli_randm( &c ); @@ -254,8 +254,8 @@ int main( int argc, char** argv ) #ifdef PRINT - bli_printm( "a", &a, "%4.1f", "" ); - bli_printm( "c", &c, "%4.1f", "" ); + bli_printm( "a", &a, "%11.8f", "" ); + bli_printm( "c", &c, "%14.11f", "" ); #endif #ifdef BLIS @@ -269,17 +269,17 @@ int main( int argc, char** argv ) #else - char side = 'L'; - char uplo = 'U'; - char transa = 'N'; - char diag = 'N'; - int mm = bli_obj_length( c ); - int nn = bli_obj_width( c ); - int lda = bli_obj_col_stride( a ); - int ldc = bli_obj_col_stride( c ); - double* alphap = bli_obj_buffer( alpha ); - double* ap = bli_obj_buffer( a ); - double* cp = bli_obj_buffer( c ); + f77_char side = 'L'; + f77_char uplo = 'L'; + f77_char transa = 'N'; + f77_char diag = 'N'; + f77_int mm = bli_obj_length( c ); + f77_int nn = bli_obj_width( c ); + f77_int lda = bli_obj_col_stride( a ); + f77_int ldc = bli_obj_col_stride( c ); + double* alphap = bli_obj_buffer( alpha ); + double* ap = bli_obj_buffer( a ); + double* cp = bli_obj_buffer( c ); dtrmm_( &side, &uplo, @@ -293,7 +293,7 @@ int main( int argc, char** argv ) #endif #ifdef PRINT - bli_printm( "c after", &c, "%4.1f", "" ); + bli_printm( "c after", &c, "%14.11f", "" ); exit(1); #endif diff --git a/test/test_trmv.c b/test/test_trmv.c index c7e288997..c41707c72 100644 --- a/test/test_trmv.c +++ b/test/test_trmv.c @@ -36,7 +36,7 @@ #include "blis.h" // uploa trans, diag, m a lda x incx -void dtrmv_( char*, char*, char*, int*, double*, int*, double*, int* ); +//void dtrmv_( char*, char*, char*, int*, double*, int*, double*, int* ); //#define PRINT @@ -128,14 +128,14 @@ int main( int argc, char** argv ) #else - char uploa = 'L'; - char transa = 'N'; - char diaga = 'N'; - int mm = bli_obj_length( a ); - int lda = bli_obj_col_stride( a ); - int incx = bli_obj_vector_inc( x ); - double* ap = bli_obj_buffer( a ); - double* xp = bli_obj_buffer( x ); + f77_char uploa = 'L'; + f77_char transa = 'N'; + f77_char diaga = 'N'; + f77_int mm = bli_obj_length( a ); + f77_int lda = bli_obj_col_stride( a ); + f77_int incx = bli_obj_vector_inc( x ); + double* ap = bli_obj_buffer( a ); + double* xp = bli_obj_buffer( x ); dtrmv_( &uploa, &transa, diff --git a/test/test_trsm.c b/test/test_trsm.c index 8ead5bdbb..b2209df3c 100644 --- a/test/test_trsm.c +++ b/test/test_trsm.c @@ -36,7 +36,7 @@ #include "blis.h" // side uplo trans diag m n alpha a lda b ldb -void dtrsm_( char*, char*, char*, char*, int*, int*, double*, double*, int*, double*, int* ); +//void dtrsm_( char*, char*, char*, char*, int*, int*, double*, double*, int*, double*, int* ); //#define PRINT @@ -95,8 +95,8 @@ int main( int argc, char** argv ) p_end = 16; p_inc = 1; - m_input = 16; - n_input = 16; + m_input = 7 ; + n_input = 7 ; #endif dt_a = BLIS_DOUBLE; @@ -265,17 +265,17 @@ int main( int argc, char** argv ) #else - char side = 'R'; - char uplo = 'L'; - char transa = 'N'; - char diag = 'N'; - int mm = bli_obj_length( c ); - int nn = bli_obj_width( c ); - int lda = bli_obj_col_stride( a ); - int ldc = bli_obj_col_stride( c ); - double* alphap = bli_obj_buffer( alpha ); - double* ap = bli_obj_buffer( a ); - double* cp = bli_obj_buffer( c ); + f77_char side = 'R'; + f77_char uplo = 'L'; + f77_char transa = 'N'; + f77_char diag = 'N'; + f77_int mm = bli_obj_length( c ); + f77_int nn = bli_obj_width( c ); + f77_int lda = bli_obj_col_stride( a ); + f77_int ldc = bli_obj_col_stride( c ); + double* alphap = bli_obj_buffer( alpha ); + double* ap = bli_obj_buffer( a ); + double* cp = bli_obj_buffer( c ); dtrsm_( &side, &uplo, diff --git a/test/test_trsv.c b/test/test_trsv.c index 5bbbe0b76..1700364f8 100644 --- a/test/test_trsv.c +++ b/test/test_trsv.c @@ -36,7 +36,7 @@ #include "blis.h" // uploa trans, diag, m a lda x incx -void dtrsv_( char*, char*, char*, int*, double*, int*, double*, int* ); +//void dtrsv_( char*, char*, char*, int*, double*, int*, double*, int* ); //#define PRINT @@ -128,14 +128,14 @@ int main( int argc, char** argv ) #else - char uploa = 'L'; - char transa = 'N'; - char diaga = 'N'; - int mm = bli_obj_length( a ); - int lda = bli_obj_col_stride( a ); - int incx = bli_obj_vector_inc( x ); - double* ap = bli_obj_buffer( a ); - double* xp = bli_obj_buffer( x ); + f77_char uploa = 'L'; + f77_char transa = 'N'; + f77_char diaga = 'N'; + f77_int mm = bli_obj_length( a ); + f77_int lda = bli_obj_col_stride( a ); + f77_int incx = bli_obj_vector_inc( x ); + double* ap = bli_obj_buffer( a ); + double* xp = bli_obj_buffer( x ); dtrsv_( &uploa, &transa,