From a62cfc3ccf2d096b28e041f2d8bbbe25f68ad00f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=E7=8E=8B=E6=BB=8B=E6=B6=B5=20Zephyr=20Wang?= Date: Sat, 29 May 2021 18:10:00 +0800 Subject: [PATCH 001/311] Fix typo in common.h --- common.h | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/common.h b/common.h index ac795937c..d27fc4cb7 100644 --- a/common.h +++ b/common.h @@ -392,7 +392,7 @@ typedef int blasint; #endif /*** -To alloc job_t on heap or statck. +To alloc job_t on heap or stack. please https://github.com/xianyi/OpenBLAS/issues/246 ***/ #if defined(OS_WINDOWS) From 448fe1c42a928f2a090f7ec1a5be9b6e81ccbf0f Mon Sep 17 00:00:00 2001 From: Xianyi Zhang Date: Wed, 24 Aug 2022 19:24:01 +0800 Subject: [PATCH 002/311] Test on PolarFire Soc. `make NOFORTRAN=1 CC=gcc` --- TargetList.txt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/TargetList.txt b/TargetList.txt index deef75819..99d603d03 100644 --- a/TargetList.txt +++ b/TargetList.txt @@ -118,7 +118,7 @@ Z13 Z14 10.RISC-V 64: -RISCV64_GENERIC +RISCV64_GENERIC (e.g. PolarFire Soc/SiFive U54) C910V 11.LOONGARCH64: From bef47917bd72f35c151038fee0cf485445476863 Mon Sep 17 00:00:00 2001 From: Heller Zheng Date: Tue, 15 Nov 2022 00:06:25 -0800 Subject: [PATCH 003/311] Initial version for riscv sifive x280 --- Makefile.install | 7 + Makefile.prebuild | 8 + Makefile.riscv64 | 8 + README.md | 5 + TargetList.txt | 1 + benchmark/Makefile | 6 + common_riscv64.h | 4 + cpuid_riscv64.c | 2 + getarch.c | 12 + kernel/riscv64/KERNEL.x280 | 267 ++++++++ kernel/riscv64/amax_rvv.c | 102 +++ kernel/riscv64/amin_rvv.c | 102 +++ kernel/riscv64/asum_rvv.c | 99 +++ kernel/riscv64/axpby_rvv.c | 171 +++++ kernel/riscv64/axpy_rvv.c | 109 +++ kernel/riscv64/copy_rvv.c | 94 +++ kernel/riscv64/dot_rvv.c | 126 ++++ kernel/riscv64/gemm_beta_rvv.c | 89 +++ kernel/riscv64/gemm_ncopy_2_rvv.c | 92 +++ kernel/riscv64/gemm_ncopy_4_rvv.c | 123 ++++ kernel/riscv64/gemm_ncopy_8_rvv.c | 164 +++++ kernel/riscv64/gemm_ncopy_rvv_v1.c | 76 +++ kernel/riscv64/gemm_tcopy_2_rvv.c | 108 +++ kernel/riscv64/gemm_tcopy_4_rvv.c | 236 +++++++ kernel/riscv64/gemm_tcopy_8_rvv.c | 264 ++++++++ kernel/riscv64/gemm_tcopy_rvv_v1.c | 74 +++ kernel/riscv64/gemmkernel_2x2_rvv.c | 214 ++++++ kernel/riscv64/gemmkernel_4x4_rvv.c | 508 ++++++++++++++ kernel/riscv64/gemmkernel_rvv_v1x8.c | 601 +++++++++++++++++ kernel/riscv64/gemv_n_rvv.c | 94 +++ kernel/riscv64/gemv_t_rvv.c | 119 ++++ kernel/riscv64/iamax_rvv.c | 150 +++++ kernel/riscv64/iamin_rvv.c | 151 +++++ kernel/riscv64/imax_rvv.c | 147 +++++ kernel/riscv64/imin_rvv.c | 147 +++++ kernel/riscv64/izamax_rvv.c | 162 +++++ kernel/riscv64/izamin_rvv.c | 161 +++++ kernel/riscv64/max_rvv.c | 98 +++ kernel/riscv64/min_rvv.c | 98 +++ kernel/riscv64/nrm2_rvv.c | 117 ++++ kernel/riscv64/rot_rvv.c | 149 +++++ kernel/riscv64/scal_rvv.c | 80 +++ kernel/riscv64/sum_rvv.c | 95 +++ kernel/riscv64/swap_rvv.c | 142 ++++ kernel/riscv64/symm_lcopy_rvv_v1.c | 101 +++ kernel/riscv64/symm_ucopy_rvv_v1.c | 100 +++ kernel/riscv64/symv_L_rvv.c | 224 +++++++ kernel/riscv64/symv_U_rvv.c | 221 +++++++ kernel/riscv64/trmm_lncopy_rvv_v1.c | 138 ++++ kernel/riscv64/trmm_ltcopy_rvv_v1.c | 134 ++++ kernel/riscv64/trmm_uncopy_rvv_v1.c | 136 ++++ kernel/riscv64/trmm_utcopy_rvv_v1.c | 133 ++++ kernel/riscv64/trmmkernel_2x2_rvv.c | 342 ++++++++++ kernel/riscv64/trmmkernel_4x4_rvv.c | 881 +++++++++++++++++++++++++ kernel/riscv64/trmmkernel_rvv_v1x8.c | 685 +++++++++++++++++++ kernel/riscv64/trsm_kernel_LN_rvv_v1.c | 847 ++++++++++++++++++++++++ kernel/riscv64/trsm_kernel_LT_rvv_v1.c | 840 +++++++++++++++++++++++ kernel/riscv64/trsm_kernel_RN_rvv_v1.c | 792 ++++++++++++++++++++++ kernel/riscv64/trsm_kernel_RT_rvv_v1.c | 828 +++++++++++++++++++++++ kernel/riscv64/trsm_lncopy_rvv_v1.c | 122 ++++ kernel/riscv64/trsm_ltcopy_rvv_v1.c | 122 ++++ kernel/riscv64/trsm_uncopy_rvv_v1.c | 121 ++++ kernel/riscv64/trsm_utcopy_rvv_v1.c | 123 ++++ kernel/riscv64/zamax_rvv.c | 113 ++++ kernel/riscv64/zamin_rvv.c | 112 ++++ kernel/riscv64/zasum_rvv.c | 108 +++ kernel/riscv64/zaxpby_rvv.c | 151 +++++ kernel/riscv64/zaxpy_rvv.c | 154 +++++ kernel/riscv64/zcopy_rvv.c | 105 +++ kernel/riscv64/zdot_rvv.c | 170 +++++ kernel/riscv64/zgemm_beta_rvv.c | 117 ++++ kernel/riscv64/zgemv_n_rvv.c | 170 +++++ kernel/riscv64/zgemv_t_rvv.c | 172 +++++ kernel/riscv64/znrm2_rvv.c | 122 ++++ kernel/riscv64/zrot_rvv.c | 181 +++++ kernel/riscv64/zscal_rvv.c | 148 +++++ kernel/riscv64/zsum_rvv.c | 97 +++ kernel/riscv64/zswap_rvv.c | 156 +++++ kernel/riscv64/ztrmmkernel_2x2_rvv.c | 596 +++++++++++++++++ param.h | 44 ++ 80 files changed, 15188 insertions(+) create mode 100644 kernel/riscv64/KERNEL.x280 create mode 100644 kernel/riscv64/amax_rvv.c create mode 100644 kernel/riscv64/amin_rvv.c create mode 100644 kernel/riscv64/asum_rvv.c create mode 100644 kernel/riscv64/axpby_rvv.c create mode 100644 kernel/riscv64/axpy_rvv.c create mode 100644 kernel/riscv64/copy_rvv.c create mode 100644 kernel/riscv64/dot_rvv.c create mode 100644 kernel/riscv64/gemm_beta_rvv.c create mode 100644 kernel/riscv64/gemm_ncopy_2_rvv.c create mode 100644 kernel/riscv64/gemm_ncopy_4_rvv.c create mode 100644 kernel/riscv64/gemm_ncopy_8_rvv.c create mode 100644 kernel/riscv64/gemm_ncopy_rvv_v1.c create mode 100644 kernel/riscv64/gemm_tcopy_2_rvv.c create mode 100644 kernel/riscv64/gemm_tcopy_4_rvv.c create mode 100644 kernel/riscv64/gemm_tcopy_8_rvv.c create mode 100644 kernel/riscv64/gemm_tcopy_rvv_v1.c create mode 100644 kernel/riscv64/gemmkernel_2x2_rvv.c create mode 100644 kernel/riscv64/gemmkernel_4x4_rvv.c create mode 100644 kernel/riscv64/gemmkernel_rvv_v1x8.c create mode 100644 kernel/riscv64/gemv_n_rvv.c create mode 100644 kernel/riscv64/gemv_t_rvv.c create mode 100644 kernel/riscv64/iamax_rvv.c create mode 100644 kernel/riscv64/iamin_rvv.c create mode 100644 kernel/riscv64/imax_rvv.c create mode 100644 kernel/riscv64/imin_rvv.c create mode 100644 kernel/riscv64/izamax_rvv.c create mode 100644 kernel/riscv64/izamin_rvv.c create mode 100644 kernel/riscv64/max_rvv.c create mode 100644 kernel/riscv64/min_rvv.c create mode 100644 kernel/riscv64/nrm2_rvv.c create mode 100644 kernel/riscv64/rot_rvv.c create mode 100644 kernel/riscv64/scal_rvv.c create mode 100644 kernel/riscv64/sum_rvv.c create mode 100644 kernel/riscv64/swap_rvv.c create mode 100644 kernel/riscv64/symm_lcopy_rvv_v1.c create mode 100644 kernel/riscv64/symm_ucopy_rvv_v1.c create mode 100644 kernel/riscv64/symv_L_rvv.c create mode 100644 kernel/riscv64/symv_U_rvv.c create mode 100644 kernel/riscv64/trmm_lncopy_rvv_v1.c create mode 100644 kernel/riscv64/trmm_ltcopy_rvv_v1.c create mode 100644 kernel/riscv64/trmm_uncopy_rvv_v1.c create mode 100644 kernel/riscv64/trmm_utcopy_rvv_v1.c create mode 100644 kernel/riscv64/trmmkernel_2x2_rvv.c create mode 100644 kernel/riscv64/trmmkernel_4x4_rvv.c create mode 100644 kernel/riscv64/trmmkernel_rvv_v1x8.c create mode 100644 kernel/riscv64/trsm_kernel_LN_rvv_v1.c create mode 100644 kernel/riscv64/trsm_kernel_LT_rvv_v1.c create mode 100644 kernel/riscv64/trsm_kernel_RN_rvv_v1.c create mode 100644 kernel/riscv64/trsm_kernel_RT_rvv_v1.c create mode 100644 kernel/riscv64/trsm_lncopy_rvv_v1.c create mode 100644 kernel/riscv64/trsm_ltcopy_rvv_v1.c create mode 100644 kernel/riscv64/trsm_uncopy_rvv_v1.c create mode 100644 kernel/riscv64/trsm_utcopy_rvv_v1.c create mode 100644 kernel/riscv64/zamax_rvv.c create mode 100644 kernel/riscv64/zamin_rvv.c create mode 100644 kernel/riscv64/zasum_rvv.c create mode 100644 kernel/riscv64/zaxpby_rvv.c create mode 100644 kernel/riscv64/zaxpy_rvv.c create mode 100644 kernel/riscv64/zcopy_rvv.c create mode 100644 kernel/riscv64/zdot_rvv.c create mode 100644 kernel/riscv64/zgemm_beta_rvv.c create mode 100644 kernel/riscv64/zgemv_n_rvv.c create mode 100644 kernel/riscv64/zgemv_t_rvv.c create mode 100644 kernel/riscv64/znrm2_rvv.c create mode 100644 kernel/riscv64/zrot_rvv.c create mode 100644 kernel/riscv64/zscal_rvv.c create mode 100644 kernel/riscv64/zsum_rvv.c create mode 100644 kernel/riscv64/zswap_rvv.c create mode 100644 kernel/riscv64/ztrmmkernel_2x2_rvv.c diff --git a/Makefile.install b/Makefile.install index 87b5bc870..f1adaa271 100644 --- a/Makefile.install +++ b/Makefile.install @@ -8,6 +8,7 @@ PREFIX ?= /opt/OpenBLAS OPENBLAS_INCLUDE_DIR := $(PREFIX)/include OPENBLAS_LIBRARY_DIR := $(PREFIX)/lib OPENBLAS_BINARY_DIR := $(PREFIX)/bin +OPENBLAS_RELEASE_DIR := $(PREFIX)/release OPENBLAS_BUILD_DIR := $(CURDIR) OPENBLAS_CMAKE_DIR := $(OPENBLAS_LIBRARY_DIR)/cmake/$(LIBSONAMEBASE) OPENBLAS_CMAKE_CONFIG := OpenBLASConfig.cmake @@ -38,6 +39,7 @@ install : lib.grd @-mkdir -p "$(DESTDIR)$(OPENBLAS_INCLUDE_DIR)" @-mkdir -p "$(DESTDIR)$(OPENBLAS_LIBRARY_DIR)" @-mkdir -p "$(DESTDIR)$(OPENBLAS_BINARY_DIR)" + @-mkdir -p "$(DESTDIR)$(OPENBLAS_RELEASE_DIR)" @-mkdir -p "$(DESTDIR)$(OPENBLAS_CMAKE_DIR)" @-mkdir -p "$(DESTDIR)$(OPENBLAS_PKGCONFIG_DIR)" @echo Generating openblas_config.h in $(DESTDIR)$(OPENBLAS_INCLUDE_DIR) @@ -202,3 +204,8 @@ endif @echo " endif ()" >> "$(DESTDIR)$(OPENBLAS_CMAKE_DIR)/$(OPENBLAS_CMAKE_CONFIG_VERSION)" @echo "endif ()" >> "$(DESTDIR)$(OPENBLAS_CMAKE_DIR)/$(OPENBLAS_CMAKE_CONFIG_VERSION)" @echo Install OK! +#Generating release tar + @echo Generating $(OPENBLAS_RELEASE_DIR)/$(basename $(LIBNAME)).tar.gz + @tar -cvz --file=$(OPENBLAS_RELEASE_DIR)/$(basename $(LIBNAME)).tar.gz --directory=$(PREFIX) --exclude=release . + + diff --git a/Makefile.prebuild b/Makefile.prebuild index 0be4f1274..e6a8eab59 100644 --- a/Makefile.prebuild +++ b/Makefile.prebuild @@ -55,6 +55,14 @@ ifeq ($(TARGET), C910V) TARGET_FLAGS = -march=rv64gcv0p7_zfh_xtheadc -mabi=lp64d endif +ifeq ($(TARGET), x280) +TARGET_FLAGS = -march=rv64imafdcv_zba_zbb_zfh_xsfvqmaccqoq_xsfvfhbfmin -mabi=lp64d -mcpu=sifive-x280 +endif + +ifeq ($(TARGET), RISCV64_GENERIC) +TARGET_FLAGS = -march=rv64imafdc -mabi=lp64d +endif + all: getarch_2nd ./getarch_2nd 0 >> $(TARGET_MAKE) ./getarch_2nd 1 >> $(TARGET_CONF) diff --git a/Makefile.riscv64 b/Makefile.riscv64 index ce91e03ec..d6eaf552d 100644 --- a/Makefile.riscv64 +++ b/Makefile.riscv64 @@ -2,3 +2,11 @@ ifeq ($(CORE), C910V) CCOMMON_OPT += -march=rv64imafdcv0p7_zfh_xtheadc -mabi=lp64d -mtune=c920 FCOMMON_OPT += -march=rv64imafdcv0p7_zfh_xtheadc -mabi=lp64d -mtune=c920 -static endif +ifeq ($(CORE), x280) +CCOMMON_OPT += -march=rv64imafdcv_zba_zbb_zfh_xsfvqmaccqoq_xsfvfhbfmin -mabi=lp64d -menable-experimental-extensions -mllvm --riscv-v-vector-bits-min=512 -mcpu=sifive-x280 -ffast-math +FCOMMON_OPT += -march=rv64imafdcv_zba_zbb_zfh_xsfvqmaccqoq_xsfvfhbfmin -mabi=lp64d -menable-experimental-extensions -static +endif +ifeq ($(CORE), RISCV64_GENERIC) +CCOMMON_OPT += -march=rv64imafdc -mabi=lp64d +FCOMMON_OPT += -march=rv64imafdc -mabi=lp64d -static +endif \ No newline at end of file diff --git a/README.md b/README.md index 6ce85e08e..6ecb46178 100644 --- a/README.md +++ b/README.md @@ -186,6 +186,11 @@ Please read `GotoBLAS_01Readme.txt` for older CPU models already supported by th ``` (also known to work on C906) +- **x280**: LLVM auto-vectorization using RISC-V Vector extension 1.0. + ```sh + make HOSTCC=gcc TARGET=x280 NUM_THREADS=8 CC=riscv64-unknown-linux-gnu-clang FC=riscv64-unknown-linux-gnu-gfortran + ``` + ### Support for multiple targets in a single library OpenBLAS can be built for multiple targets with runtime detection of the target cpu by specifiying `DYNAMIC_ARCH=1` in Makefile.rule, on the gmake command line or as `-DDYNAMIC_ARCH=TRUE` in cmake. diff --git a/TargetList.txt b/TargetList.txt index deef75819..6c533361e 100644 --- a/TargetList.txt +++ b/TargetList.txt @@ -120,6 +120,7 @@ Z14 10.RISC-V 64: RISCV64_GENERIC C910V +x280 11.LOONGARCH64: LOONGSONGENERIC diff --git a/benchmark/Makefile b/benchmark/Makefile index f2f3b354a..734c83a26 100644 --- a/benchmark/Makefile +++ b/benchmark/Makefile @@ -37,6 +37,12 @@ ESSL=/opt/ibm/lib #LIBESSL = -lesslsmp $(ESSL)/libxlomp_ser.so.1 $(ESSL)/libxlf90_r.so.1 $(ESSL)/libxlfmath.so.1 $(ESSL)/libxlsmp.so.1 /opt/ibm/xlC/13.1.3/lib/libxl.a LIBESSL = -lesslsmp $(ESSL)/libxlf90_r.so.1 $(ESSL)/libxlfmath.so.1 $(ESSL)/libxlsmp.so.1 /opt/ibm/xlC/13.1.3/lib/libxl.a +# x280 temporary workaround for gfortran +ifeq ($(TARGET), x280) +CCOMMON_OPT:=$(filter-out -mllvm --riscv-v-vector-bits-min=512,$(CCOMMON_OPT)) +endif + + ifneq ($(NO_LAPACK), 1) GOTO_LAPACK_TARGETS=slinpack.goto dlinpack.goto clinpack.goto zlinpack.goto \ scholesky.goto dcholesky.goto ccholesky.goto zcholesky.goto \ diff --git a/common_riscv64.h b/common_riscv64.h index 7ddbe80a4..221a79901 100644 --- a/common_riscv64.h +++ b/common_riscv64.h @@ -92,6 +92,10 @@ static inline int blas_quickdivide(blasint x, blasint y){ #define SEEK_ADDRESS #if defined(C910V) +#include +#endif + +#if defined(x280) #include #endif diff --git a/cpuid_riscv64.c b/cpuid_riscv64.c index 894d2b873..5326787e6 100644 --- a/cpuid_riscv64.c +++ b/cpuid_riscv64.c @@ -72,10 +72,12 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define CPU_GENERIC 0 #define CPU_C910V 1 +#define CPU_x280 2 static char *cpuname[] = { "RISCV64_GENERIC", "C910V" + "x280" }; int detect(void){ diff --git a/getarch.c b/getarch.c index cde5b4e83..0d197285c 100644 --- a/getarch.c +++ b/getarch.c @@ -1677,6 +1677,18 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define LIBNAME "c910v" #define CORENAME "C910V" #endif +#endif +#ifdef FORCE_x280 +#define FORCE +#define ARCHITECTURE "RISCV64" +#define SUBARCHITECTURE "x280" +#define SUBDIRNAME "riscv64" +#define ARCHCONFIG "-Dx280 " \ + "-DL1_DATA_SIZE=64536 -DL1_DATA_LINESIZE=32 " \ + "-DL2_SIZE=262144 -DL2_LINESIZE=32 " \ + "-DDTB_DEFAULT_ENTRIES=128 -DDTB_SIZE=4096 -DL2_ASSOCIATIVE=4 " +#define LIBNAME "x280" +#define CORENAME "x280" #else #endif diff --git a/kernel/riscv64/KERNEL.x280 b/kernel/riscv64/KERNEL.x280 new file mode 100644 index 000000000..2eb60f2b4 --- /dev/null +++ b/kernel/riscv64/KERNEL.x280 @@ -0,0 +1,267 @@ +# ********************************************************************************** +# Copyright (c) 2022, The OpenBLAS Project +# All rights reserved. +# Redistribution and use in source and binary forms, with or without +# modification, are permitted provided that the following conditions are +# met: +# 1. Redistributions of source code must retain the above copyright +# notice, this list of conditions and the following disclaimer. +# 2. 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. +# 3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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. +# ********************************************************************************** + +SAMAXKERNEL = amax_rvv.c +DAMAXKERNEL = amax_rvv.c +CAMAXKERNEL = zamax_rvv.c +ZAMAXKERNEL = zamax_rvv.c + +SAMINKERNEL = amin_rvv.c +DAMINKERNEL = amin_rvv.c +CAMINKERNEL = zamin_rvv.c +ZAMINKERNEL = zamin_rvv.c + +SMAXKERNEL = max_rvv.c +DMAXKERNEL = max_rvv.c + +SMINKERNEL = min_rvv.c +DMINKERNEL = min_rvv.c + +ISAMAXKERNEL = iamax_rvv.c +IDAMAXKERNEL = iamax_rvv.c +ICAMAXKERNEL = izamax_rvv.c +IZAMAXKERNEL = izamax_rvv.c + +ISAMINKERNEL = iamin_rvv.c +IDAMINKERNEL = iamin_rvv.c +ICAMINKERNEL = izamin_rvv.c +IZAMINKERNEL = izamin_rvv.c + +ISMAXKERNEL = imax_rvv.c +IDMAXKERNEL = imax_rvv.c + +ISMINKERNEL = imin_rvv.c +IDMINKERNEL = imin_rvv.c + +SASUMKERNEL = asum_rvv.c +DASUMKERNEL = asum_rvv.c +CASUMKERNEL = zasum_rvv.c +ZASUMKERNEL = zasum_rvv.c + +SSUMKERNEL = sum_rvv.c +DSUMKERNEL = sum_rvv.c +CSUMKERNEL = zsum_rvv.c +ZSUMKERNEL = zsum_rvv.c + +SAXPYKERNEL = axpy_rvv.c +DAXPYKERNEL = axpy_rvv.c +CAXPYKERNEL = zaxpy_rvv.c +ZAXPYKERNEL = zaxpy_rvv.c + +SAXPBYKERNEL = axpby_rvv.c +DAXPBYKERNEL = axpby_rvv.c +CAXPBYKERNEL = zaxpby_rvv.c +ZAXPBYKERNEL = zaxpby_rvv.c + +SCOPYKERNEL = copy_rvv.c +DCOPYKERNEL = copy_rvv.c +CCOPYKERNEL = zcopy_rvv.c +ZCOPYKERNEL = zcopy_rvv.c + +SDOTKERNEL = dot_rvv.c +DDOTKERNEL = dot_rvv.c +CDOTKERNEL = zdot_rvv.c +ZDOTKERNEL = zdot_rvv.c +DSDOTKERNEL = dot_rvv.c + +SNRM2KERNEL = nrm2_rvv.c +DNRM2KERNEL = nrm2_rvv.c +CNRM2KERNEL = znrm2_rvv.c +ZNRM2KERNEL = znrm2_rvv.c + +SROTKERNEL = rot_rvv.c +DROTKERNEL = rot_rvv.c +CROTKERNEL = zrot_rvv.c +ZROTKERNEL = zrot_rvv.c + +SSCALKERNEL = scal_rvv.c +DSCALKERNEL = scal_rvv.c +CSCALKERNEL = zscal_rvv.c +ZSCALKERNEL = zscal_rvv.c + +SSWAPKERNEL = swap_rvv.c +DSWAPKERNEL = swap_rvv.c +CSWAPKERNEL = zswap_rvv.c +ZSWAPKERNEL = zswap_rvv.c + +SGEMVNKERNEL = gemv_n_rvv.c +DGEMVNKERNEL = gemv_n_rvv.c +CGEMVNKERNEL = zgemv_n_rvv.c +ZGEMVNKERNEL = zgemv_n_rvv.c + +SGEMVTKERNEL = gemv_t_rvv.c +DGEMVTKERNEL = gemv_t_rvv.c +CGEMVTKERNEL = zgemv_t_rvv.c +ZGEMVTKERNEL = zgemv_t_rvv.c + +CTRMMKERNEL = ztrmmkernel_2x2_rvv.c +ZTRMMKERNEL = ztrmmkernel_2x2_rvv.c + +# SGEMM_UNROLL_N set in params.h +ifeq ($(SGEMM_UNROLL_N), 2) +SGEMMKERNEL = gemmkernel_2x2_rvv.c +SGEMMONCOPY = gemm_ncopy_2_rvv.c +SGEMMOTCOPY = gemm_tcopy_2_rvv.c +SGEMMONCOPYOBJ = sgemm_oncopy.o +SGEMMOTCOPYOBJ = sgemm_otcopy.o + +STRMMKERNEL = trmmkernel_2x2_rvv.c +else ifeq ($(SGEMM_UNROLL_N), 4) +SGEMMKERNEL = gemmkernel_4x4_rvv.c +SGEMMONCOPY = gemm_ncopy_4_rvv.c +SGEMMOTCOPY = ../generic/gemm_tcopy_4.c +SGEMMONCOPYOBJ = sgemm_oncopy.o +SGEMMOTCOPYOBJ = sgemm_otcopy.o + +STRMMKERNEL = trmmkernel_4x4_rvv.c +else ifeq ($(SGEMM_UNROLL_N), 8) +# UNROLL_M is VLMAX +SGEMMKERNEL = gemmkernel_rvv_v1x8.c +SGEMMINCOPY = gemm_ncopy_rvv_v1.c +SGEMMITCOPY = gemm_tcopy_rvv_v1.c +SGEMMONCOPY = gemm_ncopy_$(SGEMM_UNROLL_N)_rvv.c +SGEMMOTCOPY = gemm_tcopy_$(SGEMM_UNROLL_N)_rvv.c +SGEMMINCOPYOBJ = sgemm_incopy$(TSUFFIX).$(SUFFIX) +SGEMMITCOPYOBJ = sgemm_itcopy$(TSUFFIX).$(SUFFIX) +SGEMMONCOPYOBJ = sgemm_oncopy$(TSUFFIX).$(SUFFIX) +SGEMMOTCOPYOBJ = sgemm_otcopy$(TSUFFIX).$(SUFFIX) + +STRMMKERNEL = trmmkernel_rvv_v1x8.c + +STRMMUNCOPY_M = trmm_uncopy_rvv_v1.c +STRMMLNCOPY_M = trmm_lncopy_rvv_v1.c +STRMMUTCOPY_M = trmm_utcopy_rvv_v1.c +STRMMLTCOPY_M = trmm_ltcopy_rvv_v1.c + +SSYMMUCOPY_M = symm_ucopy_rvv_v1.c +SSYMMLCOPY_M = symm_lcopy_rvv_v1.c +endif + +# SGEMM_UNROLL_N set in params.h +ifeq ($(DGEMM_UNROLL_N), 2) +DGEMMKERNEL = gemmkernel_2x2_rvv.c +DGEMMONCOPY = gemm_ncopy_2_rvv.c +DGEMMOTCOPY = gemm_tcopy_2_rvv.c +DGEMMONCOPYOBJ = dgemm_oncopy.o +DGEMMOTCOPYOBJ = dgemm_otcopy.o + +DTRMMKERNEL = trmmkernel_2x2_rvv.c +else ifeq ($(DGEMM_UNROLL_N), 4) +DGEMMKERNEL = gemmkernel_4x4_rvv.c +DGEMMONCOPY = gemm_ncopy_4_rvv.c +DGEMMOTCOPY = ../generic/gemm_tcopy_4.c +DGEMMONCOPYOBJ = dgemm_oncopy.o +DGEMMOTCOPYOBJ = dgemm_otcopy.o + +DTRMMKERNEL = trmmkernel_4x4_rvv.c +else ifeq ($(DGEMM_UNROLL_N), 8) +# UNROLL_M is VLMAX +DGEMMKERNEL = gemmkernel_rvv_v1x8.c +DGEMMINCOPY = gemm_ncopy_rvv_v1.c +DGEMMITCOPY = gemm_tcopy_rvv_v1.c +DGEMMONCOPY = gemm_ncopy_$(DGEMM_UNROLL_N)_rvv.c +DGEMMOTCOPY = gemm_tcopy_$(DGEMM_UNROLL_N)_rvv.c +DGEMMINCOPYOBJ = dgemm_incopy$(TSUFFIX).$(SUFFIX) +DGEMMITCOPYOBJ = dgemm_itcopy$(TSUFFIX).$(SUFFIX) +DGEMMONCOPYOBJ = dgemm_oncopy$(TSUFFIX).$(SUFFIX) +DGEMMOTCOPYOBJ = dgemm_otcopy$(TSUFFIX).$(SUFFIX) + +DTRMMKERNEL = trmmkernel_rvv_v1x8.c +DTRMMUNCOPY_M = trmm_uncopy_rvv_v1.c +DTRMMLNCOPY_M = trmm_lncopy_rvv_v1.c +DTRMMUTCOPY_M = trmm_utcopy_rvv_v1.c +DTRMMLTCOPY_M = trmm_ltcopy_rvv_v1.c + +DSYMMUCOPY_M = symm_ucopy_rvv_v1.c +DSYMMLCOPY_M = symm_lcopy_rvv_v1.c +endif + +CGEMMKERNEL = ../generic/zgemmkernel_2x2.c +CGEMMONCOPY = ../generic/zgemm_ncopy_2.c +CGEMMOTCOPY = ../generic/zgemm_tcopy_2.c +CGEMMONCOPYOBJ = cgemm_oncopy.o +CGEMMOTCOPYOBJ = cgemm_otcopy.o + +ZGEMMKERNEL = ../generic/zgemmkernel_2x2.c +ZGEMMONCOPY = ../generic/zgemm_ncopy_2.c +ZGEMMOTCOPY = ../generic/zgemm_tcopy_2.c +ZGEMMONCOPYOBJ = zgemm_oncopy.o +ZGEMMOTCOPYOBJ = zgemm_otcopy.o + +STRSMKERNEL_LN = trsm_kernel_LN_rvv_v1.c +STRSMKERNEL_LT = trsm_kernel_LT_rvv_v1.c +STRSMKERNEL_RN = trsm_kernel_RN_rvv_v1.c +STRSMKERNEL_RT = trsm_kernel_RT_rvv_v1.c + +DTRSMKERNEL_LN = trsm_kernel_LN_rvv_v1.c +DTRSMKERNEL_LT = trsm_kernel_LT_rvv_v1.c +DTRSMKERNEL_RN = trsm_kernel_RN_rvv_v1.c +DTRSMKERNEL_RT = trsm_kernel_RT_rvv_v1.c + +CTRSMKERNEL_LN = ../generic/trsm_kernel_LN.c +CTRSMKERNEL_LT = ../generic/trsm_kernel_LT.c +CTRSMKERNEL_RN = ../generic/trsm_kernel_RN.c +CTRSMKERNEL_RT = ../generic/trsm_kernel_RT.c + +ZTRSMKERNEL_LN = ../generic/trsm_kernel_LN.c +ZTRSMKERNEL_LT = ../generic/trsm_kernel_LT.c +ZTRSMKERNEL_RN = ../generic/trsm_kernel_RN.c +ZTRSMKERNEL_RT = ../generic/trsm_kernel_RT.c + +TRSMCOPYLN_M = trsm_lncopy_rvv_v1.c +TRSMCOPYLT_M = trsm_ltcopy_rvv_v1.c +TRSMCOPYUN_M = trsm_uncopy_rvv_v1.c +TRSMCOPYUT_M = trsm_utcopy_rvv_v1.c + +SSYMV_U_KERNEL = symv_U_rvv.c +SSYMV_L_KERNEL = symv_L_rvv.c +DSYMV_U_KERNEL = symv_U_rvv.c +DSYMV_L_KERNEL = symv_L_rvv.c +CSYMV_U_KERNEL = ../generic/zsymv_k.c +CSYMV_L_KERNEL = ../generic/zsymv_k.c +ZSYMV_U_KERNEL = ../generic/zsymv_k.c +ZSYMV_L_KERNEL = ../generic/zsymv_k.c + + +LSAME_KERNEL = ../generic/lsame.c + +SCABS_KERNEL = ../generic/cabs.c +DCABS_KERNEL = ../generic/cabs.c +QCABS_KERNEL = ../generic/cabs.c + +ifndef SGEMM_BETA +SGEMM_BETA = gemm_beta_rvv.c +endif +ifndef DGEMM_BETA +DGEMM_BETA = gemm_beta_rvv.c +endif +ifndef CGEMM_BETA +CGEMM_BETA = zgemm_beta_rvv.c +endif +ifndef ZGEMM_BETA +ZGEMM_BETA = zgemm_beta_rvv.c +endif diff --git a/kernel/riscv64/amax_rvv.c b/kernel/riscv64/amax_rvv.c new file mode 100644 index 000000000..c9c6e7f73 --- /dev/null +++ b/kernel/riscv64/amax_rvv.c @@ -0,0 +1,102 @@ +/*************************************************************************** +Copyright (c) 2022, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" +#include + +#if !defined(DOUBLE) +#define VSETVL(n) vsetvl_e32m8(n) +#define VSETVL_MAX vsetvlmax_e32m8() +#define VSETVL_MAX_M1 vsetvlmax_e32m1() +#define FLOAT_V_T vfloat32m8_t +#define FLOAT_V_T_M1 vfloat32m1_t +#define VLEV_FLOAT vle32_v_f32m8 +#define VLSEV_FLOAT vlse32_v_f32m8 +#define VFREDMAXVS_FLOAT vfredmax_vs_f32m8_f32m1 +#define VFMVVF_FLOAT vfmv_v_f_f32m8 +#define VFMVVF_FLOAT_M1 vfmv_v_f_f32m1 +#define VFMAXVV_FLOAT vfmax_vv_f32m8 +#define VFABSV_FLOAT vfabs_v_f32m8 +#define VFMVFS_FLOAT_M1 vfmv_f_s_f32m1_f32 +#else +#define VSETVL(n) vsetvl_e64m8(n) +#define VSETVL_MAX vsetvlmax_e64m8() +#define VSETVL_MAX_M1 vsetvlmax_e64m1() +#define FLOAT_V_T vfloat64m8_t +#define FLOAT_V_T_M1 vfloat64m1_t +#define VLEV_FLOAT vle64_v_f64m8 +#define VLSEV_FLOAT vlse64_v_f64m8 +#define VFREDMAXVS_FLOAT vfredmax_vs_f64m8_f64m1 +#define VFMVVF_FLOAT vfmv_v_f_f64m8 +#define VFMVVF_FLOAT_M1 vfmv_v_f_f64m1 +#define VFMAXVV_FLOAT vfmax_vv_f64m8 +#define VFABSV_FLOAT vfabs_v_f64m8 +#define VFMVFS_FLOAT_M1 vfmv_f_s_f64m1_f64 +#endif + +FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) +{ + FLOAT maxf = 0.0; + + if (n <= 0 || inc_x <= 0) return(maxf); + + FLOAT_V_T vx, vmax; + FLOAT_V_T_M1 v_res; + + v_res = VFMVVF_FLOAT_M1(0, VSETVL_MAX_M1); + size_t vlmax = VSETVL_MAX; + vmax = VFMVVF_FLOAT(0.0, vlmax); + + if(inc_x == 1) { + + for (size_t vl; n > 0; n -= vl, x += vl) { + vl = VSETVL(n); + + vx = VLEV_FLOAT(x, vl); + vx = VFABSV_FLOAT(vx, vl); + vmax = VFMAXVV_FLOAT(vmax, vx, vl); + } + + } else { + + BLASLONG stride_x = inc_x * sizeof(FLOAT); + + for (size_t vl; n > 0; n -= vl, x += vl*inc_x) { + vl = VSETVL(n); + + vx = VLSEV_FLOAT(x, stride_x, vl); + vx = VFABSV_FLOAT(vx, vl); + vmax = VFMAXVV_FLOAT(vmax, vx, vl); + } + + } + + v_res = VFREDMAXVS_FLOAT(v_res, vmax, v_res, vlmax); + maxf = VFMVFS_FLOAT_M1(v_res); + + return(maxf); +} diff --git a/kernel/riscv64/amin_rvv.c b/kernel/riscv64/amin_rvv.c new file mode 100644 index 000000000..370b6c338 --- /dev/null +++ b/kernel/riscv64/amin_rvv.c @@ -0,0 +1,102 @@ +/*************************************************************************** +Copyright (c) 2022, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" +#include + +#if !defined(DOUBLE) +#define VSETVL(n) vsetvl_e32m8(n) +#define VSETVL_MAX vsetvlmax_e32m8() +#define VSETVL_MAX_M1 vsetvlmax_e32m1() +#define FLOAT_V_T vfloat32m8_t +#define FLOAT_V_T_M1 vfloat32m1_t +#define VLEV_FLOAT vle32_v_f32m8 +#define VLSEV_FLOAT vlse32_v_f32m8 +#define VFREDMINVS_FLOAT vfredmin_vs_f32m8_f32m1 +#define VFMVVF_FLOAT vfmv_v_f_f32m8 +#define VFMVVF_FLOAT_M1 vfmv_v_f_f32m1 +#define VFMINVV_FLOAT vfmin_vv_f32m8 +#define VFABSV_FLOAT vfabs_v_f32m8 +#define VFMVFS_FLOAT_M1 vfmv_f_s_f32m1_f32 +#else +#define VSETVL(n) vsetvl_e64m8(n) +#define VSETVL_MAX vsetvlmax_e64m8() +#define VSETVL_MAX_M1 vsetvlmax_e64m1() +#define FLOAT_V_T vfloat64m8_t +#define FLOAT_V_T_M1 vfloat64m1_t +#define VLEV_FLOAT vle64_v_f64m8 +#define VLSEV_FLOAT vlse64_v_f64m8 +#define VFREDMINVS_FLOAT vfredmin_vs_f64m8_f64m1 +#define VFMVVF_FLOAT vfmv_v_f_f64m8 +#define VFMVVF_FLOAT_M1 vfmv_v_f_f64m1 +#define VFMINVV_FLOAT vfmin_vv_f64m8 +#define VFABSV_FLOAT vfabs_v_f64m8 +#define VFMVFS_FLOAT_M1 vfmv_f_s_f64m1_f64 +#endif + +FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) +{ + FLOAT minf = 0.0; + + if (n <= 0 || inc_x <= 0) return(minf); + + FLOAT_V_T vx, vmin; + FLOAT_V_T_M1 v_res; + + v_res = VFMVVF_FLOAT_M1(FLT_MAX, VSETVL_MAX_M1); + size_t vlmax = VSETVL_MAX; + vmin = VFMVVF_FLOAT(FLT_MAX, vlmax); + + if(inc_x == 1) { + + for (size_t vl; n > 0; n -= vl, x += vl) { + vl = VSETVL(n); + + vx = VLEV_FLOAT(x, vl); + vx = VFABSV_FLOAT(vx, vl); + vmin = VFMINVV_FLOAT(vmin, vx, vl); + } + + } else { + + BLASLONG stride_x = inc_x * sizeof(FLOAT); + + for (size_t vl; n > 0; n -= vl, x += vl*inc_x) { + vl = VSETVL(n); + + vx = VLSEV_FLOAT(x, stride_x, vl); + vx = VFABSV_FLOAT(vx, vl); + vmin = VFMINVV_FLOAT(vmin, vx, vl); + } + + } + + v_res = VFREDMINVS_FLOAT(v_res, vmin, v_res, vlmax); + minf = VFMVFS_FLOAT_M1(v_res); + + return(minf); +} diff --git a/kernel/riscv64/asum_rvv.c b/kernel/riscv64/asum_rvv.c new file mode 100644 index 000000000..4f711c9be --- /dev/null +++ b/kernel/riscv64/asum_rvv.c @@ -0,0 +1,99 @@ +/*************************************************************************** +Copyright (c) 2022, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" + +#if !defined(DOUBLE) +#define VSETVL(n) vsetvl_e32m8(n) +#define VSETVL_MAX vsetvlmax_e32m8() +#define VSETVL_MAX_M1 vsetvlmax_e32m1() +#define FLOAT_V_T vfloat32m8_t +#define FLOAT_V_T_M1 vfloat32m1_t +#define VLEV_FLOAT vle32_v_f32m8 +#define VLSEV_FLOAT vlse32_v_f32m8 +#define VFMVVF_FLOAT vfmv_v_f_f32m8 +#define VFADDVV_FLOAT vfadd_vv_f32m8 +#define VFABSV_FLOAT vfabs_v_f32m8 +#define VFREDSUMVS_FLOAT vfredusum_vs_f32m8_f32m1 +#define VFMVVF_FLOAT_M1 vfmv_v_f_f32m1 +#define VFMVFS_FLOAT_M1 vfmv_f_s_f32m1_f32 +#else +#define VSETVL(n) vsetvl_e64m8(n) +#define VSETVL_MAX vsetvlmax_e64m8() +#define VSETVL_MAX_M1 vsetvlmax_e64m1() +#define FLOAT_V_T vfloat64m8_t +#define FLOAT_V_T_M1 vfloat64m1_t +#define VLEV_FLOAT vle64_v_f64m8 +#define VLSEV_FLOAT vlse64_v_f64m8 +#define VFMVVF_FLOAT vfmv_v_f_f64m8 +#define VFADDVV_FLOAT vfadd_vv_f64m8 +#define VFABSV_FLOAT vfabs_v_f64m8 +#define VFREDSUMVS_FLOAT vfredusum_vs_f64m8_f64m1 +#define VFMVVF_FLOAT_M1 vfmv_v_f_f64m1 +#define VFMVFS_FLOAT_M1 vfmv_f_s_f64m1_f64 +#endif + +FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) +{ + FLOAT asumf = 0.0; + if (n <= 0 || inc_x <= 0) return(asumf); + + FLOAT_V_T vx, vsum; + FLOAT_V_T_M1 v_res; + + v_res = VFMVVF_FLOAT_M1(0, VSETVL_MAX_M1); + size_t vlmax = VSETVL_MAX; + vsum = VFMVVF_FLOAT(0.0, vlmax); + + if(inc_x == 1) { + + for (size_t vl; n > 0; n -= vl, x += vl) { + vl = VSETVL(n); + + vx = VLEV_FLOAT(x, vl); + vx = VFABSV_FLOAT(vx, vl); + vsum = VFADDVV_FLOAT(vsum, vx, vl); + } + + } else { + + BLASLONG stride_x = inc_x * sizeof(FLOAT); + + for (size_t vl; n > 0; n -= vl, x += vl*inc_x) { + vl = VSETVL(n); + + vx = VLSEV_FLOAT(x, stride_x, vl); + vx = VFABSV_FLOAT(vx, vl); + vsum = VFADDVV_FLOAT(vsum, vx, vl); + } + + } + + v_res = VFREDSUMVS_FLOAT(v_res, vsum, v_res, vlmax); + asumf = VFMVFS_FLOAT_M1(v_res); + return(asumf); +} diff --git a/kernel/riscv64/axpby_rvv.c b/kernel/riscv64/axpby_rvv.c new file mode 100644 index 000000000..7c35c563d --- /dev/null +++ b/kernel/riscv64/axpby_rvv.c @@ -0,0 +1,171 @@ +/*************************************************************************** +Copyright (c) 2022, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" + +#if !defined(DOUBLE) +#define VSETVL(n) vsetvl_e32m8(n) +#define FLOAT_V_T vfloat32m8_t +#define VLEV_FLOAT vle32_v_f32m8 +#define VLSEV_FLOAT vlse32_v_f32m8 +#define VSEV_FLOAT vse32_v_f32m8 +#define VSSEV_FLOAT vsse32_v_f32m8 +#define VFMACCVF_FLOAT vfmacc_vf_f32m8 +#define VFMULVF_FLOAT vfmul_vf_f32m8 +#define VFMVVF_FLOAT vfmv_v_f_f32m8 +#else +#define VSETVL(n) vsetvl_e64m8(n) +#define FLOAT_V_T vfloat64m8_t +#define VLEV_FLOAT vle64_v_f64m8 +#define VLSEV_FLOAT vlse64_v_f64m8 +#define VSEV_FLOAT vse64_v_f64m8 +#define VSSEV_FLOAT vsse64_v_f64m8 +#define VFMACCVF_FLOAT vfmacc_vf_f64m8 +#define VFMULVF_FLOAT vfmul_vf_f64m8 +#define VFMVVF_FLOAT vfmv_v_f_f64m8 +#endif + +int CNAME(BLASLONG n, FLOAT alpha, FLOAT *x, BLASLONG inc_x, FLOAT beta, FLOAT *y, BLASLONG inc_y) +{ + FLOAT_V_T vx, vy; + + if ( n < 0 ) return(0); + + if ( beta == 0.0 ) { + if ( alpha == 0.0 ) { + if (1 == inc_y) { + memset(&y[0], 0, n * sizeof(FLOAT)); + } else { + BLASLONG stride_y = inc_y * sizeof(FLOAT); + size_t vl = VSETVL(n); + vy = VFMVVF_FLOAT(0.0, vl); + for ( ; n > 0; n -= vl, y += vl*stride_y) { + vl = VSETVL(n); + VSSEV_FLOAT(y, stride_y, vy, vl); + } + } + + } else { + if ((1 == inc_x) && (1 == inc_y)) { + for (size_t vl; n > 0; n -= vl, x += vl, y += vl) { + vl = VSETVL(n); + vx = VLEV_FLOAT(x, vl); + vy = VFMULVF_FLOAT(vx, alpha, vl); + VSEV_FLOAT (y, vy, vl); + } + } else if (1 == inc_x) { + BLASLONG stride_y = inc_y * sizeof(FLOAT); + for (size_t vl; n > 0; n -= vl, x += vl, y += vl*inc_y) { + vl = VSETVL(n); + vx = VLEV_FLOAT(x, vl); + vy = VFMULVF_FLOAT(vx, alpha, vl); + VSSEV_FLOAT (y, stride_y, vy, vl); + } + } else if (1 == inc_y) { + BLASLONG stride_x = inc_x * sizeof(FLOAT); + for (size_t vl; n > 0; n -= vl, x += vl*inc_x, y += vl) { + vl = VSETVL(n); + vx = VLSEV_FLOAT(x, stride_x, vl); + vy = VFMULVF_FLOAT(vx, alpha, vl); + VSEV_FLOAT (y, vy, vl); + } + } else { + BLASLONG stride_x = inc_x * sizeof(FLOAT); + BLASLONG stride_y = inc_y * sizeof(FLOAT); + for (size_t vl; n > 0; n -= vl, x += vl*inc_x, y += vl*inc_y) { + vl = VSETVL(n); + vx = VLSEV_FLOAT(x, stride_x, vl); + vy = VFMULVF_FLOAT(vx, alpha, vl); + VSSEV_FLOAT (y, stride_y, vy, vl); + } + } + } + + } else { + if ( alpha == 0.0 ) { + if (1 == inc_y) { + for (size_t vl; n > 0; n -= vl, y += vl) { + vl = VSETVL(n); + vy = VLEV_FLOAT(y, vl); + vy = VFMULVF_FLOAT(vy, beta, vl); + VSEV_FLOAT (y, vy, vl); + } + } else { + BLASLONG stride_y = inc_y * sizeof(FLOAT); + for (size_t vl; n > 0; n -= vl, y += vl*inc_y) { + vl = VSETVL(n); + vy = VLSEV_FLOAT(y, stride_y, vl); + vy = VFMULVF_FLOAT(vy, beta, vl); + VSSEV_FLOAT (y, stride_y, vy, vl); + } + } + + } else { + if ((1 == inc_x) && (1 == inc_y)) { + for (size_t vl; n > 0; n -= vl, y += vl) { + vl = VSETVL(n); + vy = VLEV_FLOAT(y, vl); + vy = VFMULVF_FLOAT(vy, beta, vl); + VSEV_FLOAT (y, vy, vl); + } + } else if (1 == inc_x) { + BLASLONG stride_y = inc_y * sizeof(FLOAT); + for (size_t vl; n > 0; n -= vl, x += vl, y += vl*inc_y) { + vl = VSETVL(n); + vx = VLEV_FLOAT(x, vl); + vy = VLSEV_FLOAT(y, stride_y, vl); + vy = VFMULVF_FLOAT(vy, beta, vl); + vy = VFMACCVF_FLOAT(vy, alpha, vx, vl); + VSSEV_FLOAT (y, stride_y, vy, vl); + } + } else if (1 == inc_y) { + BLASLONG stride_x = inc_x * sizeof(FLOAT); + for (size_t vl; n > 0; n -= vl, x += vl*inc_x, y += vl) { + vl = VSETVL(n); + vx = VLSEV_FLOAT(x, stride_x, vl); + vy = VLEV_FLOAT(y, vl); + vy = VFMULVF_FLOAT(vy, beta, vl); + vy = VFMACCVF_FLOAT(vy, alpha, vx, vl); + VSEV_FLOAT (y, vy, vl); + } + } else { + BLASLONG stride_x = inc_x * sizeof(FLOAT); + BLASLONG stride_y = inc_y * sizeof(FLOAT); + for (size_t vl; n > 0; n -= vl, x += vl*inc_x, y += vl*inc_y) { + vl = VSETVL(n); + vx = VLSEV_FLOAT(x, stride_x, vl); + vy = VLSEV_FLOAT(y, stride_y, vl); + vy = VFMULVF_FLOAT(vy, beta, vl); + vy = VFMACCVF_FLOAT(vy, alpha, vx, vl); + VSSEV_FLOAT (y, stride_y, vy, vl); + } + } + } + } + + return(0); +} diff --git a/kernel/riscv64/axpy_rvv.c b/kernel/riscv64/axpy_rvv.c new file mode 100644 index 000000000..3986f4e21 --- /dev/null +++ b/kernel/riscv64/axpy_rvv.c @@ -0,0 +1,109 @@ +/*************************************************************************** +Copyright (c) 2022, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" + +#if !defined(DOUBLE) +#define VSETVL(n) vsetvl_e32m8(n) +#define FLOAT_V_T vfloat32m8_t +#define VLEV_FLOAT vle32_v_f32m8 +#define VLSEV_FLOAT vlse32_v_f32m8 +#define VSEV_FLOAT vse32_v_f32m8 +#define VSSEV_FLOAT vsse32_v_f32m8 +#define VFMACCVF_FLOAT vfmacc_vf_f32m8 +#else +#define VSETVL(n) vsetvl_e64m8(n) +#define FLOAT_V_T vfloat64m8_t +#define VLEV_FLOAT vle64_v_f64m8 +#define VLSEV_FLOAT vlse64_v_f64m8 +#define VSEV_FLOAT vse64_v_f64m8 +#define VSSEV_FLOAT vsse64_v_f64m8 +#define VFMACCVF_FLOAT vfmacc_vf_f64m8 +#endif + +int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT da, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y, FLOAT *dummy, BLASLONG dummy2) +{ + if ( n <= 0 ) return(0); + if ( da == 0.0 ) return(0); + + FLOAT_V_T vx, vy; + + if(inc_x == 1 && inc_y == 1) { + + for (size_t vl; n > 0; n -= vl, x += vl, y += vl) { + vl = VSETVL(n); + + vx = VLEV_FLOAT(x, vl); + vy = VLEV_FLOAT(y, vl); + vy = VFMACCVF_FLOAT(vy, da, vx, vl); + VSEV_FLOAT (y, vy, vl); + } + + } else if (1 == inc_y) { + + BLASLONG stride_x = inc_x * sizeof(FLOAT); + + for (size_t vl; n > 0; n -= vl, x += vl*inc_x, y += vl) { + vl = VSETVL(n); + + vx = VLSEV_FLOAT(x, stride_x, vl); + vy = VLEV_FLOAT(y, vl); + vy = VFMACCVF_FLOAT(vy, da, vx, vl); + VSEV_FLOAT(y, vy, vl); + } + + } else if (1 == inc_x) { + + BLASLONG stride_y = inc_y * sizeof(FLOAT); + + for (size_t vl; n > 0; n -= vl, x += vl, y += vl*inc_y) { + vl = VSETVL(n); + + vx = VLEV_FLOAT(x, vl); + vy = VLSEV_FLOAT(y, stride_y, vl); + vy = VFMACCVF_FLOAT(vy, da, vx, vl); + VSSEV_FLOAT(y, stride_y, vy, vl); + } + + } else { + + BLASLONG stride_x = inc_x * sizeof(FLOAT); + BLASLONG stride_y = inc_y * sizeof(FLOAT); + + for (size_t vl; n > 0; n -= vl, x += vl*inc_x, y += vl*inc_y) { + vl = VSETVL(n); + + vx = VLSEV_FLOAT(x, stride_x, vl); + vy = VLSEV_FLOAT(y, stride_y, vl); + vy = VFMACCVF_FLOAT(vy, da, vx, vl); + VSSEV_FLOAT(y, stride_y, vy, vl); + } + + } + + return(0); +} diff --git a/kernel/riscv64/copy_rvv.c b/kernel/riscv64/copy_rvv.c new file mode 100644 index 000000000..5d5a8bd04 --- /dev/null +++ b/kernel/riscv64/copy_rvv.c @@ -0,0 +1,94 @@ +/*************************************************************************** +Copyright (c) 2022, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" + +#if !defined(DOUBLE) +#define VSETVL(n) vsetvl_e32m8(n) +#define FLOAT_V_T vfloat32m8_t +#define VLEV_FLOAT vle32_v_f32m8 +#define VLSEV_FLOAT vlse32_v_f32m8 +#define VSEV_FLOAT vse32_v_f32m8 +#define VSSEV_FLOAT vsse32_v_f32m8 +#else +#define VSETVL(n) vsetvl_e64m8(n) +#define FLOAT_V_T vfloat64m8_t +#define VLEV_FLOAT vle64_v_f64m8 +#define VLSEV_FLOAT vlse64_v_f64m8 +#define VSEV_FLOAT vse64_v_f64m8 +#define VSSEV_FLOAT vsse64_v_f64m8 +#endif + +int CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y) +{ + if(n < 0) return(0); + + FLOAT_V_T v0; + + if(inc_x == 1 && inc_y == 1) { + + for(size_t vl; n > 0; n -= vl, x += vl, y += vl) { + vl = VSETVL(n); + v0 = VLEV_FLOAT(x, vl); + VSEV_FLOAT(y, v0, vl); + } + + } else if (inc_y == 1) { + + BLASLONG stride_x = inc_x * sizeof(FLOAT); + + for(size_t vl; n > 0; n -= vl, x += vl*inc_x, y += vl) { + vl = VSETVL(n); + v0 = VLSEV_FLOAT(x, stride_x, vl); + VSEV_FLOAT(y, v0, vl); + } + + } else if(inc_x == 1) { + + BLASLONG stride_y = inc_y * sizeof(FLOAT); + + for(size_t vl; n > 0; n -= vl, x += vl, y += vl*inc_y) { + vl = VSETVL(n); + v0 = VLEV_FLOAT(x, vl); + VSSEV_FLOAT(y, stride_y, v0, vl); + } + + } else { + + BLASLONG stride_x = inc_x * sizeof(FLOAT); + BLASLONG stride_y = inc_y * sizeof(FLOAT); + + for(size_t vl; n > 0; n -= vl, x += vl*inc_x, y += vl*inc_y) { + vl = VSETVL(n); + v0 = VLSEV_FLOAT(x, stride_x, vl); + VSSEV_FLOAT(y, stride_y, v0, vl); + } + + } + + return(0); +} diff --git a/kernel/riscv64/dot_rvv.c b/kernel/riscv64/dot_rvv.c new file mode 100644 index 000000000..60dcac2f5 --- /dev/null +++ b/kernel/riscv64/dot_rvv.c @@ -0,0 +1,126 @@ +/*************************************************************************** +Copyright (c) 2022, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" + +#if defined(DSDOT) +double CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y) +#else +FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y) +#endif +{ + double dot = 0.0; + + if ( n <= 0 ) return(dot); + + size_t vlmax = vsetvlmax_e64m8(); + vfloat64m8_t vr = vfmv_v_f_f64m8(0, vlmax); + + if(inc_x == 1 && inc_y == 1) { + + for (size_t vl; n > 0; n -= vl, x += vl, y += vl) { + vl = vsetvl_e64m8(n); + +#if !defined(DOUBLE) + vfloat32m4_t vx = vle32_v_f32m4(x, vl); + vfloat32m4_t vy = vle32_v_f32m4(y, vl); + + vr = vfwmacc_vv_f64m8(vr, vx, vy, vl); +#else + vfloat64m8_t vx = vle64_v_f64m8(x, vl); + vfloat64m8_t vy = vle64_v_f64m8(y, vl); + + vr = vfmacc_vv_f64m8(vr, vx, vy, vl); +#endif + } + + } else if (1 == inc_x) { + + BLASLONG stride_y = inc_y * sizeof(FLOAT); + + for (size_t vl; n > 0; n -= vl, x += vl, y += vl*inc_y) { + vl = vsetvl_e64m8(n); + +#if !defined(DOUBLE) + vfloat32m4_t vx = vle32_v_f32m4(x, vl); + vfloat32m4_t vy = vlse32_v_f32m4(y, stride_y, vl); + + vr = vfwmacc_vv_f64m8(vr, vx, vy, vl); +#else + vfloat64m8_t vx = vle64_v_f64m8(x, vl); + vfloat64m8_t vy = vlse64_v_f64m8(y, stride_y, vl); + + vr = vfmacc_vv_f64m8(vr, vx, vy, vl); +#endif + } + } else if (1 == inc_y) { + + BLASLONG stride_x = inc_x * sizeof(FLOAT); + + for (size_t vl; n > 0; n -= vl, x += vl*inc_x, y += vl) { + vl = vsetvl_e64m8(n); + +#if !defined(DOUBLE) + vfloat32m4_t vx = vlse32_v_f32m4(x, stride_x, vl); + vfloat32m4_t vy = vle32_v_f32m4(y, vl); + + vr = vfwmacc_vv_f64m8(vr, vx, vy, vl); +#else + vfloat64m8_t vx = vlse64_v_f64m8(x, stride_x, vl); + vfloat64m8_t vy = vle64_v_f64m8(y, vl); + + vr = vfmacc_vv_f64m8(vr, vx, vy, vl); +#endif + } + } else { + + BLASLONG stride_x = inc_x * sizeof(FLOAT); + BLASLONG stride_y = inc_y * sizeof(FLOAT); + + for (size_t vl; n > 0; n -= vl, x += vl*inc_x, y += vl*inc_y) { + vl = vsetvl_e64m8(n); + +#if !defined(DOUBLE) + vfloat32m4_t vx = vlse32_v_f32m4(x, stride_x, vl); + vfloat32m4_t vy = vlse32_v_f32m4(y, stride_y, vl); + + vr = vfwmacc_vv_f64m8(vr, vx, vy, vl); +#else + vfloat64m8_t vx = vlse64_v_f64m8(x, stride_x, vl); + vfloat64m8_t vy = vlse64_v_f64m8(y, stride_y, vl); + + vr = vfmacc_vv_f64m8(vr, vx, vy, vl); +#endif + } + } + + vfloat64m1_t vec_zero = vfmv_v_f_f64m1(0, vlmax); + vfloat64m1_t vec_sum = vfredusum_vs_f64m8_f64m1(vec_zero, vr, vec_zero, vlmax); + dot = vfmv_f_s_f64m1_f64(vec_sum); + + return(dot); +} diff --git a/kernel/riscv64/gemm_beta_rvv.c b/kernel/riscv64/gemm_beta_rvv.c new file mode 100644 index 000000000..34d1ea078 --- /dev/null +++ b/kernel/riscv64/gemm_beta_rvv.c @@ -0,0 +1,89 @@ +/*************************************************************************** +Copyright (c) 2022, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" + +#if !defined(DOUBLE) +#define VSETVL(n) vsetvl_e32m8(n) +#define FLOAT_V_T vfloat32m8_t +#define VLEV_FLOAT vle32_v_f32m8 +#define VFMVVF_FLOAT vfmv_v_f_f32m8 +#define VFMULVF_FLOAT vfmul_vf_f32m8 +#define VSEV_FLOAT vse32_v_f32m8 +#else +#define VSETVL(n) vsetvl_e64m8(n) +#define FLOAT_V_T vfloat64m8_t +#define VLEV_FLOAT vle64_v_f64m8 +#define VFMVVF_FLOAT vfmv_v_f_f64m8 +#define VFMULVF_FLOAT vfmul_vf_f64m8 +#define VSEV_FLOAT vse64_v_f64m8 +#endif + +// Optimizes the implementation in ../generic/gemm_beta.c + +int CNAME(BLASLONG m, BLASLONG n, BLASLONG dummy1, FLOAT beta, + IFLOAT *dummy2, BLASLONG dummy3, IFLOAT *dummy4, BLASLONG dummy5, + FLOAT *c, BLASLONG ldc) +{ + BLASLONG chunk; + FLOAT *c_offset; + size_t vl; + FLOAT_V_T vx; + + if (beta == ZERO) { + + vl = VSETVL(m); + vx = VFMVVF_FLOAT(0.0, vl); + + for( ; n > 0; n--, c += ldc) { + c_offset = c; + + for(chunk=m; chunk > 0; chunk -= vl, c_offset += vl) { + vl = VSETVL(chunk); + + VSEV_FLOAT(c_offset, vx, vl); + } + } + + } else { + + for( ; n > 0; n--, c += ldc) { + c_offset = c; + + for(chunk=m; chunk > 0; chunk -= vl, c_offset += vl) { + vl = VSETVL(chunk); + + vx = VLEV_FLOAT(c_offset, vl); + vx = VFMULVF_FLOAT(vx, beta, vl); + VSEV_FLOAT(c_offset, vx, vl); + } + } + + } + + return 0; +} diff --git a/kernel/riscv64/gemm_ncopy_2_rvv.c b/kernel/riscv64/gemm_ncopy_2_rvv.c new file mode 100644 index 000000000..5f55bc349 --- /dev/null +++ b/kernel/riscv64/gemm_ncopy_2_rvv.c @@ -0,0 +1,92 @@ +/*************************************************************************** +Copyright (c) 2022, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" + +#if !defined(DOUBLE) +#define VSETVL(n) vsetvl_e32m4(n) +#define FLOAT_V_T vfloat32m4_t +#define VLEV_FLOAT vle32_v_f32m4 +#define VSEV_FLOAT vse32_v_f32m4 +#define VSSEG2_FLOAT vsseg2e32_v_f32m4 +#else +#define VSETVL(n) vsetvl_e64m4(n) +#define FLOAT_V_T vfloat64m4_t +#define VLEV_FLOAT vle64_v_f64m4 +#define VSEV_FLOAT vse64_v_f64m4 +#define VSSEG2_FLOAT vsseg2e64_v_f64m4 +#endif + +// Optimizes the implementation in ../generic/gemm_ncopy_2.c + +int CNAME(BLASLONG m, BLASLONG n, IFLOAT *a, BLASLONG lda, IFLOAT *b) +{ + BLASLONG i, j; + IFLOAT *a_offset, *a_offset1, *a_offset2; + IFLOAT *b_offset; + FLOAT_V_T v1, v2; + size_t vl; + + //fprintf(stderr, "gemm_ncopy_2 m=%ld n=%ld lda=%ld\n", m, n, lda); // KU + + a_offset = a; + b_offset = b; + + for(j = (n >> 1); j > 0; j--) { + + a_offset1 = a_offset; + a_offset2 = a_offset + lda; + a_offset += 2 * lda; + + for(i = m; i > 0; i -= vl) { + vl = VSETVL(i); + + v1 = VLEV_FLOAT(a_offset1, vl); + v2 = VLEV_FLOAT(a_offset2, vl); + VSSEG2_FLOAT(b_offset, v1, v2, vl); + + a_offset1 += vl; + a_offset2 += vl; + b_offset += vl*2; + } + } + + if (n & 1) { + + for(i = m; i > 0; i -= vl) { + vl = VSETVL(i); + + v1 = VLEV_FLOAT(a_offset, vl); + VSEV_FLOAT(b_offset, v1, vl); + + a_offset += vl; + b_offset += vl; + } + } + + return 0; +} diff --git a/kernel/riscv64/gemm_ncopy_4_rvv.c b/kernel/riscv64/gemm_ncopy_4_rvv.c new file mode 100644 index 000000000..4d4efe4c9 --- /dev/null +++ b/kernel/riscv64/gemm_ncopy_4_rvv.c @@ -0,0 +1,123 @@ +/*************************************************************************** +Copyright (c) 2022, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" + +#if !defined(DOUBLE) +#define VSETVL(n) vsetvl_e32m2(n) +#define FLOAT_V_T vfloat32m2_t +#define VLEV_FLOAT vle32_v_f32m2 +#define VSEV_FLOAT vse32_v_f32m2 +#define VSSEG2_FLOAT vsseg2e32_v_f32m2 +#define VSSEG4_FLOAT vsseg4e32_v_f32m2 +#else +#define VSETVL(n) vsetvl_e64m2(n) +#define FLOAT_V_T vfloat64m2_t +#define VLEV_FLOAT vle64_v_f64m2 +#define VSEV_FLOAT vse64_v_f64m2 +#define VSSEG2_FLOAT vsseg2e64_v_f64m2 +#define VSSEG4_FLOAT vsseg4e64_v_f64m2 +#endif + +// Optimizes the implementation in ../generic/gemm_ncopy_4.c + +int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, FLOAT *b) +{ + BLASLONG i, j; + + FLOAT *a_offset, *a_offset1, *a_offset2, *a_offset3, *a_offset4; + FLOAT *b_offset; + + FLOAT_V_T v1, v2, v3, v4; + size_t vl; + + //fprintf(stderr, "gemm_ncopy_4 m=%ld n=%ld lda=%ld\n", m, n, lda); + + a_offset = a; + b_offset = b; + + for(j = (n >> 2); j > 0; j--) { + a_offset1 = a_offset; + a_offset2 = a_offset1 + lda; + a_offset3 = a_offset2 + lda; + a_offset4 = a_offset3 + lda; + a_offset += 4 * lda; + + for(i = m; i > 0; i -= vl) { + vl = VSETVL(i); + + v1 = VLEV_FLOAT(a_offset1, vl); + v2 = VLEV_FLOAT(a_offset2, vl); + v3 = VLEV_FLOAT(a_offset3, vl); + v4 = VLEV_FLOAT(a_offset4, vl); + + VSSEG4_FLOAT(b_offset, v1, v2, v3, v4, vl); + + a_offset1 += vl; + a_offset2 += vl; + a_offset3 += vl; + a_offset4 += vl; + b_offset += vl*4; + } + } + + if (n & 2) { + a_offset1 = a_offset; + a_offset2 = a_offset1 + lda; + a_offset += 2 * lda; + + for(i = m; i > 0; i -= vl) { + vl = VSETVL(i); + + v1 = VLEV_FLOAT(a_offset1, vl); + v2 = VLEV_FLOAT(a_offset2, vl); + + VSSEG2_FLOAT(b_offset, v1, v2, vl); + + a_offset1 += vl; + a_offset2 += vl; + b_offset += vl*2; + } + } + + if (n & 1) { + a_offset1 = a_offset; + + for(i = m; i > 0; i -= vl) { + vl = VSETVL(i); + + v1 = VLEV_FLOAT(a_offset1, vl); + + VSEV_FLOAT(b_offset, v1, vl); + + a_offset1 += vl; + b_offset += vl; + } + } + + return 0; +} diff --git a/kernel/riscv64/gemm_ncopy_8_rvv.c b/kernel/riscv64/gemm_ncopy_8_rvv.c new file mode 100644 index 000000000..525b223c2 --- /dev/null +++ b/kernel/riscv64/gemm_ncopy_8_rvv.c @@ -0,0 +1,164 @@ +/*************************************************************************** +Copyright (c) 2022, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" + +#if !defined(DOUBLE) +#define VSETVL(n) vsetvl_e32m1(n) +#define FLOAT_V_T vfloat32m1_t +#define VLEV_FLOAT vle32_v_f32m1 +#define VSEV_FLOAT vse32_v_f32m1 +#define VSSEG2_FLOAT vsseg2e32_v_f32m1 +#define VSSEG4_FLOAT vsseg4e32_v_f32m1 +#define VSSEG8_FLOAT vsseg8e32_v_f32m1 +#else +#define VSETVL(n) vsetvl_e64m1(n) +#define FLOAT_V_T vfloat64m1_t +#define VLEV_FLOAT vle64_v_f64m1 +#define VSEV_FLOAT vse64_v_f64m1 +#define VSSEG2_FLOAT vsseg2e64_v_f64m1 +#define VSSEG4_FLOAT vsseg4e64_v_f64m1 +#define VSSEG8_FLOAT vsseg8e64_v_f64m1 +#endif + +// Optimizes the implementation in ../generic/gemm_ncopy_8.c + +int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, FLOAT *b) +{ + BLASLONG i, j; + + FLOAT *a_offset; + FLOAT *a_offset1, *a_offset2, *a_offset3, *a_offset4; + FLOAT *a_offset5, *a_offset6, *a_offset7, *a_offset8; + FLOAT *b_offset; + + FLOAT_V_T v1, v2, v3, v4, v5, v6, v7, v8; + size_t vl; + + //fprintf(stderr, "gemm_ncopy_8 m=%ld n=%ld lda=%ld\n", m, n, lda); + + a_offset = a; + b_offset = b; + + for(j = (n >> 3); j > 0; j--) { + a_offset1 = a_offset; + a_offset2 = a_offset1 + lda; + a_offset3 = a_offset2 + lda; + a_offset4 = a_offset3 + lda; + a_offset5 = a_offset4 + lda; + a_offset6 = a_offset5 + lda; + a_offset7 = a_offset6 + lda; + a_offset8 = a_offset7 + lda; + a_offset += 8 * lda; + + for(i = m; i > 0; i -= vl) { + vl = VSETVL(i); + + v1 = VLEV_FLOAT(a_offset1, vl); + v2 = VLEV_FLOAT(a_offset2, vl); + v3 = VLEV_FLOAT(a_offset3, vl); + v4 = VLEV_FLOAT(a_offset4, vl); + v5 = VLEV_FLOAT(a_offset5, vl); + v6 = VLEV_FLOAT(a_offset6, vl); + v7 = VLEV_FLOAT(a_offset7, vl); + v8 = VLEV_FLOAT(a_offset8, vl); + + VSSEG8_FLOAT(b_offset, v1, v2, v3, v4, v5, v6, v7, v8, vl); + + a_offset1 += vl; + a_offset2 += vl; + a_offset3 += vl; + a_offset4 += vl; + a_offset5 += vl; + a_offset6 += vl; + a_offset7 += vl; + a_offset8 += vl; + b_offset += vl*8; + } + } + + if (n & 4) { + a_offset1 = a_offset; + a_offset2 = a_offset1 + lda; + a_offset3 = a_offset2 + lda; + a_offset4 = a_offset3 + lda; + a_offset += 4 * lda; + + for(i = m; i > 0; i -= vl) { + vl = VSETVL(i); + + v1 = VLEV_FLOAT(a_offset1, vl); + v2 = VLEV_FLOAT(a_offset2, vl); + v3 = VLEV_FLOAT(a_offset3, vl); + v4 = VLEV_FLOAT(a_offset4, vl); + + VSSEG4_FLOAT(b_offset, v1, v2, v3, v4, vl); + + a_offset1 += vl; + a_offset2 += vl; + a_offset3 += vl; + a_offset4 += vl; + b_offset += vl*4; + } + } + + if (n & 2) { + a_offset1 = a_offset; + a_offset2 = a_offset1 + lda; + a_offset += 2 * lda; + + for(i = m; i > 0; i -= vl) { + vl = VSETVL(i); + + v1 = VLEV_FLOAT(a_offset1, vl); + v2 = VLEV_FLOAT(a_offset2, vl); + + VSSEG2_FLOAT(b_offset, v1, v2, vl); + + a_offset1 += vl; + a_offset2 += vl; + b_offset += vl*2; + } + } + + if (n & 1) { + a_offset1 = a_offset; + + for(i = m; i > 0; i -= vl) { + vl = VSETVL(i); + + v1 = VLEV_FLOAT(a_offset1, vl); + + VSEV_FLOAT(b_offset, v1, vl); + + a_offset1 += vl; + b_offset += vl; + } + } + + return 0; +} diff --git a/kernel/riscv64/gemm_ncopy_rvv_v1.c b/kernel/riscv64/gemm_ncopy_rvv_v1.c new file mode 100644 index 000000000..2c5230752 --- /dev/null +++ b/kernel/riscv64/gemm_ncopy_rvv_v1.c @@ -0,0 +1,76 @@ +/*************************************************************************** +Copyright (c) 2022, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" + +#if !defined(DOUBLE) +#define VSETVL(n) vsetvl_e32m2(n) +#define FLOAT_V_T vfloat32m2_t +#define VLEV_FLOAT vle32_v_f32m2 +#define VLSEV_FLOAT vlse32_v_f32m2 +#define VSEV_FLOAT vse32_v_f32m2 +#else +#define VSETVL(n) vsetvl_e64m2(n) +#define FLOAT_V_T vfloat64m2_t +#define VLEV_FLOAT vle64_v_f64m2 +#define VLSEV_FLOAT vlse64_v_f64m2 +#define VSEV_FLOAT vse64_v_f64m2 +#endif + +int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, FLOAT *b) +{ + BLASLONG i, j; + + FLOAT *a_offset; + FLOAT *a_offset1; + FLOAT *b_offset; + + FLOAT_V_T v0; + size_t vl; + + //fprintf(stderr, "%s, m=%ld n=%ld lda=%ld\n", __FUNCTION__, m, n, lda); + + a_offset = a; + b_offset = b; + + for(j = n; j > 0; j -= vl) { + vl = VSETVL(j); + + a_offset1 = a_offset; + a_offset += vl * lda; + + for(i = m; i > 0; i--) { + v0 = VLSEV_FLOAT(a_offset1, lda * sizeof(FLOAT), vl); + VSEV_FLOAT(b_offset, v0, vl); + + a_offset1++; + b_offset += vl; + } + } + + return 0; +} diff --git a/kernel/riscv64/gemm_tcopy_2_rvv.c b/kernel/riscv64/gemm_tcopy_2_rvv.c new file mode 100644 index 000000000..963e1be69 --- /dev/null +++ b/kernel/riscv64/gemm_tcopy_2_rvv.c @@ -0,0 +1,108 @@ +/*************************************************************************** +Copyright (c) 2022, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" + +#if !defined(DOUBLE) +#define VSETVL(n) vsetvl_e32m2(n) +#define FLOAT_V_T vfloat32m2_t +#define VLSEG2_FLOAT vlseg2e32_v_f32m2 +#define VSSSEG2_FLOAT vssseg2e32_v_f32m2 +#define VSSSEG4_FLOAT vssseg4e32_v_f32m2 +#else +#define VSETVL(n) vsetvl_e64m2(n) +#define FLOAT_V_T vfloat64m2_t +#define VLSEG2_FLOAT vlseg2e64_v_f64m2 +#define VSSSEG2_FLOAT vssseg2e64_v_f64m2 +#define VSSSEG4_FLOAT vssseg4e64_v_f64m2 +#endif + +// Optimizes the implementation in ../generic/gemm_tcopy_2.c + +int CNAME(BLASLONG m, BLASLONG n, IFLOAT *a, BLASLONG lda, IFLOAT *b) +{ + BLASLONG i, j; + IFLOAT *a_offset, *a_offset1, *a_offset2; + IFLOAT *b_offset, *b_offset1, *b_offset2; + FLOAT_V_T v1a, v1b, v2a, v2b; + size_t vl; + + //fprintf(stderr, "gemm_tcopy_2 m=%ld n=%ld lda=%ld\n", m, n, lda); // KU + + a_offset = a; + b_offset = b; + b_offset2 = b + m * (n & ~1); + + for(i = (m >> 1); i > 0; i--) { + + a_offset1 = a_offset; + a_offset2 = a_offset + lda; + a_offset += 2 * lda; + + b_offset1 = b_offset; + b_offset += 4; + + for(j = (n >> 1); j > 0; j -= vl) { + vl = VSETVL(j); + + VLSEG2_FLOAT(&v1a, &v1b, a_offset1, vl); + VLSEG2_FLOAT(&v2a, &v2b, a_offset2, vl); + + VSSSEG4_FLOAT(b_offset1, m*2*sizeof(FLOAT), v1a, v1b, v2a, v2b, vl); + + a_offset1 += vl * 2; + a_offset2 += vl * 2; + b_offset1 += vl * m * 2; + } + + if (n & 1) { + *(b_offset2 + 0) = *(a_offset1 + 0); + *(b_offset2 + 1) = *(a_offset2 + 0); + b_offset2 += 2; + } + } + + if (m & 1) { + + for(j = (n >> 1); j > 0; j -= vl) { + vl = VSETVL(j); + + VLSEG2_FLOAT(&v1a, &v1b, a_offset, vl); + + VSSSEG2_FLOAT(b_offset, m*2*sizeof(FLOAT), v1a, v1b, vl); + + a_offset += vl * 2; + b_offset += vl * m * 2; + } + + if (n & 1){ + *(b_offset2 + 0) = *(a_offset + 0); + } + } + + return 0; +} diff --git a/kernel/riscv64/gemm_tcopy_4_rvv.c b/kernel/riscv64/gemm_tcopy_4_rvv.c new file mode 100644 index 000000000..ac9974b24 --- /dev/null +++ b/kernel/riscv64/gemm_tcopy_4_rvv.c @@ -0,0 +1,236 @@ +/*************************************************************************** +Copyright (c) 2022, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" + +#if !defined(DOUBLE) +#define VSETVL(n) vsetvl_e32m2(n) +#define FLOAT_V_T vfloat32m2_t +#define VLSEG2_FLOAT vlseg2e32_v_f32m2 +#define VSSSEG2_FLOAT vssseg2e32_v_f32m2 +#define VSSSEG4_FLOAT vssseg4e32_v_f32m2 +#else +#define VSETVL(n) vsetvl_e64m2(n) +#define FLOAT_V_T vfloat64m2_t +#define VLSEG2_FLOAT vlseg2e64_v_f64m2 +#define VSSSEG2_FLOAT vssseg2e64_v_f64m2 +#define VSSSEG4_FLOAT vssseg4e64_v_f64m2 +#endif + +// Optimizes the implementation in ../generic/gemm_tcopy_4.c + +int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, FLOAT *b) +{ + BLASLONG i, j; + + FLOAT *a_offset, *a_offset1, *a_offset2, *a_offset3, *a_offset4; + FLOAT *b_offset, *b_offset1, *b_offset2, *b_offset3; + FLOAT ctemp1, ctemp2, ctemp3, ctemp4; + FLOAT ctemp5, ctemp6, ctemp7, ctemp8; + FLOAT ctemp9, ctemp10, ctemp11, ctemp12; + FLOAT ctemp13, ctemp14, ctemp15, ctemp16; + + //fprintf(stderr, "gemm_tcopy_4 m=%ld n=%ld lda=%ld\n", m, n, lda); + + a_offset = a; + b_offset = b; + + b_offset2 = b + m * (n & ~3); + b_offset3 = b + m * (n & ~1); + + for(j = (m >> 2); j > 0; j--) { + a_offset1 = a_offset; + a_offset2 = a_offset1 + lda; + a_offset3 = a_offset2 + lda; + a_offset4 = a_offset3 + lda; + a_offset += 4 * lda; + + b_offset1 = b_offset; + b_offset += 16; + + for(i = (n >> 2); i > 0; i--) { + v1 = VLEV_FLOAT(a_offset1, 4); + v2 = VLEV_FLOAT(a_offset2, 4); + v3 = VLEV_FLOAT(a_offset3, 4); + v4 = VLEV_FLOAT(a_offset4, 4); + + a_offset1 += 4; + a_offset2 += 4; + a_offset3 += 4; + a_offset4 += 4; + + VSEV_FLOAT(b_offset1, v1, 4); + VSEV_FLOAT(b_offset2+4, v2, 4); + VSEV_FLOAT(b_offset2+8, v3, 4); + VSEV_FLOAT(b_offset2+12, v4, 4); + + b_offset1 += m * 4; + } + + if (n & 2) { + v1 = VLEV_FLOAT(a_offset1, 2); + v2 = VLEV_FLOAT(a_offset2, 2); + v3 = VLEV_FLOAT(a_offset3, 2); + v4 = VLEV_FLOAT(a_offset4, 2); + + a_offset1 += 2; + a_offset2 += 2; + a_offset3 += 2; + a_offset4 += 2; + + VSEV_FLOAT(b_offset2, v1, 2); + VSEV_FLOAT(b_offset2+2, v2, 2); + VSEV_FLOAT(b_offset2+4, v3, 2); + VSEV_FLOAT(b_offset2+6, v4, 2); + + b_offset2 += 8; + } + + if (n & 1) { + v1 = VLEV_FLOAT(a_offset1, 1); + v2 = VLEV_FLOAT(a_offset2, 1); + v3 = VLEV_FLOAT(a_offset3, 1); + v4 = VLEV_FLOAT(a_offset4, 1); + + VSSEG4_FLOAT(b_offset3, v1, v2, v3, v4, 1); + + b_offset3 += 4; + } + + } + +// TODO cleanup + + if (m & 2){ + a_offset1 = a_offset; + a_offset2 = a_offset1 + lda; + a_offset += 2 * lda; + + b_offset1 = b_offset; + b_offset += 8; + + i = (n >> 2); + if (i > 0){ + do{ + ctemp1 = *(a_offset1 + 0); + ctemp2 = *(a_offset1 + 1); + ctemp3 = *(a_offset1 + 2); + ctemp4 = *(a_offset1 + 3); + + ctemp5 = *(a_offset2 + 0); + ctemp6 = *(a_offset2 + 1); + ctemp7 = *(a_offset2 + 2); + ctemp8 = *(a_offset2 + 3); + + a_offset1 += 4; + a_offset2 += 4; + + *(b_offset1 + 0) = ctemp1; + *(b_offset1 + 1) = ctemp2; + *(b_offset1 + 2) = ctemp3; + *(b_offset1 + 3) = ctemp4; + + *(b_offset1 + 4) = ctemp5; + *(b_offset1 + 5) = ctemp6; + *(b_offset1 + 6) = ctemp7; + *(b_offset1 + 7) = ctemp8; + + b_offset1 += m * 4; + i --; + }while(i > 0); + } + + if (n & 2) { + ctemp1 = *(a_offset1 + 0); + ctemp2 = *(a_offset1 + 1); + + ctemp3 = *(a_offset2 + 0); + ctemp4 = *(a_offset2 + 1); + + a_offset1 += 2; + a_offset2 += 2; + + *(b_offset2 + 0) = ctemp1; + *(b_offset2 + 1) = ctemp2; + *(b_offset2 + 2) = ctemp3; + *(b_offset2 + 3) = ctemp4; + + b_offset2 += 4; + } + + if (n & 1) { + ctemp1 = *(a_offset1 + 0); + ctemp2 = *(a_offset2 + 0); + + *(b_offset3 + 0) = ctemp1; + *(b_offset3 + 1) = ctemp2; + b_offset3 += 2; + } + } + + if (m & 1){ + a_offset1 = a_offset; + b_offset1 = b_offset; + + i = (n >> 2); + if (i > 0){ + do{ + ctemp1 = *(a_offset1 + 0); + ctemp2 = *(a_offset1 + 1); + ctemp3 = *(a_offset1 + 2); + ctemp4 = *(a_offset1 + 3); + + a_offset1 += 4; + + *(b_offset1 + 0) = ctemp1; + *(b_offset1 + 1) = ctemp2; + *(b_offset1 + 2) = ctemp3; + *(b_offset1 + 3) = ctemp4; + + b_offset1 += 4 * m; + + i --; + }while(i > 0); + } + + if (n & 2) { + ctemp1 = *(a_offset1 + 0); + ctemp2 = *(a_offset1 + 1); + a_offset1 += 2; + + *(b_offset2 + 0) = ctemp1; + *(b_offset2 + 1) = ctemp2; + } + + if (n & 1) { + ctemp1 = *(a_offset1 + 0); + *(b_offset3 + 0) = ctemp1; + } + } + + return 0; +} diff --git a/kernel/riscv64/gemm_tcopy_8_rvv.c b/kernel/riscv64/gemm_tcopy_8_rvv.c new file mode 100644 index 000000000..81c1f962b --- /dev/null +++ b/kernel/riscv64/gemm_tcopy_8_rvv.c @@ -0,0 +1,264 @@ +/*************************************************************************** +Copyright (c) 2022, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" + +#if !defined(DOUBLE) +#define VSETVL(n) vsetvl_e32m1(n) +#define FLOAT_V_T vfloat32m1_t +#define VLEV_FLOAT vle32_v_f32m1 +#define VLSEV_FLOAT vlse32_v_f32m1 +#define VSEV_FLOAT vse32_v_f32m1 +#define VLSSEG2_FLOAT vlsseg2e32_v_f32m1 +#define VSSEG2_FLOAT vsseg2e32_v_f32m1 +#define VLSSEG4_FLOAT vlsseg4e32_v_f32m1 +#define VSSEG4_FLOAT vsseg4e32_v_f32m1 +#define VLSSEG8_FLOAT vlsseg8e32_v_f32m1 +#define VSSEG8_FLOAT vsseg8e32_v_f32m1 +#else +#define VSETVL(n) vsetvl_e64m1(n) +#define FLOAT_V_T vfloat64m1_t +#define VLEV_FLOAT vle64_v_f64m1 +#define VLSEV_FLOAT vlse64_v_f64m1 +#define VSEV_FLOAT vse64_v_f64m1 +#define VLSSEG2_FLOAT vlsseg2e64_v_f64m1 +#define VSSEG2_FLOAT vsseg2e64_v_f64m1 +#define VLSSEG4_FLOAT vlsseg4e64_v_f64m1 +#define VSSEG4_FLOAT vsseg4e64_v_f64m1 +#define VLSSEG8_FLOAT vlsseg8e64_v_f64m1 +#define VSSEG8_FLOAT vsseg8e64_v_f64m1 +#endif + +int CNAME(BLASLONG m, BLASLONG n, IFLOAT *a, BLASLONG lda, IFLOAT *b) +{ + BLASLONG i, j; + + IFLOAT *aoffset; + IFLOAT *aoffset1; + + IFLOAT *boffset, *boffset1, *boffset2, *boffset3, *boffset4; + + FLOAT_V_T v0, v1, v2, v3, v4, v5, v6, v7; + + // fprintf(stderr, "gemm_tcopy_8 m=%ld n=%ld lda=%ld\n", m, n, lda); + + aoffset = a; + boffset = b; + boffset2 = b + m * (n & ~7); + boffset3 = b + m * (n & ~3); + boffset4 = b + m * (n & ~1); + + for(j = (m >> 3); j > 0; j--) { + + aoffset1 = aoffset; + aoffset += 8 * lda; + + boffset1 = boffset; + boffset += 64; + + for(i = (n >> 3); i > 0; i--) { + size_t vl = 8; + + VLSSEG8_FLOAT(&v0, &v1, &v2, &v3, &v4, &v5, &v6, &v7, aoffset1, lda * sizeof(FLOAT), vl); + VSSEG8_FLOAT(boffset1, v0, v1, v2, v3, v4, v5, v6, v7, vl); + + aoffset1 += 8; + boffset1 += m * 8; + } + + if (n & 4) { + size_t vl = 8; + + VLSSEG4_FLOAT(&v0, &v1, &v2, &v3, aoffset1, lda * sizeof(FLOAT), vl); + VSSEG4_FLOAT(boffset2, v0, v1, v2, v3, vl); + + aoffset1 += 4; + boffset2 += 32; + } + + if (n & 2) { + size_t vl = 8; + + VLSSEG2_FLOAT(&v0, &v1, aoffset1, lda * sizeof(FLOAT), vl); + VSSEG2_FLOAT(boffset3, v0, v1, vl); + + aoffset1 += 2; + boffset3 += 16; + } + + if (n & 1) { + size_t vl = 8; + + v0 = VLSEV_FLOAT(aoffset1, lda * sizeof(FLOAT), vl); + VSEV_FLOAT(boffset4, v0, vl); + + aoffset1 += 1; + boffset4 += 8; + } + + } + + if (m & 4) { + + aoffset1 = aoffset; + aoffset += 4 * lda; + + boffset1 = boffset; + boffset += 32; + + for(i = (n >> 3); i > 0; i--) { + size_t vl = 4; + + VLSSEG8_FLOAT(&v0, &v1, &v2, &v3, &v4, &v5, &v6, &v7, aoffset1, lda * sizeof(FLOAT), vl); + VSSEG8_FLOAT(boffset1, v0, v1, v2, v3, v4, v5, v6, v7, vl); + + aoffset1 += 8; + boffset1 += m * 8; + } + + if (n & 4) { + size_t vl = 4; + + VLSSEG4_FLOAT(&v0, &v1, &v2, &v3, aoffset1, lda * sizeof(FLOAT), vl); + VSSEG4_FLOAT(boffset2, v0, v1, v2, v3, vl); + + aoffset1 += 4; + boffset2 += 16; + } + + if (n & 2) { + size_t vl = 4; + + VLSSEG2_FLOAT(&v0, &v1, aoffset1, lda * sizeof(FLOAT), vl); + VSSEG2_FLOAT(boffset3, v0, v1, vl); + + aoffset1 += 2; + boffset3 += 8; + } + + if (n & 1) { + size_t vl = 4; + + v0 = VLSEV_FLOAT(aoffset1, lda * sizeof(FLOAT), vl); + VSEV_FLOAT(boffset4, v0, vl); + + aoffset1 += 1; + boffset4 += 4; + } + } + + if (m & 2) { + aoffset1 = aoffset; + aoffset += 2 * lda; + + boffset1 = boffset; + boffset += 16; + + for(i = (n >> 3); i > 0; i--) { + size_t vl = 2; + + VLSSEG8_FLOAT(&v0, &v1, &v2, &v3, &v4, &v5, &v6, &v7, aoffset1, lda * sizeof(FLOAT), vl); + VSSEG8_FLOAT(boffset1, v0, v1, v2, v3, v4, v5, v6, v7, vl); + + aoffset1 += 8; + boffset1 += m * 8; + } + + if (n & 4) { + size_t vl = 2; + + VLSSEG4_FLOAT(&v0, &v1, &v2, &v3, aoffset1, lda * sizeof(FLOAT), vl); + VSSEG4_FLOAT(boffset2, v0, v1, v2, v3, vl); + + aoffset1 += 4; + boffset2 += 8; + } + + if (n & 2) { + size_t vl = 2; + + VLSSEG2_FLOAT(&v0, &v1, aoffset1, lda * sizeof(FLOAT), vl); + VSSEG2_FLOAT(boffset3, v0, v1, vl); + + aoffset1 += 2; + boffset3 += 4; + } + + if (n & 1) { + size_t vl = 2; + + v0 = VLSEV_FLOAT(aoffset1, lda * sizeof(FLOAT), vl); + VSEV_FLOAT(boffset4, v0, vl); + + aoffset1 += 1; + boffset4 += 2; + } + } + + if (m & 1) { + aoffset1 = aoffset; + boffset1 = boffset; + + for(i = (n >> 3); i > 0; i--) { + size_t vl = 8; + + v0 = VLEV_FLOAT(aoffset1, vl); + VSEV_FLOAT(boffset1, v0, vl); + + aoffset1 += 8; + boffset1 += 8 * m; + } + + if (n & 4) { + size_t vl = 4; + + v0 = VLEV_FLOAT(aoffset1, vl); + VSEV_FLOAT(boffset2, v0, vl); + + aoffset1 += 4; + //boffset2 += 4; + } + + if (n & 2) { + size_t vl = 2; + + v0 = VLEV_FLOAT(aoffset1, vl); + VSEV_FLOAT(boffset3, v0, vl); + + aoffset1 += 2; + // boffset3 += 2; + } + + if (n & 1) { + *(boffset4) = *(aoffset1); + // aoffset1 ++; + // boffset4 ++; + } + } + + return 0; +} diff --git a/kernel/riscv64/gemm_tcopy_rvv_v1.c b/kernel/riscv64/gemm_tcopy_rvv_v1.c new file mode 100644 index 000000000..a291b70b8 --- /dev/null +++ b/kernel/riscv64/gemm_tcopy_rvv_v1.c @@ -0,0 +1,74 @@ +/*************************************************************************** +Copyright (c) 2022, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" + +#if !defined(DOUBLE) +#define VSETVL(n) vsetvl_e32m2(n) +#define FLOAT_V_T vfloat32m2_t +#define VLEV_FLOAT vle32_v_f32m2 +#define VSEV_FLOAT vse32_v_f32m2 +#else +#define VSETVL(n) vsetvl_e64m2(n) +#define FLOAT_V_T vfloat64m2_t +#define VLEV_FLOAT vle64_v_f64m2 +#define VSEV_FLOAT vse64_v_f64m2 +#endif + +int CNAME(BLASLONG m, BLASLONG n, IFLOAT *a, BLASLONG lda, IFLOAT *b) +{ + BLASLONG i, j; + + IFLOAT *aoffset; + IFLOAT *aoffset1; + IFLOAT *boffset; + + FLOAT_V_T v0; + size_t vl; + + //fprintf(stderr, "%s, m=%ld n=%ld lda=%ld\n", __FUNCTION__, m, n, lda); + + aoffset = a; + boffset = b; + + for(j = n; j > 0; j -= vl) { + vl = VSETVL(j); + + aoffset1 = aoffset; + aoffset += vl; + + for(i = m; i > 0; i--) { + v0 = VLEV_FLOAT(aoffset1, vl); + VSEV_FLOAT(boffset, v0, vl); + + aoffset1 += lda; + boffset += vl; + } + } + + return 0; +} diff --git a/kernel/riscv64/gemmkernel_2x2_rvv.c b/kernel/riscv64/gemmkernel_2x2_rvv.c new file mode 100644 index 000000000..ec8961ced --- /dev/null +++ b/kernel/riscv64/gemmkernel_2x2_rvv.c @@ -0,0 +1,214 @@ +/*************************************************************************** +Copyright (c) 2022, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" + +#if !defined(DOUBLE) +#define VSETVL(n) vsetvl_e32m4(n) +#define VSETVL_MAX vsetvlmax_e32m4() +#define VSETVL_MAX_M1 vsetvlmax_e32m1() +#define FLOAT_V_T vfloat32m4_t +#define FLOAT_V_T_M1 vfloat32m1_t +#define VLEV_FLOAT vle32_v_f32m4 +#define VLSEG2_FLOAT vlseg2e32_v_f32m4 +#define VFMVVF_FLOAT vfmv_v_f_f32m4 +#define VFMACCVF_FLOAT vfmacc_vf_f32m4 +#define VFMACCVV_FLOAT vfmacc_vv_f32m4 +#define VFREDSUMVS_FLOAT vfredusum_vs_f32m4_f32m1 +#define VFMVVF_FLOAT_M1 vfmv_v_f_f32m1 +#define VFMVFS_FLOAT_M1 vfmv_f_s_f32m1_f32 +#else +#define VSETVL(n) vsetvl_e64m4(n) +#define VSETVL_MAX vsetvlmax_e64m4() +#define VSETVL_MAX_M1 vsetvlmax_e64m1() +#define FLOAT_V_T vfloat64m4_t +#define FLOAT_V_T_M1 vfloat64m1_t +#define VLEV_FLOAT vle64_v_f64m4 +#define VLSEG2_FLOAT vlseg2e64_v_f64m4 +#define VFMVVF_FLOAT vfmv_v_f_f64m4 +#define VFMACCVF_FLOAT vfmacc_vf_f64m4 +#define VFMACCVV_FLOAT vfmacc_vv_f64m4 +#define VFREDSUMVS_FLOAT vfredusum_vs_f64m4_f64m1 +#define VFMVVF_FLOAT_M1 vfmv_v_f_f64m1 +#define VFMVFS_FLOAT_M1 vfmv_f_s_f64m1_f64 +#endif + +// Optimizes the implementation in ../generic/gemm_kernel_2x2.c + +int CNAME(BLASLONG bm, BLASLONG bn, BLASLONG bk, FLOAT alpha, IFLOAT* ba, IFLOAT* bb, FLOAT* C, BLASLONG ldc +#ifdef TRMMKERNEL + ,BLASLONG offset +#endif + ) +{ + BLASLONG i,j,k; + FLOAT *C0,*C1; + IFLOAT *ptrba,*ptrbb; + + //fprintf(stderr, "gemm_kernel_2x2 bm=%ld bn=%ld bk=%ld alpha=%f ldc=%ld\n", bm, bn, bk, alpha, ldc); + + FLOAT_V_T va0, va1, vb0, vb1; + FLOAT_V_T vres0, vres1, vres2, vres3; + FLOAT_V_T_M1 vsum0, vsum1, vsum2, vsum3; + FLOAT_V_T_M1 v_z0; + + v_z0 = VFMVVF_FLOAT_M1(0, VSETVL_MAX_M1); + size_t vlmax = VSETVL_MAX; + size_t vl; + + for (j = bn/2; j > 0; j--) { + C0 = C; + C1 = C0 + ldc; + ptrba = ba; + + for (i = bm/2; i > 0; i--) { + ptrbb = bb; + + vres0 = VFMVVF_FLOAT(0.0, vlmax); + vres1 = VFMVVF_FLOAT(0.0, vlmax); + vres2 = VFMVVF_FLOAT(0.0, vlmax); + vres3 = VFMVVF_FLOAT(0.0, vlmax); + + for (k = bk; k > 0; k -= vl) { + vl = VSETVL(k); + + VLSEG2_FLOAT(&va0, &va1, ptrba, vl); + VLSEG2_FLOAT(&vb0, &vb1, ptrbb, vl); + + vres0 = VFMACCVV_FLOAT(vres0, va0, vb0, vl); + vres1 = VFMACCVV_FLOAT(vres1, va1, vb0, vl); + vres2 = VFMACCVV_FLOAT(vres2, va0, vb1, vl); + vres3 = VFMACCVV_FLOAT(vres3, va1, vb1, vl); + + ptrba += vl*2; + ptrbb += vl*2; + } + + vsum0 = VFREDSUMVS_FLOAT(vsum0, vres0, v_z0, vlmax); + vsum1 = VFREDSUMVS_FLOAT(vsum1, vres1, v_z0, vlmax); + vsum2 = VFREDSUMVS_FLOAT(vsum2, vres2, v_z0, vlmax); + vsum3 = VFREDSUMVS_FLOAT(vsum3, vres3, v_z0, vlmax); + C0[0] += alpha * VFMVFS_FLOAT_M1(vsum0); + C0[1] += alpha * VFMVFS_FLOAT_M1(vsum1); + C1[0] += alpha * VFMVFS_FLOAT_M1(vsum2); + C1[1] += alpha * VFMVFS_FLOAT_M1(vsum3); + + C0 += 2; + C1 += 2; + } + + if(bm & 1) { + ptrbb = bb; + + vres0 = VFMVVF_FLOAT(0.0, vlmax); + vres1 = VFMVVF_FLOAT(0.0, vlmax); + + for (k = bk; k > 0; k -= vl) { + vl = VSETVL(k); + + va0 = VLEV_FLOAT(ptrba, vl); + VLSEG2_FLOAT(&vb0, &vb1, ptrbb, vl); + + vres0 = VFMACCVV_FLOAT(vres0, va0, vb0, vl); + vres1 = VFMACCVV_FLOAT(vres1, va0, vb1, vl); + + ptrba += vl; + ptrbb += vl*2; + } + + vsum0 = VFREDSUMVS_FLOAT(vsum0, vres0, v_z0, vlmax); + vsum1 = VFREDSUMVS_FLOAT(vsum1, vres1, v_z0, vlmax); + C0[0] += alpha * VFMVFS_FLOAT_M1(vsum0); + C1[0] += alpha * VFMVFS_FLOAT_M1(vsum1); + + C0 += 1; + C1 += 1; + } + + bb += (bk<<1); + C += (ldc<<1); + } + + if(bn & 1) { + C0 = C; + ptrba = ba; + for (i = bm/2; i > 0; i--) { + ptrbb = bb; + + vres0 = VFMVVF_FLOAT(0.0, vlmax); + vres1 = VFMVVF_FLOAT(0.0, vlmax); + + for (k = bk; k > 0; k -= vl) { + vl = VSETVL(k); + + VLSEG2_FLOAT(&va0, &va1, ptrba, vl); + vb0 = VLEV_FLOAT(ptrbb, vl); + + vres0 = VFMACCVV_FLOAT(vres0, va0, vb0, vl); + vres1 = VFMACCVV_FLOAT(vres1, va1, vb0, vl); + + ptrba += vl*2; + ptrbb += vl; + } + + vsum0 = VFREDSUMVS_FLOAT(vsum0, vres0, v_z0, vlmax); + vsum1 = VFREDSUMVS_FLOAT(vsum1, vres1, v_z0, vlmax); + C0[0] += alpha * VFMVFS_FLOAT_M1(vsum0); + C0[1] += alpha * VFMVFS_FLOAT_M1(vsum1); + + C0 += 2; + } + + if(bm & 1) { + ptrbb = bb; + + vres0 = VFMVVF_FLOAT(0.0, vlmax); + + for (k = bk; k > 0; k -= vl) { + vl = VSETVL(k); + + va0 = VLEV_FLOAT(ptrba, vl); + vb0 = VLEV_FLOAT(ptrbb, vl); + + vres0 = VFMACCVV_FLOAT(vres0, va0, vb0, vl); + + ptrba += vl; + ptrbb += vl; + } + + vsum0 = VFREDSUMVS_FLOAT(vsum0, vres0, v_z0, vlmax); + C0[0] += alpha * VFMVFS_FLOAT_M1(vsum0); + + C0 += 1; + } + + bb += (bk<<0); + C += ldc; + } + + return 0; +} diff --git a/kernel/riscv64/gemmkernel_4x4_rvv.c b/kernel/riscv64/gemmkernel_4x4_rvv.c new file mode 100644 index 000000000..aa58bcc76 --- /dev/null +++ b/kernel/riscv64/gemmkernel_4x4_rvv.c @@ -0,0 +1,508 @@ +/*************************************************************************** +Copyright (c) 2022, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" + +#if !defined(DOUBLE) +#define VSETVL(n) vsetvl_e32m1(n) +#define VSETVL_MAX vsetvlmax_e32m1() +#define VSETVL_MAX_M1 vsetvlmax_e32m1() +#define FLOAT_V_T vfloat32m1_t +#define FLOAT_V_T_M1 vfloat32m1_t +#define VLEV_FLOAT vle32_v_f32m1 +#define VLSEG2_FLOAT vlseg2e32_v_f32m1 +#define VLSEG4_FLOAT vlseg4e32_v_f32m1 +#define VFMVVF_FLOAT vfmv_v_f_f32m1 +#define VFMACCVF_FLOAT vfmacc_vf_f32m1 +#define VFMACCVV_FLOAT vfmacc_vv_f32m1 +#define VFREDSUMVS_FLOAT vfredusum_vs_f32m1_f32m1 +#define VFMVVF_FLOAT_M1 vfmv_v_f_f32m1 +#define VFMVFS_FLOAT_M1 vfmv_f_s_f32m1_f32 +#else +#define VSETVL(n) vsetvl_e64m1(n) +#define VSETVL_MAX vsetvlmax_e64m1() +#define VSETVL_MAX_M1 vsetvlmax_e64m1() +#define FLOAT_V_T vfloat64m1_t +#define FLOAT_V_T_M1 vfloat64m1_t +#define VLEV_FLOAT vle64_v_f64m1 +#define VLSEG2_FLOAT vlseg2e64_v_f64m1 +#define VLSEG4_FLOAT vlseg4e64_v_f64m1 +#define VFMVVF_FLOAT vfmv_v_f_f64m1 +#define VFMACCVF_FLOAT vfmacc_vf_f64m1 +#define VFMACCVV_FLOAT vfmacc_vv_f64m1 +#define VFREDSUMVS_FLOAT vfredusum_vs_f64m1_f64m1 +#define VFMVVF_FLOAT_M1 vfmv_v_f_f64m1 +#define VFMVFS_FLOAT_M1 vfmv_f_s_f64m1_f64 +#endif + +// Optimizes the implementation in ../generic/gemm_kernel_2x2.c + +int CNAME(BLASLONG bm, BLASLONG bn, BLASLONG bk, FLOAT alpha, IFLOAT* ba, IFLOAT* bb, FLOAT* C, BLASLONG ldc +#ifdef TRMMKERNEL + ,BLASLONG offset +#endif + ) +{ + BLASLONG i,j,k; + FLOAT *C0,*C1,*C2,*C3; + IFLOAT *ptrba,*ptrbb; + + //fprintf(stderr, "gemm_kernel_4x4 bm=%ld bn=%ld bk=%ld alpha=%f ldc=%ld\n", bm, bn, bk, alpha, ldc); // KU + + FLOAT_V_T va0, va1, va2, va3; + FLOAT_V_T vb0, vb1, vb2, vb3; + FLOAT_V_T vres0, vres1, vres2, vres3, vres4, vres5, vres6, vres7; + FLOAT_V_T vres8, vres9, vres10, vres11, vres12, vres13, vres14, vres15; + FLOAT_V_T_M1 vsum0, vsum1, vsum2, vsum3; + FLOAT_V_T_M1 v_z0; + + v_z0 = VFMVVF_FLOAT_M1(0, VSETVL_MAX_M1); + size_t vlmax = VSETVL_MAX; + size_t vl; + + for (j = bn/4; j > 0; j--) { + C0 = C; + C1 = C0 + ldc; + C2 = C1 + ldc; + C3 = C2 + ldc; + ptrba = ba; + + for (i = bm/4; i > 0; i--) { + ptrbb = bb; + + vres0 = VFMVVF_FLOAT(0.0, vlmax); + vres1 = VFMVVF_FLOAT(0.0, vlmax); + vres2 = VFMVVF_FLOAT(0.0, vlmax); + vres3 = VFMVVF_FLOAT(0.0, vlmax); + vres4 = VFMVVF_FLOAT(0.0, vlmax); + vres5 = VFMVVF_FLOAT(0.0, vlmax); + vres6 = VFMVVF_FLOAT(0.0, vlmax); + vres7 = VFMVVF_FLOAT(0.0, vlmax); + vres8 = VFMVVF_FLOAT(0.0, vlmax); + vres9 = VFMVVF_FLOAT(0.0, vlmax); + vres10 = VFMVVF_FLOAT(0.0, vlmax); + vres11 = VFMVVF_FLOAT(0.0, vlmax); + vres12 = VFMVVF_FLOAT(0.0, vlmax); + vres13 = VFMVVF_FLOAT(0.0, vlmax); + vres14 = VFMVVF_FLOAT(0.0, vlmax); + vres15 = VFMVVF_FLOAT(0.0, vlmax); + + for (k = bk; k > 0; k -= vl) { + vl = VSETVL(k); + + VLSEG4_FLOAT(&va0, &va1, &va2, &va3, ptrba, vl); + VLSEG4_FLOAT(&vb0, &vb1, &vb2, &vb3, ptrbb, vl); + + vres0 = VFMACCVV_FLOAT(vres0, va0, vb0, vl); + vres1 = VFMACCVV_FLOAT(vres1, va1, vb0, vl); + vres2 = VFMACCVV_FLOAT(vres2, va0, vb1, vl); + vres3 = VFMACCVV_FLOAT(vres3, va1, vb1, vl); + + vres4 = VFMACCVV_FLOAT(vres4, va0, vb2, vl); + vres5 = VFMACCVV_FLOAT(vres5, va1, vb2, vl); + vres6 = VFMACCVV_FLOAT(vres6, va0, vb3, vl); + vres7 = VFMACCVV_FLOAT(vres7, va1, vb3, vl); + + vres8 = VFMACCVV_FLOAT(vres8, va2, vb0, vl); + vres9 = VFMACCVV_FLOAT(vres9, va3, vb0, vl); + vres10 = VFMACCVV_FLOAT(vres10, va2, vb1, vl); + vres11 = VFMACCVV_FLOAT(vres11, va3, vb1, vl); + + vres12 = VFMACCVV_FLOAT(vres12, va2, vb2, vl); + vres13 = VFMACCVV_FLOAT(vres13, va3, vb2, vl); + vres14 = VFMACCVV_FLOAT(vres14, va2, vb3, vl); + vres15 = VFMACCVV_FLOAT(vres15, va3, vb3, vl); + + ptrba += vl*4; + ptrbb += vl*4; + } + + vsum0 = VFREDSUMVS_FLOAT(vsum0, vres0, v_z0, vlmax); + vsum1 = VFREDSUMVS_FLOAT(vsum1, vres1, v_z0, vlmax); + vsum2 = VFREDSUMVS_FLOAT(vsum2, vres8, v_z0, vlmax); + vsum3 = VFREDSUMVS_FLOAT(vsum3, vres9, v_z0, vlmax); + C0[0] += alpha * VFMVFS_FLOAT_M1(vsum0); + C0[1] += alpha * VFMVFS_FLOAT_M1(vsum1); + C0[2] += alpha * VFMVFS_FLOAT_M1(vsum2); + C0[3] += alpha * VFMVFS_FLOAT_M1(vsum3); + + vsum0 = VFREDSUMVS_FLOAT(vsum0, vres2, v_z0, vlmax); + vsum1 = VFREDSUMVS_FLOAT(vsum1, vres3, v_z0, vlmax); + vsum2 = VFREDSUMVS_FLOAT(vsum2, vres10, v_z0, vlmax); + vsum3 = VFREDSUMVS_FLOAT(vsum3, vres11, v_z0, vlmax); + C1[0] += alpha * VFMVFS_FLOAT_M1(vsum0); + C1[1] += alpha * VFMVFS_FLOAT_M1(vsum1); + C1[2] += alpha * VFMVFS_FLOAT_M1(vsum2); + C1[3] += alpha * VFMVFS_FLOAT_M1(vsum3); + + vsum0 = VFREDSUMVS_FLOAT(vsum0, vres4, v_z0, vlmax); + vsum1 = VFREDSUMVS_FLOAT(vsum1, vres5, v_z0, vlmax); + vsum2 = VFREDSUMVS_FLOAT(vsum2, vres12, v_z0, vlmax); + vsum3 = VFREDSUMVS_FLOAT(vsum3, vres13, v_z0, vlmax); + C2[0] += alpha * VFMVFS_FLOAT_M1(vsum0); + C2[1] += alpha * VFMVFS_FLOAT_M1(vsum1); + C2[2] += alpha * VFMVFS_FLOAT_M1(vsum2); + C2[3] += alpha * VFMVFS_FLOAT_M1(vsum3); + + vsum0 = VFREDSUMVS_FLOAT(vsum0, vres6, v_z0, vlmax); + vsum1 = VFREDSUMVS_FLOAT(vsum1, vres7, v_z0, vlmax); + vsum2 = VFREDSUMVS_FLOAT(vsum2, vres14, v_z0, vlmax); + vsum3 = VFREDSUMVS_FLOAT(vsum3, vres15, v_z0, vlmax); + C3[0] += alpha * VFMVFS_FLOAT_M1(vsum0); + C3[1] += alpha * VFMVFS_FLOAT_M1(vsum1); + C3[2] += alpha * VFMVFS_FLOAT_M1(vsum2); + C3[3] += alpha * VFMVFS_FLOAT_M1(vsum3); + + C0 += 4; + C1 += 4; + C2 += 4; + C3 += 4; + } + + if(bm & 2) { + ptrbb = bb; + + vres0 = VFMVVF_FLOAT(0.0, vlmax); + vres1 = VFMVVF_FLOAT(0.0, vlmax); + vres2 = VFMVVF_FLOAT(0.0, vlmax); + vres3 = VFMVVF_FLOAT(0.0, vlmax); + vres4 = VFMVVF_FLOAT(0.0, vlmax); + vres5 = VFMVVF_FLOAT(0.0, vlmax); + vres6 = VFMVVF_FLOAT(0.0, vlmax); + vres7 = VFMVVF_FLOAT(0.0, vlmax); + + for (k = bk; k > 0; k -= vl) { + vl = VSETVL(k); + + VLSEG2_FLOAT(&va0, &va1, ptrba, vl); + VLSEG4_FLOAT(&vb0, &vb1, &vb2, &vb3, ptrbb, vl); + + vres0 = VFMACCVV_FLOAT(vres0, va0, vb0, vl); + vres1 = VFMACCVV_FLOAT(vres1, va1, vb0, vl); + vres2 = VFMACCVV_FLOAT(vres2, va0, vb1, vl); + vres3 = VFMACCVV_FLOAT(vres3, va1, vb1, vl); + + vres4 = VFMACCVV_FLOAT(vres4, va0, vb2, vl); + vres5 = VFMACCVV_FLOAT(vres5, va1, vb2, vl); + vres6 = VFMACCVV_FLOAT(vres6, va0, vb3, vl); + vres7 = VFMACCVV_FLOAT(vres7, va1, vb3, vl); + + ptrba += vl*2; + ptrbb += vl*4; + } + + vsum0 = VFREDSUMVS_FLOAT(vsum0, vres0, v_z0, vlmax); + vsum1 = VFREDSUMVS_FLOAT(vsum1, vres1, v_z0, vlmax); + C0[0] += alpha * VFMVFS_FLOAT_M1(vsum0); + C0[1] += alpha * VFMVFS_FLOAT_M1(vsum1); + + vsum0 = VFREDSUMVS_FLOAT(vsum0, vres2, v_z0, vlmax); + vsum1 = VFREDSUMVS_FLOAT(vsum1, vres3, v_z0, vlmax); + C1[0] += alpha * VFMVFS_FLOAT_M1(vsum0); + C1[1] += alpha * VFMVFS_FLOAT_M1(vsum1); + + vsum0 = VFREDSUMVS_FLOAT(vsum0, vres4, v_z0, vlmax); + vsum1 = VFREDSUMVS_FLOAT(vsum1, vres5, v_z0, vlmax); + C2[0] += alpha * VFMVFS_FLOAT_M1(vsum0); + C2[1] += alpha * VFMVFS_FLOAT_M1(vsum1); + + vsum0 = VFREDSUMVS_FLOAT(vsum0, vres6, v_z0, vlmax); + vsum1 = VFREDSUMVS_FLOAT(vsum1, vres7, v_z0, vlmax); + C3[0] += alpha * VFMVFS_FLOAT_M1(vsum0); + C3[1] += alpha * VFMVFS_FLOAT_M1(vsum1); + + C0 += 2; + C1 += 2; + C2 += 2; + C3 += 2; + } + + if(bm & 1) { + ptrbb = bb; + + vres0 = VFMVVF_FLOAT(0.0, vlmax); + vres1 = VFMVVF_FLOAT(0.0, vlmax); + vres2 = VFMVVF_FLOAT(0.0, vlmax); + vres3 = VFMVVF_FLOAT(0.0, vlmax); + + for (k = bk; k > 0; k -= vl) { + vl = VSETVL(k); + + va0 = VLEV_FLOAT(ptrba, vl); + VLSEG4_FLOAT(&vb0, &vb1, &vb2, &vb3, ptrbb, vl); + + vres0 = VFMACCVV_FLOAT(vres0, va0, vb0, vl); + vres1 = VFMACCVV_FLOAT(vres1, va0, vb1, vl); + vres2 = VFMACCVV_FLOAT(vres2, va0, vb2, vl); + vres3 = VFMACCVV_FLOAT(vres3, va0, vb3, vl); + + ptrba += vl; + ptrbb += vl*4; + } + + vsum0 = VFREDSUMVS_FLOAT(vsum0, vres0, v_z0, vlmax); + vsum1 = VFREDSUMVS_FLOAT(vsum1, vres1, v_z0, vlmax); + vsum2 = VFREDSUMVS_FLOAT(vsum2, vres2, v_z0, vlmax); + vsum3 = VFREDSUMVS_FLOAT(vsum3, vres3, v_z0, vlmax); + C0[0] += alpha * VFMVFS_FLOAT_M1(vsum0); + C1[0] += alpha * VFMVFS_FLOAT_M1(vsum1); + C2[0] += alpha * VFMVFS_FLOAT_M1(vsum2); + C3[0] += alpha * VFMVFS_FLOAT_M1(vsum3); + + C0 += 1; + C1 += 1; + C2 += 1; + C3 += 1; + } + + bb += (bk<<2); + C += (ldc<<2); + } + + if(bn & 2) { + + C0 = C; + C1 = C0 + ldc; + ptrba = ba; + + for (i = bm/4; i > 0; i--) { + ptrbb = bb; + + vres0 = VFMVVF_FLOAT(0.0, vlmax); + vres1 = VFMVVF_FLOAT(0.0, vlmax); + vres2 = VFMVVF_FLOAT(0.0, vlmax); + vres3 = VFMVVF_FLOAT(0.0, vlmax); + + vres4 = VFMVVF_FLOAT(0.0, vlmax); + vres5 = VFMVVF_FLOAT(0.0, vlmax); + vres6 = VFMVVF_FLOAT(0.0, vlmax); + vres7 = VFMVVF_FLOAT(0.0, vlmax); + + for (k = bk; k > 0; k -= vl) { + vl = VSETVL(k); + + VLSEG4_FLOAT(&va0, &va1, &va2, &va3, ptrba, vl); + VLSEG2_FLOAT(&vb0, &vb1, ptrbb, vl); + + vres0 = VFMACCVV_FLOAT(vres0, va0, vb0, vl); + vres1 = VFMACCVV_FLOAT(vres1, va1, vb0, vl); + vres2 = VFMACCVV_FLOAT(vres2, va2, vb0, vl); + vres3 = VFMACCVV_FLOAT(vres3, va3, vb0, vl); + + vres4 = VFMACCVV_FLOAT(vres4, va0, vb1, vl); + vres5 = VFMACCVV_FLOAT(vres5, va1, vb1, vl); + vres6 = VFMACCVV_FLOAT(vres6, va2, vb1, vl); + vres7 = VFMACCVV_FLOAT(vres7, va3, vb1, vl); + + ptrba += vl*4; + ptrbb += vl*2; + } + + vsum0 = VFREDSUMVS_FLOAT(vsum0, vres0, v_z0, vlmax); + vsum1 = VFREDSUMVS_FLOAT(vsum1, vres1, v_z0, vlmax); + vsum2 = VFREDSUMVS_FLOAT(vsum2, vres2, v_z0, vlmax); + vsum3 = VFREDSUMVS_FLOAT(vsum3, vres3, v_z0, vlmax); + C0[0] += alpha * VFMVFS_FLOAT_M1(vsum0); + C0[1] += alpha * VFMVFS_FLOAT_M1(vsum1); + C0[2] += alpha * VFMVFS_FLOAT_M1(vsum2); + C0[3] += alpha * VFMVFS_FLOAT_M1(vsum3); + + vsum0 = VFREDSUMVS_FLOAT(vsum0, vres4, v_z0, vlmax); + vsum1 = VFREDSUMVS_FLOAT(vsum1, vres5, v_z0, vlmax); + vsum2 = VFREDSUMVS_FLOAT(vsum2, vres6, v_z0, vlmax); + vsum3 = VFREDSUMVS_FLOAT(vsum3, vres7, v_z0, vlmax); + C1[0] += alpha * VFMVFS_FLOAT_M1(vsum0); + C1[1] += alpha * VFMVFS_FLOAT_M1(vsum1); + C1[2] += alpha * VFMVFS_FLOAT_M1(vsum2); + C1[3] += alpha * VFMVFS_FLOAT_M1(vsum3); + + C0 += 4; + C1 += 4; + } + + if(bm & 2) { + ptrbb = bb; + + vres0 = VFMVVF_FLOAT(0.0, vlmax); + vres1 = VFMVVF_FLOAT(0.0, vlmax); + vres2 = VFMVVF_FLOAT(0.0, vlmax); + vres3 = VFMVVF_FLOAT(0.0, vlmax); + + for (k = bk; k > 0; k -= vl) { + vl = VSETVL(k); + + VLSEG2_FLOAT(&va0, &va1, ptrba, vl); + VLSEG2_FLOAT(&vb0, &vb1, ptrbb, vl); + + vres0 = VFMACCVV_FLOAT(vres0, va0, vb0, vl); + vres1 = VFMACCVV_FLOAT(vres1, va1, vb0, vl); + vres2 = VFMACCVV_FLOAT(vres2, va0, vb1, vl); + vres3 = VFMACCVV_FLOAT(vres3, va1, vb1, vl); + + ptrba += vl*2; + ptrbb += vl*2; + } + + vsum0 = VFREDSUMVS_FLOAT(vsum0, vres0, v_z0, vlmax); + vsum1 = VFREDSUMVS_FLOAT(vsum1, vres1, v_z0, vlmax); + vsum2 = VFREDSUMVS_FLOAT(vsum2, vres2, v_z0, vlmax); + vsum3 = VFREDSUMVS_FLOAT(vsum3, vres3, v_z0, vlmax); + C0[0] += alpha * VFMVFS_FLOAT_M1(vsum0); + C0[1] += alpha * VFMVFS_FLOAT_M1(vsum1); + C1[0] += alpha * VFMVFS_FLOAT_M1(vsum2); + C1[1] += alpha * VFMVFS_FLOAT_M1(vsum3); + + C0 += 2; + C1 += 2; + } + + if(bm & 1) { + ptrbb = bb; + + vres0 = VFMVVF_FLOAT(0.0, vlmax); + vres1 = VFMVVF_FLOAT(0.0, vlmax); + + for (k = bk; k > 0; k -= vl) { + vl = VSETVL(k); + + va0 = VLEV_FLOAT(ptrba, vl); + VLSEG2_FLOAT(&vb0, &vb1, ptrbb, vl); + + vres0 = VFMACCVV_FLOAT(vres0, va0, vb0, vl); + vres1 = VFMACCVV_FLOAT(vres1, va0, vb1, vl); + + ptrba += vl; + ptrbb += vl*2; + } + + vsum0 = VFREDSUMVS_FLOAT(vsum0, vres0, v_z0, vlmax); + vsum1 = VFREDSUMVS_FLOAT(vsum1, vres1, v_z0, vlmax); + C0[0] += alpha * VFMVFS_FLOAT_M1(vsum0); + C1[0] += alpha * VFMVFS_FLOAT_M1(vsum1); + + C0 += 1; + C1 += 1; + } + + bb += (bk<<1); + C += (ldc<<1); + } + + if(bn & 1) { + C0 = C; + ptrba = ba; + for (i = bm/4; i > 0; i--) { + ptrbb = bb; + + vres0 = VFMVVF_FLOAT(0.0, vlmax); + vres1 = VFMVVF_FLOAT(0.0, vlmax); + vres2 = VFMVVF_FLOAT(0.0, vlmax); + vres3 = VFMVVF_FLOAT(0.0, vlmax); + + for (k = bk; k > 0; k -= vl) { + vl = VSETVL(k); + + VLSEG4_FLOAT(&va0, &va1, &va2, &va3, ptrba, vl); + vb0 = VLEV_FLOAT(ptrbb, vl); + + vres0 = VFMACCVV_FLOAT(vres0, va0, vb0, vl); + vres1 = VFMACCVV_FLOAT(vres1, va1, vb0, vl); + vres2 = VFMACCVV_FLOAT(vres2, va2, vb0, vl); + vres3 = VFMACCVV_FLOAT(vres3, va3, vb0, vl); + + ptrba += vl*4; + ptrbb += vl; + } + + vsum0 = VFREDSUMVS_FLOAT(vsum0, vres0, v_z0, vlmax); + vsum1 = VFREDSUMVS_FLOAT(vsum1, vres1, v_z0, vlmax); + vsum2 = VFREDSUMVS_FLOAT(vsum2, vres2, v_z0, vlmax); + vsum3 = VFREDSUMVS_FLOAT(vsum3, vres3, v_z0, vlmax); + C0[0] += alpha * VFMVFS_FLOAT_M1(vsum0); + C0[1] += alpha * VFMVFS_FLOAT_M1(vsum1); + C0[2] += alpha * VFMVFS_FLOAT_M1(vsum2); + C0[3] += alpha * VFMVFS_FLOAT_M1(vsum3); + + C0 += 4; + } + + if(bm & 2) { + ptrbb = bb; + + vres0 = VFMVVF_FLOAT(0.0, vlmax); + vres1 = VFMVVF_FLOAT(0.0, vlmax); + + for (k = bk; k > 0; k -= vl) { + vl = VSETVL(k); + + VLSEG2_FLOAT(&va0, &va1, ptrba, vl); + vb0 = VLEV_FLOAT(ptrbb, vl); + + vres0 = VFMACCVV_FLOAT(vres0, va0, vb0, vl); + vres1 = VFMACCVV_FLOAT(vres1, va1, vb0, vl); + + ptrba += vl*2; + ptrbb += vl; + } + + vsum0 = VFREDSUMVS_FLOAT(vsum0, vres0, v_z0, vlmax); + vsum1 = VFREDSUMVS_FLOAT(vsum1, vres1, v_z0, vlmax); + C0[0] += alpha * VFMVFS_FLOAT_M1(vsum0); + C0[1] += alpha * VFMVFS_FLOAT_M1(vsum1); + + C0 += 2; + } + + if(bm & 1) { + ptrbb = bb; + + vres0 = VFMVVF_FLOAT(0.0, vlmax); + + for (k = bk; k > 0; k -= vl) { + vl = VSETVL(k); + + va0 = VLEV_FLOAT(ptrba, vl); + vb0 = VLEV_FLOAT(ptrbb, vl); + + vres0 = VFMACCVV_FLOAT(vres0, va0, vb0, vl); + + ptrba += vl; + ptrbb += vl; + } + + vsum0 = VFREDSUMVS_FLOAT(vsum0, vres0, v_z0, vlmax); + C0[0] += alpha * VFMVFS_FLOAT_M1(vsum0); + + C0 += 1; + } + + bb += (bk<<0); + C += ldc; + } + + return 0; +} diff --git a/kernel/riscv64/gemmkernel_rvv_v1x8.c b/kernel/riscv64/gemmkernel_rvv_v1x8.c new file mode 100644 index 000000000..5cd509f93 --- /dev/null +++ b/kernel/riscv64/gemmkernel_rvv_v1x8.c @@ -0,0 +1,601 @@ +/*************************************************************************** +Copyright (c) 2022, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" + +#if !defined(DOUBLE) +#define VSETVL(n) vsetvl_e32m2(n) +#define FLOAT_V_T vfloat32m2_t +#define VLEV_FLOAT vle32_v_f32m2 +#define VSEV_FLOAT vse32_v_f32m2 +#define VFMVVF_FLOAT vfmv_v_f_f32m2 +#define VFMACCVF_FLOAT vfmacc_vf_f32m2 +#else +#define VSETVL(n) vsetvl_e64m2(n) +#define FLOAT_V_T vfloat64m2_t +#define VLEV_FLOAT vle64_v_f64m2 +#define VSEV_FLOAT vse64_v_f64m2 +#define VFMVVF_FLOAT vfmv_v_f_f64m2 +#define VFMACCVF_FLOAT vfmacc_vf_f64m2 +#endif + +int CNAME(BLASLONG bm, BLASLONG bn, BLASLONG bk, FLOAT alpha, IFLOAT* ba, IFLOAT* bb, FLOAT* C, BLASLONG ldc +#ifdef TRMMKERNEL + ,BLASLONG offset +#endif + ) +{ + BLASLONG i,j,k; + FLOAT *C0,*C1,*C2,*C3,*C4,*C5,*C6,*C7; + IFLOAT *ptrba,*ptrbb; + + //fprintf(stderr, "%s, bm=%ld bn=%ld bk=%ld alpha=%f ldc=%ld\n", __FUNCTION__, bm, bn, bk, alpha, ldc); // Debug + + FLOAT_V_T va0, va1, va2, va3, va4, va5, va6, va7; + FLOAT_V_T vres0, vres1, vres2, vres3, vres4, vres5, vres6, vres7; + size_t vl; + + // N:8 + for (j = bn/8; j > 0; j--) { + C0 = C; + C1 = C0 + ldc; + C2 = C1 + ldc; + C3 = C2 + ldc; + C4 = C3 + ldc; + C5 = C4 + ldc; + C6 = C5 + ldc; + C7 = C6 + ldc; + ptrba = ba; + + for (i = bm; i > 0; i -= vl) { + vl = VSETVL(i); + + ptrbb = bb; + + vres0 = VFMVVF_FLOAT(0.0, vl); + vres1 = VFMVVF_FLOAT(0.0, vl); + vres2 = VFMVVF_FLOAT(0.0, vl); + vres3 = VFMVVF_FLOAT(0.0, vl); + vres4 = VFMVVF_FLOAT(0.0, vl); + vres5 = VFMVVF_FLOAT(0.0, vl); + vres6 = VFMVVF_FLOAT(0.0, vl); + vres7 = VFMVVF_FLOAT(0.0, vl); +#if 0 + for (k = bk; k > 0; k--) { + va0 = VLEV_FLOAT(ptrba, vl); + + vres0 = VFMACCVF_FLOAT(vres0, *(ptrbb + 0), va0, vl); + vres1 = VFMACCVF_FLOAT(vres1, *(ptrbb + 1), va0, vl); + vres2 = VFMACCVF_FLOAT(vres2, *(ptrbb + 2), va0, vl); + vres3 = VFMACCVF_FLOAT(vres3, *(ptrbb + 3), va0, vl); + vres4 = VFMACCVF_FLOAT(vres4, *(ptrbb + 4), va0, vl); + vres5 = VFMACCVF_FLOAT(vres5, *(ptrbb + 5), va0, vl); + vres6 = VFMACCVF_FLOAT(vres6, *(ptrbb + 6), va0, vl); + vres7 = VFMACCVF_FLOAT(vres7, *(ptrbb + 7), va0, vl); + + ptrba += vl; + ptrbb += 8; + } +#else + // Unroll K + for (k = bk/8; k > 0; k--) { + va0 = VLEV_FLOAT(ptrba, vl); + ptrba += vl; + va1 = VLEV_FLOAT(ptrba, vl); + ptrba += vl; + + vres0 = VFMACCVF_FLOAT(vres0, *(ptrbb + 0), va0, vl); + vres1 = VFMACCVF_FLOAT(vres1, *(ptrbb + 1), va0, vl); + vres2 = VFMACCVF_FLOAT(vres2, *(ptrbb + 2), va0, vl); + vres3 = VFMACCVF_FLOAT(vres3, *(ptrbb + 3), va0, vl); + vres4 = VFMACCVF_FLOAT(vres4, *(ptrbb + 4), va0, vl); + vres5 = VFMACCVF_FLOAT(vres5, *(ptrbb + 5), va0, vl); + vres6 = VFMACCVF_FLOAT(vres6, *(ptrbb + 6), va0, vl); + vres7 = VFMACCVF_FLOAT(vres7, *(ptrbb + 7), va0, vl); + ptrbb += 8; + + va2 = VLEV_FLOAT(ptrba, vl); + ptrba += vl; + + vres0 = VFMACCVF_FLOAT(vres0, *(ptrbb + 0), va1, vl); + vres1 = VFMACCVF_FLOAT(vres1, *(ptrbb + 1), va1, vl); + vres2 = VFMACCVF_FLOAT(vres2, *(ptrbb + 2), va1, vl); + vres3 = VFMACCVF_FLOAT(vres3, *(ptrbb + 3), va1, vl); + vres4 = VFMACCVF_FLOAT(vres4, *(ptrbb + 4), va1, vl); + vres5 = VFMACCVF_FLOAT(vres5, *(ptrbb + 5), va1, vl); + vres6 = VFMACCVF_FLOAT(vres6, *(ptrbb + 6), va1, vl); + vres7 = VFMACCVF_FLOAT(vres7, *(ptrbb + 7), va1, vl); + ptrbb += 8; + + va3 = VLEV_FLOAT(ptrba, vl); + ptrba += vl; + + vres0 = VFMACCVF_FLOAT(vres0, *(ptrbb + 0), va2, vl); + vres1 = VFMACCVF_FLOAT(vres1, *(ptrbb + 1), va2, vl); + vres2 = VFMACCVF_FLOAT(vres2, *(ptrbb + 2), va2, vl); + vres3 = VFMACCVF_FLOAT(vres3, *(ptrbb + 3), va2, vl); + vres4 = VFMACCVF_FLOAT(vres4, *(ptrbb + 4), va2, vl); + vres5 = VFMACCVF_FLOAT(vres5, *(ptrbb + 5), va2, vl); + vres6 = VFMACCVF_FLOAT(vres6, *(ptrbb + 6), va2, vl); + vres7 = VFMACCVF_FLOAT(vres7, *(ptrbb + 7), va2, vl); + ptrbb += 8; + + va4 = VLEV_FLOAT(ptrba, vl); + ptrba += vl; + + vres0 = VFMACCVF_FLOAT(vres0, *(ptrbb + 0), va3, vl); + vres1 = VFMACCVF_FLOAT(vres1, *(ptrbb + 1), va3, vl); + vres2 = VFMACCVF_FLOAT(vres2, *(ptrbb + 2), va3, vl); + vres3 = VFMACCVF_FLOAT(vres3, *(ptrbb + 3), va3, vl); + vres4 = VFMACCVF_FLOAT(vres4, *(ptrbb + 4), va3, vl); + vres5 = VFMACCVF_FLOAT(vres5, *(ptrbb + 5), va3, vl); + vres6 = VFMACCVF_FLOAT(vres6, *(ptrbb + 6), va3, vl); + vres7 = VFMACCVF_FLOAT(vres7, *(ptrbb + 7), va3, vl); + ptrbb += 8; + + va5 = VLEV_FLOAT(ptrba, vl); + ptrba += vl; + + vres0 = VFMACCVF_FLOAT(vres0, *(ptrbb + 0), va4, vl); + vres1 = VFMACCVF_FLOAT(vres1, *(ptrbb + 1), va4, vl); + vres2 = VFMACCVF_FLOAT(vres2, *(ptrbb + 2), va4, vl); + vres3 = VFMACCVF_FLOAT(vres3, *(ptrbb + 3), va4, vl); + vres4 = VFMACCVF_FLOAT(vres4, *(ptrbb + 4), va4, vl); + vres5 = VFMACCVF_FLOAT(vres5, *(ptrbb + 5), va4, vl); + vres6 = VFMACCVF_FLOAT(vres6, *(ptrbb + 6), va4, vl); + vres7 = VFMACCVF_FLOAT(vres7, *(ptrbb + 7), va4, vl); + ptrbb += 8; + + va6 = VLEV_FLOAT(ptrba, vl); + ptrba += vl; + + vres0 = VFMACCVF_FLOAT(vres0, *(ptrbb + 0), va5, vl); + vres1 = VFMACCVF_FLOAT(vres1, *(ptrbb + 1), va5, vl); + vres2 = VFMACCVF_FLOAT(vres2, *(ptrbb + 2), va5, vl); + vres3 = VFMACCVF_FLOAT(vres3, *(ptrbb + 3), va5, vl); + vres4 = VFMACCVF_FLOAT(vres4, *(ptrbb + 4), va5, vl); + vres5 = VFMACCVF_FLOAT(vres5, *(ptrbb + 5), va5, vl); + vres6 = VFMACCVF_FLOAT(vres6, *(ptrbb + 6), va5, vl); + vres7 = VFMACCVF_FLOAT(vres7, *(ptrbb + 7), va5, vl); + ptrbb += 8; + + va7 = VLEV_FLOAT(ptrba, vl); + ptrba += vl; + + vres0 = VFMACCVF_FLOAT(vres0, *(ptrbb + 0), va6, vl); + vres1 = VFMACCVF_FLOAT(vres1, *(ptrbb + 1), va6, vl); + vres2 = VFMACCVF_FLOAT(vres2, *(ptrbb + 2), va6, vl); + vres3 = VFMACCVF_FLOAT(vres3, *(ptrbb + 3), va6, vl); + vres4 = VFMACCVF_FLOAT(vres4, *(ptrbb + 4), va6, vl); + vres5 = VFMACCVF_FLOAT(vres5, *(ptrbb + 5), va6, vl); + vres6 = VFMACCVF_FLOAT(vres6, *(ptrbb + 6), va6, vl); + vres7 = VFMACCVF_FLOAT(vres7, *(ptrbb + 7), va6, vl); + ptrbb += 8; + + vres0 = VFMACCVF_FLOAT(vres0, *(ptrbb + 0), va7, vl); + vres1 = VFMACCVF_FLOAT(vres1, *(ptrbb + 1), va7, vl); + vres2 = VFMACCVF_FLOAT(vres2, *(ptrbb + 2), va7, vl); + vres3 = VFMACCVF_FLOAT(vres3, *(ptrbb + 3), va7, vl); + vres4 = VFMACCVF_FLOAT(vres4, *(ptrbb + 4), va7, vl); + vres5 = VFMACCVF_FLOAT(vres5, *(ptrbb + 5), va7, vl); + vres6 = VFMACCVF_FLOAT(vres6, *(ptrbb + 6), va7, vl); + vres7 = VFMACCVF_FLOAT(vres7, *(ptrbb + 7), va7, vl); + ptrbb += 8; + } + + // K remainder + for (k = bk&7; k > 0; k--) { + va0 = VLEV_FLOAT(ptrba, vl); + + vres0 = VFMACCVF_FLOAT(vres0, *(ptrbb + 0), va0, vl); + vres1 = VFMACCVF_FLOAT(vres1, *(ptrbb + 1), va0, vl); + vres2 = VFMACCVF_FLOAT(vres2, *(ptrbb + 2), va0, vl); + vres3 = VFMACCVF_FLOAT(vres3, *(ptrbb + 3), va0, vl); + vres4 = VFMACCVF_FLOAT(vres4, *(ptrbb + 4), va0, vl); + vres5 = VFMACCVF_FLOAT(vres5, *(ptrbb + 5), va0, vl); + vres6 = VFMACCVF_FLOAT(vres6, *(ptrbb + 6), va0, vl); + vres7 = VFMACCVF_FLOAT(vres7, *(ptrbb + 7), va0, vl); + + ptrbb += 8; + ptrba += vl; + } +#endif + va0 = VLEV_FLOAT(C0, vl); + va0 = VFMACCVF_FLOAT(va0, alpha, vres0, vl); + VSEV_FLOAT(C0, va0, vl); + + va1 = VLEV_FLOAT(C1, vl); + va1 = VFMACCVF_FLOAT(va1, alpha, vres1, vl); + VSEV_FLOAT(C1, va1, vl); + + va2 = VLEV_FLOAT(C2, vl); + va2 = VFMACCVF_FLOAT(va2, alpha, vres2, vl); + VSEV_FLOAT(C2, va2, vl); + + va3 = VLEV_FLOAT(C3, vl); + va3 = VFMACCVF_FLOAT(va3, alpha, vres3, vl); + VSEV_FLOAT(C3, va3, vl); + + va4 = VLEV_FLOAT(C4, vl); + va4 = VFMACCVF_FLOAT(va4, alpha, vres4, vl); + VSEV_FLOAT(C4, va4, vl); + + va5 = VLEV_FLOAT(C5, vl); + va5 = VFMACCVF_FLOAT(va5, alpha, vres5, vl); + VSEV_FLOAT(C5, va5, vl); + + va6 = VLEV_FLOAT(C6, vl); + va6 = VFMACCVF_FLOAT(va6, alpha, vres6, vl); + VSEV_FLOAT(C6, va6, vl); + + va7 = VLEV_FLOAT(C7, vl); + va7 = VFMACCVF_FLOAT(va7, alpha, vres7, vl); + VSEV_FLOAT(C7, va7, vl); + + C0 += vl; + C1 += vl; + C2 += vl; + C3 += vl; + C4 += vl; + C5 += vl; + C6 += vl; + C7 += vl; + } + + bb += (bk<<3); + C += (ldc<<3); + } + + // N:4 + if (bn & 4) { + C0 = C; + C1 = C0 + ldc; + C2 = C1 + ldc; + C3 = C2 + ldc; + ptrba = ba; + + for (i = bm; i > 0; i -= vl) { + vl = VSETVL(i); + + ptrbb = bb; + + vres0 = VFMVVF_FLOAT(0.0, vl); + vres1 = VFMVVF_FLOAT(0.0, vl); + vres2 = VFMVVF_FLOAT(0.0, vl); + vres3 = VFMVVF_FLOAT(0.0, vl); + +#if 0 + for (k = bk; k > 0; k--) { + va0 = VLEV_FLOAT(ptrba, vl); + + vres0 = VFMACCVF_FLOAT(vres0, *(ptrbb + 0), va0, vl); + vres1 = VFMACCVF_FLOAT(vres1, *(ptrbb + 1), va0, vl); + vres2 = VFMACCVF_FLOAT(vres2, *(ptrbb + 2), va0, vl); + vres3 = VFMACCVF_FLOAT(vres3, *(ptrbb + 3), va0, vl); + + ptrba += vl; + ptrbb += 4; + } +#else + // Unroll K + for (k = bk/8; k > 0; k--) { + va0 = VLEV_FLOAT(ptrba, vl); + ptrba += vl; + va1 = VLEV_FLOAT(ptrba, vl); + ptrba += vl; + + vres0 = VFMACCVF_FLOAT(vres0, *(ptrbb + 0), va0, vl); + vres1 = VFMACCVF_FLOAT(vres1, *(ptrbb + 1), va0, vl); + vres2 = VFMACCVF_FLOAT(vres2, *(ptrbb + 2), va0, vl); + vres3 = VFMACCVF_FLOAT(vres3, *(ptrbb + 3), va0, vl); + ptrbb += 4; + va2 = VLEV_FLOAT(ptrba, vl); + ptrba += vl; + + vres0 = VFMACCVF_FLOAT(vres0, *(ptrbb + 0), va1, vl); + vres1 = VFMACCVF_FLOAT(vres1, *(ptrbb + 1), va1, vl); + vres2 = VFMACCVF_FLOAT(vres2, *(ptrbb + 2), va1, vl); + vres3 = VFMACCVF_FLOAT(vres3, *(ptrbb + 3), va1, vl); + ptrbb += 4; + va3 = VLEV_FLOAT(ptrba, vl); + ptrba += vl; + + vres0 = VFMACCVF_FLOAT(vres0, *(ptrbb + 0), va2, vl); + vres1 = VFMACCVF_FLOAT(vres1, *(ptrbb + 1), va2, vl); + vres2 = VFMACCVF_FLOAT(vres2, *(ptrbb + 2), va2, vl); + vres3 = VFMACCVF_FLOAT(vres3, *(ptrbb + 3), va2, vl); + ptrbb += 4; + va4 = VLEV_FLOAT(ptrba, vl); + ptrba += vl; + + vres0 = VFMACCVF_FLOAT(vres0, *(ptrbb + 0), va3, vl); + vres1 = VFMACCVF_FLOAT(vres1, *(ptrbb + 1), va3, vl); + vres2 = VFMACCVF_FLOAT(vres2, *(ptrbb + 2), va3, vl); + vres3 = VFMACCVF_FLOAT(vres3, *(ptrbb + 3), va3, vl); + ptrbb += 4; + va5 = VLEV_FLOAT(ptrba, vl); + ptrba += vl; + + vres0 = VFMACCVF_FLOAT(vres0, *(ptrbb + 0), va4, vl); + vres1 = VFMACCVF_FLOAT(vres1, *(ptrbb + 1), va4, vl); + vres2 = VFMACCVF_FLOAT(vres2, *(ptrbb + 2), va4, vl); + vres3 = VFMACCVF_FLOAT(vres3, *(ptrbb + 3), va4, vl); + ptrbb += 4; + va6 = VLEV_FLOAT(ptrba, vl); + ptrba += vl; + + vres0 = VFMACCVF_FLOAT(vres0, *(ptrbb + 0), va5, vl); + vres1 = VFMACCVF_FLOAT(vres1, *(ptrbb + 1), va5, vl); + vres2 = VFMACCVF_FLOAT(vres2, *(ptrbb + 2), va5, vl); + vres3 = VFMACCVF_FLOAT(vres3, *(ptrbb + 3), va5, vl); + ptrbb += 4; + va7 = VLEV_FLOAT(ptrba, vl); + ptrba += vl; + + vres0 = VFMACCVF_FLOAT(vres0, *(ptrbb + 0), va6, vl); + vres1 = VFMACCVF_FLOAT(vres1, *(ptrbb + 1), va6, vl); + vres2 = VFMACCVF_FLOAT(vres2, *(ptrbb + 2), va6, vl); + vres3 = VFMACCVF_FLOAT(vres3, *(ptrbb + 3), va6, vl); + ptrbb += 4; + + vres0 = VFMACCVF_FLOAT(vres0, *(ptrbb + 0), va7, vl); + vres1 = VFMACCVF_FLOAT(vres1, *(ptrbb + 1), va7, vl); + vres2 = VFMACCVF_FLOAT(vres2, *(ptrbb + 2), va7, vl); + vres3 = VFMACCVF_FLOAT(vres3, *(ptrbb + 3), va7, vl); + ptrbb += 4; + } + + // K remainder + for (k = bk&7; k > 0; k--) { + va0 = VLEV_FLOAT(ptrba, vl); + + vres0 = VFMACCVF_FLOAT(vres0, *(ptrbb + 0), va0, vl); + vres1 = VFMACCVF_FLOAT(vres1, *(ptrbb + 1), va0, vl); + vres2 = VFMACCVF_FLOAT(vres2, *(ptrbb + 2), va0, vl); + vres3 = VFMACCVF_FLOAT(vres3, *(ptrbb + 3), va0, vl); + + ptrbb += 4; + ptrba += vl; + } +#endif + va0 = VLEV_FLOAT(C0, vl); + va0 = VFMACCVF_FLOAT(va0, alpha, vres0, vl); + VSEV_FLOAT(C0, va0, vl); + + va1 = VLEV_FLOAT(C1, vl); + va1 = VFMACCVF_FLOAT(va1, alpha, vres1, vl); + VSEV_FLOAT(C1, va1, vl); + + va2 = VLEV_FLOAT(C2, vl); + va2 = VFMACCVF_FLOAT(va2, alpha, vres2, vl); + VSEV_FLOAT(C2, va2, vl); + + va3 = VLEV_FLOAT(C3, vl); + va3 = VFMACCVF_FLOAT(va3, alpha, vres3, vl); + VSEV_FLOAT(C3, va3, vl); + + C0 += vl; + C1 += vl; + C2 += vl; + C3 += vl; + } + + bb += (bk<<2); + C += (ldc<<2); + } + + // N:2 + if (bn & 2) { + C0 = C; + C1 = C0 + ldc; + ptrba = ba; + + for (i = bm; i > 0; i -= vl) { + vl = VSETVL(i); + + ptrbb = bb; + + vres0 = VFMVVF_FLOAT(0.0, vl); + vres1 = VFMVVF_FLOAT(0.0, vl); +#if 0 + for (k = bk; k > 0; k--) { + va0 = VLEV_FLOAT(ptrba, vl); + + vres0 = VFMACCVF_FLOAT(vres0, *(ptrbb + 0), va0, vl); + vres1 = VFMACCVF_FLOAT(vres1, *(ptrbb + 1), va0, vl); + + ptrba += vl; + ptrbb += 2; + } +#else + // Unroll K + for (k = bk/8; k > 0; k--) { + va0 = VLEV_FLOAT(ptrba, vl); + ptrba += vl; + va1 = VLEV_FLOAT(ptrba, vl); + ptrba += vl; + + vres0 = VFMACCVF_FLOAT(vres0, *(ptrbb + 0), va0, vl); + vres1 = VFMACCVF_FLOAT(vres1, *(ptrbb + 1), va0, vl); + ptrbb += 2; + va2 = VLEV_FLOAT(ptrba, vl); + ptrba += vl; + + vres0 = VFMACCVF_FLOAT(vres0, *(ptrbb + 0), va1, vl); + vres1 = VFMACCVF_FLOAT(vres1, *(ptrbb + 1), va1, vl); + ptrbb += 2; + va3 = VLEV_FLOAT(ptrba, vl); + ptrba += vl; + + vres0 = VFMACCVF_FLOAT(vres0, *(ptrbb + 0), va2, vl); + vres1 = VFMACCVF_FLOAT(vres1, *(ptrbb + 1), va2, vl); + ptrbb += 2; + va4 = VLEV_FLOAT(ptrba, vl); + ptrba += vl; + + vres0 = VFMACCVF_FLOAT(vres0, *(ptrbb + 0), va3, vl); + vres1 = VFMACCVF_FLOAT(vres1, *(ptrbb + 1), va3, vl); + ptrbb += 2; + va5 = VLEV_FLOAT(ptrba, vl); + ptrba += vl; + + vres0 = VFMACCVF_FLOAT(vres0, *(ptrbb + 0), va4, vl); + vres1 = VFMACCVF_FLOAT(vres1, *(ptrbb + 1), va4, vl); + ptrbb += 2; + va6 = VLEV_FLOAT(ptrba, vl); + ptrba += vl; + + vres0 = VFMACCVF_FLOAT(vres0, *(ptrbb + 0), va5, vl); + vres1 = VFMACCVF_FLOAT(vres1, *(ptrbb + 1), va5, vl); + ptrbb += 2; + va7 = VLEV_FLOAT(ptrba, vl); + ptrba += vl; + + vres0 = VFMACCVF_FLOAT(vres0, *(ptrbb + 0), va6, vl); + vres1 = VFMACCVF_FLOAT(vres1, *(ptrbb + 1), va6, vl); + ptrbb += 2; + + vres0 = VFMACCVF_FLOAT(vres0, *(ptrbb + 0), va7, vl); + vres1 = VFMACCVF_FLOAT(vres1, *(ptrbb + 1), va7, vl); + ptrbb += 2; + } + + // K remainder + for (k = bk&7; k > 0; k--) { + va0 = VLEV_FLOAT(ptrba, vl); + + vres0 = VFMACCVF_FLOAT(vres0, *(ptrbb + 0), va0, vl); + vres1 = VFMACCVF_FLOAT(vres1, *(ptrbb + 1), va0, vl); + + ptrbb += 2; + ptrba += vl; + } +#endif + va0 = VLEV_FLOAT(C0, vl); + va0 = VFMACCVF_FLOAT(va0, alpha, vres0, vl); + VSEV_FLOAT(C0, va0, vl); + + va1 = VLEV_FLOAT(C1, vl); + va1 = VFMACCVF_FLOAT(va1, alpha, vres1, vl); + VSEV_FLOAT(C1, va1, vl); + + C0 += vl; + C1 += vl; + } + + bb += (bk<<1); + C += (ldc<<1); + } + + // N:1 + if (bn & 1) { + C0 = C; + ptrba = ba; + + for (i = bm; i > 0; i -= vl) { + vl = VSETVL(i); + + ptrbb = bb; + + vres0 = VFMVVF_FLOAT(0.0, vl); +#if 0 + for (k = bk; k > 0; k--) { + va0 = VLEV_FLOAT(ptrba, vl); + + vres0 = VFMACCVF_FLOAT(vres0, *(ptrbb + 0), va0, vl); + + ptrba += vl; + ptrbb += 1; + } +#else + // Unroll K + for (k = bk/8; k > 0; k--) { + va0 = VLEV_FLOAT(ptrba, vl); + ptrba += vl; + va1 = VLEV_FLOAT(ptrba, vl); + ptrba += vl; + + vres0 = VFMACCVF_FLOAT(vres0, *(ptrbb + 0), va0, vl); + ptrbb += 1; + va2 = VLEV_FLOAT(ptrba, vl); + ptrba += vl; + + vres0 = VFMACCVF_FLOAT(vres0, *(ptrbb + 0), va1, vl); + ptrbb += 1; + va3 = VLEV_FLOAT(ptrba, vl); + ptrba += vl; + + vres0 = VFMACCVF_FLOAT(vres0, *(ptrbb + 0), va2, vl); + ptrbb += 1; + va4 = VLEV_FLOAT(ptrba, vl); + ptrba += vl; + + vres0 = VFMACCVF_FLOAT(vres0, *(ptrbb + 0), va3, vl); + ptrbb += 1; + va5 = VLEV_FLOAT(ptrba, vl); + ptrba += vl; + + vres0 = VFMACCVF_FLOAT(vres0, *(ptrbb + 0), va4, vl); + ptrbb += 1; + va6 = VLEV_FLOAT(ptrba, vl); + ptrba += vl; + + vres0 = VFMACCVF_FLOAT(vres0, *(ptrbb + 0), va5, vl); + ptrbb += 1; + va7 = VLEV_FLOAT(ptrba, vl); + ptrba += vl; + + vres0 = VFMACCVF_FLOAT(vres0, *(ptrbb + 0), va6, vl); + ptrbb += 1; + + vres0 = VFMACCVF_FLOAT(vres0, *(ptrbb + 0), va7, vl); + ptrbb += 1; + } + + // K remainder + for (k = bk&7; k > 0; k--) { + va0 = VLEV_FLOAT(ptrba, vl); + + vres0 = VFMACCVF_FLOAT(vres0, *(ptrbb + 0), va0, vl); + + ptrbb += 1; + ptrba += vl; + } +#endif + va0 = VLEV_FLOAT(C0, vl); + va0 = VFMACCVF_FLOAT(va0, alpha, vres0, vl); + VSEV_FLOAT(C0, va0, vl); + + C0 += vl; + } + + bb += (bk); + C += (ldc); + } + + return 0; +} diff --git a/kernel/riscv64/gemv_n_rvv.c b/kernel/riscv64/gemv_n_rvv.c new file mode 100644 index 000000000..9d2dee615 --- /dev/null +++ b/kernel/riscv64/gemv_n_rvv.c @@ -0,0 +1,94 @@ +/*************************************************************************** +Copyright (c) 2022, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" + +#if !defined(DOUBLE) +#define VSETVL(n) vsetvl_e32m8(n) +#define FLOAT_V_T vfloat32m8_t +#define VLEV_FLOAT vle32_v_f32m8 +#define VLSEV_FLOAT vlse32_v_f32m8 +#define VSEV_FLOAT vse32_v_f32m8 +#define VSSEV_FLOAT vsse32_v_f32m8 +#define VFMACCVF_FLOAT vfmacc_vf_f32m8 +#else +#define VSETVL(n) vsetvl_e64m8(n) +#define FLOAT_V_T vfloat64m8_t +#define VLEV_FLOAT vle64_v_f64m8 +#define VLSEV_FLOAT vlse64_v_f64m8 +#define VSEV_FLOAT vse64_v_f64m8 +#define VSSEV_FLOAT vsse64_v_f64m8 +#define VFMACCVF_FLOAT vfmacc_vf_f64m8 +#endif + +int CNAME(BLASLONG m, BLASLONG n, BLASLONG dummy1, FLOAT alpha, FLOAT *a, BLASLONG lda, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y, FLOAT *buffer) +{ + if(n < 0) return(0); + + FLOAT *a_ptr, *x_ptr; + BLASLONG i; + FLOAT_V_T va, vy; + + if(inc_y == 1) { + + for (size_t vl; m > 0; m -= vl, y += vl, a += vl) { + vl = VSETVL(m); + a_ptr = a; + x_ptr = x; + vy = VLEV_FLOAT(y, vl); + for(i = 0; i < n; i++) { + va = VLEV_FLOAT(a_ptr, vl); + vy = VFMACCVF_FLOAT(vy, (alpha * (*x_ptr)), va, vl); + + a_ptr += lda; + x_ptr += inc_x; + } + VSEV_FLOAT(y, vy, vl); + } + + } else { + + BLASLONG stride_y = inc_y * sizeof(FLOAT); + + for (size_t vl; m > 0; m -= vl, y += vl*inc_y, a += vl) { + vl = VSETVL(m); + a_ptr = a; + x_ptr = x; + vy = VLSEV_FLOAT(y, stride_y, vl); + for(i = 0; i < n; i++) { + va = VLEV_FLOAT(a_ptr, vl); + vy = VFMACCVF_FLOAT(vy, (alpha * (*x_ptr)), va, vl); + + a_ptr += lda; + x_ptr += inc_x; + } + VSSEV_FLOAT(y, stride_y, vy, vl); + } + + } + return(0); +} diff --git a/kernel/riscv64/gemv_t_rvv.c b/kernel/riscv64/gemv_t_rvv.c new file mode 100644 index 000000000..a80af81b6 --- /dev/null +++ b/kernel/riscv64/gemv_t_rvv.c @@ -0,0 +1,119 @@ +/*************************************************************************** +Copyright (c) 2022, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" + +#if !defined(DOUBLE) +#define VSETVL(n) vsetvl_e32m8(n) +#define VSETVL_MAX vsetvlmax_e32m8() +#define VSETVL_MAX_M1 vsetvlmax_e32m1() +#define FLOAT_V_T vfloat32m8_t +#define FLOAT_V_T_M1 vfloat32m1_t +#define VLEV_FLOAT vle32_v_f32m8 +#define VLSEV_FLOAT vlse32_v_f32m8 +#define VFREDSUM_FLOAT vfredusum_vs_f32m8_f32m1 +#define VFMACCVV_FLOAT vfmacc_vv_f32m8 +#define VFMVVF_FLOAT vfmv_v_f_f32m8 +#define VFMVVF_FLOAT_M1 vfmv_v_f_f32m1 +#define VFMVFS_FLOAT_M1 vfmv_f_s_f32m1_f32 +#else +#define VSETVL(n) vsetvl_e64m8(n) +#define VSETVL_MAX vsetvlmax_e64m8() +#define VSETVL_MAX_M1 vsetvlmax_e64m1() +#define FLOAT_V_T vfloat64m8_t +#define FLOAT_V_T_M1 vfloat64m1_t +#define VLEV_FLOAT vle64_v_f64m8 +#define VLSEV_FLOAT vlse64_v_f64m8 +#define VFREDSUM_FLOAT vfredusum_vs_f64m8_f64m1 +#define VFMACCVV_FLOAT vfmacc_vv_f64m8 +#define VFMVVF_FLOAT vfmv_v_f_f64m8 +#define VFMVVF_FLOAT_M1 vfmv_v_f_f64m1 +#define VFMVFS_FLOAT_M1 vfmv_f_s_f64m1_f64 +#endif + +int CNAME(BLASLONG m, BLASLONG n, BLASLONG dummy1, FLOAT alpha, FLOAT *a, BLASLONG lda, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y, FLOAT *buffer) +{ + BLASLONG i, j; + FLOAT *a_ptr, *x_ptr; + + FLOAT_V_T va, vx, vr; + FLOAT_V_T_M1 v_res, v_z0; + size_t vlmax = VSETVL_MAX_M1; + v_res = VFMVVF_FLOAT_M1(0, vlmax); + v_z0 = VFMVVF_FLOAT_M1(0, vlmax); + vlmax = VSETVL_MAX; + + if(inc_x == 1) { + + for(i = 0; i < n; i++) { + j = m; + a_ptr = a; + x_ptr = x; + vr = VFMVVF_FLOAT(0, vlmax); + + for (size_t vl; j > 0; j -= vl, a_ptr += vl, x_ptr += vl) { + vl = VSETVL(j); + + va = VLEV_FLOAT(a_ptr, vl); + vx = VLEV_FLOAT(x_ptr, vl); + vr = VFMACCVV_FLOAT(vr, va, vx, vl); + } + + v_res = VFREDSUM_FLOAT(v_res, vr, v_z0, vlmax); + *y += alpha * VFMVFS_FLOAT_M1(v_res); + y += inc_y; + a += lda; + } + + } else { + + BLASLONG stride_x = inc_x * sizeof(FLOAT); + + for(i = 0; i < n; i++) { + j = m; + a_ptr = a; + x_ptr = x; + vr = VFMVVF_FLOAT(0, vlmax); + + for (size_t vl; j > 0; j -= vl, a_ptr += vl, x_ptr += vl*inc_x) { + vl = VSETVL(j); + + va = VLEV_FLOAT(a_ptr, vl); + vx = VLSEV_FLOAT(x_ptr, stride_x, vl); + vr = VFMACCVV_FLOAT(vr, va, vx, vl); + } + + v_res = VFREDSUM_FLOAT(v_res, vr, v_z0, vlmax); + *y += alpha * VFMVFS_FLOAT_M1(v_res); + y += inc_y; + a += lda; + } + + } + + return(0); +} diff --git a/kernel/riscv64/iamax_rvv.c b/kernel/riscv64/iamax_rvv.c new file mode 100644 index 000000000..8b33b3bcb --- /dev/null +++ b/kernel/riscv64/iamax_rvv.c @@ -0,0 +1,150 @@ +/*************************************************************************** +Copyright (c) 2022, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" + +#if defined(DOUBLE) +#define VSETVL(n) vsetvl_e64m8(n) +#define VSETVL_MAX vsetvlmax_e64m8() +#define FLOAT_V_T vfloat64m8_t +#define FLOAT_V_T_M1 vfloat64m1_t +#define VLEV_FLOAT vle64_v_f64m8 +#define VLSEV_FLOAT vlse64_v_f64m8 +#define VFREDMAXVS_FLOAT vfredmax_vs_f64m8_f64m1 +#define MASK_T vbool8_t +#define VMFLTVF_FLOAT vmflt_vf_f64m8_b8 +#define VMFLTVV_FLOAT vmflt_vv_f64m8_b8 +#define VMFGEVF_FLOAT vmfge_vf_f64m8_b8 +#define VFMVVF_FLOAT vfmv_v_f_f64m8 +#define VFMVVF_FLOAT_M1 vfmv_v_f_f64m1 +#define VFABSV_FLOAT vfabs_v_f64m8 +#define VFMAXVV_FLOAT vfmax_vv_f64m8 +#define VFIRSTM vfirst_m_b8 +#define UINT_V_T vuint64m8_t +#define VIDV_MASK_UINT vid_v_u64m8_m +#define VIDV_UINT vid_v_u64m8 +#define VADDVX_MASK_UINT vadd_vx_u64m8_m +#define VADDVX_UINT vadd_vx_u64m8 +#define VMVVX_UINT vmv_v_x_u64m8 +#define VFMVFS_FLOAT_M1 vfmv_f_s_f64m1_f64 +#define VSLIDEDOWN_UINT vslidedown_vx_u64m8 +#define VMVVXS_UINT vmv_x_s_u64m8_u64 +#else +#define VSETVL(n) vsetvl_e32m8(n) +#define VSETVL_MAX vsetvlmax_e32m8() +#define FLOAT_V_T vfloat32m8_t +#define FLOAT_V_T_M1 vfloat32m1_t +#define VLEV_FLOAT vle32_v_f32m8 +#define VLSEV_FLOAT vlse32_v_f32m8 +#define VFREDMAXVS_FLOAT vfredmax_vs_f32m8_f32m1 +#define MASK_T vbool4_t +#define VMFLTVF_FLOAT vmflt_vf_f32m8_b4 +#define VMFLTVV_FLOAT vmflt_vv_f32m8_b4 +#define VMFGEVF_FLOAT vmfge_vf_f32m8_b4 +#define VFMVVF_FLOAT vfmv_v_f_f32m8 +#define VFMVVF_FLOAT_M1 vfmv_v_f_f32m1 +#define VFABSV_FLOAT vfabs_v_f32m8 +#define VFMAXVV_FLOAT vfmax_vv_f32m8 +#define VFIRSTM vfirst_m_b4 +#define UINT_V_T vuint32m8_t +#define VIDV_MASK_UINT vid_v_u32m8_m +#define VIDV_UINT vid_v_u32m8 +#define VADDVX_MASK_UINT vadd_vx_u32m8_m +#define VADDVX_UINT vadd_vx_u32m8 +#define VMVVX_UINT vmv_v_x_u32m8 +#define VFMVFS_FLOAT_M1 vfmv_f_s_f32m1_f32 +#define VSLIDEDOWN_UINT vslidedown_vx_u32m8 +#define VMVVXS_UINT vmv_x_s_u32m8_u32 +#endif + +BLASLONG CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) +{ + unsigned int max_index = 0; + if (n <= 0 || inc_x <= 0) return(max_index); + + FLOAT_V_T vx, v_max; + UINT_V_T v_max_index; + MASK_T mask; + + size_t vlmax = VSETVL_MAX; + v_max_index = VMVVX_UINT(0, vlmax); + v_max = VFMVVF_FLOAT(-1, vlmax); + BLASLONG j=0; + FLOAT maxf=0.0; + + if(inc_x == 1) { + + for (size_t vl; n > 0; n -= vl, x += vl, j += vl) { + vl = VSETVL(n); + + vx = VLEV_FLOAT(x, vl); + vx = VFABSV_FLOAT(vx, vl); + + //index where element greater than v_max + mask = VMFLTVV_FLOAT(v_max, vx, vl); + v_max_index = VIDV_MASK_UINT(mask, v_max_index, vl); + v_max_index = VADDVX_MASK_UINT(mask, v_max_index, v_max_index, j, vl); + + //update v_max + v_max = VFMAXVV_FLOAT(v_max, vx, vl); + } + + } else { + + BLASLONG stride_x = inc_x * sizeof(FLOAT); + + for (size_t vl; n > 0; n -= vl, x += vl*inc_x, j += vl) { + vl = VSETVL(n); + + vx = VLSEV_FLOAT(x, stride_x, vl); + vx = VFABSV_FLOAT(vx, vl); + + //index where element greater than v_max + mask = VMFLTVV_FLOAT(v_max, vx, vl); + v_max_index = VIDV_MASK_UINT(mask, v_max_index, vl); + v_max_index = VADDVX_MASK_UINT(mask, v_max_index, v_max_index, j, vl); + + //update v_max + v_max = VFMAXVV_FLOAT(v_max, vx, vl); + } + + } + + FLOAT_V_T_M1 v_res, v_z0; + v_res = VFMVVF_FLOAT_M1(0, vlmax); + v_z0 = VFMVVF_FLOAT_M1(0, vlmax); + + v_res = VFREDMAXVS_FLOAT(v_res, v_max, v_z0, vlmax); + maxf = VFMVFS_FLOAT_M1(v_res); + mask = VMFGEVF_FLOAT(v_max, maxf, vlmax); + max_index = VFIRSTM(mask, vlmax); + + v_max_index = VSLIDEDOWN_UINT(v_max_index, v_max_index, max_index, vlmax); + max_index = VMVVXS_UINT(v_max_index); + + return(max_index+1); +} diff --git a/kernel/riscv64/iamin_rvv.c b/kernel/riscv64/iamin_rvv.c new file mode 100644 index 000000000..585b37186 --- /dev/null +++ b/kernel/riscv64/iamin_rvv.c @@ -0,0 +1,151 @@ +/*************************************************************************** +Copyright (c) 2022, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" +#include + +#if defined(DOUBLE) +#define VSETVL(n) vsetvl_e64m8(n) +#define VSETVL_MAX vsetvlmax_e64m8() +#define FLOAT_V_T vfloat64m8_t +#define FLOAT_V_T_M1 vfloat64m1_t +#define VLEV_FLOAT vle64_v_f64m8 +#define VLSEV_FLOAT vlse64_v_f64m8 +#define VFREDMINVS_FLOAT vfredmin_vs_f64m8_f64m1 +#define MASK_T vbool8_t +#define VMFLTVF_FLOAT vmflt_vf_f64m8_b8 +#define VMFLTVV_FLOAT vmflt_vv_f64m8_b8 +#define VMFLEVF_FLOAT vmfle_vf_f64m8_b8 +#define VFMVVF_FLOAT vfmv_v_f_f64m8 +#define VFMVVF_FLOAT_M1 vfmv_v_f_f64m1 +#define VFABSV_FLOAT vfabs_v_f64m8 +#define VFMINVV_FLOAT vfmin_vv_f64m8 +#define VFIRSTM vfirst_m_b8 +#define UINT_V_T vuint64m8_t +#define VIDV_MASK_UINT vid_v_u64m8_m +#define VIDV_UINT vid_v_u64m8 +#define VADDVX_MASK_UINT vadd_vx_u64m8_m +#define VADDVX_UINT vadd_vx_u64m8 +#define VMVVX_UINT vmv_v_x_u64m8 +#define VFMVFS_FLOAT_M1 vfmv_f_s_f64m1_f64 +#define VSLIDEDOWN_UINT vslidedown_vx_u64m8 +#define VMVVXS_UINT vmv_x_s_u64m8_u64 +#else +#define VSETVL(n) vsetvl_e32m8(n) +#define VSETVL_MAX vsetvlmax_e32m8() +#define FLOAT_V_T vfloat32m8_t +#define FLOAT_V_T_M1 vfloat32m1_t +#define VLEV_FLOAT vle32_v_f32m8 +#define VLSEV_FLOAT vlse32_v_f32m8 +#define VFREDMINVS_FLOAT vfredmin_vs_f32m8_f32m1 +#define MASK_T vbool4_t +#define VMFLTVF_FLOAT vmflt_vf_f32m8_b4 +#define VMFLTVV_FLOAT vmflt_vv_f32m8_b4 +#define VMFLEVF_FLOAT vmfle_vf_f32m8_b4 +#define VFMVVF_FLOAT vfmv_v_f_f32m8 +#define VFMVVF_FLOAT_M1 vfmv_v_f_f32m1 +#define VFABSV_FLOAT vfabs_v_f32m8 +#define VFMINVV_FLOAT vfmin_vv_f32m8 +#define VFIRSTM vfirst_m_b4 +#define UINT_V_T vuint32m8_t +#define VIDV_MASK_UINT vid_v_u32m8_m +#define VIDV_UINT vid_v_u32m8 +#define VADDVX_MASK_UINT vadd_vx_u32m8_m +#define VADDVX_UINT vadd_vx_u32m8 +#define VMVVX_UINT vmv_v_x_u32m8 +#define VFMVFS_FLOAT_M1 vfmv_f_s_f32m1_f32 +#define VSLIDEDOWN_UINT vslidedown_vx_u32m8 +#define VMVVXS_UINT vmv_x_s_u32m8_u32 +#endif + +BLASLONG CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) +{ + unsigned int min_index = 0; + if (n <= 0 || inc_x <= 0) return(min_index); + + FLOAT_V_T vx, v_min; + UINT_V_T v_min_index; + MASK_T mask; + + size_t vlmax = VSETVL_MAX; + v_min_index = VMVVX_UINT(0, vlmax); + v_min = VFMVVF_FLOAT(FLT_MAX, vlmax); + BLASLONG j=0; + FLOAT minf=0.0; + + if(inc_x == 1) { + + for (size_t vl; n > 0; n -= vl, x += vl, j += vl) { + vl = VSETVL(n); + + vx = VLEV_FLOAT(x, vl); + vx = VFABSV_FLOAT(vx, vl); + + // index where element less than v_min + mask = VMFLTVV_FLOAT(vx, v_min, vl); + v_min_index = VIDV_MASK_UINT(mask, v_min_index, vl); + v_min_index = VADDVX_MASK_UINT(mask, v_min_index, v_min_index, j, vl); + + //update v_min and start_index j + v_min = VFMINVV_FLOAT(v_min, vx, vl); + } + + } else { + + BLASLONG stride_x = inc_x * sizeof(FLOAT); + + for (size_t vl; n > 0; n -= vl, x += vl*inc_x, j += vl) { + vl = VSETVL(n); + + vx = VLSEV_FLOAT(x, stride_x, vl); + vx = VFABSV_FLOAT(vx, vl); + + // index where element less than v_min + mask = VMFLTVV_FLOAT(vx, v_min, vl); + v_min_index = VIDV_MASK_UINT(mask, v_min_index, vl); + v_min_index = VADDVX_MASK_UINT(mask, v_min_index, v_min_index, j, vl); + + //update v_min and start_index j + v_min = VFMINVV_FLOAT(v_min, vx, vl); + } + + } + + FLOAT_V_T_M1 v_res, v_max; + v_res = VFMVVF_FLOAT_M1(0, vlmax); + v_max = VFMVVF_FLOAT_M1(FLT_MAX, vlmax); + + v_res = VFREDMINVS_FLOAT(v_res, v_min, v_max, vlmax); + minf = VFMVFS_FLOAT_M1(v_res); + mask = VMFLEVF_FLOAT(v_min, minf, vlmax); + min_index = VFIRSTM(mask, vlmax); + + v_min_index = VSLIDEDOWN_UINT(v_min_index, v_min_index, min_index, vlmax); + min_index = VMVVXS_UINT(v_min_index); + + return(min_index+1); +} diff --git a/kernel/riscv64/imax_rvv.c b/kernel/riscv64/imax_rvv.c new file mode 100644 index 000000000..d84ad968e --- /dev/null +++ b/kernel/riscv64/imax_rvv.c @@ -0,0 +1,147 @@ +/*************************************************************************** +Copyright (c) 2022, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" +#include + +#if defined(DOUBLE) +#define VSETVL(n) vsetvl_e64m8(n) +#define VSETVL_MAX vsetvlmax_e64m8() +#define FLOAT_V_T vfloat64m8_t +#define FLOAT_V_T_M1 vfloat64m1_t +#define VLEV_FLOAT vle64_v_f64m8 +#define VLSEV_FLOAT vlse64_v_f64m8 +#define VFREDMAXVS_FLOAT vfredmax_vs_f64m8_f64m1 +#define MASK_T vbool8_t +#define VMFLTVF_FLOAT vmflt_vf_f64m8_b8 +#define VMFLTVV_FLOAT vmflt_vv_f64m8_b8 +#define VMFGEVF_FLOAT vmfge_vf_f64m8_b8 +#define VFMVVF_FLOAT vfmv_v_f_f64m8 +#define VFMVVF_FLOAT_M1 vfmv_v_f_f64m1 +#define VFMAXVV_FLOAT vfmax_vv_f64m8 +#define VFIRSTM vfirst_m_b8 +#define UINT_V_T vuint64m8_t +#define VIDV_MASK_UINT vid_v_u64m8_m +#define VIDV_UINT vid_v_u64m8 +#define VADDVX_MASK_UINT vadd_vx_u64m8_m +#define VADDVX_UINT vadd_vx_u64m8 +#define VMVVX_UINT vmv_v_x_u64m8 +#define VFMVFS_FLOAT_M1 vfmv_f_s_f64m1_f64 +#define VSLIDEDOWN_UINT vslidedown_vx_u64m8 +#define VMVVXS_UINT vmv_x_s_u64m8_u64 +#else +#define VSETVL(n) vsetvl_e32m8(n) +#define VSETVL_MAX vsetvlmax_e32m8() +#define FLOAT_V_T vfloat32m8_t +#define FLOAT_V_T_M1 vfloat32m1_t +#define VLEV_FLOAT vle32_v_f32m8 +#define VLSEV_FLOAT vlse32_v_f32m8 +#define VFREDMAXVS_FLOAT vfredmax_vs_f32m8_f32m1 +#define MASK_T vbool4_t +#define VMFLTVF_FLOAT vmflt_vf_f32m8_b4 +#define VMFLTVV_FLOAT vmflt_vv_f32m8_b4 +#define VMFGEVF_FLOAT vmfge_vf_f32m8_b4 +#define VFMVVF_FLOAT vfmv_v_f_f32m8 +#define VFMVVF_FLOAT_M1 vfmv_v_f_f32m1 +#define VFMAXVV_FLOAT vfmax_vv_f32m8 +#define VFIRSTM vfirst_m_b4 +#define UINT_V_T vuint32m8_t +#define VIDV_MASK_UINT vid_v_u32m8_m +#define VIDV_UINT vid_v_u32m8 +#define VADDVX_MASK_UINT vadd_vx_u32m8_m +#define VADDVX_UINT vadd_vx_u32m8 +#define VMVVX_UINT vmv_v_x_u32m8 +#define VFMVFS_FLOAT_M1 vfmv_f_s_f32m1_f32 +#define VSLIDEDOWN_UINT vslidedown_vx_u32m8 +#define VMVVXS_UINT vmv_x_s_u32m8_u32 +#endif + +BLASLONG CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) +{ + unsigned int max_index = 0; + if (n <= 0 || inc_x <= 0) return(max_index); + + FLOAT_V_T vx, v_max; + UINT_V_T v_max_index; + MASK_T mask; + + size_t vlmax = VSETVL_MAX; + v_max_index = VMVVX_UINT(0, vlmax); + v_max = VFMVVF_FLOAT(-FLT_MAX, vlmax); + BLASLONG j=0; + FLOAT maxf=0.0; + + if(inc_x == 1) { + + for (size_t vl; n > 0; n -= vl, x += vl, j += vl) { + vl = VSETVL(n); + + vx = VLEV_FLOAT(x, vl); + + //index where element greater than v_max + mask = VMFLTVV_FLOAT(v_max, vx, vl); + v_max_index = VIDV_MASK_UINT(mask, v_max_index, vl); + v_max_index = VADDVX_MASK_UINT(mask, v_max_index, v_max_index, j, vl); + + //update v_max and start_index j + v_max = VFMAXVV_FLOAT(v_max, vx, vl); + } + + } else { + + BLASLONG stride_x = inc_x * sizeof(FLOAT); + + for (size_t vl; n > 0; n -= vl, x += vl*inc_x, j += vl) { + vl = VSETVL(n); + + vx = VLSEV_FLOAT(x, stride_x, vl); + + //index where element greater than v_max + mask = VMFLTVV_FLOAT(v_max, vx, vl); + v_max_index = VIDV_MASK_UINT(mask, v_max_index, vl); + v_max_index = VADDVX_MASK_UINT(mask, v_max_index, v_max_index, j, vl); + + //update v_max and start_index j + v_max = VFMAXVV_FLOAT(v_max, vx, vl); + } + + } + + FLOAT_V_T_M1 v_res, v_min; + v_res = VFMVVF_FLOAT_M1(0, vlmax); + v_min = VFMVVF_FLOAT_M1(-FLT_MAX, vlmax); + + v_res = VFREDMAXVS_FLOAT(v_res, v_max, v_min, vlmax); + maxf = VFMVFS_FLOAT_M1(v_res); + mask = VMFGEVF_FLOAT(v_max, maxf, vlmax); + max_index = VFIRSTM(mask, vlmax); + + v_max_index = VSLIDEDOWN_UINT(v_max_index, v_max_index, max_index, vlmax); + max_index = VMVVXS_UINT(v_max_index); + + return(max_index+1); +} diff --git a/kernel/riscv64/imin_rvv.c b/kernel/riscv64/imin_rvv.c new file mode 100644 index 000000000..fb734f6f8 --- /dev/null +++ b/kernel/riscv64/imin_rvv.c @@ -0,0 +1,147 @@ +/*************************************************************************** +Copyright (c) 2022, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" +#include + +#if defined(DOUBLE) +#define VSETVL(n) vsetvl_e64m8(n) +#define VSETVL_MAX vsetvlmax_e64m8() +#define FLOAT_V_T vfloat64m8_t +#define FLOAT_V_T_M1 vfloat64m1_t +#define VLEV_FLOAT vle64_v_f64m8 +#define VLSEV_FLOAT vlse64_v_f64m8 +#define VFREDMINVS_FLOAT vfredmin_vs_f64m8_f64m1 +#define MASK_T vbool8_t +#define VMFLTVF_FLOAT vmflt_vf_f64m8_b8 +#define VMFLTVV_FLOAT vmflt_vv_f64m8_b8 +#define VMFLEVF_FLOAT vmfle_vf_f64m8_b8 +#define VFMVVF_FLOAT vfmv_v_f_f64m8 +#define VFMVVF_FLOAT_M1 vfmv_v_f_f64m1 +#define VFMINVV_FLOAT vfmin_vv_f64m8 +#define VFIRSTM vfirst_m_b8 +#define UINT_V_T vuint64m8_t +#define VIDV_MASK_UINT vid_v_u64m8_m +#define VIDV_UINT vid_v_u64m8 +#define VADDVX_MASK_UINT vadd_vx_u64m8_m +#define VADDVX_UINT vadd_vx_u64m8 +#define VMVVX_UINT vmv_v_x_u64m8 +#define VFMVFS_FLOAT_M1 vfmv_f_s_f64m1_f64 +#define VSLIDEDOWN_UINT vslidedown_vx_u64m8 +#define VMVVXS_UINT vmv_x_s_u64m8_u64 +#else +#define VSETVL(n) vsetvl_e32m8(n) +#define VSETVL_MAX vsetvlmax_e32m8() +#define FLOAT_V_T vfloat32m8_t +#define FLOAT_V_T_M1 vfloat32m1_t +#define VLEV_FLOAT vle32_v_f32m8 +#define VLSEV_FLOAT vlse32_v_f32m8 +#define VFREDMINVS_FLOAT vfredmin_vs_f32m8_f32m1 +#define MASK_T vbool4_t +#define VMFLTVF_FLOAT vmflt_vf_f32m8_b4 +#define VMFLTVV_FLOAT vmflt_vv_f32m8_b4 +#define VMFLEVF_FLOAT vmfle_vf_f32m8_b4 +#define VFMVVF_FLOAT vfmv_v_f_f32m8 +#define VFMVVF_FLOAT_M1 vfmv_v_f_f32m1 +#define VFMINVV_FLOAT vfmin_vv_f32m8 +#define VFIRSTM vfirst_m_b4 +#define UINT_V_T vuint32m8_t +#define VIDV_MASK_UINT vid_v_u32m8_m +#define VIDV_UINT vid_v_u32m8 +#define VADDVX_MASK_UINT vadd_vx_u32m8_m +#define VADDVX_UINT vadd_vx_u32m8 +#define VMVVX_UINT vmv_v_x_u32m8 +#define VFMVFS_FLOAT_M1 vfmv_f_s_f32m1_f32 +#define VSLIDEDOWN_UINT vslidedown_vx_u32m8 +#define VMVVXS_UINT vmv_x_s_u32m8_u32 +#endif + +BLASLONG CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) +{ + unsigned int min_index = 0; + if (n <= 0 || inc_x <= 0) return(min_index); + + FLOAT_V_T vx, v_min; + UINT_V_T v_min_index; + MASK_T mask; + + size_t vlmax = VSETVL_MAX; + v_min_index = VMVVX_UINT(0, vlmax); + v_min = VFMVVF_FLOAT(FLT_MAX, vlmax); + BLASLONG j=0; + FLOAT minf=0.0; + + if(inc_x == 1) { + + for (size_t vl; n > 0; n -= vl, x += vl, j += vl) { + vl = VSETVL(n); + + vx = VLEV_FLOAT(x, vl); + + // index where element less than v_min + mask = VMFLTVV_FLOAT(vx, v_min, vl); + v_min_index = VIDV_MASK_UINT(mask, v_min_index, vl); + v_min_index = VADDVX_MASK_UINT(mask, v_min_index, v_min_index, j, vl); + + //update v_min and start_index j + v_min = VFMINVV_FLOAT(v_min, vx, vl); + } + + } else { + + BLASLONG stride_x = inc_x * sizeof(FLOAT); + + for (size_t vl; n > 0; n -= vl, x += vl*inc_x, j += vl) { + vl = VSETVL(n); + + vx = VLSEV_FLOAT(x, stride_x, vl); + + // index where element less than v_min + mask = VMFLTVV_FLOAT(vx, v_min, vl); + v_min_index = VIDV_MASK_UINT(mask, v_min_index, vl); + v_min_index = VADDVX_MASK_UINT(mask, v_min_index, v_min_index, j, vl); + + //update v_min and start_index j + v_min = VFMINVV_FLOAT(v_min, vx, vl); + } + + } + + FLOAT_V_T_M1 v_res, v_max; + v_res = VFMVVF_FLOAT_M1(0, vlmax); + v_max = VFMVVF_FLOAT_M1(FLT_MAX, vlmax); + + v_res = VFREDMINVS_FLOAT(v_res, v_min, v_max, vlmax); + minf = VFMVFS_FLOAT_M1(v_res); + mask = VMFLEVF_FLOAT(v_min, minf, vlmax); + min_index = VFIRSTM(mask, vlmax); + + v_min_index = VSLIDEDOWN_UINT(v_min_index, v_min_index, min_index, vlmax); + min_index = VMVVXS_UINT(v_min_index); + + return(min_index+1); +} diff --git a/kernel/riscv64/izamax_rvv.c b/kernel/riscv64/izamax_rvv.c new file mode 100644 index 000000000..9cb332cbb --- /dev/null +++ b/kernel/riscv64/izamax_rvv.c @@ -0,0 +1,162 @@ +/*************************************************************************** +Copyright (c) 2022, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" + +#if defined(DOUBLE) +#define VSETVL(n) vsetvl_e64m4(n) +#define VSETVL_MAX vsetvlmax_e64m4() +#define FLOAT_V_T vfloat64m4_t +#define FLOAT_V_T_M1 vfloat64m1_t +#define VLEV_FLOAT vle64_v_f64m4 +#define VLSEV_FLOAT vlse64_v_f64m4 +#define VLSEG_FLOAT vlseg2e64_v_f64m4 +#define VLSSEG_FLOAT vlsseg2e64_v_f64m4 +#define VFREDMAXVS_FLOAT vfredmax_vs_f64m4_f64m1 +#define MASK_T vbool16_t +#define VMFLTVF_FLOAT vmflt_vf_f64m4_b16 +#define VMFLTVV_FLOAT vmflt_vv_f64m4_b16 +#define VMFGEVF_FLOAT vmfge_vf_f64m4_b16 +#define VFMVVF_FLOAT vfmv_v_f_f64m4 +#define VFMVVF_FLOAT_M1 vfmv_v_f_f64m1 +#define VFABSV_FLOAT vfabs_v_f64m4 +#define VFMAXVV_FLOAT vfmax_vv_f64m4 +#define VFADDVV_FLOAT vfadd_vv_f64m4 +#define VFIRSTM vfirst_m_b16 +#define UINT_V_T vuint64m4_t +#define VIDV_MASK_UINT vid_v_u64m4_m +#define VIDV_UINT vid_v_u64m4 +#define VADDVX_MASK_UINT vadd_vx_u64m4_m +#define VADDVX_UINT vadd_vx_u64m4 +#define VMVVX_UINT vmv_v_x_u64m4 +#define VFMVFS_FLOAT_M1 vfmv_f_s_f64m1_f64 +#define VSLIDEDOWN_UINT vslidedown_vx_u64m4 +#define VMVVXS_UINT vmv_x_s_u64m4_u64 +#else +#define VSETVL(n) vsetvl_e32m4(n) +#define VSETVL_MAX vsetvlmax_e32m4() +#define FLOAT_V_T vfloat32m4_t +#define FLOAT_V_T_M1 vfloat32m1_t +#define VLEV_FLOAT vle32_v_f32m4 +#define VLSEV_FLOAT vlse32_v_f32m4 +#define VLSEG_FLOAT vlseg2e32_v_f32m4 +#define VLSSEG_FLOAT vlsseg2e32_v_f32m4 +#define VFREDMAXVS_FLOAT vfredmax_vs_f32m4_f32m1 +#define MASK_T vbool8_t +#define VMFLTVF_FLOAT vmflt_vf_f32m4_b8 +#define VMFLTVV_FLOAT vmflt_vv_f32m4_b8 +#define VMFGEVF_FLOAT vmfge_vf_f32m4_b8 +#define VFMVVF_FLOAT vfmv_v_f_f32m4 +#define VFMVVF_FLOAT_M1 vfmv_v_f_f32m1 +#define VFABSV_FLOAT vfabs_v_f32m4 +#define VFMAXVV_FLOAT vfmax_vv_f32m4 +#define VFADDVV_FLOAT vfadd_vv_f32m4 +#define VFIRSTM vfirst_m_b8 +#define UINT_V_T vuint32m4_t +#define VIDV_MASK_UINT vid_v_u32m4_m +#define VIDV_UINT vid_v_u32m4 +#define VADDVX_MASK_UINT vadd_vx_u32m4_m +#define VADDVX_UINT vadd_vx_u32m4 +#define VMVVX_UINT vmv_v_x_u32m4 +#define VFMVFS_FLOAT_M1 vfmv_f_s_f32m1_f32 +#define VSLIDEDOWN_UINT vslidedown_vx_u32m4 +#define VMVVXS_UINT vmv_x_s_u32m4_u32 +#endif + +BLASLONG CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) +{ + unsigned int max_index = 0; + if (n <= 0 || inc_x <= 0) return(max_index); + + FLOAT_V_T vx0, vx1, v_max; + UINT_V_T v_max_index; + MASK_T mask; + + size_t vlmax = VSETVL_MAX; + v_max_index = VMVVX_UINT(0, vlmax); + v_max = VFMVVF_FLOAT(-1, vlmax); + BLASLONG j=0; + FLOAT maxf=0.0; + + if(inc_x == 1) { + + for (size_t vl; n > 0; n -= vl, x += vl*2, j += vl) { + vl = VSETVL(n); + + VLSEG_FLOAT(&vx0, &vx1, x, vl); + + vx0 = VFABSV_FLOAT(vx0, vl); + vx1 = VFABSV_FLOAT(vx1, vl); + + vx0 = VFADDVV_FLOAT(vx0, vx1, vl); + + //index where element greater than v_max + mask = VMFLTVV_FLOAT(v_max, vx0, vl); + v_max_index = VIDV_MASK_UINT(mask, v_max_index, vl); + v_max_index = VADDVX_MASK_UINT(mask, v_max_index, v_max_index, j, vl); + + //update v_max and start_index j + v_max = VFMAXVV_FLOAT(v_max, vx0, vl); + } + } + else { + + BLASLONG stride_x = inc_x * sizeof(FLOAT) * 2; + for (size_t vl; n > 0; n -= vl, x += vl*inc_x*2, j += vl) { + vl = VSETVL(n); + + VLSSEG_FLOAT(&vx0, &vx1, x, stride_x, vl); + + vx0 = VFABSV_FLOAT(vx0, vl); + vx1 = VFABSV_FLOAT(vx1, vl); + + vx0 = VFADDVV_FLOAT(vx0, vx1, vl); + + //index where element greater than v_max + mask = VMFLTVV_FLOAT(v_max, vx0, vl); + v_max_index = VIDV_MASK_UINT(mask, v_max_index, vl); + v_max_index = VADDVX_MASK_UINT(mask, v_max_index, v_max_index, j, vl); + + //update v_max and start_index j + v_max = VFMAXVV_FLOAT(v_max, vx0, vl); + } + + } + FLOAT_V_T_M1 v_res, v_z0; + v_res = VFMVVF_FLOAT_M1(0, vlmax); + v_z0 = VFMVVF_FLOAT_M1(0, vlmax); + + v_res = VFREDMAXVS_FLOAT(v_res, v_max, v_z0, vlmax); + maxf = VFMVFS_FLOAT_M1(v_res); + mask = VMFGEVF_FLOAT(v_max, maxf, vlmax); + max_index = VFIRSTM(mask, vlmax); + + v_max_index = VSLIDEDOWN_UINT(v_max_index, v_max_index, max_index, vlmax); + max_index = VMVVXS_UINT(v_max_index); + + return(max_index+1); +} diff --git a/kernel/riscv64/izamin_rvv.c b/kernel/riscv64/izamin_rvv.c new file mode 100644 index 000000000..69771e5aa --- /dev/null +++ b/kernel/riscv64/izamin_rvv.c @@ -0,0 +1,161 @@ +/*************************************************************************** +Copyright (c) 2022, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" +#include + +#if defined(DOUBLE) +#define VSETVL(n) vsetvl_e64m4(n) +#define VSETVL_MAX vsetvlmax_e64m4() +#define FLOAT_V_T vfloat64m4_t +#define FLOAT_V_T_M1 vfloat64m1_t +#define VLSEG_FLOAT vlseg2e64_v_f64m4 +#define VLSSEG_FLOAT vlsseg2e64_v_f64m4 +#define VFREDMINVS_FLOAT vfredmin_vs_f64m4_f64m1 +#define MASK_T vbool16_t +#define VMFLTVF_FLOAT vmflt_vf_f64m4_b16 +#define VMFLTVV_FLOAT vmflt_vv_f64m4_b16 +#define VMFLEVF_FLOAT vmfle_vf_f64m4_b16 +#define VFMVVF_FLOAT vfmv_v_f_f64m4 +#define VFMVVF_FLOAT_M1 vfmv_v_f_f64m1 +#define VFABSV_FLOAT vfabs_v_f64m4 +#define VFMINVV_FLOAT vfmin_vv_f64m4 +#define VFADDVV_FLOAT vfadd_vv_f64m4 +#define VFIRSTM vfirst_m_b16 +#define UINT_V_T vuint64m4_t +#define VIDV_MASK_UINT vid_v_u64m4_m +#define VIDV_UINT vid_v_u64m4 +#define VADDVX_MASK_UINT vadd_vx_u64m4_m +#define VADDVX_UINT vadd_vx_u64m4 +#define VMVVX_UINT vmv_v_x_u64m4 +#define VFMVFS_FLOAT_M1 vfmv_f_s_f64m1_f64 +#define VSLIDEDOWN_UINT vslidedown_vx_u64m4 +#define VMVVXS_UINT vmv_x_s_u64m4_u64 +#else +#define VSETVL(n) vsetvl_e32m4(n) +#define VSETVL_MAX vsetvlmax_e32m4() +#define FLOAT_V_T vfloat32m4_t +#define FLOAT_V_T_M1 vfloat32m1_t +#define VLSEG_FLOAT vlseg2e32_v_f32m4 +#define VLSSEG_FLOAT vlsseg2e32_v_f32m4 +#define VFREDMINVS_FLOAT vfredmin_vs_f32m4_f32m1 +#define MASK_T vbool8_t +#define VMFLTVF_FLOAT vmflt_vf_f32m4_b8 +#define VMFLTVV_FLOAT vmflt_vv_f32m4_b8 +#define VMFLEVF_FLOAT vmfle_vf_f32m4_b8 +#define VFMVVF_FLOAT vfmv_v_f_f32m4 +#define VFMVVF_FLOAT_M1 vfmv_v_f_f32m1 +#define VFABSV_FLOAT vfabs_v_f32m4 +#define VFMINVV_FLOAT vfmin_vv_f32m4 +#define VFADDVV_FLOAT vfadd_vv_f32m4 +#define VFIRSTM vfirst_m_b8 +#define UINT_V_T vuint32m4_t +#define VIDV_MASK_UINT vid_v_u32m4_m +#define VIDV_UINT vid_v_u32m4 +#define VADDVX_MASK_UINT vadd_vx_u32m4_m +#define VADDVX_UINT vadd_vx_u32m4 +#define VMVVX_UINT vmv_v_x_u32m4 +#define VFMVFS_FLOAT_M1 vfmv_f_s_f32m1_f32 +#define VSLIDEDOWN_UINT vslidedown_vx_u32m4 +#define VMVVXS_UINT vmv_x_s_u32m4_u32 +#endif + +BLASLONG CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) +{ + unsigned int min_index = 0; + if (n <= 0 || inc_x <= 0) return(min_index); + + FLOAT_V_T vx0, vx1, v_min; + UINT_V_T v_min_index; + MASK_T mask; + + size_t vlmax = VSETVL_MAX; + v_min_index = VMVVX_UINT(0, vlmax); + v_min = VFMVVF_FLOAT(FLT_MAX, vlmax); + BLASLONG j=0; + FLOAT minf=0.0; + + if(inc_x == 1) { + + for (size_t vl; n > 0; n -= vl, x += vl*2, j += vl) { + vl = VSETVL(n); + + VLSEG_FLOAT(&vx0, &vx1, x, vl); + + vx0 = VFABSV_FLOAT(vx0, vl); + vx1 = VFABSV_FLOAT(vx1, vl); + + vx0 = VFADDVV_FLOAT(vx0, vx1, vl); + + // index where element less than v_min + mask = VMFLTVV_FLOAT(vx0, v_min, vl); + v_min_index = VIDV_MASK_UINT(mask, v_min_index, vl); + v_min_index = VADDVX_MASK_UINT(mask, v_min_index, v_min_index, j, vl); + + //update v_min and start_index j + v_min = VFMINVV_FLOAT(v_min, vx0, vl); + } + + } else { + + BLASLONG stride_x = inc_x * sizeof(FLOAT) * 2; + + for (size_t vl; n > 0; n -= vl, x += vl*inc_x*2, j += vl) { + vl = VSETVL(n); + + VLSSEG_FLOAT(&vx0, &vx1, x, stride_x, vl); + + vx0 = VFABSV_FLOAT(vx0, vl); + vx1 = VFABSV_FLOAT(vx1, vl); + + vx0 = VFADDVV_FLOAT(vx0, vx1, vl); + + // index where element less than v_min + mask = VMFLTVV_FLOAT(vx0, v_min, vl); + v_min_index = VIDV_MASK_UINT(mask, v_min_index, vl); + v_min_index = VADDVX_MASK_UINT(mask, v_min_index, v_min_index, j, vl); + + //update v_min and start_index j + v_min = VFMINVV_FLOAT(v_min, vx0, vl); + } + + } + + FLOAT_V_T_M1 v_res, v_max; + v_res = VFMVVF_FLOAT_M1(0, vlmax); + v_max = VFMVVF_FLOAT_M1(FLT_MAX, vlmax); + + v_res = VFREDMINVS_FLOAT(v_res, v_min, v_max, vlmax); + minf = VFMVFS_FLOAT_M1(v_res); + mask = VMFLEVF_FLOAT(v_min, minf, vlmax); + min_index = VFIRSTM(mask, vlmax); + + v_min_index = VSLIDEDOWN_UINT(v_min_index, v_min_index, min_index, vlmax); + min_index = VMVVXS_UINT(v_min_index); + + return(min_index+1); +} diff --git a/kernel/riscv64/max_rvv.c b/kernel/riscv64/max_rvv.c new file mode 100644 index 000000000..5b1380d2b --- /dev/null +++ b/kernel/riscv64/max_rvv.c @@ -0,0 +1,98 @@ +/*************************************************************************** +Copyright (c) 2022, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" +#include + +#if !defined(DOUBLE) +#define VSETVL(n) vsetvl_e32m8(n) +#define VSETVL_MAX vsetvlmax_e32m8() +#define VSETVL_MAX_M1 vsetvlmax_e32m1() +#define FLOAT_V_T vfloat32m8_t +#define FLOAT_V_T_M1 vfloat32m1_t +#define VLEV_FLOAT vle32_v_f32m8 +#define VLSEV_FLOAT vlse32_v_f32m8 +#define VFREDMAXVS_FLOAT vfredmax_vs_f32m8_f32m1 +#define VFMVVF_FLOAT vfmv_v_f_f32m8 +#define VFMVVF_FLOAT_M1 vfmv_v_f_f32m1 +#define VFMAXVV_FLOAT vfmax_vv_f32m8 +#define VFMVFS_FLOAT_M1 vfmv_f_s_f32m1_f32 +#else +#define VSETVL(n) vsetvl_e64m8(n) +#define VSETVL_MAX vsetvlmax_e64m8() +#define VSETVL_MAX_M1 vsetvlmax_e64m1() +#define FLOAT_V_T vfloat64m8_t +#define FLOAT_V_T_M1 vfloat64m1_t +#define VLEV_FLOAT vle64_v_f64m8 +#define VLSEV_FLOAT vlse64_v_f64m8 +#define VFREDMAXVS_FLOAT vfredmax_vs_f64m8_f64m1 +#define VFMVVF_FLOAT vfmv_v_f_f64m8 +#define VFMVVF_FLOAT_M1 vfmv_v_f_f64m1 +#define VFMAXVV_FLOAT vfmax_vv_f64m8 +#define VFMVFS_FLOAT_M1 vfmv_f_s_f64m1_f64 +#endif + +FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) +{ + FLOAT maxf = 0.0; + + if (n <= 0 || inc_x <= 0) return(maxf); + + FLOAT_V_T vx, vmax; + FLOAT_V_T_M1 v_res; + + v_res = VFMVVF_FLOAT_M1(-FLT_MAX, VSETVL_MAX_M1); + size_t vlmax = VSETVL_MAX; + vmax = VFMVVF_FLOAT(-FLT_MAX, vlmax); + + if(inc_x == 1) { + + for (size_t vl; n > 0; n -= vl, x += vl) { + vl = VSETVL(n); + + vx = VLEV_FLOAT(x, vl); + vmax = VFMAXVV_FLOAT(vmax, vx, vl); + } + + } else { + + BLASLONG stride_x = inc_x * sizeof(FLOAT); + + for (size_t vl; n > 0; n -= vl, x += vl*inc_x) { + vl = VSETVL(n); + + vx = VLSEV_FLOAT(x, stride_x, vl); + vmax = VFMAXVV_FLOAT(vmax, vx, vl); + } + + } + + v_res = VFREDMAXVS_FLOAT(v_res, vmax, v_res, vlmax); + maxf = VFMVFS_FLOAT_M1(v_res); + + return(maxf); +} diff --git a/kernel/riscv64/min_rvv.c b/kernel/riscv64/min_rvv.c new file mode 100644 index 000000000..bddcc0ba7 --- /dev/null +++ b/kernel/riscv64/min_rvv.c @@ -0,0 +1,98 @@ +/*************************************************************************** +Copyright (c) 2022, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" +#include + +#if !defined(DOUBLE) +#define VSETVL(n) vsetvl_e32m8(n) +#define VSETVL_MAX vsetvlmax_e32m8() +#define VSETVL_MAX_M1 vsetvlmax_e32m1() +#define FLOAT_V_T vfloat32m8_t +#define FLOAT_V_T_M1 vfloat32m1_t +#define VLEV_FLOAT vle32_v_f32m8 +#define VLSEV_FLOAT vlse32_v_f32m8 +#define VFREDMINVS_FLOAT vfredmin_vs_f32m8_f32m1 +#define VFMVVF_FLOAT vfmv_v_f_f32m8 +#define VFMVVF_FLOAT_M1 vfmv_v_f_f32m1 +#define VFMINVV_FLOAT vfmin_vv_f32m8 +#define VFMVFS_FLOAT_M1 vfmv_f_s_f32m1_f32 +#else +#define VSETVL(n) vsetvl_e64m8(n) +#define VSETVL_MAX vsetvlmax_e64m8() +#define VSETVL_MAX_M1 vsetvlmax_e64m1() +#define FLOAT_V_T vfloat64m8_t +#define FLOAT_V_T_M1 vfloat64m1_t +#define VLEV_FLOAT vle64_v_f64m8 +#define VLSEV_FLOAT vlse64_v_f64m8 +#define VFREDMINVS_FLOAT vfredmin_vs_f64m8_f64m1 +#define VFMVVF_FLOAT vfmv_v_f_f64m8 +#define VFMVVF_FLOAT_M1 vfmv_v_f_f64m1 +#define VFMINVV_FLOAT vfmin_vv_f64m8 +#define VFMVFS_FLOAT_M1 vfmv_f_s_f64m1_f64 +#endif + +FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) +{ + FLOAT minf = 0.0; + + if (n <= 0 || inc_x <= 0) return(minf); + + FLOAT_V_T vx, vmin; + FLOAT_V_T_M1 v_res; + + v_res = VFMVVF_FLOAT_M1(FLT_MAX, VSETVL_MAX_M1); + size_t vlmax = VSETVL_MAX; + vmin = VFMVVF_FLOAT(FLT_MAX, vlmax); + + if(inc_x == 1) { + + for (size_t vl; n > 0; n -= vl, x += vl) { + vl = VSETVL(n); + + vx = VLEV_FLOAT(x, vl); + vmin = VFMINVV_FLOAT(vmin, vx, vl); + } + + } else { + + BLASLONG stride_x = inc_x * sizeof(FLOAT); + + for (size_t vl; n > 0; n -= vl, x += vl*inc_x) { + vl = VSETVL(n); + + vx = VLSEV_FLOAT(x, stride_x, vl); + vmin = VFMINVV_FLOAT(vmin, vx, vl); + } + + } + + v_res = VFREDMINVS_FLOAT(v_res, vmin, v_res, vlmax); + minf = VFMVFS_FLOAT_M1(v_res); + + return(minf); +} diff --git a/kernel/riscv64/nrm2_rvv.c b/kernel/riscv64/nrm2_rvv.c new file mode 100644 index 000000000..3f5d50397 --- /dev/null +++ b/kernel/riscv64/nrm2_rvv.c @@ -0,0 +1,117 @@ +/*************************************************************************** +Copyright (c) 2022, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" +#include + +#if !defined(DOUBLE) +#define VSETVL(n) vsetvl_e32m8(n) +#define VSETVL_MAX vsetvlmax_e32m8() +#define FLOAT_V_T vfloat32m8_t +#define FLOAT_V_T_M1 vfloat32m1_t +#define VLEV_FLOAT vle32_v_f32m8 +#define VLSEV_FLOAT vlse32_v_f32m8 +#define VFREDSUM_FLOAT vfredusum_vs_f32m8_f32m1 +#define VFMACCVV_FLOAT vfmacc_vv_f32m8 +#define VFMVVF_FLOAT vfmv_v_f_f32m8 +#define VFMVVF_FLOAT_M1 vfmv_v_f_f32m1 +#define VFREDMAXVS_FLOAT vfredmax_vs_f32m8_f32m1 +#define VFMVFS_FLOAT_M1 vfmv_f_s_f32m1_f32 +#define VFABSV_FLOAT vfabs_v_f32m8 +#define ABS fabsf +#else +#define VSETVL(n) vsetvl_e64m8(n) +#define VSETVL_MAX vsetvlmax_e64m8() +#define FLOAT_V_T vfloat64m8_t +#define FLOAT_V_T_M1 vfloat64m1_t +#define VLEV_FLOAT vle64_v_f64m8 +#define VLSEV_FLOAT vlse64_v_f64m8 +#define VFREDSUM_FLOAT vfredusum_vs_f64m8_f64m1 +#define VFMACCVV_FLOAT vfmacc_vv_f64m8 +#define VFMVVF_FLOAT vfmv_v_f_f64m8 +#define VFMVVF_FLOAT_M1 vfmv_v_f_f64m1 +#define VFREDMAXVS_FLOAT vfredmax_vs_f64m8_f64m1 +#define VFMVFS_FLOAT_M1 vfmv_f_s_f64m1_f64 +#define VFABSV_FLOAT vfabs_v_f64m8 +#define ABS fabs +#endif + + +FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) +{ + + if( n <= 0 ) return(0.0); + if(n == 1) return (ABS(x[0])); + + FLOAT_V_T vr, v0; + FLOAT_V_T_M1 v_max, v_res; + FLOAT scale = 0.0, ssq = 0.0; + + size_t vlmax = VSETVL_MAX; + v_res = VFMVVF_FLOAT_M1(0, vlmax); + v_max = VFMVVF_FLOAT_M1(0, vlmax); + + vr = VFMVVF_FLOAT(0, vlmax); + + if(inc_x == 1) { + + for (size_t vl; n > 0; n -= vl, x += vl) { + vl = VSETVL(n); + + v0 = VLEV_FLOAT(x, vl); + v0 = VFABSV_FLOAT(v0, vl); + + v_max = VFREDMAXVS_FLOAT(v_max, v0, v_max, vl); + + vr = VFMACCVV_FLOAT(vr, v0, v0, vl); + } + + } else { + + BLASLONG stride_x = inc_x * sizeof(FLOAT); + + for (size_t vl; n > 0; n -= vl, x += vl * inc_x) { + vl = VSETVL(n); + + v0 = VLSEV_FLOAT(x, stride_x, vl); + v0 = VFABSV_FLOAT(v0, vl); + + v_max = VFREDMAXVS_FLOAT(v_max, v0, v_max, vl); + + vr = VFMACCVV_FLOAT(vr, v0, v0, vl); + } + + } + + v_res = VFREDSUM_FLOAT(v_res, vr, v_res, vlmax); + + ssq = VFMVFS_FLOAT_M1(v_res); + scale = VFMVFS_FLOAT_M1(v_max); + ssq = ssq / (scale*scale); + + return(scale * sqrt(ssq)); +} diff --git a/kernel/riscv64/rot_rvv.c b/kernel/riscv64/rot_rvv.c new file mode 100644 index 000000000..7bf5e4270 --- /dev/null +++ b/kernel/riscv64/rot_rvv.c @@ -0,0 +1,149 @@ +/*************************************************************************** +Copyright (c) 2022, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" + +#if !defined(DOUBLE) +#define VSETVL(n) vsetvl_e32m8(n) +#define FLOAT_V_T vfloat32m8_t +#define VLEV_FLOAT vle32_v_f32m8 +#define VLSEV_FLOAT vlse32_v_f32m8 +#define VSEV_FLOAT vse32_v_f32m8 +#define VSSEV_FLOAT vsse32_v_f32m8 +#define VFMACCVF_FLOAT vfmacc_vf_f32m8 +#define VFMULVF_FLOAT vfmul_vf_f32m8 +#define VFMSACVF_FLOAT vfmsac_vf_f32m8 +#else +#define VSETVL(n) vsetvl_e64m8(n) +#define FLOAT_V_T vfloat64m8_t +#define VLEV_FLOAT vle64_v_f64m8 +#define VLSEV_FLOAT vlse64_v_f64m8 +#define VSEV_FLOAT vse64_v_f64m8 +#define VSSEV_FLOAT vsse64_v_f64m8 +#define VFMACCVF_FLOAT vfmacc_vf_f64m8 +#define VFMULVF_FLOAT vfmul_vf_f64m8 +#define VFMSACVF_FLOAT vfmsac_vf_f64m8 +#endif + +int CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y, FLOAT c, FLOAT s) +{ + + if(n <= 0) return(0); + + FLOAT_V_T v0, v1, vx, vy; + + if (inc_x == 0 || inc_y == 0) { + BLASLONG i=0; + BLASLONG ix=0,iy=0; + FLOAT temp; + while(i < n) + { + temp = c*x[ix] + s*y[iy] ; + y[iy] = c*y[iy] - s*x[ix] ; + x[ix] = temp ; + + ix += inc_x ; + iy += inc_y ; + i++ ; + } + } + else if(inc_x == 1 && inc_y == 1) { + + for (size_t vl; n > 0; n -= vl, x += vl, y += vl) { + vl = VSETVL(n); + + vx = VLEV_FLOAT(x, vl); + vy = VLEV_FLOAT(y, vl); + + v0 = VFMULVF_FLOAT(vx, c, vl); + v0 = VFMACCVF_FLOAT(v0, s, vy, vl); + VSEV_FLOAT(x, v0, vl); + + v1 = VFMULVF_FLOAT(vx, s, vl); + v1 = VFMSACVF_FLOAT(v1, c, vy, vl); + VSEV_FLOAT(y, v1, vl); + } + + } else if(inc_y == 1) { + BLASLONG stride_x = inc_x * sizeof(FLOAT); + + for (size_t vl; n > 0; n -= vl, x += vl*inc_x, y += vl) { + vl = VSETVL(n); + + vx = VLSEV_FLOAT(x, stride_x, vl); + vy = VLEV_FLOAT(y, vl); + + v0 = VFMULVF_FLOAT(vx, c, vl); + v0 = VFMACCVF_FLOAT(v0, s, vy, vl); + VSSEV_FLOAT(x, stride_x, v0, vl); + + v1 = VFMULVF_FLOAT(vx, s, vl); + v1 = VFMSACVF_FLOAT(v1, c, vy, vl); + VSEV_FLOAT(y, v1, vl); + } + + } else if(inc_x == 1) { + BLASLONG stride_y = inc_y * sizeof(FLOAT); + + for (size_t vl; n > 0; n -= vl, x += vl, y += vl*inc_y) { + vl = VSETVL(n); + + vx = VLEV_FLOAT(x, vl); + vy = VLSEV_FLOAT(y, stride_y, vl); + + v0 = VFMULVF_FLOAT(vx, c, vl); + v0 = VFMACCVF_FLOAT(v0, s, vy, vl); + VSEV_FLOAT(x, v0, vl); + + v1 = VFMULVF_FLOAT(vx, s, vl); + v1 = VFMSACVF_FLOAT(v1, c, vy, vl); + VSSEV_FLOAT(y, stride_y, v1, vl); + } + + } else { + BLASLONG stride_x = inc_x * sizeof(FLOAT); + BLASLONG stride_y = inc_y * sizeof(FLOAT); + + for (size_t vl; n > 0; n -= vl, x += vl*inc_x, y += vl*inc_y) { + vl = VSETVL(n); + + vx = VLSEV_FLOAT(x, stride_x, vl); + vy = VLSEV_FLOAT(y, stride_y, vl); + + v0 = VFMULVF_FLOAT(vx, c, vl); + v0 = VFMACCVF_FLOAT(v0, s, vy, vl); + VSSEV_FLOAT(x, stride_x, v0, vl); + + v1 = VFMULVF_FLOAT(vx, s, vl); + v1 = VFMSACVF_FLOAT(v1, c, vy, vl); + VSSEV_FLOAT(y, stride_y, v1, vl); + } + + } + + return(0); +} diff --git a/kernel/riscv64/scal_rvv.c b/kernel/riscv64/scal_rvv.c new file mode 100644 index 000000000..d2c0378bf --- /dev/null +++ b/kernel/riscv64/scal_rvv.c @@ -0,0 +1,80 @@ +/*************************************************************************** +Copyright (c) 2020, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" + +#if !defined(DOUBLE) +#define VSETVL(n) vsetvl_e32m8(n) +#define FLOAT_V_T vfloat32m8_t +#define VLEV_FLOAT vle32_v_f32m8 +#define VLSEV_FLOAT vlse32_v_f32m8 +#define VSEV_FLOAT vse32_v_f32m8 +#define VSSEV_FLOAT vsse32_v_f32m8 +#define VFMULVF_FLOAT vfmul_vf_f32m8 +#define VFMVVF_FLOAT vfmv_v_f_f32m8 +#else +#define VSETVL(n) vsetvl_e64m8(n) +#define FLOAT_V_T vfloat64m8_t +#define VLEV_FLOAT vle64_v_f64m8 +#define VLSEV_FLOAT vlse64_v_f64m8 +#define VSEV_FLOAT vse64_v_f64m8 +#define VSSEV_FLOAT vsse64_v_f64m8 +#define VFMULVF_FLOAT vfmul_vf_f64m8 +#define VFMVVF_FLOAT vfmv_v_f_f64m8 +#endif + +int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT da, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y, FLOAT *dummy, BLASLONG dummy2) +{ + if ( (n <= 0) || (inc_x <= 0)) return(0); + + FLOAT_V_T v0; + + if(inc_x == 1) { + + for (size_t vl; n > 0; n -= vl, x += vl) { + vl = VSETVL(n); + + v0 = VLEV_FLOAT(x, vl); + v0 = VFMULVF_FLOAT(v0, da, vl); + VSEV_FLOAT(x, v0, vl); + } + + } else { + BLASLONG stride_x = inc_x * sizeof(FLOAT); + + for (size_t vl; n > 0; n -= vl, x += vl*inc_x) { + vl = VSETVL(n); + + v0 = VLSEV_FLOAT(x, stride_x, vl); + v0 = VFMULVF_FLOAT(v0, da, vl); + VSSEV_FLOAT(x, stride_x, v0, vl); + } + + } + + return 0; +} diff --git a/kernel/riscv64/sum_rvv.c b/kernel/riscv64/sum_rvv.c new file mode 100644 index 000000000..1db0d09dd --- /dev/null +++ b/kernel/riscv64/sum_rvv.c @@ -0,0 +1,95 @@ +/*************************************************************************** +Copyright (c) 2022, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" + +#if !defined(DOUBLE) +#define VSETVL(n) vsetvl_e32m8(n) +#define VSETVL_MAX vsetvlmax_e32m8() +#define VSETVL_MAX_M1 vsetvlmax_e32m1() +#define FLOAT_V_T vfloat32m8_t +#define FLOAT_V_T_M1 vfloat32m1_t +#define VLEV_FLOAT vle32_v_f32m8 +#define VLSEV_FLOAT vlse32_v_f32m8 +#define VFMVVF_FLOAT vfmv_v_f_f32m8 +#define VFADDVV_FLOAT vfadd_vv_f32m8 +#define VFREDSUMVS_FLOAT vfredusum_vs_f32m8_f32m1 +#define VFMVVF_FLOAT_M1 vfmv_v_f_f32m1 +#define VFMVFS_FLOAT_M1 vfmv_f_s_f32m1_f32 +#else +#define VSETVL(n) vsetvl_e64m8(n) +#define VSETVL_MAX vsetvlmax_e64m8() +#define VSETVL_MAX_M1 vsetvlmax_e64m1() +#define FLOAT_V_T vfloat64m8_t +#define FLOAT_V_T_M1 vfloat64m1_t +#define VLEV_FLOAT vle64_v_f64m8 +#define VLSEV_FLOAT vlse64_v_f64m8 +#define VFMVVF_FLOAT vfmv_v_f_f64m8 +#define VFADDVV_FLOAT vfadd_vv_f64m8 +#define VFREDSUMVS_FLOAT vfredusum_vs_f64m8_f64m1 +#define VFMVVF_FLOAT_M1 vfmv_v_f_f64m1 +#define VFMVFS_FLOAT_M1 vfmv_f_s_f64m1_f64 +#endif + +FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) +{ + FLOAT sumf = 0.0; + if (n <= 0 || inc_x <= 0) return(sumf); + + FLOAT_V_T vx, vsum; + FLOAT_V_T_M1 v_res; + + v_res = VFMVVF_FLOAT_M1(0, VSETVL_MAX_M1); + size_t vlmax = VSETVL_MAX; + vsum = VFMVVF_FLOAT(0.0, vlmax); + + if(inc_x == 1) { + + for (size_t vl; n > 0; n -= vl, x += vl) { + vl = VSETVL(n); + + vx = VLEV_FLOAT(x, vl); + vsum = VFADDVV_FLOAT(vsum, vx, vl); + } + + } else { + + BLASLONG stride_x = inc_x * sizeof(FLOAT); + + for (size_t vl; n > 0; n -= vl, x += vl*inc_x) { + vl = VSETVL(n); + + vx = VLSEV_FLOAT(x, stride_x, vl); + vsum = VFADDVV_FLOAT(vsum, vx, vl); + } + + } + + v_res = VFREDSUMVS_FLOAT(v_res, vsum, v_res, vlmax); + sumf = VFMVFS_FLOAT_M1(v_res); + return(sumf); +} diff --git a/kernel/riscv64/swap_rvv.c b/kernel/riscv64/swap_rvv.c new file mode 100644 index 000000000..2cf92f6ad --- /dev/null +++ b/kernel/riscv64/swap_rvv.c @@ -0,0 +1,142 @@ +/*************************************************************************** +Copyright (c) 2022, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" + +#if !defined(DOUBLE) +#define VSETVL(n) vsetvl_e32m8(n) +#define VSETVL_MAX vsetvlmax_e32m8() +#define FLOAT_V_T vfloat32m8_t +#define VLEV_FLOAT vle32_v_f32m8 +#define VLSEV_FLOAT vlse32_v_f32m8 +#define VSEV_FLOAT vse32_v_f32m8 +#define VSSEV_FLOAT vsse32_v_f32m8 +#define VFMVVF_FLOAT vfmv_v_f_f32m8 +#else +#define VSETVL(n) vsetvl_e64m8(n) +#define VSETVL_MAX vsetvlmax_e64m8() +#define FLOAT_V_T vfloat64m8_t +#define VLEV_FLOAT vle64_v_f64m8 +#define VLSEV_FLOAT vlse64_v_f64m8 +#define VSEV_FLOAT vse64_v_f64m8 +#define VSSEV_FLOAT vsse64_v_f64m8 +#define VFMVVF_FLOAT vfmv_v_f_f64m8 +#endif + +int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT dummy3, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y, FLOAT *dummy, BLASLONG dummy2) +{ + BLASLONG stride_x, stride_y; + FLOAT_V_T vx, vy; + + if (n <= 0) return(0); + + if (inc_x == 0 && inc_y == 0) { + if (n & 1) { + FLOAT temp = x[0]; + x[0] = y[0]; + y[0] = temp; + } + else { + return 0; + } + } + else if(inc_x == 0) { + FLOAT temp = x[0]; + x[0] = y[(n - 1) * inc_y]; + FLOAT* ptr = y + (n - 1) * inc_y; // start from the last one + stride_y = (0 - inc_y) * sizeof(FLOAT); // reverse + BLASLONG m = n - 1; + for (size_t vl; m > 0; m -= vl, ptr -= vl*inc_y) { + vl = VSETVL(m); + vy = VLSEV_FLOAT(ptr - 1, stride_y, vl); + VSSEV_FLOAT(ptr, stride_y, vy, vl); + } + y[0] = temp; + } + else if(inc_y == 0) { + FLOAT temp = y[0]; + y[0] = x[(n - 1) * inc_x]; + FLOAT* ptr = x + (n - 1) * inc_x; // start from the last one + stride_x = (0 - inc_x) * sizeof(FLOAT); // reverse + BLASLONG m = n - 1; + for (size_t vl; m > 0; m -= vl, ptr -= vl*inc_x) { + vl = VSETVL(m); + vx = VLSEV_FLOAT(ptr - 1, stride_x, vl); + VSSEV_FLOAT(ptr, stride_x, vx, vl); + } + x[0] = temp; + } + else if(inc_x == 1 && inc_y == 1) { + for (size_t vl; n > 0; n -= vl, x += vl, y += vl) { + vl = VSETVL(n); + + vx = VLEV_FLOAT(x, vl); + vy = VLEV_FLOAT(y, vl); + VSEV_FLOAT(y, vx, vl); + VSEV_FLOAT(x, vy, vl); + } + + } else if (inc_y == 1) { + stride_x = inc_x * sizeof(FLOAT); + + for (size_t vl; n > 0; n -= vl, x += vl*inc_x, y += vl) { + vl = VSETVL(n); + + vx = VLSEV_FLOAT(x, stride_x, vl); + vy = VLEV_FLOAT(y, vl); + VSEV_FLOAT(y, vx, vl); + VSSEV_FLOAT(x, stride_x, vy, vl); + } + + } else if(inc_x == 1) { + stride_y = inc_y * sizeof(FLOAT); + + for (size_t vl; n > 0; n -= vl, x += vl, y += vl*inc_y) { + vl = VSETVL(n); + + vx = VLEV_FLOAT(x, vl); + vy = VLSEV_FLOAT(y, stride_y, vl); + VSSEV_FLOAT(y, stride_y, vx, vl); + VSEV_FLOAT(x, vy, vl); + } + + } else { + stride_x = inc_x * sizeof(FLOAT); + stride_y = inc_y * sizeof(FLOAT); + + for (size_t vl; n > 0; n -= vl, x += vl*inc_x, y += vl*inc_y) { + vl = VSETVL(n); + + vx = VLSEV_FLOAT(x, stride_x, vl); + vy = VLSEV_FLOAT(y, stride_y, vl); + VSSEV_FLOAT(y, stride_y, vx, vl); + VSSEV_FLOAT(x, stride_x, vy, vl); + } + } + + return(0); +} diff --git a/kernel/riscv64/symm_lcopy_rvv_v1.c b/kernel/riscv64/symm_lcopy_rvv_v1.c new file mode 100644 index 000000000..f0def9617 --- /dev/null +++ b/kernel/riscv64/symm_lcopy_rvv_v1.c @@ -0,0 +1,101 @@ +/*************************************************************************** +Copyright (c) 2022, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" + +#if !defined(DOUBLE) +#define VSETVL(n) vsetvl_e32m2(n) +#define VSETVL_MAX vsetvlmax_e32m2() +#define FLOAT_V_T vfloat32m2_t +#define VLEV_FLOAT vle32_v_f32m2 +#define VSEV_FLOAT vse32_v_f32m2 +#define VLSEV_FLOAT vlse32_v_f32m2 +#define INT_V_T vint32m2_t +#define VID_V_INT vid_v_i32m2 +#define VADD_VX_INT vadd_vx_i32m2 +#define VMSGT_VX_INT vmsgt_vx_i32m2_b16 +#define VBOOL_T vbool16_t +#define VMERGE_VVM_FLOAT vmerge_vvm_f32m2 +#else +#define VSETVL(n) vsetvl_e64m2(n) +#define VSETVL_MAX vsetvlmax_e64m2() +#define FLOAT_V_T vfloat64m2_t +#define VLEV_FLOAT vle64_v_f64m2 +#define VSEV_FLOAT vse64_v_f64m2 +#define VLSEV_FLOAT vlse64_v_f64m2 +#define INT_V_T vint64m2_t +#define VID_V_INT vid_v_i64m2 +#define VADD_VX_INT vadd_vx_i64m2 +#define VMSGT_VX_INT vmsgt_vx_i64m2_b32 +#define VBOOL_T vbool32_t +#define VMERGE_VVM_FLOAT vmerge_vvm_f64m2 +#endif + +// Optimizes the implementation in ../generic/symm_lcopy_4.c + +int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG posX, BLASLONG posY, FLOAT *b) +{ + BLASLONG i, js, offset; + + FLOAT *ao1, *ao2; + + BLASLONG stride_lda = sizeof(FLOAT)*lda; + + FLOAT_V_T vb, va1, va2; + VBOOL_T vbool; + INT_V_T vindex_max, vindex; + + size_t vl = VSETVL_MAX; + vindex_max = VID_V_INT(vl); + + for (js = n; js > 0; js -= vl, posX += vl) { + vl = VSETVL(js); + offset = posX - posY; + + ao1 = a + posX + posY * lda; + ao2 = a + posY + (posX) * lda; + + for (i = m; i > 0; i--, offset--) { + va2 = VLSEV_FLOAT(ao2, stride_lda, vl); + va1 = VLEV_FLOAT(ao1, vl); + + // offset > (0 - vindex) ---> (offset + vindex) > 0 + vindex = VADD_VX_INT(vindex_max, offset, vl); + vbool = VMSGT_VX_INT(vindex, 0, vl); + + vb = VMERGE_VVM_FLOAT(vbool, va2, va1, vl); + VSEV_FLOAT(b, vb, vl); + + b += vl; + ao1 += lda; + ao2++; + } + } + + return 0; +} + diff --git a/kernel/riscv64/symm_ucopy_rvv_v1.c b/kernel/riscv64/symm_ucopy_rvv_v1.c new file mode 100644 index 000000000..958506df3 --- /dev/null +++ b/kernel/riscv64/symm_ucopy_rvv_v1.c @@ -0,0 +1,100 @@ +/*************************************************************************** +Copyright (c) 2022, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" + +#if !defined(DOUBLE) +#define VSETVL(n) vsetvl_e32m2(n) +#define VSETVL_MAX vsetvlmax_e32m2() +#define FLOAT_V_T vfloat32m2_t +#define VLEV_FLOAT vle32_v_f32m2 +#define VSEV_FLOAT vse32_v_f32m2 +#define VLSEV_FLOAT vlse32_v_f32m2 +#define INT_V_T vint32m2_t +#define VID_V_INT vid_v_i32m2 +#define VADD_VX_INT vadd_vx_i32m2 +#define VMSGT_VX_INT vmsgt_vx_i32m2_b16 +#define VBOOL_T vbool16_t +#define VMERGE_VVM_FLOAT vmerge_vvm_f32m2 +#else +#define VSETVL(n) vsetvl_e64m2(n) +#define VSETVL_MAX vsetvlmax_e64m2() +#define FLOAT_V_T vfloat64m2_t +#define VLEV_FLOAT vle64_v_f64m2 +#define VSEV_FLOAT vse64_v_f64m2 +#define VLSEV_FLOAT vlse64_v_f64m2 +#define INT_V_T vint64m2_t +#define VID_V_INT vid_v_i64m2 +#define VADD_VX_INT vadd_vx_i64m2 +#define VMSGT_VX_INT vmsgt_vx_i64m2_b32 +#define VBOOL_T vbool32_t +#define VMERGE_VVM_FLOAT vmerge_vvm_f64m2 +#endif + +// Optimizes the implementation in ../generic/symm_ucopy_4.c + +int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG posX, BLASLONG posY, FLOAT *b) +{ + BLASLONG i, js, offset; + + FLOAT *ao1, *ao2; + + BLASLONG stride_lda = sizeof(FLOAT)*lda; + + FLOAT_V_T vb, va1, va2; + VBOOL_T vbool; + INT_V_T vindex_max, vindex; + + size_t vl = VSETVL_MAX; + vindex_max = VID_V_INT(vl); + + for (js = n; js > 0; js -= vl, posX += vl) { + vl = VSETVL(js); + offset = posX - posY; + + ao1 = a + posY + (posX + 0) * lda; + ao2 = a + posX + 0 + posY * lda; + + for (i = m; i > 0; i--, offset--) { + va1 = VLSEV_FLOAT(ao1, stride_lda, vl); + va2 = VLEV_FLOAT(ao2, vl); + + // offset > (0 - vindex) ---> (offset + vindex) > 0 + vindex = VADD_VX_INT(vindex_max, offset, vl); + vbool = VMSGT_VX_INT(vindex, 0, vl); + + vb = VMERGE_VVM_FLOAT(vbool, va2, va1, vl); + VSEV_FLOAT(b, vb, vl); + + b += vl; + ao1++; + ao2 += lda; + } + } + + return 0; +} diff --git a/kernel/riscv64/symv_L_rvv.c b/kernel/riscv64/symv_L_rvv.c new file mode 100644 index 000000000..737abaae3 --- /dev/null +++ b/kernel/riscv64/symv_L_rvv.c @@ -0,0 +1,224 @@ +/*************************************************************************** +Copyright (c) 2022, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" + +#if !defined(DOUBLE) +#define VSETVL_MAX_M1 vsetvlmax_e32m1() +#define VSETVL(n) vsetvl_e32m8(n) +#define VSETVL_MAX vsetvlmax_e32m8() +#define FLOAT_V_T_M1 vfloat32m1_t +#define FLOAT_V_T vfloat32m8_t +#define VLEV_FLOAT vle32_v_f32m8 +#define VSEV_FLOAT vse32_v_f32m8 +#define VLSEV_FLOAT vlse32_v_f32m8 +#define VSSEV_FLOAT vsse32_v_f32m8 +#define VFMACCVV_FLOAT vfmacc_vv_f32m8 +#define VFMACCVF_FLOAT vfmacc_vf_f32m8 +#define VFNMSACVF_FLOAT vfnmsac_vf_f32m8 +#define VFMULVF_FLOAT vfmul_vf_f32m8 +#define VFMVVF_FLOAT vfmv_v_f_f32m8 +#define VFMSACVF_FLOAT vfmsac_vf_f32m8 +#define VFMVVF_FLOAT_M1 vfmv_v_f_f32m1 +#define VFREDSUM_FLOAT vfredusum_vs_f32m8_f32m1 +#define VFMVFS_FLOAT_M1 vfmv_f_s_f32m1_f32 +#else +#define VSETVL_MAX_M1 vsetvlmax_e64m1() +#define VSETVL(n) vsetvl_e64m8(n) +#define VSETVL_MAX vsetvlmax_e64m8() +#define FLOAT_V_T_M1 vfloat64m1_t +#define FLOAT_V_T vfloat64m8_t +#define VLEV_FLOAT vle64_v_f64m8 +#define VSEV_FLOAT vse64_v_f64m8 +#define VLSEV_FLOAT vlse64_v_f64m8 +#define VSSEV_FLOAT vsse64_v_f64m8 +#define VFMACCVV_FLOAT vfmacc_vv_f64m8 +#define VFMACCVF_FLOAT vfmacc_vf_f64m8 +#define VFNMSACVF_FLOAT vfnmsac_vf_f64m8 +#define VFMULVF_FLOAT vfmul_vf_f64m8 +#define VFMVVF_FLOAT vfmv_v_f_f64m8 +#define VFMSACVF_FLOAT vfmsac_vf_f64m8 +#define VFMVVF_FLOAT_M1 vfmv_v_f_f64m1 +#define VFREDSUM_FLOAT vfredusum_vs_f64m8_f64m1 +#define VFMVFS_FLOAT_M1 vfmv_f_s_f64m1_f64 +#endif + +int CNAME(BLASLONG m, BLASLONG offset, FLOAT alpha, FLOAT *a, BLASLONG lda, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y, FLOAT *buffer) +{ + BLASLONG i, j, k; + BLASLONG ix,iy; + BLASLONG jx,jy; + FLOAT temp1; + FLOAT *a_ptr = a; + + FLOAT_V_T_M1 v_res, v_z0; + size_t vlmax = VSETVL_MAX_M1, vl; + v_res = VFMVVF_FLOAT_M1(0, vlmax); + v_z0 = VFMVVF_FLOAT_M1(0, vlmax); + vlmax = VSETVL_MAX; + + FLOAT_V_T va, vx, vy, vr; + BLASLONG stride_x, stride_y, inc_xv, inc_yv; + + if(inc_x == 1 && inc_y == 1) + { + for (j=0; j 0; k -= vl, i += vl) + { + vl = VSETVL(k); + vr = VFMVVF_FLOAT(0, vl); + va = VLEV_FLOAT(&a_ptr[i], vl); + vy = VLEV_FLOAT(&y[i], vl); + vy = VFMACCVF_FLOAT(vy, temp1, va, vl); + VSEV_FLOAT(&y[i], vy, vl); + + vx = VLEV_FLOAT(&x[i], vl); + vr = VFMACCVV_FLOAT(vr, vx, va, vl); + + } + v_res = VFREDSUM_FLOAT(v_res, vr, v_z0, vlmax); + + y[j] += alpha * VFMVFS_FLOAT_M1(v_res); + a_ptr += lda; + } + } + else if(inc_x == 1) + { + jy = 0; + stride_y = inc_y * sizeof(FLOAT); + for (j=0; j 0; k -= vl, i += vl) + { + vl = VSETVL(k); + inc_yv = inc_y * vl; + vr = VFMVVF_FLOAT(0, vl); + va = VLEV_FLOAT(&a_ptr[i], vl); + vy = VLSEV_FLOAT(&y[iy], stride_y, vl); + vy = VFMACCVF_FLOAT(vy, temp1, va, vl); + VSSEV_FLOAT(&y[iy], stride_y, vy, vl); + + vx = VLEV_FLOAT(&x[i], vl); + vr = VFMACCVV_FLOAT(vr, vx, va, vl); + + iy += inc_yv; + } + v_res = VFREDSUM_FLOAT(v_res, vr, v_z0, vlmax); + + y[jy] += alpha * VFMVFS_FLOAT_M1(v_res); + jy += inc_y; + a_ptr += lda; + } + } + else if(inc_y == 1) + { + jx = 0; + stride_x = inc_x * sizeof(FLOAT); + for (j=0; j 0; k -= vl, i += vl) + { + vl = VSETVL(k); + vr = VFMVVF_FLOAT(0, vl); + inc_xv = inc_x * vl; + + va = VLEV_FLOAT(&a_ptr[i], vl); + vy = VLEV_FLOAT(&y[i], vl); + vy = VFMACCVF_FLOAT(vy, temp1, va, vl); + VSEV_FLOAT(&y[i], vy, vl); + + vx = VLSEV_FLOAT(&x[ix], stride_x, vl); + vr = VFMACCVV_FLOAT(vr, vx, va, vl); + + ix += inc_xv; + } + + v_res = VFREDSUM_FLOAT(v_res, vr, v_z0, vlmax); + + y[j] += alpha * VFMVFS_FLOAT_M1(v_res); + jx += inc_x; + a_ptr += lda; + } + } + else + { + stride_x = inc_x * sizeof(FLOAT); + stride_y = inc_y * sizeof(FLOAT); + jx = 0; + jy = 0; + for (j=0; j 0; k -= vl, i += vl) + { + vl = VSETVL(k); + inc_xv = inc_x * vl; + inc_yv = inc_y * vl; + vr = VFMVVF_FLOAT(0, vl); + + va = VLEV_FLOAT(&a_ptr[i], vl); + vy = VLSEV_FLOAT(&y[iy], stride_y, vl); + vy = VFMACCVF_FLOAT(vy, temp1, va, vl); + VSSEV_FLOAT(&y[iy], stride_y, vy, vl); + + vx = VLSEV_FLOAT(&x[ix], stride_x, vl); + vr = VFMACCVV_FLOAT(vr, vx, va, vl); + + ix += inc_xv; + iy += inc_yv; + } + v_res = VFREDSUM_FLOAT(v_res, vr, v_z0, vlmax); + + y[jy] += alpha * VFMVFS_FLOAT_M1(v_res); + jx += inc_x; + jy += inc_y; + a_ptr += lda; + } + } + return(0); +} + diff --git a/kernel/riscv64/symv_U_rvv.c b/kernel/riscv64/symv_U_rvv.c new file mode 100644 index 000000000..cb923be5d --- /dev/null +++ b/kernel/riscv64/symv_U_rvv.c @@ -0,0 +1,221 @@ +/*************************************************************************** +Copyright (c) 2022, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" + +#if !defined(DOUBLE) +#define VSETVL_MAX_M1 vsetvlmax_e32m1() +#define VSETVL(n) vsetvl_e32m8(n) +#define VSETVL_MAX vsetvlmax_e32m8() +#define FLOAT_V_T_M1 vfloat32m1_t +#define FLOAT_V_T vfloat32m8_t +#define VLEV_FLOAT vle32_v_f32m8 +#define VSEV_FLOAT vse32_v_f32m8 +#define VLSEV_FLOAT vlse32_v_f32m8 +#define VSSEV_FLOAT vsse32_v_f32m8 +#define VFMACCVV_FLOAT vfmacc_vv_f32m8 +#define VFMACCVF_FLOAT vfmacc_vf_f32m8 +#define VFNMSACVF_FLOAT vfnmsac_vf_f32m8 +#define VFMULVF_FLOAT vfmul_vf_f32m8 +#define VFMVVF_FLOAT vfmv_v_f_f32m8 +#define VFMSACVF_FLOAT vfmsac_vf_f32m8 +#define VFMVVF_FLOAT_M1 vfmv_v_f_f32m1 +#define VFREDSUM_FLOAT vfredusum_vs_f32m8_f32m1 +#define VFMVFS_FLOAT_M1 vfmv_f_s_f32m1_f32 +#else +#define VSETVL_MAX_M1 vsetvlmax_e64m1() +#define VSETVL(n) vsetvl_e64m8(n) +#define VSETVL_MAX vsetvlmax_e64m8() +#define FLOAT_V_T_M1 vfloat64m1_t +#define FLOAT_V_T vfloat64m8_t +#define VLEV_FLOAT vle64_v_f64m8 +#define VSEV_FLOAT vse64_v_f64m8 +#define VLSEV_FLOAT vlse64_v_f64m8 +#define VSSEV_FLOAT vsse64_v_f64m8 +#define VFMACCVV_FLOAT vfmacc_vv_f64m8 +#define VFMACCVF_FLOAT vfmacc_vf_f64m8 +#define VFNMSACVF_FLOAT vfnmsac_vf_f64m8 +#define VFMULVF_FLOAT vfmul_vf_f64m8 +#define VFMVVF_FLOAT vfmv_v_f_f64m8 +#define VFMSACVF_FLOAT vfmsac_vf_f64m8 +#define VFMVVF_FLOAT_M1 vfmv_v_f_f64m1 +#define VFREDSUM_FLOAT vfredusum_vs_f64m8_f64m1 +#define VFMVFS_FLOAT_M1 vfmv_f_s_f64m1_f64 +#endif + +int CNAME(BLASLONG m, BLASLONG offset, FLOAT alpha, FLOAT *a, BLASLONG lda, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y, FLOAT *buffer) +{ + BLASLONG i, j, k; + BLASLONG ix,iy; + BLASLONG jx,jy; + FLOAT temp1; + FLOAT *a_ptr = a; + FLOAT_V_T_M1 v_res, v_z0; + size_t vl_max = VSETVL_MAX_M1, vl; + v_res = VFMVVF_FLOAT_M1(0, vl_max); + v_z0 = VFMVVF_FLOAT_M1(0, vl_max); + vl_max = VSETVL_MAX; + + FLOAT_V_T va, vx, vy, vr; + BLASLONG stride_x, stride_y, inc_xv, inc_yv; + + BLASLONG m1 = m - offset; + if(inc_x == 1 && inc_y == 1) + { + a_ptr += m1 * lda; + for (j=m1; j 0; k -= vl, i += vl) + { + vl = VSETVL(k); + vr = VFMVVF_FLOAT(0, vl); + vy = VLEV_FLOAT(&y[i], vl); + va = VLEV_FLOAT(&a_ptr[i], vl); + vy = VFMACCVF_FLOAT(vy, temp1, va, vl); + VSEV_FLOAT(&y[i], vy, vl); + + vx = VLEV_FLOAT(&x[i], vl); + vr = VFMACCVV_FLOAT(vr, vx, va, vl); + } + v_res = VFREDSUM_FLOAT(v_res, vr, v_z0, vl_max); + + y[j] += temp1 * a_ptr[j] + alpha * VFMVFS_FLOAT_M1(v_res); + a_ptr += lda; + } + } + else if(inc_x == 1) + { + jy = m1 * inc_y; + a_ptr += m1 * lda; + stride_y = inc_y * sizeof(FLOAT); + for (j=m1; j 0; k -= vl, i += vl) + { + vl = VSETVL(k); + inc_yv = inc_y * vl; + vr = VFMVVF_FLOAT(0, vl); + vy = VLSEV_FLOAT(&y[iy], stride_y, vl); + va = VLEV_FLOAT(&a_ptr[i], vl); + vy = VFMACCVF_FLOAT(vy, temp1, va, vl); + VSSEV_FLOAT(&y[iy], stride_y, vy, vl); + + vx = VLEV_FLOAT(&x[i], vl); + vr = VFMACCVV_FLOAT(vr, vx, va, vl); + + iy += inc_yv; + } + v_res = VFREDSUM_FLOAT(v_res, vr, v_z0, vl_max); + + y[jy] += temp1 * a_ptr[j] + alpha * VFMVFS_FLOAT_M1(v_res); + a_ptr += lda; + jy += inc_y; + } + } + else if(inc_y == 1) + { + jx = m1 * inc_x; + a_ptr += m1 * lda; + stride_x = inc_x * sizeof(FLOAT); + for (j=m1; j 0; k -= vl, i += vl) + { + vl = VSETVL(k); + inc_xv = inc_x * vl; + vr = VFMVVF_FLOAT(0, vl); + + vy = VLEV_FLOAT(&y[i], vl); + va = VLEV_FLOAT(&a_ptr[i], vl); + vy = VFMACCVF_FLOAT(vy, temp1, va, vl); + VSEV_FLOAT(&y[i], vy, vl); + + vx = VLSEV_FLOAT(&x[ix], stride_x, vl); + vr = VFMACCVV_FLOAT(vr, vx, va, vl); + + ix += inc_xv; + } + v_res = VFREDSUM_FLOAT(v_res, vr, v_z0, vl_max); + + y[j] += temp1 * a_ptr[j] + alpha * VFMVFS_FLOAT_M1(v_res); + a_ptr += lda; + jx += inc_x; + } + } + else + { + jx = m1 * inc_x; + jy = m1 * inc_y; + a_ptr += m1 * lda; + stride_x = inc_x * sizeof(FLOAT); + stride_y = inc_y * sizeof(FLOAT); + for (j=m1; j 0; k -= vl, i += vl) + { + vl = VSETVL(k); + inc_xv = inc_x * vl; + inc_yv = inc_y * vl; + vr = VFMVVF_FLOAT(0, vl); + vy = VLSEV_FLOAT(&y[iy], stride_y, vl); + va = VLEV_FLOAT(&a_ptr[i], vl); + vy = VFMACCVF_FLOAT(vy, temp1, va, vl); + VSSEV_FLOAT(&y[iy], stride_y, vy, vl); + + vx = VLSEV_FLOAT(&x[ix], stride_x, vl); + vr = VFMACCVV_FLOAT(vr, vx, va, vl); + ix += inc_xv; + iy += inc_yv; + } + v_res = VFREDSUM_FLOAT(v_res, vr, v_z0, vl_max); + + y[jy] += temp1 * a_ptr[j] + alpha * VFMVFS_FLOAT_M1(v_res); + a_ptr += lda; + jx += inc_x; + jy += inc_y; + } + } + return(0); +} diff --git a/kernel/riscv64/trmm_lncopy_rvv_v1.c b/kernel/riscv64/trmm_lncopy_rvv_v1.c new file mode 100644 index 000000000..73a8233f8 --- /dev/null +++ b/kernel/riscv64/trmm_lncopy_rvv_v1.c @@ -0,0 +1,138 @@ +/*************************************************************************** +Copyright (c) 2022, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 +#include "common.h" + +#if !defined(DOUBLE) +#define VSETVL(n) vsetvl_e32m2(n) +#define FLOAT_V_T vfloat32m2_t +#define VLEV_FLOAT vle32_v_f32m2 +#define VSEV_FLOAT vse32_v_f32m2 +#define VLSEV_FLOAT vlse32_v_f32m2 +#define VBOOL_T vbool16_t +#define UINT_V_T vint32m2_t +#define VID_V_UINT vid_v_i32m2 +#define VMSGTU_VX_UINT vmsgt_vx_i32m2_b16 +#define VMSEQ_VX_UINT vmseq_vx_i32m2_b16 +#define VFMERGE_VFM_FLOAT vfmerge_vfm_f32m2 +#else +#define VSETVL(n) vsetvl_e64m2(n) +#define FLOAT_V_T vfloat64m2_t +#define VLEV_FLOAT vle64_v_f64m2 +#define VSEV_FLOAT vse64_v_f64m2 +#define VLSEV_FLOAT vlse64_v_f64m2 +#define VBOOL_T vbool32_t +#define UINT_V_T vuint64m2_t +#define VID_V_UINT vid_v_u64m2 +#define VMSGTU_VX_UINT vmsgtu_vx_u64m2_b32 +#define VMSEQ_VX_UINT vmseq_vx_u64m2_b32 +#define VFMERGE_VFM_FLOAT vfmerge_vfm_f64m2 +#endif + +// Optimizes the implementation in ../arm64/tmmm_lncopy_sve_v1.c + +int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG posX, BLASLONG posY, FLOAT *b){ + + BLASLONG i, js, X; + + FLOAT *ao; + + BLASLONG stride_lda = sizeof(FLOAT)*lda; + + FLOAT_V_T vb, va1; + + size_t vl; +#ifdef UNIT + VBOOL_T vbool_eq; +#endif + + VBOOL_T vbool_cmp; + UINT_V_T vindex; + + for (js = n; js > 0; js -= vl) + { + vl = VSETVL(js); + X = posX; + + if (posX <= posY) + { + ao = a + posY + posX * lda; + } + else + { + ao = a + posX + posY * lda; + } + + i = 0; + do + { + if (X > posY) + { + va1 = VLSEV_FLOAT(ao, stride_lda, vl); + VSEV_FLOAT(b, va1, vl); + + ao ++; + b += vl; + X ++; + i ++; + } + else if (X < posY) + { + ao += lda; + b += vl; + X ++; + i ++; + } + else + { + vindex = VID_V_UINT(vl); + for (unsigned int j = 0; j < vl; j++) + { + va1 = VLSEV_FLOAT(ao, stride_lda, vl); + vbool_cmp = VMSGTU_VX_UINT(vindex, j, vl); + vb = VFMERGE_VFM_FLOAT(vbool_cmp, va1, ZERO, vl); +#ifdef UNIT + vbool_eq = VMSEQ_VX_UINT(vindex, j, vl); + vb = VFMERGE_VFM_FLOAT(vbool_eq, vb, ONE, vl); +#endif + VSEV_FLOAT(b, vb, vl); + ao++; + b += vl; + } + + X += vl; + i += vl; + } + } while (i < m); + + posY += vl; + } + + return 0; +} diff --git a/kernel/riscv64/trmm_ltcopy_rvv_v1.c b/kernel/riscv64/trmm_ltcopy_rvv_v1.c new file mode 100644 index 000000000..2fe8cf79e --- /dev/null +++ b/kernel/riscv64/trmm_ltcopy_rvv_v1.c @@ -0,0 +1,134 @@ +/*************************************************************************** +Copyright (c) 2022, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 +#include "common.h" + +#if !defined(DOUBLE) +#define VSETVL(n) vsetvl_e32m2(n) +#define FLOAT_V_T vfloat32m2_t +#define VLEV_FLOAT vle32_v_f32m2 +#define VSEV_FLOAT vse32_v_f32m2 +#define VBOOL_T vbool16_t +#define UINT_V_T vuint32m2_t +#define VID_V_UINT vid_v_u32m2 +#define VMSLTU_VX_UINT vmsltu_vx_u32m2_b16 +#define VMSEQ_VX_UINT vmseq_vx_u32m2_b16 +#define VFMERGE_VFM_FLOAT vfmerge_vfm_f32m2 +#else +#define VSETVL(n) vsetvl_e64m2(n) +#define FLOAT_V_T vfloat64m2_t +#define VLEV_FLOAT vle64_v_f64m2 +#define VSEV_FLOAT vse64_v_f64m2 +#define VBOOL_T vbool32_t +#define UINT_V_T vuint64m2_t +#define VID_V_UINT vid_v_u64m2 +#define VMSLTU_VX_UINT vmsltu_vx_u64m2_b32 +#define VMSEQ_VX_UINT vmseq_vx_u64m2_b32 +#define VFMERGE_VFM_FLOAT vfmerge_vfm_f64m2 +#endif + +// Optimizes the implementation in ../arm64/tmmm_ltcopy_sve_v1.c + +int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG posX, BLASLONG posY, FLOAT *b){ + + BLASLONG i, js, X; + + FLOAT *ao; + + FLOAT_V_T vb, va1; + size_t vl; +#ifdef UNIT + VBOOL_T vbool_eq; +#endif + + VBOOL_T vbool_cmp; + UINT_V_T vindex; + + for (js = n; js > 0; js -= vl) + { + vl = VSETVL(js); + X = posX; + + if (posX <= posY) + { + ao = a + posY + posX * lda; + } + else + { + ao = a + posX + posY * lda; + } + + i = 0; + do + { + if (X > posY) + { + ao ++; + b += vl; + X ++; + i ++; + } + else if (X < posY) + { + va1 = VLEV_FLOAT(ao, vl); + VSEV_FLOAT(b, va1, vl); + + ao += lda; + b += vl; + X ++; + i ++; + } + else + { + vindex = VID_V_UINT(vl); + for (unsigned int j = 0; j < vl; j++) + { + va1 = VLEV_FLOAT(ao, vl); + vbool_cmp = VMSLTU_VX_UINT(vindex, j, vl); + vb = VFMERGE_VFM_FLOAT(vbool_cmp, va1, ZERO, vl); +#ifdef UNIT + vbool_eq = VMSEQ_VX_UINT(vindex, j, vl); + vb = VFMERGE_VFM_FLOAT(vbool_eq, vb, ONE, vl); +#endif + VSEV_FLOAT(b, vb, vl); + ao += lda; + b += vl; + } + X += vl; + i += vl; + + } + } while (i < m); + + posY += vl; + } + + return 0; +} + diff --git a/kernel/riscv64/trmm_uncopy_rvv_v1.c b/kernel/riscv64/trmm_uncopy_rvv_v1.c new file mode 100644 index 000000000..b64cd840d --- /dev/null +++ b/kernel/riscv64/trmm_uncopy_rvv_v1.c @@ -0,0 +1,136 @@ +/*************************************************************************** +Copyright (c) 2022, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 +#include "common.h" + +#if !defined(DOUBLE) +#define VSETVL(n) vsetvl_e32m2(n) +#define FLOAT_V_T vfloat32m2_t +#define VLEV_FLOAT vle32_v_f32m2 +#define VLSEV_FLOAT vlse32_v_f32m2 +#define VSEV_FLOAT vse32_v_f32m2 +#define VBOOL_T vbool16_t +#define UINT_V_T vuint32m2_t +#define VID_V_UINT vid_v_u32m2 +#define VMSLTU_VX_UINT vmsltu_vx_u32m2_b16 +#define VMSEQ_VX_UINT vmseq_vx_u32m2_b16 +#define VFMERGE_VFM_FLOAT vfmerge_vfm_f32m2 +#else +#define VSETVL(n) vsetvl_e64m2(n) +#define FLOAT_V_T vfloat64m2_t +#define VLEV_FLOAT vle64_v_f64m2 +#define VLSEV_FLOAT vlse64_v_f64m2 +#define VSEV_FLOAT vse64_v_f64m2 +#define VBOOL_T vbool32_t +#define UINT_V_T vuint64m2_t +#define VID_V_UINT vid_v_u64m2 +#define VMSLTU_VX_UINT vmsltu_vx_u64m2_b32 +#define VMSEQ_VX_UINT vmseq_vx_u64m2_b32 +#define VFMERGE_VFM_FLOAT vfmerge_vfm_f64m2 +#endif + +// Optimizes the implementation in ../arm64/tmmm_uncopy_sve_v1.c + +int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG posX, BLASLONG posY, FLOAT *b){ + + BLASLONG i, js, X; + BLASLONG stride_lda = sizeof(FLOAT) * lda; + FLOAT *ao; + + FLOAT_V_T vb, va1; + size_t vl; + +#ifdef UNIT + VBOOL_T vbool_eq; +#endif + + VBOOL_T vbool_cmp; + UINT_V_T vindex; + + for (js = n; js > 0; js -= vl) + { + vl = VSETVL(js); + X = posX; + + if (posX <= posY) + { + ao = a + posX + posY * lda; + } + else + { + ao = a + posY + posX * lda; + } + + i = 0; + do + { + if (X < posY) + { + va1 = VLSEV_FLOAT(ao, stride_lda, vl); + VSEV_FLOAT(b, va1, vl); + + ao ++; + b += vl; + X ++; + i ++; + } + else if (X > posY) + { + ao += lda; + b += vl; + X ++; + i ++; + } + else + { + vindex = VID_V_UINT(vl); + for (unsigned int j = 0; j < vl; j++) + { + va1 = VLSEV_FLOAT(ao, stride_lda, vl); + vbool_cmp = VMSLTU_VX_UINT(vindex, j, vl); + vb = VFMERGE_VFM_FLOAT(vbool_cmp, va1, ZERO, vl); +#ifdef UNIT + vbool_eq = VMSEQ_VX_UINT(vindex, j, vl); + vb = VFMERGE_VFM_FLOAT(vbool_eq, vb, ONE, vl); +#endif + VSEV_FLOAT(b, vb, vl); + ao++; + b += vl; + } + + X += vl; + i += vl; + } + }while (i < m); + + posY += vl; + } + + return 0; +} diff --git a/kernel/riscv64/trmm_utcopy_rvv_v1.c b/kernel/riscv64/trmm_utcopy_rvv_v1.c new file mode 100644 index 000000000..b96daae5b --- /dev/null +++ b/kernel/riscv64/trmm_utcopy_rvv_v1.c @@ -0,0 +1,133 @@ +/*********************************************************************/ +/* Copyright 2009, 2010 The University of Texas at Austin. */ +/*************************************************************************** +Copyright (c) 2022, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 +#include "common.h" + +#if !defined(DOUBLE) +#define VSETVL(n) vsetvl_e32m2(n) +#define FLOAT_V_T vfloat32m2_t +#define VLEV_FLOAT vle32_v_f32m2 +#define VSEV_FLOAT vse32_v_f32m2 +#define VBOOL_T vbool16_t +#define UINT_V_T vuint32m2_t +#define VID_V_UINT vid_v_u32m2 +#define VMSGTU_VX_UINT vmsgtu_vx_u32m2_b16 +#define VMSEQ_VX_UINT vmseq_vx_u32m2_b16 +#define VFMERGE_VFM_FLOAT vfmerge_vfm_f32m2 +#else +#define VSETVL(n) vsetvl_e64m2(n) +#define FLOAT_V_T vfloat64m2_t +#define VLEV_FLOAT vle64_v_f64m2 +#define VSEV_FLOAT vse64_v_f64m2 +#define VBOOL_T vbool32_t +#define UINT_V_T vuint64m2_t +#define VID_V_UINT vid_v_u64m2 +#define VMSGTU_VX_UINT vmsgtu_vx_u64m2_b32 +#define VMSEQ_VX_UINT vmseq_vx_u64m2_b32 +#define VFMERGE_VFM_FLOAT vfmerge_vfm_f64m2 +#endif + +// Optimizes the implementation in ../arm64/tmmm_utcopy_sve_v1.c + +int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG posX, BLASLONG posY, FLOAT *b){ + + BLASLONG i, j, js, X; + + FLOAT *ao; + FLOAT_V_T vb, va1; +#ifdef UNIT + VBOOL_T vbool_eq; +#endif + + VBOOL_T vbool_cmp; + UINT_V_T vindex; + + size_t vl; + + for (js = n; js > 0; js -= vl) + { + vl = VSETVL(js); + + X = posX; + + if (posX <= posY) + { + ao = a + posX + posY * lda; + } + else + { + ao = a + posY + posX * lda; + } + + i = 0; + do + { + if (X < posY) + { + ao ++; + b += vl; + X ++; + i++; + } + else if (X > posY) + { + va1 = VLEV_FLOAT(ao, vl); + VSEV_FLOAT(b, va1, vl); + ao += lda; + b += vl; + X++; + i++; + } + else + { + vindex = VID_V_UINT(vl); + for (j = 0; j < vl; j++) + { + va1 = VLEV_FLOAT(ao, vl); + vbool_cmp = VMSGTU_VX_UINT(vindex, j, vl); + vb = VFMERGE_VFM_FLOAT(vbool_cmp, va1, ZERO, vl); +#ifdef UNIT + vbool_eq = VMSEQ_VX_UINT(vindex, j, vl); + vb = VFMERGE_VFM_FLOAT(vbool_eq, vb, ONE, vl); +#endif + VSEV_FLOAT(b, vb, vl); + ao += lda; + b += vl; + } + X += vl; + i += vl; + } + }while (i < m); + posY += vl; + } + return 0; +} + diff --git a/kernel/riscv64/trmmkernel_2x2_rvv.c b/kernel/riscv64/trmmkernel_2x2_rvv.c new file mode 100644 index 000000000..127e76970 --- /dev/null +++ b/kernel/riscv64/trmmkernel_2x2_rvv.c @@ -0,0 +1,342 @@ +/*************************************************************************** +Copyright (c) 2022, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" + +#if !defined(DOUBLE) +#define VSETVL(n) vsetvl_e32m4(n) +#define VSETVL_MAX vsetvlmax_e32m4() +#define VSETVL_MAX_M1 vsetvlmax_e32m1() +#define FLOAT_V_T vfloat32m4_t +#define FLOAT_V_T_M1 vfloat32m1_t +#define VLEV_FLOAT vle32_v_f32m4 +#define VLSEG_FLOAT vlseg2e32_v_f32m4 +#define VFMVVF_FLOAT vfmv_v_f_f32m4 +#define VFMACCVF_FLOAT vfmacc_vf_f32m4 +#define VFMACCVV_FLOAT vfmacc_vv_f32m4 +#define VFREDSUMVS_FLOAT vfredusum_vs_f32m4_f32m1 +#define VFMVVF_FLOAT_M1 vfmv_v_f_f32m1 +#define VFMVFS_FLOAT_M1 vfmv_f_s_f32m1_f32 +#else +#define VSETVL(n) vsetvl_e64m4(n) +#define VSETVL_MAX vsetvlmax_e64m4() +#define VSETVL_MAX_M1 vsetvlmax_e64m1() +#define FLOAT_V_T vfloat64m4_t +#define FLOAT_V_T_M1 vfloat64m1_t +#define VLEV_FLOAT vle64_v_f64m4 +#define VLSEG_FLOAT vlseg2e64_v_f64m4 +#define VFMVVF_FLOAT vfmv_v_f_f64m4 +#define VFMACCVF_FLOAT vfmacc_vf_f64m4 +#define VFMACCVV_FLOAT vfmacc_vv_f64m4 +#define VFREDSUMVS_FLOAT vfredusum_vs_f64m4_f64m1 +#define VFMVVF_FLOAT_M1 vfmv_v_f_f64m1 +#define VFMVFS_FLOAT_M1 vfmv_f_s_f64m1_f64 +#endif + + +// Optimizes the implementation in ../generic/trmmkernel_2x2.c + + +int CNAME(BLASLONG bm,BLASLONG bn,BLASLONG bk,FLOAT alpha,FLOAT* ba,FLOAT* bb,FLOAT* C,BLASLONG ldc +#ifdef TRMMKERNEL + ,BLASLONG offset +#endif + ) +{ + BLASLONG i,j,k; + FLOAT *C0,*C1,*ptrba,*ptrbb; + BLASLONG off, temp; + + FLOAT_V_T va0, va1, vb0, vb1; + FLOAT_V_T vres0, vres1, vres2, vres3; + FLOAT_V_T_M1 v_res, v_z0; + v_z0 = VFMVVF_FLOAT_M1(0, VSETVL_MAX_M1); + size_t vl; + size_t vlmax = VSETVL_MAX; + +#if defined(TRMMKERNEL) && !defined(LEFT) + off = -offset; +#else + off = 0; +#endif + + for (j = bn/2; j > 0; j--) + { + C0 = C; + C1 = C0+ldc; +#if defined(TRMMKERNEL) && defined(LEFT) + off = offset; +#endif + ptrba = ba; + + for (i = bm/2; i > 0; i--) + { +#if (defined(LEFT) && defined(TRANSA)) || \ + (!defined(LEFT) && !defined(TRANSA)) + ptrbb = bb; +#else + ptrba += off*2; + ptrbb = bb + off*2; +#endif + +#if (defined(LEFT) && !defined(TRANSA)) || \ + (!defined(LEFT) && defined(TRANSA)) + temp = bk-off; +#elif defined(LEFT) + temp = off+2; +#else + temp = off+2; +#endif + vres0 = VFMVVF_FLOAT(0.0, vlmax); + vres1 = VFMVVF_FLOAT(0.0, vlmax); + vres2 = VFMVVF_FLOAT(0.0, vlmax); + vres3 = VFMVVF_FLOAT(0.0, vlmax); + for (k = temp; k > 0; k -= vl) + { + vl = VSETVL(k); + VLSEG_FLOAT(&va0, &va1, ptrba, vl); + VLSEG_FLOAT(&vb0, &vb1, ptrbb, vl); + + vres0 = VFMACCVV_FLOAT(vres0, va0, vb0, vl); + vres1 = VFMACCVV_FLOAT(vres1, va1, vb0, vl); + vres2 = VFMACCVV_FLOAT(vres2, va0, vb1, vl); + vres3 = VFMACCVV_FLOAT(vres3, va1, vb1, vl); + + ptrba += vl * 2; + ptrbb += vl * 2; + } + v_res = VFREDSUMVS_FLOAT(v_res, vres0, v_z0, vlmax); + C0[0] = alpha * VFMVFS_FLOAT_M1(v_res); + v_res = VFREDSUMVS_FLOAT(v_res, vres1, v_z0, vlmax); + C0[1] = alpha * VFMVFS_FLOAT_M1(v_res); + v_res = VFREDSUMVS_FLOAT(v_res, vres2, v_z0, vlmax); + C1[0] = alpha * VFMVFS_FLOAT_M1(v_res); + v_res = VFREDSUMVS_FLOAT(v_res, vres3, v_z0, vlmax); + C1[1] = alpha * VFMVFS_FLOAT_M1(v_res); + +#if ( defined(LEFT) && defined(TRANSA)) || \ + (!defined(LEFT) && !defined(TRANSA)) + temp = bk - off; +#ifdef LEFT + temp -= 2; +#else + temp -= 2; +#endif + ptrba += temp*2; + ptrbb += temp*2; +#endif +#ifdef LEFT + off += 2; +#endif + C0 = C0+2; + C1 = C1+2; + } + + if (bm & 1) + { +#if (defined(LEFT) && defined(TRANSA)) ||(!defined(LEFT) && !defined(TRANSA)) + ptrbb = bb; +#else + ptrba += off; + ptrbb = bb+off*2; +#endif + +#if (defined(LEFT) && !defined(TRANSA)) || (!defined(LEFT) && defined(TRANSA)) + temp = bk-off; +#elif defined(LEFT) + temp = off+1; +#else + temp = off+2; +#endif + vres0 = VFMVVF_FLOAT(0.0, vlmax); + vres1 = VFMVVF_FLOAT(0.0, vlmax); + + for (k = temp; k > 0; k -= vl) + { + vl = VSETVL(k); + va0 = VLEV_FLOAT(ptrba, vl); + VLSEG_FLOAT(&vb0, &vb1, ptrbb, vl); + + vres0 = VFMACCVV_FLOAT(vres0, va0, vb0, vl); + vres1 = VFMACCVV_FLOAT(vres1, va0, vb1, vl); + + ptrba += vl; + ptrbb += vl * 2; + + } + v_res = VFREDSUMVS_FLOAT(v_res, vres0, v_z0, vlmax); + C0[0] = alpha * VFMVFS_FLOAT_M1(v_res); + v_res = VFREDSUMVS_FLOAT(v_res, vres1, v_z0, vlmax); + C1[0] = alpha * VFMVFS_FLOAT_M1(v_res); + +#if ( defined(LEFT) && defined(TRANSA)) || (!defined(LEFT) && !defined(TRANSA)) + temp = bk-off; +#ifdef LEFT + temp -= 1; +#else + temp -= 2; +#endif + ptrba += temp; + ptrbb += temp*2; +#endif +#ifdef LEFT + off += 1; +#endif + C0 = C0+1; + C1 = C1+1; + } +#if defined(TRMMKERNEL) && !defined(LEFT) + off += 2; +#endif + k = (bk<<1); + bb = bb+k; + i = (ldc<<1); + C = C+i; + } + + if (bn & 1) + { + C0 = C; +#if defined(TRMMKERNEL) && defined(LEFT) + off = offset; +#endif + ptrba = ba; + + for (i = bm/2; i > 0; i--) + { +#if (defined(LEFT) && defined(TRANSA)) || \ + (!defined(LEFT) && !defined(TRANSA)) + ptrbb = bb; +#else + ptrba += off*2; + ptrbb = bb + off; +#endif + + +#if (defined(LEFT) && !defined(TRANSA)) || \ + (!defined(LEFT) && defined(TRANSA)) + temp = bk-off; +#elif defined(LEFT) + temp = off+2; +#else + temp = off+1; +#endif + vres0 = VFMVVF_FLOAT(0.0, vlmax); + vres1 = VFMVVF_FLOAT(0.0, vlmax); + + for (k = temp; k > 0; k -= vl) + { + vl = VSETVL(k); + vb0 = VLEV_FLOAT(ptrbb, vl); + VLSEG_FLOAT(&va0, &va1, ptrba, vl); + + vres0 = VFMACCVV_FLOAT(vres0, vb0, va0, vl); + vres1 = VFMACCVV_FLOAT(vres1, vb0, va1, vl); + + ptrba += vl * 2; + ptrbb += vl; + + } + v_res = VFREDSUMVS_FLOAT(v_res, vres0, v_z0, vlmax); + C0[0] = alpha * VFMVFS_FLOAT_M1(v_res); + v_res = VFREDSUMVS_FLOAT(v_res, vres1, v_z0, vlmax); + C0[1] = alpha * VFMVFS_FLOAT_M1(v_res); + +#if ( defined(LEFT) && defined(TRANSA)) || \ + (!defined(LEFT) && !defined(TRANSA)) + temp = bk - off; +#ifdef LEFT + temp -= 2; +#else + temp -= 1; +#endif + ptrba += temp*2; + ptrbb += temp; +#endif +#ifdef LEFT + off += 2; +#endif + + C0 = C0+2; + } + + if (bm & 1) + { +#if (defined(LEFT) && defined(TRANSA)) || (!defined(LEFT) && !defined(TRANSA)) + ptrbb = bb; +#else + ptrba += off; + ptrbb = bb+off; +#endif + +#if (defined(LEFT) && !defined(TRANSA)) || (!defined(LEFT) && defined(TRANSA)) + temp = bk-off; +#elif defined(LEFT) + temp = off + 1; +#else + temp = off + 1; +#endif + vres0 = VFMVVF_FLOAT(0.0, vlmax); + + for (k = temp; k > 0; k -= vl) + { + vl = VSETVL(k); + va0 = VLEV_FLOAT(ptrba, vl); + vb0 = VLEV_FLOAT(ptrbb, vl); + + vres0 = VFMACCVV_FLOAT(vres0, vb0, va0, vl); + ptrba += vl; + ptrbb += vl; + } + v_res = VFREDSUMVS_FLOAT(v_res, vres0, v_z0, vlmax); + C0[0] = alpha * VFMVFS_FLOAT_M1(v_res); + +#if ( defined(LEFT) && defined(TRANSA)) || (!defined(LEFT) && !defined(TRANSA)) + temp = bk-off; +#ifdef LEFT + temp -= 1; +#else + temp -= 1; +#endif + ptrba += temp; + ptrbb += temp; +#endif +#ifdef LEFT + off += 1; +#endif + C0 = C0+1; + } +#if defined(TRMMKERNEL) && !defined(LEFT) + off += 1; +#endif + k = (bk<<0); + bb = bb+k; + C = C+ldc; + } + return 0; +} + diff --git a/kernel/riscv64/trmmkernel_4x4_rvv.c b/kernel/riscv64/trmmkernel_4x4_rvv.c new file mode 100644 index 000000000..3e46c6348 --- /dev/null +++ b/kernel/riscv64/trmmkernel_4x4_rvv.c @@ -0,0 +1,881 @@ +/*************************************************************************** +Copyright (c) 2022, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" +#include + +#if !defined(DOUBLE) +#define VSETVL(n) vsetvl_e32m2(n) +#define VSETVL_MAX vsetvlmax_e32m2() +#define VSETVL_MAX_M1 vsetvlmax_e32m1() +#define FLOAT_V_T vfloat32m2_t +#define FLOAT_V_T_M1 vfloat32m1_t +#define VLEV_FLOAT vle32_v_f32m2 +#define VLSEG4_FLOAT vlseg4e32_v_f32m2 +#define VLSEG2_FLOAT vlseg2e32_v_f32m2 +#define VFMVVF_FLOAT vfmv_v_f_f32m2 +#define VFMUL_FLOAT vfmul_vv_f32m2 +#define VFMACCVF_FLOAT vfmacc_vf_f32m2 +#define VFMACCVV_FLOAT vfmacc_vv_f32m2 +#define VFREDSUMVS_FLOAT vfredusum_vs_f32m2_f32m1 +#define VFMVVF_FLOAT_M1 vfmv_v_f_f32m1 +#define VFMVFS_FLOAT_M1 vfmv_f_s_f32m1_f32 +#else +#define VSETVL(n) vsetvl_e64m2(n) +#define VSETVL_MAX vsetvlmax_e64m2() +#define VSETVL_MAX_M1 vsetvlmax_e64m1() +#define FLOAT_V_T vfloat64m2_t +#define FLOAT_V_T_M1 vfloat64m1_t +#define VLEV_FLOAT vle64_v_f64m2 +#define VLSEG4_FLOAT vlseg4e64_v_f64m2 +#define VLSEG2_FLOAT vlseg2e64_v_f64m2 +#define VFMVVF_FLOAT vfmv_v_f_f64m2 +#define VFMUL_FLOAT vfmul_vv_f64m2 +#define VFMACCVF_FLOAT vfmacc_vf_f64m2 +#define VFMACCVV_FLOAT vfmacc_vv_f64m2 +#define VFREDSUMVS_FLOAT vfredusum_vs_f64m2_f64m1 +#define VFMVVF_FLOAT_M1 vfmv_v_f_f64m1 +#define VFMVFS_FLOAT_M1 vfmv_f_s_f64m1_f64 +#endif + + +// Optimizes the implementation in ../generic/trmmkernel_4x4.c + +int CNAME(BLASLONG bm,BLASLONG bn,BLASLONG bk,FLOAT alpha,FLOAT* ba,FLOAT* bb,FLOAT* C,BLASLONG ldc ,BLASLONG offset) +{ + + BLASLONG i,j,k; + FLOAT *C0,*C1,*C2,*C3,*ptrba,*ptrbb; + + FLOAT_V_T va0, va1, va2, va3, vb0, vb1, vb2, vb3; + FLOAT_V_T_M1 vsum0, vsum1, vsum2, vsum3, v_z0; + v_z0 = VFMVVF_FLOAT_M1(0, VSETVL_MAX_M1); + size_t vl; + size_t vlmax = VSETVL_MAX; + + FLOAT_V_T vres0_0; + FLOAT_V_T vres0_1; + FLOAT_V_T vres0_2; + FLOAT_V_T vres0_3; + + FLOAT_V_T vres1_0; + FLOAT_V_T vres1_1; + FLOAT_V_T vres1_2; + FLOAT_V_T vres1_3; + + FLOAT_V_T vres2_0; + FLOAT_V_T vres2_1; + FLOAT_V_T vres2_2; + FLOAT_V_T vres2_3; + + FLOAT_V_T vres3_0; + FLOAT_V_T vres3_1; + FLOAT_V_T vres3_2; + FLOAT_V_T vres3_3; + + BLASLONG off, temp; + + bool left; + bool transposed; + bool backwards; + +#ifdef LEFT + left = true; +#else + left = false; +#endif + +#ifdef TRANSA + transposed = true; +#else + transposed = false; +#endif + + backwards = left != transposed; + + if (!left) { + off = -offset; + } + + + for (j=0; j 0; k -= vl) + { + vl = VSETVL(k); + VLSEG4_FLOAT(&va0, &va1, &va2, &va3, ptrba, vl); + VLSEG4_FLOAT(&vb0, &vb1, &vb2, &vb3, ptrbb, vl); + + vres0_0 = VFMACCVV_FLOAT(vres0_0, va0, vb0, vl); + vres1_0 = VFMACCVV_FLOAT(vres1_0, va0, vb1, vl); + vres2_0 = VFMACCVV_FLOAT(vres2_0, va0, vb2, vl); + vres3_0 = VFMACCVV_FLOAT(vres3_0, va0, vb3, vl); + + vres0_1 = VFMACCVV_FLOAT(vres0_1, va1, vb0, vl); + vres1_1 = VFMACCVV_FLOAT(vres1_1, va1, vb1, vl); + vres2_1 = VFMACCVV_FLOAT(vres2_1, va1, vb2, vl); + vres3_1 = VFMACCVV_FLOAT(vres3_1, va1, vb3, vl); + + vres0_2 = VFMACCVV_FLOAT(vres0_2, va2, vb0, vl); + vres1_2 = VFMACCVV_FLOAT(vres1_2, va2, vb1, vl); + vres2_2 = VFMACCVV_FLOAT(vres2_2, va2, vb2, vl); + vres3_2 = VFMACCVV_FLOAT(vres3_2, va2, vb3, vl); + + vres0_3 = VFMACCVV_FLOAT(vres0_3, va3, vb0, vl); + vres1_3 = VFMACCVV_FLOAT(vres1_3, va3, vb1, vl); + vres2_3 = VFMACCVV_FLOAT(vres2_3, va3, vb2, vl); + vres3_3 = VFMACCVV_FLOAT(vres3_3, va3, vb3, vl); + + ptrba += vl * 4; + ptrbb += vl * 4; + } + + vsum0 = VFREDSUMVS_FLOAT(vsum0, vres0_0, v_z0, vlmax); + vsum1 = VFREDSUMVS_FLOAT(vsum1, vres0_1, v_z0, vlmax); + vsum2 = VFREDSUMVS_FLOAT(vsum2, vres0_2, v_z0, vlmax); + vsum3 = VFREDSUMVS_FLOAT(vsum3, vres0_3, v_z0, vlmax); + C0[0] = alpha * VFMVFS_FLOAT_M1(vsum0); + C0[1] = alpha * VFMVFS_FLOAT_M1(vsum1); + C0[2] = alpha * VFMVFS_FLOAT_M1(vsum2); + C0[3] = alpha * VFMVFS_FLOAT_M1(vsum3); + + vsum0 = VFREDSUMVS_FLOAT(vsum0, vres1_0, v_z0, vlmax); + vsum1 = VFREDSUMVS_FLOAT(vsum1, vres1_1, v_z0, vlmax); + vsum2 = VFREDSUMVS_FLOAT(vsum2, vres1_2, v_z0, vlmax); + vsum3 = VFREDSUMVS_FLOAT(vsum3, vres1_3, v_z0, vlmax); + C1[0] = alpha * VFMVFS_FLOAT_M1(vsum0); + C1[1] = alpha * VFMVFS_FLOAT_M1(vsum1); + C1[2] = alpha * VFMVFS_FLOAT_M1(vsum2); + C1[3] = alpha * VFMVFS_FLOAT_M1(vsum3); + + vsum0 = VFREDSUMVS_FLOAT(vsum0, vres2_0, v_z0, vlmax); + vsum1 = VFREDSUMVS_FLOAT(vsum1, vres2_1, v_z0, vlmax); + vsum2 = VFREDSUMVS_FLOAT(vsum2, vres2_2, v_z0, vlmax); + vsum3 = VFREDSUMVS_FLOAT(vsum3, vres2_3, v_z0, vlmax); + C2[0] = alpha * VFMVFS_FLOAT_M1(vsum0); + C2[1] = alpha * VFMVFS_FLOAT_M1(vsum1); + C2[2] = alpha * VFMVFS_FLOAT_M1(vsum2); + C2[3] = alpha * VFMVFS_FLOAT_M1(vsum3); + + vsum0 = VFREDSUMVS_FLOAT(vsum0, vres3_0, v_z0, vlmax); + vsum1 = VFREDSUMVS_FLOAT(vsum1, vres3_1, v_z0, vlmax); + vsum2 = VFREDSUMVS_FLOAT(vsum2, vres3_2, v_z0, vlmax); + vsum3 = VFREDSUMVS_FLOAT(vsum3, vres3_3, v_z0, vlmax); + C3[0] = alpha * VFMVFS_FLOAT_M1(vsum0); + C3[1] = alpha * VFMVFS_FLOAT_M1(vsum1); + C3[2] = alpha * VFMVFS_FLOAT_M1(vsum2); + C3[3] = alpha * VFMVFS_FLOAT_M1(vsum3); + + if (!backwards) { + temp = bk-off; + temp = left ? temp - 4 : // number of values in A + temp - 4; // number of values in B + + ptrba += temp*4; // number of values in A + ptrbb += temp*4; // number of values in B + } +#ifdef LEFT + off += 4; // number of values in A +#endif + + C0 = C0+4; + C1 = C1+4; + C2 = C2+4; + C3 = C3+4; + + } + + if ( bm & 2 ) // do any 2x4 loop + { + +#if (defined(LEFT) && defined(TRANSA)) || (!defined(LEFT) && !defined(TRANSA)) + ptrbb = bb; +#else + ptrba += off*2; + ptrbb = bb + off*4; +#endif + + vres0_0 = VFMVVF_FLOAT(0, vlmax); + vres0_1 = VFMVVF_FLOAT(0, vlmax); + + vres1_0 = VFMVVF_FLOAT(0, vlmax); + vres1_1 = VFMVVF_FLOAT(0, vlmax); + + vres2_0 = VFMVVF_FLOAT(0, vlmax); + vres2_1 = VFMVVF_FLOAT(0, vlmax); + + vres3_0 = VFMVVF_FLOAT(0, vlmax); + vres3_1 = VFMVVF_FLOAT(0, vlmax); + + +#if (defined(LEFT) && !defined(TRANSA)) || (!defined(LEFT) && defined(TRANSA)) + temp = bk-off; +#elif defined(LEFT) + temp = off+2; // number of values in A +#else + temp = off+4; // number of values in B +#endif + for (k = temp; k > 0; k -= vl) + { + vl = VSETVL(k); + VLSEG2_FLOAT(&va0, &va1, ptrba, vl); + VLSEG4_FLOAT(&vb0, &vb1, &vb2, &vb3, ptrbb, vl); + + vres0_0 = VFMACCVV_FLOAT(vres0_0, va0, vb0, vl); + vres1_0 = VFMACCVV_FLOAT(vres1_0, va0, vb1, vl); + vres2_0 = VFMACCVV_FLOAT(vres2_0, va0, vb2, vl); + vres3_0 = VFMACCVV_FLOAT(vres3_0, va0, vb3, vl); + + vres0_1 = VFMACCVV_FLOAT(vres0_1, va1, vb0, vl); + vres1_1 = VFMACCVV_FLOAT(vres1_1, va1, vb1, vl); + vres2_1 = VFMACCVV_FLOAT(vres2_1, va1, vb2, vl); + vres3_1 = VFMACCVV_FLOAT(vres3_1, va1, vb3, vl); + + ptrba += vl * 2; + ptrbb += vl * 4; + } + + vsum0 = VFREDSUMVS_FLOAT(vsum0, vres0_0, v_z0, vlmax); + vsum1 = VFREDSUMVS_FLOAT(vsum1, vres0_1, v_z0, vlmax); + vsum2 = VFREDSUMVS_FLOAT(vsum2, vres1_0, v_z0, vlmax); + vsum3 = VFREDSUMVS_FLOAT(vsum3, vres1_1, v_z0, vlmax); + + C0[0] = alpha * VFMVFS_FLOAT_M1(vsum0); + C0[1] = alpha * VFMVFS_FLOAT_M1(vsum1); + C1[0] = alpha * VFMVFS_FLOAT_M1(vsum2); + C1[1] = alpha * VFMVFS_FLOAT_M1(vsum3); + + vsum0 = VFREDSUMVS_FLOAT(vsum0, vres2_0, v_z0, vlmax); + vsum1 = VFREDSUMVS_FLOAT(vsum1, vres2_1, v_z0, vlmax); + vsum2 = VFREDSUMVS_FLOAT(vsum2, vres3_0, v_z0, vlmax); + vsum3 = VFREDSUMVS_FLOAT(vsum3, vres3_1, v_z0, vlmax); + + C2[0] = alpha * VFMVFS_FLOAT_M1(vsum0); + C2[1] = alpha * VFMVFS_FLOAT_M1(vsum1); + C3[0] = alpha * VFMVFS_FLOAT_M1(vsum2); + C3[1] = alpha * VFMVFS_FLOAT_M1(vsum3); + + +#if ( defined(LEFT) && defined(TRANSA)) || (!defined(LEFT) && !defined(TRANSA)) + temp = bk - off; +#ifdef LEFT + temp -= 2; // number of values in A +#else + temp -= 4; // number of values in B +#endif + ptrba += temp*2; + ptrbb += temp*4; +#endif + +#ifdef LEFT + off += 2; // number of values in A +#endif + + C0 = C0+2; + C1 = C1+2; + C2 = C2+2; + C3 = C3+2; + + } + + if ( bm & 1 ) // do any 1x4 loop + { + +#if (defined(LEFT) && defined(TRANSA)) || (!defined(LEFT) && !defined(TRANSA)) + ptrbb = bb; +#else + ptrba += off*1; + ptrbb = bb + off*4; +#endif + + vres0_0 = VFMVVF_FLOAT(0, vlmax); + vres1_0 = VFMVVF_FLOAT(0, vlmax); + vres2_0 = VFMVVF_FLOAT(0, vlmax); + vres3_0 = VFMVVF_FLOAT(0, vlmax); + + +#if (defined(LEFT) && !defined(TRANSA)) || (!defined(LEFT) && defined(TRANSA)) + temp = bk-off; +#elif defined(LEFT) + temp = off+1; // number of values in A +#else + temp = off+4; // number of values in B +#endif + + for (k = temp; k > 0; k -= vl) + { + vl = VSETVL(k); + va0 = VLEV_FLOAT(ptrba, vl); + VLSEG4_FLOAT(&vb0, &vb1, &vb2, &vb3, ptrbb, vl); + + vres0_0 = VFMACCVV_FLOAT(vres0_0, va0, vb0, vl); + vres1_0 = VFMACCVV_FLOAT(vres1_0, va0, vb1, vl); + vres2_0 = VFMACCVV_FLOAT(vres2_0, va0, vb2, vl); + vres3_0 = VFMACCVV_FLOAT(vres3_0, va0, vb3, vl); + + ptrba += vl; + ptrbb += vl * 4; + } + + vsum0 = VFREDSUMVS_FLOAT(vsum0, vres0_0, v_z0, vlmax); + vsum1 = VFREDSUMVS_FLOAT(vsum1, vres1_0, v_z0, vlmax); + vsum2 = VFREDSUMVS_FLOAT(vsum2, vres2_0, v_z0, vlmax); + vsum3 = VFREDSUMVS_FLOAT(vsum3, vres3_0, v_z0, vlmax); + + C0[0] = alpha * VFMVFS_FLOAT_M1(vsum0); + C1[0] = alpha * VFMVFS_FLOAT_M1(vsum1); + C2[0] = alpha * VFMVFS_FLOAT_M1(vsum2); + C3[0] = alpha * VFMVFS_FLOAT_M1(vsum3); + +#if ( defined(LEFT) && defined(TRANSA)) || (!defined(LEFT) && !defined(TRANSA)) + temp = bk - off; +#ifdef LEFT + temp -= 1; // number of values in A +#else + temp -= 4; // number of values in B +#endif + ptrba += temp*1; + ptrbb += temp*4; +#endif + +#ifdef LEFT + off += 1; // number of values in A +#endif + + C0 = C0+1; + C1 = C1+1; + C2 = C2+1; + C3 = C3+1; + + } + + +#if defined(TRMMKERNEL) && !defined(LEFT) + off += 4; +#endif + + k = (bk<<2); + bb = bb+k; + i = (ldc<<2); + C = C+i; + } + + for (j=0; j<(bn&2); j+=2) // do the Mx2 loops + { + C0 = C; + C1 = C0+ldc; + +#if defined(TRMMKERNEL) && defined(LEFT) + off = offset; +#endif + + ptrba = ba; + + for (i=0; i 0; k -= vl) + { + vl = VSETVL(k); + VLSEG4_FLOAT(&va0, &va1, &va2, &va3, ptrba, vl); + VLSEG2_FLOAT(&vb0, &vb1, ptrbb, vl); + + vres0_0 = VFMACCVV_FLOAT(vres0_0, va0, vb0, vl); + vres1_0 = VFMACCVV_FLOAT(vres1_0, va0, vb1, vl); + + vres0_1 = VFMACCVV_FLOAT(vres0_1, va1, vb0, vl); + vres1_1 = VFMACCVV_FLOAT(vres1_1, va1, vb1, vl); + + vres0_2 = VFMACCVV_FLOAT(vres0_2, va2, vb0, vl); + vres1_2 = VFMACCVV_FLOAT(vres1_2, va2, vb1, vl); + + vres0_3 = VFMACCVV_FLOAT(vres0_3, va3, vb0, vl); + vres1_3 = VFMACCVV_FLOAT(vres1_3, va3, vb1, vl); + + ptrba += vl * 4; + ptrbb += vl * 2; + } + + vsum0 = VFREDSUMVS_FLOAT(vsum0, vres0_0, v_z0, vlmax); + vsum1 = VFREDSUMVS_FLOAT(vsum1, vres0_1, v_z0, vlmax); + vsum2 = VFREDSUMVS_FLOAT(vsum2, vres0_2, v_z0, vlmax); + vsum3 = VFREDSUMVS_FLOAT(vsum3, vres0_3, v_z0, vlmax); + C0[0] = alpha * VFMVFS_FLOAT_M1(vsum0); + C0[1] = alpha * VFMVFS_FLOAT_M1(vsum1); + C0[2] = alpha * VFMVFS_FLOAT_M1(vsum2); + C0[3] = alpha * VFMVFS_FLOAT_M1(vsum3); + + vsum0 = VFREDSUMVS_FLOAT(vsum0, vres1_0, v_z0, vlmax); + vsum1 = VFREDSUMVS_FLOAT(vsum1, vres1_1, v_z0, vlmax); + vsum2 = VFREDSUMVS_FLOAT(vsum2, vres1_2, v_z0, vlmax); + vsum3 = VFREDSUMVS_FLOAT(vsum3, vres1_3, v_z0, vlmax); + C1[0] = alpha * VFMVFS_FLOAT_M1(vsum0); + C1[1] = alpha * VFMVFS_FLOAT_M1(vsum1); + C1[2] = alpha * VFMVFS_FLOAT_M1(vsum2); + C1[3] = alpha * VFMVFS_FLOAT_M1(vsum3); + +#if ( defined(LEFT) && defined(TRANSA)) || (!defined(LEFT) && !defined(TRANSA)) + temp = bk - off; +#ifdef LEFT + temp -= 4; // number of values in A +#else + temp -= 2; // number of values in B +#endif + ptrba += temp*4; + ptrbb += temp*2; +#endif + +#ifdef LEFT + off += 4; // number of values in A +#endif + + C0 = C0+4; + C1 = C1+4; + + } + + if ( bm & 2 ) // do any 2x2 loop + { + +#if (defined(LEFT) && defined(TRANSA)) || (!defined(LEFT) && !defined(TRANSA)) + ptrbb = bb; +#else + ptrba += off*2; + ptrbb = bb + off*2; +#endif + + vres0_0 = VFMVVF_FLOAT(0, vlmax); + vres0_1 = VFMVVF_FLOAT(0, vlmax); + + vres1_0 = VFMVVF_FLOAT(0, vlmax); + vres1_1 = VFMVVF_FLOAT(0, vlmax); + + +#if (defined(LEFT) && !defined(TRANSA)) || (!defined(LEFT) && defined(TRANSA)) + temp = bk-off; +#elif defined(LEFT) + temp = off+2; // number of values in A +#else + temp = off+2; // number of values in B +#endif + for (k = temp; k > 0; k -= vl) + { + vl = VSETVL(k); + VLSEG2_FLOAT(&va0, &va1, ptrba, vl); + VLSEG2_FLOAT(&vb0, &vb1, ptrbb, vl); + + vres0_0 = VFMACCVV_FLOAT(vres0_0, va0, vb0, vl); + vres1_0 = VFMACCVV_FLOAT(vres1_0, va0, vb1, vl); + + vres0_1 = VFMACCVV_FLOAT(vres0_1, va1, vb0, vl); + vres1_1 = VFMACCVV_FLOAT(vres1_1, va1, vb1, vl); + + ptrba += vl * 2; + ptrbb += vl * 2; + } + + vsum0 = VFREDSUMVS_FLOAT(vsum0, vres0_0, v_z0, vlmax); + vsum1 = VFREDSUMVS_FLOAT(vsum1, vres0_1, v_z0, vlmax); + vsum2 = VFREDSUMVS_FLOAT(vsum2, vres1_0, v_z0, vlmax); + vsum3 = VFREDSUMVS_FLOAT(vsum3, vres1_1, v_z0, vlmax); + + C0[0] = alpha * VFMVFS_FLOAT_M1(vsum0); + C0[1] = alpha * VFMVFS_FLOAT_M1(vsum1); + C1[0] = alpha * VFMVFS_FLOAT_M1(vsum2); + C1[1] = alpha * VFMVFS_FLOAT_M1(vsum3); + + +#if ( defined(LEFT) && defined(TRANSA)) || (!defined(LEFT) && !defined(TRANSA)) + temp = bk - off; +#ifdef LEFT + temp -= 2; // number of values in A +#else + temp -= 2; // number of values in B +#endif + ptrba += temp*2; + ptrbb += temp*2; +#endif + +#ifdef LEFT + off += 2; // number of values in A +#endif + + C0 = C0+2; + C1 = C1+2; + + } + + if ( bm & 1 ) // do any 1x2 loop + { + +#if (defined(LEFT) && defined(TRANSA)) || (!defined(LEFT) && !defined(TRANSA)) + ptrbb = bb; +#else + ptrba += off*1; + ptrbb = bb + off*2; +#endif + + + vres0_0 = VFMVVF_FLOAT(0, vlmax); + vres1_0 = VFMVVF_FLOAT(0, vlmax); + + +#if (defined(LEFT) && !defined(TRANSA)) || (!defined(LEFT) && defined(TRANSA)) + temp = bk-off; +#elif defined(LEFT) + temp = off+1; // number of values in A +#else + temp = off+2; // number of values in B +#endif + + for (k = temp; k > 0; k -= vl) + { + vl = VSETVL(k); + va0 = VLEV_FLOAT(ptrba, vl); + VLSEG2_FLOAT(&vb0, &vb1, ptrbb, vl); + + vres0_0 = VFMACCVV_FLOAT(vres0_0, va0, vb0, vl); + vres1_0 = VFMACCVV_FLOAT(vres1_0, va0, vb1, vl); + + ptrba += vl; + ptrbb += vl * 2; + } + + vsum0 = VFREDSUMVS_FLOAT(vsum0, vres0_0, v_z0, vlmax); + vsum1 = VFREDSUMVS_FLOAT(vsum1, vres1_0, v_z0, vlmax); + C0[0] = alpha * VFMVFS_FLOAT_M1(vsum0); + C1[0] = alpha * VFMVFS_FLOAT_M1(vsum1); + + +#if ( defined(LEFT) && defined(TRANSA)) || (!defined(LEFT) && !defined(TRANSA)) + temp = bk - off; +#ifdef LEFT + temp -= 1; // number of values in A +#else + temp -= 2; // number of values in B +#endif + ptrba += temp*1; + ptrbb += temp*2; +#endif + +#ifdef LEFT + off += 1; // number of values in A +#endif + + C0 = C0+1; + C1 = C1+1; + + } + + +#if defined(TRMMKERNEL) && !defined(LEFT) + off += 2; +#endif + + k = (bk<<1); + bb = bb+k; + i = (ldc<<1); + C = C+i; + } + + for (j=0; j<(bn&1); j+=1) // do the Mx1 loops + { + C0 = C; + +#if defined(TRMMKERNEL) && defined(LEFT) + off = offset; +#endif + + ptrba = ba; + + for (i=0; i 0; k -= vl) + { + vl = VSETVL(k); + VLSEG4_FLOAT(&va0, &va1, &va2, &va3, ptrba, vl); + vb0 = VLEV_FLOAT(ptrbb, vl); + + vres0_0 = VFMACCVV_FLOAT(vres0_0, va0, vb0, vl); + + vres0_1 = VFMACCVV_FLOAT(vres0_1, va1, vb0, vl); + + vres0_2 = VFMACCVV_FLOAT(vres0_2, va2, vb0, vl); + + vres0_3 = VFMACCVV_FLOAT(vres0_3, va3, vb0, vl); + + ptrba += vl * 4; + ptrbb += vl; + } + + vsum0 = VFREDSUMVS_FLOAT(vsum0, vres0_0, v_z0, vlmax); + vsum1 = VFREDSUMVS_FLOAT(vsum1, vres0_1, v_z0, vlmax); + vsum2 = VFREDSUMVS_FLOAT(vsum2, vres0_2, v_z0, vlmax); + vsum3 = VFREDSUMVS_FLOAT(vsum3, vres0_3, v_z0, vlmax); + C0[0] = alpha * VFMVFS_FLOAT_M1(vsum0); + C0[1] = alpha * VFMVFS_FLOAT_M1(vsum1); + C0[2] = alpha * VFMVFS_FLOAT_M1(vsum2); + C0[3] = alpha * VFMVFS_FLOAT_M1(vsum3); + + +#if ( defined(LEFT) && defined(TRANSA)) || (!defined(LEFT) && !defined(TRANSA)) + temp = bk - off; +#ifdef LEFT + temp -= 4; // number of values in A +#else + temp -= 1; // number of values in B +#endif + ptrba += temp*4; + ptrbb += temp*1; +#endif + +#ifdef LEFT + off += 4; // number of values in A +#endif + + C0 = C0+4; + + } + + if ( bm & 2 ) // do any 2x1 loop + { + +#if (defined(LEFT) && defined(TRANSA)) || (!defined(LEFT) && !defined(TRANSA)) + ptrbb = bb; +#else + ptrba += off*2; + ptrbb = bb + off*1; +#endif + + vres0_0 = VFMVVF_FLOAT(0, vlmax); + vres0_1 = VFMVVF_FLOAT(0, vlmax); + +#if (defined(LEFT) && !defined(TRANSA)) || (!defined(LEFT) && defined(TRANSA)) + temp = bk-off; +#elif defined(LEFT) + temp = off+2; // number of values in A +#else + temp = off+1; // number of values in B +#endif + + for (k = temp; k > 0; k -= vl) + { + vl = VSETVL(k); + VLSEG2_FLOAT(&va0, &va1, ptrba, vl); + vb0 = VLEV_FLOAT(ptrbb, vl); + + vres0_0 = VFMACCVV_FLOAT(vres0_0, va0, vb0, vl); + + vres0_1 = VFMACCVV_FLOAT(vres0_1, va1, vb0, vl); + + ptrba += vl * 2; + ptrbb += vl; + } + + vsum0 = VFREDSUMVS_FLOAT(vsum0, vres0_0, v_z0, vlmax); + vsum1 = VFREDSUMVS_FLOAT(vsum1, vres0_1, v_z0, vlmax); + C0[0] = alpha * VFMVFS_FLOAT_M1(vsum0); + C0[1] = alpha * VFMVFS_FLOAT_M1(vsum1); + + +#if ( defined(LEFT) && defined(TRANSA)) || (!defined(LEFT) && !defined(TRANSA)) + temp = bk - off; +#ifdef LEFT + temp -= 2; // number of values in A +#else + temp -= 1; // number of values in B +#endif + ptrba += temp*2; + ptrbb += temp*1; +#endif + +#ifdef LEFT + off += 2; // number of values in A +#endif + + C0 = C0+2; + + } + + if ( bm & 1 ) // do any 1x1 loop + { + +#if (defined(LEFT) && defined(TRANSA)) || (!defined(LEFT) && !defined(TRANSA)) + ptrbb = bb; +#else + ptrba += off*1; + ptrbb = bb + off*1; +#endif + + vres0_0 = VFMVVF_FLOAT(0, vlmax); + +#if (defined(LEFT) && !defined(TRANSA)) || (!defined(LEFT) && defined(TRANSA)) + temp = bk-off; +#elif defined(LEFT) + temp = off+1; // number of values in A +#else + temp = off+1; // number of values in B +#endif + + for (k = temp; k > 0; k -= vl) + { + vl = VSETVL(k); + va0 = VLEV_FLOAT(ptrba, vl); + vb0 = VLEV_FLOAT(ptrbb, vl); + + vres0_0 = VFMACCVV_FLOAT(vres0_0, va0, vb0, vl); + + ptrba += vl; + ptrbb += vl; + } + + vsum0 = VFREDSUMVS_FLOAT(vsum0, vres0_0, v_z0, vlmax); + C0[0] = alpha * VFMVFS_FLOAT_M1(vsum0); + + +#if ( defined(LEFT) && defined(TRANSA)) || (!defined(LEFT) && !defined(TRANSA)) + temp = bk - off; +#ifdef LEFT + temp -= 1; // number of values in A +#else + temp -= 1; // number of values in B +#endif + ptrba += temp*1; + ptrbb += temp*1; +#endif + +#ifdef LEFT + off += 1; // number of values in A +#endif + + C0 = C0+1; + + } + +#if defined(TRMMKERNEL) && !defined(LEFT) + off += 1; +#endif + + k = (bk<<0); + bb = bb+k; + C = C+ldc; + } + return 0; +} diff --git a/kernel/riscv64/trmmkernel_rvv_v1x8.c b/kernel/riscv64/trmmkernel_rvv_v1x8.c new file mode 100644 index 000000000..97b14650c --- /dev/null +++ b/kernel/riscv64/trmmkernel_rvv_v1x8.c @@ -0,0 +1,685 @@ +/*************************************************************************** +Copyright (c) 2022, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" + +#if !defined(DOUBLE) +#define VSETVL(n) vsetvl_e32m2(n) +#define FLOAT_V_T vfloat32m2_t +#define VLEV_FLOAT vle32_v_f32m2 +#define VSEV_FLOAT vse32_v_f32m2 +#define VFMVVF_FLOAT vfmv_v_f_f32m2 +#define VFMACCVF_FLOAT vfmacc_vf_f32m2 +#define VFMULVF_FLOAT vfmul_vf_f32m2 +#else +#define VSETVL(n) vsetvl_e64m2(n) +#define FLOAT_V_T vfloat64m2_t +#define VLEV_FLOAT vle64_v_f64m2 +#define VSEV_FLOAT vse64_v_f64m2 +#define VFMVVF_FLOAT vfmv_v_f_f64m2 +#define VFMACCVF_FLOAT vfmacc_vf_f64m2 +#define VFMULVF_FLOAT vfmul_vf_f64m2 +#endif + + +// Optimizes the implementation in ../generic/trmmkernel_8x8.c + + +int CNAME(BLASLONG bm,BLASLONG bn,BLASLONG bk,FLOAT alpha,FLOAT* ba,FLOAT* bb,FLOAT* C,BLASLONG ldc ,BLASLONG offset) +{ + //fprintf(stderr, "%s, %s, bm=%4ld bn=%4ld bk=%4ld alpha=%f ldc=%ld\n", __FILE__, __FUNCTION__, bm, bn, bk, alpha, ldc); + + BLASLONG i,j,k; + FLOAT *C0,*C1,*C2,*C3,*C4,*C5,*C6,*C7,*ptrba,*ptrbb; + + FLOAT_V_T va0, va1, va2, va3, va4, va5, va6, va7; + FLOAT_V_T vres0, vres1, vres2, vres3, vres4, vres5, vres6, vres7; + size_t vl; + + BLASLONG off, temp; + +#if !defined(LEFT) + off = -offset; +#else + off = 0; +#endif + for (j = bn/8; j > 0; j--) + { + C0 = C; + C1 = C0+ldc; + C2 = C1+ldc; + C3 = C2+ldc; + C4 = C3+ldc; + C5 = C4+ldc; + C6 = C5+ldc; + C7 = C6+ldc; + +#if defined(TRMMKERNEL) && defined(LEFT) + off = offset; +#endif + + ptrba = ba; + + for (i = bm; i > 0; i -= vl) + { + vl = VSETVL(i); + +#if (defined(LEFT) && defined(TRANSA)) || (!defined(LEFT) && !defined(TRANSA)) + ptrbb = bb; +#else + ptrba += off*vl; + ptrbb = bb + off*8; +#endif + + vres0 = VFMVVF_FLOAT(0.0, vl); + vres1 = VFMVVF_FLOAT(0.0, vl); + vres2 = VFMVVF_FLOAT(0.0, vl); + vres3 = VFMVVF_FLOAT(0.0, vl); + vres4 = VFMVVF_FLOAT(0.0, vl); + vres5 = VFMVVF_FLOAT(0.0, vl); + vres6 = VFMVVF_FLOAT(0.0, vl); + vres7 = VFMVVF_FLOAT(0.0, vl); + +#if (defined(LEFT) && !defined(TRANSA)) || (!defined(LEFT) && defined(TRANSA)) + temp = bk-off; +#elif defined(LEFT) + temp = off+vl; // number of values in A +#else + temp = off+8; // number of values in B +#endif + + for (k = temp/8; k > 0; k--) { + va0 = VLEV_FLOAT(ptrba, vl); + ptrba += vl; + va1 = VLEV_FLOAT(ptrba, vl); + ptrba += vl; + + vres0 = VFMACCVF_FLOAT(vres0, *(ptrbb + 0), va0, vl); + vres1 = VFMACCVF_FLOAT(vres1, *(ptrbb + 1), va0, vl); + vres2 = VFMACCVF_FLOAT(vres2, *(ptrbb + 2), va0, vl); + vres3 = VFMACCVF_FLOAT(vres3, *(ptrbb + 3), va0, vl); + vres4 = VFMACCVF_FLOAT(vres4, *(ptrbb + 4), va0, vl); + vres5 = VFMACCVF_FLOAT(vres5, *(ptrbb + 5), va0, vl); + vres6 = VFMACCVF_FLOAT(vres6, *(ptrbb + 6), va0, vl); + vres7 = VFMACCVF_FLOAT(vres7, *(ptrbb + 7), va0, vl); + ptrbb += 8; + va2 = VLEV_FLOAT(ptrba, vl); + ptrba += vl; + + vres0 = VFMACCVF_FLOAT(vres0, *(ptrbb + 0), va1, vl); + vres1 = VFMACCVF_FLOAT(vres1, *(ptrbb + 1), va1, vl); + vres2 = VFMACCVF_FLOAT(vres2, *(ptrbb + 2), va1, vl); + vres3 = VFMACCVF_FLOAT(vres3, *(ptrbb + 3), va1, vl); + vres4 = VFMACCVF_FLOAT(vres4, *(ptrbb + 4), va1, vl); + vres5 = VFMACCVF_FLOAT(vres5, *(ptrbb + 5), va1, vl); + vres6 = VFMACCVF_FLOAT(vres6, *(ptrbb + 6), va1, vl); + vres7 = VFMACCVF_FLOAT(vres7, *(ptrbb + 7), va1, vl); + ptrbb += 8; + va3 = VLEV_FLOAT(ptrba, vl); + ptrba += vl; + + vres0 = VFMACCVF_FLOAT(vres0, *(ptrbb + 0), va2, vl); + vres1 = VFMACCVF_FLOAT(vres1, *(ptrbb + 1), va2, vl); + vres2 = VFMACCVF_FLOAT(vres2, *(ptrbb + 2), va2, vl); + vres3 = VFMACCVF_FLOAT(vres3, *(ptrbb + 3), va2, vl); + vres4 = VFMACCVF_FLOAT(vres4, *(ptrbb + 4), va2, vl); + vres5 = VFMACCVF_FLOAT(vres5, *(ptrbb + 5), va2, vl); + vres6 = VFMACCVF_FLOAT(vres6, *(ptrbb + 6), va2, vl); + vres7 = VFMACCVF_FLOAT(vres7, *(ptrbb + 7), va2, vl); + ptrbb += 8; + va4 = VLEV_FLOAT(ptrba, vl); + ptrba += vl; + + vres0 = VFMACCVF_FLOAT(vres0, *(ptrbb + 0), va3, vl); + vres1 = VFMACCVF_FLOAT(vres1, *(ptrbb + 1), va3, vl); + vres2 = VFMACCVF_FLOAT(vres2, *(ptrbb + 2), va3, vl); + vres3 = VFMACCVF_FLOAT(vres3, *(ptrbb + 3), va3, vl); + vres4 = VFMACCVF_FLOAT(vres4, *(ptrbb + 4), va3, vl); + vres5 = VFMACCVF_FLOAT(vres5, *(ptrbb + 5), va3, vl); + vres6 = VFMACCVF_FLOAT(vres6, *(ptrbb + 6), va3, vl); + vres7 = VFMACCVF_FLOAT(vres7, *(ptrbb + 7), va3, vl); + ptrbb += 8; + va5 = VLEV_FLOAT(ptrba, vl); + ptrba += vl; + + vres0 = VFMACCVF_FLOAT(vres0, *(ptrbb + 0), va4, vl); + vres1 = VFMACCVF_FLOAT(vres1, *(ptrbb + 1), va4, vl); + vres2 = VFMACCVF_FLOAT(vres2, *(ptrbb + 2), va4, vl); + vres3 = VFMACCVF_FLOAT(vres3, *(ptrbb + 3), va4, vl); + vres4 = VFMACCVF_FLOAT(vres4, *(ptrbb + 4), va4, vl); + vres5 = VFMACCVF_FLOAT(vres5, *(ptrbb + 5), va4, vl); + vres6 = VFMACCVF_FLOAT(vres6, *(ptrbb + 6), va4, vl); + vres7 = VFMACCVF_FLOAT(vres7, *(ptrbb + 7), va4, vl); + ptrbb += 8; + va6 = VLEV_FLOAT(ptrba, vl); + ptrba += vl; + + vres0 = VFMACCVF_FLOAT(vres0, *(ptrbb + 0), va5, vl); + vres1 = VFMACCVF_FLOAT(vres1, *(ptrbb + 1), va5, vl); + vres2 = VFMACCVF_FLOAT(vres2, *(ptrbb + 2), va5, vl); + vres3 = VFMACCVF_FLOAT(vres3, *(ptrbb + 3), va5, vl); + vres4 = VFMACCVF_FLOAT(vres4, *(ptrbb + 4), va5, vl); + vres5 = VFMACCVF_FLOAT(vres5, *(ptrbb + 5), va5, vl); + vres6 = VFMACCVF_FLOAT(vres6, *(ptrbb + 6), va5, vl); + vres7 = VFMACCVF_FLOAT(vres7, *(ptrbb + 7), va5, vl); + ptrbb += 8; + va7 = VLEV_FLOAT(ptrba, vl); + ptrba += vl; + + vres0 = VFMACCVF_FLOAT(vres0, *(ptrbb + 0), va6, vl); + vres1 = VFMACCVF_FLOAT(vres1, *(ptrbb + 1), va6, vl); + vres2 = VFMACCVF_FLOAT(vres2, *(ptrbb + 2), va6, vl); + vres3 = VFMACCVF_FLOAT(vres3, *(ptrbb + 3), va6, vl); + vres4 = VFMACCVF_FLOAT(vres4, *(ptrbb + 4), va6, vl); + vres5 = VFMACCVF_FLOAT(vres5, *(ptrbb + 5), va6, vl); + vres6 = VFMACCVF_FLOAT(vres6, *(ptrbb + 6), va6, vl); + vres7 = VFMACCVF_FLOAT(vres7, *(ptrbb + 7), va6, vl); + ptrbb += 8; + + vres0 = VFMACCVF_FLOAT(vres0, *(ptrbb + 0), va7, vl); + vres1 = VFMACCVF_FLOAT(vres1, *(ptrbb + 1), va7, vl); + vres2 = VFMACCVF_FLOAT(vres2, *(ptrbb + 2), va7, vl); + vres3 = VFMACCVF_FLOAT(vres3, *(ptrbb + 3), va7, vl); + vres4 = VFMACCVF_FLOAT(vres4, *(ptrbb + 4), va7, vl); + vres5 = VFMACCVF_FLOAT(vres5, *(ptrbb + 5), va7, vl); + vres6 = VFMACCVF_FLOAT(vres6, *(ptrbb + 6), va7, vl); + vres7 = VFMACCVF_FLOAT(vres7, *(ptrbb + 7), va7, vl); + ptrbb += 8; + } + + for (k = temp&7; k > 0; k--) { + va0 = VLEV_FLOAT(ptrba, vl); // M:8 (should be vlen); + + vres0 = VFMACCVF_FLOAT(vres0, *(ptrbb + 0), va0, vl); + vres1 = VFMACCVF_FLOAT(vres1, *(ptrbb + 1), va0, vl); + vres2 = VFMACCVF_FLOAT(vres2, *(ptrbb + 2), va0, vl); + vres3 = VFMACCVF_FLOAT(vres3, *(ptrbb + 3), va0, vl); + vres4 = VFMACCVF_FLOAT(vres4, *(ptrbb + 4), va0, vl); + vres5 = VFMACCVF_FLOAT(vres5, *(ptrbb + 5), va0, vl); + vres6 = VFMACCVF_FLOAT(vres6, *(ptrbb + 6), va0, vl); + vres7 = VFMACCVF_FLOAT(vres7, *(ptrbb + 7), va0, vl); + + ptrbb += 8; + ptrba += vl; + } + + va0 = VFMULVF_FLOAT(vres0, alpha, vl); + VSEV_FLOAT(C0, va0, vl); + + va1 = VFMULVF_FLOAT(vres1, alpha, vl); + VSEV_FLOAT(C1, va1, vl); + + va2 = VFMULVF_FLOAT(vres2, alpha, vl); + VSEV_FLOAT(C2, va2, vl); + + va3 = VFMULVF_FLOAT(vres3, alpha, vl); + VSEV_FLOAT(C3, va3, vl); + + va4 = VFMULVF_FLOAT(vres4, alpha, vl); + VSEV_FLOAT(C4, va4, vl); + + va5 = VFMULVF_FLOAT(vres5, alpha, vl); + VSEV_FLOAT(C5, va5, vl); + + va6 = VFMULVF_FLOAT(vres6, alpha, vl); + VSEV_FLOAT(C6, va6, vl); + + va7 = VFMULVF_FLOAT(vres7, alpha, vl); + VSEV_FLOAT(C7, va7, vl); + + +#if ( defined(LEFT) && defined(TRANSA)) || (!defined(LEFT) && !defined(TRANSA)) + temp = bk - off; +#ifdef LEFT + temp -= vl; // number of values in A +#else + temp -= 8; // number of values in B +#endif + ptrba += temp*vl; + ptrbb += temp*8; +#endif + +#ifdef LEFT + off += vl; // number of values in A +#endif + + C0 += vl; + C1 += vl; + C2 += vl; + C3 += vl; + C4 += vl; + C5 += vl; + C6 += vl; + C7 += vl; + } + +#if defined(TRMMKERNEL) && !defined(LEFT) + off += 8; +#endif + + bb += (bk<<3); + C += (ldc<<3); + } + + if (bn & 4) + { + C0 = C; + C1 = C0+ldc; + C2 = C1+ldc; + C3 = C2+ldc; + +#if defined(TRMMKERNEL) && defined(LEFT) + off = offset; +#endif + ptrba = ba; + + for (i = bm; i > 0; i -= vl) + { + vl = VSETVL(i); +#if (defined(LEFT) && defined(TRANSA)) || (!defined(LEFT) && !defined(TRANSA)) + ptrbb = bb; +#else + ptrba += off*vl; + ptrbb = bb + off*4; +#endif + + vres0 = VFMVVF_FLOAT(0.0, vl); + vres1 = VFMVVF_FLOAT(0.0, vl); + vres2 = VFMVVF_FLOAT(0.0, vl); + vres3 = VFMVVF_FLOAT(0.0, vl); + + +#if (defined(LEFT) && !defined(TRANSA)) || (!defined(LEFT) && defined(TRANSA)) + temp = bk-off; +#elif defined(LEFT) + temp = off+vl; // number of values in A +#else + temp = off+4; // number of values in B +#endif + + for (k = temp/8; k > 0; k--) { + va0 = VLEV_FLOAT(ptrba, vl); + ptrba += vl; + va1 = VLEV_FLOAT(ptrba, vl); + ptrba += vl; + + vres0 = VFMACCVF_FLOAT(vres0, *(ptrbb + 0), va0, vl); + vres1 = VFMACCVF_FLOAT(vres1, *(ptrbb + 1), va0, vl); + vres2 = VFMACCVF_FLOAT(vres2, *(ptrbb + 2), va0, vl); + vres3 = VFMACCVF_FLOAT(vres3, *(ptrbb + 3), va0, vl); + ptrbb += 4; + va2 = VLEV_FLOAT(ptrba, vl); + ptrba += vl; + + vres0 = VFMACCVF_FLOAT(vres0, *(ptrbb + 0), va1, vl); + vres1 = VFMACCVF_FLOAT(vres1, *(ptrbb + 1), va1, vl); + vres2 = VFMACCVF_FLOAT(vres2, *(ptrbb + 2), va1, vl); + vres3 = VFMACCVF_FLOAT(vres3, *(ptrbb + 3), va1, vl); + ptrbb += 4; + va3 = VLEV_FLOAT(ptrba, vl); + ptrba += vl; + + vres0 = VFMACCVF_FLOAT(vres0, *(ptrbb + 0), va2, vl); + vres1 = VFMACCVF_FLOAT(vres1, *(ptrbb + 1), va2, vl); + vres2 = VFMACCVF_FLOAT(vres2, *(ptrbb + 2), va2, vl); + vres3 = VFMACCVF_FLOAT(vres3, *(ptrbb + 3), va2, vl); + ptrbb += 4; + va4 = VLEV_FLOAT(ptrba, vl); + ptrba += vl; + + vres0 = VFMACCVF_FLOAT(vres0, *(ptrbb + 0), va3, vl); + vres1 = VFMACCVF_FLOAT(vres1, *(ptrbb + 1), va3, vl); + vres2 = VFMACCVF_FLOAT(vres2, *(ptrbb + 2), va3, vl); + vres3 = VFMACCVF_FLOAT(vres3, *(ptrbb + 3), va3, vl); + ptrbb += 4; + va5 = VLEV_FLOAT(ptrba, vl); + ptrba += vl; + + vres0 = VFMACCVF_FLOAT(vres0, *(ptrbb + 0), va4, vl); + vres1 = VFMACCVF_FLOAT(vres1, *(ptrbb + 1), va4, vl); + vres2 = VFMACCVF_FLOAT(vres2, *(ptrbb + 2), va4, vl); + vres3 = VFMACCVF_FLOAT(vres3, *(ptrbb + 3), va4, vl); + ptrbb += 4; + va6 = VLEV_FLOAT(ptrba, vl); + ptrba += vl; + + vres0 = VFMACCVF_FLOAT(vres0, *(ptrbb + 0), va5, vl); + vres1 = VFMACCVF_FLOAT(vres1, *(ptrbb + 1), va5, vl); + vres2 = VFMACCVF_FLOAT(vres2, *(ptrbb + 2), va5, vl); + vres3 = VFMACCVF_FLOAT(vres3, *(ptrbb + 3), va5, vl); + ptrbb += 4; + va7 = VLEV_FLOAT(ptrba, vl); + ptrba += vl; + + vres0 = VFMACCVF_FLOAT(vres0, *(ptrbb + 0), va6, vl); + vres1 = VFMACCVF_FLOAT(vres1, *(ptrbb + 1), va6, vl); + vres2 = VFMACCVF_FLOAT(vres2, *(ptrbb + 2), va6, vl); + vres3 = VFMACCVF_FLOAT(vres3, *(ptrbb + 3), va6, vl); + ptrbb += 4; + + vres0 = VFMACCVF_FLOAT(vres0, *(ptrbb + 0), va7, vl); + vres1 = VFMACCVF_FLOAT(vres1, *(ptrbb + 1), va7, vl); + vres2 = VFMACCVF_FLOAT(vres2, *(ptrbb + 2), va7, vl); + vres3 = VFMACCVF_FLOAT(vres3, *(ptrbb + 3), va7, vl); + ptrbb += 4; + } + + // K remainder + for (k = temp&7; k > 0; k--) { + va0 = VLEV_FLOAT(ptrba, vl); + + vres0 = VFMACCVF_FLOAT(vres0, *(ptrbb + 0), va0, vl); + vres1 = VFMACCVF_FLOAT(vres1, *(ptrbb + 1), va0, vl); + vres2 = VFMACCVF_FLOAT(vres2, *(ptrbb + 2), va0, vl); + vres3 = VFMACCVF_FLOAT(vres3, *(ptrbb + 3), va0, vl); + + ptrbb += 4; + ptrba += vl; + } + + va0 = VFMULVF_FLOAT(vres0, alpha, vl); + VSEV_FLOAT(C0, va0, vl); + + va1 = VFMULVF_FLOAT(vres1, alpha, vl); + VSEV_FLOAT(C1, va1, vl); + + va2 = VFMULVF_FLOAT(vres2, alpha, vl); + VSEV_FLOAT(C2, va2, vl); + + va3 = VFMULVF_FLOAT(vres3, alpha, vl); + VSEV_FLOAT(C3, va3, vl); + +#if ( defined(LEFT) && defined(TRANSA)) || (!defined(LEFT) && !defined(TRANSA)) + temp = bk - off; +#ifdef LEFT + temp -= vl; // number of values in A +#else + temp -= 4; // number of values in B +#endif + ptrba += temp*vl; + ptrbb += temp*4; +#endif + +#ifdef LEFT + off += vl; // number of values in A +#endif + + C0 += vl; + C1 += vl; + C2 += vl; + C3 += vl; + } + +#if defined(TRMMKERNEL) && !defined(LEFT) + off += 4; +#endif + + bb += (bk<<2); + C += (ldc<<2); + } + + if (bn & 2) + { + C0 = C; + C1 = C0+ldc; + +#if defined(TRMMKERNEL) && defined(LEFT) + off = offset; +#endif + + ptrba = ba; + + for (i = bm; i > 0; i -= vl) + { + vl = VSETVL(i); + +#if (defined(LEFT) && defined(TRANSA)) || (!defined(LEFT) && !defined(TRANSA)) + ptrbb = bb; +#else + ptrba += off*vl; + ptrbb = bb + off*2; +#endif + + vres0 = VFMVVF_FLOAT(0.0, vl); + vres1 = VFMVVF_FLOAT(0.0, vl); + + +#if (defined(LEFT) && !defined(TRANSA)) || (!defined(LEFT) && defined(TRANSA)) + temp = bk-off; +#elif defined(LEFT) + temp = off+vl; // number of values in A +#else + temp = off+2; // number of values in B +#endif + + for (k = temp/8; k > 0; k--) { + va0 = VLEV_FLOAT(ptrba, vl); + ptrba += vl; + va1 = VLEV_FLOAT(ptrba, vl); + ptrba += vl; + + vres0 = VFMACCVF_FLOAT(vres0, *(ptrbb + 0), va0, vl); + vres1 = VFMACCVF_FLOAT(vres1, *(ptrbb + 1), va0, vl); + ptrbb += 2; + va2 = VLEV_FLOAT(ptrba, vl); + ptrba += vl; + + vres0 = VFMACCVF_FLOAT(vres0, *(ptrbb + 0), va1, vl); + vres1 = VFMACCVF_FLOAT(vres1, *(ptrbb + 1), va1, vl); + ptrbb += 2; + va3 = VLEV_FLOAT(ptrba, vl); + ptrba += vl; + + vres0 = VFMACCVF_FLOAT(vres0, *(ptrbb + 0), va2, vl); + vres1 = VFMACCVF_FLOAT(vres1, *(ptrbb + 1), va2, vl); + ptrbb += 2; + va4 = VLEV_FLOAT(ptrba, vl); + ptrba += vl; + + vres0 = VFMACCVF_FLOAT(vres0, *(ptrbb + 0), va3, vl); + vres1 = VFMACCVF_FLOAT(vres1, *(ptrbb + 1), va3, vl); + ptrbb += 2; + va5 = VLEV_FLOAT(ptrba, vl); + ptrba += vl; + + vres0 = VFMACCVF_FLOAT(vres0, *(ptrbb + 0), va4, vl); + vres1 = VFMACCVF_FLOAT(vres1, *(ptrbb + 1), va4, vl); + ptrbb += 2; + va6 = VLEV_FLOAT(ptrba, vl); + ptrba += vl; + + vres0 = VFMACCVF_FLOAT(vres0, *(ptrbb + 0), va5, vl); + vres1 = VFMACCVF_FLOAT(vres1, *(ptrbb + 1), va5, vl); + ptrbb += 2; + va7 = VLEV_FLOAT(ptrba, vl); + ptrba += vl; + + vres0 = VFMACCVF_FLOAT(vres0, *(ptrbb + 0), va6, vl); + vres1 = VFMACCVF_FLOAT(vres1, *(ptrbb + 1), va6, vl); + ptrbb += 2; + + vres0 = VFMACCVF_FLOAT(vres0, *(ptrbb + 0), va7, vl); + vres1 = VFMACCVF_FLOAT(vres1, *(ptrbb + 1), va7, vl); + ptrbb += 2; + } + + // K remainder + for (k = temp&7; k > 0; k--) { + va0 = VLEV_FLOAT(ptrba, vl); + + vres0 = VFMACCVF_FLOAT(vres0, *(ptrbb + 0), va0, vl); + vres1 = VFMACCVF_FLOAT(vres1, *(ptrbb + 1), va0, vl); + + ptrbb += 2; + ptrba += vl; + } + va0 = VFMULVF_FLOAT(vres0, alpha, vl); + VSEV_FLOAT(C0, va0, vl); + + va1 = VFMULVF_FLOAT(vres1, alpha, vl); + VSEV_FLOAT(C1, va1, vl); + +#if ( defined(LEFT) && defined(TRANSA)) || (!defined(LEFT) && !defined(TRANSA)) + temp = bk - off; +#ifdef LEFT + temp -= vl; // number of values in A +#else + temp -= 2; // number of values in B +#endif + ptrba += temp*vl; + ptrbb += temp*2; +#endif + +#ifdef LEFT + off += vl; // number of values in A +#endif + + C0 += vl; + C1 += vl; + } + +#if defined(TRMMKERNEL) && !defined(LEFT) + off += 2; +#endif + + bb += (bk<<1); + C += (ldc<<1); + } + + if (bn & 1) + { + C0 = C; + +#if defined(TRMMKERNEL) && defined(LEFT) + off = offset; +#endif + + ptrba = ba; + + for (i = bm; i > 0; i -= vl) + { + vl = VSETVL(i); +#if (defined(LEFT) && defined(TRANSA)) || (!defined(LEFT) && !defined(TRANSA)) + ptrbb = bb; +#else + ptrba += off*vl; + ptrbb = bb + off*1; +#endif + + vres0 = VFMVVF_FLOAT(0.0, vl); + +#if (defined(LEFT) && !defined(TRANSA)) || (!defined(LEFT) && defined(TRANSA)) + temp = bk-off; +#elif defined(LEFT) + temp = off+vl; // number of values in A +#else + temp = off+1; // number of values in B +#endif + + for (k = temp/8; k > 0; k--) { + va0 = VLEV_FLOAT(ptrba, vl); + ptrba += vl; + va1 = VLEV_FLOAT(ptrba, vl); + ptrba += vl; + + vres0 = VFMACCVF_FLOAT(vres0, *(ptrbb + 0), va0, vl); + ptrbb += 1; + va2 = VLEV_FLOAT(ptrba, vl); + ptrba += vl; + + vres0 = VFMACCVF_FLOAT(vres0, *(ptrbb + 0), va1, vl); + ptrbb += 1; + va3 = VLEV_FLOAT(ptrba, vl); + ptrba += vl; + + vres0 = VFMACCVF_FLOAT(vres0, *(ptrbb + 0), va2, vl); + ptrbb += 1; + va4 = VLEV_FLOAT(ptrba, vl); + ptrba += vl; + + vres0 = VFMACCVF_FLOAT(vres0, *(ptrbb + 0), va3, vl); + ptrbb += 1; + va5 = VLEV_FLOAT(ptrba, vl); + ptrba += vl; + + vres0 = VFMACCVF_FLOAT(vres0, *(ptrbb + 0), va4, vl); + ptrbb += 1; + va6 = VLEV_FLOAT(ptrba, vl); + ptrba += vl; + + vres0 = VFMACCVF_FLOAT(vres0, *(ptrbb + 0), va5, vl); + ptrbb += 1; + va7 = VLEV_FLOAT(ptrba, vl); + ptrba += vl; + + vres0 = VFMACCVF_FLOAT(vres0, *(ptrbb + 0), va6, vl); + ptrbb += 1; + + vres0 = VFMACCVF_FLOAT(vres0, *(ptrbb + 0), va7, vl); + ptrbb += 1; + } + + // K remainder + for (k = temp&7; k > 0; k--) { + va0 = VLEV_FLOAT(ptrba, vl); + + vres0 = VFMACCVF_FLOAT(vres0, *(ptrbb + 0), va0, vl); + + ptrbb += 1; + ptrba += vl; + } + va0 = VFMULVF_FLOAT(vres0, alpha, vl); + VSEV_FLOAT(C0, va0, vl); + +#if ( defined(LEFT) && defined(TRANSA)) || (!defined(LEFT) && !defined(TRANSA)) + temp = bk - off; +#ifdef LEFT + temp -= vl; // number of values in A +#else + temp -= 1; // number of values in B +#endif + ptrba += temp*vl; + ptrbb += temp*1; +#endif + +#ifdef LEFT + off += vl; // number of values in A +#endif + + C0 += vl; + } + +#if defined(TRMMKERNEL) && !defined(LEFT) + off += 1; +#endif + + bb += (bk); + C += (ldc); + } + return 0; +} + diff --git a/kernel/riscv64/trsm_kernel_LN_rvv_v1.c b/kernel/riscv64/trsm_kernel_LN_rvv_v1.c new file mode 100644 index 000000000..11a0398ca --- /dev/null +++ b/kernel/riscv64/trsm_kernel_LN_rvv_v1.c @@ -0,0 +1,847 @@ +/*************************************************************************** +Copyright (c) 2022, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" + +#if !defined(DOUBLE) +#define VSETVL(n) vsetvl_e32m2(n) +#define VSETVL_MAX vsetvlmax_e32m2() +#define FLOAT_V_T vfloat32m2_t +#define VLEV_FLOAT vle32_v_f32m2 +#define VLSEV_FLOAT vlse32_v_f32m2 +#define VLSEG2_FLOAT vlseg2e32_v_f32m2 +#define VSEV_FLOAT vse32_v_f32m2 +#define VSSEV_FLOAT vsse32_v_f32m2 +#define VSSEG2_FLOAT vsseg2e32_v_f32m2 +#define VFMACCVF_FLOAT vfmacc_vf_f32m2 +#define VFMULVF_FLOAT vfmul_vf_f32m2 +#define VFNMSACVF_FLOAT vfnmsac_vf_f32m2 +#else +#define VSETVL(n) vsetvl_e64m2(n) +#define VSETVL_MAX vsetvlmax_e64m2() +#define FLOAT_V_T vfloat64m2_t +#define VLEV_FLOAT vle64_v_f64m2 +#define VLSEV_FLOAT vlse64_v_f64m2 +#define VLSEG2_FLOAT vlseg2e64_v_f64m2 +#define VSEV_FLOAT vse64_v_f64m2 +#define VSSEV_FLOAT vsse64_v_f64m2 +#define VSSEG2_FLOAT vsseg2e64_v_f64m2 +#define VFMACCVF_FLOAT vfmacc_vf_f64m2 +#define VFMULVF_FLOAT vfmul_vf_f64m2 +#define VFNMSACVF_FLOAT vfnmsac_vf_f64m2 +#endif + + +static FLOAT dm1 = -1.; + +#ifdef CONJ +#define GEMM_KERNEL GEMM_KERNEL_L +#else +#define GEMM_KERNEL GEMM_KERNEL_N +#endif + +#if GEMM_DEFAULT_UNROLL_N == 1 +#define GEMM_UNROLL_N_SHIFT 0 +#endif + +#if GEMM_DEFAULT_UNROLL_N == 2 +#define GEMM_UNROLL_N_SHIFT 1 +#endif + +#if GEMM_DEFAULT_UNROLL_N == 4 +#define GEMM_UNROLL_N_SHIFT 2 +#endif + +#if GEMM_DEFAULT_UNROLL_N == 8 +#define GEMM_UNROLL_N_SHIFT 3 +#endif + +#if GEMM_DEFAULT_UNROLL_N == 16 +#define GEMM_UNROLL_N_SHIFT 4 +#endif + +// Optimizes the implementation in ../arm64/trsm_kernel_LN_sve.c + +#ifndef COMPLEX + +#if GEMM_DEFAULT_UNROLL_N == 1 + +static inline void solve(BLASLONG m, BLASLONG n, FLOAT *a, FLOAT *b, FLOAT *c, BLASLONG ldc) { + + FLOAT aa, bb; + FLOAT *pa, *pc; + + int i, j, k; + //fprintf(stderr, "%s , %s, m = %4ld n = %4ld offset = %4ld\n", __FILE__, __FUNCTION__, m, n, ldc); // Debug + + size_t vl; + FLOAT_V_T va, vc; + + a += (m - 1) * m; + b += (m - 1) * n; + + for (i = m - 1; i >= 0; i--) + { + aa = *(a + i); + for (j = 0; j < n; j ++) + { + bb = *(c + i + j * ldc); + bb *= aa; + *b = bb; + *(c + i + j * ldc) = bb; + b ++; + + pa = a; + pc = c + j * ldc; + for (k = i; k > 0; k -= vl) + { + vl = VSETVL(k); + vc = VLEV_FLOAT(pc, vl); + va = VLEV_FLOAT(pa, vl); + vc = VFNMSACVF_FLOAT(vc, bb, va, vl); + VSEV_FLOAT(pc, vc, vl); + pa += vl; + pc += vl; + } + } + a -= m; + b -= 2 * n; + } + +} +#elif GEMM_DEFAULT_UNROLL_N == 2 + +static inline void solve(BLASLONG m, BLASLONG n, FLOAT *a, FLOAT *b, FLOAT *c, BLASLONG ldc) { + + FLOAT aa, bb0, bb1; + FLOAT *pa, *pc, *pc0, *pc1; + FLOAT *pb0, *pb1; + + int i, j, k; + fprintf(stderr, "%s , %s, m = %4ld n = %4ld offset = %4ld\n", __FILE__, __FUNCTION__, m, n, ldc); // Debug + + size_t vl; + FLOAT_V_T va, vc0, vc1; + + a += (m - 1) * m; + b += (m - 1) * n; + + for (i = m - 1; i >= 0; i--) + { + aa = *(a + i); + pc = c + i; + for (j = 0; j < n/2; j ++) + { + //bb = *(c + i + j * ldc); + pb0 = pc + j * ldc * 2; + pb1 = pb0 + ldc; + //bb *= aa; + bb0 = (*pb0) * aa; + bb1 = (*pb1) * aa; + //*b = bb; + *b = bb0; + *(b+1) = bb1; + *pb0 = bb0; + *pb1 = bb1; + + //*(c + i + j * ldc) = bb; + //b ++; + + b += 2; + //pa = a + i + 1; + pc0 = c + j * ldc * 2; + pc1 = pc0 + ldc; + pa = a; + //pc = c + j * ldc; + for (k = i; k > 0; k -= vl) + { + vl = VSETVL(k); + vc0 = VLEV_FLOAT(pc0, vl); + vc1 = VLEV_FLOAT(pc1, vl); + va = VLEV_FLOAT(pa, vl); + vc0 = VFNMSACVF_FLOAT(vc0, bb0, va, vl); + vc1 = VFNMSACVF_FLOAT(vc1, bb1, va, vl); + VSEV_FLOAT(pc0, vc0, vl); + VSEV_FLOAT(pc1, vc1, vl); + + pa += vl; + pc0 += vl; + pc1 += vl; + } + } + pc += ldc * (n/2) * 2; + if (n & 1) + { + pb0 = pc; + bb0 = (*pb0) * aa; + *b = bb0; + *pb0 = bb0; + b += 1; + + pc0 = pc - i; + pa = a; + for (k = i; k > 0; k -= vl) + { + vl = VSETVL(k); + vc0 = VLEV_FLOAT(pc0, vl); + va = VLEV_FLOAT(pa, vl); + vc0 = VFNMSACVF_FLOAT(vc0, bb0, va, vl); + VSEV_FLOAT(pc0, vc0, vl); + + pa += vl; + pc0 += vl; + } + } + + a -= m; + b -= 2 * n; + } + +} + +#elif GEMM_DEFAULT_UNROLL_N == 4 + +static inline void solve(BLASLONG m, BLASLONG n, FLOAT *a, FLOAT *b, FLOAT *c, BLASLONG ldc) { + + FLOAT aa, bb0, bb1, bb2, bb3; + FLOAT *pa, *pc, *pc0, *pc1, *pc2, *pc3; + FLOAT *pb0, *pb1, *pb2, *pb3; + + int i, j, k; + + size_t vl; + FLOAT_V_T va, vc0, vc1, vc2, vc3; + + a += (m - 1) * m; + b += (m - 1) * n; + + for (i = m - 1; i >= 0; i--) + { + aa = *(a + i); + pc = c + i; + for (j = 0; j < n/4; j ++) + { + pb0 = pc + j * ldc * 4; + pb1 = pb0 + ldc; + pb2 = pb1 + ldc; + pb3 = pb2 + ldc; + + bb0 = (*pb0) * aa; + bb1 = (*pb1) * aa; + bb2 = (*pb2) * aa; + bb3 = (*pb3) * aa; + + *b = bb0; + *(b+1) = bb1; + *(b+2) = bb2; + *(b+3) = bb3; + + *pb0 = bb0; + *pb1 = bb1; + *pb2 = bb2; + *pb3 = bb3; + + b += 4; + + pc0 = c + j * ldc * 4; + pc1 = pc0 + ldc; + pc2 = pc1 + ldc; + pc3 = pc2 + ldc; + + pa = a; + for (k = i; k > 0; k -= vl) + { + vl = VSETVL(k); + vc0 = VLEV_FLOAT(pc0, vl); + vc1 = VLEV_FLOAT(pc1, vl); + vc2 = VLEV_FLOAT(pc2, vl); + vc3 = VLEV_FLOAT(pc3, vl); + va = VLEV_FLOAT(pa, vl); + vc0 = VFNMSACVF_FLOAT(vc0, bb0, va, vl); + vc1 = VFNMSACVF_FLOAT(vc1, bb1, va, vl); + vc2 = VFNMSACVF_FLOAT(vc2, bb2, va, vl); + vc3 = VFNMSACVF_FLOAT(vc3, bb3, va, vl); + VSEV_FLOAT(pc0, vc0, vl); + VSEV_FLOAT(pc1, vc1, vl); + VSEV_FLOAT(pc2, vc2, vl); + VSEV_FLOAT(pc3, vc3, vl); + + pa += vl; + pc0 += vl; + pc1 += vl; + pc2 += vl; + pc3 += vl; + } + } + pc += ldc * (n/4) * 4; + + if (n & 2) + { + pb0 = pc + j * ldc * 2; + pb1 = pb0 + ldc; + + bb0 = (*pb0) * aa; + bb1 = (*pb1) * aa; + + *b = bb0; + *(b+1) = bb1; + + *pb0 = bb0; + *pb1 = bb1; + + b += 2; + + pc0 = c + j * ldc * 2; + pc1 = pc0 + ldc; + + pa = a; + for (k = i; k > 0; k -= vl) + { + vl = VSETVL(k); + vc0 = VLEV_FLOAT(pc0, vl); + vc1 = VLEV_FLOAT(pc1, vl); + va = VLEV_FLOAT(pa, vl); + vc0 = VFNMSACVF_FLOAT(vc0, bb0, va, vl); + vc1 = VFNMSACVF_FLOAT(vc1, bb1, va, vl); + VSEV_FLOAT(pc0, vc0, vl); + VSEV_FLOAT(pc1, vc1, vl); + + pa += vl; + pc0 += vl; + pc1 += vl; + } + pc += ldc * 2; + } + + if (n & 1) + { + pb0 = pc; + bb0 = (*pb0) * aa; + *b = bb0; + *pb0 = bb0; + b += 1; + + pc0 = pc - i; + pa = a; + for (k = i; k > 0; k -= vl) + { + vl = VSETVL(k); + vc0 = VLEV_FLOAT(pc0, vl); + va = VLEV_FLOAT(pa, vl); + vc0 = VFNMSACVF_FLOAT(vc0, bb0, va, vl); + VSEV_FLOAT(pc0, vc0, vl); + + pa += vl; + pc0 += vl; + } + } + + a -= m; + b -= 2 * n; + } + +} +#elif GEMM_DEFAULT_UNROLL_N == 8 + +static inline void solve(BLASLONG m, BLASLONG n, FLOAT *a, FLOAT *b, FLOAT *c, BLASLONG ldc) { + + FLOAT aa, bb0, bb1, bb2, bb3, bb4, bb5, bb6, bb7; + FLOAT *pa, *pc, *pc0, *pc1, *pc2, *pc3, *pc4, *pc5, *pc6, *pc7; + FLOAT *pb0, *pb1, *pb2, *pb3, *pb4, *pb5, *pb6, *pb7; + + int i, j, k; + + size_t vl; + FLOAT_V_T va, vc0, vc1, vc2, vc3, vc4, vc5, vc6, vc7; + + a += (m - 1) * m; + b += (m - 1) * n; + + for (i = m - 1; i >= 0; i--) + { + aa = *(a + i); + pc = c + i; + for (j = 0; j < n/8; j ++) + { + pb0 = pc + j * ldc * 8; + pb1 = pb0 + ldc; + pb2 = pb1 + ldc; + pb3 = pb2 + ldc; + pb4 = pb3 + ldc; + pb5 = pb4 + ldc; + pb6 = pb5 + ldc; + pb7 = pb6 + ldc; + + bb0 = (*pb0) * aa; + bb1 = (*pb1) * aa; + bb2 = (*pb2) * aa; + bb3 = (*pb3) * aa; + bb4 = (*pb4) * aa; + bb5 = (*pb5) * aa; + bb6 = (*pb6) * aa; + bb7 = (*pb7) * aa; + + *b = bb0; + *(b+1) = bb1; + *(b+2) = bb2; + *(b+3) = bb3; + *(b+4) = bb4; + *(b+5) = bb5; + *(b+6) = bb6; + *(b+7) = bb7; + + *pb0 = bb0; + *pb1 = bb1; + *pb2 = bb2; + *pb3 = bb3; + *pb4 = bb4; + *pb5 = bb5; + *pb6 = bb6; + *pb7 = bb7; + + b += 8; + + pc0 = c + j * ldc * 8; + pc1 = pc0 + ldc; + pc2 = pc1 + ldc; + pc3 = pc2 + ldc; + pc4 = pc3 + ldc; + pc5 = pc4 + ldc; + pc6 = pc5 + ldc; + pc7 = pc6 + ldc; + + pa = a; + for (k = i; k > 0; k -= vl) + { + vl = VSETVL(k); + vc0 = VLEV_FLOAT(pc0, vl); + vc1 = VLEV_FLOAT(pc1, vl); + vc2 = VLEV_FLOAT(pc2, vl); + vc3 = VLEV_FLOAT(pc3, vl); + vc4 = VLEV_FLOAT(pc4, vl); + vc5 = VLEV_FLOAT(pc5, vl); + vc6 = VLEV_FLOAT(pc6, vl); + vc7 = VLEV_FLOAT(pc7, vl); + va = VLEV_FLOAT(pa, vl); + vc0 = VFNMSACVF_FLOAT(vc0, bb0, va, vl); + vc1 = VFNMSACVF_FLOAT(vc1, bb1, va, vl); + vc2 = VFNMSACVF_FLOAT(vc2, bb2, va, vl); + vc3 = VFNMSACVF_FLOAT(vc3, bb3, va, vl); + vc4 = VFNMSACVF_FLOAT(vc4, bb4, va, vl); + vc5 = VFNMSACVF_FLOAT(vc5, bb5, va, vl); + vc6 = VFNMSACVF_FLOAT(vc6, bb6, va, vl); + vc7 = VFNMSACVF_FLOAT(vc7, bb7, va, vl); + VSEV_FLOAT(pc0, vc0, vl); + VSEV_FLOAT(pc1, vc1, vl); + VSEV_FLOAT(pc2, vc2, vl); + VSEV_FLOAT(pc3, vc3, vl); + VSEV_FLOAT(pc4, vc4, vl); + VSEV_FLOAT(pc5, vc5, vl); + VSEV_FLOAT(pc6, vc6, vl); + VSEV_FLOAT(pc7, vc7, vl); + + pa += vl; + pc0 += vl; + pc1 += vl; + pc2 += vl; + pc3 += vl; + pc4 += vl; + pc5 += vl; + pc6 += vl; + pc7 += vl; + } + } + pc += ldc * (n/8) * 8; + + if (n & 4) + { + pb0 = pc + j * ldc * 4; + pb1 = pb0 + ldc; + pb2 = pb1 + ldc; + pb3 = pb2 + ldc; + + bb0 = (*pb0) * aa; + bb1 = (*pb1) * aa; + bb2 = (*pb2) * aa; + bb3 = (*pb3) * aa; + + *b = bb0; + *(b+1) = bb1; + *(b+2) = bb2; + *(b+3) = bb3; + + *pb0 = bb0; + *pb1 = bb1; + *pb2 = bb2; + *pb3 = bb3; + + b += 4; + + pc0 = c + j * ldc * 4; + pc1 = pc0 + ldc; + pc2 = pc1 + ldc; + pc3 = pc2 + ldc; + + pa = a; + for (k = i; k > 0; k -= vl) + { + vl = VSETVL(k); + vc0 = VLEV_FLOAT(pc0, vl); + vc1 = VLEV_FLOAT(pc1, vl); + vc2 = VLEV_FLOAT(pc2, vl); + vc3 = VLEV_FLOAT(pc3, vl); + va = VLEV_FLOAT(pa, vl); + vc0 = VFNMSACVF_FLOAT(vc0, bb0, va, vl); + vc1 = VFNMSACVF_FLOAT(vc1, bb1, va, vl); + vc2 = VFNMSACVF_FLOAT(vc2, bb2, va, vl); + vc3 = VFNMSACVF_FLOAT(vc3, bb3, va, vl); + VSEV_FLOAT(pc0, vc0, vl); + VSEV_FLOAT(pc1, vc1, vl); + VSEV_FLOAT(pc2, vc2, vl); + VSEV_FLOAT(pc3, vc3, vl); + + pa += vl; + pc0 += vl; + pc1 += vl; + pc2 += vl; + pc3 += vl; + } + pc += ldc * 4; + } + + if (n & 2) + { + pb0 = pc + j * ldc * 2; + pb1 = pb0 + ldc; + + bb0 = (*pb0) * aa; + bb1 = (*pb1) * aa; + + *b = bb0; + *(b+1) = bb1; + + *pb0 = bb0; + *pb1 = bb1; + + b += 2; + + pc0 = c + j * ldc * 2; + pc1 = pc0 + ldc; + + pa = a; + for (k = i; k > 0; k -= vl) + { + vl = VSETVL(k); + vc0 = VLEV_FLOAT(pc0, vl); + vc1 = VLEV_FLOAT(pc1, vl); + va = VLEV_FLOAT(pa, vl); + vc0 = VFNMSACVF_FLOAT(vc0, bb0, va, vl); + vc1 = VFNMSACVF_FLOAT(vc1, bb1, va, vl); + VSEV_FLOAT(pc0, vc0, vl); + VSEV_FLOAT(pc1, vc1, vl); + + pa += vl; + pc0 += vl; + pc1 += vl; + } + pc += ldc * 2; + } + + if (n & 1) + { + pb0 = pc; + bb0 = (*pb0) * aa; + *b = bb0; + *pb0 = bb0; + b += 1; + + pc0 = pc - i; + pa = a; + for (k = i; k > 0; k -= vl) + { + vl = VSETVL(k); + vc0 = VLEV_FLOAT(pc0, vl); + va = VLEV_FLOAT(pa, vl); + vc0 = VFNMSACVF_FLOAT(vc0, bb0, va, vl); + VSEV_FLOAT(pc0, vc0, vl); + + pa += vl; + pc0 += vl; + } + } + + a -= m; + b -= 2 * n; + } + +} +#else +static inline void solve_generic(BLASLONG m, BLASLONG n, FLOAT *a, FLOAT *b, FLOAT *c, BLASLONG ldc) { + + FLOAT aa, bb; + + int i, j, k; + + a += (m - 1) * m; + b += (m - 1) * n; + + for (i = m - 1; i >= 0; i--) { + + aa = *(a + i); + + for (j = 0; j < n; j ++) { + bb = *(c + i + j * ldc); + bb *= aa; + *b = bb; + *(c + i + j * ldc) = bb; + b ++; + + for (k = 0; k < i; k ++){ + *(c + k + j * ldc) -= bb * *(a + k); + } + + } + a -= m; + b -= 2 * n; + } + +} + +#endif + +#else + +static inline void solve(BLASLONG m, BLASLONG n, FLOAT *a, FLOAT *b, FLOAT *c, BLASLONG ldc) { + + FLOAT aa1, aa2; + FLOAT bb1, bb2; + FLOAT cc1, cc2; + + int i, j, k; + + ldc *= 2; + a += (m - 1) * m * 2; + b += (m - 1) * n * 2; + + for (i = m - 1; i >= 0; i--) { + + aa1 = *(a + i * 2 + 0); + aa2 = *(a + i * 2 + 1); + + for (j = 0; j < n; j ++) { + bb1 = *(c + i * 2 + 0 + j * ldc); + bb2 = *(c + i * 2 + 1 + j * ldc); + +#ifndef CONJ + cc1 = aa1 * bb1 - aa2 * bb2; + cc2 = aa1 * bb2 + aa2 * bb1; +#else + cc1 = aa1 * bb1 + aa2 * bb2; + cc2 = aa1 * bb2 - aa2 * bb1; +#endif + + + *(b + 0) = cc1; + *(b + 1) = cc2; + *(c + i * 2 + 0 + j * ldc) = cc1; + *(c + i * 2 + 1 + j * ldc) = cc2; + b += 2; + + for (k = 0; k < i; k ++){ +#ifndef CONJ + *(c + k * 2 + 0 + j * ldc) -= cc1 * *(a + k * 2 + 0) - cc2 * *(a + k * 2 + 1); + *(c + k * 2 + 1 + j * ldc) -= cc1 * *(a + k * 2 + 1) + cc2 * *(a + k * 2 + 0); +#else + *(c + k * 2 + 0 + j * ldc) -= cc1 * *(a + k * 2 + 0) + cc2 * *(a + k * 2 + 1); + *(c + k * 2 + 1 + j * ldc) -= - cc1 * *(a + k * 2 + 1) + cc2 * *(a + k * 2 + 0); +#endif + } + + } + a -= m * 2; + b -= 4 * n; + } + +} + +#endif + + +int CNAME(BLASLONG m, BLASLONG n, BLASLONG k, FLOAT dummy1, +#ifdef COMPLEX + FLOAT dummy2, +#endif + FLOAT *a, FLOAT *b, FLOAT *c, BLASLONG ldc, BLASLONG offset){ + + BLASLONG i, j; + FLOAT *aa, *cc; + BLASLONG kk; + + size_t vl = VSETVL_MAX; + + //fprintf(stderr, "%s , %s, m = %4ld n = %4ld k = %4ld offset = %4ld\n", __FILE__, __FUNCTION__, m, n, k, offset); // Debug + + j = (n >> GEMM_UNROLL_N_SHIFT); + + while (j > 0) { + + kk = m + offset; + + i = m % vl; + if (i) { + aa = a + (m - i) * k * COMPSIZE; + cc = c + (m - i) * COMPSIZE; + + if (k - kk > 0) { + GEMM_KERNEL(i, GEMM_UNROLL_N, k - kk, dm1, +#ifdef COMPLEX + ZERO, +#endif + aa + i * kk * COMPSIZE, + b + GEMM_UNROLL_N * kk * COMPSIZE, + cc, + ldc); + } + + solve(i, GEMM_UNROLL_N, + aa + (kk - i) * i * COMPSIZE, + b + (kk - i) * GEMM_UNROLL_N * COMPSIZE, + cc, ldc); + + kk -= i; + + } + + int mod = i; + i = vl; + if (i <= m) { + aa = a + (m - mod - vl) * k * COMPSIZE; + cc = c + (m - mod - vl) * COMPSIZE; + + do { + if (k - kk > 0) { + GEMM_KERNEL(vl, GEMM_UNROLL_N, k - kk, dm1, +#ifdef COMPLEX + ZERO, +#endif + aa + vl * kk * COMPSIZE, + b + GEMM_UNROLL_N * kk * COMPSIZE, + cc, + ldc); + } + + solve(vl, GEMM_UNROLL_N, + aa + (kk - vl) * vl * COMPSIZE, + b + (kk - vl) * GEMM_UNROLL_N * COMPSIZE, + cc, ldc); + + aa -= vl * k * COMPSIZE; + cc -= vl * COMPSIZE; + kk -= vl; + + i += vl; + } while (i <= m); + } + + + b += GEMM_UNROLL_N * k * COMPSIZE; + c += GEMM_UNROLL_N * ldc * COMPSIZE; + j --; + } + + if (n & (GEMM_UNROLL_N - 1)) { + + j = (GEMM_UNROLL_N >> 1); + while (j > 0) { + if (n & j) { + + kk = m + offset; + + i = m % vl; + if (i) { + aa = a + (m - i) * k * COMPSIZE; + cc = c + (m - i) * COMPSIZE; + + if (k - kk > 0) { + GEMM_KERNEL(i, j, k - kk, dm1, +#ifdef COMPLEX + ZERO, +#endif + aa + i * kk * COMPSIZE, + b + j * kk * COMPSIZE, + cc, ldc); + } + + solve(i, j, + aa + (kk - i) * i * COMPSIZE, + b + (kk - i) * j * COMPSIZE, + cc, ldc); + + kk -= i; + + } + + int mod = i; + i = vl; + if (i <= m) { + aa = a + (m - mod - vl) * k * COMPSIZE; + cc = c + (m - mod - vl) * COMPSIZE; + + do { + if (k - kk > 0) { + GEMM_KERNEL(vl, j, k - kk, dm1, +#ifdef COMPLEX + ZERO, +#endif + aa + vl * kk * COMPSIZE, + b + j * kk * COMPSIZE, + cc, + ldc); + } + + solve(vl, j, + aa + (kk - vl) * vl * COMPSIZE, + b + (kk - vl) * j * COMPSIZE, + cc, ldc); + + aa -= vl * k * COMPSIZE; + cc -= vl * COMPSIZE; + kk -= vl; + + i += vl; + } while (i <= m); + } + + b += j * k * COMPSIZE; + c += j * ldc * COMPSIZE; + } + j >>= 1; + } + } + + return 0; +} diff --git a/kernel/riscv64/trsm_kernel_LT_rvv_v1.c b/kernel/riscv64/trsm_kernel_LT_rvv_v1.c new file mode 100644 index 000000000..0380bd1bb --- /dev/null +++ b/kernel/riscv64/trsm_kernel_LT_rvv_v1.c @@ -0,0 +1,840 @@ +/*************************************************************************** +Copyright (c) 2022, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" + +#if !defined(DOUBLE) +#define VSETVL(n) vsetvl_e32m2(n) +#define VSETVL_MAX vsetvlmax_e32m2() +#define FLOAT_V_T vfloat32m2_t +#define VLEV_FLOAT vle32_v_f32m2 +#define VLSEV_FLOAT vlse32_v_f32m2 +#define VLSEG2_FLOAT vlseg2e32_v_f32m2 +#define VSEV_FLOAT vse32_v_f32m2 +#define VSSEV_FLOAT vsse32_v_f32m2 +#define VSSEG2_FLOAT vsseg2e32_v_f32m2 +#define VFMACCVF_FLOAT vfmacc_vf_f32m2 +#define VFMULVF_FLOAT vfmul_vf_f32m2 +#define VFNMSACVF_FLOAT vfnmsac_vf_f32m2 +#else +#define VSETVL(n) vsetvl_e64m2(n) +#define VSETVL_MAX vsetvlmax_e64m2() +#define FLOAT_V_T vfloat64m2_t +#define VLEV_FLOAT vle64_v_f64m2 +#define VLSEV_FLOAT vlse64_v_f64m2 +#define VLSEG2_FLOAT vlseg2e64_v_f64m2 +#define VSEV_FLOAT vse64_v_f64m2 +#define VSSEV_FLOAT vsse64_v_f64m2 +#define VSSEG2_FLOAT vsseg2e64_v_f64m2 +#define VFMACCVF_FLOAT vfmacc_vf_f64m2 +#define VFMULVF_FLOAT vfmul_vf_f64m2 +#define VFNMSACVF_FLOAT vfnmsac_vf_f64m2 +#endif + + +static FLOAT dm1 = -1.; + +#ifdef CONJ +#define GEMM_KERNEL GEMM_KERNEL_L +#else +#define GEMM_KERNEL GEMM_KERNEL_N +#endif + +#if GEMM_DEFAULT_UNROLL_N == 1 +#define GEMM_UNROLL_N_SHIFT 0 +#endif + +#if GEMM_DEFAULT_UNROLL_N == 2 +#define GEMM_UNROLL_N_SHIFT 1 +#endif + +#if GEMM_DEFAULT_UNROLL_N == 4 +#define GEMM_UNROLL_N_SHIFT 2 +#endif + +#if GEMM_DEFAULT_UNROLL_N == 8 +#define GEMM_UNROLL_N_SHIFT 3 +#endif + +#if GEMM_DEFAULT_UNROLL_N == 16 +#define GEMM_UNROLL_N_SHIFT 4 +#endif + +// Optimizes the implementation in ../arm64/trsm_kernel_LT_sve.c + +#ifndef COMPLEX +#if GEMM_DEFAULT_UNROLL_N == 1 + +static inline void solve(BLASLONG m, BLASLONG n, FLOAT *a, FLOAT *b, FLOAT *c, BLASLONG ldc) +{ + FLOAT aa, bb; + FLOAT *pa, *pc; + + int i, j, k; + size_t vl; + FLOAT_V_T va, vc; + for (i = 0; i < m; i++) + { + aa = *(a + i); + for (j = 0; j < n; j ++) + { + bb = *(c + i + j * ldc); + bb *= aa; + *b = bb; + *(c + i + j * ldc) = bb; + b++; + pa = a + i + 1; + pc = c + j * ldc + i + 1; + for (k = (m - i - 1); k > 0; k -= vl) + { + vl = VSETVL(k); + vc = VLEV_FLOAT(pc, vl); + va = VLEV_FLOAT(pa, vl); + vc = VFNMSACVF_FLOAT(vc, bb, va, vl); + VSEV_FLOAT(pc, vc, vl); + pa += vl; + pc += vl; + } + } + a += m; + } +} +#elif GEMM_DEFAULT_UNROLL_N == 2 + +static inline void solve(BLASLONG m, BLASLONG n, FLOAT *a, FLOAT *b, FLOAT *c, BLASLONG ldc) +{ + + FLOAT aa, bb0, bb1; + FLOAT *pa, *pc, *pc0, *pc1; + FLOAT *pb0, *pb1; + + int i, j, k; + size_t vl; + FLOAT_V_T va, vc0, vc1; + for (i = 0; i < m; i++) + { + aa = *(a + i); + pc = c + i; + for (j = 0; j < n/2; j ++) + { + pb0 = pc + j * ldc * 2; + pb1 = pb0 + ldc; + bb0 = (*pb0) * aa; + bb1 = (*pb1) * aa; + *b = bb0; + *(b+1) = bb1; + *pb0 = bb0; + *pb1 = bb1; + b += 2; + pa = a + i + 1; + pc0 = pb0 + 1; + pc1 = pc0 + ldc; + for (k = (m - i - 1); k > 0; k -= vl) + { + vl = VSETVL(k); + vc0 = VLEV_FLOAT(pc0, vl); + vc1 = VLEV_FLOAT(pc1, vl); + va = VLEV_FLOAT(pa, vl); + vc0 = VFNMSACVF_FLOAT(vc0, bb0, va, vl); + vc1 = VFNMSACVF_FLOAT(vc1, bb1, va, vl); + VSEV_FLOAT(pc0, vc0, vl); + VSEV_FLOAT(pc1, vc1, vl); + pa += vl; + pc0 += vl; + pc1 += vl; + } + } + pc += ldc * (n/2) * 2; + if (n & 1) + { + pb0 = pc; + bb0 = *(pb0); + bb0 *= aa; + *b = bb0; + *(c + i) = bb0; + b++; + pa = a + i + 1; + pc0 = pb0 + 1; + for (k = (m - i - 1); k > 0; k -= vl) + { + vl = VSETVL(k); + vc0 = VLEV_FLOAT(pc0, vl); + va = VLEV_FLOAT(pa, vl); + vc0 = VFNMSACVF_FLOAT(vc0, bb0, va, vl); + VSEV_FLOAT(pc0, vc0, vl); + pa += vl; + pc0 += vl; + } + } + + a += m; + } +} +#elif GEMM_DEFAULT_UNROLL_N == 4 + +static inline void solve(BLASLONG m, BLASLONG n, FLOAT *a, FLOAT *b, FLOAT *c, BLASLONG ldc) +{ + + FLOAT aa, bb0, bb1, bb2, bb3; + FLOAT *pa, *pc; + FLOAT *pc0, *pc1, *pc2, *pc3; + FLOAT *pb0, *pb1, *pb2, *pb3; + + int i, j, k; + size_t vl; + FLOAT_V_T va; + FLOAT_V_T vc0, vc1, vc2, vc3; + for (i = 0; i < m; i++) + { + aa = *(a + i); + pc = c + i; + for (j = 0; j < n/4; j ++) + { + pb0 = pc; + pb1 = pb0 + ldc; + pb2 = pb1 + ldc; + pb3 = pb2 + ldc; + + bb0 = (*pb0) * aa; + bb1 = (*pb1) * aa; + bb2 = (*pb2) * aa; + bb3 = (*pb3) * aa; + + *b = bb0; + *(b+1) = bb1; + *(b+2) = bb2; + *(b+3) = bb3; + + *pb0 = bb0; + *pb1 = bb1; + *pb2 = bb2; + *pb3 = bb3; + b += 4; + + pa = a + i + 1; + pc0 = pb0 + 1; + pc1 = pc0 + ldc; + pc2 = pc1 + ldc; + pc3 = pc2 + ldc; + + for (k = (m - i - 1); k > 0; k -= vl) + { + vl = VSETVL(k); + vc0 = VLEV_FLOAT(pc0, vl); + vc1 = VLEV_FLOAT(pc1, vl); + vc2 = VLEV_FLOAT(pc2, vl); + vc3 = VLEV_FLOAT(pc3, vl); + + va = VLEV_FLOAT(pa, vl); + + vc0 = VFNMSACVF_FLOAT(vc0, bb0, va, vl); + vc1 = VFNMSACVF_FLOAT(vc1, bb1, va, vl); + vc2 = VFNMSACVF_FLOAT(vc2, bb2, va, vl); + vc3 = VFNMSACVF_FLOAT(vc3, bb3, va, vl); + + VSEV_FLOAT(pc0, vc0, vl); + VSEV_FLOAT(pc1, vc1, vl); + VSEV_FLOAT(pc2, vc2, vl); + VSEV_FLOAT(pc3, vc3, vl); + + pa += vl; + pc0 += vl; + pc1 += vl; + pc2 += vl; + pc3 += vl; + } + } + pc += ldc * (n/4) * 4; + + if (n & 2) + { + pb0 = pc; + pb1 = pb0 + ldc; + bb0 = (*pb0) * aa; + bb1 = (*pb1) * aa; + *b = bb0; + *(b+1) = bb1; + *pb0 = bb0; + *pb1 = bb1; + b += 2; + pa = a + i + 1; + pc0 = pb0 + 1; + pc1 = pc0 + ldc; + for (k = (m - i - 1); k > 0; k -= vl) + { + vl = VSETVL(k); + vc0 = VLEV_FLOAT(pc0, vl); + vc1 = VLEV_FLOAT(pc1, vl); + va = VLEV_FLOAT(pa, vl); + vc0 = VFNMSACVF_FLOAT(vc0, bb0, va, vl); + vc1 = VFNMSACVF_FLOAT(vc1, bb1, va, vl); + VSEV_FLOAT(pc0, vc0, vl); + VSEV_FLOAT(pc1, vc1, vl); + pa += vl; + pc0 += vl; + pc1 += vl; + } + pc += ldc * 2; + } + + if (n & 1) + { + pb0 = pc; + bb0 = *(pb0); + bb0 *= aa; + *b = bb0; + *(c + i) = bb0; + b++; + pa = a + i + 1; + pc0 = pb0 + 1; + for (k = (m - i - 1); k > 0; k -= vl) + { + vl = VSETVL(k); + vc0 = VLEV_FLOAT(pc0, vl); + va = VLEV_FLOAT(pa, vl); + vc0 = VFNMSACVF_FLOAT(vc0, bb0, va, vl); + VSEV_FLOAT(pc0, vc0, vl); + pa += vl; + pc0 += vl; + } + } + + a += m; + } +} +#elif GEMM_DEFAULT_UNROLL_N == 8 + +static inline void solve(BLASLONG m, BLASLONG n, FLOAT *a, FLOAT *b, FLOAT *c, BLASLONG ldc) +{ + + FLOAT aa, bb0, bb1, bb2, bb3, bb4, bb5, bb6, bb7; + FLOAT *pa, *pc; + FLOAT *pc0, *pc1, *pc2, *pc3, *pc4, *pc5, *pc6, *pc7; + FLOAT *pb0, *pb1, *pb2, *pb3, *pb4, *pb5, *pb6, *pb7; + + int i, j, k; + size_t vl; + FLOAT_V_T va; + FLOAT_V_T vc0, vc1, vc2, vc3, vc4, vc5, vc6, vc7; + for (i = 0; i < m; i++) + { + aa = *(a + i); + pc = c + i; + for (j = 0; j < n/8; j ++) + { + pb0 = pc + j * ldc * 8; + pb1 = pb0 + ldc; + pb2 = pb1 + ldc; + pb3 = pb2 + ldc; + pb4 = pb3 + ldc; + pb5 = pb4 + ldc; + pb6 = pb5 + ldc; + pb7 = pb6 + ldc; + + bb0 = (*pb0) * aa; + bb1 = (*pb1) * aa; + bb2 = (*pb2) * aa; + bb3 = (*pb3) * aa; + bb4 = (*pb4) * aa; + bb5 = (*pb5) * aa; + bb6 = (*pb6) * aa; + bb7 = (*pb7) * aa; + + *b = bb0; + *(b+1) = bb1; + *(b+2) = bb2; + *(b+3) = bb3; + *(b+4) = bb4; + *(b+5) = bb5; + *(b+6) = bb6; + *(b+7) = bb7; + + *pb0 = bb0; + *pb1 = bb1; + *pb2 = bb2; + *pb3 = bb3; + *pb4 = bb4; + *pb5 = bb5; + *pb6 = bb6; + *pb7 = bb7; + b += 8; + + pa = a + i + 1; + pc0 = pb0 + 1; + pc1 = pc0 + ldc; + pc2 = pc1 + ldc; + pc3 = pc2 + ldc; + pc4 = pc3 + ldc; + pc5 = pc4 + ldc; + pc6 = pc5 + ldc; + pc7 = pc6 + ldc; + + for (k = (m - i - 1); k > 0; k -= vl) + { + vl = VSETVL(k); + vc0 = VLEV_FLOAT(pc0, vl); + vc1 = VLEV_FLOAT(pc1, vl); + vc2 = VLEV_FLOAT(pc2, vl); + vc3 = VLEV_FLOAT(pc3, vl); + vc4 = VLEV_FLOAT(pc4, vl); + vc5 = VLEV_FLOAT(pc5, vl); + vc6 = VLEV_FLOAT(pc6, vl); + vc7 = VLEV_FLOAT(pc7, vl); + + va = VLEV_FLOAT(pa, vl); + + vc0 = VFNMSACVF_FLOAT(vc0, bb0, va, vl); + vc1 = VFNMSACVF_FLOAT(vc1, bb1, va, vl); + vc2 = VFNMSACVF_FLOAT(vc2, bb2, va, vl); + vc3 = VFNMSACVF_FLOAT(vc3, bb3, va, vl); + vc4 = VFNMSACVF_FLOAT(vc4, bb4, va, vl); + vc5 = VFNMSACVF_FLOAT(vc5, bb5, va, vl); + vc6 = VFNMSACVF_FLOAT(vc6, bb6, va, vl); + vc7 = VFNMSACVF_FLOAT(vc7, bb7, va, vl); + + VSEV_FLOAT(pc0, vc0, vl); + VSEV_FLOAT(pc1, vc1, vl); + VSEV_FLOAT(pc2, vc2, vl); + VSEV_FLOAT(pc3, vc3, vl); + VSEV_FLOAT(pc4, vc4, vl); + VSEV_FLOAT(pc5, vc5, vl); + VSEV_FLOAT(pc6, vc6, vl); + VSEV_FLOAT(pc7, vc7, vl); + + pa += vl; + pc0 += vl; + pc1 += vl; + pc2 += vl; + pc3 += vl; + pc4 += vl; + pc5 += vl; + pc6 += vl; + pc7 += vl; + } + } + pc += ldc * (n/8) * 8; + + if (n & 4) + { + pb0 = pc; + pb1 = pb0 + ldc; + pb2 = pb1 + ldc; + pb3 = pb2 + ldc; + + bb0 = (*pb0) * aa; + bb1 = (*pb1) * aa; + bb2 = (*pb2) * aa; + bb3 = (*pb3) * aa; + + *b = bb0; + *(b+1) = bb1; + *(b+2) = bb2; + *(b+3) = bb3; + + *pb0 = bb0; + *pb1 = bb1; + *pb2 = bb2; + *pb3 = bb3; + b += 4; + + pa = a + i + 1; + pc0 = pb0 + 1; + pc1 = pc0 + ldc; + pc2 = pc1 + ldc; + pc3 = pc2 + ldc; + + for (k = (m - i - 1); k > 0; k -= vl) + { + vl = VSETVL(k); + vc0 = VLEV_FLOAT(pc0, vl); + vc1 = VLEV_FLOAT(pc1, vl); + vc2 = VLEV_FLOAT(pc2, vl); + vc3 = VLEV_FLOAT(pc3, vl); + + va = VLEV_FLOAT(pa, vl); + + vc0 = VFNMSACVF_FLOAT(vc0, bb0, va, vl); + vc1 = VFNMSACVF_FLOAT(vc1, bb1, va, vl); + vc2 = VFNMSACVF_FLOAT(vc2, bb2, va, vl); + vc3 = VFNMSACVF_FLOAT(vc3, bb3, va, vl); + + VSEV_FLOAT(pc0, vc0, vl); + VSEV_FLOAT(pc1, vc1, vl); + VSEV_FLOAT(pc2, vc2, vl); + VSEV_FLOAT(pc3, vc3, vl); + + pa += vl; + pc0 += vl; + pc1 += vl; + pc2 += vl; + pc3 += vl; + } + pc += ldc * 4; + } + + if (n & 2) + { + pb0 = pc; + pb1 = pb0 + ldc; + bb0 = (*pb0) * aa; + bb1 = (*pb1) * aa; + *b = bb0; + *(b+1) = bb1; + *pb0 = bb0; + *pb1 = bb1; + b += 2; + pa = a + i + 1; + pc0 = pb0 + 1; + pc1 = pc0 + ldc; + for (k = (m - i - 1); k > 0; k -= vl) + { + vl = VSETVL(k); + vc0 = VLEV_FLOAT(pc0, vl); + vc1 = VLEV_FLOAT(pc1, vl); + va = VLEV_FLOAT(pa, vl); + vc0 = VFNMSACVF_FLOAT(vc0, bb0, va, vl); + vc1 = VFNMSACVF_FLOAT(vc1, bb1, va, vl); + VSEV_FLOAT(pc0, vc0, vl); + VSEV_FLOAT(pc1, vc1, vl); + pa += vl; + pc0 += vl; + pc1 += vl; + } + pc += ldc * 2; + } + + if (n & 1) + { + pb0 = pc; + bb0 = *(pb0); + bb0 *= aa; + *b = bb0; + *(c + i) = bb0; + b++; + pa = a + i + 1; + pc0 = pb0 + 1; + for (k = (m - i - 1); k > 0; k -= vl) + { + vl = VSETVL(k); + vc0 = VLEV_FLOAT(pc0, vl); + va = VLEV_FLOAT(pa, vl); + vc0 = VFNMSACVF_FLOAT(vc0, bb0, va, vl); + VSEV_FLOAT(pc0, vc0, vl); + pa += vl; + pc0 += vl; + } + } + + a += m; + } +} + +#else + +static inline void solve(BLASLONG m, BLASLONG n, FLOAT *a, FLOAT *b, FLOAT *c, BLASLONG ldc) { + + FLOAT aa, bb; + + int i, j, k; + + for (i = 0; i < m; i++) { + + aa = *(a + i); + + for (j = 0; j < n; j ++) { + bb = *(c + i + j * ldc); + bb *= aa; + *b = bb; + *(c + i + j * ldc) = bb; + b ++; + + for (k = i + 1; k < m; k ++){ + *(c + k + j * ldc) -= bb * *(a + k); + } + + } + a += m; + } +} + +#endif + +#else + +static inline void solve(BLASLONG m, BLASLONG n, FLOAT *a, FLOAT *b, FLOAT *c, BLASLONG ldc) { + + FLOAT aa1, aa2; + FLOAT bb1, bb2; + FLOAT cc1, cc2; + + int i, j, k; + + ldc *= 2; + + for (i = 0; i < m; i++) { + + aa1 = *(a + i * 2 + 0); + aa2 = *(a + i * 2 + 1); + + for (j = 0; j < n; j ++) { + bb1 = *(c + i * 2 + 0 + j * ldc); + bb2 = *(c + i * 2 + 1 + j * ldc); + +#ifndef CONJ + cc1 = aa1 * bb1 - aa2 * bb2; + cc2 = aa1 * bb2 + aa2 * bb1; +#else + cc1 = aa1 * bb1 + aa2 * bb2; + cc2 = aa1 * bb2 - aa2 * bb1; +#endif + + *(b + 0) = cc1; + *(b + 1) = cc2; + *(c + i * 2 + 0 + j * ldc) = cc1; + *(c + i * 2 + 1 + j * ldc) = cc2; + b += 2; + + for (k = i + 1; k < m; k ++){ +#ifndef CONJ + *(c + k * 2 + 0 + j * ldc) -= cc1 * *(a + k * 2 + 0) - cc2 * *(a + k * 2 + 1); + *(c + k * 2 + 1 + j * ldc) -= cc1 * *(a + k * 2 + 1) + cc2 * *(a + k * 2 + 0); +#else + *(c + k * 2 + 0 + j * ldc) -= cc1 * *(a + k * 2 + 0) + cc2 * *(a + k * 2 + 1); + *(c + k * 2 + 1 + j * ldc) -= -cc1 * *(a + k * 2 + 1) + cc2 * *(a + k * 2 + 0); +#endif + } + + } + a += m * 2; + } +} + + +static inline void solve_N1(BLASLONG m, BLASLONG n, FLOAT *a, FLOAT *b, FLOAT *c, BLASLONG ldc) { + + FLOAT aa1, aa2; + FLOAT bb1, bb2; + FLOAT cc1, cc2; + FLOAT *pa, *pc; + + int i, j, k; + + size_t vl; + FLOAT_V_T va0, va1, vc0, vc1; + + ldc *= 2; + + for (i = 0; i < m; i++) { + + aa1 = *(a + i * 2 + 0); + aa2 = *(a + i * 2 + 1); + + for (j = 0; j < n; j ++) { + bb1 = *(c + i * 2 + 0 + j * ldc); + bb2 = *(c + i * 2 + 1 + j * ldc); + +#ifndef CONJ + cc1 = aa1 * bb1 - aa2 * bb2; + cc2 = aa1 * bb2 + aa2 * bb1; +#else + cc1 = aa1 * bb1 + aa2 * bb2; + cc2 = aa1 * bb2 - aa2 * bb1; +#endif + + *(b + 0) = cc1; + *(b + 1) = cc2; + *(c + i * 2 + 0 + j * ldc) = cc1; + *(c + i * 2 + 1 + j * ldc) = cc2; + b += 2; + + pa = a + (i + 1) * 2; + pc = c + j * ldc + (i + 1) * 2; + for (k = (m - i - 1); k > 0; k -= vl) + { + vl = VSETVL(k); + VLSEG2_FLOAT(&va0, &va1, pa, vl); + VLSEG2_FLOAT(&vc0, &vc1, pc, vl); +#ifndef CONJ + vc0 = VFNMSACVF_FLOAT(vc0, cc1, va0); + vc0 = VFMACCVF_FLOAT(vc0, cc2, va1); + vc1 = VFNMSACVF_FLOAT(vc1, cc1, va1); + vc1 = VFNMSACVF_FLOAT(vc1, cc2, va0); +#else + vc0 = VFNMSACVF_FLOAT(vc0, cc1, va0); + vc0 = VFNMSACVF_FLOAT(vc0, cc2, va1); + vc1 = VFMACCVF_FLOAT(vc1, cc1, va1); + vc1 = VFNMSACVF_FLOAT(vc1, cc2, va0); +#endif + VSSEG2_FLOAT(pc, vc0, vc1, vl); + pa += vl * 2; + pc += vl * 2; + } + } + } + a += m * 2; + } +} + +#endif + + +int CNAME(BLASLONG m, BLASLONG n, BLASLONG k, FLOAT dummy1, +#ifdef COMPLEX + FLOAT dummy2, +#endif + FLOAT *a, FLOAT *b, FLOAT *c, BLASLONG ldc, BLASLONG offset){ + + FLOAT *aa, *cc; + BLASLONG kk; + BLASLONG i, j; + + size_t vl = VSETVL_MAX; + + //fprintf(stderr, "%s , %s, m = %4ld n = %4ld k = %4ld offset = %4ld\n", __FILE__, __FUNCTION__, m, n, k, offset); // Debug + + j = (n >> GEMM_UNROLL_N_SHIFT); + + while (j > 0) { + + kk = offset; + aa = a; + cc = c; + + i = vl; + + while (i <= m) { + + if (kk > 0) { + GEMM_KERNEL(vl, GEMM_UNROLL_N, kk, dm1, +#ifdef COMPLEX + ZERO, +#endif + aa, b, cc, ldc); + } + + solve(vl, GEMM_UNROLL_N, + aa + kk * vl * COMPSIZE, + b + kk * GEMM_UNROLL_N * COMPSIZE, + cc, ldc); + + aa += vl * k * COMPSIZE; + cc += vl * COMPSIZE; + kk += vl; + i += vl; + } + + i = m % vl; + if (i) { + if (kk > 0) { + GEMM_KERNEL(i, GEMM_UNROLL_N, kk, dm1, +#ifdef COMPLEX + ZERO, +#endif + aa, b, cc, ldc); + } + solve(i, GEMM_UNROLL_N, + aa + kk * i * COMPSIZE, + b + kk * GEMM_UNROLL_N * COMPSIZE, + cc, ldc); + + aa += i * k * COMPSIZE; + cc += i * COMPSIZE; + kk += i; + + } + + b += GEMM_UNROLL_N * k * COMPSIZE; + c += GEMM_UNROLL_N * ldc * COMPSIZE; + j --; + } + + if (n & (GEMM_UNROLL_N - 1)) { + + j = (GEMM_UNROLL_N >> 1); + while (j > 0) { + if (n & j) { + + kk = offset; + aa = a; + cc = c; + + i = vl; + + while (i <= m) { + if (kk > 0) { + GEMM_KERNEL(vl, j, kk, dm1, +#ifdef COMPLEX + ZERO, +#endif + aa, + b, + cc, + ldc); + } + + solve(vl, j, + aa + kk * vl * COMPSIZE, + b + kk * j * COMPSIZE, cc, ldc); + + aa += vl * k * COMPSIZE; + cc += vl * COMPSIZE; + kk += vl; + i += vl; + } + + i = m % vl; + if (i) { + if (kk > 0) { + GEMM_KERNEL(i, j, kk, dm1, +#ifdef COMPLEX + ZERO, +#endif + aa, + b, + cc, + ldc); + } + + solve(i, j, + aa + kk * i * COMPSIZE, + b + kk * j * COMPSIZE, cc, ldc); + + aa += i * k * COMPSIZE; + cc += i * COMPSIZE; + kk += i; + + } + + b += j * k * COMPSIZE; + c += j * ldc * COMPSIZE; + } + j >>= 1; + } + } + + return 0; +} diff --git a/kernel/riscv64/trsm_kernel_RN_rvv_v1.c b/kernel/riscv64/trsm_kernel_RN_rvv_v1.c new file mode 100644 index 000000000..41368be60 --- /dev/null +++ b/kernel/riscv64/trsm_kernel_RN_rvv_v1.c @@ -0,0 +1,792 @@ +/*************************************************************************** +Copyright (c) 2022, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" + +#if !defined(DOUBLE) +#define VSETVL(n) vsetvl_e32m2(n) +#define VSETVL_MAX vsetvlmax_e32m2() +#define FLOAT_V_T vfloat32m2_t +#define VLEV_FLOAT vle32_v_f32m2 +#define VLSEV_FLOAT vlse32_v_f32m2 +#define VLSEG2_FLOAT vlseg2e32_v_f32m2 +#define VSEV_FLOAT vse32_v_f32m2 +#define VSSEV_FLOAT vsse32_v_f32m2 +#define VSSEG2_FLOAT vsseg2e32_v_f32m2 +#define VFMACCVF_FLOAT vfmacc_vf_f32m2 +#define VFNMSACVF_FLOAT vfnmsac_vf_f32m2 +#else +#define VSETVL(n) vsetvl_e64m2(n) +#define VSETVL_MAX vsetvlmax_e64m2() +#define FLOAT_V_T vfloat64m2_t +#define VLEV_FLOAT vle64_v_f64m2 +#define VLSEV_FLOAT vlse64_v_f64m2 +#define VLSEG2_FLOAT vlseg2e64_v_f64m2 +#define VSEV_FLOAT vse64_v_f64m2 +#define VSSEV_FLOAT vsse64_v_f64m2 +#define VSSEG2_FLOAT vsseg2e64_v_f64m2 +#define VFMACCVF_FLOAT vfmacc_vf_f64m2 +#define VFNMSACVF_FLOAT vfnmsac_vf_f64m2 +#endif + + +static FLOAT dm1 = -1.; + +#ifdef CONJ +#define GEMM_KERNEL GEMM_KERNEL_R +#else +#define GEMM_KERNEL GEMM_KERNEL_N +#endif + +#if GEMM_DEFAULT_UNROLL_N == 1 +#define GEMM_UNROLL_N_SHIFT 0 +#endif + +#if GEMM_DEFAULT_UNROLL_N == 2 +#define GEMM_UNROLL_N_SHIFT 1 +#endif + +#if GEMM_DEFAULT_UNROLL_N == 4 +#define GEMM_UNROLL_N_SHIFT 2 +#endif + +#if GEMM_DEFAULT_UNROLL_N == 8 +#define GEMM_UNROLL_N_SHIFT 3 +#endif + +#if GEMM_DEFAULT_UNROLL_N == 16 +#define GEMM_UNROLL_N_SHIFT 4 +#endif + +// Optimizes the implementation in ../arm64/trsm_kernel_RN_sve.c + +#ifndef COMPLEX + +#if GEMM_DEFAULT_UNROLL_N == 1 + +static inline void solve(BLASLONG m, BLASLONG n, FLOAT *a, FLOAT *b, FLOAT *c, BLASLONG ldc) { + + FLOAT aa, bb; + FLOAT *pb, *pc; + BLASLONG stride_ldc = sizeof(FLOAT) * ldc; + int i, j, k; + size_t vl; + FLOAT_V_T vb, vc; + + for (i = 0; i < n; i++) + { + bb = *(b + i); + + for (j = 0; j < m; j ++) + { + aa = *(c + j + i * ldc); + aa *= bb; + *a = aa; + *(c + j + i * ldc) = aa; + a ++; + + pb = b + i + 1; + pc = c + j + (i + 1) *ldc; + for (k = (n - i - 1); k > 0; k -= vl) + { + vl = VSETVL(k); + vc = VLSEV_FLOAT(pc, stride_ldc, vl); + vb = VLEV_FLOAT(pb, vl); + vc = VFNMSACVF_FLOAT(vc, aa, vb, vl); + VSSEV_FLOAT(pc, stride_ldc, vc, vl); + pb += vl; + pc ++; + } + } + b += n; + } +} + +#elif GEMM_DEFAULT_UNROLL_N == 2 + +static inline void solve(BLASLONG m, BLASLONG n, FLOAT *a, FLOAT *b, FLOAT *c, BLASLONG ldc) { + + FLOAT aa0, aa1, bb; + FLOAT *pb, *pc; + FLOAT *pa0, *pa1, *pc0, *pc1; + BLASLONG stride_ldc = sizeof(FLOAT) * ldc; + int i, j, k; + size_t vl; + FLOAT_V_T vb, vc0, vc1; + + for (i = 0; i < n; i++) + { + bb = *(b + i); + pc = c + i * ldc; + for (j = 0; j < m/2; j ++) + { + pa0 = pc + j * 2; + pa1 = pc + j * 2 + 1; + aa0 = *pa0 * bb; + aa1 = *pa1 * bb; + + *pa0 = aa0; + *pa1 = aa1; + *a = aa0; + *(a + 1)= aa1; + a += 2; + + pb = b + i + 1; + pc0 = pa0 + ldc; + pc1 = pa1 + ldc; + for (k = (n - i - 1); k > 0; k -= vl) + { + vl = VSETVL(k); + vc0 = VLSEV_FLOAT(pc0, stride_ldc, vl); + vc1 = VLSEV_FLOAT(pc1, stride_ldc, vl); + vb = VLEV_FLOAT(pb, vl); + vc0 = VFNMSACVF_FLOAT(vc0, aa0, vb, vl); + vc1 = VFNMSACVF_FLOAT(vc1, aa1, vb, vl); + VSSEV_FLOAT(pc0, stride_ldc, vc0, vl); + VSSEV_FLOAT(pc1, stride_ldc, vc1, vl); + pb += vl; + pc0++; + pc1++; + } + } + pc += (m/2)*2; + if (m & 1) + { + pa0 = pc; + aa0 = *pa0 * bb; + + *pa0 = aa0; + *a = aa0; + a += 1; + + pb = b + i + 1; + pc0 = pa0 + ldc; + for (k = (n - i - 1); k > 0; k -= vl) + { + vl = VSETVL(k); + vc0 = VLSEV_FLOAT(pc0, stride_ldc, vl); + vb = VLEV_FLOAT(pb, vl); + vc0 = VFNMSACVF_FLOAT(vc0, aa0, vb, vl); + VSSEV_FLOAT(pc0, stride_ldc, vc0, vl); + pb += vl; + pc0++; + } + } + b += n; + } +} + +#elif GEMM_DEFAULT_UNROLL_N == 4 + +static inline void solve(BLASLONG m, BLASLONG n, FLOAT *a, FLOAT *b, FLOAT *c, BLASLONG ldc) { + + FLOAT bb; + FLOAT aa0, aa1, aa2, aa3; + FLOAT *pb, *pc; + FLOAT *pa0, *pa1, *pa2, *pa3; + FLOAT *pc0, *pc1, *pc2, *pc3; + BLASLONG stride_ldc = sizeof(FLOAT) * ldc; + int i, j, k; + size_t vl; + FLOAT_V_T vb, vc0, vc1, vc2, vc3; + + for (i = 0; i < n; i++) + { + bb = *(b + i); + pc = c + i * ldc; + for (j = 0; j < m/4; j ++) + { + pa0 = pc + j * 4; + pa1 = pa0 + 1; + pa2 = pa1 + 1; + pa3 = pa2 + 1; + + aa0 = *pa0 * bb; + aa1 = *pa1 * bb; + aa2 = *pa2 * bb; + aa3 = *pa3 * bb; + + *pa0 = aa0; + *pa1 = aa1; + *pa2 = aa2; + *pa3 = aa3; + + *a = aa0; + *(a + 1)= aa1; + *(a + 2)= aa2; + *(a + 3)= aa3; + + a += 4; + + pb = b + i + 1; + pc0 = pa0 + ldc; + pc1 = pa1 + ldc; + pc2 = pa2 + ldc; + pc3 = pa3 + ldc; + for (k = (n - i - 1); k > 0; k -= vl) + { + vl = VSETVL(k); + vc0 = VLSEV_FLOAT(pc0, stride_ldc, vl); + vc1 = VLSEV_FLOAT(pc1, stride_ldc, vl); + vc2 = VLSEV_FLOAT(pc2, stride_ldc, vl); + vc3 = VLSEV_FLOAT(pc3, stride_ldc, vl); + vb = VLEV_FLOAT(pb, vl); + + vc0 = VFNMSACVF_FLOAT(vc0, aa0, vb, vl); + vc1 = VFNMSACVF_FLOAT(vc1, aa1, vb, vl); + vc2 = VFNMSACVF_FLOAT(vc2, aa2, vb, vl); + vc3 = VFNMSACVF_FLOAT(vc3, aa3, vb, vl); + + VSSEV_FLOAT(pc0, stride_ldc, vc0, vl); + VSSEV_FLOAT(pc1, stride_ldc, vc1, vl); + VSSEV_FLOAT(pc2, stride_ldc, vc2, vl); + VSSEV_FLOAT(pc3, stride_ldc, vc3, vl); + + pb += vl; + pc0++; + pc1++; + pc2++; + pc3++; + } + } + pc += (m/4)*4; + + if (m & 2) + { + pa0 = pc; + pa1 = pa0 + 1; + + aa0 = *pa0 * bb; + aa1 = *pa1 * bb; + + *pa0 = aa0; + *pa1 = aa1; + + *a = aa0; + *(a + 1)= aa1; + + a += 2; + + pb = b + i + 1; + pc0 = pa0 + ldc; + pc1 = pa1 + ldc; + for (k = (n - i - 1); k > 0; k -= vl) + { + vl = VSETVL(k); + vc0 = VLSEV_FLOAT(pc0, stride_ldc, vl); + vc1 = VLSEV_FLOAT(pc1, stride_ldc, vl); + vb = VLEV_FLOAT(pb, vl); + + vc0 = VFNMSACVF_FLOAT(vc0, aa0, vb, vl); + vc1 = VFNMSACVF_FLOAT(vc1, aa1, vb, vl); + + VSSEV_FLOAT(pc0, stride_ldc, vc0, vl); + VSSEV_FLOAT(pc1, stride_ldc, vc1, vl); + + pb += vl; + pc0++; + pc1++; + } + pc += 2; + } + + if (m & 1) + { + pa0 = pc; + aa0 = *pa0 * bb; + + *pa0 = aa0; + *a = aa0; + a += 1; + + pb = b + i + 1; + pc0 = pa0 + ldc; + for (k = (n - i - 1); k > 0; k -= vl) + { + vl = VSETVL(k); + vc0 = VLSEV_FLOAT(pc0, stride_ldc, vl); + vb = VLEV_FLOAT(pb, vl); + vc0 = VFNMSACVF_FLOAT(vc0, aa0, vb, vl); + VSSEV_FLOAT(pc0, stride_ldc, vc0, vl); + pb += vl; + pc0++; + } + } + b += n; + } +} + +#elif GEMM_DEFAULT_UNROLL_N == 8 + +static inline void solve(BLASLONG m, BLASLONG n, FLOAT *a, FLOAT *b, FLOAT *c, BLASLONG ldc) { + + FLOAT bb; + FLOAT aa0, aa1, aa2, aa3, aa4, aa5, aa6, aa7; + FLOAT *pb, *pc; + FLOAT *pa0, *pa1, *pa2, *pa3, *pa4, *pa5, *pa6, *pa7; + FLOAT *pc0, *pc1, *pc2, *pc3, *pc4, *pc5, *pc6, *pc7; + BLASLONG stride_ldc = sizeof(FLOAT) * ldc; + int i, j, k; + size_t vl; + FLOAT_V_T vb, vc0, vc1, vc2, vc3, vc4, vc5, vc6, vc7; + + for (i = 0; i < n; i++) + { + bb = *(b + i); + pc = c + i * ldc; + for (j = 0; j < m/8; j ++) + { + pa0 = pc + j * 8; + pa1 = pa0 + 1; + pa2 = pa1 + 1; + pa3 = pa2 + 1; + pa4 = pa3 + 1; + pa5 = pa4 + 1; + pa6 = pa5 + 1; + pa7 = pa6 + 1; + + aa0 = *pa0 * bb; + aa1 = *pa1 * bb; + aa2 = *pa2 * bb; + aa3 = *pa3 * bb; + aa4 = *pa4 * bb; + aa5 = *pa5 * bb; + aa6 = *pa6 * bb; + aa7 = *pa7 * bb; + + *pa0 = aa0; + *pa1 = aa1; + *pa2 = aa2; + *pa3 = aa3; + *pa4 = aa4; + *pa5 = aa5; + *pa6 = aa6; + *pa7 = aa7; + + *a = aa0; + *(a + 1)= aa1; + *(a + 2)= aa2; + *(a + 3)= aa3; + *(a + 4)= aa4; + *(a + 5)= aa5; + *(a + 6)= aa6; + *(a + 7)= aa7; + + a += 8; + + pb = b + i + 1; + pc0 = pa0 + ldc; + pc1 = pa1 + ldc; + pc2 = pa2 + ldc; + pc3 = pa3 + ldc; + pc4 = pa4 + ldc; + pc5 = pa5 + ldc; + pc6 = pa6 + ldc; + pc7 = pa7 + ldc; + for (k = (n - i - 1); k > 0; k -= vl) + { + vl = VSETVL(k); + vc0 = VLSEV_FLOAT(pc0, stride_ldc, vl); + vc1 = VLSEV_FLOAT(pc1, stride_ldc, vl); + vc2 = VLSEV_FLOAT(pc2, stride_ldc, vl); + vc3 = VLSEV_FLOAT(pc3, stride_ldc, vl); + vc4 = VLSEV_FLOAT(pc4, stride_ldc, vl); + vc5 = VLSEV_FLOAT(pc5, stride_ldc, vl); + vc6 = VLSEV_FLOAT(pc6, stride_ldc, vl); + vc7 = VLSEV_FLOAT(pc7, stride_ldc, vl); + vb = VLEV_FLOAT(pb, vl); + + vc0 = VFNMSACVF_FLOAT(vc0, aa0, vb, vl); + vc1 = VFNMSACVF_FLOAT(vc1, aa1, vb, vl); + vc2 = VFNMSACVF_FLOAT(vc2, aa2, vb, vl); + vc3 = VFNMSACVF_FLOAT(vc3, aa3, vb, vl); + vc4 = VFNMSACVF_FLOAT(vc4, aa4, vb, vl); + vc5 = VFNMSACVF_FLOAT(vc5, aa5, vb, vl); + vc6 = VFNMSACVF_FLOAT(vc6, aa6, vb, vl); + vc7 = VFNMSACVF_FLOAT(vc7, aa7, vb, vl); + + VSSEV_FLOAT(pc0, stride_ldc, vc0, vl); + VSSEV_FLOAT(pc1, stride_ldc, vc1, vl); + VSSEV_FLOAT(pc2, stride_ldc, vc2, vl); + VSSEV_FLOAT(pc3, stride_ldc, vc3, vl); + VSSEV_FLOAT(pc4, stride_ldc, vc4, vl); + VSSEV_FLOAT(pc5, stride_ldc, vc5, vl); + VSSEV_FLOAT(pc6, stride_ldc, vc6, vl); + VSSEV_FLOAT(pc7, stride_ldc, vc7, vl); + + pb += vl; + pc0++; + pc1++; + pc2++; + pc3++; + pc4++; + pc5++; + pc6++; + pc7++; + } + } + pc += (m/8)*8; + + if (m & 4) + { + pa0 = pc; + pa1 = pa0 + 1; + pa2 = pa1 + 1; + pa3 = pa2 + 1; + + aa0 = *pa0 * bb; + aa1 = *pa1 * bb; + aa2 = *pa2 * bb; + aa3 = *pa3 * bb; + + *pa0 = aa0; + *pa1 = aa1; + *pa2 = aa2; + *pa3 = aa3; + + *a = aa0; + *(a + 1)= aa1; + *(a + 2)= aa2; + *(a + 3)= aa3; + + a += 4; + + pb = b + i + 1; + pc0 = pa0 + ldc; + pc1 = pa1 + ldc; + pc2 = pa2 + ldc; + pc3 = pa3 + ldc; + for (k = (n - i - 1); k > 0; k -= vl) + { + vl = VSETVL(k); + vc0 = VLSEV_FLOAT(pc0, stride_ldc, vl); + vc1 = VLSEV_FLOAT(pc1, stride_ldc, vl); + vc2 = VLSEV_FLOAT(pc2, stride_ldc, vl); + vc3 = VLSEV_FLOAT(pc3, stride_ldc, vl); + vb = VLEV_FLOAT(pb, vl); + + vc0 = VFNMSACVF_FLOAT(vc0, aa0, vb, vl); + vc1 = VFNMSACVF_FLOAT(vc1, aa1, vb, vl); + vc2 = VFNMSACVF_FLOAT(vc2, aa2, vb, vl); + vc3 = VFNMSACVF_FLOAT(vc3, aa3, vb, vl); + + VSSEV_FLOAT(pc0, stride_ldc, vc0, vl); + VSSEV_FLOAT(pc1, stride_ldc, vc1, vl); + VSSEV_FLOAT(pc2, stride_ldc, vc2, vl); + VSSEV_FLOAT(pc3, stride_ldc, vc3, vl); + + pb += vl; + pc0++; + pc1++; + pc2++; + pc3++; + } + pc += 4; + } + + if (m & 2) + { + pa0 = pc; + pa1 = pa0 + 1; + + aa0 = *pa0 * bb; + aa1 = *pa1 * bb; + + *pa0 = aa0; + *pa1 = aa1; + + *a = aa0; + *(a + 1)= aa1; + + a += 2; + + pb = b + i + 1; + pc0 = pa0 + ldc; + pc1 = pa1 + ldc; + for (k = (n - i - 1); k > 0; k -= vl) + { + vl = VSETVL(k); + vc0 = VLSEV_FLOAT(pc0, stride_ldc, vl); + vc1 = VLSEV_FLOAT(pc1, stride_ldc, vl); + vb = VLEV_FLOAT(pb, vl); + + vc0 = VFNMSACVF_FLOAT(vc0, aa0, vb, vl); + vc1 = VFNMSACVF_FLOAT(vc1, aa1, vb, vl); + + VSSEV_FLOAT(pc0, stride_ldc, vc0, vl); + VSSEV_FLOAT(pc1, stride_ldc, vc1, vl); + + pb += vl; + pc0++; + pc1++; + } + pc += 2; + } + + if (m & 1) + { + pa0 = pc; + aa0 = *pa0 * bb; + + *pa0 = aa0; + *a = aa0; + a += 1; + + pb = b + i + 1; + pc0 = pa0 + ldc; + for (k = (n - i - 1); k > 0; k -= vl) + { + vl = VSETVL(k); + vc0 = VLSEV_FLOAT(pc0, stride_ldc, vl); + vb = VLEV_FLOAT(pb, vl); + vc0 = VFNMSACVF_FLOAT(vc0, aa0, vb, vl); + VSSEV_FLOAT(pc0, stride_ldc, vc0, vl); + pb += vl; + pc0++; + } + } + b += n; + } +} +#else +static inline void solve(BLASLONG m, BLASLONG n, FLOAT *a, FLOAT *b, FLOAT *c, BLASLONG ldc) { + + FLOAT aa, bb; + + int i, j, k; + + for (i = 0; i < n; i++) { + + bb = *(b + i); + + for (j = 0; j < m; j ++) { + aa = *(c + j + i * ldc); + aa *= bb; + *a = aa; + *(c + j + i * ldc) = aa; + a ++; + + for (k = i + 1; k < n; k ++){ + *(c + j + k * ldc) -= aa * *(b + k); + } + + } + b += n; + } +} + +#endif + +#else + +static inline void solve(BLASLONG m, BLASLONG n, FLOAT *a, FLOAT *b, FLOAT *c, BLASLONG ldc) { + + FLOAT aa1, aa2; + FLOAT bb1, bb2; + FLOAT cc1, cc2; + + int i, j, k; + + ldc *= 2; + + for (i = 0; i < n; i++) { + + bb1 = *(b + i * 2 + 0); + bb2 = *(b + i * 2 + 1); + + for (j = 0; j < m; j ++) { + aa1 = *(c + j * 2 + 0 + i * ldc); + aa2 = *(c + j * 2 + 1 + i * ldc); + +#ifndef CONJ + cc1 = aa1 * bb1 - aa2 * bb2; + cc2 = aa1 * bb2 + aa2 * bb1; +#else + cc1 = aa1 * bb1 + aa2 * bb2; + cc2 = -aa1 * bb2 + aa2 * bb1; +#endif + + *(a + 0) = cc1; + *(a + 1) = cc2; + *(c + j * 2 + 0 + i * ldc) = cc1; + *(c + j * 2 + 1 + i * ldc) = cc2; + a += 2; + + for (k = i + 1; k < n; k ++){ +#ifndef CONJ + *(c + j * 2 + 0 + k * ldc) -= cc1 * *(b + k * 2 + 0) - cc2 * *(b + k * 2 + 1); + *(c + j * 2 + 1 + k * ldc) -= cc1 * *(b + k * 2 + 1) + cc2 * *(b + k * 2 + 0); +#else + *(c + j * 2 + 0 + k * ldc) -= cc1 * *(b + k * 2 + 0) + cc2 * *(b + k * 2 + 1); + *(c + j * 2 + 1 + k * ldc) -= - cc1 * *(b + k * 2 + 1) + cc2 * *(b + k * 2 + 0); +#endif + } + + } + b += n * 2; + } +} + +#endif + + +int CNAME(BLASLONG m, BLASLONG n, BLASLONG k, FLOAT dummy1, +#ifdef COMPLEX + FLOAT dummy2, +#endif + FLOAT *a, FLOAT *b, FLOAT *c, BLASLONG ldc, BLASLONG offset){ + + FLOAT *aa, *cc; + BLASLONG kk; + BLASLONG i, j; + + size_t vl = VSETVL_MAX; + + //fprintf(stderr, "%s , %s, m = %4ld n = %4ld k = %4ld offset = %4ld\n", __FILE__, __FUNCTION__, m, n, k, offset); // Debug + + + j = (n >> GEMM_UNROLL_N_SHIFT); + kk = -offset; + + while (j > 0) { + + aa = a; + cc = c; + + i = vl; + + if (i <= m) { + do { + if (kk > 0) { + GEMM_KERNEL(vl, GEMM_UNROLL_N, kk, dm1, +#ifdef COMPLEX + ZERO, +#endif + aa, b, cc, ldc); + } + + solve(vl, GEMM_UNROLL_N, + aa + kk * vl * COMPSIZE, + b + kk * GEMM_UNROLL_N * COMPSIZE, + cc, ldc); + + aa += vl * k * COMPSIZE; + cc += vl * COMPSIZE; + i += vl; + } while (i <= m); + } + + + i = m % vl; + if (i) { + if (kk > 0) { + GEMM_KERNEL(i, GEMM_UNROLL_N, kk, dm1, +#ifdef COMPLEX + ZERO, +#endif + aa, b, cc, ldc); + } + solve(i, GEMM_UNROLL_N, + aa + kk * i * COMPSIZE, + b + kk * GEMM_UNROLL_N * COMPSIZE, + cc, ldc); + + aa += i * k * COMPSIZE; + cc += i * COMPSIZE; + + } + + kk += GEMM_UNROLL_N; + b += GEMM_UNROLL_N * k * COMPSIZE; + c += GEMM_UNROLL_N * ldc * COMPSIZE; + j --; + } + + if (n & (GEMM_UNROLL_N - 1)) { + + j = (GEMM_UNROLL_N >> 1); + while (j > 0) { + if (n & j) { + + aa = a; + cc = c; + + i = vl; + + while (i <= m) { + if (kk > 0) { + GEMM_KERNEL(vl, j, kk, dm1, +#ifdef COMPLEX + ZERO, +#endif + aa, + b, + cc, + ldc); + } + + solve(vl, j, + aa + kk * vl * COMPSIZE, + b + kk * j * COMPSIZE, cc, ldc); + + aa += vl * k * COMPSIZE; + cc += vl * COMPSIZE; + i += vl; + } + + i = m % vl; + if (i) { + if (kk > 0) { + GEMM_KERNEL(i, j, kk, dm1, +#ifdef COMPLEX + ZERO, +#endif + aa, + b, + cc, + ldc); + } + + solve(i, j, + aa + kk * i * COMPSIZE, + b + kk * j * COMPSIZE, cc, ldc); + + aa += i * k * COMPSIZE; + cc += i * COMPSIZE; + + } + + b += j * k * COMPSIZE; + c += j * ldc * COMPSIZE; + kk += j; + } + j >>= 1; + } + } + + return 0; +} diff --git a/kernel/riscv64/trsm_kernel_RT_rvv_v1.c b/kernel/riscv64/trsm_kernel_RT_rvv_v1.c new file mode 100644 index 000000000..459c1663a --- /dev/null +++ b/kernel/riscv64/trsm_kernel_RT_rvv_v1.c @@ -0,0 +1,828 @@ +/*************************************************************************** +Copyright (c) 2022, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" + +#if !defined(DOUBLE) +#define VSETVL(n) vsetvl_e32m2(n) +#define VSETVL_MAX vsetvlmax_e32m2() +#define FLOAT_V_T vfloat32m2_t +#define VLEV_FLOAT vle32_v_f32m2 +#define VLSEV_FLOAT vlse32_v_f32m2 +#define VLSEG2_FLOAT vlseg2e32_v_f32m2 +#define VSEV_FLOAT vse32_v_f32m2 +#define VSSEV_FLOAT vsse32_v_f32m2 +#define VSSEG2_FLOAT vsseg2e32_v_f32m2 +#define VFMACCVF_FLOAT vfmacc_vf_f32m2 +#define VFNMSACVF_FLOAT vfnmsac_vf_f32m2 +#else +#define VSETVL(n) vsetvl_e64m2(n) +#define VSETVL_MAX vsetvlmax_e64m2() +#define FLOAT_V_T vfloat64m2_t +#define VLEV_FLOAT vle64_v_f64m2 +#define VLSEV_FLOAT vlse64_v_f64m2 +#define VLSEG2_FLOAT vlseg2e64_v_f64m2 +#define VSEV_FLOAT vse64_v_f64m2 +#define VSSEV_FLOAT vsse64_v_f64m2 +#define VSSEG2_FLOAT vsseg2e64_v_f64m2 +#define VFMACCVF_FLOAT vfmacc_vf_f64m2 +#define VFNMSACVF_FLOAT vfnmsac_vf_f64m2 +#endif + + +static FLOAT dm1 = -1.; + +#ifdef CONJ +#define GEMM_KERNEL GEMM_KERNEL_R +#else +#define GEMM_KERNEL GEMM_KERNEL_N +#endif + +#if GEMM_DEFAULT_UNROLL_N == 1 +#define GEMM_UNROLL_N_SHIFT 0 +#endif + +#if GEMM_DEFAULT_UNROLL_N == 2 +#define GEMM_UNROLL_N_SHIFT 1 +#endif + +#if GEMM_DEFAULT_UNROLL_N == 4 +#define GEMM_UNROLL_N_SHIFT 2 +#endif + +#if GEMM_DEFAULT_UNROLL_N == 8 +#define GEMM_UNROLL_N_SHIFT 3 +#endif + +#if GEMM_DEFAULT_UNROLL_N == 16 +#define GEMM_UNROLL_N_SHIFT 4 +#endif + +// Optimizes the implementation in ../arm64/trsm_kernel_RT_sve.c + +#ifndef COMPLEX + +#if GEMM_DEFAULT_UNROLL_N == 1 +static inline void solve(BLASLONG m, BLASLONG n, FLOAT *a, FLOAT *b, FLOAT *c, BLASLONG ldc) { + + FLOAT aa, bb; + FLOAT *pb, *pc; + BLASLONG stride_ldc = sizeof(FLOAT) * ldc; + + int i, j, k; + size_t vl; + FLOAT_V_T vb, vc; + + a += (n - 1) * m; + b += (n - 1) * n; + + for (i = n - 1; i >= 0; i--) { + + bb = *(b + i); + + for (j = 0; j < m; j ++) { + aa = *(c + j + i * ldc); + aa *= bb; + *a = aa; + *(c + j + i * ldc) = aa; + a ++; + + pb = b; + pc = c + j; + for (k = i; k > 0; k -= vl) + { + vl = VSETVL(k); + vc = VLSEV_FLOAT(pc, stride_ldc, vl); + vb = VLEV_FLOAT(pb, vl); + vc = VFNMSACVF_FLOAT(vc, aa, vb, vl); + VSSEV_FLOAT(pc, stride_ldc, vc, vl); + pb += vl; + pc++; + } + } + b -= n; + a -= 2 * m; + } + +} +#elif GEMM_DEFAULT_UNROLL_N == 2 + +static inline void solve(BLASLONG m, BLASLONG n, FLOAT *a, FLOAT *b, FLOAT *c, BLASLONG ldc) { + + FLOAT aa0, aa1, bb; + FLOAT *pb, *pc; + FLOAT *pa0, *pa1, *pc0, *pc1; + BLASLONG stride_ldc = sizeof(FLOAT) * ldc; + int i, j, k; + size_t vl; + FLOAT_V_T vb, vc0, vc1; + + a += (n - 1) * m; + b += (n - 1) * n; + + for (i = n - 1; i >= 0; i--) + { + bb = *(b + i); + pc = c + i * ldc; + for (j = 0; j < m/2; j ++) + { + pa0 = pc + j * 2; + pa1 = pc + j * 2 + 1; + aa0 = *pa0 * bb; + aa1 = *pa1 * bb; + + *pa0 = aa0; + *pa1 = aa1; + *a = aa0; + *(a + 1)= aa1; + a += 2; + + pb = b; + pc0 = c + j * 2; + pc1 = pc0 + 1; + for (k = i; k > 0; k -= vl) + { + vl = VSETVL(k); + vc0 = VLSEV_FLOAT(pc0, stride_ldc, vl); + vc1 = VLSEV_FLOAT(pc1, stride_ldc, vl); + vb = VLEV_FLOAT(pb, vl); + vc0 = VFNMSACVF_FLOAT(vc0, aa0, vb, vl); + vc1 = VFNMSACVF_FLOAT(vc1, aa1, vb, vl); + VSSEV_FLOAT(pc0, stride_ldc, vc0, vl); + VSSEV_FLOAT(pc1, stride_ldc, vc1, vl); + pb += vl; + pc0++; + pc1++; + } + } + pc += (m/2)*2; + + if (m & 1) + { + pa0 = pc; + aa0 = *pa0 * bb; + + *pa0 = aa0; + *a = aa0; + a += 1; + + pb = b; + pc0 = pc - i * ldc; + for (k = i; k > 0; k -= vl) + { + vl = VSETVL(k); + vc0 = VLSEV_FLOAT(pc0, stride_ldc, vl); + vb = VLEV_FLOAT(pb, vl); + vc0 = VFNMSACVF_FLOAT(vc0, aa0, vb, vl); + VSSEV_FLOAT(pc0, stride_ldc, vc0, vl); + pb += vl; + pc0++; + } + } + b -= n; + a -= 2 * m; + } +} + +#elif GEMM_DEFAULT_UNROLL_N == 4 + +static inline void solve(BLASLONG m, BLASLONG n, FLOAT *a, FLOAT *b, FLOAT *c, BLASLONG ldc) { + + FLOAT aa0, aa1, aa2, aa3; + FLOAT bb; + FLOAT *pb, *pc; + FLOAT *pa0, *pa1, *pa2, *pa3; + FLOAT *pc0, *pc1, *pc2, *pc3; + BLASLONG stride_ldc = sizeof(FLOAT) * ldc; + int i, j, k; + size_t vl; + FLOAT_V_T vb, vc0, vc1, vc2, vc3; + + a += (n - 1) * m; + b += (n - 1) * n; + + for (i = n - 1; i >= 0; i--) + { + bb = *(b + i); + pc = c + i * ldc; + for (j = 0; j < m/4; j ++) + { + pa0 = pc + j * 4; + pa1 = pa0 + 1; + pa2 = pa1 + 1; + pa3 = pa2 + 1; + + aa0 = *pa0 * bb; + aa1 = *pa1 * bb; + aa2 = *pa2 * bb; + aa3 = *pa3 * bb; + + *pa0 = aa0; + *pa1 = aa1; + *pa2 = aa2; + *pa3 = aa3; + + *a = aa0; + *(a + 1)= aa1; + *(a + 2)= aa2; + *(a + 3)= aa3; + a += 4; + + pb = b; + pc0 = c + j * 4; + pc1 = pc0 + 1; + pc2 = pc1 + 1; + pc3 = pc2 + 1; + for (k = i; k > 0; k -= vl) + { + vl = VSETVL(k); + vc0 = VLSEV_FLOAT(pc0, stride_ldc, vl); + vc1 = VLSEV_FLOAT(pc1, stride_ldc, vl); + vc2 = VLSEV_FLOAT(pc2, stride_ldc, vl); + vc3 = VLSEV_FLOAT(pc3, stride_ldc, vl); + vb = VLEV_FLOAT(pb, vl); + + vc0 = VFNMSACVF_FLOAT(vc0, aa0, vb, vl); + vc1 = VFNMSACVF_FLOAT(vc1, aa1, vb, vl); + vc2 = VFNMSACVF_FLOAT(vc2, aa2, vb, vl); + vc3 = VFNMSACVF_FLOAT(vc3, aa3, vb, vl); + + VSSEV_FLOAT(pc0, stride_ldc, vc0, vl); + VSSEV_FLOAT(pc1, stride_ldc, vc1, vl); + VSSEV_FLOAT(pc2, stride_ldc, vc2, vl); + VSSEV_FLOAT(pc3, stride_ldc, vc3, vl); + + pb += vl; + pc0++; + pc1++; + pc2++; + pc3++; + } + } + pc += (m/4)*4; + + if (m & 2) + { + pa0 = pc + j * 2; + pa1 = pa0 + 1; + + aa0 = *pa0 * bb; + aa1 = *pa1 * bb; + + *pa0 = aa0; + *pa1 = aa1; + + *a = aa0; + *(a + 1)= aa1; + a += 2; + + pb = b; + pc0 = c + j * 4; + pc1 = pc0 + 1; + for (k = i; k > 0; k -= vl) + { + vl = VSETVL(k); + vc0 = VLSEV_FLOAT(pc0, stride_ldc, vl); + vc1 = VLSEV_FLOAT(pc1, stride_ldc, vl); + vb = VLEV_FLOAT(pb, vl); + + vc0 = VFNMSACVF_FLOAT(vc0, aa0, vb, vl); + vc1 = VFNMSACVF_FLOAT(vc1, aa1, vb, vl); + + VSSEV_FLOAT(pc0, stride_ldc, vc0, vl); + VSSEV_FLOAT(pc1, stride_ldc, vc1, vl); + + pb += vl; + pc0++; + pc1++; + } + pc += 2; + } + + if (m & 1) + { + pa0 = pc; + aa0 = *pa0 * bb; + + *pa0 = aa0; + *a = aa0; + a += 1; + + pb = b; + pc0 = pc - i * ldc; + for (k = i; k > 0; k -= vl) + { + vl = VSETVL(k); + vc0 = VLSEV_FLOAT(pc0, stride_ldc, vl); + vb = VLEV_FLOAT(pb, vl); + vc0 = VFNMSACVF_FLOAT(vc0, aa0, vb, vl); + VSSEV_FLOAT(pc0, stride_ldc, vc0, vl); + pb += vl; + pc0++; + } + } + b -= n; + a -= 2 * m; + } +} +#elif GEMM_DEFAULT_UNROLL_N == 8 + +static inline void solve(BLASLONG m, BLASLONG n, FLOAT *a, FLOAT *b, FLOAT *c, BLASLONG ldc) { + + FLOAT aa0, aa1, aa2, aa3, aa4, aa5, aa6, aa7; + FLOAT bb; + FLOAT *pb, *pc; + FLOAT *pa0, *pa1, *pa2, *pa3, *pa4, *pa5, *pa6, *pa7; + FLOAT *pc0, *pc1, *pc2, *pc3, *pc4, *pc5, *pc6, *pc7; + BLASLONG stride_ldc = sizeof(FLOAT) * ldc; + int i, j, k; + size_t vl; + FLOAT_V_T vb, vc0, vc1, vc2, vc3, vc4, vc5, vc6, vc7; + + a += (n - 1) * m; + b += (n - 1) * n; + + for (i = n - 1; i >= 0; i--) + { + bb = *(b + i); + pc = c + i * ldc; + for (j = 0; j < m/8; j ++) + { + pa0 = pc + j * 8; + pa1 = pa0 + 1; + pa2 = pa1 + 1; + pa3 = pa2 + 1; + pa4 = pa3 + 1; + pa5 = pa4 + 1; + pa6 = pa5 + 1; + pa7 = pa6 + 1; + + aa0 = *pa0 * bb; + aa1 = *pa1 * bb; + aa2 = *pa2 * bb; + aa3 = *pa3 * bb; + aa4 = *pa4 * bb; + aa5 = *pa5 * bb; + aa6 = *pa6 * bb; + aa7 = *pa7 * bb; + + *pa0 = aa0; + *pa1 = aa1; + *pa2 = aa2; + *pa3 = aa3; + *pa4 = aa4; + *pa5 = aa5; + *pa6 = aa6; + *pa7 = aa7; + + *a = aa0; + *(a + 1)= aa1; + *(a + 2)= aa2; + *(a + 3)= aa3; + *(a + 4)= aa4; + *(a + 5)= aa5; + *(a + 6)= aa6; + *(a + 7)= aa7; + a += 8; + + pb = b; + pc0 = c + j * 8; + pc1 = pc0 + 1; + pc2 = pc1 + 1; + pc3 = pc2 + 1; + pc4 = pc3 + 1; + pc5 = pc4 + 1; + pc6 = pc5 + 1; + pc7 = pc6 + 1; + for (k = i; k > 0; k -= vl) + { + vl = VSETVL(k); + vc0 = VLSEV_FLOAT(pc0, stride_ldc, vl); + vc1 = VLSEV_FLOAT(pc1, stride_ldc, vl); + vc2 = VLSEV_FLOAT(pc2, stride_ldc, vl); + vc3 = VLSEV_FLOAT(pc3, stride_ldc, vl); + vc4 = VLSEV_FLOAT(pc4, stride_ldc, vl); + vc5 = VLSEV_FLOAT(pc5, stride_ldc, vl); + vc6 = VLSEV_FLOAT(pc6, stride_ldc, vl); + vc7 = VLSEV_FLOAT(pc7, stride_ldc, vl); + vb = VLEV_FLOAT(pb, vl); + + vc0 = VFNMSACVF_FLOAT(vc0, aa0, vb, vl); + vc1 = VFNMSACVF_FLOAT(vc1, aa1, vb, vl); + vc2 = VFNMSACVF_FLOAT(vc2, aa2, vb, vl); + vc3 = VFNMSACVF_FLOAT(vc3, aa3, vb, vl); + vc4 = VFNMSACVF_FLOAT(vc4, aa4, vb, vl); + vc5 = VFNMSACVF_FLOAT(vc5, aa5, vb, vl); + vc6 = VFNMSACVF_FLOAT(vc6, aa6, vb, vl); + vc7 = VFNMSACVF_FLOAT(vc7, aa7, vb, vl); + + VSSEV_FLOAT(pc0, stride_ldc, vc0, vl); + VSSEV_FLOAT(pc1, stride_ldc, vc1, vl); + VSSEV_FLOAT(pc2, stride_ldc, vc2, vl); + VSSEV_FLOAT(pc3, stride_ldc, vc3, vl); + VSSEV_FLOAT(pc4, stride_ldc, vc4, vl); + VSSEV_FLOAT(pc5, stride_ldc, vc5, vl); + VSSEV_FLOAT(pc6, stride_ldc, vc6, vl); + VSSEV_FLOAT(pc7, stride_ldc, vc7, vl); + + pb += vl; + pc0++; + pc1++; + pc2++; + pc3++; + pc4++; + pc5++; + pc6++; + pc7++; + } + } + pc += (m/8)*8; + + if (m & 4) + { + pa0 = pc; + pa1 = pa0 + 1; + pa2 = pa1 + 1; + pa3 = pa2 + 1; + + aa0 = *pa0 * bb; + aa1 = *pa1 * bb; + aa2 = *pa2 * bb; + aa3 = *pa3 * bb; + + *pa0 = aa0; + *pa1 = aa1; + *pa2 = aa2; + *pa3 = aa3; + + *a = aa0; + *(a + 1)= aa1; + *(a + 2)= aa2; + *(a + 3)= aa3; + a += 4; + + pb = b; + pc0 = pc - i * ldc; + pc1 = pc0 + 1; + pc2 = pc1 + 1; + pc3 = pc2 + 1; + for (k = i; k > 0; k -= vl) + { + vl = VSETVL(k); + vc0 = VLSEV_FLOAT(pc0, stride_ldc, vl); + vc1 = VLSEV_FLOAT(pc1, stride_ldc, vl); + vc2 = VLSEV_FLOAT(pc2, stride_ldc, vl); + vc3 = VLSEV_FLOAT(pc3, stride_ldc, vl); + vb = VLEV_FLOAT(pb, vl); + + vc0 = VFNMSACVF_FLOAT(vc0, aa0, vb, vl); + vc1 = VFNMSACVF_FLOAT(vc1, aa1, vb, vl); + vc2 = VFNMSACVF_FLOAT(vc2, aa2, vb, vl); + vc3 = VFNMSACVF_FLOAT(vc3, aa3, vb, vl); + + VSSEV_FLOAT(pc0, stride_ldc, vc0, vl); + VSSEV_FLOAT(pc1, stride_ldc, vc1, vl); + VSSEV_FLOAT(pc2, stride_ldc, vc2, vl); + VSSEV_FLOAT(pc3, stride_ldc, vc3, vl); + + pb += vl; + pc0++; + pc1++; + pc2++; + pc3++; + } + pc += 4; + } + + if (m & 2) + { + pa0 = pc; + pa1 = pa0 + 1; + + aa0 = *pa0 * bb; + aa1 = *pa1 * bb; + + *pa0 = aa0; + *pa1 = aa1; + + *a = aa0; + *(a + 1)= aa1; + a += 2; + + pb = b; + pc0 = pc - i * ldc; + pc1 = pc0 + 1; + for (k = i; k > 0; k -= vl) + { + vl = VSETVL(k); + vc0 = VLSEV_FLOAT(pc0, stride_ldc, vl); + vc1 = VLSEV_FLOAT(pc1, stride_ldc, vl); + vb = VLEV_FLOAT(pb, vl); + + vc0 = VFNMSACVF_FLOAT(vc0, aa0, vb, vl); + vc1 = VFNMSACVF_FLOAT(vc1, aa1, vb, vl); + + VSSEV_FLOAT(pc0, stride_ldc, vc0, vl); + VSSEV_FLOAT(pc1, stride_ldc, vc1, vl); + + pb += vl; + pc0++; + pc1++; + } + pc += 2; + } + + if (m & 1) + { + pa0 = pc; + aa0 = *pa0 * bb; + + *pa0 = aa0; + *a = aa0; + a += 1; + + pb = b; + pc0 = pc - i * ldc; + for (k = i; k > 0; k -= vl) + { + vl = VSETVL(k); + vc0 = VLSEV_FLOAT(pc0, stride_ldc, vl); + vb = VLEV_FLOAT(pb, vl); + vc0 = VFNMSACVF_FLOAT(vc0, aa0, vb, vl); + VSSEV_FLOAT(pc0, stride_ldc, vc0, vl); + pb += vl; + pc0++; + } + } + b -= n; + a -= 2 * m; + } +} + +#else + +static inline void solve(BLASLONG m, BLASLONG n, FLOAT *a, FLOAT *b, FLOAT *c, BLASLONG ldc) { + + FLOAT aa, bb; + + int i, j, k; + + a += (n - 1) * m; + b += (n - 1) * n; + + for (i = n - 1; i >= 0; i--) { + + bb = *(b + i); + + for (j = 0; j < m; j ++) { + aa = *(c + j + i * ldc); + aa *= bb; + *a = aa; + *(c + j + i * ldc) = aa; + a ++; + + for (k = 0; k < i; k ++){ + *(c + j + k * ldc) -= aa * *(b + k); + } + + } + b -= n; + a -= 2 * m; + } + +} + +#endif + +#else + +static inline void solve(BLASLONG m, BLASLONG n, FLOAT *a, FLOAT *b, FLOAT *c, BLASLONG ldc) { + + FLOAT aa1, aa2; + FLOAT bb1, bb2; + FLOAT cc1, cc2; + + int i, j, k; + + ldc *= 2; + + a += (n - 1) * m * 2; + b += (n - 1) * n * 2; + + for (i = n - 1; i >= 0; i--) { + + bb1 = *(b + i * 2 + 0); + bb2 = *(b + i * 2 + 1); + + for (j = 0; j < m; j ++) { + + aa1 = *(c + j * 2 + 0 + i * ldc); + aa2 = *(c + j * 2 + 1 + i * ldc); + +#ifndef CONJ + cc1 = aa1 * bb1 - aa2 * bb2; + cc2 = aa1 * bb2 + aa2 * bb1; +#else + cc1 = aa1 * bb1 + aa2 * bb2; + cc2 = - aa1 * bb2 + aa2 * bb1; +#endif + + *(a + 0) = cc1; + *(a + 1) = cc2; + + *(c + j * 2 + 0 + i * ldc) = cc1; + *(c + j * 2 + 1 + i * ldc) = cc2; + a += 2; + + for (k = 0; k < i; k ++){ +#ifndef CONJ + *(c + j * 2 + 0 + k * ldc) -= cc1 * *(b + k * 2 + 0) - cc2 * *(b + k * 2 + 1); + *(c + j * 2 + 1 + k * ldc) -= cc1 * *(b + k * 2 + 1) + cc2 * *(b + k * 2 + 0); +#else + *(c + j * 2 + 0 + k * ldc) -= cc1 * *(b + k * 2 + 0) + cc2 * *(b + k * 2 + 1); + *(c + j * 2 + 1 + k * ldc) -= -cc1 * *(b + k * 2 + 1) + cc2 * *(b + k * 2 + 0); +#endif + } + + } + b -= n * 2; + a -= 4 * m; + } + +} + +#endif + +int CNAME(BLASLONG m, BLASLONG n, BLASLONG k, FLOAT dummy1, +#ifdef COMPLEX + FLOAT dummy2, +#endif + FLOAT *a, FLOAT *b, FLOAT *c, BLASLONG ldc, BLASLONG offset){ + + BLASLONG i, j; + FLOAT *aa, *cc; + BLASLONG kk; + + size_t vl = VSETVL_MAX; + + //fprintf(stderr, "%s , %s, m = %4ld n = %4ld k = %4ld offset = %4ld\n", __FILE__, __FUNCTION__, m, n, k, offset); // Debug + + kk = n - offset; + c += n * ldc * COMPSIZE; + b += n * k * COMPSIZE; + + if (n & (GEMM_UNROLL_N - 1)) { + + j = 1; + while (j < GEMM_UNROLL_N) { + if (n & j) { + + aa = a; + b -= j * k * COMPSIZE; + c -= j * ldc* COMPSIZE; + cc = c; + + i = vl; + if (i <= m) { + + do { + if (k - kk > 0) { + GEMM_KERNEL(vl, j, k - kk, dm1, +#ifdef COMPLEX + ZERO, +#endif + aa + vl * kk * COMPSIZE, + b + j * kk * COMPSIZE, + cc, + ldc); + } + + solve(vl, j, + aa + (kk - j) * vl * COMPSIZE, + b + (kk - j) * j * COMPSIZE, + cc, ldc); + + aa += vl * k * COMPSIZE; + cc += vl * COMPSIZE; + i += vl; + } while (i <= m); + } + + i = m % vl; + if (i) { + if (k - kk > 0) { + GEMM_KERNEL(i, j, k - kk, dm1, +#ifdef COMPLEX + ZERO, +#endif + aa + i * kk * COMPSIZE, + b + j * kk * COMPSIZE, + cc, ldc); + } + + solve(i, j, + aa + (kk - j) * i * COMPSIZE, + b + (kk - j) * j * COMPSIZE, + cc, ldc); + + aa += i * k * COMPSIZE; + cc += i * COMPSIZE; + + } + kk -= j; + } + j <<= 1; + } + } + + j = (n >> GEMM_UNROLL_N_SHIFT); + + if (j > 0) { + + do { + aa = a; + b -= GEMM_UNROLL_N * k * COMPSIZE; + c -= GEMM_UNROLL_N * ldc * COMPSIZE; + cc = c; + + i = vl; + if (i <= m) { + do { + if (k - kk > 0) { + GEMM_KERNEL(vl, GEMM_UNROLL_N, k - kk, dm1, +#ifdef COMPLEX + ZERO, +#endif + aa + vl * kk * COMPSIZE, + b + GEMM_UNROLL_N * kk * COMPSIZE, + cc, + ldc); + } + + solve(vl, GEMM_UNROLL_N, + aa + (kk - GEMM_UNROLL_N) * vl * COMPSIZE, + b + (kk - GEMM_UNROLL_N) * GEMM_UNROLL_N * COMPSIZE, + cc, ldc); + + aa += vl * k * COMPSIZE; + cc += vl * COMPSIZE; + i += vl; + } while (i <= m); + } + + i = m % vl; + if (i) { + if (k - kk > 0) { + GEMM_KERNEL(i, GEMM_UNROLL_N, k - kk, dm1, +#ifdef COMPLEX + ZERO, +#endif + aa + i * kk * COMPSIZE, + b + GEMM_UNROLL_N * kk * COMPSIZE, + cc, + ldc); + } + + solve(i, GEMM_UNROLL_N, + aa + (kk - GEMM_UNROLL_N) * i * COMPSIZE, + b + (kk - GEMM_UNROLL_N) * GEMM_UNROLL_N * COMPSIZE, + cc, ldc); + + aa += i * k * COMPSIZE; + cc += i * COMPSIZE; + + } + + kk -= GEMM_UNROLL_N; + j --; + } while (j > 0); + } + + return 0; +} + + diff --git a/kernel/riscv64/trsm_lncopy_rvv_v1.c b/kernel/riscv64/trsm_lncopy_rvv_v1.c new file mode 100644 index 000000000..bacfb2b08 --- /dev/null +++ b/kernel/riscv64/trsm_lncopy_rvv_v1.c @@ -0,0 +1,122 @@ +/*************************************************************************** +Copyright (c) 2022, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 +#include "common.h" + +#if !defined(DOUBLE) +#define VSETVL(n) vsetvl_e32m2(n) +#define FLOAT_V_T vfloat32m2_t +#define VLEV_FLOAT vle32_v_f32m2 +#define VSEV_FLOAT vse32_v_f32m2 +#define VSEV_FLOAT_M vse32_v_f32m2_m +#define VLSEV_FLOAT vlse32_v_f32m2 +#define VBOOL_T vbool16_t +#define UINT_V_T vuint32m2_t +#define VID_V_UINT vid_v_u32m2 +#define VMSLTU_VX_UINT vmsltu_vx_u32m2_b16 +#else +#define VSETVL(n) vsetvl_e64m2(n) +#define FLOAT_V_T vfloat64m2_t +#define VLEV_FLOAT vle64_v_f64m2 +#define VSEV_FLOAT vse64_v_f64m2 +#define VSEV_FLOAT_M vse64_v_f64m2_m +#define VLSEV_FLOAT vlse64_v_f64m2 +#define VBOOL_T vbool32_t +#define UINT_V_T vuint64m2_t +#define VID_V_UINT vid_v_u64m2 +#define VMSLTU_VX_UINT vmsltu_vx_u64m2_b32 + +#endif + +#ifndef UNIT +#define INV(a) (ONE / (a)) +#else +#define INV(a) (ONE) +#endif + +// Optimizes the implementation in ../arm64/trsm_lncopy_sve.c + +int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG offset, FLOAT *b){ + + BLASLONG i, ii, jj, js; + + FLOAT *ao; + + jj = offset; + + BLASLONG stride_lda = sizeof(FLOAT)*lda; + + FLOAT_V_T va1; + VBOOL_T vbool_cmp; + UINT_V_T vindex; + size_t vl; + + for (js = n; js > 0; js -= vl) + { + vl = VSETVL(js); + ao = a; + + ii = 0; + for (i = 0; i < m;) + { + if (ii == jj) + { + vindex = VID_V_UINT(vl); + for (unsigned int j = 0; j < vl; j++) + { + va1 = VLSEV_FLOAT(ao, stride_lda, vl); + vbool_cmp = VMSLTU_VX_UINT(vindex, j, vl); + VSEV_FLOAT_M(vbool_cmp, b, va1, vl); + + *(b + j) = INV(*(ao + j * lda)); + ao++; + b += vl; + } + i += vl; + ii += vl; + } + else + { + if (ii > jj) + { + va1 = VLSEV_FLOAT(ao, stride_lda, vl); + VSEV_FLOAT(b, va1, vl); + } + ao++; + b += vl; + i++; + ii++; + } + } + + a += vl * lda; + jj += vl; + } + + return 0; +} diff --git a/kernel/riscv64/trsm_ltcopy_rvv_v1.c b/kernel/riscv64/trsm_ltcopy_rvv_v1.c new file mode 100644 index 000000000..0fc7c9f24 --- /dev/null +++ b/kernel/riscv64/trsm_ltcopy_rvv_v1.c @@ -0,0 +1,122 @@ +/*************************************************************************** +Copyright (c) 2022, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 +#include "common.h" + +#if !defined(DOUBLE) +#define VSETVL(n) vsetvl_e32m2(n) +#define FLOAT_V_T vfloat32m2_t +#define VLEV_FLOAT vle32_v_f32m2 +#define VSEV_FLOAT vse32_v_f32m2 +#define VSEV_FLOAT_M vse32_v_f32m2_m +#define VLSEV_FLOAT vlse32_v_f32m2 +#define VBOOL_T vbool16_t +#define UINT_V_T vuint32m2_t +#define VID_V_UINT vid_v_u32m2 +#define VMSGTU_VX_UINT vmsgtu_vx_u32m2_b16 +#else +#define VSETVL(n) vsetvl_e64m2(n) +#define FLOAT_V_T vfloat64m2_t +#define VLEV_FLOAT vle64_v_f64m2 +#define VSEV_FLOAT vse64_v_f64m2 +#define VSEV_FLOAT_M vse64_v_f64m2_m +#define VLSEV_FLOAT vlse64_v_f64m2 +#define VBOOL_T vbool32_t +#define UINT_V_T vuint64m2_t +#define VID_V_UINT vid_v_u64m2 +#define VMSGTU_VX_UINT vmsgtu_vx_u64m2_b32 +#endif + +#ifndef UNIT +#define INV(a) (ONE / (a)) +#else +#define INV(a) (ONE) +#endif + +// Optimizes the implementation in ../arm64/trsm_ltcopy_sve.c + +int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG offset, FLOAT *b){ + + BLASLONG i, ii, jj, js; + + FLOAT *ao; + + jj = offset; + + FLOAT_V_T va1; + VBOOL_T vbool_cmp; + UINT_V_T vindex; + + size_t vl; + + for (js = n; js > 0; js -= vl) + { + vl = VSETVL(js); + ao = a; + + ii = 0; + for (i = 0; i < m;) + { + + if (ii == jj) + { + vindex = VID_V_UINT(vl); + for (unsigned int j = 0; j < vl; j++) + { + *(b + j) = INV(*(ao + j)); + + va1 = VLEV_FLOAT(ao, vl); + vbool_cmp = VMSGTU_VX_UINT(vindex, j, vl); + VSEV_FLOAT_M(vbool_cmp, b, va1, vl); + + b += vl; + ao += lda; + } + i += vl; + ii += vl; + } + else + { + if (ii < jj) + { + va1 = VLEV_FLOAT(ao, vl); + VSEV_FLOAT(b, va1, vl); + } + ao += lda; + b += vl; + i ++; + ii ++; + } + } + + a += vl; + jj += vl; + } + return 0; +} + diff --git a/kernel/riscv64/trsm_uncopy_rvv_v1.c b/kernel/riscv64/trsm_uncopy_rvv_v1.c new file mode 100644 index 000000000..ee869a795 --- /dev/null +++ b/kernel/riscv64/trsm_uncopy_rvv_v1.c @@ -0,0 +1,121 @@ +/*************************************************************************** +Copyright (c) 2022, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 +#include "common.h" + +#if !defined(DOUBLE) +#define VSETVL(n) vsetvl_e32m2(n) +#define FLOAT_V_T vfloat32m2_t +#define VLEV_FLOAT vle32_v_f32m2 +#define VSEV_FLOAT vse32_v_f32m2 +#define VSEV_FLOAT_M vse32_v_f32m2_m +#define VLSEV_FLOAT vlse32_v_f32m2 +#define VBOOL_T vbool16_t +#define UINT_V_T vuint32m2_t +#define VID_V_UINT vid_v_u32m2 +#define VMSGTU_VX_UINT vmsgtu_vx_u32m2_b16 +#else +#define VSETVL(n) vsetvl_e64m2(n) +#define FLOAT_V_T vfloat64m2_t +#define VLEV_FLOAT vle64_v_f64m2 +#define VSEV_FLOAT vse64_v_f64m2 +#define VSEV_FLOAT_M vse64_v_f64m2_m +#define VLSEV_FLOAT vlse64_v_f64m2 +#define VBOOL_T vbool32_t +#define UINT_V_T vuint64m2_t +#define VID_V_UINT vid_v_u64m2 +#define VMSGTU_VX_UINT vmsgtu_vx_u64m2_b32 +#endif + + +#ifndef UNIT +#define INV(a) (ONE / (a)) +#else +#define INV(a) (ONE) +#endif + +// Optimizes the implementation in ../arm64/trsm_uncopy_sve.c + +int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG offset, FLOAT *b){ + + BLASLONG i, ii, jj, js; + BLASLONG stride_lda = sizeof(FLOAT)*lda; + + FLOAT *ao; + jj = offset; + + FLOAT_V_T va1; + VBOOL_T vbool_cmp; + UINT_V_T vindex; + + size_t vl; + + for (js = n; js > 0; js -= vl) + { + vl = VSETVL(js); + ao = a; + + i = 0; + ii = 0; + for (i = 0; i < m;) + { + if (ii == jj) + { + vindex = VID_V_UINT(vl); + for (unsigned int j = 0; j < vl; j++) + { + *(b + j) = INV(*(ao + j * lda)); + va1 = VLSEV_FLOAT(ao, stride_lda, vl); + vbool_cmp = VMSGTU_VX_UINT(vindex, j, vl); + VSEV_FLOAT_M(vbool_cmp, b, va1, vl); + ao++; + b += vl; + } + i += vl; + ii += vl; + } + else + { + if (ii < jj) + { + va1 = VLSEV_FLOAT(ao, stride_lda, vl); + VSEV_FLOAT(b, va1, vl); + } + ao++; + b += vl; + i++; + ii++; + } + } + + a += vl * lda; + jj += vl; + } + return 0; +} diff --git a/kernel/riscv64/trsm_utcopy_rvv_v1.c b/kernel/riscv64/trsm_utcopy_rvv_v1.c new file mode 100644 index 000000000..a324b0fa6 --- /dev/null +++ b/kernel/riscv64/trsm_utcopy_rvv_v1.c @@ -0,0 +1,123 @@ +/*************************************************************************** +Copyright (c) 2022, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 +#include "common.h" + +#if !defined(DOUBLE) +#define VSETVL(n) vsetvl_e32m2(n) +#define FLOAT_V_T vfloat32m2_t +#define VLEV_FLOAT vle32_v_f32m2 +#define VSEV_FLOAT vse32_v_f32m2 +#define VSEV_FLOAT_M vse32_v_f32m2_m +#define VLSEV_FLOAT vlse32_v_f32m2 +#define VBOOL_T vbool16_t +#define UINT_V_T vuint32m2_t +#define VID_V_UINT vid_v_u32m2 +#define VMSLTU_VX_UINT vmsltu_vx_u32m2_b16 +#else +#define VSETVL(n) vsetvl_e64m2(n) +#define FLOAT_V_T vfloat64m2_t +#define VLEV_FLOAT vle64_v_f64m2 +#define VSEV_FLOAT vse64_v_f64m2 +#define VSEV_FLOAT_M vse64_v_f64m2_m +#define VLSEV_FLOAT vlse64_v_f64m2 +#define VBOOL_T vbool32_t +#define UINT_V_T vuint64m2_t +#define VID_V_UINT vid_v_u64m2 +#define VMSLTU_VX_UINT vmsltu_vx_u64m2_b32 +#endif + + +#ifndef UNIT +#define INV(a) (ONE / (a)) +#else +#define INV(a) (ONE) +#endif + +// Optimizes the implementation in ../arm64/trsm_utcopy_sve.c + + +int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG offset, FLOAT *b){ + + BLASLONG i, ii, jj, js; + + FLOAT *ao; + + jj = offset; + FLOAT_V_T va1; + + VBOOL_T vbool_cmp; + UINT_V_T vindex; + + size_t vl; + + for (js = n; js > 0; js -= vl) + { + vl = VSETVL(js); + ao = a; + + ii = 0; + for (i = 0; i < m;) + { + + if (ii == jj) + { + vindex = VID_V_UINT(vl); + for (unsigned int j = 0; j < vl; j++) + { + va1 = VLEV_FLOAT(ao, vl); + vbool_cmp = VMSLTU_VX_UINT(vindex, j, vl); + VSEV_FLOAT_M(vbool_cmp, b, va1, vl); + *(b + j) = INV(*(ao + j)); + + ao += lda; + b += vl; + } + i += vl; + ii += vl; + } + else + { + if (ii > jj) + { + va1 = VLEV_FLOAT(ao, vl); + VSEV_FLOAT(b, va1, vl); + } + ao += lda; + b += vl; + i ++; + ii ++; + } + } + + a += vl; + jj += vl; + } + + return 0; +} diff --git a/kernel/riscv64/zamax_rvv.c b/kernel/riscv64/zamax_rvv.c new file mode 100644 index 000000000..1917042be --- /dev/null +++ b/kernel/riscv64/zamax_rvv.c @@ -0,0 +1,113 @@ +/*************************************************************************** +Copyright (c) 2022, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" +#include + +#if !defined(DOUBLE) +#define VSETVL(n) vsetvl_e32m4(n) +#define VSETVL_MAX vsetvlmax_e32m4() +#define VSETVL_MAX_M1 vsetvlmax_e32m1() +#define FLOAT_V_T vfloat32m4_t +#define FLOAT_V_T_M1 vfloat32m1_t +#define VLSEG_FLOAT vlseg2e32_v_f32m4 +#define VLSSEG_FLOAT vlsseg2e32_v_f32m4 +#define VFREDMAXVS_FLOAT vfredmax_vs_f32m4_f32m1 +#define VFMVVF_FLOAT vfmv_v_f_f32m4 +#define VFMVVF_FLOAT_M1 vfmv_v_f_f32m1 +#define VFMAXVV_FLOAT vfmax_vv_f32m4 +#define VFADDVV_FLOAT vfadd_vv_f32m4 +#define VFABSV_FLOAT vfabs_v_f32m4 +#define VFMVFS_FLOAT_M1 vfmv_f_s_f32m1_f32 +#else +#define VSETVL(n) vsetvl_e64m4(n) +#define VSETVL_MAX vsetvlmax_e64m4() +#define VSETVL_MAX_M1 vsetvlmax_e64m1() +#define FLOAT_V_T vfloat64m4_t +#define FLOAT_V_T_M1 vfloat64m1_t +#define VLSEG_FLOAT vlseg2e64_v_f64m4 +#define VLSSEG_FLOAT vlsseg2e64_v_f64m4 +#define VFREDMAXVS_FLOAT vfredmax_vs_f64m4_f64m1 +#define VFMVVF_FLOAT vfmv_v_f_f64m4 +#define VFMVVF_FLOAT_M1 vfmv_v_f_f64m1 +#define VFMAXVV_FLOAT vfmax_vv_f64m4 +#define VFADDVV_FLOAT vfadd_vv_f64m4 +#define VFABSV_FLOAT vfabs_v_f64m4 +#define VFMVFS_FLOAT_M1 vfmv_f_s_f64m1_f64 +#endif + +FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) +{ + FLOAT maxf=0.0; + + if (n <= 0 || inc_x <= 0) return(maxf); + + FLOAT_V_T v0, v1, vmax; + FLOAT_V_T_M1 v_res; + + v_res = VFMVVF_FLOAT_M1(0, VSETVL_MAX_M1); + size_t vlmax = VSETVL_MAX; + vmax = VFMVVF_FLOAT(0.0, vlmax); + + if(inc_x == 1) { + + for (size_t vl; n > 0; n -= vl, x += vl*2) { + vl = VSETVL(n); + + VLSEG_FLOAT(&v0, &v1, x, vl); + + v0 = VFABSV_FLOAT(v0, vl); + v1 = VFABSV_FLOAT(v1, vl); + + v0 = VFADDVV_FLOAT(v0, v1, vl); + vmax = VFMAXVV_FLOAT(vmax, v0, vl); + + } + + } else { + + BLASLONG stride_x = inc_x * sizeof(FLOAT) * 2; + + for (size_t vl; n > 0; n -= vl, x += vl*inc_x*2) { + vl = VSETVL(n); + + VLSSEG_FLOAT(&v0, &v1, x, stride_x, vl); + + v0 = VFABSV_FLOAT(v0, vl); + v1 = VFABSV_FLOAT(v1, vl); + + v0 = VFADDVV_FLOAT(v0, v1, vl); + vmax = VFMAXVV_FLOAT(vmax, v0, vl); + } + + } + + v_res = VFREDMAXVS_FLOAT(v_res, vmax, v_res, vlmax); + maxf = VFMVFS_FLOAT_M1(v_res); + + return(maxf); +} diff --git a/kernel/riscv64/zamin_rvv.c b/kernel/riscv64/zamin_rvv.c new file mode 100644 index 000000000..3f027383a --- /dev/null +++ b/kernel/riscv64/zamin_rvv.c @@ -0,0 +1,112 @@ +/*************************************************************************** +Copyright (c) 2022, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" +#include + +#if !defined(DOUBLE) +#define VSETVL(n) vsetvl_e32m4(n) +#define VSETVL_MAX vsetvlmax_e32m4() +#define VSETVL_MAX_M1 vsetvlmax_e32m1() +#define FLOAT_V_T vfloat32m4_t +#define FLOAT_V_T_M1 vfloat32m1_t +#define VLSEG_FLOAT vlseg2e32_v_f32m4 +#define VLSSEG_FLOAT vlsseg2e32_v_f32m4 +#define VFREDMINVS_FLOAT vfredmin_vs_f32m4_f32m1 +#define VFMVVF_FLOAT vfmv_v_f_f32m4 +#define VFMVVF_FLOAT_M1 vfmv_v_f_f32m1 +#define VFMINVV_FLOAT vfmin_vv_f32m4 +#define VFADDVV_FLOAT vfadd_vv_f32m4 +#define VFABSV_FLOAT vfabs_v_f32m4 +#define VFMVFS_FLOAT_M1 vfmv_f_s_f32m1_f32 +#else +#define VSETVL(n) vsetvl_e64m4(n) +#define VSETVL_MAX vsetvlmax_e64m4() +#define VSETVL_MAX_M1 vsetvlmax_e64m1() +#define FLOAT_V_T vfloat64m4_t +#define FLOAT_V_T_M1 vfloat64m1_t +#define VLSEG_FLOAT vlseg2e64_v_f64m4 +#define VLSSEG_FLOAT vlsseg2e64_v_f64m4 +#define VFREDMINVS_FLOAT vfredmin_vs_f64m4_f64m1 +#define VFMVVF_FLOAT vfmv_v_f_f64m4 +#define VFMVVF_FLOAT_M1 vfmv_v_f_f64m1 +#define VFMINVV_FLOAT vfmin_vv_f64m4 +#define VFADDVV_FLOAT vfadd_vv_f64m4 +#define VFABSV_FLOAT vfabs_v_f64m4 +#define VFMVFS_FLOAT_M1 vfmv_f_s_f64m1_f64 +#endif + +FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) +{ + FLOAT minf=0.0; + + if (n <= 0 || inc_x <= 0) return(minf); + + FLOAT_V_T v0, v1, vmin; + FLOAT_V_T_M1 v_res; + + v_res = VFMVVF_FLOAT_M1(FLT_MAX, VSETVL_MAX_M1); + size_t vlmax = VSETVL_MAX; + vmin = VFMVVF_FLOAT(FLT_MAX, vlmax); + + if(inc_x == 1) { + + for (size_t vl; n > 0; n -= vl, x += vl*2) { + vl = VSETVL(n); + + VLSEG_FLOAT(&v0, &v1, x, vl); + + v0 = VFABSV_FLOAT(v0, vl); + v1 = VFABSV_FLOAT(v1, vl); + + v0 = VFADDVV_FLOAT(v0, v1, vl); + vmin = VFMINVV_FLOAT(vmin, v0, vl); + } + + } else { + + BLASLONG stride_x = inc_x * sizeof(FLOAT) * 2; + + for (size_t vl; n > 0; n -= vl, x += vl*inc_x*2) { + vl = VSETVL(n); + + VLSSEG_FLOAT(&v0, &v1, x, stride_x, vl); + + v0 = VFABSV_FLOAT(v0, vl); + v1 = VFABSV_FLOAT(v1, vl); + + v0 = VFADDVV_FLOAT(v0, v1, vl); + vmin = VFMINVV_FLOAT(vmin, v0, vl); + } + + } + + v_res = VFREDMINVS_FLOAT(v_res, vmin, v_res, vlmax); + minf = VFMVFS_FLOAT_M1(v_res); + + return(minf); +} diff --git a/kernel/riscv64/zasum_rvv.c b/kernel/riscv64/zasum_rvv.c new file mode 100644 index 000000000..7876646b3 --- /dev/null +++ b/kernel/riscv64/zasum_rvv.c @@ -0,0 +1,108 @@ +/*************************************************************************** +Copyright (c) 2022, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" + +#if !defined(DOUBLE) +#define VSETVL(n) vsetvl_e32m8(n) +#define VSETVL_MAX vsetvlmax_e32m8() +#define FLOAT_V_T vfloat32m8_t +#define FLOAT_V_T_M1 vfloat32m1_t +#define VLEV_FLOAT vle32_v_f32m8 +#define VLSEV_FLOAT vlse32_v_f32m8 +#define VFREDSUMVS_FLOAT vfredusum_vs_f32m8_f32m1 +#define VFMVVF_FLOAT vfmv_v_f_f32m8 +#define VFMVVF_FLOAT_M1 vfmv_v_f_f32m1 +#define VFMVFS_FLOAT_M1 vfmv_f_s_f32m1_f32 +#define VFADDVV_FLOAT vfadd_vv_f32m8 +#define VFABSV_FLOAT vfabs_v_f32m8 +#else +#define VSETVL(n) vsetvl_e64m8(n) +#define VSETVL_MAX vsetvlmax_e64m8() +#define FLOAT_V_T vfloat64m8_t +#define FLOAT_V_T_M1 vfloat64m1_t +#define VLEV_FLOAT vle64_v_f64m8 +#define VLSEV_FLOAT vlse64_v_f64m8 +#define VFREDSUMVS_FLOAT vfredusum_vs_f64m8_f64m1 +#define VFMVVF_FLOAT vfmv_v_f_f64m8 +#define VFMVVF_FLOAT_M1 vfmv_v_f_f64m1 +#define VFMVFS_FLOAT_M1 vfmv_f_s_f64m1_f64 +#define VFADDVV_FLOAT vfadd_vv_f64m8 +#define VFABSV_FLOAT vfabs_v_f64m8 +#endif + +FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) +{ + FLOAT asumf = 0.0; + if (n <= 0 || inc_x <= 0) return(asumf); + + FLOAT_V_T v0, v1; + size_t vlmax = VSETVL_MAX; + FLOAT_V_T v_sum = VFMVVF_FLOAT(0, vlmax); + + if(inc_x == 1) { + + for (size_t vl; n > 0; n -= vl, x += vl*2) { + vl = VSETVL(n); + + v0 = VLEV_FLOAT(x, vl); + v1 = VLEV_FLOAT(x+vl, vl); + + v0 = VFABSV_FLOAT(v0, vl); + v1 = VFABSV_FLOAT(v1, vl); + + v_sum = VFADDVV_FLOAT(v_sum, v0, vl); + v_sum = VFADDVV_FLOAT(v_sum, v1, vl); + } + + } + else { + + int stride_x = inc_x * sizeof(FLOAT) * 2; + + for (size_t vl; n > 0; n -= vl, x += vl*inc_x*2) { + vl = VSETVL(n); + + v0 = VLSEV_FLOAT(x, stride_x, vl); + v1 = VLSEV_FLOAT(x+1, stride_x, vl); + + v0 = VFABSV_FLOAT(v0, vl); + v1 = VFABSV_FLOAT(v1, vl); + + v_sum = VFADDVV_FLOAT(v_sum, v0, vl); + v_sum = VFADDVV_FLOAT(v_sum, v1, vl); + } + + } + + FLOAT_V_T_M1 v_z0 = VFMVVF_FLOAT_M1(0, vlmax); + FLOAT_V_T_M1 v_res = VFMVVF_FLOAT_M1(0, vlmax); + v_res = VFREDSUMVS_FLOAT(v_res, v_sum, v_z0, vlmax); + asumf += VFMVFS_FLOAT_M1(v_res); + + return(asumf); +} diff --git a/kernel/riscv64/zaxpby_rvv.c b/kernel/riscv64/zaxpby_rvv.c new file mode 100644 index 000000000..66f52d9d0 --- /dev/null +++ b/kernel/riscv64/zaxpby_rvv.c @@ -0,0 +1,151 @@ +/*************************************************************************** +Copyright (c) 2022, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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. +*****************************************************************************/ + +/*************************************************************************** +* 2014/06/07 Saar +* +***************************************************************************/ + +#include "common.h" + +#if !defined(DOUBLE) +#define VSETVL(n) vsetvl_e32m4(n) +#define FLOAT_V_T vfloat32m4_t +#define VLSEV_FLOAT vlse32_v_f32m4 +#define VSSEV_FLOAT vsse32_v_f32m4 +#define VFMACCVF_FLOAT vfmacc_vf_f32m4 +#define VFNMSACVF_FLOAT vfnmsac_vf_f32m4 +#define VFMVVF_FLOAT vfmv_v_f_f32m4 +#define VFMULVF_FLOAT vfmul_vf_f32m4 +#define VFMSACVF_FLOAT vfmsac_vf_f32m4 +#define VLSEG_FLOAT vlseg2e32_v_f32m4 +#define VSSEG_FLOAT vsseg2e32_v_f32m4 +#define VLSSEG_FLOAT vlsseg2e32_v_f32m4 +#define VSSSEG_FLOAT vssseg2e32_v_f32m4 +#else +#define VSETVL(n) vsetvl_e64m4(n) +#define FLOAT_V_T vfloat64m4_t +#define VLSEV_FLOAT vlse64_v_f64m4 +#define VSSEV_FLOAT vsse64_v_f64m4 +#define VFMACCVF_FLOAT vfmacc_vf_f64m4 +#define VFNMSACVF_FLOAT vfnmsac_vf_f64m4 +#define VFMVVF_FLOAT vfmv_v_f_f64m4 +#define VFMULVF_FLOAT vfmul_vf_f64m4 +#define VFMSACVF_FLOAT vfmsac_vf_f64m4 +#define VLSEG_FLOAT vlseg2e64_v_f64m4 +#define VSSEG_FLOAT vsseg2e64_v_f64m4 +#define VLSSEG_FLOAT vlsseg2e64_v_f64m4 +#define VSSSEG_FLOAT vssseg2e64_v_f64m4 +#endif + +int CNAME(BLASLONG n, FLOAT alpha_r, FLOAT alpha_i, FLOAT *x, BLASLONG inc_x, FLOAT beta_r, FLOAT beta_i,FLOAT *y, BLASLONG inc_y) +{ + BLASLONG inc_x2, inc_y2; + + if ( n <= 0 ) return(0); + + inc_x2 = 2 * inc_x; + inc_y2 = 2 * inc_y; + + BLASLONG stride_x = inc_x2 * sizeof(FLOAT); + BLASLONG stride_y = inc_y2 * sizeof(FLOAT); + FLOAT_V_T vx0, vx1, vy0, vy1; + + if ( beta_r == 0.0 && beta_i == 0.0) + { + if ( alpha_r == 0.0 && alpha_i == 0.0 ) + { + size_t vl = VSETVL(n); + FLOAT_V_T temp = VFMVVF_FLOAT(0.0, vl); + for ( ; n > 0; n -= vl, y += vl*stride_y) + { + vl = VSETVL(n); + VSSSEG_FLOAT(y, stride_y, temp, temp, vl); + } + } + else + { + for (size_t vl; n > 0; n -= vl, x += vl*inc_x2, y += vl*inc_y2) + { + vl = VSETVL(n); + VLSSEG_FLOAT(&vx0, &vx1, x, stride_x, vl); + + vy0 = VFMULVF_FLOAT(vx1, alpha_i, vl); + vy0 = VFMSACVF_FLOAT(vy0, alpha_r, vx0, vl); + + vy1 = VFMULVF_FLOAT(vx1, alpha_r, vl); + vy1 = VFMACCVF_FLOAT(vy1, alpha_i, vx0, vl); + + VSSSEG_FLOAT(y, stride_y, vy0, vy1, vl); + } + } + } + else + { + FLOAT_V_T v0, v1; + + if ( alpha_r == 0.0 && alpha_i == 0.0 ) + { + for (size_t vl; n > 0; n -= vl, y += vl*inc_y2) + { + vl = VSETVL(n); + VLSSEG_FLOAT(&vy0, &vy1, y, stride_y, vl); + + v0 = VFMULVF_FLOAT(vy1, beta_i, vl); + v0 = VFMSACVF_FLOAT(v0, beta_r, vy0, vl); + + v1 = VFMULVF_FLOAT(vy1, beta_r, vl); + v1 = VFMACCVF_FLOAT(v1, beta_i, vy0, vl); + + VSSSEG_FLOAT(y, stride_y, v0, v1, vl); + } + } + else + { + for (size_t vl; n > 0; n -= vl, x += vl*inc_x2, y += vl*inc_y2) + { + vl = VSETVL(n); + VLSSEG_FLOAT(&vx0, &vx1, x, stride_x, vl); + VLSSEG_FLOAT(&vy0, &vy1, y, stride_y, vl); + + v0 = VFMULVF_FLOAT(vx0, alpha_r, vl); + v0 = VFNMSACVF_FLOAT(v0, alpha_i, vx1, vl); + v0 = VFMACCVF_FLOAT(v0, beta_r, vy0, vl); + v0 = VFNMSACVF_FLOAT(v0, beta_i, vy1, vl); + + v1 = VFMULVF_FLOAT(vx1, alpha_r, vl); + v1 = VFMACCVF_FLOAT(v1, alpha_i, vx0, vl); + v1 = VFMACCVF_FLOAT(v1, beta_r, vy1, vl); + v1 = VFMACCVF_FLOAT(v1, beta_i, vy0, vl); + + VSSSEG_FLOAT(y, stride_y, v0, v1, vl); + } + } + } + return(0); + +} diff --git a/kernel/riscv64/zaxpy_rvv.c b/kernel/riscv64/zaxpy_rvv.c new file mode 100644 index 000000000..777bcb728 --- /dev/null +++ b/kernel/riscv64/zaxpy_rvv.c @@ -0,0 +1,154 @@ +/*************************************************************************** +Copyright (c) 2022, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" + +#if !defined(DOUBLE) +#define VSETVL(n) vsetvl_e32m4(n) +#define FLOAT_V_T vfloat32m4_t +#define VLSEG_FLOAT vlseg2e32_v_f32m4 +#define VLSSEG_FLOAT vlsseg2e32_v_f32m4 +#define VSSEG_FLOAT vsseg2e32_v_f32m4 +#define VSSSEG_FLOAT vssseg2e32_v_f32m4 +#define VFMACCVF_FLOAT vfmacc_vf_f32m4 +#define VFNMSACVF_FLOAT vfnmsac_vf_f32m4 +#else +#define VSETVL(n) vsetvl_e64m4(n) +#define FLOAT_V_T vfloat64m4_t +#define VLSEG_FLOAT vlseg2e64_v_f64m4 +#define VLSSEG_FLOAT vlsseg2e64_v_f64m4 +#define VSSEG_FLOAT vsseg2e64_v_f64m4 +#define VSSSEG_FLOAT vssseg2e64_v_f64m4 +#define VFMACCVF_FLOAT vfmacc_vf_f64m4 +#define VFNMSACVF_FLOAT vfnmsac_vf_f64m4 +#endif + +int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT da_r, FLOAT da_i, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y, FLOAT *dummy, BLASLONG dummy2) +{ + if(n < 0) return(0); + if(da_r == 0.0 && da_i == 0.0) return(0); + + FLOAT_V_T vx0, vx1, vy0, vy1; + + if(inc_x == 1 && inc_y == 1) { + + for (size_t vl; n > 0; n -= vl, x += vl*2, y += vl*2) { + vl = VSETVL(n); + + VLSEG_FLOAT(&vx0, &vx1, x, vl); + VLSEG_FLOAT(&vy0, &vy1, y, vl); + #if !defined(CONJ) + vy0 = VFMACCVF_FLOAT(vy0, da_r, vx0, vl); + vy0 = VFNMSACVF_FLOAT(vy0, da_i, vx1, vl); + vy1 = VFMACCVF_FLOAT(vy1, da_r, vx1, vl); + vy1 = VFMACCVF_FLOAT(vy1, da_i, vx0, vl); + #else + vy0 = VFMACCVF_FLOAT(vy0, da_r, vx0, vl); + vy0 = VFMACCVF_FLOAT(vy0, da_i, vx1, vl); + vy1 = VFNMSACVF_FLOAT(vy1, da_r, vx1, vl); + vy1 = VFMACCVF_FLOAT(vy1, da_i, vx0, vl); + #endif + VSSEG_FLOAT(y, vy0, vy1, vl); + } + + } else if (inc_x == 1) { + + BLASLONG stride_y = inc_y * 2 * sizeof(FLOAT); + + for (size_t vl; n > 0; n -= vl, x += vl*2, y += vl*inc_y*2) { + vl = VSETVL(n); + + VLSEG_FLOAT(&vx0, &vx1, x, vl); + VLSSEG_FLOAT(&vy0, &vy1, y, stride_y, vl); + + #if !defined(CONJ) + vy0 = VFMACCVF_FLOAT(vy0, da_r, vx0, vl); + vy0 = VFNMSACVF_FLOAT(vy0, da_i, vx1, vl); + vy1 = VFMACCVF_FLOAT(vy1, da_r, vx1, vl); + vy1 = VFMACCVF_FLOAT(vy1, da_i, vx0, vl); + #else + vy0 = VFMACCVF_FLOAT(vy0, da_r, vx0, vl); + vy0 = VFMACCVF_FLOAT(vy0, da_i, vx1, vl); + vy1 = VFNMSACVF_FLOAT(vy1, da_r, vx1, vl); + vy1 = VFMACCVF_FLOAT(vy1, da_i, vx0, vl); + #endif + VSSSEG_FLOAT(y, stride_y, vy0, vy1, vl); + } + + } else if (inc_y == 1) { + + BLASLONG stride_x = inc_x * 2 * sizeof(FLOAT); + + for (size_t vl; n > 0; n -= vl, x += vl*inc_x*2, y += vl*2) { + vl = VSETVL(n); + + VLSSEG_FLOAT(&vx0, &vx1, x, stride_x, vl); + VLSEG_FLOAT(&vy0, &vy1, y, vl); + + #if !defined(CONJ) + vy0 = VFMACCVF_FLOAT(vy0, da_r, vx0, vl); + vy0 = VFNMSACVF_FLOAT(vy0, da_i, vx1, vl); + vy1 = VFMACCVF_FLOAT(vy1, da_r, vx1, vl); + vy1 = VFMACCVF_FLOAT(vy1, da_i, vx0, vl); + #else + vy0 = VFMACCVF_FLOAT(vy0, da_r, vx0, vl); + vy0 = VFMACCVF_FLOAT(vy0, da_i, vx1, vl); + vy1 = VFNMSACVF_FLOAT(vy1, da_r, vx1, vl); + vy1 = VFMACCVF_FLOAT(vy1, da_i, vx0, vl); + #endif + VSSEG_FLOAT(y, vy0, vy1, vl); + } + + } else { + + BLASLONG stride_x = inc_x * 2 * sizeof(FLOAT); + BLASLONG stride_y = inc_y * 2 * sizeof(FLOAT); + + for (size_t vl; n > 0; n -= vl, x += vl*inc_x*2, y += vl*inc_y*2) { + vl = VSETVL(n); + + VLSSEG_FLOAT(&vx0, &vx1, x, stride_x, vl); + VLSSEG_FLOAT(&vy0, &vy1, y, stride_y, vl); + + #if !defined(CONJ) + vy0 = VFMACCVF_FLOAT(vy0, da_r, vx0, vl); + vy0 = VFNMSACVF_FLOAT(vy0, da_i, vx1, vl); + vy1 = VFMACCVF_FLOAT(vy1, da_r, vx1, vl); + vy1 = VFMACCVF_FLOAT(vy1, da_i, vx0, vl); + #else + vy0 = VFMACCVF_FLOAT(vy0, da_r, vx0, vl); + vy0 = VFMACCVF_FLOAT(vy0, da_i, vx1, vl); + vy1 = VFNMSACVF_FLOAT(vy1, da_r, vx1, vl); + vy1 = VFMACCVF_FLOAT(vy1, da_i, vx0, vl); + #endif + VSSSEG_FLOAT(y, stride_y, vy0, vy1, vl); + } + + } + + return(0); +} diff --git a/kernel/riscv64/zcopy_rvv.c b/kernel/riscv64/zcopy_rvv.c new file mode 100644 index 000000000..5d8322bbb --- /dev/null +++ b/kernel/riscv64/zcopy_rvv.c @@ -0,0 +1,105 @@ +/*************************************************************************** +Copyright (c) 2022, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" + +#if !defined(DOUBLE) +#define VSETVL_M8(n) vsetvl_e32m8(n) +#define FLOAT_V_T_M8 vfloat32m8_t +#define VLEV_FLOAT_M8 vle32_v_f32m8 +#define VSEV_FLOAT_M8 vse32_v_f32m8 + +#define VSETVL_M4(n) vsetvl_e32m4(n) +#define FLOAT_V_T_M4 vfloat32m4_t +#define VLSEG_FLOAT_M4 vlseg2e32_v_f32m4 +#define VSSEG_FLOAT_M4 vsseg2e32_v_f32m4 +#define VLSSEG_FLOAT_M4 vlsseg2e32_v_f32m4 +#define VSSSEG_FLOAT_M4 vssseg2e32_v_f32m4 +#else +#define VSETVL_M8(n) vsetvl_e64m8(n) +#define FLOAT_V_T_M8 vfloat64m8_t +#define VLEV_FLOAT_M8 vle64_v_f64m8 +#define VSEV_FLOAT_M8 vse64_v_f64m8 + +#define VSETVL_M4(n) vsetvl_e64m4(n) +#define FLOAT_V_T_M4 vfloat64m4_t +#define VLSEG_FLOAT_M4 vlseg2e64_v_f64m4 +#define VSSEG_FLOAT_M4 vsseg2e64_v_f64m4 +#define VLSSEG_FLOAT_M4 vlsseg2e64_v_f64m4 +#define VSSSEG_FLOAT_M4 vssseg2e64_v_f64m4 +#endif + +int CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y) +{ + if(n < 0) return(0); + + if(inc_x == 1 && inc_y == 1) { + + FLOAT_V_T_M8 vx; + n *= 2; // convert to words + + for(size_t vl; n > 0; n -= vl, x += vl, y += vl) { + vl = VSETVL_M8(n); + vx = VLEV_FLOAT_M8(x, vl); + VSEV_FLOAT_M8(y, vx, vl); + } + + }else if (1 == inc_x) { + + FLOAT_V_T_M4 vr, vi; + BLASLONG stride_y = inc_y * 2 * sizeof(FLOAT); + + for(size_t vl; n > 0; n -= vl, x += vl*2, y += vl*inc_y*2) { + vl = VSETVL_M4(n); + VLSEG_FLOAT_M4(&vr, &vi, x, vl); + VSSSEG_FLOAT_M4(y, stride_y, vr, vi, vl); + } + } else if (1 == inc_y) { + + FLOAT_V_T_M4 vr, vi; + BLASLONG stride_x = inc_x * 2 * sizeof(FLOAT); + + for(size_t vl; n > 0; n -= vl, x += vl*inc_x*2, y += vl*2) { + vl = VSETVL_M4(n); + VLSSEG_FLOAT_M4(&vr, &vi, x, stride_x, vl); + VSSEG_FLOAT_M4(y, vr, vi, vl); + } + } else { + + FLOAT_V_T_M4 vr, vi; + BLASLONG stride_x = inc_x * 2 * sizeof(FLOAT); + BLASLONG stride_y = inc_y * 2 * sizeof(FLOAT); + + for(size_t vl; n > 0; n -= vl, x += vl*inc_x*2, y += vl*inc_y*2) { + vl = VSETVL_M4(n); + VLSSEG_FLOAT_M4(&vr, &vi, x, stride_x, vl); + VSSSEG_FLOAT_M4(y, stride_y, vr, vi, vl); + } + } + + return(0); +} diff --git a/kernel/riscv64/zdot_rvv.c b/kernel/riscv64/zdot_rvv.c new file mode 100644 index 000000000..7eae6f608 --- /dev/null +++ b/kernel/riscv64/zdot_rvv.c @@ -0,0 +1,170 @@ +/*************************************************************************** +Copyright (c) 2022, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" + +#if !defined(DOUBLE) +#define VSETVL(n) vsetvl_e32m4(n) +#define VSETVL_MAX vsetvlmax_e32m4() +#define VSETVL_MAX_M1 vsetvlmax_e32m1() +#define FLOAT_V_T vfloat32m4_t +#define FLOAT_V_T_M1 vfloat32m1_t +#define VLSEG_FLOAT vlseg2e32_v_f32m4 +#define VLSSEG_FLOAT vlsseg2e32_v_f32m4 +#define VFREDSUM_FLOAT vfredusum_vs_f32m4_f32m1 +#define VFMACCVV_FLOAT vfmacc_vv_f32m4 +#define VFMVVF_FLOAT vfmv_v_f_f32m4 +#define VFMVVF_FLOAT_M1 vfmv_v_f_f32m1 +#define VFMULVV_FLOAT vfmul_vv_f32m4 +#define VFMSACVV_FLOAT vfmsac_vv_f32m4 +#define VFNMSACVV_FLOAT vfnmsac_vv_f32m4 +#define VFMVFS_FLOAT_M1 vfmv_f_s_f32m1_f32 +#else +#define VSETVL(n) vsetvl_e64m4(n) +#define VSETVL_MAX vsetvlmax_e64m4() +#define VSETVL_MAX_M1 vsetvlmax_e64m1() +#define FLOAT_V_T vfloat64m4_t +#define FLOAT_V_T_M1 vfloat64m1_t +#define VLSEG_FLOAT vlseg2e64_v_f64m4 +#define VLSSEG_FLOAT vlsseg2e64_v_f64m4 +#define VFREDSUM_FLOAT vfredusum_vs_f64m4_f64m1 +#define VFMACCVV_FLOAT vfmacc_vv_f64m4 +#define VFMVVF_FLOAT vfmv_v_f_f64m4 +#define VFMVVF_FLOAT_M1 vfmv_v_f_f64m1 +#define VFMULVV_FLOAT vfmul_vv_f64m4 +#define VFMSACVV_FLOAT vfmsac_vv_f64m4 +#define VFNMSACVV_FLOAT vfnmsac_vv_f64m4 +#define VFMVFS_FLOAT_M1 vfmv_f_s_f64m1_f64 +#endif + +OPENBLAS_COMPLEX_FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y) +{ + OPENBLAS_COMPLEX_FLOAT result; + CREAL(result) = 0.0; + CIMAG(result) = 0.0; + + if ( n <= 0 ) return(result); + + FLOAT_V_T vr0, vr1, vx0, vx1, vy0, vy1; + FLOAT_V_T_M1 v_res, v_z0; + size_t vlmax_m1 = VSETVL_MAX_M1; + v_res = VFMVVF_FLOAT_M1(0, vlmax_m1); + v_z0 = VFMVVF_FLOAT_M1(0, vlmax_m1); + + size_t vlmax = VSETVL_MAX; + vr0 = VFMVVF_FLOAT(0, vlmax); + vr1 = VFMVVF_FLOAT(0, vlmax); + + if(inc_x == 1 && inc_y == 1) { + + for (size_t vl; n > 0; n -= vl, x += vl*2, y += vl*2) { + vl = VSETVL(n); + + VLSEG_FLOAT(&vx0, &vx1, x, vl); + VLSEG_FLOAT(&vy0, &vy1, y, vl); + + vr0 = VFMACCVV_FLOAT(vr0, vx0, vy0, vl); + vr1 = VFMACCVV_FLOAT(vr1, vx0, vy1, vl); + #if !defined(CONJ) + vr0 = VFNMSACVV_FLOAT(vr0, vx1, vy1, vl); + vr1 = VFMACCVV_FLOAT(vr1, vx1, vy0, vl); + #else + vr0 = VFMACCVV_FLOAT(vr0, vx1, vy1, vl); + vr1 = VFNMSACVV_FLOAT(vr1, vx1, vy0, vl); + #endif + } + + } else if (inc_x == 1){ + + BLASLONG stride_y = inc_y * 2 * sizeof(FLOAT); + + for (size_t vl; n > 0; n -= vl, x += vl*2, y += vl*inc_y*2) { + vl = VSETVL(n); + + VLSEG_FLOAT(&vx0, &vx1, x, vl); + VLSSEG_FLOAT(&vy0, &vy1, y, stride_y, vl); + + vr0 = VFMACCVV_FLOAT(vr0, vx0, vy0, vl); + vr1 = VFMACCVV_FLOAT(vr1, vx0, vy1, vl); + #if !defined(CONJ) + vr0 = VFNMSACVV_FLOAT(vr0, vx1, vy1, vl); + vr1 = VFMACCVV_FLOAT(vr1, vx1, vy0, vl); + #else + vr0 = VFMACCVV_FLOAT(vr0, vx1, vy1, vl); + vr1 = VFNMSACVV_FLOAT(vr1, vx1, vy0, vl); + #endif + } + } else if (inc_y == 1){ + + BLASLONG stride_x = inc_x * 2 * sizeof(FLOAT); + + for (size_t vl; n > 0; n -= vl, x += vl*inc_x*2, y += vl*2) { + vl = VSETVL(n); + + VLSSEG_FLOAT(&vx0, &vx1, x, stride_x, vl); + VLSEG_FLOAT(&vy0, &vy1, y, vl); + + vr0 = VFMACCVV_FLOAT(vr0, vx0, vy0, vl); + vr1 = VFMACCVV_FLOAT(vr1, vx0, vy1, vl); + #if !defined(CONJ) + vr0 = VFNMSACVV_FLOAT(vr0, vx1, vy1, vl); + vr1 = VFMACCVV_FLOAT(vr1, vx1, vy0, vl); + #else + vr0 = VFMACCVV_FLOAT(vr0, vx1, vy1, vl); + vr1 = VFNMSACVV_FLOAT(vr1, vx1, vy0, vl); + #endif + } + }else { + + BLASLONG stride_x = inc_x * 2 * sizeof(FLOAT); + BLASLONG stride_y = inc_y * 2 * sizeof(FLOAT); + + for (size_t vl; n > 0; n -= vl, x += vl*inc_x*2, y += vl*inc_y*2) { + vl = VSETVL(n); + + VLSSEG_FLOAT(&vx0, &vx1, x, stride_x, vl); + VLSSEG_FLOAT(&vy0, &vy1, y, stride_y, vl); + + vr0 = VFMACCVV_FLOAT(vr0, vx0, vy0, vl); + vr1 = VFMACCVV_FLOAT(vr1, vx0, vy1, vl); + #if !defined(CONJ) + vr0 = VFNMSACVV_FLOAT(vr0, vx1, vy1, vl); + vr1 = VFMACCVV_FLOAT(vr1, vx1, vy0, vl); + #else + vr0 = VFMACCVV_FLOAT(vr0, vx1, vy1, vl); + vr1 = VFNMSACVV_FLOAT(vr1, vx1, vy0, vl); + #endif + } + } + + v_res = VFREDSUM_FLOAT(v_res, vr0, v_z0, vlmax); + CREAL(result) = VFMVFS_FLOAT_M1(v_res); + v_res = VFREDSUM_FLOAT(v_res, vr1, v_z0, vlmax); + CIMAG(result) = VFMVFS_FLOAT_M1(v_res); + + return(result); +} diff --git a/kernel/riscv64/zgemm_beta_rvv.c b/kernel/riscv64/zgemm_beta_rvv.c new file mode 100644 index 000000000..a89752d18 --- /dev/null +++ b/kernel/riscv64/zgemm_beta_rvv.c @@ -0,0 +1,117 @@ +/*********************************************************************/ +/* Copyright 2009, 2010 The University of Texas at Austin. */ +/* All rights reserved. */ +/* */ +/* Redistribution and use in source and binary forms, with or */ +/* without modification, are permitted provided that the following */ +/* conditions are met: */ +/* */ +/* 1. Redistributions of source code must retain the above */ +/* copyright notice, this list of conditions and the following */ +/* disclaimer. */ +/* */ +/* 2. 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. */ +/* */ +/* THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY OF TEXAS AT */ +/* AUSTIN ``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 UNIVERSITY OF TEXAS AT */ +/* AUSTIN 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. */ +/* */ +/* The views and conclusions contained in the software and */ +/* documentation are those of the authors and should not be */ +/* interpreted as representing official policies, either expressed */ +/* or implied, of The University of Texas at Austin. */ +/*********************************************************************/ + +#include "common.h" + +#if !defined(DOUBLE) +#define VSETVL(n) vsetvl_e32m4(n) +#define FLOAT_V_T vfloat32m4_t +#define VLSEG_FLOAT vlseg2e32_v_f32m4 +#define VSSEG_FLOAT vsseg2e32_v_f32m4 +#define VFMVVF_FLOAT vfmv_v_f_f32m4 +#define VFMULVF_FLOAT vfmul_vf_f32m4 +#define VFADDVV_FLOAT vfadd_vv_f32m4 +#define VFSUBVV_FLOAT vfsub_vv_f32m4 +#else +#define VSETVL(n) vsetvl_e64m4(n) +#define FLOAT_V_T vfloat64m4_t +#define VLSEG_FLOAT vlseg2e64_v_f64m4 +#define VSSEG_FLOAT vsseg2e64_v_f64m4 +#define VFMVVF_FLOAT vfmv_v_f_f64m4 +#define VFMULVF_FLOAT vfmul_vf_f64m4 +#define VFADDVV_FLOAT vfadd_vv_f64m4 +#define VFSUBVV_FLOAT vfsub_vv_f64m4 +#endif + +int CNAME(BLASLONG m, BLASLONG n, BLASLONG dummy1, + FLOAT beta_r, FLOAT beta_i, + FLOAT *dummy2, BLASLONG dummy3, + FLOAT *dummy4, BLASLONG dummy5, + FLOAT *c, BLASLONG ldc) +{ + BLASLONG chunk; + FLOAT *c_offset; + size_t vl; + FLOAT_V_T vr, vi, v1, v2, v3, v4; + + ldc *= 2; + c_offset = c; + + if (beta_r == 0.0 && beta_i == 0.0) { + + vl = VSETVL(m); + vr = VFMVVF_FLOAT(0.0, vl); + vi = VFMVVF_FLOAT(0.0, vl); + + for( ; n > 0; n--, c += ldc) { + c_offset = c; + + for(chunk=m; chunk > 0; chunk -= vl, c_offset += vl*2) { + vl = VSETVL(chunk); + + VSSEG_FLOAT(c_offset, vr, vi, vl); + } + } + + } else { + + for( ; n > 0; n--, c += ldc) { + c_offset = c; + + for(chunk=m; chunk > 0; chunk -= vl, c_offset += vl*2) { + vl = VSETVL(chunk); + + VLSEG_FLOAT(&vr, &vi, c_offset, vl); + + v1 = VFMULVF_FLOAT(vr, beta_r, vl); + v2 = VFMULVF_FLOAT(vi, beta_i, vl); + + v3 = VFMULVF_FLOAT(vi, beta_r, vl); + v4 = VFMULVF_FLOAT(vr, beta_i, vl); + + vr = VFSUBVV_FLOAT(v1, v2, vl); + vi = VFADDVV_FLOAT(v3, v4, vl); + + VSSEG_FLOAT(c_offset, vr, vi, vl); + } + } + + } + + return 0; +} diff --git a/kernel/riscv64/zgemv_n_rvv.c b/kernel/riscv64/zgemv_n_rvv.c new file mode 100644 index 000000000..2eeb61b45 --- /dev/null +++ b/kernel/riscv64/zgemv_n_rvv.c @@ -0,0 +1,170 @@ +/*************************************************************************** +Copyright (c) 2022, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" + +#if !defined(DOUBLE) +#define VSETVL(n) vsetvl_e32m4(n) +#define FLOAT_V_T vfloat32m4_t +#define VLEV_FLOAT vle32_v_f32m4 +#define VLSEV_FLOAT vlse32_v_f32m4 +#define VSEV_FLOAT vse32_v_f32m4 +#define VSSEV_FLOAT vsse32_v_f32m4 +#define VLSEG_FLOAT vlseg2e32_v_f32m4 +#define VSSEG_FLOAT vsseg2e32_v_f32m4 +#define VLSSEG_FLOAT vlsseg2e32_v_f32m4 +#define VSSSEG_FLOAT vssseg2e32_v_f32m4 +#define VFMACCVF_FLOAT vfmacc_vf_f32m4 +#define VFNMSACVF_FLOAT vfnmsac_vf_f32m4 +#else +#define VSETVL(n) vsetvl_e64m4(n) +#define FLOAT_V_T vfloat64m4_t +#define VLEV_FLOAT vle64_v_f64m4 +#define VLSEV_FLOAT vlse64_v_f64m4 +#define VSEV_FLOAT vse64_v_f64m4 +#define VSSEV_FLOAT vsse64_v_f64m4 +#define VLSEG_FLOAT vlseg2e64_v_f64m4 +#define VSSEG_FLOAT vsseg2e64_v_f64m4 +#define VLSSEG_FLOAT vlsseg2e64_v_f64m4 +#define VSSSEG_FLOAT vssseg2e64_v_f64m4 +#define VFMACCVF_FLOAT vfmacc_vf_f64m4 +#define VFNMSACVF_FLOAT vfnmsac_vf_f64m4 +#endif + +int CNAME(BLASLONG m, BLASLONG n, BLASLONG dummy1, FLOAT alpha_r, FLOAT alpha_i, FLOAT *a, BLASLONG lda, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y, FLOAT *buffer) +{ + BLASLONG i; + BLASLONG ix; + FLOAT *a_ptr; + FLOAT temp_r, temp_i; + FLOAT_V_T va0, va1, vy0, vy1; + + BLASLONG stride_y = inc_y * sizeof(FLOAT) * 2; + + BLASLONG inc_x2 = inc_x * 2; + BLASLONG lda2 = lda * 2; + if (inc_y == 1) + { + for (size_t vl; m > 0; m -= vl, a += vl*2, y += vl*2) { + vl = VSETVL(m); + a_ptr = a; + ix = 0; + VLSEG_FLOAT(&vy0, &vy1, y, vl); + + for(i = 0; i < n; i++){ +#if !defined(XCONJ) + temp_r = alpha_r * x[ix] - alpha_i * x[ix+1]; + temp_i = alpha_r * x[ix+1] + alpha_i * x[ix]; +#else + temp_r = alpha_r * x[ix] + alpha_i * x[ix+1]; + temp_i = alpha_r * x[ix+1] - alpha_i * x[ix]; +#endif + + VLSEG_FLOAT(&va0, &va1, a_ptr, vl); +#if !defined(CONJ) +#if !defined(XCONJ) + vy0 = VFMACCVF_FLOAT(vy0, temp_r, va0, vl); + vy0 = VFNMSACVF_FLOAT(vy0, temp_i, va1, vl); + vy1 = VFMACCVF_FLOAT(vy1, temp_r, va1, vl); + vy1 = VFMACCVF_FLOAT(vy1, temp_i, va0, vl); +#else + vy0 = VFMACCVF_FLOAT(vy0, temp_r, va0, vl); + vy0 = VFMACCVF_FLOAT(vy0, temp_i, va1, vl); + vy1 = VFMACCVF_FLOAT(vy1, temp_r, va1, vl); + vy1 = VFNMSACVF_FLOAT(vy1, temp_i, va0, vl); +#endif +#else +#if !defined(XCONJ) + vy0 = VFMACCVF_FLOAT(vy0, temp_r, va0, vl); + vy0 = VFMACCVF_FLOAT(vy0, temp_i, va1, vl); + vy1 = VFNMSACVF_FLOAT(vy1, temp_r, va1, vl); + vy1 = VFMACCVF_FLOAT(vy1, temp_i, va0, vl); +#else + vy0 = VFMACCVF_FLOAT(vy0, temp_r, va0, vl); + vy0 = VFNMSACVF_FLOAT(vy0, temp_i, va1, vl); + vy1 = VFNMSACVF_FLOAT(vy1, temp_r, va1, vl); + vy1 = VFNMSACVF_FLOAT(vy1, temp_i, va0, vl); +#endif +#endif + a_ptr += lda2; + ix += inc_x2; + } + VSSEG_FLOAT(y, vy0, vy1, vl); + } + + } + else + { + for (size_t vl; m > 0; m -= vl, a += vl*2, y += vl*inc_y*2) { + vl = VSETVL(m); + a_ptr = a; + ix = 0; + VLSSEG_FLOAT(&vy0, &vy1, y, stride_y, vl); + + for(i = 0; i < n; i++){ +#if !defined(XCONJ) + temp_r = alpha_r * x[ix] - alpha_i * x[ix+1]; + temp_i = alpha_r * x[ix+1] + alpha_i * x[ix]; +#else + temp_r = alpha_r * x[ix] + alpha_i * x[ix+1]; + temp_i = alpha_r * x[ix+1] - alpha_i * x[ix]; +#endif + + VLSEG_FLOAT(&va0, &va1, a_ptr, vl); +#if !defined(CONJ) +#if !defined(XCONJ) + vy0 = VFMACCVF_FLOAT(vy0, temp_r, va0, vl); + vy0 = VFNMSACVF_FLOAT(vy0, temp_i, va1, vl); + vy1 = VFMACCVF_FLOAT(vy1, temp_r, va1, vl); + vy1 = VFMACCVF_FLOAT(vy1, temp_i, va0, vl); +#else + vy0 = VFMACCVF_FLOAT(vy0, temp_r, va0, vl); + vy0 = VFMACCVF_FLOAT(vy0, temp_i, va1, vl); + vy1 = VFMACCVF_FLOAT(vy1, temp_r, va1, vl); + vy1 = VFNMSACVF_FLOAT(vy1, temp_i, va0, vl); +#endif +#else +#if !defined(XCONJ) + vy0 = VFMACCVF_FLOAT(vy0, temp_r, va0, vl); + vy0 = VFMACCVF_FLOAT(vy0, temp_i, va1, vl); + vy1 = VFNMSACVF_FLOAT(vy1, temp_r, va1, vl); + vy1 = VFMACCVF_FLOAT(vy1, temp_i, va0, vl); +#else + vy0 = VFMACCVF_FLOAT(vy0, temp_r, va0, vl); + vy0 = VFNMSACVF_FLOAT(vy0, temp_i, va1, vl); + vy1 = VFNMSACVF_FLOAT(vy1, temp_r, va1, vl); + vy1 = VFNMSACVF_FLOAT(vy1, temp_i, va0, vl); +#endif +#endif + a_ptr += lda2; + ix += inc_x2; + } + VSSSEG_FLOAT(y, stride_y, vy0, vy1, vl); + } + } + return(0); +} diff --git a/kernel/riscv64/zgemv_t_rvv.c b/kernel/riscv64/zgemv_t_rvv.c new file mode 100644 index 000000000..b682d5cd8 --- /dev/null +++ b/kernel/riscv64/zgemv_t_rvv.c @@ -0,0 +1,172 @@ +/*************************************************************************** +Copyright (c) 2022, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" + +#if !defined(DOUBLE) +#define VSETVL(n) vsetvl_e32m4(n) +#define VSETVL_MAX_M1 vsetvlmax_e32m1() +#define FLOAT_V_T vfloat32m4_t +#define FLOAT_V_T_M1 vfloat32m1_t +#define VLSEG_FLOAT vlseg2e32_v_f32m4 +#define VLSSEG_FLOAT vlsseg2e32_v_f32m4 +#define VFREDSUM_FLOAT vfredusum_vs_f32m4_f32m1 +#define VFMACCVV_FLOAT vfmacc_vv_f32m4 +#define VFNMSACVV_FLOAT vfnmsac_vv_f32m4 +#define VFMVVF_FLOAT vfmv_v_f_f32m4 +#define VFMVVF_FLOAT_M1 vfmv_v_f_f32m1 +#define VFMULVV_FLOAT vfmul_vv_f32m4 +#define VFMVFS_FLOAT_M1 vfmv_f_s_f32m1_f32 +#else +#define VSETVL(n) vsetvl_e64m4(n) +#define VSETVL_MAX_M1 vsetvlmax_e64m1() +#define FLOAT_V_T vfloat64m4_t +#define FLOAT_V_T_M1 vfloat64m1_t +#define VLSEG_FLOAT vlseg2e64_v_f64m4 +#define VLSSEG_FLOAT vlsseg2e64_v_f64m4 +#define VFREDSUM_FLOAT vfredusum_vs_f64m4_f64m1 +#define VFMACCVV_FLOAT vfmacc_vv_f64m4 +#define VFNMSACVV_FLOAT vfnmsac_vv_f64m4 +#define VFMVVF_FLOAT vfmv_v_f_f64m4 +#define VFMVVF_FLOAT_M1 vfmv_v_f_f64m1 +#define VFMULVV_FLOAT vfmul_vv_f64m4 +#define VFMVFS_FLOAT_M1 vfmv_f_s_f64m1_f64 +#endif + +int CNAME(BLASLONG m, BLASLONG n, BLASLONG dummy1, FLOAT alpha_r, FLOAT alpha_i, FLOAT *a, BLASLONG lda, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y, FLOAT *buffer) +{ + BLASLONG i = 0, j = 0; + BLASLONG ix = 0, iy = 0; + FLOAT *a_ptr = a; + FLOAT temp_r, temp_i; + + FLOAT_V_T va0, va1, vx0, vx1, vr, vi; + FLOAT_V_T_M1 v_res, v_z0; + + BLASLONG stride_x = inc_x * sizeof(FLOAT) * 2; + //BLASLONG stride_a = sizeof(FLOAT) * 2; + BLASLONG inc_y2 = inc_y * 2; + BLASLONG lda2 = lda * 2; + + size_t vlmax = VSETVL_MAX_M1; + v_res = VFMVVF_FLOAT_M1(0, vlmax); + v_z0 = VFMVVF_FLOAT_M1(0, vlmax); + vlmax = VSETVL(m); + + if (inc_x == 1) + { + for(i = 0; i < n; i++) { + j = 0; + ix = 0; + vr = VFMVVF_FLOAT(0, vlmax); + vi = VFMVVF_FLOAT(0, vlmax); + for(size_t vl, k = m; k > 0; k -= vl) { + vl = VSETVL(k); + + VLSEG_FLOAT(&va0, &va1, &a_ptr[j], vl); + VLSEG_FLOAT(&vx0, &vx1, &x[ix], vl); + +#if ( !defined(CONJ) && !defined(XCONJ) ) || ( defined(CONJ) && defined(XCONJ) ) + vr = VFMACCVV_FLOAT(vr, va0, vx0, vl); + vr = VFNMSACVV_FLOAT(vr, va1, vx1, vl); + vi = VFMACCVV_FLOAT(vi, va0, vx1, vl); + vi = VFMACCVV_FLOAT(vi, va1, vx0, vl); +#else + vr = VFMACCVV_FLOAT(vr, va0, vx0, vl); + vr = VFMACCVV_FLOAT(vr, va1, vx1, vl); + vi = VFMACCVV_FLOAT(vi, va0, vx1, vl); + vi = VFNMSACVV_FLOAT(vi, va1, vx0, vl); +#endif + j += vl * 2; + ix += vl * inc_x * 2; + } + + v_res = VFREDSUM_FLOAT(v_res, vr, v_z0, vlmax); + temp_r = VFMVFS_FLOAT_M1(v_res); + v_res = VFREDSUM_FLOAT(v_res, vi, v_z0, vlmax); + temp_i = VFMVFS_FLOAT_M1(v_res); + +#if !defined(XCONJ) + y[iy] += alpha_r * temp_r - alpha_i * temp_i; + y[iy+1] += alpha_r * temp_i + alpha_i * temp_r; +#else + y[iy] += alpha_r * temp_r + alpha_i * temp_i; + y[iy+1] -= alpha_r * temp_i - alpha_i * temp_r; +#endif + iy += inc_y2; + a_ptr += lda2; + } + } + else + { + for(i = 0; i < n; i++) { + j = 0; + ix = 0; + vr = VFMVVF_FLOAT(0, vlmax); + vi = VFMVVF_FLOAT(0, vlmax); + for(size_t vl, k = m; k > 0; k -= vl) { + vl = VSETVL(k); + + VLSEG_FLOAT(&va0, &va1, &a_ptr[j], vl); + VLSSEG_FLOAT(&vx0, &vx1, &x[ix], stride_x, vl); + +#if ( !defined(CONJ) && !defined(XCONJ) ) || ( defined(CONJ) && defined(XCONJ) ) + vr = VFMACCVV_FLOAT(vr, va0, vx0, vl); + vr = VFNMSACVV_FLOAT(vr, va1, vx1, vl); + vi = VFMACCVV_FLOAT(vi, va0, vx1, vl); + vi = VFMACCVV_FLOAT(vi, va1, vx0, vl); +#else + vr = VFMACCVV_FLOAT(vr, va0, vx0, vl); + vr = VFMACCVV_FLOAT(vr, va1, vx1, vl); + vi = VFMACCVV_FLOAT(vi, va0, vx1, vl); + vi = VFNMSACVV_FLOAT(vi, va1, vx0, vl); +#endif + j += vl * 2; + ix += vl * inc_x * 2; + } + + v_res = VFREDSUM_FLOAT(v_res, vr, v_z0, vlmax); + temp_r = VFMVFS_FLOAT_M1(v_res); + v_res = VFREDSUM_FLOAT(v_res, vi, v_z0, vlmax); + temp_i = VFMVFS_FLOAT_M1(v_res); + +#if !defined(XCONJ) + y[iy] += alpha_r * temp_r - alpha_i * temp_i; + y[iy+1] += alpha_r * temp_i + alpha_i * temp_r; +#else + y[iy] += alpha_r * temp_r + alpha_i * temp_i; + y[iy+1] -= alpha_r * temp_i - alpha_i * temp_r; +#endif + iy += inc_y2; + a_ptr += lda2; + } + + } + + + return(0); +} diff --git a/kernel/riscv64/znrm2_rvv.c b/kernel/riscv64/znrm2_rvv.c new file mode 100644 index 000000000..921ddb8cb --- /dev/null +++ b/kernel/riscv64/znrm2_rvv.c @@ -0,0 +1,122 @@ +/*************************************************************************** +Copyright (c) 2022, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" + +#if !defined(DOUBLE) +#define VSETVL(n) vsetvl_e32m4(n) +#define VSETVL_MAX vsetvlmax_e32m4() +#define VSETVL_MAX_M1 vsetvlmax_e32m1() +#define FLOAT_V_T vfloat32m4_t +#define FLOAT_V_T_M1 vfloat32m1_t +#define VLSEG_FLOAT vlseg2e32_v_f32m4 +#define VLSSEG_FLOAT vlsseg2e32_v_f32m4 +#define VFREDSUM_FLOAT vfredusum_vs_f32m4_f32m1 +#define VFMACCVV_FLOAT vfmacc_vv_f32m4 +#define VFMVVF_FLOAT vfmv_v_f_f32m4 +#define VFMVVF_FLOAT_M1 vfmv_v_f_f32m1 +#define VFREDMAXVS_FLOAT vfredmax_vs_f32m4_f32m1 +#define VFMVFS_FLOAT_M1 vfmv_f_s_f32m1_f32 +#define VFABSV_FLOAT vfabs_v_f32m4 +#else +#define VSETVL(n) vsetvl_e64m4(n) +#define VSETVL_MAX vsetvlmax_e64m4() +#define VSETVL_MAX_M1 vsetvlmax_e64m1() +#define FLOAT_V_T vfloat64m4_t +#define FLOAT_V_T_M1 vfloat64m1_t +#define VLSEG_FLOAT vlseg2e64_v_f64m4 +#define VLSSEG_FLOAT vlsseg2e64_v_f64m4 +#define VFREDSUM_FLOAT vfredusum_vs_f64m4_f64m1 +#define VFMACCVV_FLOAT vfmacc_vv_f64m4 +#define VFMVVF_FLOAT vfmv_v_f_f64m4 +#define VFMVVF_FLOAT_M1 vfmv_v_f_f64m1 +#define VFREDMAXVS_FLOAT vfredmax_vs_f64m4_f64m1 +#define VFMVFS_FLOAT_M1 vfmv_f_s_f64m1_f64 +#define VFABSV_FLOAT vfabs_v_f64m4 +#endif + +// TODO: Should single precision use the widening MAC, or perhaps all should be double? + +FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) +{ + + if ( n <= 0 ) return(0.0); + + FLOAT_V_T vr, v0, v1; + FLOAT_V_T_M1 v_max, v_res; + FLOAT scale = 0.0, ssq = 0.0; + + size_t vlmax = VSETVL_MAX; + v_res = VFMVVF_FLOAT_M1(0, vlmax); + v_max = VFMVVF_FLOAT_M1(0, vlmax); + + vr = VFMVVF_FLOAT(0, vlmax); + + if (inc_x == 1) { + + for (size_t vl; n > 0; n -= vl, x += vl*2) { + vl = VSETVL(n); + + VLSEG_FLOAT(&v0, &v1, x, vl); + v0 = VFABSV_FLOAT(v0, vl); + v1 = VFABSV_FLOAT(v1, vl); + + v_max = VFREDMAXVS_FLOAT(v_max, v0, v_max, vl); + vr = VFMACCVV_FLOAT(vr, v0, v0, vl); + + v_max = VFREDMAXVS_FLOAT(v_max, v1, v_max, vl); + vr = VFMACCVV_FLOAT(vr, v1, v1, vl); + } + + } else { + + BLASLONG stride_x = inc_x * sizeof(FLOAT) * 2; + + for (size_t vl; n > 0; n -= vl, x += vl*inc_x*2) { + vl = VSETVL(n); + + VLSSEG_FLOAT(&v0, &v1, x, stride_x, vl); + v0 = VFABSV_FLOAT(v0, vl); + v1 = VFABSV_FLOAT(v1, vl); + + v_max = VFREDMAXVS_FLOAT(v_max, v0, v_max, vl); + vr = VFMACCVV_FLOAT(vr, v0, v0, vl); + + v_max = VFREDMAXVS_FLOAT(v_max, v1, v_max, vl); + vr = VFMACCVV_FLOAT(vr, v1, v1, vl); + } + + } + + v_res = VFREDSUM_FLOAT(v_res, vr, v_res, vlmax); + + ssq = VFMVFS_FLOAT_M1(v_res); + scale = VFMVFS_FLOAT_M1(v_max); + ssq = ssq / (scale*scale); + + return(scale * sqrt(ssq)); +} diff --git a/kernel/riscv64/zrot_rvv.c b/kernel/riscv64/zrot_rvv.c new file mode 100644 index 000000000..68066a00b --- /dev/null +++ b/kernel/riscv64/zrot_rvv.c @@ -0,0 +1,181 @@ +/*************************************************************************** +Copyright (c) 2022, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" + +#if !defined(DOUBLE) +#define VSETVL(n) vsetvl_e32m4(n) +#define FLOAT_V_T vfloat32m4_t +#define VLEV_FLOAT vle32_v_f32m4 +#define VLSEV_FLOAT vlse32_v_f32m4 +#define VSEV_FLOAT vse32_v_f32m4 +#define VSSEV_FLOAT vsse32_v_f32m4 +#define VLSEG_FLOAT vlseg2e32_v_f32m4 +#define VSSEG_FLOAT vsseg2e32_v_f32m4 +#define VLSSEG_FLOAT vlsseg2e32_v_f32m4 +#define VSSSEG_FLOAT vssseg2e32_v_f32m4 +#define VFMACCVF_FLOAT vfmacc_vf_f32m4 +#define VFMULVF_FLOAT vfmul_vf_f32m4 +#define VFNMSACVF_FLOAT vfnmsac_vf_f32m4 +#else +#define VSETVL(n) vsetvl_e64m4(n) +#define FLOAT_V_T vfloat64m4_t +#define VLEV_FLOAT vle64_v_f64m4 +#define VLSEV_FLOAT vlse64_v_f64m4 +#define VSEV_FLOAT vse64_v_f64m4 +#define VSSEV_FLOAT vsse64_v_f64m4 +#define VLSEG_FLOAT vlseg2e64_v_f64m4 +#define VSSEG_FLOAT vsseg2e64_v_f64m4 +#define VLSSEG_FLOAT vlsseg2e64_v_f64m4 +#define VSSSEG_FLOAT vssseg2e64_v_f64m4 +#define VFMACCVF_FLOAT vfmacc_vf_f64m4 +#define VFMULVF_FLOAT vfmul_vf_f64m4 +#define VFNMSACVF_FLOAT vfnmsac_vf_f64m4 +#endif + +int CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y, FLOAT c, FLOAT s) +{ + + if (n <= 0) return(0); + + FLOAT_V_T vt0, vt1, vx0, vx1, vy0, vy1; + + if (inc_x == 0 && inc_y == 0) { + BLASLONG i=0; + BLASLONG ix=0,iy=0; + FLOAT temp[2]; + BLASLONG inc_x2; + BLASLONG inc_y2; + + inc_x2 = 2 * inc_x ; + inc_y2 = 2 * inc_y ; + + while(i < n) + { + temp[0] = c*x[ix] + s*y[iy] ; + temp[1] = c*x[ix+1] + s*y[iy+1] ; + y[iy] = c*y[iy] - s*x[ix] ; + y[iy+1] = c*y[iy+1] - s*x[ix+1] ; + x[ix] = temp[0] ; + x[ix+1] = temp[1] ; + + ix += inc_x2 ; + iy += inc_y2 ; + i++ ; + } + } + else if(inc_x == 1 && inc_y == 1) { + + for (size_t vl; n > 0; n -= vl, x += vl*2, y += vl*2) { + vl = VSETVL(n); + + VLSEG_FLOAT(&vx0, &vx1, x, vl); + VLSEG_FLOAT(&vy0, &vy1, y, vl); + + vt0 = VFMULVF_FLOAT(vx0, c, vl); + vt0 = VFMACCVF_FLOAT(vt0, s, vy0, vl); + vt1 = VFMULVF_FLOAT(vx1, c, vl); + vt1 = VFMACCVF_FLOAT(vt1, s, vy1, vl); + vy0 = VFMULVF_FLOAT(vy0, c, vl); + vy0 = VFNMSACVF_FLOAT(vy0, s, vx0, vl); + vy1 = VFMULVF_FLOAT(vy1, c, vl); + vy1 = VFNMSACVF_FLOAT(vy1, s, vx1, vl); + + VSSEG_FLOAT(x, vt0, vt1, vl); + VSSEG_FLOAT(y, vy0, vy1, vl); + } + + } else if (inc_x == 1){ + BLASLONG stride_y = inc_y * 2 * sizeof(FLOAT); + + for (size_t vl; n > 0; n -= vl, x += vl*2, y += vl*inc_y*2) { + vl = VSETVL(n); + + VLSEG_FLOAT(&vx0, &vx1, x, vl); + VLSSEG_FLOAT(&vy0, &vy1, y, stride_y, vl); + + vt0 = VFMULVF_FLOAT(vx0, c, vl); + vt0 = VFMACCVF_FLOAT(vt0, s, vy0, vl); + vt1 = VFMULVF_FLOAT(vx1, c, vl); + vt1 = VFMACCVF_FLOAT(vt1, s, vy1, vl); + vy0 = VFMULVF_FLOAT(vy0, c, vl); + vy0 = VFNMSACVF_FLOAT(vy0, s, vx0, vl); + vy1 = VFMULVF_FLOAT(vy1, c, vl); + vy1 = VFNMSACVF_FLOAT(vy1, s, vx1, vl); + + VSSEG_FLOAT(x, vt0, vt1, vl); + VSSSEG_FLOAT(y, stride_y, vy0, vy1, vl); + } + + } else if (inc_y == 1){ + BLASLONG stride_x = inc_x * 2 * sizeof(FLOAT); + + for (size_t vl; n > 0; n -= vl, x += vl*inc_x*2, y += vl*2) { + vl = VSETVL(n); + + VLSSEG_FLOAT(&vx0, &vx1, x, stride_x, vl); + VLSEG_FLOAT(&vy0, &vy1, y, vl); + + vt0 = VFMULVF_FLOAT(vx0, c, vl); + vt0 = VFMACCVF_FLOAT(vt0, s, vy0, vl); + vt1 = VFMULVF_FLOAT(vx1, c, vl); + vt1 = VFMACCVF_FLOAT(vt1, s, vy1, vl); + vy0 = VFMULVF_FLOAT(vy0, c, vl); + vy0 = VFNMSACVF_FLOAT(vy0, s, vx0, vl); + vy1 = VFMULVF_FLOAT(vy1, c, vl); + vy1 = VFNMSACVF_FLOAT(vy1, s, vx1, vl); + + VSSSEG_FLOAT(x, stride_x, vt0, vt1, vl); + VSSEG_FLOAT(y, vy0, vy1, vl); + } + + } else { + BLASLONG stride_x = inc_x * 2 * sizeof(FLOAT); + BLASLONG stride_y = inc_y * 2 * sizeof(FLOAT); + + for (size_t vl; n > 0; n -= vl, x += vl*inc_x*2, y += vl*inc_y*2) { + vl = VSETVL(n); + + VLSSEG_FLOAT(&vx0, &vx1, x, stride_x, vl); + VLSSEG_FLOAT(&vy0, &vy1, y, stride_y, vl); + + vt0 = VFMULVF_FLOAT(vx0, c, vl); + vt0 = VFMACCVF_FLOAT(vt0, s, vy0, vl); + vt1 = VFMULVF_FLOAT(vx1, c, vl); + vt1 = VFMACCVF_FLOAT(vt1, s, vy1, vl); + vy0 = VFMULVF_FLOAT(vy0, c, vl); + vy0 = VFNMSACVF_FLOAT(vy0, s, vx0, vl); + vy1 = VFMULVF_FLOAT(vy1, c, vl); + vy1 = VFNMSACVF_FLOAT(vy1, s, vx1, vl); + + VSSSEG_FLOAT(x, stride_x, vt0, vt1, vl); + VSSSEG_FLOAT(y, stride_y, vy0, vy1, vl); + } + } + + return 0; +} diff --git a/kernel/riscv64/zscal_rvv.c b/kernel/riscv64/zscal_rvv.c new file mode 100644 index 000000000..079c36a2d --- /dev/null +++ b/kernel/riscv64/zscal_rvv.c @@ -0,0 +1,148 @@ +/*************************************************************************** +Copyright (c) 2022, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" + +#if !defined(DOUBLE) +#define VSETVL(n) vsetvl_e32m4(n) +#define VSETVL_MAX vsetvlmax_e32m4() +#define FLOAT_V_T vfloat32m4_t +#define VLSEG_FLOAT vlseg2e32_v_f32m4 +#define VLSSEG_FLOAT vlsseg2e32_v_f32m4 +#define VSSEG_FLOAT vsseg2e32_v_f32m4 +#define VSSSEG_FLOAT vssseg2e32_v_f32m4 +#define VFMACCVF_FLOAT vfmacc_vf_f32m4 +#define VFMULVF_FLOAT vfmul_vf_f32m4 +#define VFNMSACVF_FLOAT vfnmsac_vf_f32m4 +#define VFMVVF_FLOAT vfmv_v_f_f32m4 +#else +#define VSETVL(n) vsetvl_e64m4(n) +#define VSETVL_MAX vsetvlmax_e64m4() +#define FLOAT_V_T vfloat64m4_t +#define VLSEG_FLOAT vlseg2e64_v_f64m4 +#define VLSSEG_FLOAT vlsseg2e64_v_f64m4 +#define VSSEG_FLOAT vsseg2e64_v_f64m4 +#define VSSSEG_FLOAT vssseg2e64_v_f64m4 +#define VFMACCVF_FLOAT vfmacc_vf_f64m4 +#define VFMULVF_FLOAT vfmul_vf_f64m4 +#define VFNMSACVF_FLOAT vfnmsac_vf_f64m4 +#define VFMVVF_FLOAT vfmv_v_f_f64m4 +#endif + +int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT da_r,FLOAT da_i, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y, FLOAT *dummy, BLASLONG dummy2) +{ + + if((n <= 0) || (inc_x <= 0)) return(0); + + FLOAT_V_T vt, vr, vi; + BLASLONG stride_x = inc_x * 2 * sizeof(FLOAT); + size_t vlmax = VSETVL_MAX; + + if(da_r == 0.0 && da_i == 0.0) { + + vr = VFMVVF_FLOAT(0.0, vlmax); + vi = VFMVVF_FLOAT(0.0, vlmax); + + if(inc_x == 1) { + + for (size_t vl; n > 0; n -= vl, x += vl*2) { + vl = VSETVL(n); + + VSSEG_FLOAT(x, vr, vi, vl); + } + + } else { + + for (size_t vl; n > 0; n -= vl, x += vl*inc_x*2) { + vl = VSETVL(n); + + VSSSEG_FLOAT(x, stride_x, vr, vi, vl); + } + } + + } else if(da_r == 0.0) { + + for (size_t vl; n > 0; n -= vl, x += vl*inc_x*2) { + vl = VSETVL(n); + + VLSSEG_FLOAT(&vr, &vi, x, stride_x, vl); + + vt = VFMULVF_FLOAT(vi, -da_i, vl); + vi = VFMULVF_FLOAT(vr, da_i, vl); + + VSSSEG_FLOAT(x, stride_x, vt, vi, vl); + } + + } else if(da_i == 0.0) { + + for (size_t vl; n > 0; n -= vl, x += vl*inc_x*2) { + vl = VSETVL(n); + + VLSSEG_FLOAT(&vr, &vi, x, stride_x, vl); + + vr = VFMULVF_FLOAT(vr, da_r, vl); + vi = VFMULVF_FLOAT(vi, da_r, vl); + + VSSSEG_FLOAT(x, stride_x, vr, vi, vl); + } + + } else { + + if(inc_x == 1) { + + for (size_t vl; n > 0; n -= vl, x += vl*2) { + vl = VSETVL(n); + + VLSEG_FLOAT(&vr, &vi, x, vl); + + vt = VFMULVF_FLOAT(vr, da_r, vl); + vt = VFNMSACVF_FLOAT(vt, da_i, vi, vl); + vi = VFMULVF_FLOAT(vi, da_r, vl); + vi = VFMACCVF_FLOAT(vi, da_i, vr, vl); + + VSSEG_FLOAT(x, vt, vi, vl); + } + + } else { + + for (size_t vl; n > 0; n -= vl, x += vl*inc_x*2) { + vl = VSETVL(n); + + VLSSEG_FLOAT(&vr, &vi, x, stride_x, vl); + + vt = VFMULVF_FLOAT(vr, da_r, vl); + vt = VFNMSACVF_FLOAT(vt, da_i, vi, vl); + vi = VFMULVF_FLOAT(vi, da_r, vl); + vi = VFMACCVF_FLOAT(vi, da_i, vr, vl); + + VSSSEG_FLOAT(x, stride_x, vt, vi, vl); + } + } + } + + return(0); +} diff --git a/kernel/riscv64/zsum_rvv.c b/kernel/riscv64/zsum_rvv.c new file mode 100644 index 000000000..3928fbe27 --- /dev/null +++ b/kernel/riscv64/zsum_rvv.c @@ -0,0 +1,97 @@ +/*************************************************************************** +Copyright (c) 2022, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" + +#if !defined(DOUBLE) +#define VSETVL(n) vsetvl_e32m4(n) +#define VSETVL_MAX vsetvlmax_e32m4() +#define FLOAT_V_T vfloat32m4_t +#define FLOAT_V_T_M1 vfloat32m1_t +#define VLSEG_FLOAT vlseg2e32_v_f32m4 +#define VLSSEG_FLOAT vlsseg2e32_v_f32m4 +#define VFREDSUMVS_FLOAT vfredusum_vs_f32m4_f32m1 +#define VFMVVF_FLOAT vfmv_v_f_f32m4 +#define VFMVVF_FLOAT_M1 vfmv_v_f_f32m1 +#define VFMVFS_FLOAT_M1 vfmv_f_s_f32m1_f32 +#define VFADDVV_FLOAT vfadd_vv_f32m4 +#else +#define VSETVL(n) vsetvl_e64m4(n) +#define VSETVL_MAX vsetvlmax_e64m4() +#define FLOAT_V_T vfloat64m4_t +#define FLOAT_V_T_M1 vfloat64m1_t +#define VLSEG_FLOAT vlseg2e64_v_f64m4 +#define VLSSEG_FLOAT vlsseg2e64_v_f64m4 +#define VFREDSUMVS_FLOAT vfredusum_vs_f64m4_f64m1 +#define VFMVVF_FLOAT vfmv_v_f_f64m4 +#define VFMVVF_FLOAT_M1 vfmv_v_f_f64m1 +#define VFMVFS_FLOAT_M1 vfmv_f_s_f64m1_f64 +#define VFADDVV_FLOAT vfadd_vv_f64m4 +#endif + +FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) +{ + FLOAT sumf = 0.0; + if (n <= 0 || inc_x <= 0) return(sumf); + + FLOAT_V_T v0, v1; + size_t vlmax = VSETVL_MAX; + FLOAT_V_T v_sum = VFMVVF_FLOAT(0, vlmax); + + if(inc_x == 1) { + + for (size_t vl; n > 0; n -= vl, x += vl*2) { + vl = VSETVL(n); + + VLSEG_FLOAT(&v0, &v1, x, vl); + + v_sum = VFADDVV_FLOAT(v_sum, v0, vl); + v_sum = VFADDVV_FLOAT(v_sum, v1, vl); + } + + } else { + + BLASLONG stride_x = inc_x * sizeof(FLOAT) * 2; + + for (size_t vl; n > 0; n -= vl, x += vl*inc_x*2) { + vl = VSETVL(n); + + VLSSEG_FLOAT(&v0, &v1, x, stride_x, vl); + + v_sum = VFADDVV_FLOAT(v_sum, v0, vl); + v_sum = VFADDVV_FLOAT(v_sum, v1, vl); + } + + } + + FLOAT_V_T_M1 v_z0 = VFMVVF_FLOAT_M1(0, vlmax); + FLOAT_V_T_M1 v_res = VFMVVF_FLOAT_M1(0, vlmax); + v_res = VFREDSUMVS_FLOAT(v_res, v_sum, v_z0, vlmax); + sumf += VFMVFS_FLOAT_M1(v_res); + + return(sumf); +} diff --git a/kernel/riscv64/zswap_rvv.c b/kernel/riscv64/zswap_rvv.c new file mode 100644 index 000000000..86f9103d3 --- /dev/null +++ b/kernel/riscv64/zswap_rvv.c @@ -0,0 +1,156 @@ +/*************************************************************************** +Copyright (c) 2022, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" + +#if !defined(DOUBLE) +#define VSETVL(n) vsetvl_e32m4(n) +#define FLOAT_V_T vfloat32m4_t +#define VLSEG_FLOAT vlseg2e32_v_f32m4 +#define VLSSEG_FLOAT vlsseg2e32_v_f32m4 +#define VSSEG_FLOAT vsseg2e32_v_f32m4 +#define VSSSEG_FLOAT vssseg2e32_v_f32m4 +#else +#define VSETVL(n) vsetvl_e64m4(n) +#define FLOAT_V_T vfloat64m4_t +#define VLSEG_FLOAT vlseg2e64_v_f64m4 +#define VLSSEG_FLOAT vlsseg2e64_v_f64m4 +#define VSSEG_FLOAT vsseg2e64_v_f64m4 +#define VSSSEG_FLOAT vssseg2e64_v_f64m4 +#endif + +int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT dummy3, FLOAT dummy4, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y, FLOAT *dummy, BLASLONG dummy2) +{ + + if (n <= 0) return(0); + + FLOAT_V_T vx0, vx1, vy0, vy1; + + if (inc_x == 0 && inc_y == 0) { + if (n & 1) { + FLOAT temp[2]; + temp[0] = x[0]; + temp[1] = x[1]; + x[0] = y[0]; + x[1] = y[1]; + y[0] = temp[0]; + y[1] = temp[1]; + } + else { + return 0; + } + } + else if(inc_x == 0) { + FLOAT temp[2]; + temp[0] = x[0]; + temp[1] = x[1]; + x[0] = y[(n - 1) * inc_y * 2]; + x[0] = y[(n - 1) * inc_y * 2 + 1]; + FLOAT* ptr = y + (n - 1) * inc_y * 2; // start from the last one + BLASLONG stride_y = (0 - inc_y) * sizeof(FLOAT) * 2; // reverse + BLASLONG m = n - 1; + for (size_t vl; m > 0; m -= vl * 2, ptr -= vl*inc_y * 2) { + vl = VSETVL(m); + VLSSEG_FLOAT(&vy0, &vy1, ptr - 2, stride_y, vl); + VSSSEG_FLOAT(ptr, stride_y, vy0, vy1, vl); + } + y[0] = temp[0]; + y[1] = temp[1]; + } + else if(inc_y == 0) { + FLOAT temp[2]; + temp[0] = y[0]; + temp[1] = y[1]; + y[0] = x[(n - 1) * inc_x * 2]; + y[0] = x[(n - 1) * inc_x * 2 + 1]; + FLOAT* ptr = x + (n - 1) * inc_x * 2; // start from the last one + BLASLONG stride_x = (0 - inc_x) * sizeof(FLOAT) * 2; // reverse + BLASLONG m = n - 1; + for (size_t vl; m > 0; m -= vl * 2, ptr -= vl*inc_x * 2) { + vl = VSETVL(m); + VLSSEG_FLOAT(&vx0, &vx1, ptr - 2, stride_x, vl); + VSSSEG_FLOAT(ptr, stride_x, vx0, vx1, vl); + } + x[0] = temp[0]; + x[1] = temp[1]; + } + else if(inc_x == 1 && inc_y == 1) { + + for (size_t vl; n > 0; n -= vl, x += vl*2, y += vl*2) { + vl = VSETVL(n); + + VLSEG_FLOAT(&vx0, &vx1, x, vl); + VLSEG_FLOAT(&vy0, &vy1, y, vl); + + VSSEG_FLOAT(y, vx0, vx1, vl); + VSSEG_FLOAT(x, vy0, vy1, vl); + } + + } else if (inc_x == 1){ + BLASLONG stride_y = inc_y * 2 * sizeof(FLOAT); + + for (size_t vl; n > 0; n -= vl, x += vl*2, y += vl*inc_y*2) { + vl = VSETVL(n); + + VLSEG_FLOAT(&vx0, &vx1, x, vl); + VLSSEG_FLOAT(&vy0, &vy1, y, stride_y, vl); + + VSSSEG_FLOAT(y, stride_y, vx0, vx1, vl); + VSSEG_FLOAT(x, vy0, vy1, vl); + } + + } else if (inc_y == 1){ + BLASLONG stride_x = inc_x * 2 * sizeof(FLOAT); + + for (size_t vl; n > 0; n -= vl, x += vl*inc_x*2, y += vl*2) { + vl = VSETVL(n); + + VLSSEG_FLOAT(&vx0, &vx1, x, stride_x, vl); + VLSEG_FLOAT(&vy0, &vy1, y, vl); + + VSSEG_FLOAT(y, vx0, vx1, vl); + VSSSEG_FLOAT(x, stride_x, vy0, vy1, vl); + } + + } else { + BLASLONG stride_x = inc_x * 2 * sizeof(FLOAT); + BLASLONG stride_y = inc_y * 2 * sizeof(FLOAT); + + for (size_t vl; n > 0; n -= vl, x += vl*inc_x*2, y += vl*inc_y*2) { + vl = VSETVL(n); + + VLSSEG_FLOAT(&vx0, &vx1, x, stride_x, vl); + VLSSEG_FLOAT(&vy0, &vy1, y, stride_y, vl); + + VSSSEG_FLOAT(y, stride_y, vx0, vx1, vl); + VSSSEG_FLOAT(x, stride_x, vy0, vy1, vl); + } + + } + + return(0); +} diff --git a/kernel/riscv64/ztrmmkernel_2x2_rvv.c b/kernel/riscv64/ztrmmkernel_2x2_rvv.c new file mode 100644 index 000000000..3486a4648 --- /dev/null +++ b/kernel/riscv64/ztrmmkernel_2x2_rvv.c @@ -0,0 +1,596 @@ +/*************************************************************************** +Copyright (c) 2022, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" + +#if !defined(DOUBLE) +#define VSETVL(n) vsetvl_e32m2(n) +#define VSETVL_MAX vsetvlmax_e32m2() +#define VSETVL_MAX_M1 vsetvlmax_e32m1() +#define FLOAT_V_T vfloat32m2_t +#define FLOAT_V_T_M1 vfloat32m1_t +#define VLEV_FLOAT vle32_v_f32m2 +#define VLSEG4_FLOAT vlseg4e32_v_f32m2 +#define VLSEG2_FLOAT vlseg2e32_v_f32m2 +#define VFMVVF_FLOAT vfmv_v_f_f32m2 +#define VFMACCVF_FLOAT vfmacc_vf_f32m2 +#define VFMACCVV_FLOAT vfmacc_vv_f32m2 +#define VFNMSACVV_FLOAT vfnmsac_vv_f32m2 +#define VFREDSUMVS_FLOAT vfredusum_vs_f32m2_f32m1 +#define VFMVVF_FLOAT_M1 vfmv_v_f_f32m1 +#define VFMVFS_FLOAT_M1 vfmv_f_s_f32m1_f32 +#else +#define VSETVL(n) vsetvl_e64m2(n) +#define VSETVL_MAX vsetvlmax_e64m2() +#define VSETVL_MAX_M1 vsetvlmax_e64m1() +#define FLOAT_V_T vfloat64m2_t +#define FLOAT_V_T_M1 vfloat64m1_t +#define VLEV_FLOAT vle64_v_f64m2 +#define VLSEG4_FLOAT vlseg4e64_v_f64m2 +#define VLSEG2_FLOAT vlseg2e64_v_f64m2 +#define VFMVVF_FLOAT vfmv_v_f_f64m2 +#define VFMACCVF_FLOAT vfmacc_vf_f64m2 +#define VFMACCVV_FLOAT vfmacc_vv_f64m2 +#define VFNMSACVV_FLOAT vfnmsac_vv_f64m2 +#define VFREDSUMVS_FLOAT vfredusum_vs_f64m2_f64m1 +#define VFMVVF_FLOAT_M1 vfmv_v_f_f64m1 +#define VFMVFS_FLOAT_M1 vfmv_f_s_f64m1_f64 +#endif + +// Optimizes the implementation in ../generic/ztrmmkernel_2x2.c + + +/******************************** + ADD1 a*c + ADD2 b*c + ADD3 a*d + ADD4 b*d + *********************************/ +int CNAME(BLASLONG bm,BLASLONG bn,BLASLONG bk,FLOAT alphar,FLOAT alphai,FLOAT* ba,FLOAT* bb, + FLOAT* C,BLASLONG ldc, BLASLONG offset) +{ + BLASLONG i,j,k; + FLOAT *C0,*C1,*ptrba,*ptrbb; + FLOAT res0,res1; + BLASLONG off, temp; + + FLOAT_V_T va0, va1, va2, va3, vb0, vb1, vb2, vb3; + FLOAT_V_T vres0, vres1, vres2, vres3, vres4, vres5, vres6, vres7; + FLOAT_V_T_M1 v_m1_res0, v_m1_res1; + FLOAT_V_T_M1 v_z0 = VFMVVF_FLOAT_M1(0, VSETVL_MAX_M1); + + size_t vl; + size_t vlmax = VSETVL_MAX; + +#if defined(TRMMKERNEL) && !defined(LEFT) + off = -offset; +#else + off = 0; +#endif + + for (j = bn/2; j > 0; j--) + { +#if defined(TRMMKERNEL) && defined(LEFT) + off = offset; +#endif + C0 = C; + C1 = C0+2*ldc; + ptrba = ba; + + for (i = bm/2; i > 0; i--) + { +#if (defined(LEFT) && defined(TRANSA)) || (!defined(LEFT) && !defined(TRANSA)) + ptrbb = bb; +#else + ptrba += off*2*2; + ptrbb = bb+off*2*2; +#endif + + vres0 = VFMVVF_FLOAT(0.0, vlmax); + vres1 = VFMVVF_FLOAT(0.0, vlmax); + vres2 = VFMVVF_FLOAT(0.0, vlmax); + vres3 = VFMVVF_FLOAT(0.0, vlmax); + vres4 = VFMVVF_FLOAT(0.0, vlmax); + vres5 = VFMVVF_FLOAT(0.0, vlmax); + vres6 = VFMVVF_FLOAT(0.0, vlmax); + vres7 = VFMVVF_FLOAT(0.0, vlmax); + +#if (defined(LEFT) && !defined(TRANSA)) || (!defined(LEFT) && defined(TRANSA)) + temp = bk - off; +#elif defined(LEFT) + temp = off + 2; +#else + temp = off + 2; +#endif + + for (k = temp; k > 0; k -= vl) + { + vl = VSETVL(k); + VLSEG4_FLOAT(&va0, &va1, &va2, &va3, ptrba, vl); + VLSEG4_FLOAT(&vb0, &vb1, &vb2, &vb3, ptrbb, vl); + +#if defined(NN) || defined(NT) || defined(TN) || defined(TT) + vres0 = VFMACCVV_FLOAT(vres0, va0, vb0, vl); + vres1 = VFMACCVV_FLOAT(vres1, va1, vb0, vl); + vres0 = VFNMSACVV_FLOAT(vres0, va1, vb1, vl); + vres1 = VFMACCVV_FLOAT(vres1, va0, vb1, vl); + + vres2 = VFMACCVV_FLOAT(vres2, va2, vb0, vl); + vres3 = VFMACCVV_FLOAT(vres3, va3, vb0, vl); + vres2 = VFNMSACVV_FLOAT(vres2, va3, vb1, vl); + vres3 = VFMACCVV_FLOAT(vres3, va2, vb1, vl); + + vres4 = VFMACCVV_FLOAT(vres4, va0, vb2, vl); + vres5 = VFMACCVV_FLOAT(vres5, va1, vb2, vl); + vres4 = VFNMSACVV_FLOAT(vres4, va1, vb3, vl); + vres5 = VFMACCVV_FLOAT(vres5, va0, vb3, vl); + + vres6 = VFMACCVV_FLOAT(vres6, va2, vb2, vl); + vres7 = VFMACCVV_FLOAT(vres7, va3, vb2, vl); + vres6 = VFNMSACVV_FLOAT(vres6, va3, vb3, vl); + vres7 = VFMACCVV_FLOAT(vres7, va2, vb3, vl); +#endif +#if defined(NR) || defined(NC) || defined(TR) || defined(TC) + vres0 = VFMACCVV_FLOAT(vres0, va0, vb0, vl); + vres1 = VFMACCVV_FLOAT(vres1, va1, vb0, vl); + vres0 = VFMACCVV_FLOAT(vres0, va1, vb1, vl); + vres1 = VFNMSACVV_FLOAT(vres1, va0, vb1, vl); + + vres2 = VFMACCVV_FLOAT(vres2, va2, vb0, vl); + vres3 = VFMACCVV_FLOAT(vres3, va3, vb0, vl); + vres2 = VFMACCVV_FLOAT(vres2, va3, vb1, vl); + vres3 = VFNMSACVV_FLOAT(vres3, va2, vb1, vl); + + vres4 = VFMACCVV_FLOAT(vres4, va0, vb2, vl); + vres5 = VFMACCVV_FLOAT(vres5, va1, vb2, vl); + vres4 = VFMACCVV_FLOAT(vres4, va1, vb3, vl); + vres5 = VFNMSACVV_FLOAT(vres5, va0, vb3, vl); + + vres6 = VFMACCVV_FLOAT(vres6, va2, vb2, vl); + vres7 = VFMACCVV_FLOAT(vres7, va3, vb2, vl); + vres6 = VFMACCVV_FLOAT(vres6, va3, vb3, vl); + vres7 = VFNMSACVV_FLOAT(vres7, va2, vb3, vl); +#endif +#if defined(RN) || defined(RT) || defined(CN) || defined(CT) + vres0 = VFMACCVV_FLOAT(vres0, va0, vb0, vl); + vres1 = VFNMSACVV_FLOAT(vres1, va1, vb0, vl); + vres0 = VFMACCVV_FLOAT(vres0, va1, vb1, vl); + vres1 = VFMACCVV_FLOAT(vres1, va0, vb1, vl); + + vres2 = VFMACCVV_FLOAT(vres2, va2, vb0, vl); + vres3 = VFNMSACVV_FLOAT(vres3, va3, vb0, vl); + vres2 = VFMACCVV_FLOAT(vres2, va3, vb1, vl); + vres3 = VFMACCVV_FLOAT(vres3, va2, vb1, vl); + + vres4 = VFMACCVV_FLOAT(vres4, va0, vb2, vl); + vres5 = VFNMSACVV_FLOAT(vres5, va1, vb2, vl); + vres4 = VFMACCVV_FLOAT(vres4, va1, vb3, vl); + vres5 = VFMACCVV_FLOAT(vres5, va0, vb3, vl); + + vres6 = VFMACCVV_FLOAT(vres6, va2, vb2, vl); + vres7 = VFNMSACVV_FLOAT(vres7, va3, vb2, vl); + vres6 = VFMACCVV_FLOAT(vres6, va3, vb3, vl); + vres7 = VFMACCVV_FLOAT(vres7, va2, vb3, vl); +#endif +#if defined(RR) || defined(RC) || defined(CR) || defined(CC) + vres0 = VFMACCVV_FLOAT(vres0, va0, vb0, vl); + vres1 = VFNMSACVV_FLOAT(vres1, va1, vb0, vl); + vres0 = VFMACCVV_FLOAT(vres0, va1, vb1, vl); + vres1 = VFNMSACVV_FLOAT(vres1, va0, vb1, vl); + + vres2 = VFMACCVV_FLOAT(vres2, va2, vb0, vl); + vres3 = VFNMSACVV_FLOAT(vres3, va3, vb0, vl); + vres2 = VFMACCVV_FLOAT(vres2, va3, vb1, vl); + vres3 = VFNMSACVV_FLOAT(vres3, va2, vb1, vl); + + vres4 = VFMACCVV_FLOAT(vres4, va0, vb2, vl); + vres5 = VFNMSACVV_FLOAT(vres5, va1, vb2, vl); + vres4 = VFMACCVV_FLOAT(vres4, va1, vb3, vl); + vres5 = VFNMSACVV_FLOAT(vres5, va0, vb3, vl); + + vres6 = VFMACCVV_FLOAT(vres6, va2, vb2, vl); + vres7 = VFNMSACVV_FLOAT(vres7, va3, vb2, vl); + vres6 = VFMACCVV_FLOAT(vres6, va3, vb3, vl); + vres7 = VFNMSACVV_FLOAT(vres7, va2, vb3, vl); + +#endif + ptrba += vl * 4; + ptrbb += vl * 4; + } + + v_m1_res0 = VFREDSUMVS_FLOAT(v_m1_res0, vres0, v_z0, vlmax); + v_m1_res1 = VFREDSUMVS_FLOAT(v_m1_res1, vres1, v_z0, vlmax); + res0 = VFMVFS_FLOAT_M1(v_m1_res0); + res1 = VFMVFS_FLOAT_M1(v_m1_res1); + C0[0] = res0 * alphar - res1 * alphai; + C0[1] = res1 * alphar + res0 * alphai; + + v_m1_res0 = VFREDSUMVS_FLOAT(v_m1_res0, vres2, v_z0, vlmax); + v_m1_res1 = VFREDSUMVS_FLOAT(v_m1_res1, vres3, v_z0, vlmax); + res0 = VFMVFS_FLOAT_M1(v_m1_res0); + res1 = VFMVFS_FLOAT_M1(v_m1_res1); + C0[2] = res0 * alphar - res1 * alphai; + C0[3] = res1 * alphar + res0 * alphai; + + v_m1_res0 = VFREDSUMVS_FLOAT(v_m1_res0, vres4, v_z0, vlmax); + v_m1_res1 = VFREDSUMVS_FLOAT(v_m1_res1, vres5, v_z0, vlmax); + res0 = VFMVFS_FLOAT_M1(v_m1_res0); + res1 = VFMVFS_FLOAT_M1(v_m1_res1); + C1[0] = res0 * alphar - res1 * alphai; + C1[1] = res1 * alphar + res0 * alphai; + + v_m1_res0 = VFREDSUMVS_FLOAT(v_m1_res0, vres6, v_z0, vlmax); + v_m1_res1 = VFREDSUMVS_FLOAT(v_m1_res1, vres7, v_z0, vlmax); + res0 = VFMVFS_FLOAT_M1(v_m1_res0); + res1 = VFMVFS_FLOAT_M1(v_m1_res1); + C1[2] = res0 * alphar - res1 * alphai; + C1[3] = res1 * alphar + res0 * alphai; +#if ( defined(LEFT) && defined(TRANSA)) || \ + (!defined(LEFT) && !defined(TRANSA)) + temp = bk - off; +#ifdef LEFT + temp -= 2; +#else + temp -= 2; +#endif + + ptrba += temp*2*2; + ptrbb += temp*2*2; + +#endif + +#ifdef LEFT + off += 2; +#endif + + C0 = C0+4; + C1 = C1+4; + } + + if (bm & 1) + { +#if (defined(LEFT) && defined(TRANSA)) || (!defined(LEFT) && !defined(TRANSA)) + ptrbb = bb; +#else + ptrba += off*2; + ptrbb = bb + off*2*2; +#endif + vres0 = VFMVVF_FLOAT(0.0, vlmax); + vres1 = VFMVVF_FLOAT(0.0, vlmax); + vres2 = VFMVVF_FLOAT(0.0, vlmax); + vres3 = VFMVVF_FLOAT(0.0, vlmax); + +#if (defined(LEFT) && !defined(TRANSA)) || (!defined(LEFT) && defined(TRANSA)) + temp = bk - off; +#elif defined(LEFT) + temp = off+1; +#else + temp = off+2; +#endif + for (k = temp; k > 0; k -= vl) + { + vl = VSETVL(k); + VLSEG2_FLOAT(&va0, &va1, ptrba, vl); + VLSEG4_FLOAT(&vb0, &vb1, &vb2, &vb3, ptrbb, vl); + +#if defined(NN) || defined(NT) || defined(TN) || defined(TT) + vres0 = VFMACCVV_FLOAT(vres0, va0, vb0, vl); + vres1 = VFMACCVV_FLOAT(vres1, va1, vb0, vl); + vres0 = VFNMSACVV_FLOAT(vres0, va1, vb1, vl); + vres1 = VFMACCVV_FLOAT(vres1, va0, vb1, vl); + + vres2 = VFMACCVV_FLOAT(vres2, va0, vb2, vl); + vres3 = VFMACCVV_FLOAT(vres3, va1, vb2, vl); + vres2 = VFNMSACVV_FLOAT(vres2, va1, vb3, vl); + vres3 = VFMACCVV_FLOAT(vres3, va0, vb3, vl); +#endif +#if defined(NR) || defined(NC) || defined(TR) || defined(TC) + + vres0 = VFMACCVV_FLOAT(vres0, va0, vb0, vl); + vres1 = VFMACCVV_FLOAT(vres1, va1, vb0, vl); + vres0 = VFMACCVV_FLOAT(vres0, va1, vb1, vl); + vres1 = VFNMSACVV_FLOAT(vres1, va0, vb1, vl); + + vres2 = VFMACCVV_FLOAT(vres2, va0, vb2, vl); + vres3 = VFMACCVV_FLOAT(vres3, va1, vb2, vl); + vres2 = VFMACCVV_FLOAT(vres2, va1, vb3, vl); + vres3 = VFNMSACVV_FLOAT(vres3, va0, vb3, vl); + +#endif +#if defined(RN) || defined(RT) || defined(CN) || defined(CT) + + vres0 = VFMACCVV_FLOAT(vres0, va0, vb0, vl); + vres1 = VFNMSACVV_FLOAT(vres1, va1, vb0, vl); + vres0 = VFMACCVV_FLOAT(vres0, va1, vb1, vl); + vres1 = VFMACCVV_FLOAT(vres1, va0, vb1, vl); + + vres2 = VFMACCVV_FLOAT(vres2, va0, vb2, vl); + vres3 = VFNMSACVV_FLOAT(vres3, va1, vb2, vl); + vres2 = VFMACCVV_FLOAT(vres2, va1, vb3, vl); + vres3 = VFMACCVV_FLOAT(vres3, va0, vb3, vl); + +#endif +#if defined(RR) || defined(RC) || defined(CR) || defined(CC) + + vres0 = VFMACCVV_FLOAT(vres0, va0, vb0, vl); + vres1 = VFNMSACVV_FLOAT(vres1, va1, vb0, vl); + vres0 = VFNMSACVV_FLOAT(vres0, va1, vb1, vl); + vres1 = VFNMSACVV_FLOAT(vres1, va0, vb1, vl); + + vres2 = VFMACCVV_FLOAT(vres2, va0, vb2, vl); + vres3 = VFNMSACVV_FLOAT(vres3, va1, vb2, vl); + vres2 = VFNMSACVV_FLOAT(vres2, va1, vb3, vl); + vres3 = VFNMSACVV_FLOAT(vres3, va0, vb3, vl); + +#endif + ptrba += vl * 2; + ptrbb += vl * 4; + } + v_m1_res0 = VFREDSUMVS_FLOAT(v_m1_res0, vres0, v_z0, vlmax); + v_m1_res1 = VFREDSUMVS_FLOAT(v_m1_res1, vres1, v_z0, vlmax); + res0 = VFMVFS_FLOAT_M1(v_m1_res0); + res1 = VFMVFS_FLOAT_M1(v_m1_res1); + C0[0] = res0 * alphar - res1 * alphai; + C0[1] = res1 * alphar + res0 * alphai; + + v_m1_res0 = VFREDSUMVS_FLOAT(v_m1_res0, vres2, v_z0, vlmax); + v_m1_res1 = VFREDSUMVS_FLOAT(v_m1_res1, vres3, v_z0, vlmax); + res0 = VFMVFS_FLOAT_M1(v_m1_res0); + res1 = VFMVFS_FLOAT_M1(v_m1_res1); + C1[0] = res0 * alphar - res1 * alphai; + C1[1] = res1 * alphar + res0 * alphai; + +#if ( defined(LEFT) && defined(TRANSA)) || \ + (!defined(LEFT) && !defined(TRANSA)) + temp = bk - off; +#ifdef LEFT + temp -= 1; +#else + temp -= 2; +#endif + ptrba += temp*2; + ptrbb += temp*2*2; +#endif +#ifdef LEFT + off += 1; +#endif + C0 = C0+2; + C1 = C1+2; + } +#if defined(TRMMKERNEL) && !defined(LEFT) + off += 2; +#endif + k = (bk<<2); + bb = bb+k; + i = (ldc<<2); + C = C+i; + } + + if (bn & 1) + { + C0 = C; +#if defined(TRMMKERNEL) && defined(LEFT) + off = offset; +#endif + ptrba = ba; + + for (i = bm/2; i > 0; i--) + { +#if (defined(LEFT) && defined(TRANSA)) || (!defined(LEFT) && !defined(TRANSA)) + ptrbb = bb; +#else + ptrba += off*2*2; + ptrbb = bb+off*2; +#endif + vres0 = VFMVVF_FLOAT(0.0, vlmax); + vres1 = VFMVVF_FLOAT(0.0, vlmax); + vres2 = VFMVVF_FLOAT(0.0, vlmax); + vres3 = VFMVVF_FLOAT(0.0, vlmax); +#if (defined(LEFT) && !defined(TRANSA)) || (!defined(LEFT) && defined(TRANSA)) + temp = bk - off; +#elif defined(LEFT) + temp = off + 2; +#else + temp = off + 1; +#endif + + for (k = temp; k > 0; k -= vl) + { + vl = VSETVL(k); + VLSEG4_FLOAT(&va0, &va1, &va2, &va3, ptrba, vl); + VLSEG2_FLOAT(&vb0, &vb1, ptrbb, vl); + +#if defined(NN) || defined(NT) || defined(TN) || defined(TT) + vres0 = VFMACCVV_FLOAT(vres0, va0, vb0, vl); + vres1 = VFMACCVV_FLOAT(vres1, va1, vb0, vl); + vres0 = VFNMSACVV_FLOAT(vres0, va1, vb1, vl); + vres1 = VFMACCVV_FLOAT(vres1, va0, vb1, vl); + + vres2 = VFMACCVV_FLOAT(vres2, va2, vb0, vl); + vres3 = VFMACCVV_FLOAT(vres3, va3, vb0, vl); + vres2 = VFNMSACVV_FLOAT(vres2, va3, vb1, vl); + vres3 = VFMACCVV_FLOAT(vres3, va2, vb1, vl); +#endif +#if defined(NR) || defined(NC) || defined(TR) || defined(TC) + vres0 = VFMACCVV_FLOAT(vres0, va0, vb0, vl); + vres1 = VFMACCVV_FLOAT(vres1, va1, vb0, vl); + vres0 = VFMACCVV_FLOAT(vres0, va1, vb1, vl); + vres1 = VFNMSACVV_FLOAT(vres1, va0, vb1, vl); + + vres2 = VFMACCVV_FLOAT(vres2, va2, vb0, vl); + vres3 = VFMACCVV_FLOAT(vres3, va3, vb0, vl); + vres2 = VFMACCVV_FLOAT(vres2, va3, vb1, vl); + vres3 = VFNMSACVV_FLOAT(vres3, va2, vb1, vl); +#endif +#if defined(RN) || defined(RT) || defined(CN) || defined(CT) + vres0 = VFMACCVV_FLOAT(vres0, va0, vb0, vl); + vres1 = VFNMSACVV_FLOAT(vres1, va1, vb0, vl); + vres0 = VFMACCVV_FLOAT(vres0, va1, vb1, vl); + vres1 = VFMACCVV_FLOAT(vres1, va0, vb1, vl); + + vres2 = VFMACCVV_FLOAT(vres2, va2, vb0, vl); + vres3 = VFNMSACVV_FLOAT(vres3, va3, vb0, vl); + vres2 = VFMACCVV_FLOAT(vres2, va3, vb1, vl); + vres3 = VFMACCVV_FLOAT(vres3, va2, vb1, vl); + +#endif +#if defined(RR) || defined(RC) || defined(CR) || defined(CC) + vres0 = VFMACCVV_FLOAT(vres0, va0, vb0, vl); + vres1 = VFNMSACVV_FLOAT(vres1, va1, vb0, vl); + vres0 = VFNMSACVV_FLOAT(vres0, va1, vb1, vl); + vres1 = VFNMSACVV_FLOAT(vres1, va0, vb1, vl); + + vres2 = VFMACCVV_FLOAT(vres2, va2, vb0, vl); + vres3 = VFNMSACVV_FLOAT(vres3, va3, vb0, vl); + vres2 = VFNMSACVV_FLOAT(vres2, va3, vb1, vl); + vres3 = VFNMSACVV_FLOAT(vres3, va2, vb1, vl); + +#endif + ptrba += vl * 4; + ptrbb += vl * 2; + } + v_m1_res0 = VFREDSUMVS_FLOAT(v_m1_res0, vres0, v_z0, vlmax); + v_m1_res1 = VFREDSUMVS_FLOAT(v_m1_res1, vres1, v_z0, vlmax); + res0 = VFMVFS_FLOAT_M1(v_m1_res0); + res1 = VFMVFS_FLOAT_M1(v_m1_res1); + C0[0] = res0 * alphar - res1 * alphai; + C0[1] = res1 * alphar + res0 * alphai; + + v_m1_res0 = VFREDSUMVS_FLOAT(v_m1_res0, vres2, v_z0, vlmax); + v_m1_res1 = VFREDSUMVS_FLOAT(v_m1_res1, vres3, v_z0, vlmax); + res0 = VFMVFS_FLOAT_M1(v_m1_res0); + res1 = VFMVFS_FLOAT_M1(v_m1_res1); + C0[2] = res0 * alphar - res1 * alphai; + C0[3] = res1 * alphar + res0 * alphai; + +#if ( defined(LEFT) && defined(TRANSA)) || \ + (!defined(LEFT) && !defined(TRANSA)) + temp = bk-off; +#ifdef LEFT + temp -= 2; +#else + temp -= 1; +#endif + ptrba += temp*2*2; + ptrbb += temp*2; +#endif +#ifdef LEFT + off += 2; +#endif + C0 = C0+4; + } + + if (bm & 1) + { +#if (defined(LEFT) && defined(TRANSA)) || (!defined(LEFT) && !defined(TRANSA)) + ptrbb = bb; +#else + ptrba += off*2; + ptrbb = bb + off*2; +#endif + vres0 = VFMVVF_FLOAT(0.0, vlmax); + vres1 = VFMVVF_FLOAT(0.0, vlmax); + +#if (defined(LEFT) && !defined(TRANSA)) || (!defined(LEFT) && defined(TRANSA)) + temp = bk-off; +#elif defined(LEFT) + temp = off + 1; +#else + temp = off + 1; +#endif + + for (k = temp; k > 0; k -= vl) + { + vl = VSETVL(k); + VLSEG2_FLOAT(&va0, &va1, ptrba, vl); + VLSEG2_FLOAT(&vb0, &vb1, ptrbb, vl); + +#if defined(NN) || defined(NT) || defined(TN) || defined(TT) + vres0 = VFMACCVV_FLOAT(vres0, va0, vb0, vl); + vres1 = VFMACCVV_FLOAT(vres1, va1, vb0, vl); + vres0 = VFNMSACVV_FLOAT(vres0, va1, vb1, vl); + vres1 = VFMACCVV_FLOAT(vres1, va0, vb1, vl); + +#endif +#if defined(NR) || defined(NC) || defined(TR) || defined(TC) + vres0 = VFMACCVV_FLOAT(vres0, va0, vb0, vl); + vres1 = VFMACCVV_FLOAT(vres1, va1, vb0, vl); + vres0 = VFMACCVV_FLOAT(vres0, va1, vb1, vl); + vres1 = VFNMSACVV_FLOAT(vres1, va0, vb1, vl); + +#endif +#if defined(RN) || defined(RT) || defined(CN) || defined(CT) + vres0 = VFMACCVV_FLOAT(vres0, va0, vb0, vl); + vres1 = VFNMSACVV_FLOAT(vres1, va1, vb0, vl); + vres0 = VFMACCVV_FLOAT(vres0, va1, vb1, vl); + vres1 = VFMACCVV_FLOAT(vres1, va0, vb1, vl); + +#endif +#if defined(RR) || defined(RC) || defined(CR) || defined(CC) + vres0 = VFMACCVV_FLOAT(vres0, va0, vb0, vl); + vres1 = VFNMSACVV_FLOAT(vres1, va1, vb0, vl); + vres0 = VFNMSACVV_FLOAT(vres0, va1, vb1, vl); + vres1 = VFNMSACVV_FLOAT(vres1, va0, vb1, vl); + +#endif + ptrba += vl * 2; + ptrbb += vl * 2; + + } + + v_m1_res0 = VFREDSUMVS_FLOAT(v_m1_res0, vres0, v_z0, vlmax); + v_m1_res1 = VFREDSUMVS_FLOAT(v_m1_res1, vres1, v_z0, vlmax); + res0 = VFMVFS_FLOAT_M1(v_m1_res0); + res1 = VFMVFS_FLOAT_M1(v_m1_res1); + + C0[0] = res0 * alphar - res1 * alphai; + C0[1] = res1 * alphar + res0 * alphai; + +#if ( defined(LEFT) && defined(TRANSA)) || \ + (!defined(LEFT) && !defined(TRANSA)) + temp = bk - off; +#ifdef LEFT + temp -= 1; +#else + temp -= 1; +#endif + ptrba += temp*2; + ptrbb += temp*2; + +#endif +#ifdef LEFT + off += 1; +#endif + C0 = C0+2; + } + k = (bk<<1); + bb = bb+k; + i = (ldc<<1); + C = C+i; + } + return 0; +} diff --git a/param.h b/param.h index 514b13a3a..62b675d6c 100644 --- a/param.h +++ b/param.h @@ -3038,6 +3038,50 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #endif +#if defined(x280) +#define GEMM_DEFAULT_OFFSET_A 0 +#define GEMM_DEFAULT_OFFSET_B 0 +#define GEMM_DEFAULT_ALIGN 0x03fffUL + +#define SGEMM_DEFAULT_UNROLL_M 16 // 4 // 16 // 2 +#define SGEMM_DEFAULT_UNROLL_N 8// 4 // 4 // 2 + +/* SGEMM_UNROLL_MN is calculated as max(SGEMM_UNROLL_M, SGEMM_UNROLL_N) + * Since we don't define SGEMM_UNROLL_M correctly we have to manually set this macro. + * If VLMAX size is ever more than 1024, this should be increased also. */ +#define SGEMM_DEFAULT_UNROLL_MN 32 + +#define DGEMM_DEFAULT_UNROLL_M 16 //2 // 8 +#define DGEMM_DEFAULT_UNROLL_N 8 //2 // 4 +#define DGEMM_DEFAULT_UNROLL_MN 32 + +#define CGEMM_DEFAULT_UNROLL_M 2 +#define CGEMM_DEFAULT_UNROLL_N 2 + +#define ZGEMM_DEFAULT_UNROLL_M 2 +#define ZGEMM_DEFAULT_UNROLL_N 2 + +#define SGEMM_DEFAULT_P 160 +#define DGEMM_DEFAULT_P 160 +#define CGEMM_DEFAULT_P 96 +#define ZGEMM_DEFAULT_P 64 + +#define SGEMM_DEFAULT_Q 240 +#define DGEMM_DEFAULT_Q 128 +#define CGEMM_DEFAULT_Q 120 +#define ZGEMM_DEFAULT_Q 120 + +#define SGEMM_DEFAULT_R 12288 +#define DGEMM_DEFAULT_R 8192 +#define CGEMM_DEFAULT_R 4096 +#define ZGEMM_DEFAULT_R 4096 + +#define SYMV_P 16 + +#define GEMM_DEFAULT_OFFSET_A 0 +#define GEMM_DEFAULT_OFFSET_B 0 + +#endif #ifdef C910V #define GEMM_DEFAULT_OFFSET_A 0 #define GEMM_DEFAULT_OFFSET_B 0 From 5d0d1c555195a391fe5d029427dfbf7b942ecdf9 Mon Sep 17 00:00:00 2001 From: Heller Zheng Date: Tue, 15 Nov 2022 18:22:21 -0800 Subject: [PATCH 004/311] Remove redundant files --- Makefile.install | 5 - kernel/riscv64/KERNEL.x280 | 36 +- kernel/riscv64/gemm_ncopy_2_rvv.c | 92 --- kernel/riscv64/gemm_ncopy_4_rvv.c | 123 ---- kernel/riscv64/gemm_tcopy_2_rvv.c | 108 ---- kernel/riscv64/gemm_tcopy_4_rvv.c | 236 -------- kernel/riscv64/gemmkernel_2x2_rvv.c | 214 ------- kernel/riscv64/gemmkernel_4x4_rvv.c | 508 ---------------- kernel/riscv64/trmmkernel_2x2_rvv.c | 342 ----------- kernel/riscv64/trmmkernel_4x4_rvv.c | 881 ---------------------------- 10 files changed, 2 insertions(+), 2543 deletions(-) delete mode 100644 kernel/riscv64/gemm_ncopy_2_rvv.c delete mode 100644 kernel/riscv64/gemm_ncopy_4_rvv.c delete mode 100644 kernel/riscv64/gemm_tcopy_2_rvv.c delete mode 100644 kernel/riscv64/gemm_tcopy_4_rvv.c delete mode 100644 kernel/riscv64/gemmkernel_2x2_rvv.c delete mode 100644 kernel/riscv64/gemmkernel_4x4_rvv.c delete mode 100644 kernel/riscv64/trmmkernel_2x2_rvv.c delete mode 100644 kernel/riscv64/trmmkernel_4x4_rvv.c diff --git a/Makefile.install b/Makefile.install index f1adaa271..168d08f72 100644 --- a/Makefile.install +++ b/Makefile.install @@ -8,7 +8,6 @@ PREFIX ?= /opt/OpenBLAS OPENBLAS_INCLUDE_DIR := $(PREFIX)/include OPENBLAS_LIBRARY_DIR := $(PREFIX)/lib OPENBLAS_BINARY_DIR := $(PREFIX)/bin -OPENBLAS_RELEASE_DIR := $(PREFIX)/release OPENBLAS_BUILD_DIR := $(CURDIR) OPENBLAS_CMAKE_DIR := $(OPENBLAS_LIBRARY_DIR)/cmake/$(LIBSONAMEBASE) OPENBLAS_CMAKE_CONFIG := OpenBLASConfig.cmake @@ -39,7 +38,6 @@ install : lib.grd @-mkdir -p "$(DESTDIR)$(OPENBLAS_INCLUDE_DIR)" @-mkdir -p "$(DESTDIR)$(OPENBLAS_LIBRARY_DIR)" @-mkdir -p "$(DESTDIR)$(OPENBLAS_BINARY_DIR)" - @-mkdir -p "$(DESTDIR)$(OPENBLAS_RELEASE_DIR)" @-mkdir -p "$(DESTDIR)$(OPENBLAS_CMAKE_DIR)" @-mkdir -p "$(DESTDIR)$(OPENBLAS_PKGCONFIG_DIR)" @echo Generating openblas_config.h in $(DESTDIR)$(OPENBLAS_INCLUDE_DIR) @@ -204,8 +202,5 @@ endif @echo " endif ()" >> "$(DESTDIR)$(OPENBLAS_CMAKE_DIR)/$(OPENBLAS_CMAKE_CONFIG_VERSION)" @echo "endif ()" >> "$(DESTDIR)$(OPENBLAS_CMAKE_DIR)/$(OPENBLAS_CMAKE_CONFIG_VERSION)" @echo Install OK! -#Generating release tar - @echo Generating $(OPENBLAS_RELEASE_DIR)/$(basename $(LIBNAME)).tar.gz - @tar -cvz --file=$(OPENBLAS_RELEASE_DIR)/$(basename $(LIBNAME)).tar.gz --directory=$(PREFIX) --exclude=release . diff --git a/kernel/riscv64/KERNEL.x280 b/kernel/riscv64/KERNEL.x280 index 2eb60f2b4..4d64354fb 100644 --- a/kernel/riscv64/KERNEL.x280 +++ b/kernel/riscv64/KERNEL.x280 @@ -122,23 +122,7 @@ CTRMMKERNEL = ztrmmkernel_2x2_rvv.c ZTRMMKERNEL = ztrmmkernel_2x2_rvv.c # SGEMM_UNROLL_N set in params.h -ifeq ($(SGEMM_UNROLL_N), 2) -SGEMMKERNEL = gemmkernel_2x2_rvv.c -SGEMMONCOPY = gemm_ncopy_2_rvv.c -SGEMMOTCOPY = gemm_tcopy_2_rvv.c -SGEMMONCOPYOBJ = sgemm_oncopy.o -SGEMMOTCOPYOBJ = sgemm_otcopy.o - -STRMMKERNEL = trmmkernel_2x2_rvv.c -else ifeq ($(SGEMM_UNROLL_N), 4) -SGEMMKERNEL = gemmkernel_4x4_rvv.c -SGEMMONCOPY = gemm_ncopy_4_rvv.c -SGEMMOTCOPY = ../generic/gemm_tcopy_4.c -SGEMMONCOPYOBJ = sgemm_oncopy.o -SGEMMOTCOPYOBJ = sgemm_otcopy.o - -STRMMKERNEL = trmmkernel_4x4_rvv.c -else ifeq ($(SGEMM_UNROLL_N), 8) +ifeq ($(SGEMM_UNROLL_N), 8) # UNROLL_M is VLMAX SGEMMKERNEL = gemmkernel_rvv_v1x8.c SGEMMINCOPY = gemm_ncopy_rvv_v1.c @@ -162,23 +146,7 @@ SSYMMLCOPY_M = symm_lcopy_rvv_v1.c endif # SGEMM_UNROLL_N set in params.h -ifeq ($(DGEMM_UNROLL_N), 2) -DGEMMKERNEL = gemmkernel_2x2_rvv.c -DGEMMONCOPY = gemm_ncopy_2_rvv.c -DGEMMOTCOPY = gemm_tcopy_2_rvv.c -DGEMMONCOPYOBJ = dgemm_oncopy.o -DGEMMOTCOPYOBJ = dgemm_otcopy.o - -DTRMMKERNEL = trmmkernel_2x2_rvv.c -else ifeq ($(DGEMM_UNROLL_N), 4) -DGEMMKERNEL = gemmkernel_4x4_rvv.c -DGEMMONCOPY = gemm_ncopy_4_rvv.c -DGEMMOTCOPY = ../generic/gemm_tcopy_4.c -DGEMMONCOPYOBJ = dgemm_oncopy.o -DGEMMOTCOPYOBJ = dgemm_otcopy.o - -DTRMMKERNEL = trmmkernel_4x4_rvv.c -else ifeq ($(DGEMM_UNROLL_N), 8) +ifeq ($(DGEMM_UNROLL_N), 8) # UNROLL_M is VLMAX DGEMMKERNEL = gemmkernel_rvv_v1x8.c DGEMMINCOPY = gemm_ncopy_rvv_v1.c diff --git a/kernel/riscv64/gemm_ncopy_2_rvv.c b/kernel/riscv64/gemm_ncopy_2_rvv.c deleted file mode 100644 index 5f55bc349..000000000 --- a/kernel/riscv64/gemm_ncopy_2_rvv.c +++ /dev/null @@ -1,92 +0,0 @@ -/*************************************************************************** -Copyright (c) 2022, The OpenBLAS Project -All rights reserved. -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are -met: -1. Redistributions of source code must retain the above copyright -notice, this list of conditions and the following disclaimer. -2. 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. -3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" - -#if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m4(n) -#define FLOAT_V_T vfloat32m4_t -#define VLEV_FLOAT vle32_v_f32m4 -#define VSEV_FLOAT vse32_v_f32m4 -#define VSSEG2_FLOAT vsseg2e32_v_f32m4 -#else -#define VSETVL(n) vsetvl_e64m4(n) -#define FLOAT_V_T vfloat64m4_t -#define VLEV_FLOAT vle64_v_f64m4 -#define VSEV_FLOAT vse64_v_f64m4 -#define VSSEG2_FLOAT vsseg2e64_v_f64m4 -#endif - -// Optimizes the implementation in ../generic/gemm_ncopy_2.c - -int CNAME(BLASLONG m, BLASLONG n, IFLOAT *a, BLASLONG lda, IFLOAT *b) -{ - BLASLONG i, j; - IFLOAT *a_offset, *a_offset1, *a_offset2; - IFLOAT *b_offset; - FLOAT_V_T v1, v2; - size_t vl; - - //fprintf(stderr, "gemm_ncopy_2 m=%ld n=%ld lda=%ld\n", m, n, lda); // KU - - a_offset = a; - b_offset = b; - - for(j = (n >> 1); j > 0; j--) { - - a_offset1 = a_offset; - a_offset2 = a_offset + lda; - a_offset += 2 * lda; - - for(i = m; i > 0; i -= vl) { - vl = VSETVL(i); - - v1 = VLEV_FLOAT(a_offset1, vl); - v2 = VLEV_FLOAT(a_offset2, vl); - VSSEG2_FLOAT(b_offset, v1, v2, vl); - - a_offset1 += vl; - a_offset2 += vl; - b_offset += vl*2; - } - } - - if (n & 1) { - - for(i = m; i > 0; i -= vl) { - vl = VSETVL(i); - - v1 = VLEV_FLOAT(a_offset, vl); - VSEV_FLOAT(b_offset, v1, vl); - - a_offset += vl; - b_offset += vl; - } - } - - return 0; -} diff --git a/kernel/riscv64/gemm_ncopy_4_rvv.c b/kernel/riscv64/gemm_ncopy_4_rvv.c deleted file mode 100644 index 4d4efe4c9..000000000 --- a/kernel/riscv64/gemm_ncopy_4_rvv.c +++ /dev/null @@ -1,123 +0,0 @@ -/*************************************************************************** -Copyright (c) 2022, The OpenBLAS Project -All rights reserved. -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are -met: -1. Redistributions of source code must retain the above copyright -notice, this list of conditions and the following disclaimer. -2. 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. -3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" - -#if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m2(n) -#define FLOAT_V_T vfloat32m2_t -#define VLEV_FLOAT vle32_v_f32m2 -#define VSEV_FLOAT vse32_v_f32m2 -#define VSSEG2_FLOAT vsseg2e32_v_f32m2 -#define VSSEG4_FLOAT vsseg4e32_v_f32m2 -#else -#define VSETVL(n) vsetvl_e64m2(n) -#define FLOAT_V_T vfloat64m2_t -#define VLEV_FLOAT vle64_v_f64m2 -#define VSEV_FLOAT vse64_v_f64m2 -#define VSSEG2_FLOAT vsseg2e64_v_f64m2 -#define VSSEG4_FLOAT vsseg4e64_v_f64m2 -#endif - -// Optimizes the implementation in ../generic/gemm_ncopy_4.c - -int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, FLOAT *b) -{ - BLASLONG i, j; - - FLOAT *a_offset, *a_offset1, *a_offset2, *a_offset3, *a_offset4; - FLOAT *b_offset; - - FLOAT_V_T v1, v2, v3, v4; - size_t vl; - - //fprintf(stderr, "gemm_ncopy_4 m=%ld n=%ld lda=%ld\n", m, n, lda); - - a_offset = a; - b_offset = b; - - for(j = (n >> 2); j > 0; j--) { - a_offset1 = a_offset; - a_offset2 = a_offset1 + lda; - a_offset3 = a_offset2 + lda; - a_offset4 = a_offset3 + lda; - a_offset += 4 * lda; - - for(i = m; i > 0; i -= vl) { - vl = VSETVL(i); - - v1 = VLEV_FLOAT(a_offset1, vl); - v2 = VLEV_FLOAT(a_offset2, vl); - v3 = VLEV_FLOAT(a_offset3, vl); - v4 = VLEV_FLOAT(a_offset4, vl); - - VSSEG4_FLOAT(b_offset, v1, v2, v3, v4, vl); - - a_offset1 += vl; - a_offset2 += vl; - a_offset3 += vl; - a_offset4 += vl; - b_offset += vl*4; - } - } - - if (n & 2) { - a_offset1 = a_offset; - a_offset2 = a_offset1 + lda; - a_offset += 2 * lda; - - for(i = m; i > 0; i -= vl) { - vl = VSETVL(i); - - v1 = VLEV_FLOAT(a_offset1, vl); - v2 = VLEV_FLOAT(a_offset2, vl); - - VSSEG2_FLOAT(b_offset, v1, v2, vl); - - a_offset1 += vl; - a_offset2 += vl; - b_offset += vl*2; - } - } - - if (n & 1) { - a_offset1 = a_offset; - - for(i = m; i > 0; i -= vl) { - vl = VSETVL(i); - - v1 = VLEV_FLOAT(a_offset1, vl); - - VSEV_FLOAT(b_offset, v1, vl); - - a_offset1 += vl; - b_offset += vl; - } - } - - return 0; -} diff --git a/kernel/riscv64/gemm_tcopy_2_rvv.c b/kernel/riscv64/gemm_tcopy_2_rvv.c deleted file mode 100644 index 963e1be69..000000000 --- a/kernel/riscv64/gemm_tcopy_2_rvv.c +++ /dev/null @@ -1,108 +0,0 @@ -/*************************************************************************** -Copyright (c) 2022, The OpenBLAS Project -All rights reserved. -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are -met: -1. Redistributions of source code must retain the above copyright -notice, this list of conditions and the following disclaimer. -2. 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. -3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" - -#if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m2(n) -#define FLOAT_V_T vfloat32m2_t -#define VLSEG2_FLOAT vlseg2e32_v_f32m2 -#define VSSSEG2_FLOAT vssseg2e32_v_f32m2 -#define VSSSEG4_FLOAT vssseg4e32_v_f32m2 -#else -#define VSETVL(n) vsetvl_e64m2(n) -#define FLOAT_V_T vfloat64m2_t -#define VLSEG2_FLOAT vlseg2e64_v_f64m2 -#define VSSSEG2_FLOAT vssseg2e64_v_f64m2 -#define VSSSEG4_FLOAT vssseg4e64_v_f64m2 -#endif - -// Optimizes the implementation in ../generic/gemm_tcopy_2.c - -int CNAME(BLASLONG m, BLASLONG n, IFLOAT *a, BLASLONG lda, IFLOAT *b) -{ - BLASLONG i, j; - IFLOAT *a_offset, *a_offset1, *a_offset2; - IFLOAT *b_offset, *b_offset1, *b_offset2; - FLOAT_V_T v1a, v1b, v2a, v2b; - size_t vl; - - //fprintf(stderr, "gemm_tcopy_2 m=%ld n=%ld lda=%ld\n", m, n, lda); // KU - - a_offset = a; - b_offset = b; - b_offset2 = b + m * (n & ~1); - - for(i = (m >> 1); i > 0; i--) { - - a_offset1 = a_offset; - a_offset2 = a_offset + lda; - a_offset += 2 * lda; - - b_offset1 = b_offset; - b_offset += 4; - - for(j = (n >> 1); j > 0; j -= vl) { - vl = VSETVL(j); - - VLSEG2_FLOAT(&v1a, &v1b, a_offset1, vl); - VLSEG2_FLOAT(&v2a, &v2b, a_offset2, vl); - - VSSSEG4_FLOAT(b_offset1, m*2*sizeof(FLOAT), v1a, v1b, v2a, v2b, vl); - - a_offset1 += vl * 2; - a_offset2 += vl * 2; - b_offset1 += vl * m * 2; - } - - if (n & 1) { - *(b_offset2 + 0) = *(a_offset1 + 0); - *(b_offset2 + 1) = *(a_offset2 + 0); - b_offset2 += 2; - } - } - - if (m & 1) { - - for(j = (n >> 1); j > 0; j -= vl) { - vl = VSETVL(j); - - VLSEG2_FLOAT(&v1a, &v1b, a_offset, vl); - - VSSSEG2_FLOAT(b_offset, m*2*sizeof(FLOAT), v1a, v1b, vl); - - a_offset += vl * 2; - b_offset += vl * m * 2; - } - - if (n & 1){ - *(b_offset2 + 0) = *(a_offset + 0); - } - } - - return 0; -} diff --git a/kernel/riscv64/gemm_tcopy_4_rvv.c b/kernel/riscv64/gemm_tcopy_4_rvv.c deleted file mode 100644 index ac9974b24..000000000 --- a/kernel/riscv64/gemm_tcopy_4_rvv.c +++ /dev/null @@ -1,236 +0,0 @@ -/*************************************************************************** -Copyright (c) 2022, The OpenBLAS Project -All rights reserved. -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are -met: -1. Redistributions of source code must retain the above copyright -notice, this list of conditions and the following disclaimer. -2. 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. -3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" - -#if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m2(n) -#define FLOAT_V_T vfloat32m2_t -#define VLSEG2_FLOAT vlseg2e32_v_f32m2 -#define VSSSEG2_FLOAT vssseg2e32_v_f32m2 -#define VSSSEG4_FLOAT vssseg4e32_v_f32m2 -#else -#define VSETVL(n) vsetvl_e64m2(n) -#define FLOAT_V_T vfloat64m2_t -#define VLSEG2_FLOAT vlseg2e64_v_f64m2 -#define VSSSEG2_FLOAT vssseg2e64_v_f64m2 -#define VSSSEG4_FLOAT vssseg4e64_v_f64m2 -#endif - -// Optimizes the implementation in ../generic/gemm_tcopy_4.c - -int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, FLOAT *b) -{ - BLASLONG i, j; - - FLOAT *a_offset, *a_offset1, *a_offset2, *a_offset3, *a_offset4; - FLOAT *b_offset, *b_offset1, *b_offset2, *b_offset3; - FLOAT ctemp1, ctemp2, ctemp3, ctemp4; - FLOAT ctemp5, ctemp6, ctemp7, ctemp8; - FLOAT ctemp9, ctemp10, ctemp11, ctemp12; - FLOAT ctemp13, ctemp14, ctemp15, ctemp16; - - //fprintf(stderr, "gemm_tcopy_4 m=%ld n=%ld lda=%ld\n", m, n, lda); - - a_offset = a; - b_offset = b; - - b_offset2 = b + m * (n & ~3); - b_offset3 = b + m * (n & ~1); - - for(j = (m >> 2); j > 0; j--) { - a_offset1 = a_offset; - a_offset2 = a_offset1 + lda; - a_offset3 = a_offset2 + lda; - a_offset4 = a_offset3 + lda; - a_offset += 4 * lda; - - b_offset1 = b_offset; - b_offset += 16; - - for(i = (n >> 2); i > 0; i--) { - v1 = VLEV_FLOAT(a_offset1, 4); - v2 = VLEV_FLOAT(a_offset2, 4); - v3 = VLEV_FLOAT(a_offset3, 4); - v4 = VLEV_FLOAT(a_offset4, 4); - - a_offset1 += 4; - a_offset2 += 4; - a_offset3 += 4; - a_offset4 += 4; - - VSEV_FLOAT(b_offset1, v1, 4); - VSEV_FLOAT(b_offset2+4, v2, 4); - VSEV_FLOAT(b_offset2+8, v3, 4); - VSEV_FLOAT(b_offset2+12, v4, 4); - - b_offset1 += m * 4; - } - - if (n & 2) { - v1 = VLEV_FLOAT(a_offset1, 2); - v2 = VLEV_FLOAT(a_offset2, 2); - v3 = VLEV_FLOAT(a_offset3, 2); - v4 = VLEV_FLOAT(a_offset4, 2); - - a_offset1 += 2; - a_offset2 += 2; - a_offset3 += 2; - a_offset4 += 2; - - VSEV_FLOAT(b_offset2, v1, 2); - VSEV_FLOAT(b_offset2+2, v2, 2); - VSEV_FLOAT(b_offset2+4, v3, 2); - VSEV_FLOAT(b_offset2+6, v4, 2); - - b_offset2 += 8; - } - - if (n & 1) { - v1 = VLEV_FLOAT(a_offset1, 1); - v2 = VLEV_FLOAT(a_offset2, 1); - v3 = VLEV_FLOAT(a_offset3, 1); - v4 = VLEV_FLOAT(a_offset4, 1); - - VSSEG4_FLOAT(b_offset3, v1, v2, v3, v4, 1); - - b_offset3 += 4; - } - - } - -// TODO cleanup - - if (m & 2){ - a_offset1 = a_offset; - a_offset2 = a_offset1 + lda; - a_offset += 2 * lda; - - b_offset1 = b_offset; - b_offset += 8; - - i = (n >> 2); - if (i > 0){ - do{ - ctemp1 = *(a_offset1 + 0); - ctemp2 = *(a_offset1 + 1); - ctemp3 = *(a_offset1 + 2); - ctemp4 = *(a_offset1 + 3); - - ctemp5 = *(a_offset2 + 0); - ctemp6 = *(a_offset2 + 1); - ctemp7 = *(a_offset2 + 2); - ctemp8 = *(a_offset2 + 3); - - a_offset1 += 4; - a_offset2 += 4; - - *(b_offset1 + 0) = ctemp1; - *(b_offset1 + 1) = ctemp2; - *(b_offset1 + 2) = ctemp3; - *(b_offset1 + 3) = ctemp4; - - *(b_offset1 + 4) = ctemp5; - *(b_offset1 + 5) = ctemp6; - *(b_offset1 + 6) = ctemp7; - *(b_offset1 + 7) = ctemp8; - - b_offset1 += m * 4; - i --; - }while(i > 0); - } - - if (n & 2) { - ctemp1 = *(a_offset1 + 0); - ctemp2 = *(a_offset1 + 1); - - ctemp3 = *(a_offset2 + 0); - ctemp4 = *(a_offset2 + 1); - - a_offset1 += 2; - a_offset2 += 2; - - *(b_offset2 + 0) = ctemp1; - *(b_offset2 + 1) = ctemp2; - *(b_offset2 + 2) = ctemp3; - *(b_offset2 + 3) = ctemp4; - - b_offset2 += 4; - } - - if (n & 1) { - ctemp1 = *(a_offset1 + 0); - ctemp2 = *(a_offset2 + 0); - - *(b_offset3 + 0) = ctemp1; - *(b_offset3 + 1) = ctemp2; - b_offset3 += 2; - } - } - - if (m & 1){ - a_offset1 = a_offset; - b_offset1 = b_offset; - - i = (n >> 2); - if (i > 0){ - do{ - ctemp1 = *(a_offset1 + 0); - ctemp2 = *(a_offset1 + 1); - ctemp3 = *(a_offset1 + 2); - ctemp4 = *(a_offset1 + 3); - - a_offset1 += 4; - - *(b_offset1 + 0) = ctemp1; - *(b_offset1 + 1) = ctemp2; - *(b_offset1 + 2) = ctemp3; - *(b_offset1 + 3) = ctemp4; - - b_offset1 += 4 * m; - - i --; - }while(i > 0); - } - - if (n & 2) { - ctemp1 = *(a_offset1 + 0); - ctemp2 = *(a_offset1 + 1); - a_offset1 += 2; - - *(b_offset2 + 0) = ctemp1; - *(b_offset2 + 1) = ctemp2; - } - - if (n & 1) { - ctemp1 = *(a_offset1 + 0); - *(b_offset3 + 0) = ctemp1; - } - } - - return 0; -} diff --git a/kernel/riscv64/gemmkernel_2x2_rvv.c b/kernel/riscv64/gemmkernel_2x2_rvv.c deleted file mode 100644 index ec8961ced..000000000 --- a/kernel/riscv64/gemmkernel_2x2_rvv.c +++ /dev/null @@ -1,214 +0,0 @@ -/*************************************************************************** -Copyright (c) 2022, The OpenBLAS Project -All rights reserved. -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are -met: -1. Redistributions of source code must retain the above copyright -notice, this list of conditions and the following disclaimer. -2. 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. -3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" - -#if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m4(n) -#define VSETVL_MAX vsetvlmax_e32m4() -#define VSETVL_MAX_M1 vsetvlmax_e32m1() -#define FLOAT_V_T vfloat32m4_t -#define FLOAT_V_T_M1 vfloat32m1_t -#define VLEV_FLOAT vle32_v_f32m4 -#define VLSEG2_FLOAT vlseg2e32_v_f32m4 -#define VFMVVF_FLOAT vfmv_v_f_f32m4 -#define VFMACCVF_FLOAT vfmacc_vf_f32m4 -#define VFMACCVV_FLOAT vfmacc_vv_f32m4 -#define VFREDSUMVS_FLOAT vfredusum_vs_f32m4_f32m1 -#define VFMVVF_FLOAT_M1 vfmv_v_f_f32m1 -#define VFMVFS_FLOAT_M1 vfmv_f_s_f32m1_f32 -#else -#define VSETVL(n) vsetvl_e64m4(n) -#define VSETVL_MAX vsetvlmax_e64m4() -#define VSETVL_MAX_M1 vsetvlmax_e64m1() -#define FLOAT_V_T vfloat64m4_t -#define FLOAT_V_T_M1 vfloat64m1_t -#define VLEV_FLOAT vle64_v_f64m4 -#define VLSEG2_FLOAT vlseg2e64_v_f64m4 -#define VFMVVF_FLOAT vfmv_v_f_f64m4 -#define VFMACCVF_FLOAT vfmacc_vf_f64m4 -#define VFMACCVV_FLOAT vfmacc_vv_f64m4 -#define VFREDSUMVS_FLOAT vfredusum_vs_f64m4_f64m1 -#define VFMVVF_FLOAT_M1 vfmv_v_f_f64m1 -#define VFMVFS_FLOAT_M1 vfmv_f_s_f64m1_f64 -#endif - -// Optimizes the implementation in ../generic/gemm_kernel_2x2.c - -int CNAME(BLASLONG bm, BLASLONG bn, BLASLONG bk, FLOAT alpha, IFLOAT* ba, IFLOAT* bb, FLOAT* C, BLASLONG ldc -#ifdef TRMMKERNEL - ,BLASLONG offset -#endif - ) -{ - BLASLONG i,j,k; - FLOAT *C0,*C1; - IFLOAT *ptrba,*ptrbb; - - //fprintf(stderr, "gemm_kernel_2x2 bm=%ld bn=%ld bk=%ld alpha=%f ldc=%ld\n", bm, bn, bk, alpha, ldc); - - FLOAT_V_T va0, va1, vb0, vb1; - FLOAT_V_T vres0, vres1, vres2, vres3; - FLOAT_V_T_M1 vsum0, vsum1, vsum2, vsum3; - FLOAT_V_T_M1 v_z0; - - v_z0 = VFMVVF_FLOAT_M1(0, VSETVL_MAX_M1); - size_t vlmax = VSETVL_MAX; - size_t vl; - - for (j = bn/2; j > 0; j--) { - C0 = C; - C1 = C0 + ldc; - ptrba = ba; - - for (i = bm/2; i > 0; i--) { - ptrbb = bb; - - vres0 = VFMVVF_FLOAT(0.0, vlmax); - vres1 = VFMVVF_FLOAT(0.0, vlmax); - vres2 = VFMVVF_FLOAT(0.0, vlmax); - vres3 = VFMVVF_FLOAT(0.0, vlmax); - - for (k = bk; k > 0; k -= vl) { - vl = VSETVL(k); - - VLSEG2_FLOAT(&va0, &va1, ptrba, vl); - VLSEG2_FLOAT(&vb0, &vb1, ptrbb, vl); - - vres0 = VFMACCVV_FLOAT(vres0, va0, vb0, vl); - vres1 = VFMACCVV_FLOAT(vres1, va1, vb0, vl); - vres2 = VFMACCVV_FLOAT(vres2, va0, vb1, vl); - vres3 = VFMACCVV_FLOAT(vres3, va1, vb1, vl); - - ptrba += vl*2; - ptrbb += vl*2; - } - - vsum0 = VFREDSUMVS_FLOAT(vsum0, vres0, v_z0, vlmax); - vsum1 = VFREDSUMVS_FLOAT(vsum1, vres1, v_z0, vlmax); - vsum2 = VFREDSUMVS_FLOAT(vsum2, vres2, v_z0, vlmax); - vsum3 = VFREDSUMVS_FLOAT(vsum3, vres3, v_z0, vlmax); - C0[0] += alpha * VFMVFS_FLOAT_M1(vsum0); - C0[1] += alpha * VFMVFS_FLOAT_M1(vsum1); - C1[0] += alpha * VFMVFS_FLOAT_M1(vsum2); - C1[1] += alpha * VFMVFS_FLOAT_M1(vsum3); - - C0 += 2; - C1 += 2; - } - - if(bm & 1) { - ptrbb = bb; - - vres0 = VFMVVF_FLOAT(0.0, vlmax); - vres1 = VFMVVF_FLOAT(0.0, vlmax); - - for (k = bk; k > 0; k -= vl) { - vl = VSETVL(k); - - va0 = VLEV_FLOAT(ptrba, vl); - VLSEG2_FLOAT(&vb0, &vb1, ptrbb, vl); - - vres0 = VFMACCVV_FLOAT(vres0, va0, vb0, vl); - vres1 = VFMACCVV_FLOAT(vres1, va0, vb1, vl); - - ptrba += vl; - ptrbb += vl*2; - } - - vsum0 = VFREDSUMVS_FLOAT(vsum0, vres0, v_z0, vlmax); - vsum1 = VFREDSUMVS_FLOAT(vsum1, vres1, v_z0, vlmax); - C0[0] += alpha * VFMVFS_FLOAT_M1(vsum0); - C1[0] += alpha * VFMVFS_FLOAT_M1(vsum1); - - C0 += 1; - C1 += 1; - } - - bb += (bk<<1); - C += (ldc<<1); - } - - if(bn & 1) { - C0 = C; - ptrba = ba; - for (i = bm/2; i > 0; i--) { - ptrbb = bb; - - vres0 = VFMVVF_FLOAT(0.0, vlmax); - vres1 = VFMVVF_FLOAT(0.0, vlmax); - - for (k = bk; k > 0; k -= vl) { - vl = VSETVL(k); - - VLSEG2_FLOAT(&va0, &va1, ptrba, vl); - vb0 = VLEV_FLOAT(ptrbb, vl); - - vres0 = VFMACCVV_FLOAT(vres0, va0, vb0, vl); - vres1 = VFMACCVV_FLOAT(vres1, va1, vb0, vl); - - ptrba += vl*2; - ptrbb += vl; - } - - vsum0 = VFREDSUMVS_FLOAT(vsum0, vres0, v_z0, vlmax); - vsum1 = VFREDSUMVS_FLOAT(vsum1, vres1, v_z0, vlmax); - C0[0] += alpha * VFMVFS_FLOAT_M1(vsum0); - C0[1] += alpha * VFMVFS_FLOAT_M1(vsum1); - - C0 += 2; - } - - if(bm & 1) { - ptrbb = bb; - - vres0 = VFMVVF_FLOAT(0.0, vlmax); - - for (k = bk; k > 0; k -= vl) { - vl = VSETVL(k); - - va0 = VLEV_FLOAT(ptrba, vl); - vb0 = VLEV_FLOAT(ptrbb, vl); - - vres0 = VFMACCVV_FLOAT(vres0, va0, vb0, vl); - - ptrba += vl; - ptrbb += vl; - } - - vsum0 = VFREDSUMVS_FLOAT(vsum0, vres0, v_z0, vlmax); - C0[0] += alpha * VFMVFS_FLOAT_M1(vsum0); - - C0 += 1; - } - - bb += (bk<<0); - C += ldc; - } - - return 0; -} diff --git a/kernel/riscv64/gemmkernel_4x4_rvv.c b/kernel/riscv64/gemmkernel_4x4_rvv.c deleted file mode 100644 index aa58bcc76..000000000 --- a/kernel/riscv64/gemmkernel_4x4_rvv.c +++ /dev/null @@ -1,508 +0,0 @@ -/*************************************************************************** -Copyright (c) 2022, The OpenBLAS Project -All rights reserved. -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are -met: -1. Redistributions of source code must retain the above copyright -notice, this list of conditions and the following disclaimer. -2. 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. -3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" - -#if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m1(n) -#define VSETVL_MAX vsetvlmax_e32m1() -#define VSETVL_MAX_M1 vsetvlmax_e32m1() -#define FLOAT_V_T vfloat32m1_t -#define FLOAT_V_T_M1 vfloat32m1_t -#define VLEV_FLOAT vle32_v_f32m1 -#define VLSEG2_FLOAT vlseg2e32_v_f32m1 -#define VLSEG4_FLOAT vlseg4e32_v_f32m1 -#define VFMVVF_FLOAT vfmv_v_f_f32m1 -#define VFMACCVF_FLOAT vfmacc_vf_f32m1 -#define VFMACCVV_FLOAT vfmacc_vv_f32m1 -#define VFREDSUMVS_FLOAT vfredusum_vs_f32m1_f32m1 -#define VFMVVF_FLOAT_M1 vfmv_v_f_f32m1 -#define VFMVFS_FLOAT_M1 vfmv_f_s_f32m1_f32 -#else -#define VSETVL(n) vsetvl_e64m1(n) -#define VSETVL_MAX vsetvlmax_e64m1() -#define VSETVL_MAX_M1 vsetvlmax_e64m1() -#define FLOAT_V_T vfloat64m1_t -#define FLOAT_V_T_M1 vfloat64m1_t -#define VLEV_FLOAT vle64_v_f64m1 -#define VLSEG2_FLOAT vlseg2e64_v_f64m1 -#define VLSEG4_FLOAT vlseg4e64_v_f64m1 -#define VFMVVF_FLOAT vfmv_v_f_f64m1 -#define VFMACCVF_FLOAT vfmacc_vf_f64m1 -#define VFMACCVV_FLOAT vfmacc_vv_f64m1 -#define VFREDSUMVS_FLOAT vfredusum_vs_f64m1_f64m1 -#define VFMVVF_FLOAT_M1 vfmv_v_f_f64m1 -#define VFMVFS_FLOAT_M1 vfmv_f_s_f64m1_f64 -#endif - -// Optimizes the implementation in ../generic/gemm_kernel_2x2.c - -int CNAME(BLASLONG bm, BLASLONG bn, BLASLONG bk, FLOAT alpha, IFLOAT* ba, IFLOAT* bb, FLOAT* C, BLASLONG ldc -#ifdef TRMMKERNEL - ,BLASLONG offset -#endif - ) -{ - BLASLONG i,j,k; - FLOAT *C0,*C1,*C2,*C3; - IFLOAT *ptrba,*ptrbb; - - //fprintf(stderr, "gemm_kernel_4x4 bm=%ld bn=%ld bk=%ld alpha=%f ldc=%ld\n", bm, bn, bk, alpha, ldc); // KU - - FLOAT_V_T va0, va1, va2, va3; - FLOAT_V_T vb0, vb1, vb2, vb3; - FLOAT_V_T vres0, vres1, vres2, vres3, vres4, vres5, vres6, vres7; - FLOAT_V_T vres8, vres9, vres10, vres11, vres12, vres13, vres14, vres15; - FLOAT_V_T_M1 vsum0, vsum1, vsum2, vsum3; - FLOAT_V_T_M1 v_z0; - - v_z0 = VFMVVF_FLOAT_M1(0, VSETVL_MAX_M1); - size_t vlmax = VSETVL_MAX; - size_t vl; - - for (j = bn/4; j > 0; j--) { - C0 = C; - C1 = C0 + ldc; - C2 = C1 + ldc; - C3 = C2 + ldc; - ptrba = ba; - - for (i = bm/4; i > 0; i--) { - ptrbb = bb; - - vres0 = VFMVVF_FLOAT(0.0, vlmax); - vres1 = VFMVVF_FLOAT(0.0, vlmax); - vres2 = VFMVVF_FLOAT(0.0, vlmax); - vres3 = VFMVVF_FLOAT(0.0, vlmax); - vres4 = VFMVVF_FLOAT(0.0, vlmax); - vres5 = VFMVVF_FLOAT(0.0, vlmax); - vres6 = VFMVVF_FLOAT(0.0, vlmax); - vres7 = VFMVVF_FLOAT(0.0, vlmax); - vres8 = VFMVVF_FLOAT(0.0, vlmax); - vres9 = VFMVVF_FLOAT(0.0, vlmax); - vres10 = VFMVVF_FLOAT(0.0, vlmax); - vres11 = VFMVVF_FLOAT(0.0, vlmax); - vres12 = VFMVVF_FLOAT(0.0, vlmax); - vres13 = VFMVVF_FLOAT(0.0, vlmax); - vres14 = VFMVVF_FLOAT(0.0, vlmax); - vres15 = VFMVVF_FLOAT(0.0, vlmax); - - for (k = bk; k > 0; k -= vl) { - vl = VSETVL(k); - - VLSEG4_FLOAT(&va0, &va1, &va2, &va3, ptrba, vl); - VLSEG4_FLOAT(&vb0, &vb1, &vb2, &vb3, ptrbb, vl); - - vres0 = VFMACCVV_FLOAT(vres0, va0, vb0, vl); - vres1 = VFMACCVV_FLOAT(vres1, va1, vb0, vl); - vres2 = VFMACCVV_FLOAT(vres2, va0, vb1, vl); - vres3 = VFMACCVV_FLOAT(vres3, va1, vb1, vl); - - vres4 = VFMACCVV_FLOAT(vres4, va0, vb2, vl); - vres5 = VFMACCVV_FLOAT(vres5, va1, vb2, vl); - vres6 = VFMACCVV_FLOAT(vres6, va0, vb3, vl); - vres7 = VFMACCVV_FLOAT(vres7, va1, vb3, vl); - - vres8 = VFMACCVV_FLOAT(vres8, va2, vb0, vl); - vres9 = VFMACCVV_FLOAT(vres9, va3, vb0, vl); - vres10 = VFMACCVV_FLOAT(vres10, va2, vb1, vl); - vres11 = VFMACCVV_FLOAT(vres11, va3, vb1, vl); - - vres12 = VFMACCVV_FLOAT(vres12, va2, vb2, vl); - vres13 = VFMACCVV_FLOAT(vres13, va3, vb2, vl); - vres14 = VFMACCVV_FLOAT(vres14, va2, vb3, vl); - vres15 = VFMACCVV_FLOAT(vres15, va3, vb3, vl); - - ptrba += vl*4; - ptrbb += vl*4; - } - - vsum0 = VFREDSUMVS_FLOAT(vsum0, vres0, v_z0, vlmax); - vsum1 = VFREDSUMVS_FLOAT(vsum1, vres1, v_z0, vlmax); - vsum2 = VFREDSUMVS_FLOAT(vsum2, vres8, v_z0, vlmax); - vsum3 = VFREDSUMVS_FLOAT(vsum3, vres9, v_z0, vlmax); - C0[0] += alpha * VFMVFS_FLOAT_M1(vsum0); - C0[1] += alpha * VFMVFS_FLOAT_M1(vsum1); - C0[2] += alpha * VFMVFS_FLOAT_M1(vsum2); - C0[3] += alpha * VFMVFS_FLOAT_M1(vsum3); - - vsum0 = VFREDSUMVS_FLOAT(vsum0, vres2, v_z0, vlmax); - vsum1 = VFREDSUMVS_FLOAT(vsum1, vres3, v_z0, vlmax); - vsum2 = VFREDSUMVS_FLOAT(vsum2, vres10, v_z0, vlmax); - vsum3 = VFREDSUMVS_FLOAT(vsum3, vres11, v_z0, vlmax); - C1[0] += alpha * VFMVFS_FLOAT_M1(vsum0); - C1[1] += alpha * VFMVFS_FLOAT_M1(vsum1); - C1[2] += alpha * VFMVFS_FLOAT_M1(vsum2); - C1[3] += alpha * VFMVFS_FLOAT_M1(vsum3); - - vsum0 = VFREDSUMVS_FLOAT(vsum0, vres4, v_z0, vlmax); - vsum1 = VFREDSUMVS_FLOAT(vsum1, vres5, v_z0, vlmax); - vsum2 = VFREDSUMVS_FLOAT(vsum2, vres12, v_z0, vlmax); - vsum3 = VFREDSUMVS_FLOAT(vsum3, vres13, v_z0, vlmax); - C2[0] += alpha * VFMVFS_FLOAT_M1(vsum0); - C2[1] += alpha * VFMVFS_FLOAT_M1(vsum1); - C2[2] += alpha * VFMVFS_FLOAT_M1(vsum2); - C2[3] += alpha * VFMVFS_FLOAT_M1(vsum3); - - vsum0 = VFREDSUMVS_FLOAT(vsum0, vres6, v_z0, vlmax); - vsum1 = VFREDSUMVS_FLOAT(vsum1, vres7, v_z0, vlmax); - vsum2 = VFREDSUMVS_FLOAT(vsum2, vres14, v_z0, vlmax); - vsum3 = VFREDSUMVS_FLOAT(vsum3, vres15, v_z0, vlmax); - C3[0] += alpha * VFMVFS_FLOAT_M1(vsum0); - C3[1] += alpha * VFMVFS_FLOAT_M1(vsum1); - C3[2] += alpha * VFMVFS_FLOAT_M1(vsum2); - C3[3] += alpha * VFMVFS_FLOAT_M1(vsum3); - - C0 += 4; - C1 += 4; - C2 += 4; - C3 += 4; - } - - if(bm & 2) { - ptrbb = bb; - - vres0 = VFMVVF_FLOAT(0.0, vlmax); - vres1 = VFMVVF_FLOAT(0.0, vlmax); - vres2 = VFMVVF_FLOAT(0.0, vlmax); - vres3 = VFMVVF_FLOAT(0.0, vlmax); - vres4 = VFMVVF_FLOAT(0.0, vlmax); - vres5 = VFMVVF_FLOAT(0.0, vlmax); - vres6 = VFMVVF_FLOAT(0.0, vlmax); - vres7 = VFMVVF_FLOAT(0.0, vlmax); - - for (k = bk; k > 0; k -= vl) { - vl = VSETVL(k); - - VLSEG2_FLOAT(&va0, &va1, ptrba, vl); - VLSEG4_FLOAT(&vb0, &vb1, &vb2, &vb3, ptrbb, vl); - - vres0 = VFMACCVV_FLOAT(vres0, va0, vb0, vl); - vres1 = VFMACCVV_FLOAT(vres1, va1, vb0, vl); - vres2 = VFMACCVV_FLOAT(vres2, va0, vb1, vl); - vres3 = VFMACCVV_FLOAT(vres3, va1, vb1, vl); - - vres4 = VFMACCVV_FLOAT(vres4, va0, vb2, vl); - vres5 = VFMACCVV_FLOAT(vres5, va1, vb2, vl); - vres6 = VFMACCVV_FLOAT(vres6, va0, vb3, vl); - vres7 = VFMACCVV_FLOAT(vres7, va1, vb3, vl); - - ptrba += vl*2; - ptrbb += vl*4; - } - - vsum0 = VFREDSUMVS_FLOAT(vsum0, vres0, v_z0, vlmax); - vsum1 = VFREDSUMVS_FLOAT(vsum1, vres1, v_z0, vlmax); - C0[0] += alpha * VFMVFS_FLOAT_M1(vsum0); - C0[1] += alpha * VFMVFS_FLOAT_M1(vsum1); - - vsum0 = VFREDSUMVS_FLOAT(vsum0, vres2, v_z0, vlmax); - vsum1 = VFREDSUMVS_FLOAT(vsum1, vres3, v_z0, vlmax); - C1[0] += alpha * VFMVFS_FLOAT_M1(vsum0); - C1[1] += alpha * VFMVFS_FLOAT_M1(vsum1); - - vsum0 = VFREDSUMVS_FLOAT(vsum0, vres4, v_z0, vlmax); - vsum1 = VFREDSUMVS_FLOAT(vsum1, vres5, v_z0, vlmax); - C2[0] += alpha * VFMVFS_FLOAT_M1(vsum0); - C2[1] += alpha * VFMVFS_FLOAT_M1(vsum1); - - vsum0 = VFREDSUMVS_FLOAT(vsum0, vres6, v_z0, vlmax); - vsum1 = VFREDSUMVS_FLOAT(vsum1, vres7, v_z0, vlmax); - C3[0] += alpha * VFMVFS_FLOAT_M1(vsum0); - C3[1] += alpha * VFMVFS_FLOAT_M1(vsum1); - - C0 += 2; - C1 += 2; - C2 += 2; - C3 += 2; - } - - if(bm & 1) { - ptrbb = bb; - - vres0 = VFMVVF_FLOAT(0.0, vlmax); - vres1 = VFMVVF_FLOAT(0.0, vlmax); - vres2 = VFMVVF_FLOAT(0.0, vlmax); - vres3 = VFMVVF_FLOAT(0.0, vlmax); - - for (k = bk; k > 0; k -= vl) { - vl = VSETVL(k); - - va0 = VLEV_FLOAT(ptrba, vl); - VLSEG4_FLOAT(&vb0, &vb1, &vb2, &vb3, ptrbb, vl); - - vres0 = VFMACCVV_FLOAT(vres0, va0, vb0, vl); - vres1 = VFMACCVV_FLOAT(vres1, va0, vb1, vl); - vres2 = VFMACCVV_FLOAT(vres2, va0, vb2, vl); - vres3 = VFMACCVV_FLOAT(vres3, va0, vb3, vl); - - ptrba += vl; - ptrbb += vl*4; - } - - vsum0 = VFREDSUMVS_FLOAT(vsum0, vres0, v_z0, vlmax); - vsum1 = VFREDSUMVS_FLOAT(vsum1, vres1, v_z0, vlmax); - vsum2 = VFREDSUMVS_FLOAT(vsum2, vres2, v_z0, vlmax); - vsum3 = VFREDSUMVS_FLOAT(vsum3, vres3, v_z0, vlmax); - C0[0] += alpha * VFMVFS_FLOAT_M1(vsum0); - C1[0] += alpha * VFMVFS_FLOAT_M1(vsum1); - C2[0] += alpha * VFMVFS_FLOAT_M1(vsum2); - C3[0] += alpha * VFMVFS_FLOAT_M1(vsum3); - - C0 += 1; - C1 += 1; - C2 += 1; - C3 += 1; - } - - bb += (bk<<2); - C += (ldc<<2); - } - - if(bn & 2) { - - C0 = C; - C1 = C0 + ldc; - ptrba = ba; - - for (i = bm/4; i > 0; i--) { - ptrbb = bb; - - vres0 = VFMVVF_FLOAT(0.0, vlmax); - vres1 = VFMVVF_FLOAT(0.0, vlmax); - vres2 = VFMVVF_FLOAT(0.0, vlmax); - vres3 = VFMVVF_FLOAT(0.0, vlmax); - - vres4 = VFMVVF_FLOAT(0.0, vlmax); - vres5 = VFMVVF_FLOAT(0.0, vlmax); - vres6 = VFMVVF_FLOAT(0.0, vlmax); - vres7 = VFMVVF_FLOAT(0.0, vlmax); - - for (k = bk; k > 0; k -= vl) { - vl = VSETVL(k); - - VLSEG4_FLOAT(&va0, &va1, &va2, &va3, ptrba, vl); - VLSEG2_FLOAT(&vb0, &vb1, ptrbb, vl); - - vres0 = VFMACCVV_FLOAT(vres0, va0, vb0, vl); - vres1 = VFMACCVV_FLOAT(vres1, va1, vb0, vl); - vres2 = VFMACCVV_FLOAT(vres2, va2, vb0, vl); - vres3 = VFMACCVV_FLOAT(vres3, va3, vb0, vl); - - vres4 = VFMACCVV_FLOAT(vres4, va0, vb1, vl); - vres5 = VFMACCVV_FLOAT(vres5, va1, vb1, vl); - vres6 = VFMACCVV_FLOAT(vres6, va2, vb1, vl); - vres7 = VFMACCVV_FLOAT(vres7, va3, vb1, vl); - - ptrba += vl*4; - ptrbb += vl*2; - } - - vsum0 = VFREDSUMVS_FLOAT(vsum0, vres0, v_z0, vlmax); - vsum1 = VFREDSUMVS_FLOAT(vsum1, vres1, v_z0, vlmax); - vsum2 = VFREDSUMVS_FLOAT(vsum2, vres2, v_z0, vlmax); - vsum3 = VFREDSUMVS_FLOAT(vsum3, vres3, v_z0, vlmax); - C0[0] += alpha * VFMVFS_FLOAT_M1(vsum0); - C0[1] += alpha * VFMVFS_FLOAT_M1(vsum1); - C0[2] += alpha * VFMVFS_FLOAT_M1(vsum2); - C0[3] += alpha * VFMVFS_FLOAT_M1(vsum3); - - vsum0 = VFREDSUMVS_FLOAT(vsum0, vres4, v_z0, vlmax); - vsum1 = VFREDSUMVS_FLOAT(vsum1, vres5, v_z0, vlmax); - vsum2 = VFREDSUMVS_FLOAT(vsum2, vres6, v_z0, vlmax); - vsum3 = VFREDSUMVS_FLOAT(vsum3, vres7, v_z0, vlmax); - C1[0] += alpha * VFMVFS_FLOAT_M1(vsum0); - C1[1] += alpha * VFMVFS_FLOAT_M1(vsum1); - C1[2] += alpha * VFMVFS_FLOAT_M1(vsum2); - C1[3] += alpha * VFMVFS_FLOAT_M1(vsum3); - - C0 += 4; - C1 += 4; - } - - if(bm & 2) { - ptrbb = bb; - - vres0 = VFMVVF_FLOAT(0.0, vlmax); - vres1 = VFMVVF_FLOAT(0.0, vlmax); - vres2 = VFMVVF_FLOAT(0.0, vlmax); - vres3 = VFMVVF_FLOAT(0.0, vlmax); - - for (k = bk; k > 0; k -= vl) { - vl = VSETVL(k); - - VLSEG2_FLOAT(&va0, &va1, ptrba, vl); - VLSEG2_FLOAT(&vb0, &vb1, ptrbb, vl); - - vres0 = VFMACCVV_FLOAT(vres0, va0, vb0, vl); - vres1 = VFMACCVV_FLOAT(vres1, va1, vb0, vl); - vres2 = VFMACCVV_FLOAT(vres2, va0, vb1, vl); - vres3 = VFMACCVV_FLOAT(vres3, va1, vb1, vl); - - ptrba += vl*2; - ptrbb += vl*2; - } - - vsum0 = VFREDSUMVS_FLOAT(vsum0, vres0, v_z0, vlmax); - vsum1 = VFREDSUMVS_FLOAT(vsum1, vres1, v_z0, vlmax); - vsum2 = VFREDSUMVS_FLOAT(vsum2, vres2, v_z0, vlmax); - vsum3 = VFREDSUMVS_FLOAT(vsum3, vres3, v_z0, vlmax); - C0[0] += alpha * VFMVFS_FLOAT_M1(vsum0); - C0[1] += alpha * VFMVFS_FLOAT_M1(vsum1); - C1[0] += alpha * VFMVFS_FLOAT_M1(vsum2); - C1[1] += alpha * VFMVFS_FLOAT_M1(vsum3); - - C0 += 2; - C1 += 2; - } - - if(bm & 1) { - ptrbb = bb; - - vres0 = VFMVVF_FLOAT(0.0, vlmax); - vres1 = VFMVVF_FLOAT(0.0, vlmax); - - for (k = bk; k > 0; k -= vl) { - vl = VSETVL(k); - - va0 = VLEV_FLOAT(ptrba, vl); - VLSEG2_FLOAT(&vb0, &vb1, ptrbb, vl); - - vres0 = VFMACCVV_FLOAT(vres0, va0, vb0, vl); - vres1 = VFMACCVV_FLOAT(vres1, va0, vb1, vl); - - ptrba += vl; - ptrbb += vl*2; - } - - vsum0 = VFREDSUMVS_FLOAT(vsum0, vres0, v_z0, vlmax); - vsum1 = VFREDSUMVS_FLOAT(vsum1, vres1, v_z0, vlmax); - C0[0] += alpha * VFMVFS_FLOAT_M1(vsum0); - C1[0] += alpha * VFMVFS_FLOAT_M1(vsum1); - - C0 += 1; - C1 += 1; - } - - bb += (bk<<1); - C += (ldc<<1); - } - - if(bn & 1) { - C0 = C; - ptrba = ba; - for (i = bm/4; i > 0; i--) { - ptrbb = bb; - - vres0 = VFMVVF_FLOAT(0.0, vlmax); - vres1 = VFMVVF_FLOAT(0.0, vlmax); - vres2 = VFMVVF_FLOAT(0.0, vlmax); - vres3 = VFMVVF_FLOAT(0.0, vlmax); - - for (k = bk; k > 0; k -= vl) { - vl = VSETVL(k); - - VLSEG4_FLOAT(&va0, &va1, &va2, &va3, ptrba, vl); - vb0 = VLEV_FLOAT(ptrbb, vl); - - vres0 = VFMACCVV_FLOAT(vres0, va0, vb0, vl); - vres1 = VFMACCVV_FLOAT(vres1, va1, vb0, vl); - vres2 = VFMACCVV_FLOAT(vres2, va2, vb0, vl); - vres3 = VFMACCVV_FLOAT(vres3, va3, vb0, vl); - - ptrba += vl*4; - ptrbb += vl; - } - - vsum0 = VFREDSUMVS_FLOAT(vsum0, vres0, v_z0, vlmax); - vsum1 = VFREDSUMVS_FLOAT(vsum1, vres1, v_z0, vlmax); - vsum2 = VFREDSUMVS_FLOAT(vsum2, vres2, v_z0, vlmax); - vsum3 = VFREDSUMVS_FLOAT(vsum3, vres3, v_z0, vlmax); - C0[0] += alpha * VFMVFS_FLOAT_M1(vsum0); - C0[1] += alpha * VFMVFS_FLOAT_M1(vsum1); - C0[2] += alpha * VFMVFS_FLOAT_M1(vsum2); - C0[3] += alpha * VFMVFS_FLOAT_M1(vsum3); - - C0 += 4; - } - - if(bm & 2) { - ptrbb = bb; - - vres0 = VFMVVF_FLOAT(0.0, vlmax); - vres1 = VFMVVF_FLOAT(0.0, vlmax); - - for (k = bk; k > 0; k -= vl) { - vl = VSETVL(k); - - VLSEG2_FLOAT(&va0, &va1, ptrba, vl); - vb0 = VLEV_FLOAT(ptrbb, vl); - - vres0 = VFMACCVV_FLOAT(vres0, va0, vb0, vl); - vres1 = VFMACCVV_FLOAT(vres1, va1, vb0, vl); - - ptrba += vl*2; - ptrbb += vl; - } - - vsum0 = VFREDSUMVS_FLOAT(vsum0, vres0, v_z0, vlmax); - vsum1 = VFREDSUMVS_FLOAT(vsum1, vres1, v_z0, vlmax); - C0[0] += alpha * VFMVFS_FLOAT_M1(vsum0); - C0[1] += alpha * VFMVFS_FLOAT_M1(vsum1); - - C0 += 2; - } - - if(bm & 1) { - ptrbb = bb; - - vres0 = VFMVVF_FLOAT(0.0, vlmax); - - for (k = bk; k > 0; k -= vl) { - vl = VSETVL(k); - - va0 = VLEV_FLOAT(ptrba, vl); - vb0 = VLEV_FLOAT(ptrbb, vl); - - vres0 = VFMACCVV_FLOAT(vres0, va0, vb0, vl); - - ptrba += vl; - ptrbb += vl; - } - - vsum0 = VFREDSUMVS_FLOAT(vsum0, vres0, v_z0, vlmax); - C0[0] += alpha * VFMVFS_FLOAT_M1(vsum0); - - C0 += 1; - } - - bb += (bk<<0); - C += ldc; - } - - return 0; -} diff --git a/kernel/riscv64/trmmkernel_2x2_rvv.c b/kernel/riscv64/trmmkernel_2x2_rvv.c deleted file mode 100644 index 127e76970..000000000 --- a/kernel/riscv64/trmmkernel_2x2_rvv.c +++ /dev/null @@ -1,342 +0,0 @@ -/*************************************************************************** -Copyright (c) 2022, The OpenBLAS Project -All rights reserved. -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are -met: -1. Redistributions of source code must retain the above copyright -notice, this list of conditions and the following disclaimer. -2. 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. -3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" - -#if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m4(n) -#define VSETVL_MAX vsetvlmax_e32m4() -#define VSETVL_MAX_M1 vsetvlmax_e32m1() -#define FLOAT_V_T vfloat32m4_t -#define FLOAT_V_T_M1 vfloat32m1_t -#define VLEV_FLOAT vle32_v_f32m4 -#define VLSEG_FLOAT vlseg2e32_v_f32m4 -#define VFMVVF_FLOAT vfmv_v_f_f32m4 -#define VFMACCVF_FLOAT vfmacc_vf_f32m4 -#define VFMACCVV_FLOAT vfmacc_vv_f32m4 -#define VFREDSUMVS_FLOAT vfredusum_vs_f32m4_f32m1 -#define VFMVVF_FLOAT_M1 vfmv_v_f_f32m1 -#define VFMVFS_FLOAT_M1 vfmv_f_s_f32m1_f32 -#else -#define VSETVL(n) vsetvl_e64m4(n) -#define VSETVL_MAX vsetvlmax_e64m4() -#define VSETVL_MAX_M1 vsetvlmax_e64m1() -#define FLOAT_V_T vfloat64m4_t -#define FLOAT_V_T_M1 vfloat64m1_t -#define VLEV_FLOAT vle64_v_f64m4 -#define VLSEG_FLOAT vlseg2e64_v_f64m4 -#define VFMVVF_FLOAT vfmv_v_f_f64m4 -#define VFMACCVF_FLOAT vfmacc_vf_f64m4 -#define VFMACCVV_FLOAT vfmacc_vv_f64m4 -#define VFREDSUMVS_FLOAT vfredusum_vs_f64m4_f64m1 -#define VFMVVF_FLOAT_M1 vfmv_v_f_f64m1 -#define VFMVFS_FLOAT_M1 vfmv_f_s_f64m1_f64 -#endif - - -// Optimizes the implementation in ../generic/trmmkernel_2x2.c - - -int CNAME(BLASLONG bm,BLASLONG bn,BLASLONG bk,FLOAT alpha,FLOAT* ba,FLOAT* bb,FLOAT* C,BLASLONG ldc -#ifdef TRMMKERNEL - ,BLASLONG offset -#endif - ) -{ - BLASLONG i,j,k; - FLOAT *C0,*C1,*ptrba,*ptrbb; - BLASLONG off, temp; - - FLOAT_V_T va0, va1, vb0, vb1; - FLOAT_V_T vres0, vres1, vres2, vres3; - FLOAT_V_T_M1 v_res, v_z0; - v_z0 = VFMVVF_FLOAT_M1(0, VSETVL_MAX_M1); - size_t vl; - size_t vlmax = VSETVL_MAX; - -#if defined(TRMMKERNEL) && !defined(LEFT) - off = -offset; -#else - off = 0; -#endif - - for (j = bn/2; j > 0; j--) - { - C0 = C; - C1 = C0+ldc; -#if defined(TRMMKERNEL) && defined(LEFT) - off = offset; -#endif - ptrba = ba; - - for (i = bm/2; i > 0; i--) - { -#if (defined(LEFT) && defined(TRANSA)) || \ - (!defined(LEFT) && !defined(TRANSA)) - ptrbb = bb; -#else - ptrba += off*2; - ptrbb = bb + off*2; -#endif - -#if (defined(LEFT) && !defined(TRANSA)) || \ - (!defined(LEFT) && defined(TRANSA)) - temp = bk-off; -#elif defined(LEFT) - temp = off+2; -#else - temp = off+2; -#endif - vres0 = VFMVVF_FLOAT(0.0, vlmax); - vres1 = VFMVVF_FLOAT(0.0, vlmax); - vres2 = VFMVVF_FLOAT(0.0, vlmax); - vres3 = VFMVVF_FLOAT(0.0, vlmax); - for (k = temp; k > 0; k -= vl) - { - vl = VSETVL(k); - VLSEG_FLOAT(&va0, &va1, ptrba, vl); - VLSEG_FLOAT(&vb0, &vb1, ptrbb, vl); - - vres0 = VFMACCVV_FLOAT(vres0, va0, vb0, vl); - vres1 = VFMACCVV_FLOAT(vres1, va1, vb0, vl); - vres2 = VFMACCVV_FLOAT(vres2, va0, vb1, vl); - vres3 = VFMACCVV_FLOAT(vres3, va1, vb1, vl); - - ptrba += vl * 2; - ptrbb += vl * 2; - } - v_res = VFREDSUMVS_FLOAT(v_res, vres0, v_z0, vlmax); - C0[0] = alpha * VFMVFS_FLOAT_M1(v_res); - v_res = VFREDSUMVS_FLOAT(v_res, vres1, v_z0, vlmax); - C0[1] = alpha * VFMVFS_FLOAT_M1(v_res); - v_res = VFREDSUMVS_FLOAT(v_res, vres2, v_z0, vlmax); - C1[0] = alpha * VFMVFS_FLOAT_M1(v_res); - v_res = VFREDSUMVS_FLOAT(v_res, vres3, v_z0, vlmax); - C1[1] = alpha * VFMVFS_FLOAT_M1(v_res); - -#if ( defined(LEFT) && defined(TRANSA)) || \ - (!defined(LEFT) && !defined(TRANSA)) - temp = bk - off; -#ifdef LEFT - temp -= 2; -#else - temp -= 2; -#endif - ptrba += temp*2; - ptrbb += temp*2; -#endif -#ifdef LEFT - off += 2; -#endif - C0 = C0+2; - C1 = C1+2; - } - - if (bm & 1) - { -#if (defined(LEFT) && defined(TRANSA)) ||(!defined(LEFT) && !defined(TRANSA)) - ptrbb = bb; -#else - ptrba += off; - ptrbb = bb+off*2; -#endif - -#if (defined(LEFT) && !defined(TRANSA)) || (!defined(LEFT) && defined(TRANSA)) - temp = bk-off; -#elif defined(LEFT) - temp = off+1; -#else - temp = off+2; -#endif - vres0 = VFMVVF_FLOAT(0.0, vlmax); - vres1 = VFMVVF_FLOAT(0.0, vlmax); - - for (k = temp; k > 0; k -= vl) - { - vl = VSETVL(k); - va0 = VLEV_FLOAT(ptrba, vl); - VLSEG_FLOAT(&vb0, &vb1, ptrbb, vl); - - vres0 = VFMACCVV_FLOAT(vres0, va0, vb0, vl); - vres1 = VFMACCVV_FLOAT(vres1, va0, vb1, vl); - - ptrba += vl; - ptrbb += vl * 2; - - } - v_res = VFREDSUMVS_FLOAT(v_res, vres0, v_z0, vlmax); - C0[0] = alpha * VFMVFS_FLOAT_M1(v_res); - v_res = VFREDSUMVS_FLOAT(v_res, vres1, v_z0, vlmax); - C1[0] = alpha * VFMVFS_FLOAT_M1(v_res); - -#if ( defined(LEFT) && defined(TRANSA)) || (!defined(LEFT) && !defined(TRANSA)) - temp = bk-off; -#ifdef LEFT - temp -= 1; -#else - temp -= 2; -#endif - ptrba += temp; - ptrbb += temp*2; -#endif -#ifdef LEFT - off += 1; -#endif - C0 = C0+1; - C1 = C1+1; - } -#if defined(TRMMKERNEL) && !defined(LEFT) - off += 2; -#endif - k = (bk<<1); - bb = bb+k; - i = (ldc<<1); - C = C+i; - } - - if (bn & 1) - { - C0 = C; -#if defined(TRMMKERNEL) && defined(LEFT) - off = offset; -#endif - ptrba = ba; - - for (i = bm/2; i > 0; i--) - { -#if (defined(LEFT) && defined(TRANSA)) || \ - (!defined(LEFT) && !defined(TRANSA)) - ptrbb = bb; -#else - ptrba += off*2; - ptrbb = bb + off; -#endif - - -#if (defined(LEFT) && !defined(TRANSA)) || \ - (!defined(LEFT) && defined(TRANSA)) - temp = bk-off; -#elif defined(LEFT) - temp = off+2; -#else - temp = off+1; -#endif - vres0 = VFMVVF_FLOAT(0.0, vlmax); - vres1 = VFMVVF_FLOAT(0.0, vlmax); - - for (k = temp; k > 0; k -= vl) - { - vl = VSETVL(k); - vb0 = VLEV_FLOAT(ptrbb, vl); - VLSEG_FLOAT(&va0, &va1, ptrba, vl); - - vres0 = VFMACCVV_FLOAT(vres0, vb0, va0, vl); - vres1 = VFMACCVV_FLOAT(vres1, vb0, va1, vl); - - ptrba += vl * 2; - ptrbb += vl; - - } - v_res = VFREDSUMVS_FLOAT(v_res, vres0, v_z0, vlmax); - C0[0] = alpha * VFMVFS_FLOAT_M1(v_res); - v_res = VFREDSUMVS_FLOAT(v_res, vres1, v_z0, vlmax); - C0[1] = alpha * VFMVFS_FLOAT_M1(v_res); - -#if ( defined(LEFT) && defined(TRANSA)) || \ - (!defined(LEFT) && !defined(TRANSA)) - temp = bk - off; -#ifdef LEFT - temp -= 2; -#else - temp -= 1; -#endif - ptrba += temp*2; - ptrbb += temp; -#endif -#ifdef LEFT - off += 2; -#endif - - C0 = C0+2; - } - - if (bm & 1) - { -#if (defined(LEFT) && defined(TRANSA)) || (!defined(LEFT) && !defined(TRANSA)) - ptrbb = bb; -#else - ptrba += off; - ptrbb = bb+off; -#endif - -#if (defined(LEFT) && !defined(TRANSA)) || (!defined(LEFT) && defined(TRANSA)) - temp = bk-off; -#elif defined(LEFT) - temp = off + 1; -#else - temp = off + 1; -#endif - vres0 = VFMVVF_FLOAT(0.0, vlmax); - - for (k = temp; k > 0; k -= vl) - { - vl = VSETVL(k); - va0 = VLEV_FLOAT(ptrba, vl); - vb0 = VLEV_FLOAT(ptrbb, vl); - - vres0 = VFMACCVV_FLOAT(vres0, vb0, va0, vl); - ptrba += vl; - ptrbb += vl; - } - v_res = VFREDSUMVS_FLOAT(v_res, vres0, v_z0, vlmax); - C0[0] = alpha * VFMVFS_FLOAT_M1(v_res); - -#if ( defined(LEFT) && defined(TRANSA)) || (!defined(LEFT) && !defined(TRANSA)) - temp = bk-off; -#ifdef LEFT - temp -= 1; -#else - temp -= 1; -#endif - ptrba += temp; - ptrbb += temp; -#endif -#ifdef LEFT - off += 1; -#endif - C0 = C0+1; - } -#if defined(TRMMKERNEL) && !defined(LEFT) - off += 1; -#endif - k = (bk<<0); - bb = bb+k; - C = C+ldc; - } - return 0; -} - diff --git a/kernel/riscv64/trmmkernel_4x4_rvv.c b/kernel/riscv64/trmmkernel_4x4_rvv.c deleted file mode 100644 index 3e46c6348..000000000 --- a/kernel/riscv64/trmmkernel_4x4_rvv.c +++ /dev/null @@ -1,881 +0,0 @@ -/*************************************************************************** -Copyright (c) 2022, The OpenBLAS Project -All rights reserved. -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are -met: -1. Redistributions of source code must retain the above copyright -notice, this list of conditions and the following disclaimer. -2. 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. -3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" -#include - -#if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m2(n) -#define VSETVL_MAX vsetvlmax_e32m2() -#define VSETVL_MAX_M1 vsetvlmax_e32m1() -#define FLOAT_V_T vfloat32m2_t -#define FLOAT_V_T_M1 vfloat32m1_t -#define VLEV_FLOAT vle32_v_f32m2 -#define VLSEG4_FLOAT vlseg4e32_v_f32m2 -#define VLSEG2_FLOAT vlseg2e32_v_f32m2 -#define VFMVVF_FLOAT vfmv_v_f_f32m2 -#define VFMUL_FLOAT vfmul_vv_f32m2 -#define VFMACCVF_FLOAT vfmacc_vf_f32m2 -#define VFMACCVV_FLOAT vfmacc_vv_f32m2 -#define VFREDSUMVS_FLOAT vfredusum_vs_f32m2_f32m1 -#define VFMVVF_FLOAT_M1 vfmv_v_f_f32m1 -#define VFMVFS_FLOAT_M1 vfmv_f_s_f32m1_f32 -#else -#define VSETVL(n) vsetvl_e64m2(n) -#define VSETVL_MAX vsetvlmax_e64m2() -#define VSETVL_MAX_M1 vsetvlmax_e64m1() -#define FLOAT_V_T vfloat64m2_t -#define FLOAT_V_T_M1 vfloat64m1_t -#define VLEV_FLOAT vle64_v_f64m2 -#define VLSEG4_FLOAT vlseg4e64_v_f64m2 -#define VLSEG2_FLOAT vlseg2e64_v_f64m2 -#define VFMVVF_FLOAT vfmv_v_f_f64m2 -#define VFMUL_FLOAT vfmul_vv_f64m2 -#define VFMACCVF_FLOAT vfmacc_vf_f64m2 -#define VFMACCVV_FLOAT vfmacc_vv_f64m2 -#define VFREDSUMVS_FLOAT vfredusum_vs_f64m2_f64m1 -#define VFMVVF_FLOAT_M1 vfmv_v_f_f64m1 -#define VFMVFS_FLOAT_M1 vfmv_f_s_f64m1_f64 -#endif - - -// Optimizes the implementation in ../generic/trmmkernel_4x4.c - -int CNAME(BLASLONG bm,BLASLONG bn,BLASLONG bk,FLOAT alpha,FLOAT* ba,FLOAT* bb,FLOAT* C,BLASLONG ldc ,BLASLONG offset) -{ - - BLASLONG i,j,k; - FLOAT *C0,*C1,*C2,*C3,*ptrba,*ptrbb; - - FLOAT_V_T va0, va1, va2, va3, vb0, vb1, vb2, vb3; - FLOAT_V_T_M1 vsum0, vsum1, vsum2, vsum3, v_z0; - v_z0 = VFMVVF_FLOAT_M1(0, VSETVL_MAX_M1); - size_t vl; - size_t vlmax = VSETVL_MAX; - - FLOAT_V_T vres0_0; - FLOAT_V_T vres0_1; - FLOAT_V_T vres0_2; - FLOAT_V_T vres0_3; - - FLOAT_V_T vres1_0; - FLOAT_V_T vres1_1; - FLOAT_V_T vres1_2; - FLOAT_V_T vres1_3; - - FLOAT_V_T vres2_0; - FLOAT_V_T vres2_1; - FLOAT_V_T vres2_2; - FLOAT_V_T vres2_3; - - FLOAT_V_T vres3_0; - FLOAT_V_T vres3_1; - FLOAT_V_T vres3_2; - FLOAT_V_T vres3_3; - - BLASLONG off, temp; - - bool left; - bool transposed; - bool backwards; - -#ifdef LEFT - left = true; -#else - left = false; -#endif - -#ifdef TRANSA - transposed = true; -#else - transposed = false; -#endif - - backwards = left != transposed; - - if (!left) { - off = -offset; - } - - - for (j=0; j 0; k -= vl) - { - vl = VSETVL(k); - VLSEG4_FLOAT(&va0, &va1, &va2, &va3, ptrba, vl); - VLSEG4_FLOAT(&vb0, &vb1, &vb2, &vb3, ptrbb, vl); - - vres0_0 = VFMACCVV_FLOAT(vres0_0, va0, vb0, vl); - vres1_0 = VFMACCVV_FLOAT(vres1_0, va0, vb1, vl); - vres2_0 = VFMACCVV_FLOAT(vres2_0, va0, vb2, vl); - vres3_0 = VFMACCVV_FLOAT(vres3_0, va0, vb3, vl); - - vres0_1 = VFMACCVV_FLOAT(vres0_1, va1, vb0, vl); - vres1_1 = VFMACCVV_FLOAT(vres1_1, va1, vb1, vl); - vres2_1 = VFMACCVV_FLOAT(vres2_1, va1, vb2, vl); - vres3_1 = VFMACCVV_FLOAT(vres3_1, va1, vb3, vl); - - vres0_2 = VFMACCVV_FLOAT(vres0_2, va2, vb0, vl); - vres1_2 = VFMACCVV_FLOAT(vres1_2, va2, vb1, vl); - vres2_2 = VFMACCVV_FLOAT(vres2_2, va2, vb2, vl); - vres3_2 = VFMACCVV_FLOAT(vres3_2, va2, vb3, vl); - - vres0_3 = VFMACCVV_FLOAT(vres0_3, va3, vb0, vl); - vres1_3 = VFMACCVV_FLOAT(vres1_3, va3, vb1, vl); - vres2_3 = VFMACCVV_FLOAT(vres2_3, va3, vb2, vl); - vres3_3 = VFMACCVV_FLOAT(vres3_3, va3, vb3, vl); - - ptrba += vl * 4; - ptrbb += vl * 4; - } - - vsum0 = VFREDSUMVS_FLOAT(vsum0, vres0_0, v_z0, vlmax); - vsum1 = VFREDSUMVS_FLOAT(vsum1, vres0_1, v_z0, vlmax); - vsum2 = VFREDSUMVS_FLOAT(vsum2, vres0_2, v_z0, vlmax); - vsum3 = VFREDSUMVS_FLOAT(vsum3, vres0_3, v_z0, vlmax); - C0[0] = alpha * VFMVFS_FLOAT_M1(vsum0); - C0[1] = alpha * VFMVFS_FLOAT_M1(vsum1); - C0[2] = alpha * VFMVFS_FLOAT_M1(vsum2); - C0[3] = alpha * VFMVFS_FLOAT_M1(vsum3); - - vsum0 = VFREDSUMVS_FLOAT(vsum0, vres1_0, v_z0, vlmax); - vsum1 = VFREDSUMVS_FLOAT(vsum1, vres1_1, v_z0, vlmax); - vsum2 = VFREDSUMVS_FLOAT(vsum2, vres1_2, v_z0, vlmax); - vsum3 = VFREDSUMVS_FLOAT(vsum3, vres1_3, v_z0, vlmax); - C1[0] = alpha * VFMVFS_FLOAT_M1(vsum0); - C1[1] = alpha * VFMVFS_FLOAT_M1(vsum1); - C1[2] = alpha * VFMVFS_FLOAT_M1(vsum2); - C1[3] = alpha * VFMVFS_FLOAT_M1(vsum3); - - vsum0 = VFREDSUMVS_FLOAT(vsum0, vres2_0, v_z0, vlmax); - vsum1 = VFREDSUMVS_FLOAT(vsum1, vres2_1, v_z0, vlmax); - vsum2 = VFREDSUMVS_FLOAT(vsum2, vres2_2, v_z0, vlmax); - vsum3 = VFREDSUMVS_FLOAT(vsum3, vres2_3, v_z0, vlmax); - C2[0] = alpha * VFMVFS_FLOAT_M1(vsum0); - C2[1] = alpha * VFMVFS_FLOAT_M1(vsum1); - C2[2] = alpha * VFMVFS_FLOAT_M1(vsum2); - C2[3] = alpha * VFMVFS_FLOAT_M1(vsum3); - - vsum0 = VFREDSUMVS_FLOAT(vsum0, vres3_0, v_z0, vlmax); - vsum1 = VFREDSUMVS_FLOAT(vsum1, vres3_1, v_z0, vlmax); - vsum2 = VFREDSUMVS_FLOAT(vsum2, vres3_2, v_z0, vlmax); - vsum3 = VFREDSUMVS_FLOAT(vsum3, vres3_3, v_z0, vlmax); - C3[0] = alpha * VFMVFS_FLOAT_M1(vsum0); - C3[1] = alpha * VFMVFS_FLOAT_M1(vsum1); - C3[2] = alpha * VFMVFS_FLOAT_M1(vsum2); - C3[3] = alpha * VFMVFS_FLOAT_M1(vsum3); - - if (!backwards) { - temp = bk-off; - temp = left ? temp - 4 : // number of values in A - temp - 4; // number of values in B - - ptrba += temp*4; // number of values in A - ptrbb += temp*4; // number of values in B - } -#ifdef LEFT - off += 4; // number of values in A -#endif - - C0 = C0+4; - C1 = C1+4; - C2 = C2+4; - C3 = C3+4; - - } - - if ( bm & 2 ) // do any 2x4 loop - { - -#if (defined(LEFT) && defined(TRANSA)) || (!defined(LEFT) && !defined(TRANSA)) - ptrbb = bb; -#else - ptrba += off*2; - ptrbb = bb + off*4; -#endif - - vres0_0 = VFMVVF_FLOAT(0, vlmax); - vres0_1 = VFMVVF_FLOAT(0, vlmax); - - vres1_0 = VFMVVF_FLOAT(0, vlmax); - vres1_1 = VFMVVF_FLOAT(0, vlmax); - - vres2_0 = VFMVVF_FLOAT(0, vlmax); - vres2_1 = VFMVVF_FLOAT(0, vlmax); - - vres3_0 = VFMVVF_FLOAT(0, vlmax); - vres3_1 = VFMVVF_FLOAT(0, vlmax); - - -#if (defined(LEFT) && !defined(TRANSA)) || (!defined(LEFT) && defined(TRANSA)) - temp = bk-off; -#elif defined(LEFT) - temp = off+2; // number of values in A -#else - temp = off+4; // number of values in B -#endif - for (k = temp; k > 0; k -= vl) - { - vl = VSETVL(k); - VLSEG2_FLOAT(&va0, &va1, ptrba, vl); - VLSEG4_FLOAT(&vb0, &vb1, &vb2, &vb3, ptrbb, vl); - - vres0_0 = VFMACCVV_FLOAT(vres0_0, va0, vb0, vl); - vres1_0 = VFMACCVV_FLOAT(vres1_0, va0, vb1, vl); - vres2_0 = VFMACCVV_FLOAT(vres2_0, va0, vb2, vl); - vres3_0 = VFMACCVV_FLOAT(vres3_0, va0, vb3, vl); - - vres0_1 = VFMACCVV_FLOAT(vres0_1, va1, vb0, vl); - vres1_1 = VFMACCVV_FLOAT(vres1_1, va1, vb1, vl); - vres2_1 = VFMACCVV_FLOAT(vres2_1, va1, vb2, vl); - vres3_1 = VFMACCVV_FLOAT(vres3_1, va1, vb3, vl); - - ptrba += vl * 2; - ptrbb += vl * 4; - } - - vsum0 = VFREDSUMVS_FLOAT(vsum0, vres0_0, v_z0, vlmax); - vsum1 = VFREDSUMVS_FLOAT(vsum1, vres0_1, v_z0, vlmax); - vsum2 = VFREDSUMVS_FLOAT(vsum2, vres1_0, v_z0, vlmax); - vsum3 = VFREDSUMVS_FLOAT(vsum3, vres1_1, v_z0, vlmax); - - C0[0] = alpha * VFMVFS_FLOAT_M1(vsum0); - C0[1] = alpha * VFMVFS_FLOAT_M1(vsum1); - C1[0] = alpha * VFMVFS_FLOAT_M1(vsum2); - C1[1] = alpha * VFMVFS_FLOAT_M1(vsum3); - - vsum0 = VFREDSUMVS_FLOAT(vsum0, vres2_0, v_z0, vlmax); - vsum1 = VFREDSUMVS_FLOAT(vsum1, vres2_1, v_z0, vlmax); - vsum2 = VFREDSUMVS_FLOAT(vsum2, vres3_0, v_z0, vlmax); - vsum3 = VFREDSUMVS_FLOAT(vsum3, vres3_1, v_z0, vlmax); - - C2[0] = alpha * VFMVFS_FLOAT_M1(vsum0); - C2[1] = alpha * VFMVFS_FLOAT_M1(vsum1); - C3[0] = alpha * VFMVFS_FLOAT_M1(vsum2); - C3[1] = alpha * VFMVFS_FLOAT_M1(vsum3); - - -#if ( defined(LEFT) && defined(TRANSA)) || (!defined(LEFT) && !defined(TRANSA)) - temp = bk - off; -#ifdef LEFT - temp -= 2; // number of values in A -#else - temp -= 4; // number of values in B -#endif - ptrba += temp*2; - ptrbb += temp*4; -#endif - -#ifdef LEFT - off += 2; // number of values in A -#endif - - C0 = C0+2; - C1 = C1+2; - C2 = C2+2; - C3 = C3+2; - - } - - if ( bm & 1 ) // do any 1x4 loop - { - -#if (defined(LEFT) && defined(TRANSA)) || (!defined(LEFT) && !defined(TRANSA)) - ptrbb = bb; -#else - ptrba += off*1; - ptrbb = bb + off*4; -#endif - - vres0_0 = VFMVVF_FLOAT(0, vlmax); - vres1_0 = VFMVVF_FLOAT(0, vlmax); - vres2_0 = VFMVVF_FLOAT(0, vlmax); - vres3_0 = VFMVVF_FLOAT(0, vlmax); - - -#if (defined(LEFT) && !defined(TRANSA)) || (!defined(LEFT) && defined(TRANSA)) - temp = bk-off; -#elif defined(LEFT) - temp = off+1; // number of values in A -#else - temp = off+4; // number of values in B -#endif - - for (k = temp; k > 0; k -= vl) - { - vl = VSETVL(k); - va0 = VLEV_FLOAT(ptrba, vl); - VLSEG4_FLOAT(&vb0, &vb1, &vb2, &vb3, ptrbb, vl); - - vres0_0 = VFMACCVV_FLOAT(vres0_0, va0, vb0, vl); - vres1_0 = VFMACCVV_FLOAT(vres1_0, va0, vb1, vl); - vres2_0 = VFMACCVV_FLOAT(vres2_0, va0, vb2, vl); - vres3_0 = VFMACCVV_FLOAT(vres3_0, va0, vb3, vl); - - ptrba += vl; - ptrbb += vl * 4; - } - - vsum0 = VFREDSUMVS_FLOAT(vsum0, vres0_0, v_z0, vlmax); - vsum1 = VFREDSUMVS_FLOAT(vsum1, vres1_0, v_z0, vlmax); - vsum2 = VFREDSUMVS_FLOAT(vsum2, vres2_0, v_z0, vlmax); - vsum3 = VFREDSUMVS_FLOAT(vsum3, vres3_0, v_z0, vlmax); - - C0[0] = alpha * VFMVFS_FLOAT_M1(vsum0); - C1[0] = alpha * VFMVFS_FLOAT_M1(vsum1); - C2[0] = alpha * VFMVFS_FLOAT_M1(vsum2); - C3[0] = alpha * VFMVFS_FLOAT_M1(vsum3); - -#if ( defined(LEFT) && defined(TRANSA)) || (!defined(LEFT) && !defined(TRANSA)) - temp = bk - off; -#ifdef LEFT - temp -= 1; // number of values in A -#else - temp -= 4; // number of values in B -#endif - ptrba += temp*1; - ptrbb += temp*4; -#endif - -#ifdef LEFT - off += 1; // number of values in A -#endif - - C0 = C0+1; - C1 = C1+1; - C2 = C2+1; - C3 = C3+1; - - } - - -#if defined(TRMMKERNEL) && !defined(LEFT) - off += 4; -#endif - - k = (bk<<2); - bb = bb+k; - i = (ldc<<2); - C = C+i; - } - - for (j=0; j<(bn&2); j+=2) // do the Mx2 loops - { - C0 = C; - C1 = C0+ldc; - -#if defined(TRMMKERNEL) && defined(LEFT) - off = offset; -#endif - - ptrba = ba; - - for (i=0; i 0; k -= vl) - { - vl = VSETVL(k); - VLSEG4_FLOAT(&va0, &va1, &va2, &va3, ptrba, vl); - VLSEG2_FLOAT(&vb0, &vb1, ptrbb, vl); - - vres0_0 = VFMACCVV_FLOAT(vres0_0, va0, vb0, vl); - vres1_0 = VFMACCVV_FLOAT(vres1_0, va0, vb1, vl); - - vres0_1 = VFMACCVV_FLOAT(vres0_1, va1, vb0, vl); - vres1_1 = VFMACCVV_FLOAT(vres1_1, va1, vb1, vl); - - vres0_2 = VFMACCVV_FLOAT(vres0_2, va2, vb0, vl); - vres1_2 = VFMACCVV_FLOAT(vres1_2, va2, vb1, vl); - - vres0_3 = VFMACCVV_FLOAT(vres0_3, va3, vb0, vl); - vres1_3 = VFMACCVV_FLOAT(vres1_3, va3, vb1, vl); - - ptrba += vl * 4; - ptrbb += vl * 2; - } - - vsum0 = VFREDSUMVS_FLOAT(vsum0, vres0_0, v_z0, vlmax); - vsum1 = VFREDSUMVS_FLOAT(vsum1, vres0_1, v_z0, vlmax); - vsum2 = VFREDSUMVS_FLOAT(vsum2, vres0_2, v_z0, vlmax); - vsum3 = VFREDSUMVS_FLOAT(vsum3, vres0_3, v_z0, vlmax); - C0[0] = alpha * VFMVFS_FLOAT_M1(vsum0); - C0[1] = alpha * VFMVFS_FLOAT_M1(vsum1); - C0[2] = alpha * VFMVFS_FLOAT_M1(vsum2); - C0[3] = alpha * VFMVFS_FLOAT_M1(vsum3); - - vsum0 = VFREDSUMVS_FLOAT(vsum0, vres1_0, v_z0, vlmax); - vsum1 = VFREDSUMVS_FLOAT(vsum1, vres1_1, v_z0, vlmax); - vsum2 = VFREDSUMVS_FLOAT(vsum2, vres1_2, v_z0, vlmax); - vsum3 = VFREDSUMVS_FLOAT(vsum3, vres1_3, v_z0, vlmax); - C1[0] = alpha * VFMVFS_FLOAT_M1(vsum0); - C1[1] = alpha * VFMVFS_FLOAT_M1(vsum1); - C1[2] = alpha * VFMVFS_FLOAT_M1(vsum2); - C1[3] = alpha * VFMVFS_FLOAT_M1(vsum3); - -#if ( defined(LEFT) && defined(TRANSA)) || (!defined(LEFT) && !defined(TRANSA)) - temp = bk - off; -#ifdef LEFT - temp -= 4; // number of values in A -#else - temp -= 2; // number of values in B -#endif - ptrba += temp*4; - ptrbb += temp*2; -#endif - -#ifdef LEFT - off += 4; // number of values in A -#endif - - C0 = C0+4; - C1 = C1+4; - - } - - if ( bm & 2 ) // do any 2x2 loop - { - -#if (defined(LEFT) && defined(TRANSA)) || (!defined(LEFT) && !defined(TRANSA)) - ptrbb = bb; -#else - ptrba += off*2; - ptrbb = bb + off*2; -#endif - - vres0_0 = VFMVVF_FLOAT(0, vlmax); - vres0_1 = VFMVVF_FLOAT(0, vlmax); - - vres1_0 = VFMVVF_FLOAT(0, vlmax); - vres1_1 = VFMVVF_FLOAT(0, vlmax); - - -#if (defined(LEFT) && !defined(TRANSA)) || (!defined(LEFT) && defined(TRANSA)) - temp = bk-off; -#elif defined(LEFT) - temp = off+2; // number of values in A -#else - temp = off+2; // number of values in B -#endif - for (k = temp; k > 0; k -= vl) - { - vl = VSETVL(k); - VLSEG2_FLOAT(&va0, &va1, ptrba, vl); - VLSEG2_FLOAT(&vb0, &vb1, ptrbb, vl); - - vres0_0 = VFMACCVV_FLOAT(vres0_0, va0, vb0, vl); - vres1_0 = VFMACCVV_FLOAT(vres1_0, va0, vb1, vl); - - vres0_1 = VFMACCVV_FLOAT(vres0_1, va1, vb0, vl); - vres1_1 = VFMACCVV_FLOAT(vres1_1, va1, vb1, vl); - - ptrba += vl * 2; - ptrbb += vl * 2; - } - - vsum0 = VFREDSUMVS_FLOAT(vsum0, vres0_0, v_z0, vlmax); - vsum1 = VFREDSUMVS_FLOAT(vsum1, vres0_1, v_z0, vlmax); - vsum2 = VFREDSUMVS_FLOAT(vsum2, vres1_0, v_z0, vlmax); - vsum3 = VFREDSUMVS_FLOAT(vsum3, vres1_1, v_z0, vlmax); - - C0[0] = alpha * VFMVFS_FLOAT_M1(vsum0); - C0[1] = alpha * VFMVFS_FLOAT_M1(vsum1); - C1[0] = alpha * VFMVFS_FLOAT_M1(vsum2); - C1[1] = alpha * VFMVFS_FLOAT_M1(vsum3); - - -#if ( defined(LEFT) && defined(TRANSA)) || (!defined(LEFT) && !defined(TRANSA)) - temp = bk - off; -#ifdef LEFT - temp -= 2; // number of values in A -#else - temp -= 2; // number of values in B -#endif - ptrba += temp*2; - ptrbb += temp*2; -#endif - -#ifdef LEFT - off += 2; // number of values in A -#endif - - C0 = C0+2; - C1 = C1+2; - - } - - if ( bm & 1 ) // do any 1x2 loop - { - -#if (defined(LEFT) && defined(TRANSA)) || (!defined(LEFT) && !defined(TRANSA)) - ptrbb = bb; -#else - ptrba += off*1; - ptrbb = bb + off*2; -#endif - - - vres0_0 = VFMVVF_FLOAT(0, vlmax); - vres1_0 = VFMVVF_FLOAT(0, vlmax); - - -#if (defined(LEFT) && !defined(TRANSA)) || (!defined(LEFT) && defined(TRANSA)) - temp = bk-off; -#elif defined(LEFT) - temp = off+1; // number of values in A -#else - temp = off+2; // number of values in B -#endif - - for (k = temp; k > 0; k -= vl) - { - vl = VSETVL(k); - va0 = VLEV_FLOAT(ptrba, vl); - VLSEG2_FLOAT(&vb0, &vb1, ptrbb, vl); - - vres0_0 = VFMACCVV_FLOAT(vres0_0, va0, vb0, vl); - vres1_0 = VFMACCVV_FLOAT(vres1_0, va0, vb1, vl); - - ptrba += vl; - ptrbb += vl * 2; - } - - vsum0 = VFREDSUMVS_FLOAT(vsum0, vres0_0, v_z0, vlmax); - vsum1 = VFREDSUMVS_FLOAT(vsum1, vres1_0, v_z0, vlmax); - C0[0] = alpha * VFMVFS_FLOAT_M1(vsum0); - C1[0] = alpha * VFMVFS_FLOAT_M1(vsum1); - - -#if ( defined(LEFT) && defined(TRANSA)) || (!defined(LEFT) && !defined(TRANSA)) - temp = bk - off; -#ifdef LEFT - temp -= 1; // number of values in A -#else - temp -= 2; // number of values in B -#endif - ptrba += temp*1; - ptrbb += temp*2; -#endif - -#ifdef LEFT - off += 1; // number of values in A -#endif - - C0 = C0+1; - C1 = C1+1; - - } - - -#if defined(TRMMKERNEL) && !defined(LEFT) - off += 2; -#endif - - k = (bk<<1); - bb = bb+k; - i = (ldc<<1); - C = C+i; - } - - for (j=0; j<(bn&1); j+=1) // do the Mx1 loops - { - C0 = C; - -#if defined(TRMMKERNEL) && defined(LEFT) - off = offset; -#endif - - ptrba = ba; - - for (i=0; i 0; k -= vl) - { - vl = VSETVL(k); - VLSEG4_FLOAT(&va0, &va1, &va2, &va3, ptrba, vl); - vb0 = VLEV_FLOAT(ptrbb, vl); - - vres0_0 = VFMACCVV_FLOAT(vres0_0, va0, vb0, vl); - - vres0_1 = VFMACCVV_FLOAT(vres0_1, va1, vb0, vl); - - vres0_2 = VFMACCVV_FLOAT(vres0_2, va2, vb0, vl); - - vres0_3 = VFMACCVV_FLOAT(vres0_3, va3, vb0, vl); - - ptrba += vl * 4; - ptrbb += vl; - } - - vsum0 = VFREDSUMVS_FLOAT(vsum0, vres0_0, v_z0, vlmax); - vsum1 = VFREDSUMVS_FLOAT(vsum1, vres0_1, v_z0, vlmax); - vsum2 = VFREDSUMVS_FLOAT(vsum2, vres0_2, v_z0, vlmax); - vsum3 = VFREDSUMVS_FLOAT(vsum3, vres0_3, v_z0, vlmax); - C0[0] = alpha * VFMVFS_FLOAT_M1(vsum0); - C0[1] = alpha * VFMVFS_FLOAT_M1(vsum1); - C0[2] = alpha * VFMVFS_FLOAT_M1(vsum2); - C0[3] = alpha * VFMVFS_FLOAT_M1(vsum3); - - -#if ( defined(LEFT) && defined(TRANSA)) || (!defined(LEFT) && !defined(TRANSA)) - temp = bk - off; -#ifdef LEFT - temp -= 4; // number of values in A -#else - temp -= 1; // number of values in B -#endif - ptrba += temp*4; - ptrbb += temp*1; -#endif - -#ifdef LEFT - off += 4; // number of values in A -#endif - - C0 = C0+4; - - } - - if ( bm & 2 ) // do any 2x1 loop - { - -#if (defined(LEFT) && defined(TRANSA)) || (!defined(LEFT) && !defined(TRANSA)) - ptrbb = bb; -#else - ptrba += off*2; - ptrbb = bb + off*1; -#endif - - vres0_0 = VFMVVF_FLOAT(0, vlmax); - vres0_1 = VFMVVF_FLOAT(0, vlmax); - -#if (defined(LEFT) && !defined(TRANSA)) || (!defined(LEFT) && defined(TRANSA)) - temp = bk-off; -#elif defined(LEFT) - temp = off+2; // number of values in A -#else - temp = off+1; // number of values in B -#endif - - for (k = temp; k > 0; k -= vl) - { - vl = VSETVL(k); - VLSEG2_FLOAT(&va0, &va1, ptrba, vl); - vb0 = VLEV_FLOAT(ptrbb, vl); - - vres0_0 = VFMACCVV_FLOAT(vres0_0, va0, vb0, vl); - - vres0_1 = VFMACCVV_FLOAT(vres0_1, va1, vb0, vl); - - ptrba += vl * 2; - ptrbb += vl; - } - - vsum0 = VFREDSUMVS_FLOAT(vsum0, vres0_0, v_z0, vlmax); - vsum1 = VFREDSUMVS_FLOAT(vsum1, vres0_1, v_z0, vlmax); - C0[0] = alpha * VFMVFS_FLOAT_M1(vsum0); - C0[1] = alpha * VFMVFS_FLOAT_M1(vsum1); - - -#if ( defined(LEFT) && defined(TRANSA)) || (!defined(LEFT) && !defined(TRANSA)) - temp = bk - off; -#ifdef LEFT - temp -= 2; // number of values in A -#else - temp -= 1; // number of values in B -#endif - ptrba += temp*2; - ptrbb += temp*1; -#endif - -#ifdef LEFT - off += 2; // number of values in A -#endif - - C0 = C0+2; - - } - - if ( bm & 1 ) // do any 1x1 loop - { - -#if (defined(LEFT) && defined(TRANSA)) || (!defined(LEFT) && !defined(TRANSA)) - ptrbb = bb; -#else - ptrba += off*1; - ptrbb = bb + off*1; -#endif - - vres0_0 = VFMVVF_FLOAT(0, vlmax); - -#if (defined(LEFT) && !defined(TRANSA)) || (!defined(LEFT) && defined(TRANSA)) - temp = bk-off; -#elif defined(LEFT) - temp = off+1; // number of values in A -#else - temp = off+1; // number of values in B -#endif - - for (k = temp; k > 0; k -= vl) - { - vl = VSETVL(k); - va0 = VLEV_FLOAT(ptrba, vl); - vb0 = VLEV_FLOAT(ptrbb, vl); - - vres0_0 = VFMACCVV_FLOAT(vres0_0, va0, vb0, vl); - - ptrba += vl; - ptrbb += vl; - } - - vsum0 = VFREDSUMVS_FLOAT(vsum0, vres0_0, v_z0, vlmax); - C0[0] = alpha * VFMVFS_FLOAT_M1(vsum0); - - -#if ( defined(LEFT) && defined(TRANSA)) || (!defined(LEFT) && !defined(TRANSA)) - temp = bk - off; -#ifdef LEFT - temp -= 1; // number of values in A -#else - temp -= 1; // number of values in B -#endif - ptrba += temp*1; - ptrbb += temp*1; -#endif - -#ifdef LEFT - off += 1; // number of values in A -#endif - - C0 = C0+1; - - } - -#if defined(TRMMKERNEL) && !defined(LEFT) - off += 1; -#endif - - k = (bk<<0); - bb = bb+k; - C = C+ldc; - } - return 0; -} From 9702d57b11351a5360a2f0326c69c3f550c784d2 Mon Sep 17 00:00:00 2001 From: HellerZheng Date: Wed, 16 Nov 2022 11:11:04 +0800 Subject: [PATCH 005/311] Update Makefile.install --- Makefile.install | 2 -- 1 file changed, 2 deletions(-) diff --git a/Makefile.install b/Makefile.install index 168d08f72..87b5bc870 100644 --- a/Makefile.install +++ b/Makefile.install @@ -202,5 +202,3 @@ endif @echo " endif ()" >> "$(DESTDIR)$(OPENBLAS_CMAKE_DIR)/$(OPENBLAS_CMAKE_CONFIG_VERSION)" @echo "endif ()" >> "$(DESTDIR)$(OPENBLAS_CMAKE_DIR)/$(OPENBLAS_CMAKE_CONFIG_VERSION)" @echo Install OK! - - From 3918d8504e7720d94221025ae6078a2459ccb104 Mon Sep 17 00:00:00 2001 From: Heller Zheng Date: Mon, 21 Nov 2022 19:06:07 -0800 Subject: [PATCH 006/311] nrm2 simple optimization --- kernel/riscv64/nrm2_rvv.c | 20 +++----------------- 1 file changed, 3 insertions(+), 17 deletions(-) diff --git a/kernel/riscv64/nrm2_rvv.c b/kernel/riscv64/nrm2_rvv.c index 3f5d50397..979c31648 100644 --- a/kernel/riscv64/nrm2_rvv.c +++ b/kernel/riscv64/nrm2_rvv.c @@ -39,9 +39,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VFMACCVV_FLOAT vfmacc_vv_f32m8 #define VFMVVF_FLOAT vfmv_v_f_f32m8 #define VFMVVF_FLOAT_M1 vfmv_v_f_f32m1 -#define VFREDMAXVS_FLOAT vfredmax_vs_f32m8_f32m1 #define VFMVFS_FLOAT_M1 vfmv_f_s_f32m1_f32 -#define VFABSV_FLOAT vfabs_v_f32m8 #define ABS fabsf #else #define VSETVL(n) vsetvl_e64m8(n) @@ -54,9 +52,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VFMACCVV_FLOAT vfmacc_vv_f64m8 #define VFMVVF_FLOAT vfmv_v_f_f64m8 #define VFMVVF_FLOAT_M1 vfmv_v_f_f64m1 -#define VFREDMAXVS_FLOAT vfredmax_vs_f64m8_f64m1 #define VFMVFS_FLOAT_M1 vfmv_f_s_f64m1_f64 -#define VFABSV_FLOAT vfabs_v_f64m8 #define ABS fabs #endif @@ -68,12 +64,11 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) if(n == 1) return (ABS(x[0])); FLOAT_V_T vr, v0; - FLOAT_V_T_M1 v_max, v_res; - FLOAT scale = 0.0, ssq = 0.0; + FLOAT_V_T_M1 v_res; + FLOAT ssq = 0.0; size_t vlmax = VSETVL_MAX; v_res = VFMVVF_FLOAT_M1(0, vlmax); - v_max = VFMVVF_FLOAT_M1(0, vlmax); vr = VFMVVF_FLOAT(0, vlmax); @@ -83,9 +78,6 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) vl = VSETVL(n); v0 = VLEV_FLOAT(x, vl); - v0 = VFABSV_FLOAT(v0, vl); - - v_max = VFREDMAXVS_FLOAT(v_max, v0, v_max, vl); vr = VFMACCVV_FLOAT(vr, v0, v0, vl); } @@ -98,20 +90,14 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) vl = VSETVL(n); v0 = VLSEV_FLOAT(x, stride_x, vl); - v0 = VFABSV_FLOAT(v0, vl); - - v_max = VFREDMAXVS_FLOAT(v_max, v0, v_max, vl); vr = VFMACCVV_FLOAT(vr, v0, v0, vl); } - } v_res = VFREDSUM_FLOAT(v_res, vr, v_res, vlmax); ssq = VFMVFS_FLOAT_M1(v_res); - scale = VFMVFS_FLOAT_M1(v_max); - ssq = ssq / (scale*scale); - return(scale * sqrt(ssq)); + return sqrt(ssq); } From 387e8970cd8ce581a6c7bc48418860966140f621 Mon Sep 17 00:00:00 2001 From: Heller Zheng Date: Mon, 28 Nov 2022 21:42:29 -0800 Subject: [PATCH 007/311] Fix merge problem; Update compiling COMMON_OPT per review comments. --- Makefile.prebuild | 2 +- Makefile.riscv64 | 6 +++--- common_riscv64.h | 2 +- 3 files changed, 5 insertions(+), 5 deletions(-) diff --git a/Makefile.prebuild b/Makefile.prebuild index e6a8eab59..c4f4a2602 100644 --- a/Makefile.prebuild +++ b/Makefile.prebuild @@ -56,7 +56,7 @@ TARGET_FLAGS = -march=rv64gcv0p7_zfh_xtheadc -mabi=lp64d endif ifeq ($(TARGET), x280) -TARGET_FLAGS = -march=rv64imafdcv_zba_zbb_zfh_xsfvqmaccqoq_xsfvfhbfmin -mabi=lp64d -mcpu=sifive-x280 +TARGET_FLAGS = -march=rv64imafdcv_zba_zbb_zfh -mabi=lp64d endif ifeq ($(TARGET), RISCV64_GENERIC) diff --git a/Makefile.riscv64 b/Makefile.riscv64 index d6eaf552d..d091984a6 100644 --- a/Makefile.riscv64 +++ b/Makefile.riscv64 @@ -3,10 +3,10 @@ CCOMMON_OPT += -march=rv64imafdcv0p7_zfh_xtheadc -mabi=lp64d -mtune=c920 FCOMMON_OPT += -march=rv64imafdcv0p7_zfh_xtheadc -mabi=lp64d -mtune=c920 -static endif ifeq ($(CORE), x280) -CCOMMON_OPT += -march=rv64imafdcv_zba_zbb_zfh_xsfvqmaccqoq_xsfvfhbfmin -mabi=lp64d -menable-experimental-extensions -mllvm --riscv-v-vector-bits-min=512 -mcpu=sifive-x280 -ffast-math -FCOMMON_OPT += -march=rv64imafdcv_zba_zbb_zfh_xsfvqmaccqoq_xsfvfhbfmin -mabi=lp64d -menable-experimental-extensions -static +CCOMMON_OPT += -march=rv64imafdcv_zba_zbb_zfh -mabi=lp64d -mllvm --riscv-v-vector-bits-min=512 -ffast-math +FCOMMON_OPT += -march=rv64imafdcv_zba_zbb_zfh -mabi=lp64d -static endif ifeq ($(CORE), RISCV64_GENERIC) CCOMMON_OPT += -march=rv64imafdc -mabi=lp64d FCOMMON_OPT += -march=rv64imafdc -mabi=lp64d -static -endif \ No newline at end of file +endif diff --git a/common_riscv64.h b/common_riscv64.h index 221a79901..2092bd5ab 100644 --- a/common_riscv64.h +++ b/common_riscv64.h @@ -92,7 +92,7 @@ static inline int blas_quickdivide(blasint x, blasint y){ #define SEEK_ADDRESS #if defined(C910V) -#include +#include #endif #if defined(x280) From c19dff0a31c58163dc386b0c4270e75f576b97be Mon Sep 17 00:00:00 2001 From: Xianyi Zhang Date: Wed, 25 Jan 2023 19:33:32 +0800 Subject: [PATCH 008/311] Fix T-Head RVV intrinsic API changes. --- kernel/riscv64/amax_vector.c | 8 ++++---- kernel/riscv64/amin_vector.c | 8 ++++---- kernel/riscv64/asum_vector.c | 8 ++++---- kernel/riscv64/axpby_vector.c | 16 ++++++++-------- kernel/riscv64/axpy_vector.c | 16 ++++++++-------- kernel/riscv64/copy_vector.c | 16 ++++++++-------- kernel/riscv64/dot_vector.c | 8 ++++---- kernel/riscv64/gemv_n_vector.c | 16 ++++++++-------- kernel/riscv64/gemv_t_vector.c | 8 ++++---- kernel/riscv64/iamax_vector.c | 8 ++++---- kernel/riscv64/iamin_vector.c | 8 ++++---- kernel/riscv64/imax_vector.c | 8 ++++---- kernel/riscv64/imin_vector.c | 8 ++++---- kernel/riscv64/izamax_vector.c | 4 ++-- kernel/riscv64/izamin_vector.c | 4 ++-- kernel/riscv64/max_vector.c | 8 ++++---- kernel/riscv64/min_vector.c | 8 ++++---- kernel/riscv64/nrm2_vector.c | 8 ++++---- kernel/riscv64/rot_vector.c | 16 ++++++++-------- kernel/riscv64/scal_vector.c | 16 ++++++++-------- kernel/riscv64/swap_vector.c | 16 ++++++++-------- kernel/riscv64/symv_L_vector.c | 16 ++++++++-------- kernel/riscv64/symv_U_vector.c | 16 ++++++++-------- kernel/riscv64/zamax_vector.c | 4 ++-- kernel/riscv64/zamin_vector.c | 4 ++-- kernel/riscv64/zasum_vector.c | 8 ++++---- kernel/riscv64/zaxpby_vector.c | 8 ++++---- kernel/riscv64/zaxpy_vector.c | 8 ++++---- kernel/riscv64/zcopy_vector.c | 8 ++++---- kernel/riscv64/zdot_vector.c | 8 ++++---- kernel/riscv64/zgemv_n_vector.c | 16 ++++++++-------- kernel/riscv64/zgemv_t_vector.c | 4 ++-- kernel/riscv64/zhemv_LM_vector.c | 8 ++++---- kernel/riscv64/zhemv_UV_vector.c | 8 ++++---- kernel/riscv64/znrm2_vector.c | 8 ++++---- kernel/riscv64/zrot_vector.c | 16 ++++++++-------- kernel/riscv64/zscal_vector.c | 8 ++++---- kernel/riscv64/zswap_vector.c | 16 ++++++++-------- 38 files changed, 190 insertions(+), 190 deletions(-) diff --git a/kernel/riscv64/amax_vector.c b/kernel/riscv64/amax_vector.c index b778d3e55..1b7799340 100644 --- a/kernel/riscv64/amax_vector.c +++ b/kernel/riscv64/amax_vector.c @@ -33,8 +33,8 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VSETVL_MAX vsetvlmax_e32m1() #define FLOAT_V_T vfloat32m8_t #define FLOAT_V_T_M1 vfloat32m1_t -#define VLEV_FLOAT vle_v_f32m8 -#define VLSEV_FLOAT vlse_v_f32m8 +#define VLEV_FLOAT vle32_v_f32m8 +#define VLSEV_FLOAT vlse32_v_f32m8 #define VFREDMAXVS_FLOAT vfredmax_vs_f32m8_f32m1 #define MASK_T vbool4_t #define VMFLTVF_FLOAT vmflt_vf_f32m8_b4 @@ -47,8 +47,8 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VSETVL_MAX vsetvlmax_e64m1() #define FLOAT_V_T vfloat64m8_t #define FLOAT_V_T_M1 vfloat64m1_t -#define VLEV_FLOAT vle_v_f64m8 -#define VLSEV_FLOAT vlse_v_f64m8 +#define VLEV_FLOAT vle64_v_f64m8 +#define VLSEV_FLOAT vlse64_v_f64m8 #define VFREDMAXVS_FLOAT vfredmax_vs_f64m8_f64m1 #define MASK_T vbool8_t #define VMFLTVF_FLOAT vmflt_vf_f64m8_b8 diff --git a/kernel/riscv64/amin_vector.c b/kernel/riscv64/amin_vector.c index fd2f83dc9..f9b7defae 100644 --- a/kernel/riscv64/amin_vector.c +++ b/kernel/riscv64/amin_vector.c @@ -34,8 +34,8 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VSETVL_MAX vsetvlmax_e32m1() #define FLOAT_V_T vfloat32m8_t #define FLOAT_V_T_M1 vfloat32m1_t -#define VLEV_FLOAT vle_v_f32m8 -#define VLSEV_FLOAT vlse_v_f32m8 +#define VLEV_FLOAT vle32_v_f32m8 +#define VLSEV_FLOAT vlse32_v_f32m8 #define VFREDMINVS_FLOAT vfredmin_vs_f32m8_f32m1 #define MASK_T vbool4_t #define VMFLTVF_FLOAT vmflt_vf_f32m8_b4 @@ -48,8 +48,8 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VSETVL_MAX vsetvlmax_e32m1() #define FLOAT_V_T vfloat64m8_t #define FLOAT_V_T_M1 vfloat64m1_t -#define VLEV_FLOAT vle_v_f64m8 -#define VLSEV_FLOAT vlse_v_f64m8 +#define VLEV_FLOAT vle64_v_f64m8 +#define VLSEV_FLOAT vlse64_v_f64m8 #define VFREDMINVS_FLOAT vfredmin_vs_f64m8_f64m1 #define MASK_T vbool8_t #define VMFLTVF_FLOAT vmflt_vf_f64m8_b8 diff --git a/kernel/riscv64/asum_vector.c b/kernel/riscv64/asum_vector.c index a82275153..fc73362bc 100644 --- a/kernel/riscv64/asum_vector.c +++ b/kernel/riscv64/asum_vector.c @@ -33,8 +33,8 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VSETVL_MAX vsetvlmax_e32m1() #define FLOAT_V_T vfloat32m8_t #define FLOAT_V_T_M1 vfloat32m1_t -#define VLEV_FLOAT vle_v_f32m8 -#define VLSEV_FLOAT vlse_v_f32m8 +#define VLEV_FLOAT vle32_v_f32m8 +#define VLSEV_FLOAT vlse32_v_f32m8 #define VFREDSUMVS_FLOAT vfredosum_vs_f32m8_f32m1 #define MASK_T vbool4_t #define VMFLTVF_FLOAT vmflt_vf_f32m8_b4 @@ -47,8 +47,8 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VSETVL_MAX vsetvlmax_e64m1() #define FLOAT_V_T vfloat64m8_t #define FLOAT_V_T_M1 vfloat64m1_t -#define VLEV_FLOAT vle_v_f64m8 -#define VLSEV_FLOAT vlse_v_f64m8 +#define VLEV_FLOAT vle64_v_f64m8 +#define VLSEV_FLOAT vlse64_v_f64m8 #define VFREDSUMVS_FLOAT vfredusum_vs_f64m8_f64m1 #define MASK_T vbool8_t #define VMFLTVF_FLOAT vmflt_vf_f64m8_b8 diff --git a/kernel/riscv64/axpby_vector.c b/kernel/riscv64/axpby_vector.c index 988c57ec2..676dfd474 100644 --- a/kernel/riscv64/axpby_vector.c +++ b/kernel/riscv64/axpby_vector.c @@ -30,20 +30,20 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #if !defined(DOUBLE) #define VSETVL(n) vsetvl_e32m4(n) #define FLOAT_V_T vfloat32m4_t -#define VLEV_FLOAT vle_v_f32m4 -#define VLSEV_FLOAT vlse_v_f32m4 -#define VSEV_FLOAT vse_v_f32m4 -#define VSSEV_FLOAT vsse_v_f32m4 +#define VLEV_FLOAT vle32_v_f32m4 +#define VLSEV_FLOAT vlse32_v_f32m4 +#define VSEV_FLOAT vse32_v_f32m4 +#define VSSEV_FLOAT vsse32_v_f32m4 #define VFMACCVF_FLOAT vfmacc_vf_f32m4 #define VFMVVF_FLOAT vfmv_v_f_f32m4 #define VFMULVF_FLOAT vfmul_vf_f32m4 #else #define VSETVL(n) vsetvl_e64m4(n) #define FLOAT_V_T vfloat64m4_t -#define VLEV_FLOAT vle_v_f64m4 -#define VLSEV_FLOAT vlse_v_f64m4 -#define VSEV_FLOAT vse_v_f64m4 -#define VSSEV_FLOAT vsse_v_f64m4 +#define VLEV_FLOAT vle64_v_f64m4 +#define VLSEV_FLOAT vlse64_v_f64m4 +#define VSEV_FLOAT vse64_v_f64m4 +#define VSSEV_FLOAT vsse64_v_f64m4 #define VFMACCVF_FLOAT vfmacc_vf_f64m4 #define VFMVVF_FLOAT vfmv_v_f_f64m4 #define VFMULVF_FLOAT vfmul_vf_f64m4 diff --git a/kernel/riscv64/axpy_vector.c b/kernel/riscv64/axpy_vector.c index 98b9f6814..6f921f2d6 100644 --- a/kernel/riscv64/axpy_vector.c +++ b/kernel/riscv64/axpy_vector.c @@ -30,18 +30,18 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #if !defined(DOUBLE) #define VSETVL(n) vsetvl_e32m4(n) #define FLOAT_V_T vfloat32m4_t -#define VLEV_FLOAT vle_v_f32m4 -#define VLSEV_FLOAT vlse_v_f32m4 -#define VSEV_FLOAT vse_v_f32m4 -#define VSSEV_FLOAT vsse_v_f32m4 +#define VLEV_FLOAT vle32_v_f32m4 +#define VLSEV_FLOAT vlse32_v_f32m4 +#define VSEV_FLOAT vse32_v_f32m4 +#define VSSEV_FLOAT vsse32_v_f32m4 #define VFMACCVF_FLOAT vfmacc_vf_f32m4 #else #define VSETVL(n) vsetvl_e64m4(n) #define FLOAT_V_T vfloat64m4_t -#define VLEV_FLOAT vle_v_f64m4 -#define VLSEV_FLOAT vlse_v_f64m4 -#define VSEV_FLOAT vse_v_f64m4 -#define VSSEV_FLOAT vsse_v_f64m4 +#define VLEV_FLOAT vle64_v_f64m4 +#define VLSEV_FLOAT vlse64_v_f64m4 +#define VSEV_FLOAT vse64_v_f64m4 +#define VSSEV_FLOAT vsse64_v_f64m4 #define VFMACCVF_FLOAT vfmacc_vf_f64m4 #endif diff --git a/kernel/riscv64/copy_vector.c b/kernel/riscv64/copy_vector.c index a46136d6c..fee5e195d 100644 --- a/kernel/riscv64/copy_vector.c +++ b/kernel/riscv64/copy_vector.c @@ -28,17 +28,17 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #if !defined(DOUBLE) #define VSETVL(n) vsetvl_e32m8(n) #define FLOAT_V_T vfloat32m8_t -#define VLEV_FLOAT vle_v_f32m8 -#define VLSEV_FLOAT vlse_v_f32m8 -#define VSEV_FLOAT vse_v_f32m8 -#define VSSEV_FLOAT vsse_v_f32m8 +#define VLEV_FLOAT vle32_v_f32m8 +#define VLSEV_FLOAT vlse32_v_f32m8 +#define VSEV_FLOAT vse32_v_f32m8 +#define VSSEV_FLOAT vsse32_v_f32m8 #else #define VSETVL(n) vsetvl_e64m8(n) #define FLOAT_V_T vfloat64m8_t -#define VLEV_FLOAT vle_v_f64m8 -#define VLSEV_FLOAT vlse_v_f64m8 -#define VSEV_FLOAT vse_v_f64m8 -#define VSSEV_FLOAT vsse_v_f64m8 +#define VLEV_FLOAT vle64_v_f64m8 +#define VLSEV_FLOAT vlse64_v_f64m8 +#define VSEV_FLOAT vse64_v_f64m8 +#define VSSEV_FLOAT vsse64_v_f64m8 #endif int CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y) diff --git a/kernel/riscv64/dot_vector.c b/kernel/riscv64/dot_vector.c index 64efc6c40..f47e0c0b5 100644 --- a/kernel/riscv64/dot_vector.c +++ b/kernel/riscv64/dot_vector.c @@ -32,8 +32,8 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define FLOAT_V_T vfloat32m4_t #define FLOAT_V_T_M1 vfloat32m1_t #define VFMVFS_FLOAT vfmv_f_s_f32m1_f32 -#define VLEV_FLOAT vle_v_f32m4 -#define VLSEV_FLOAT vlse_v_f32m4 +#define VLEV_FLOAT vle32_v_f32m4 +#define VLSEV_FLOAT vlse32_v_f32m4 #define VFREDSUM_FLOAT vfredosum_vs_f32m4_f32m1 #define VFMACCVV_FLOAT vfmacc_vv_f32m4 #define VFMVVF_FLOAT vfmv_v_f_f32m4 @@ -45,8 +45,8 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define FLOAT_V_T vfloat64m4_t #define FLOAT_V_T_M1 vfloat64m1_t #define VFMVFS_FLOAT vfmv_f_s_f64m1_f64 -#define VLEV_FLOAT vle_v_f64m4 -#define VLSEV_FLOAT vlse_v_f64m4 +#define VLEV_FLOAT vle64_v_f64m4 +#define VLSEV_FLOAT vlse64_v_f64m4 #define VFREDSUM_FLOAT vfredusum_vs_f64m4_f64m1 #define VFMACCVV_FLOAT vfmacc_vv_f64m4 #define VFMVVF_FLOAT vfmv_v_f_f64m4 diff --git a/kernel/riscv64/gemv_n_vector.c b/kernel/riscv64/gemv_n_vector.c index 32ca8618b..bb9ab8e5a 100644 --- a/kernel/riscv64/gemv_n_vector.c +++ b/kernel/riscv64/gemv_n_vector.c @@ -29,18 +29,18 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #if !defined(DOUBLE) #define VSETVL(n) vsetvl_e32m4(n) #define FLOAT_V_T vfloat32m4_t -#define VLEV_FLOAT vle_v_f32m4 -#define VLSEV_FLOAT vlse_v_f32m4 -#define VSEV_FLOAT vse_v_f32m4 -#define VSSEV_FLOAT vsse_v_f32m4 +#define VLEV_FLOAT vle32_v_f32m4 +#define VLSEV_FLOAT vlse32_v_f32m4 +#define VSEV_FLOAT vse32_v_f32m4 +#define VSSEV_FLOAT vsse32_v_f32m4 #define VFMACCVF_FLOAT vfmacc_vf_f32m4 #else #define VSETVL(n) vsetvl_e64m4(n) #define FLOAT_V_T vfloat64m4_t -#define VLEV_FLOAT vle_v_f64m4 -#define VLSEV_FLOAT vlse_v_f64m4 -#define VSEV_FLOAT vse_v_f64m4 -#define VSSEV_FLOAT vsse_v_f64m4 +#define VLEV_FLOAT vle64_v_f64m4 +#define VLSEV_FLOAT vlse64_v_f64m4 +#define VSEV_FLOAT vse64_v_f64m4 +#define VSSEV_FLOAT vsse64_v_f64m4 #define VFMACCVF_FLOAT vfmacc_vf_f64m4 #endif diff --git a/kernel/riscv64/gemv_t_vector.c b/kernel/riscv64/gemv_t_vector.c index 7683641fa..7d0b70cbb 100644 --- a/kernel/riscv64/gemv_t_vector.c +++ b/kernel/riscv64/gemv_t_vector.c @@ -32,8 +32,8 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define FLOAT_V_T vfloat32m4_t #define FLOAT_V_T_M1 vfloat32m1_t #define VFMVFS_FLOAT vfmv_f_s_f32m1_f32 -#define VLEV_FLOAT vle_v_f32m4 -#define VLSEV_FLOAT vlse_v_f32m4 +#define VLEV_FLOAT vle32_v_f32m4 +#define VLSEV_FLOAT vlse32_v_f32m4 #define VFREDSUM_FLOAT vfredosum_vs_f32m4_f32m1 #define VFMACCVV_FLOAT vfmacc_vv_f32m4 #define VFMVVF_FLOAT vfmv_v_f_f32m4 @@ -46,8 +46,8 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define FLOAT_V_T vfloat64m4_t #define FLOAT_V_T_M1 vfloat64m1_t #define VFMVFS_FLOAT vfmv_f_s_f64m1_f64 -#define VLEV_FLOAT vle_v_f64m4 -#define VLSEV_FLOAT vlse_v_f64m4 +#define VLEV_FLOAT vle64_v_f64m4 +#define VLSEV_FLOAT vlse64_v_f64m4 #define VFREDSUM_FLOAT vfredusum_vs_f64m4_f64m1 #define VFMACCVV_FLOAT vfmacc_vv_f64m4 #define VFMVVF_FLOAT vfmv_v_f_f64m4 diff --git a/kernel/riscv64/iamax_vector.c b/kernel/riscv64/iamax_vector.c index ecb4cd7a9..9fea522f7 100644 --- a/kernel/riscv64/iamax_vector.c +++ b/kernel/riscv64/iamax_vector.c @@ -35,8 +35,8 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VSETVL_MAX vsetvlmax_e64m1() #define FLOAT_V_T vfloat64m8_t #define FLOAT_V_T_M1 vfloat64m1_t -#define VLEV_FLOAT vle_v_f64m8 -#define VLSEV_FLOAT vlse_v_f64m8 +#define VLEV_FLOAT vle64_v_f64m8 +#define VLSEV_FLOAT vlse64_v_f64m8 #define VFREDMAXVS_FLOAT vfredmax_vs_f64m8_f64m1 #define MASK_T vbool8_t #define VMFLTVF_FLOAT vmflt_vf_f64m8_b8 @@ -60,8 +60,8 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VSETVL_MAX vsetvlmax_e32m1() #define FLOAT_V_T vfloat32m8_t #define FLOAT_V_T_M1 vfloat32m1_t -#define VLEV_FLOAT vle_v_f32m8 -#define VLSEV_FLOAT vlse_v_f32m8 +#define VLEV_FLOAT vle32_v_f32m8 +#define VLSEV_FLOAT vlse32_v_f32m8 #define VFREDMAXVS_FLOAT vfredmax_vs_f32m8_f32m1 #define MASK_T vbool4_t #define VMFLTVF_FLOAT vmflt_vf_f32m8_b4 diff --git a/kernel/riscv64/iamin_vector.c b/kernel/riscv64/iamin_vector.c index c72bb94cc..4e81e7848 100644 --- a/kernel/riscv64/iamin_vector.c +++ b/kernel/riscv64/iamin_vector.c @@ -36,8 +36,8 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VSETVL_MAX vsetvlmax_e64m1() #define FLOAT_V_T vfloat64m8_t #define FLOAT_V_T_M1 vfloat64m1_t -#define VLEV_FLOAT vle_v_f64m8 -#define VLSEV_FLOAT vlse_v_f64m8 +#define VLEV_FLOAT vle64_v_f64m8 +#define VLSEV_FLOAT vlse64_v_f64m8 #define VFREDMINVS_FLOAT vfredmin_vs_f64m8_f64m1 #define MASK_T vbool8_t #define VMFLTVF_FLOAT vmflt_vf_f64m8_b8 @@ -61,8 +61,8 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VSETVL_MAX vsetvlmax_e32m1() #define FLOAT_V_T vfloat32m8_t #define FLOAT_V_T_M1 vfloat32m1_t -#define VLEV_FLOAT vle_v_f32m8 -#define VLSEV_FLOAT vlse_v_f32m8 +#define VLEV_FLOAT vle32_v_f32m8 +#define VLSEV_FLOAT vlse32_v_f32m8 #define VFREDMINVS_FLOAT vfredmin_vs_f32m8_f32m1 #define MASK_T vbool4_t #define VMFLTVF_FLOAT vmflt_vf_f32m8_b4 diff --git a/kernel/riscv64/imax_vector.c b/kernel/riscv64/imax_vector.c index c2d787ab8..ca48a3c48 100644 --- a/kernel/riscv64/imax_vector.c +++ b/kernel/riscv64/imax_vector.c @@ -36,8 +36,8 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VSETVL_MAX vsetvlmax_e64m1() #define FLOAT_V_T vfloat64m8_t #define FLOAT_V_T_M1 vfloat64m1_t -#define VLEV_FLOAT vle_v_f64m8 -#define VLSEV_FLOAT vlse_v_f64m8 +#define VLEV_FLOAT vle64_v_f64m8 +#define VLSEV_FLOAT vlse64_v_f64m8 #define VFREDMAXVS_FLOAT vfredmax_vs_f64m8_f64m1 #define MASK_T vbool8_t #define VMFLTVV_FLOAT vmflt_vv_f64m8_b8 @@ -59,8 +59,8 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VSETVL_MAX vsetvlmax_e32m1() #define FLOAT_V_T vfloat32m8_t #define FLOAT_V_T_M1 vfloat32m1_t -#define VLEV_FLOAT vle_v_f32m8 -#define VLSEV_FLOAT vlse_v_f32m8 +#define VLEV_FLOAT vle32_v_f32m8 +#define VLSEV_FLOAT vlse32_v_f32m8 #define VFREDMAXVS_FLOAT vfredmax_vs_f32m8_f32m1 #define MASK_T vbool4_t #define VMFLTVV_FLOAT vmflt_vv_f32m8_b4 diff --git a/kernel/riscv64/imin_vector.c b/kernel/riscv64/imin_vector.c index dfe9a3310..2a677098d 100644 --- a/kernel/riscv64/imin_vector.c +++ b/kernel/riscv64/imin_vector.c @@ -36,8 +36,8 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VSETVL_MAX vsetvlmax_e64m1() #define FLOAT_V_T vfloat64m8_t #define FLOAT_V_T_M1 vfloat64m1_t -#define VLEV_FLOAT vle_v_f64m8 -#define VLSEV_FLOAT vlse_v_f64m8 +#define VLEV_FLOAT vle64_v_f64m8 +#define VLSEV_FLOAT vlse64_v_f64m8 #define VFREDMINVS_FLOAT vfredmin_vs_f64m8_f64m1 #define MASK_T vbool8_t #define VMFLTVV_FLOAT vmflt_vv_f64m8_b8 @@ -59,8 +59,8 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VSETVL_MAX vsetvlmax_e32m1() #define FLOAT_V_T vfloat32m8_t #define FLOAT_V_T_M1 vfloat32m1_t -#define VLEV_FLOAT vle_v_f32m8 -#define VLSEV_FLOAT vlse_v_f32m8 +#define VLEV_FLOAT vle32_v_f32m8 +#define VLSEV_FLOAT vlse32_v_f32m8 #define VFREDMINVS_FLOAT vfredmin_vs_f32m8_f32m1 #define MASK_T vbool4_t #define VMFLTVV_FLOAT vmflt_vv_f32m8_b4 diff --git a/kernel/riscv64/izamax_vector.c b/kernel/riscv64/izamax_vector.c index fdbdc3ae8..66a101566 100644 --- a/kernel/riscv64/izamax_vector.c +++ b/kernel/riscv64/izamax_vector.c @@ -35,7 +35,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define FLOAT_V_T vfloat64m8_t #define FLOAT_V_T_M1 vfloat64m1_t #define VFMVFS_FLOAT vfmv_f_s_f64m1_f64 -#define VLSEV_FLOAT vlse_v_f64m8 +#define VLSEV_FLOAT vlse64_v_f64m8 #define VFREDMAXVS_FLOAT vfredmax_vs_f64m8_f64m1 #define MASK_T vbool8_t #define VMFLTVF_FLOAT vmflt_vf_f64m8_b8 @@ -63,7 +63,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define FLOAT_V_T vfloat32m8_t #define FLOAT_V_T_M1 vfloat32m1_t #define VFMVFS_FLOAT vfmv_f_s_f32m1_f32 -#define VLSEV_FLOAT vlse_v_f32m8 +#define VLSEV_FLOAT vlse32_v_f32m8 #define VFREDMAXVS_FLOAT vfredmax_vs_f32m8_f32m1 #define MASK_T vbool4_t #define VMFLTVF_FLOAT vmflt_vf_f32m8_b4 diff --git a/kernel/riscv64/izamin_vector.c b/kernel/riscv64/izamin_vector.c index 59c720310..818193a9e 100644 --- a/kernel/riscv64/izamin_vector.c +++ b/kernel/riscv64/izamin_vector.c @@ -36,7 +36,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define FLOAT_V_T vfloat64m8_t #define FLOAT_V_T_M1 vfloat64m1_t #define VFMVFS_FLOAT vfmv_f_s_f64m1_f64 -#define VLSEV_FLOAT vlse_v_f64m8 +#define VLSEV_FLOAT vlse64_v_f64m8 #define VFREDMINVS_FLOAT vfredmin_vs_f64m8_f64m1 #define MASK_T vbool8_t #define VMFLTVF_FLOAT vmflt_vf_f64m8_b8 @@ -64,7 +64,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define FLOAT_V_T vfloat32m8_t #define FLOAT_V_T_M1 vfloat32m1_t #define VFMVFS_FLOAT vfmv_f_s_f32m1_f32 -#define VLSEV_FLOAT vlse_v_f32m8 +#define VLSEV_FLOAT vlse32_v_f32m8 #define VFREDMINVS_FLOAT vfredmin_vs_f32m8_f32m1 #define MASK_T vbool4_t #define VMFLTVF_FLOAT vmflt_vf_f32m8_b4 diff --git a/kernel/riscv64/max_vector.c b/kernel/riscv64/max_vector.c index b988513c9..7f31e9a53 100644 --- a/kernel/riscv64/max_vector.c +++ b/kernel/riscv64/max_vector.c @@ -33,8 +33,8 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VSETVL_MAX vsetvlmax_e32m1() #define FLOAT_V_T vfloat32m8_t #define FLOAT_V_T_M1 vfloat32m1_t -#define VLEV_FLOAT vle_v_f32m8 -#define VLSEV_FLOAT vlse_v_f32m8 +#define VLEV_FLOAT vle32_v_f32m8 +#define VLSEV_FLOAT vlse32_v_f32m8 #define VFREDMAXVS_FLOAT vfredmax_vs_f32m8_f32m1 #define VFMVVF_FLOAT vfmv_v_f_f32m8 #define VFMVVF_FLOAT_M1 vfmv_v_f_f32m1 @@ -44,8 +44,8 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VSETVL_MAX vsetvlmax_e64m1() #define FLOAT_V_T vfloat64m8_t #define FLOAT_V_T_M1 vfloat64m1_t -#define VLEV_FLOAT vle_v_f64m8 -#define VLSEV_FLOAT vlse_v_f64m8 +#define VLEV_FLOAT vle64_v_f64m8 +#define VLSEV_FLOAT vlse64_v_f64m8 #define VFREDMAXVS_FLOAT vfredmax_vs_f64m8_f64m1 #define VFMVVF_FLOAT vfmv_v_f_f64m8 #define VFMVVF_FLOAT_M1 vfmv_v_f_f64m1 diff --git a/kernel/riscv64/min_vector.c b/kernel/riscv64/min_vector.c index be0803df6..14b7e01ed 100644 --- a/kernel/riscv64/min_vector.c +++ b/kernel/riscv64/min_vector.c @@ -33,8 +33,8 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VSETVL_MAX vsetvlmax_e32m1() #define FLOAT_V_T vfloat32m8_t #define FLOAT_V_T_M1 vfloat32m1_t -#define VLEV_FLOAT vle_v_f32m8 -#define VLSEV_FLOAT vlse_v_f32m8 +#define VLEV_FLOAT vle32_v_f32m8 +#define VLSEV_FLOAT vlse32_v_f32m8 #define VFREDMINVS_FLOAT vfredmin_vs_f32m8_f32m1 #define VFMVVF_FLOAT vfmv_v_f_f32m8 #define VFMVVF_FLOAT_M1 vfmv_v_f_f32m1 @@ -44,8 +44,8 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VSETVL_MAX vsetvlmax_e64m1() #define FLOAT_V_T vfloat64m8_t #define FLOAT_V_T_M1 vfloat64m1_t -#define VLEV_FLOAT vle_v_f64m8 -#define VLSEV_FLOAT vlse_v_f64m8 +#define VLEV_FLOAT vle64_v_f64m8 +#define VLSEV_FLOAT vlse64_v_f64m8 #define VFREDMINVS_FLOAT vfredmin_vs_f64m8_f64m1 #define VFMVVF_FLOAT vfmv_v_f_f64m8 #define VFMVVF_FLOAT_M1 vfmv_v_f_f64m1 diff --git a/kernel/riscv64/nrm2_vector.c b/kernel/riscv64/nrm2_vector.c index 2a83e2a52..cf6fdb741 100644 --- a/kernel/riscv64/nrm2_vector.c +++ b/kernel/riscv64/nrm2_vector.c @@ -33,8 +33,8 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VFMVFS_FLOATM4 vfmv_f_s_f32m4_f32 #define FLOAT_V_T_M1 vfloat32m1_t #define VFMVFS_FLOAT vfmv_f_s_f32m1_f32 -#define VLEV_FLOAT vle_v_f32m4 -#define VLSEV_FLOAT vlse_v_f32m4 +#define VLEV_FLOAT vle32_v_f32m4 +#define VLSEV_FLOAT vlse32_v_f32m4 #define VFREDSUM_FLOAT vfredusum_vs_f32m4_f32m1 #define VFMACCVV_FLOAT vfmacc_vv_f32m4 #define VFMVVF_FLOAT vfmv_v_f_f32m4 @@ -55,8 +55,8 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VFMVFS_FLOATM4 vfmv_f_s_f64m4_f64 #define FLOAT_V_T_M1 vfloat64m1_t #define VFMVFS_FLOAT vfmv_f_s_f64m1_f64 -#define VLEV_FLOAT vle_v_f64m4 -#define VLSEV_FLOAT vlse_v_f64m4 +#define VLEV_FLOAT vle64_v_f64m4 +#define VLSEV_FLOAT vlse64_v_f64m4 #define VFREDSUM_FLOAT vfredusum_vs_f64m4_f64m1 #define VFMACCVV_FLOAT vfmacc_vv_f64m4 #define VFMVVF_FLOAT vfmv_v_f_f64m4 diff --git a/kernel/riscv64/rot_vector.c b/kernel/riscv64/rot_vector.c index 9b48d1c69..43a65e552 100644 --- a/kernel/riscv64/rot_vector.c +++ b/kernel/riscv64/rot_vector.c @@ -31,10 +31,10 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VSETVL(n) vsetvl_e32m4(n) #define VSETVL_MAX vsetvlmax_e32m1() #define FLOAT_V_T vfloat32m4_t -#define VLEV_FLOAT vle_v_f32m4 -#define VLSEV_FLOAT vlse_v_f32m4 -#define VSEV_FLOAT vse_v_f32m4 -#define VSSEV_FLOAT vsse_v_f32m4 +#define VLEV_FLOAT vle32_v_f32m4 +#define VLSEV_FLOAT vlse32_v_f32m4 +#define VSEV_FLOAT vse32_v_f32m4 +#define VSSEV_FLOAT vsse32_v_f32m4 #define VFMACCVF_FLOAT vfmacc_vf_f32m4 #define VFMULVF_FLOAT vfmul_vf_f32m4 #define VFMSACVF_FLOAT vfmsac_vf_f32m4 @@ -42,10 +42,10 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VSETVL(n) vsetvl_e64m4(n) #define VSETVL_MAX vsetvlmax_e64m1() #define FLOAT_V_T vfloat64m4_t -#define VLEV_FLOAT vle_v_f64m4 -#define VLSEV_FLOAT vlse_v_f64m4 -#define VSEV_FLOAT vse_v_f64m4 -#define VSSEV_FLOAT vsse_v_f64m4 +#define VLEV_FLOAT vle64_v_f64m4 +#define VLSEV_FLOAT vlse64_v_f64m4 +#define VSEV_FLOAT vse64_v_f64m4 +#define VSSEV_FLOAT vsse64_v_f64m4 #define VFMACCVF_FLOAT vfmacc_vf_f64m4 #define VFMULVF_FLOAT vfmul_vf_f64m4 #define VFMSACVF_FLOAT vfmsac_vf_f64m4 diff --git a/kernel/riscv64/scal_vector.c b/kernel/riscv64/scal_vector.c index 7a3153b7c..8b9ef5a3e 100644 --- a/kernel/riscv64/scal_vector.c +++ b/kernel/riscv64/scal_vector.c @@ -30,20 +30,20 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VSETVL(n) vsetvl_e32m8(n) #define VSETVL_MAX vsetvlmax_e32m1() #define FLOAT_V_T vfloat32m8_t -#define VLEV_FLOAT vle_v_f32m8 -#define VLSEV_FLOAT vlse_v_f32m8 -#define VSEV_FLOAT vse_v_f32m8 -#define VSSEV_FLOAT vsse_v_f32m8 +#define VLEV_FLOAT vle32_v_f32m8 +#define VLSEV_FLOAT vlse32_v_f32m8 +#define VSEV_FLOAT vse32_v_f32m8 +#define VSSEV_FLOAT vsse32_v_f32m8 #define VFMULVF_FLOAT vfmul_vf_f32m8 #define VFMVVF_FLOAT vfmv_v_f_f32m8 #else #define VSETVL(n) vsetvl_e64m8(n) #define VSETVL_MAX vsetvlmax_e64m1() #define FLOAT_V_T vfloat64m8_t -#define VLEV_FLOAT vle_v_f64m8 -#define VLSEV_FLOAT vlse_v_f64m8 -#define VSEV_FLOAT vse_v_f64m8 -#define VSSEV_FLOAT vsse_v_f64m8 +#define VLEV_FLOAT vle64_v_f64m8 +#define VLSEV_FLOAT vlse64_v_f64m8 +#define VSEV_FLOAT vse64_v_f64m8 +#define VSSEV_FLOAT vsse64_v_f64m8 #define VFMULVF_FLOAT vfmul_vf_f64m8 #define VFMVVF_FLOAT vfmv_v_f_f64m8 #endif diff --git a/kernel/riscv64/swap_vector.c b/kernel/riscv64/swap_vector.c index d9421e2f1..b16592808 100644 --- a/kernel/riscv64/swap_vector.c +++ b/kernel/riscv64/swap_vector.c @@ -31,18 +31,18 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VSETVL(n) vsetvl_e32m8(n) #define VSETVL_MAX vsetvlmax_e32m1() #define FLOAT_V_T vfloat32m8_t -#define VLEV_FLOAT vle_v_f32m8 -#define VLSEV_FLOAT vlse_v_f32m8 -#define VSEV_FLOAT vse_v_f32m8 -#define VSSEV_FLOAT vsse_v_f32m8 +#define VLEV_FLOAT vle32_v_f32m8 +#define VLSEV_FLOAT vlse32_v_f32m8 +#define VSEV_FLOAT vse32_v_f32m8 +#define VSSEV_FLOAT vsse32_v_f32m8 #else #define VSETVL(n) vsetvl_e64m8(n) #define VSETVL_MAX vsetvlmax_e64m1() #define FLOAT_V_T vfloat64m8_t -#define VLEV_FLOAT vle_v_f64m8 -#define VLSEV_FLOAT vlse_v_f64m8 -#define VSEV_FLOAT vse_v_f64m8 -#define VSSEV_FLOAT vsse_v_f64m8 +#define VLEV_FLOAT vle64_v_f64m8 +#define VLSEV_FLOAT vlse64_v_f64m8 +#define VSEV_FLOAT vse64_v_f64m8 +#define VSSEV_FLOAT vsse64_v_f64m8 #endif int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT dummy3, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y, FLOAT *dummy, BLASLONG dummy2) diff --git a/kernel/riscv64/symv_L_vector.c b/kernel/riscv64/symv_L_vector.c index 6588f4dda..58ec17b03 100644 --- a/kernel/riscv64/symv_L_vector.c +++ b/kernel/riscv64/symv_L_vector.c @@ -32,10 +32,10 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define FLOAT_V_T vfloat32m4_t #define FLOAT_V_T_M1 vfloat32m1_t #define VFMVFS_FLOAT vfmv_f_s_f32m1_f32 -#define VLEV_FLOAT vle_v_f32m4 -#define VLSEV_FLOAT vlse_v_f32m4 -#define VSEV_FLOAT vse_v_f32m4 -#define VSSEV_FLOAT vsse_v_f32m4 +#define VLEV_FLOAT vle32_v_f32m4 +#define VLSEV_FLOAT vlse32_v_f32m4 +#define VSEV_FLOAT vse32_v_f32m4 +#define VSSEV_FLOAT vsse32_v_f32m4 #define VFREDSUM_FLOAT vfredusum_vs_f32m4_f32m1 #define VFMACCVV_FLOAT vfmacc_vv_f32m4 #define VFMACCVF_FLOAT vfmacc_vf_f32m4 @@ -48,10 +48,10 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define FLOAT_V_T vfloat64m4_t #define FLOAT_V_T_M1 vfloat64m1_t #define VFMVFS_FLOAT vfmv_f_s_f64m1_f64 -#define VLEV_FLOAT vle_v_f64m4 -#define VLSEV_FLOAT vlse_v_f64m4 -#define VSEV_FLOAT vse_v_f64m4 -#define VSSEV_FLOAT vsse_v_f64m4 +#define VLEV_FLOAT vle64_v_f64m4 +#define VLSEV_FLOAT vlse64_v_f64m4 +#define VSEV_FLOAT vse64_v_f64m4 +#define VSSEV_FLOAT vsse64_v_f64m4 #define VFREDSUM_FLOAT vfredusum_vs_f64m4_f64m1 #define VFMACCVV_FLOAT vfmacc_vv_f64m4 #define VFMACCVF_FLOAT vfmacc_vf_f64m4 diff --git a/kernel/riscv64/symv_U_vector.c b/kernel/riscv64/symv_U_vector.c index 31104eae6..34ff0e30a 100644 --- a/kernel/riscv64/symv_U_vector.c +++ b/kernel/riscv64/symv_U_vector.c @@ -32,10 +32,10 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define FLOAT_V_T vfloat32m4_t #define FLOAT_V_T_M1 vfloat32m1_t #define VFMVFS_FLOAT vfmv_f_s_f32m1_f32 -#define VLEV_FLOAT vle_v_f32m4 -#define VLSEV_FLOAT vlse_v_f32m4 -#define VSEV_FLOAT vse_v_f32m4 -#define VSSEV_FLOAT vsse_v_f32m4 +#define VLEV_FLOAT vle32_v_f32m4 +#define VLSEV_FLOAT vlse32_v_f32m4 +#define VSEV_FLOAT vse32_v_f32m4 +#define VSSEV_FLOAT vsse32_v_f32m4 #define VFREDSUM_FLOAT vfredusum_vs_f32m4_f32m1 #define VFMACCVV_FLOAT vfmacc_vv_f32m4 #define VFMACCVF_FLOAT vfmacc_vf_f32m4 @@ -49,10 +49,10 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define FLOAT_V_T vfloat64m4_t #define FLOAT_V_T_M1 vfloat64m1_t #define VFMVFS_FLOAT vfmv_f_s_f64m1_f64 -#define VLEV_FLOAT vle_v_f64m4 -#define VLSEV_FLOAT vlse_v_f64m4 -#define VSEV_FLOAT vse_v_f64m4 -#define VSSEV_FLOAT vsse_v_f64m4 +#define VLEV_FLOAT vle64_v_f64m4 +#define VLSEV_FLOAT vlse64_v_f64m4 +#define VSEV_FLOAT vse64_v_f64m4 +#define VSSEV_FLOAT vsse64_v_f64m4 #define VFREDSUM_FLOAT vfredusum_vs_f64m4_f64m1 #define VFMACCVV_FLOAT vfmacc_vv_f64m4 #define VFMACCVF_FLOAT vfmacc_vf_f64m4 diff --git a/kernel/riscv64/zamax_vector.c b/kernel/riscv64/zamax_vector.c index 9dbeba90f..bfb282ae0 100644 --- a/kernel/riscv64/zamax_vector.c +++ b/kernel/riscv64/zamax_vector.c @@ -34,7 +34,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define FLOAT_V_T vfloat32m8_t #define FLOAT_V_T_M1 vfloat32m1_t #define VFMVFS_FLOAT vfmv_f_s_f32m1_f32 -#define VLSEV_FLOAT vlse_v_f32m8 +#define VLSEV_FLOAT vlse32_v_f32m8 #define VFREDMAXVS_FLOAT vfredmax_vs_f32m8_f32m1 #define MASK_T vbool4_t #define VMFLTVF_FLOAT vmflt_vf_f32m8_b4 @@ -50,7 +50,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define FLOAT_V_T vfloat64m8_t #define FLOAT_V_T_M1 vfloat64m1_t #define VFMVFS_FLOAT vfmv_f_s_f64m1_f64 -#define VLSEV_FLOAT vlse_v_f64m8 +#define VLSEV_FLOAT vlse64_v_f64m8 #define VFREDMAXVS_FLOAT vfredmax_vs_f64m8_f64m1 #define MASK_T vbool8_t #define VMFLTVF_FLOAT vmflt_vf_f64m8_b8 diff --git a/kernel/riscv64/zamin_vector.c b/kernel/riscv64/zamin_vector.c index dc58075ac..d9eca7f10 100644 --- a/kernel/riscv64/zamin_vector.c +++ b/kernel/riscv64/zamin_vector.c @@ -35,7 +35,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define FLOAT_V_T vfloat32m8_t #define FLOAT_V_T_M1 vfloat32m1_t #define VFMVFS_FLOAT vfmv_f_s_f32m1_f32 -#define VLSEV_FLOAT vlse_v_f32m8 +#define VLSEV_FLOAT vlse32_v_f32m8 #define VFREDMINVS_FLOAT vfredmin_vs_f32m8_f32m1 #define MASK_T vbool4_t #define VMFLTVF_FLOAT vmflt_vf_f32m8_b4 @@ -50,7 +50,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define FLOAT_V_T vfloat64m8_t #define FLOAT_V_T_M1 vfloat64m1_t #define VFMVFS_FLOAT vfmv_f_s_f64m1_f64 -#define VLSEV_FLOAT vlse_v_f64m8 +#define VLSEV_FLOAT vlse64_v_f64m8 #define VFREDMINVS_FLOAT vfredmin_vs_f64m8_f64m1 #define MASK_T vbool8_t #define VMFLTVF_FLOAT vmflt_vf_f64m8_b8 diff --git a/kernel/riscv64/zasum_vector.c b/kernel/riscv64/zasum_vector.c index 8386ab62e..0d1cc42f1 100644 --- a/kernel/riscv64/zasum_vector.c +++ b/kernel/riscv64/zasum_vector.c @@ -34,8 +34,8 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define FLOAT_V_T vfloat32m8_t #define FLOAT_V_T_M1 vfloat32m1_t #define VFFMVFS_FLOAT vfmv_f_s_f32m1_f32 -#define VLEV_FLOAT vle_v_f32m8 -#define VLSEV_FLOAT vlse_v_f32m8 +#define VLEV_FLOAT vle32_v_f32m8 +#define VLSEV_FLOAT vlse32_v_f32m8 #define VFREDSUMVS_FLOAT vfredusum_vs_f32m8_f32m1 #define MASK_T vbool4_t #define VMFLTVF_FLOAT vmflt_vf_f32m8_b4 @@ -49,8 +49,8 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define FLOAT_V_T vfloat64m8_t #define FLOAT_V_T_M1 vfloat64m1_t #define VFFMVFS_FLOAT vfmv_f_s_f64m1_f64 -#define VLEV_FLOAT vle_v_f64m8 -#define VLSEV_FLOAT vlse_v_f64m8 +#define VLEV_FLOAT vle64_v_f64m8 +#define VLSEV_FLOAT vlse64_v_f64m8 #define VFREDSUMVS_FLOAT vfredusum_vs_f64m8_f64m1 #define MASK_T vbool8_t #define VMFLTVF_FLOAT vmflt_vf_f64m8_b8 diff --git a/kernel/riscv64/zaxpby_vector.c b/kernel/riscv64/zaxpby_vector.c index 3eca20415..5e6034ac5 100644 --- a/kernel/riscv64/zaxpby_vector.c +++ b/kernel/riscv64/zaxpby_vector.c @@ -30,8 +30,8 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #if !defined(DOUBLE) #define VSETVL(n) vsetvl_e32m4(n) #define FLOAT_V_T vfloat32m4_t -#define VLSEV_FLOAT vlse_v_f32m4 -#define VSSEV_FLOAT vsse_v_f32m4 +#define VLSEV_FLOAT vlse32_v_f32m4 +#define VSSEV_FLOAT vsse32_v_f32m4 #define VFMACCVF_FLOAT vfmacc_vf_f32m4 #define VFMVVF_FLOAT vfmv_v_f_f32m4 #define VFMULVF_FLOAT vfmul_vf_f32m4 @@ -40,8 +40,8 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #else #define VSETVL(n) vsetvl_e64m4(n) #define FLOAT_V_T vfloat64m4_t -#define VLSEV_FLOAT vlse_v_f64m4 -#define VSSEV_FLOAT vsse_v_f64m4 +#define VLSEV_FLOAT vlse64_v_f64m4 +#define VSSEV_FLOAT vsse64_v_f64m4 #define VFMACCVF_FLOAT vfmacc_vf_f64m4 #define VFMVVF_FLOAT vfmv_v_f_f64m4 #define VFMULVF_FLOAT vfmul_vf_f64m4 diff --git a/kernel/riscv64/zaxpy_vector.c b/kernel/riscv64/zaxpy_vector.c index 303d3541e..4ccfe4a81 100644 --- a/kernel/riscv64/zaxpy_vector.c +++ b/kernel/riscv64/zaxpy_vector.c @@ -30,15 +30,15 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #if !defined(DOUBLE) #define VSETVL(n) vsetvl_e32m4(n) #define FLOAT_V_T vfloat32m4_t -#define VLSEV_FLOAT vlse_v_f32m4 -#define VSSEV_FLOAT vsse_v_f32m4 +#define VLSEV_FLOAT vlse32_v_f32m4 +#define VSSEV_FLOAT vsse32_v_f32m4 #define VFMACCVF_FLOAT vfmacc_vf_f32m4 #define VFNMSACVF_FLOAT vfnmsac_vf_f32m4 #else #define VSETVL(n) vsetvl_e64m4(n) #define FLOAT_V_T vfloat64m4_t -#define VLSEV_FLOAT vlse_v_f64m4 -#define VSSEV_FLOAT vsse_v_f64m4 +#define VLSEV_FLOAT vlse64_v_f64m4 +#define VSSEV_FLOAT vsse64_v_f64m4 #define VFMACCVF_FLOAT vfmacc_vf_f64m4 #define VFNMSACVF_FLOAT vfnmsac_vf_f64m4 #endif diff --git a/kernel/riscv64/zcopy_vector.c b/kernel/riscv64/zcopy_vector.c index 600f02bba..55a480a35 100644 --- a/kernel/riscv64/zcopy_vector.c +++ b/kernel/riscv64/zcopy_vector.c @@ -29,13 +29,13 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #if !defined(DOUBLE) #define VSETVL(n) vsetvl_e32m4(n) #define FLOAT_V_T vfloat32m4_t -#define VLSEV_FLOAT vlse_v_f32m4 -#define VSSEV_FLOAT vsse_v_f32m4 +#define VLSEV_FLOAT vlse32_v_f32m4 +#define VSSEV_FLOAT vsse32_v_f32m4 #else #define VSETVL(n) vsetvl_e64m4(n) #define FLOAT_V_T vfloat64m4_t -#define VLSEV_FLOAT vlse_v_f64m4 -#define VSSEV_FLOAT vsse_v_f64m4 +#define VLSEV_FLOAT vlse64_v_f64m4 +#define VSSEV_FLOAT vsse64_v_f64m4 #endif diff --git a/kernel/riscv64/zdot_vector.c b/kernel/riscv64/zdot_vector.c index ec38ed9d2..0900206b3 100644 --- a/kernel/riscv64/zdot_vector.c +++ b/kernel/riscv64/zdot_vector.c @@ -32,8 +32,8 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define FLOAT_V_T vfloat32m4_t #define FLOAT_V_T_M1 vfloat32m1_t #define VFMVFS_FLOAT vfmv_f_s_f32m1_f32 -#define VLEV_FLOAT vle_v_f32m4 -#define VLSEV_FLOAT vlse_v_f32m4 +#define VLEV_FLOAT vle32_v_f32m4 +#define VLSEV_FLOAT vlse32_v_f32m4 #define VFREDSUM_FLOAT vfredusum_vs_f32m4_f32m1 #define VFMACCVV_FLOAT vfmacc_vv_f32m4 #define VFMVVF_FLOAT vfmv_v_f_f32m4 @@ -48,8 +48,8 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define FLOAT_V_T vfloat64m4_t #define FLOAT_V_T_M1 vfloat64m1_t #define VFMVFS_FLOAT vfmv_f_s_f64m1_f64 -#define VLEV_FLOAT vle_v_f64m4 -#define VLSEV_FLOAT vlse_v_f64m4 +#define VLEV_FLOAT vle64_v_f64m4 +#define VLSEV_FLOAT vlse64_v_f64m4 #define VFREDSUM_FLOAT vfredusum_vs_f64m4_f64m1 #define VFMACCVV_FLOAT vfmacc_vv_f64m4 #define VFMVVF_FLOAT vfmv_v_f_f64m4 diff --git a/kernel/riscv64/zgemv_n_vector.c b/kernel/riscv64/zgemv_n_vector.c index b5ee1f054..3095c28f9 100644 --- a/kernel/riscv64/zgemv_n_vector.c +++ b/kernel/riscv64/zgemv_n_vector.c @@ -29,19 +29,19 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #if !defined(DOUBLE) #define VSETVL(n) vsetvl_e32m4(n) #define FLOAT_V_T vfloat32m4_t -#define VLEV_FLOAT vle_v_f32m4 -#define VLSEV_FLOAT vlse_v_f32m4 -#define VSEV_FLOAT vse_v_f32m4 -#define VSSEV_FLOAT vsse_v_f32m4 +#define VLEV_FLOAT vle32_v_f32m4 +#define VLSEV_FLOAT vlse32_v_f32m4 +#define VSEV_FLOAT vse32_v_f32m4 +#define VSSEV_FLOAT vsse32_v_f32m4 #define VFMACCVF_FLOAT vfmacc_vf_f32m4 #define VFNMSACVF_FLOAT vfnmsac_vf_f32m4 #else #define VSETVL(n) vsetvl_e64m4(n) #define FLOAT_V_T vfloat64m4_t -#define VLEV_FLOAT vle_v_f64m4 -#define VLSEV_FLOAT vlse_v_f64m4 -#define VSEV_FLOAT vse_v_f64m4 -#define VSSEV_FLOAT vsse_v_f64m4 +#define VLEV_FLOAT vle64_v_f64m4 +#define VLSEV_FLOAT vlse64_v_f64m4 +#define VSEV_FLOAT vse64_v_f64m4 +#define VSSEV_FLOAT vsse64_v_f64m4 #define VFMACCVF_FLOAT vfmacc_vf_f64m4 #define VFNMSACVF_FLOAT vfnmsac_vf_f64m4 #endif diff --git a/kernel/riscv64/zgemv_t_vector.c b/kernel/riscv64/zgemv_t_vector.c index e930dc2a2..a7a8a5279 100644 --- a/kernel/riscv64/zgemv_t_vector.c +++ b/kernel/riscv64/zgemv_t_vector.c @@ -32,7 +32,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define FLOAT_V_T vfloat32m4_t #define FLOAT_V_T_M1 vfloat32m1_t #define VFMVFS_FLOAT vfmv_f_s_f32m1_f32 -#define VLSEV_FLOAT vlse_v_f32m4 +#define VLSEV_FLOAT vlse32_v_f32m4 #define VFREDSUM_FLOAT vfredusum_vs_f32m4_f32m1 #define VFMACCVV_FLOAT vfmacc_vv_f32m4 #define VFNMSACVV_FLOAT vfnmsac_vv_f32m4 @@ -45,7 +45,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define FLOAT_V_T vfloat64m4_t #define FLOAT_V_T_M1 vfloat64m1_t #define VFMVFS_FLOAT vfmv_f_s_f64m1_f64 -#define VLSEV_FLOAT vlse_v_f64m4 +#define VLSEV_FLOAT vlse64_v_f64m4 #define VFREDSUM_FLOAT vfredusum_vs_f64m4_f64m1 #define VFMACCVV_FLOAT vfmacc_vv_f64m4 #define VFNMSACVV_FLOAT vfnmsac_vv_f64m4 diff --git a/kernel/riscv64/zhemv_LM_vector.c b/kernel/riscv64/zhemv_LM_vector.c index 275ee9131..0a284a999 100644 --- a/kernel/riscv64/zhemv_LM_vector.c +++ b/kernel/riscv64/zhemv_LM_vector.c @@ -32,8 +32,8 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define FLOAT_V_T vfloat32m4_t #define FLOAT_V_T_M1 vfloat32m1_t #define VFMVFS_FLOAT vfmv_f_s_f32m1_f32 -#define VLSEV_FLOAT vlse_v_f32m4 -#define VSSEV_FLOAT vsse_v_f32m4 +#define VLSEV_FLOAT vlse32_v_f32m4 +#define VSSEV_FLOAT vsse32_v_f32m4 #define VFREDSUM_FLOAT vfredusum_vs_f32m4_f32m1 #define VFMACCVV_FLOAT vfmacc_vv_f32m4 #define VFMACCVF_FLOAT vfmacc_vf_f32m4 @@ -48,8 +48,8 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define FLOAT_V_T vfloat64m4_t #define FLOAT_V_T_M1 vfloat64m1_t #define VFMVFS_FLOAT vfmv_f_s_f64m1_f64 -#define VLSEV_FLOAT vlse_v_f64m4 -#define VSSEV_FLOAT vsse_v_f64m4 +#define VLSEV_FLOAT vlse64_v_f64m4 +#define VSSEV_FLOAT vsse64_v_f64m4 #define VFREDSUM_FLOAT vfredusum_vs_f64m4_f64m1 #define VFMACCVV_FLOAT vfmacc_vv_f64m4 #define VFMACCVF_FLOAT vfmacc_vf_f64m4 diff --git a/kernel/riscv64/zhemv_UV_vector.c b/kernel/riscv64/zhemv_UV_vector.c index 2f46977d4..33b7c9c25 100644 --- a/kernel/riscv64/zhemv_UV_vector.c +++ b/kernel/riscv64/zhemv_UV_vector.c @@ -32,8 +32,8 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define FLOAT_V_T vfloat32m4_t #define FLOAT_V_T_M1 vfloat32m1_t #define VFMVFS_FLOAT vfmv_f_s_f32m1_f32 -#define VLSEV_FLOAT vlse_v_f32m4 -#define VSSEV_FLOAT vsse_v_f32m4 +#define VLSEV_FLOAT vlse32_v_f32m4 +#define VSSEV_FLOAT vsse32_v_f32m4 #define VFREDSUM_FLOAT vfredusum_vs_f32m4_f32m1 #define VFMACCVV_FLOAT vfmacc_vv_f32m4 #define VFMACCVF_FLOAT vfmacc_vf_f32m4 @@ -48,8 +48,8 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define FLOAT_V_T vfloat64m4_t #define FLOAT_V_T_M1 vfloat64m1_t #define VFMVFS_FLOAT vfmv_f_s_f64m1_f64 -#define VLSEV_FLOAT vlse_v_f64m4 -#define VSSEV_FLOAT vsse_v_f64m4 +#define VLSEV_FLOAT vlse64_v_f64m4 +#define VSSEV_FLOAT vsse64_v_f64m4 #define VFREDSUM_FLOAT vfredusum_vs_f64m4_f64m1 #define VFMACCVV_FLOAT vfmacc_vv_f64m4 #define VFMACCVF_FLOAT vfmacc_vf_f64m4 diff --git a/kernel/riscv64/znrm2_vector.c b/kernel/riscv64/znrm2_vector.c index 59d0e219d..cadabdb75 100644 --- a/kernel/riscv64/znrm2_vector.c +++ b/kernel/riscv64/znrm2_vector.c @@ -32,8 +32,8 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define FLOAT_V_T vfloat32m4_t #define FLOAT_V_T_M1 vfloat32m1_t #define VFMVFS_FLOAT vfmv_f_s_f32m1_f32 -#define VLEV_FLOAT vle_v_f32m4 -#define VLSEV_FLOAT vlse_v_f32m4 +#define VLEV_FLOAT vle32_v_f32m4 +#define VLSEV_FLOAT vlse32_v_f32m4 #define VFREDSUM_FLOAT vfredusum_vs_f32m4_f32m1 #define VFMACCVV_FLOAT vfmacc_vv_f32m4 #define VFMVVF_FLOAT vfmv_v_f_f32m4 @@ -53,8 +53,8 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define FLOAT_V_T vfloat64m4_t #define FLOAT_V_T_M1 vfloat64m1_t #define VFMVFS_FLOAT vfmv_f_s_f64m1_f64 -#define VLEV_FLOAT vle_v_f64m4 -#define VLSEV_FLOAT vlse_v_f64m4 +#define VLEV_FLOAT vle64_v_f64m4 +#define VLSEV_FLOAT vlse64_v_f64m4 #define VFREDSUM_FLOAT vfredusum_vs_f64m4_f64m1 #define VFMACCVV_FLOAT vfmacc_vv_f64m4 #define VFMVVF_FLOAT vfmv_v_f_f64m4 diff --git a/kernel/riscv64/zrot_vector.c b/kernel/riscv64/zrot_vector.c index 2fdd8135a..858dfd173 100644 --- a/kernel/riscv64/zrot_vector.c +++ b/kernel/riscv64/zrot_vector.c @@ -30,10 +30,10 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VSETVL(n) vsetvl_e32m4(n) #define VSETVL_MAX vsetvlmax_e32m1() #define FLOAT_V_T vfloat32m4_t -#define VLEV_FLOAT vle_v_f32m4 -#define VLSEV_FLOAT vlse_v_f32m4 -#define VSEV_FLOAT vse_v_f32m4 -#define VSSEV_FLOAT vsse_v_f32m4 +#define VLEV_FLOAT vle32_v_f32m4 +#define VLSEV_FLOAT vlse32_v_f32m4 +#define VSEV_FLOAT vse32_v_f32m4 +#define VSSEV_FLOAT vsse32_v_f32m4 #define VFMACCVF_FLOAT vfmacc_vf_f32m4 #define VFMULVF_FLOAT vfmul_vf_f32m4 #define VFNMSACVF_FLOAT vfnmsac_vf_f32m4 @@ -41,10 +41,10 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VSETVL(n) vsetvl_e64m4(n) #define VSETVL_MAX vsetvlmax_e64m1() #define FLOAT_V_T vfloat64m4_t -#define VLEV_FLOAT vle_v_f64m4 -#define VLSEV_FLOAT vlse_v_f64m4 -#define VSEV_FLOAT vse_v_f64m4 -#define VSSEV_FLOAT vsse_v_f64m4 +#define VLEV_FLOAT vle64_v_f64m4 +#define VLSEV_FLOAT vlse64_v_f64m4 +#define VSEV_FLOAT vse64_v_f64m4 +#define VSSEV_FLOAT vsse64_v_f64m4 #define VFMACCVF_FLOAT vfmacc_vf_f64m4 #define VFMULVF_FLOAT vfmul_vf_f64m4 #define VFNMSACVF_FLOAT vfnmsac_vf_f64m4 diff --git a/kernel/riscv64/zscal_vector.c b/kernel/riscv64/zscal_vector.c index 64323aa3a..d275b75f8 100644 --- a/kernel/riscv64/zscal_vector.c +++ b/kernel/riscv64/zscal_vector.c @@ -30,8 +30,8 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VSETVL(n) vsetvl_e32m4(n) #define VSETVL_MAX vsetvlmax_e32m1() #define FLOAT_V_T vfloat32m4_t -#define VLSEV_FLOAT vlse_v_f32m4 -#define VSSEV_FLOAT vsse_v_f32m4 +#define VLSEV_FLOAT vlse32_v_f32m4 +#define VSSEV_FLOAT vsse32_v_f32m4 #define VFMACCVF_FLOAT vfmacc_vf_f32m4 #define VFMULVF_FLOAT vfmul_vf_f32m4 #define VFNMSACVF_FLOAT vfnmsac_vf_f32m4 @@ -40,8 +40,8 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VSETVL(n) vsetvl_e64m4(n) #define VSETVL_MAX vsetvlmax_e64m1() #define FLOAT_V_T vfloat64m4_t -#define VLSEV_FLOAT vlse_v_f64m4 -#define VSSEV_FLOAT vsse_v_f64m4 +#define VLSEV_FLOAT vlse64_v_f64m4 +#define VSSEV_FLOAT vsse64_v_f64m4 #define VFMACCVF_FLOAT vfmacc_vf_f64m4 #define VFMULVF_FLOAT vfmul_vf_f64m4 #define VFNMSACVF_FLOAT vfnmsac_vf_f64m4 diff --git a/kernel/riscv64/zswap_vector.c b/kernel/riscv64/zswap_vector.c index 7550294b5..c1dcaccab 100644 --- a/kernel/riscv64/zswap_vector.c +++ b/kernel/riscv64/zswap_vector.c @@ -31,18 +31,18 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VSETVL(n) vsetvl_e32m8(n) #define VSETVL_MAX vsetvlmax_e32m1() #define FLOAT_V_T vfloat32m8_t -#define VLEV_FLOAT vle_v_f32m8 -#define VLSEV_FLOAT vlse_v_f32m8 -#define VSEV_FLOAT vse_v_f32m8 -#define VSSEV_FLOAT vsse_v_f32m8 +#define VLEV_FLOAT vle32_v_f32m8 +#define VLSEV_FLOAT vlse32_v_f32m8 +#define VSEV_FLOAT vse32_v_f32m8 +#define VSSEV_FLOAT vsse32_v_f32m8 #else #define VSETVL(n) vsetvl_e64m8(n) #define VSETVL_MAX vsetvlmax_e64m1() #define FLOAT_V_T vfloat64m8_t -#define VLEV_FLOAT vle_v_f64m8 -#define VLSEV_FLOAT vlse_v_f64m8 -#define VSEV_FLOAT vse_v_f64m8 -#define VSSEV_FLOAT vsse_v_f64m8 +#define VLEV_FLOAT vle64_v_f64m8 +#define VLSEV_FLOAT vlse64_v_f64m8 +#define VSEV_FLOAT vse64_v_f64m8 +#define VSSEV_FLOAT vsse64_v_f64m8 #endif int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT dummy3, FLOAT dummy4, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y, FLOAT *dummy, BLASLONG dummy2) From 63cf4d01668f8f6c73a05039bc36785ba78b0940 Mon Sep 17 00:00:00 2001 From: Heller Zheng Date: Wed, 1 Feb 2023 19:13:44 -0800 Subject: [PATCH 009/311] add riscv level3 C,Z kernel functions. --- kernel/riscv64/KERNEL.x280 | 85 +++- kernel/riscv64/trmm_lncopy_rvv_v1.c | 8 +- kernel/riscv64/trsm_kernel_LN_rvv_v1.c | 644 +++--------------------- kernel/riscv64/trsm_kernel_LT_rvv_v1.c | 658 +++---------------------- kernel/riscv64/trsm_kernel_RN_rvv_v1.c | 610 +++-------------------- kernel/riscv64/trsm_kernel_RT_rvv_v1.c | 623 +++-------------------- kernel/riscv64/zgemm_ncopy_4_rvv.c | 121 +++++ kernel/riscv64/zgemm_ncopy_rvv_v1.c | 74 +++ kernel/riscv64/zgemm_tcopy_4_rvv.c | 181 +++++++ kernel/riscv64/zgemm_tcopy_rvv_v1.c | 74 +++ kernel/riscv64/zgemmkernel_rvv_v1x4.c | 475 ++++++++++++++++++ kernel/riscv64/zhemm_ltcopy_rvv_v1.c | 124 +++++ kernel/riscv64/zhemm_utcopy_rvv_v1.c | 120 +++++ kernel/riscv64/zsymm_lcopy_rvv_v1.c | 106 ++++ kernel/riscv64/zsymm_ucopy_rvv_v1.c | 106 ++++ kernel/riscv64/ztrmm_lncopy_rvv_v1.c | 145 ++++++ kernel/riscv64/ztrmm_ltcopy_rvv_v1.c | 143 ++++++ kernel/riscv64/ztrmm_uncopy_rvv_v1.c | 144 ++++++ kernel/riscv64/ztrmm_utcopy_rvv_v1.c | 140 ++++++ kernel/riscv64/ztrmmkernel_rvv_v1x4.c | 574 +++++++++++++++++++++ kernel/riscv64/ztrsm_lncopy_rvv_v1.c | 115 +++++ kernel/riscv64/ztrsm_ltcopy_rvv_v1.c | 114 +++++ kernel/riscv64/ztrsm_uncopy_rvv_v1.c | 113 +++++ kernel/riscv64/ztrsm_utcopy_rvv_v1.c | 115 +++++ param.h | 10 +- 25 files changed, 3342 insertions(+), 2280 deletions(-) create mode 100644 kernel/riscv64/zgemm_ncopy_4_rvv.c create mode 100644 kernel/riscv64/zgemm_ncopy_rvv_v1.c create mode 100644 kernel/riscv64/zgemm_tcopy_4_rvv.c create mode 100644 kernel/riscv64/zgemm_tcopy_rvv_v1.c create mode 100644 kernel/riscv64/zgemmkernel_rvv_v1x4.c create mode 100644 kernel/riscv64/zhemm_ltcopy_rvv_v1.c create mode 100644 kernel/riscv64/zhemm_utcopy_rvv_v1.c create mode 100644 kernel/riscv64/zsymm_lcopy_rvv_v1.c create mode 100644 kernel/riscv64/zsymm_ucopy_rvv_v1.c create mode 100644 kernel/riscv64/ztrmm_lncopy_rvv_v1.c create mode 100644 kernel/riscv64/ztrmm_ltcopy_rvv_v1.c create mode 100644 kernel/riscv64/ztrmm_uncopy_rvv_v1.c create mode 100644 kernel/riscv64/ztrmm_utcopy_rvv_v1.c create mode 100644 kernel/riscv64/ztrmmkernel_rvv_v1x4.c create mode 100644 kernel/riscv64/ztrsm_lncopy_rvv_v1.c create mode 100644 kernel/riscv64/ztrsm_ltcopy_rvv_v1.c create mode 100644 kernel/riscv64/ztrsm_uncopy_rvv_v1.c create mode 100644 kernel/riscv64/ztrsm_utcopy_rvv_v1.c diff --git a/kernel/riscv64/KERNEL.x280 b/kernel/riscv64/KERNEL.x280 index 4d64354fb..217d8534e 100644 --- a/kernel/riscv64/KERNEL.x280 +++ b/kernel/riscv64/KERNEL.x280 @@ -118,8 +118,8 @@ DGEMVTKERNEL = gemv_t_rvv.c CGEMVTKERNEL = zgemv_t_rvv.c ZGEMVTKERNEL = zgemv_t_rvv.c -CTRMMKERNEL = ztrmmkernel_2x2_rvv.c -ZTRMMKERNEL = ztrmmkernel_2x2_rvv.c +CTRMMKERNEL = ztrmmkernel_rvv_v1x4.c +ZTRMMKERNEL = ztrmmkernel_rvv_v1x4.c # SGEMM_UNROLL_N set in params.h ifeq ($(SGEMM_UNROLL_N), 8) @@ -168,17 +168,28 @@ DSYMMUCOPY_M = symm_ucopy_rvv_v1.c DSYMMLCOPY_M = symm_lcopy_rvv_v1.c endif -CGEMMKERNEL = ../generic/zgemmkernel_2x2.c -CGEMMONCOPY = ../generic/zgemm_ncopy_2.c -CGEMMOTCOPY = ../generic/zgemm_tcopy_2.c -CGEMMONCOPYOBJ = cgemm_oncopy.o -CGEMMOTCOPYOBJ = cgemm_otcopy.o +CGEMMKERNEL = zgemmkernel_rvv_v1x4.c +CGEMMINCOPY = zgemm_ncopy_rvv_v1.c +CGEMMITCOPY = zgemm_tcopy_rvv_v1.c +CGEMMONCOPY = zgemm_ncopy_4_rvv.c +CGEMMOTCOPY = zgemm_tcopy_4_rvv.c -ZGEMMKERNEL = ../generic/zgemmkernel_2x2.c -ZGEMMONCOPY = ../generic/zgemm_ncopy_2.c -ZGEMMOTCOPY = ../generic/zgemm_tcopy_2.c -ZGEMMONCOPYOBJ = zgemm_oncopy.o -ZGEMMOTCOPYOBJ = zgemm_otcopy.o +CGEMMINCOPYOBJ = cgemm_incopy$(TSUFFIX).$(SUFFIX) +CGEMMITCOPYOBJ = cgemm_itcopy$(TSUFFIX).$(SUFFIX) +CGEMMONCOPYOBJ = cgemm_oncopy$(TSUFFIX).$(SUFFIX) +CGEMMOTCOPYOBJ = cgemm_otcopy$(TSUFFIX).$(SUFFIX) + +ZGEMMKERNEL = zgemmkernel_rvv_v1x4.c + +ZGEMMINCOPY = zgemm_ncopy_rvv_v1.c +ZGEMMITCOPY = zgemm_tcopy_rvv_v1.c +ZGEMMONCOPY = zgemm_ncopy_4_rvv.c +ZGEMMOTCOPY = zgemm_tcopy_4_rvv.c + +ZGEMMINCOPYOBJ = zgemm_incopy$(TSUFFIX).$(SUFFIX) +ZGEMMITCOPYOBJ = zgemm_itcopy$(TSUFFIX).$(SUFFIX) +ZGEMMONCOPYOBJ = zgemm_oncopy$(TSUFFIX).$(SUFFIX) +ZGEMMOTCOPYOBJ = zgemm_otcopy$(TSUFFIX).$(SUFFIX) STRSMKERNEL_LN = trsm_kernel_LN_rvv_v1.c STRSMKERNEL_LT = trsm_kernel_LT_rvv_v1.c @@ -190,20 +201,25 @@ DTRSMKERNEL_LT = trsm_kernel_LT_rvv_v1.c DTRSMKERNEL_RN = trsm_kernel_RN_rvv_v1.c DTRSMKERNEL_RT = trsm_kernel_RT_rvv_v1.c -CTRSMKERNEL_LN = ../generic/trsm_kernel_LN.c -CTRSMKERNEL_LT = ../generic/trsm_kernel_LT.c -CTRSMKERNEL_RN = ../generic/trsm_kernel_RN.c -CTRSMKERNEL_RT = ../generic/trsm_kernel_RT.c +CTRSMKERNEL_LN = trsm_kernel_LN_rvv_v1.c +CTRSMKERNEL_LT = trsm_kernel_LT_rvv_v1.c +CTRSMKERNEL_RN = trsm_kernel_RN_rvv_v1.c +CTRSMKERNEL_RT = trsm_kernel_RT_rvv_v1.c -ZTRSMKERNEL_LN = ../generic/trsm_kernel_LN.c -ZTRSMKERNEL_LT = ../generic/trsm_kernel_LT.c -ZTRSMKERNEL_RN = ../generic/trsm_kernel_RN.c -ZTRSMKERNEL_RT = ../generic/trsm_kernel_RT.c +ZTRSMKERNEL_LN = trsm_kernel_LN_rvv_v1.c +ZTRSMKERNEL_LT = trsm_kernel_LT_rvv_v1.c +ZTRSMKERNEL_RN = trsm_kernel_RN_rvv_v1.c +ZTRSMKERNEL_RT = trsm_kernel_RT_rvv_v1.c -TRSMCOPYLN_M = trsm_lncopy_rvv_v1.c -TRSMCOPYLT_M = trsm_ltcopy_rvv_v1.c -TRSMCOPYUN_M = trsm_uncopy_rvv_v1.c -TRSMCOPYUT_M = trsm_utcopy_rvv_v1.c +TRSMCOPYLN_M = trsm_lncopy_rvv_v1.c +TRSMCOPYLT_M = trsm_ltcopy_rvv_v1.c +TRSMCOPYUN_M = trsm_uncopy_rvv_v1.c +TRSMCOPYUT_M = trsm_utcopy_rvv_v1.c + +ZTRSMCOPYLN_M = ztrsm_lncopy_rvv_v1.c +ZTRSMCOPYLT_M = ztrsm_ltcopy_rvv_v1.c +ZTRSMCOPYUN_M = ztrsm_uncopy_rvv_v1.c +ZTRSMCOPYUT_M = ztrsm_utcopy_rvv_v1.c SSYMV_U_KERNEL = symv_U_rvv.c SSYMV_L_KERNEL = symv_L_rvv.c @@ -214,6 +230,27 @@ CSYMV_L_KERNEL = ../generic/zsymv_k.c ZSYMV_U_KERNEL = ../generic/zsymv_k.c ZSYMV_L_KERNEL = ../generic/zsymv_k.c +ZHEMMLTCOPY_M = zhemm_ltcopy_rvv_v1.c +ZHEMMUTCOPY_M = zhemm_utcopy_rvv_v1.c + +CHEMMLTCOPY_M = zhemm_ltcopy_rvv_v1.c +CHEMMUTCOPY_M = zhemm_utcopy_rvv_v1.c + +ZSYMMUCOPY_M = zsymm_ucopy_rvv_v1.c +ZSYMMLCOPY_M = zsymm_lcopy_rvv_v1.c + +CSYMMUCOPY_M = zsymm_ucopy_rvv_v1.c +CSYMMLCOPY_M = zsymm_lcopy_rvv_v1.c + +ZTRMMUNCOPY_M = ztrmm_uncopy_rvv_v1.c +ZTRMMLNCOPY_M = ztrmm_lncopy_rvv_v1.c +ZTRMMUTCOPY_M = ztrmm_utcopy_rvv_v1.c +ZTRMMLTCOPY_M = ztrmm_ltcopy_rvv_v1.c + +CTRMMUNCOPY_M = ztrmm_uncopy_rvv_v1.c +CTRMMLNCOPY_M = ztrmm_lncopy_rvv_v1.c +CTRMMUTCOPY_M = ztrmm_utcopy_rvv_v1.c +CTRMMLTCOPY_M = ztrmm_ltcopy_rvv_v1.c LSAME_KERNEL = ../generic/lsame.c diff --git a/kernel/riscv64/trmm_lncopy_rvv_v1.c b/kernel/riscv64/trmm_lncopy_rvv_v1.c index 73a8233f8..3457ca3e1 100644 --- a/kernel/riscv64/trmm_lncopy_rvv_v1.c +++ b/kernel/riscv64/trmm_lncopy_rvv_v1.c @@ -36,10 +36,10 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VSEV_FLOAT vse32_v_f32m2 #define VLSEV_FLOAT vlse32_v_f32m2 #define VBOOL_T vbool16_t -#define UINT_V_T vint32m2_t -#define VID_V_UINT vid_v_i32m2 -#define VMSGTU_VX_UINT vmsgt_vx_i32m2_b16 -#define VMSEQ_VX_UINT vmseq_vx_i32m2_b16 +#define UINT_V_T vuint32m2_t +#define VID_V_UINT vid_v_u32m2 +#define VMSGTU_VX_UINT vmsgtu_vx_u32m2_b16 +#define VMSEQ_VX_UINT vmseq_vx_u32m2_b16 #define VFMERGE_VFM_FLOAT vfmerge_vfm_f32m2 #else #define VSETVL(n) vsetvl_e64m2(n) diff --git a/kernel/riscv64/trsm_kernel_LN_rvv_v1.c b/kernel/riscv64/trsm_kernel_LN_rvv_v1.c index 11a0398ca..2cba06b38 100644 --- a/kernel/riscv64/trsm_kernel_LN_rvv_v1.c +++ b/kernel/riscv64/trsm_kernel_LN_rvv_v1.c @@ -31,28 +31,31 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VSETVL(n) vsetvl_e32m2(n) #define VSETVL_MAX vsetvlmax_e32m2() #define FLOAT_V_T vfloat32m2_t -#define VLEV_FLOAT vle32_v_f32m2 #define VLSEV_FLOAT vlse32_v_f32m2 -#define VLSEG2_FLOAT vlseg2e32_v_f32m2 -#define VSEV_FLOAT vse32_v_f32m2 #define VSSEV_FLOAT vsse32_v_f32m2 +#define VSEV_FLOAT vse32_v_f32m2 +#define VLSEG2_FLOAT vlseg2e32_v_f32m2 #define VSSEG2_FLOAT vsseg2e32_v_f32m2 +#define VLSSEG2_FLOAT vlsseg2e32_v_f32m2 +#define VSSSEG2_FLOAT vssseg2e32_v_f32m2 #define VFMACCVF_FLOAT vfmacc_vf_f32m2 -#define VFMULVF_FLOAT vfmul_vf_f32m2 #define VFNMSACVF_FLOAT vfnmsac_vf_f32m2 +#define VFMULVF_FLOAT vfmul_vf_f32m2 #else #define VSETVL(n) vsetvl_e64m2(n) #define VSETVL_MAX vsetvlmax_e64m2() #define FLOAT_V_T vfloat64m2_t -#define VLEV_FLOAT vle64_v_f64m2 #define VLSEV_FLOAT vlse64_v_f64m2 -#define VLSEG2_FLOAT vlseg2e64_v_f64m2 -#define VSEV_FLOAT vse64_v_f64m2 #define VSSEV_FLOAT vsse64_v_f64m2 +#define VSEV_FLOAT vse64_v_f64m2 +#define VLSEG2_FLOAT vlseg2e64_v_f64m2 #define VSSEG2_FLOAT vsseg2e64_v_f64m2 +#define VLSSEG2_FLOAT vlsseg2e64_v_f64m2 +#define VSSSEG2_FLOAT vssseg2e64_v_f64m2 +#define VFMVVF_FLOAT vfmv_v_f_f64m2 #define VFMACCVF_FLOAT vfmacc_vf_f64m2 -#define VFMULVF_FLOAT vfmul_vf_f64m2 #define VFNMSACVF_FLOAT vfnmsac_vf_f64m2 +#define VFMULVF_FLOAT vfmul_vf_f64m2 #endif @@ -88,606 +91,107 @@ static FLOAT dm1 = -1.; #ifndef COMPLEX -#if GEMM_DEFAULT_UNROLL_N == 1 - static inline void solve(BLASLONG m, BLASLONG n, FLOAT *a, FLOAT *b, FLOAT *c, BLASLONG ldc) { - - FLOAT aa, bb; - FLOAT *pa, *pc; + FLOAT aa; + FLOAT* pc; int i, j, k; - //fprintf(stderr, "%s , %s, m = %4ld n = %4ld offset = %4ld\n", __FILE__, __FUNCTION__, m, n, ldc); // Debug - size_t vl; - FLOAT_V_T va, vc; - - a += (m - 1) * m; - b += (m - 1) * n; - - for (i = m - 1; i >= 0; i--) - { - aa = *(a + i); - for (j = 0; j < n; j ++) - { - bb = *(c + i + j * ldc); - bb *= aa; - *b = bb; - *(c + i + j * ldc) = bb; - b ++; - - pa = a; - pc = c + j * ldc; - for (k = i; k > 0; k -= vl) - { - vl = VSETVL(k); - vc = VLEV_FLOAT(pc, vl); - va = VLEV_FLOAT(pa, vl); - vc = VFNMSACVF_FLOAT(vc, bb, va, vl); - VSEV_FLOAT(pc, vc, vl); - pa += vl; - pc += vl; - } - } - a -= m; - b -= 2 * n; - } - -} -#elif GEMM_DEFAULT_UNROLL_N == 2 - -static inline void solve(BLASLONG m, BLASLONG n, FLOAT *a, FLOAT *b, FLOAT *c, BLASLONG ldc) { + BLASLONG stride_ldc = sizeof(FLOAT) * ldc; - FLOAT aa, bb0, bb1; - FLOAT *pa, *pc, *pc0, *pc1; - FLOAT *pb0, *pb1; - - int i, j, k; - fprintf(stderr, "%s , %s, m = %4ld n = %4ld offset = %4ld\n", __FILE__, __FUNCTION__, m, n, ldc); // Debug + FLOAT_V_T vb, vc; size_t vl; - FLOAT_V_T va, vc0, vc1; a += (m - 1) * m; b += (m - 1) * n; - for (i = m - 1; i >= 0; i--) - { - aa = *(a + i); - pc = c + i; - for (j = 0; j < n/2; j ++) - { - //bb = *(c + i + j * ldc); - pb0 = pc + j * ldc * 2; - pb1 = pb0 + ldc; - //bb *= aa; - bb0 = (*pb0) * aa; - bb1 = (*pb1) * aa; - //*b = bb; - *b = bb0; - *(b+1) = bb1; - *pb0 = bb0; - *pb1 = bb1; - - //*(c + i + j * ldc) = bb; - //b ++; - - b += 2; - //pa = a + i + 1; - pc0 = c + j * ldc * 2; - pc1 = pc0 + ldc; - pa = a; - //pc = c + j * ldc; - for (k = i; k > 0; k -= vl) - { - vl = VSETVL(k); - vc0 = VLEV_FLOAT(pc0, vl); - vc1 = VLEV_FLOAT(pc1, vl); - va = VLEV_FLOAT(pa, vl); - vc0 = VFNMSACVF_FLOAT(vc0, bb0, va, vl); - vc1 = VFNMSACVF_FLOAT(vc1, bb1, va, vl); - VSEV_FLOAT(pc0, vc0, vl); - VSEV_FLOAT(pc1, vc1, vl); - - pa += vl; - pc0 += vl; - pc1 += vl; - } - } - pc += ldc * (n/2) * 2; - if (n & 1) - { - pb0 = pc; - bb0 = (*pb0) * aa; - *b = bb0; - *pb0 = bb0; - b += 1; - - pc0 = pc - i; - pa = a; - for (k = i; k > 0; k -= vl) - { - vl = VSETVL(k); - vc0 = VLEV_FLOAT(pc0, vl); - va = VLEV_FLOAT(pa, vl); - vc0 = VFNMSACVF_FLOAT(vc0, bb0, va, vl); - VSEV_FLOAT(pc0, vc0, vl); - - pa += vl; - pc0 += vl; - } - } - - a -= m; - b -= 2 * n; - } - -} - -#elif GEMM_DEFAULT_UNROLL_N == 4 - -static inline void solve(BLASLONG m, BLASLONG n, FLOAT *a, FLOAT *b, FLOAT *c, BLASLONG ldc) { - - FLOAT aa, bb0, bb1, bb2, bb3; - FLOAT *pa, *pc, *pc0, *pc1, *pc2, *pc3; - FLOAT *pb0, *pb1, *pb2, *pb3; - - int i, j, k; - - size_t vl; - FLOAT_V_T va, vc0, vc1, vc2, vc3; - - a += (m - 1) * m; - b += (m - 1) * n; - - for (i = m - 1; i >= 0; i--) - { - aa = *(a + i); - pc = c + i; - for (j = 0; j < n/4; j ++) - { - pb0 = pc + j * ldc * 4; - pb1 = pb0 + ldc; - pb2 = pb1 + ldc; - pb3 = pb2 + ldc; - - bb0 = (*pb0) * aa; - bb1 = (*pb1) * aa; - bb2 = (*pb2) * aa; - bb3 = (*pb3) * aa; - - *b = bb0; - *(b+1) = bb1; - *(b+2) = bb2; - *(b+3) = bb3; - - *pb0 = bb0; - *pb1 = bb1; - *pb2 = bb2; - *pb3 = bb3; - - b += 4; - - pc0 = c + j * ldc * 4; - pc1 = pc0 + ldc; - pc2 = pc1 + ldc; - pc3 = pc2 + ldc; - - pa = a; - for (k = i; k > 0; k -= vl) - { - vl = VSETVL(k); - vc0 = VLEV_FLOAT(pc0, vl); - vc1 = VLEV_FLOAT(pc1, vl); - vc2 = VLEV_FLOAT(pc2, vl); - vc3 = VLEV_FLOAT(pc3, vl); - va = VLEV_FLOAT(pa, vl); - vc0 = VFNMSACVF_FLOAT(vc0, bb0, va, vl); - vc1 = VFNMSACVF_FLOAT(vc1, bb1, va, vl); - vc2 = VFNMSACVF_FLOAT(vc2, bb2, va, vl); - vc3 = VFNMSACVF_FLOAT(vc3, bb3, va, vl); - VSEV_FLOAT(pc0, vc0, vl); - VSEV_FLOAT(pc1, vc1, vl); - VSEV_FLOAT(pc2, vc2, vl); - VSEV_FLOAT(pc3, vc3, vl); - - pa += vl; - pc0 += vl; - pc1 += vl; - pc2 += vl; - pc3 += vl; - } - } - pc += ldc * (n/4) * 4; - - if (n & 2) - { - pb0 = pc + j * ldc * 2; - pb1 = pb0 + ldc; - - bb0 = (*pb0) * aa; - bb1 = (*pb1) * aa; - - *b = bb0; - *(b+1) = bb1; - - *pb0 = bb0; - *pb1 = bb1; - - b += 2; - - pc0 = c + j * ldc * 2; - pc1 = pc0 + ldc; - - pa = a; - for (k = i; k > 0; k -= vl) - { - vl = VSETVL(k); - vc0 = VLEV_FLOAT(pc0, vl); - vc1 = VLEV_FLOAT(pc1, vl); - va = VLEV_FLOAT(pa, vl); - vc0 = VFNMSACVF_FLOAT(vc0, bb0, va, vl); - vc1 = VFNMSACVF_FLOAT(vc1, bb1, va, vl); - VSEV_FLOAT(pc0, vc0, vl); - VSEV_FLOAT(pc1, vc1, vl); - - pa += vl; - pc0 += vl; - pc1 += vl; - } - pc += ldc * 2; - } - - if (n & 1) - { - pb0 = pc; - bb0 = (*pb0) * aa; - *b = bb0; - *pb0 = bb0; - b += 1; - - pc0 = pc - i; - pa = a; - for (k = i; k > 0; k -= vl) - { - vl = VSETVL(k); - vc0 = VLEV_FLOAT(pc0, vl); - va = VLEV_FLOAT(pa, vl); - vc0 = VFNMSACVF_FLOAT(vc0, bb0, va, vl); - VSEV_FLOAT(pc0, vc0, vl); - - pa += vl; - pc0 += vl; - } - } - - a -= m; - b -= 2 * n; - } - -} -#elif GEMM_DEFAULT_UNROLL_N == 8 - -static inline void solve(BLASLONG m, BLASLONG n, FLOAT *a, FLOAT *b, FLOAT *c, BLASLONG ldc) { - - FLOAT aa, bb0, bb1, bb2, bb3, bb4, bb5, bb6, bb7; - FLOAT *pa, *pc, *pc0, *pc1, *pc2, *pc3, *pc4, *pc5, *pc6, *pc7; - FLOAT *pb0, *pb1, *pb2, *pb3, *pb4, *pb5, *pb6, *pb7; - - int i, j, k; - - size_t vl; - FLOAT_V_T va, vc0, vc1, vc2, vc3, vc4, vc5, vc6, vc7; - - a += (m - 1) * m; - b += (m - 1) * n; + for (i = m - 1; i >= 0; i--) { - for (i = m - 1; i >= 0; i--) - { aa = *(a + i); - pc = c + i; - for (j = 0; j < n/8; j ++) - { - pb0 = pc + j * ldc * 8; - pb1 = pb0 + ldc; - pb2 = pb1 + ldc; - pb3 = pb2 + ldc; - pb4 = pb3 + ldc; - pb5 = pb4 + ldc; - pb6 = pb5 + ldc; - pb7 = pb6 + ldc; - - bb0 = (*pb0) * aa; - bb1 = (*pb1) * aa; - bb2 = (*pb2) * aa; - bb3 = (*pb3) * aa; - bb4 = (*pb4) * aa; - bb5 = (*pb5) * aa; - bb6 = (*pb6) * aa; - bb7 = (*pb7) * aa; - - *b = bb0; - *(b+1) = bb1; - *(b+2) = bb2; - *(b+3) = bb3; - *(b+4) = bb4; - *(b+5) = bb5; - *(b+6) = bb6; - *(b+7) = bb7; - - *pb0 = bb0; - *pb1 = bb1; - *pb2 = bb2; - *pb3 = bb3; - *pb4 = bb4; - *pb5 = bb5; - *pb6 = bb6; - *pb7 = bb7; - - b += 8; - - pc0 = c + j * ldc * 8; - pc1 = pc0 + ldc; - pc2 = pc1 + ldc; - pc3 = pc2 + ldc; - pc4 = pc3 + ldc; - pc5 = pc4 + ldc; - pc6 = pc5 + ldc; - pc7 = pc6 + ldc; - - pa = a; - for (k = i; k > 0; k -= vl) - { - vl = VSETVL(k); - vc0 = VLEV_FLOAT(pc0, vl); - vc1 = VLEV_FLOAT(pc1, vl); - vc2 = VLEV_FLOAT(pc2, vl); - vc3 = VLEV_FLOAT(pc3, vl); - vc4 = VLEV_FLOAT(pc4, vl); - vc5 = VLEV_FLOAT(pc5, vl); - vc6 = VLEV_FLOAT(pc6, vl); - vc7 = VLEV_FLOAT(pc7, vl); - va = VLEV_FLOAT(pa, vl); - vc0 = VFNMSACVF_FLOAT(vc0, bb0, va, vl); - vc1 = VFNMSACVF_FLOAT(vc1, bb1, va, vl); - vc2 = VFNMSACVF_FLOAT(vc2, bb2, va, vl); - vc3 = VFNMSACVF_FLOAT(vc3, bb3, va, vl); - vc4 = VFNMSACVF_FLOAT(vc4, bb4, va, vl); - vc5 = VFNMSACVF_FLOAT(vc5, bb5, va, vl); - vc6 = VFNMSACVF_FLOAT(vc6, bb6, va, vl); - vc7 = VFNMSACVF_FLOAT(vc7, bb7, va, vl); - VSEV_FLOAT(pc0, vc0, vl); - VSEV_FLOAT(pc1, vc1, vl); - VSEV_FLOAT(pc2, vc2, vl); - VSEV_FLOAT(pc3, vc3, vl); - VSEV_FLOAT(pc4, vc4, vl); - VSEV_FLOAT(pc5, vc5, vl); - VSEV_FLOAT(pc6, vc6, vl); - VSEV_FLOAT(pc7, vc7, vl); - - pa += vl; - pc0 += vl; - pc1 += vl; - pc2 += vl; - pc3 += vl; - pc4 += vl; - pc5 += vl; - pc6 += vl; - pc7 += vl; - } - } - pc += ldc * (n/8) * 8; - - if (n & 4) - { - pb0 = pc + j * ldc * 4; - pb1 = pb0 + ldc; - pb2 = pb1 + ldc; - pb3 = pb2 + ldc; - - bb0 = (*pb0) * aa; - bb1 = (*pb1) * aa; - bb2 = (*pb2) * aa; - bb3 = (*pb3) * aa; - - *b = bb0; - *(b+1) = bb1; - *(b+2) = bb2; - *(b+3) = bb3; - - *pb0 = bb0; - *pb1 = bb1; - *pb2 = bb2; - *pb3 = bb3; - - b += 4; - - pc0 = c + j * ldc * 4; - pc1 = pc0 + ldc; - pc2 = pc1 + ldc; - pc3 = pc2 + ldc; - - pa = a; - for (k = i; k > 0; k -= vl) - { - vl = VSETVL(k); - vc0 = VLEV_FLOAT(pc0, vl); - vc1 = VLEV_FLOAT(pc1, vl); - vc2 = VLEV_FLOAT(pc2, vl); - vc3 = VLEV_FLOAT(pc3, vl); - va = VLEV_FLOAT(pa, vl); - vc0 = VFNMSACVF_FLOAT(vc0, bb0, va, vl); - vc1 = VFNMSACVF_FLOAT(vc1, bb1, va, vl); - vc2 = VFNMSACVF_FLOAT(vc2, bb2, va, vl); - vc3 = VFNMSACVF_FLOAT(vc3, bb3, va, vl); - VSEV_FLOAT(pc0, vc0, vl); - VSEV_FLOAT(pc1, vc1, vl); - VSEV_FLOAT(pc2, vc2, vl); - VSEV_FLOAT(pc3, vc3, vl); - - pa += vl; - pc0 += vl; - pc1 += vl; - pc2 += vl; - pc3 += vl; + pc = c; + for (j = n; j > 0; j -= vl) { + vl = VSETVL(j); + vb = VLSEV_FLOAT(pc + i, stride_ldc, vl); + vb = VFMULVF_FLOAT(vb, aa, vl); + VSEV_FLOAT(b, vb, vl); + VSSEV_FLOAT(pc + i, stride_ldc, vb, vl); + b += vl; + + for (k = 0; k < i; k ++) { + vc = VLSEV_FLOAT(pc + k, stride_ldc, vl); + vc = VFNMSACVF_FLOAT(vc, *(a + k), vb, vl); + VSSEV_FLOAT(pc + k, stride_ldc, vc, vl); } - pc += ldc * 4; + pc += vl * ldc; } - - if (n & 2) - { - pb0 = pc + j * ldc * 2; - pb1 = pb0 + ldc; - - bb0 = (*pb0) * aa; - bb1 = (*pb1) * aa; - - *b = bb0; - *(b+1) = bb1; - - *pb0 = bb0; - *pb1 = bb1; - - b += 2; - - pc0 = c + j * ldc * 2; - pc1 = pc0 + ldc; - - pa = a; - for (k = i; k > 0; k -= vl) - { - vl = VSETVL(k); - vc0 = VLEV_FLOAT(pc0, vl); - vc1 = VLEV_FLOAT(pc1, vl); - va = VLEV_FLOAT(pa, vl); - vc0 = VFNMSACVF_FLOAT(vc0, bb0, va, vl); - vc1 = VFNMSACVF_FLOAT(vc1, bb1, va, vl); - VSEV_FLOAT(pc0, vc0, vl); - VSEV_FLOAT(pc1, vc1, vl); - - pa += vl; - pc0 += vl; - pc1 += vl; - } - pc += ldc * 2; - } - - if (n & 1) - { - pb0 = pc; - bb0 = (*pb0) * aa; - *b = bb0; - *pb0 = bb0; - b += 1; - - pc0 = pc - i; - pa = a; - for (k = i; k > 0; k -= vl) - { - vl = VSETVL(k); - vc0 = VLEV_FLOAT(pc0, vl); - va = VLEV_FLOAT(pa, vl); - vc0 = VFNMSACVF_FLOAT(vc0, bb0, va, vl); - VSEV_FLOAT(pc0, vc0, vl); - - pa += vl; - pc0 += vl; - } - } - a -= m; b -= 2 * n; } } -#else -static inline void solve_generic(BLASLONG m, BLASLONG n, FLOAT *a, FLOAT *b, FLOAT *c, BLASLONG ldc) { - - FLOAT aa, bb; - - int i, j, k; - - a += (m - 1) * m; - b += (m - 1) * n; - - for (i = m - 1; i >= 0; i--) { - - aa = *(a + i); - - for (j = 0; j < n; j ++) { - bb = *(c + i + j * ldc); - bb *= aa; - *b = bb; - *(c + i + j * ldc) = bb; - b ++; - - for (k = 0; k < i; k ++){ - *(c + k + j * ldc) -= bb * *(a + k); - } - - } - a -= m; - b -= 2 * n; - } - -} - -#endif - #else static inline void solve(BLASLONG m, BLASLONG n, FLOAT *a, FLOAT *b, FLOAT *c, BLASLONG ldc) { - FLOAT aa1, aa2; - FLOAT bb1, bb2; - FLOAT cc1, cc2; - - int i, j, k; + FLOAT aa1, aa2; + FLOAT *pc; + int i, j, k; - ldc *= 2; - a += (m - 1) * m * 2; - b += (m - 1) * n * 2; + BLASLONG stride_ldc = sizeof(FLOAT) * ldc * 2; - for (i = m - 1; i >= 0; i--) { + FLOAT_V_T vb1, vb2, vc1, vc2, vs1, vs2; + size_t vl; + a += (m - 1) * m * 2; + b += (m - 1) * n * 2; - aa1 = *(a + i * 2 + 0); - aa2 = *(a + i * 2 + 1); + for (i = m - 1; i >= 0; i--) { - for (j = 0; j < n; j ++) { - bb1 = *(c + i * 2 + 0 + j * ldc); - bb2 = *(c + i * 2 + 1 + j * ldc); + aa1 = *(a + i * 2 + 0); + aa2 = *(a + i * 2 + 1); + pc = c; + for (j = n; j > 0; j -= vl) { + vl = VSETVL(j); + VLSSEG2_FLOAT(&vb1, &vb2, pc + i * 2, stride_ldc, vl); #ifndef CONJ - cc1 = aa1 * bb1 - aa2 * bb2; - cc2 = aa1 * bb2 + aa2 * bb1; + vs1 = VFMULVF_FLOAT(vb1, aa1, vl); + vs1 = VFNMSACVF_FLOAT(vs1, aa2, vb2, vl); + vs2 = VFMULVF_FLOAT(vb2, aa1, vl); + vs2 = VFMACCVF_FLOAT(vs2, aa2, vb1, vl); #else - cc1 = aa1 * bb1 + aa2 * bb2; - cc2 = aa1 * bb2 - aa2 * bb1; + vs1 = VFMULVF_FLOAT(vb1, aa1, vl); + vs1 = VFMACCVF_FLOAT(vs1, aa2, vb2, vl); + vs2 = VFMULVF_FLOAT(vb2, aa1, vl); + vs2 = VFNMSACVF_FLOAT(vs2, aa2, vb1, vl); #endif + VSSEG2_FLOAT(b, vs1, vs2, vl); + VSSSEG2_FLOAT(pc + i * 2, stride_ldc, vs1, vs2, vl); + b += vl * 2; - - *(b + 0) = cc1; - *(b + 1) = cc2; - *(c + i * 2 + 0 + j * ldc) = cc1; - *(c + i * 2 + 1 + j * ldc) = cc2; - b += 2; - - for (k = 0; k < i; k ++){ + for (k = 0; k < i; k ++) { + VLSSEG2_FLOAT(&vc1, &vc2, pc + k * 2, stride_ldc, vl); #ifndef CONJ - *(c + k * 2 + 0 + j * ldc) -= cc1 * *(a + k * 2 + 0) - cc2 * *(a + k * 2 + 1); - *(c + k * 2 + 1 + j * ldc) -= cc1 * *(a + k * 2 + 1) + cc2 * *(a + k * 2 + 0); -#else - *(c + k * 2 + 0 + j * ldc) -= cc1 * *(a + k * 2 + 0) + cc2 * *(a + k * 2 + 1); - *(c + k * 2 + 1 + j * ldc) -= - cc1 * *(a + k * 2 + 1) + cc2 * *(a + k * 2 + 0); + vc1 = VFMACCVF_FLOAT(vc1, *(a + k * 2 + 1), vs2, vl); + vc1 = VFNMSACVF_FLOAT(vc1, *(a + k * 2 + 0), vs1, vl); + vc2 = VFNMSACVF_FLOAT(vc2, *(a + k * 2 + 1), vs1, vl); + vc2 = VFNMSACVF_FLOAT(vc2, *(a + k * 2 + 0), vs2, vl); +#else + vc1 = VFNMSACVF_FLOAT(vc1, *(a + k * 2 + 1), vs2, vl); + vc1 = VFNMSACVF_FLOAT(vc1, *(a + k * 2 + 0), vs1, vl); + vc2 = VFMACCVF_FLOAT(vc2, *(a + k * 2 + 1), vs1, vl); + vc2 = VFNMSACVF_FLOAT(vc2, *(a + k * 2 + 0), vs2, vl); #endif - } - + VSSSEG2_FLOAT(pc + k * 2, stride_ldc, vc1, vc2, vl); + } + pc += vl * ldc * 2; + } + a -= m * 2; + b -= 4 * n; } - a -= m * 2; - b -= 4 * n; - } - } + #endif diff --git a/kernel/riscv64/trsm_kernel_LT_rvv_v1.c b/kernel/riscv64/trsm_kernel_LT_rvv_v1.c index 0380bd1bb..492a5631f 100644 --- a/kernel/riscv64/trsm_kernel_LT_rvv_v1.c +++ b/kernel/riscv64/trsm_kernel_LT_rvv_v1.c @@ -31,28 +31,31 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VSETVL(n) vsetvl_e32m2(n) #define VSETVL_MAX vsetvlmax_e32m2() #define FLOAT_V_T vfloat32m2_t -#define VLEV_FLOAT vle32_v_f32m2 #define VLSEV_FLOAT vlse32_v_f32m2 -#define VLSEG2_FLOAT vlseg2e32_v_f32m2 -#define VSEV_FLOAT vse32_v_f32m2 #define VSSEV_FLOAT vsse32_v_f32m2 +#define VSEV_FLOAT vse32_v_f32m2 +#define VLSEG2_FLOAT vlseg2e32_v_f32m2 #define VSSEG2_FLOAT vsseg2e32_v_f32m2 +#define VLSSEG2_FLOAT vlsseg2e32_v_f32m2 +#define VSSSEG2_FLOAT vssseg2e32_v_f32m2 #define VFMACCVF_FLOAT vfmacc_vf_f32m2 -#define VFMULVF_FLOAT vfmul_vf_f32m2 #define VFNMSACVF_FLOAT vfnmsac_vf_f32m2 +#define VFMULVF_FLOAT vfmul_vf_f32m2 #else #define VSETVL(n) vsetvl_e64m2(n) #define VSETVL_MAX vsetvlmax_e64m2() #define FLOAT_V_T vfloat64m2_t -#define VLEV_FLOAT vle64_v_f64m2 #define VLSEV_FLOAT vlse64_v_f64m2 -#define VLSEG2_FLOAT vlseg2e64_v_f64m2 -#define VSEV_FLOAT vse64_v_f64m2 #define VSSEV_FLOAT vsse64_v_f64m2 +#define VSEV_FLOAT vse64_v_f64m2 +#define VLSEG2_FLOAT vlseg2e64_v_f64m2 #define VSSEG2_FLOAT vsseg2e64_v_f64m2 +#define VLSSEG2_FLOAT vlsseg2e64_v_f64m2 +#define VSSSEG2_FLOAT vssseg2e64_v_f64m2 +#define VFMVVF_FLOAT vfmv_v_f_f64m2 #define VFMACCVF_FLOAT vfmacc_vf_f64m2 -#define VFMULVF_FLOAT vfmul_vf_f64m2 #define VFNMSACVF_FLOAT vfnmsac_vf_f64m2 +#define VFMULVF_FLOAT vfmul_vf_f64m2 #endif @@ -87,468 +90,39 @@ static FLOAT dm1 = -1.; // Optimizes the implementation in ../arm64/trsm_kernel_LT_sve.c #ifndef COMPLEX -#if GEMM_DEFAULT_UNROLL_N == 1 - -static inline void solve(BLASLONG m, BLASLONG n, FLOAT *a, FLOAT *b, FLOAT *c, BLASLONG ldc) -{ - FLOAT aa, bb; - FLOAT *pa, *pc; - int i, j, k; - size_t vl; - FLOAT_V_T va, vc; - for (i = 0; i < m; i++) - { - aa = *(a + i); - for (j = 0; j < n; j ++) - { - bb = *(c + i + j * ldc); - bb *= aa; - *b = bb; - *(c + i + j * ldc) = bb; - b++; - pa = a + i + 1; - pc = c + j * ldc + i + 1; - for (k = (m - i - 1); k > 0; k -= vl) - { - vl = VSETVL(k); - vc = VLEV_FLOAT(pc, vl); - va = VLEV_FLOAT(pa, vl); - vc = VFNMSACVF_FLOAT(vc, bb, va, vl); - VSEV_FLOAT(pc, vc, vl); - pa += vl; - pc += vl; - } - } - a += m; - } -} -#elif GEMM_DEFAULT_UNROLL_N == 2 - -static inline void solve(BLASLONG m, BLASLONG n, FLOAT *a, FLOAT *b, FLOAT *c, BLASLONG ldc) -{ +static inline void solve(BLASLONG m, BLASLONG n, FLOAT *a, FLOAT *b, FLOAT *c, BLASLONG ldc) { - FLOAT aa, bb0, bb1; - FLOAT *pa, *pc, *pc0, *pc1; - FLOAT *pb0, *pb1; + FLOAT aa; + FLOAT* pc; int i, j, k; - size_t vl; - FLOAT_V_T va, vc0, vc1; - for (i = 0; i < m; i++) - { - aa = *(a + i); - pc = c + i; - for (j = 0; j < n/2; j ++) - { - pb0 = pc + j * ldc * 2; - pb1 = pb0 + ldc; - bb0 = (*pb0) * aa; - bb1 = (*pb1) * aa; - *b = bb0; - *(b+1) = bb1; - *pb0 = bb0; - *pb1 = bb1; - b += 2; - pa = a + i + 1; - pc0 = pb0 + 1; - pc1 = pc0 + ldc; - for (k = (m - i - 1); k > 0; k -= vl) - { - vl = VSETVL(k); - vc0 = VLEV_FLOAT(pc0, vl); - vc1 = VLEV_FLOAT(pc1, vl); - va = VLEV_FLOAT(pa, vl); - vc0 = VFNMSACVF_FLOAT(vc0, bb0, va, vl); - vc1 = VFNMSACVF_FLOAT(vc1, bb1, va, vl); - VSEV_FLOAT(pc0, vc0, vl); - VSEV_FLOAT(pc1, vc1, vl); - pa += vl; - pc0 += vl; - pc1 += vl; - } - } - pc += ldc * (n/2) * 2; - if (n & 1) - { - pb0 = pc; - bb0 = *(pb0); - bb0 *= aa; - *b = bb0; - *(c + i) = bb0; - b++; - pa = a + i + 1; - pc0 = pb0 + 1; - for (k = (m - i - 1); k > 0; k -= vl) - { - vl = VSETVL(k); - vc0 = VLEV_FLOAT(pc0, vl); - va = VLEV_FLOAT(pa, vl); - vc0 = VFNMSACVF_FLOAT(vc0, bb0, va, vl); - VSEV_FLOAT(pc0, vc0, vl); - pa += vl; - pc0 += vl; - } - } - - a += m; - } -} -#elif GEMM_DEFAULT_UNROLL_N == 4 -static inline void solve(BLASLONG m, BLASLONG n, FLOAT *a, FLOAT *b, FLOAT *c, BLASLONG ldc) -{ + BLASLONG stride_ldc = sizeof(FLOAT) * ldc; - FLOAT aa, bb0, bb1, bb2, bb3; - FLOAT *pa, *pc; - FLOAT *pc0, *pc1, *pc2, *pc3; - FLOAT *pb0, *pb1, *pb2, *pb3; + FLOAT_V_T vb, vc; - int i, j, k; size_t vl; - FLOAT_V_T va; - FLOAT_V_T vc0, vc1, vc2, vc3; - for (i = 0; i < m; i++) - { - aa = *(a + i); - pc = c + i; - for (j = 0; j < n/4; j ++) - { - pb0 = pc; - pb1 = pb0 + ldc; - pb2 = pb1 + ldc; - pb3 = pb2 + ldc; - - bb0 = (*pb0) * aa; - bb1 = (*pb1) * aa; - bb2 = (*pb2) * aa; - bb3 = (*pb3) * aa; - - *b = bb0; - *(b+1) = bb1; - *(b+2) = bb2; - *(b+3) = bb3; - - *pb0 = bb0; - *pb1 = bb1; - *pb2 = bb2; - *pb3 = bb3; - b += 4; - - pa = a + i + 1; - pc0 = pb0 + 1; - pc1 = pc0 + ldc; - pc2 = pc1 + ldc; - pc3 = pc2 + ldc; - - for (k = (m - i - 1); k > 0; k -= vl) - { - vl = VSETVL(k); - vc0 = VLEV_FLOAT(pc0, vl); - vc1 = VLEV_FLOAT(pc1, vl); - vc2 = VLEV_FLOAT(pc2, vl); - vc3 = VLEV_FLOAT(pc3, vl); - - va = VLEV_FLOAT(pa, vl); - - vc0 = VFNMSACVF_FLOAT(vc0, bb0, va, vl); - vc1 = VFNMSACVF_FLOAT(vc1, bb1, va, vl); - vc2 = VFNMSACVF_FLOAT(vc2, bb2, va, vl); - vc3 = VFNMSACVF_FLOAT(vc3, bb3, va, vl); - - VSEV_FLOAT(pc0, vc0, vl); - VSEV_FLOAT(pc1, vc1, vl); - VSEV_FLOAT(pc2, vc2, vl); - VSEV_FLOAT(pc3, vc3, vl); - - pa += vl; - pc0 += vl; - pc1 += vl; - pc2 += vl; - pc3 += vl; - } - } - pc += ldc * (n/4) * 4; - - if (n & 2) - { - pb0 = pc; - pb1 = pb0 + ldc; - bb0 = (*pb0) * aa; - bb1 = (*pb1) * aa; - *b = bb0; - *(b+1) = bb1; - *pb0 = bb0; - *pb1 = bb1; - b += 2; - pa = a + i + 1; - pc0 = pb0 + 1; - pc1 = pc0 + ldc; - for (k = (m - i - 1); k > 0; k -= vl) - { - vl = VSETVL(k); - vc0 = VLEV_FLOAT(pc0, vl); - vc1 = VLEV_FLOAT(pc1, vl); - va = VLEV_FLOAT(pa, vl); - vc0 = VFNMSACVF_FLOAT(vc0, bb0, va, vl); - vc1 = VFNMSACVF_FLOAT(vc1, bb1, va, vl); - VSEV_FLOAT(pc0, vc0, vl); - VSEV_FLOAT(pc1, vc1, vl); - pa += vl; - pc0 += vl; - pc1 += vl; - } - pc += ldc * 2; - } - if (n & 1) - { - pb0 = pc; - bb0 = *(pb0); - bb0 *= aa; - *b = bb0; - *(c + i) = bb0; - b++; - pa = a + i + 1; - pc0 = pb0 + 1; - for (k = (m - i - 1); k > 0; k -= vl) - { - vl = VSETVL(k); - vc0 = VLEV_FLOAT(pc0, vl); - va = VLEV_FLOAT(pa, vl); - vc0 = VFNMSACVF_FLOAT(vc0, bb0, va, vl); - VSEV_FLOAT(pc0, vc0, vl); - pa += vl; - pc0 += vl; - } - } - - a += m; - } -} -#elif GEMM_DEFAULT_UNROLL_N == 8 - -static inline void solve(BLASLONG m, BLASLONG n, FLOAT *a, FLOAT *b, FLOAT *c, BLASLONG ldc) -{ - - FLOAT aa, bb0, bb1, bb2, bb3, bb4, bb5, bb6, bb7; - FLOAT *pa, *pc; - FLOAT *pc0, *pc1, *pc2, *pc3, *pc4, *pc5, *pc6, *pc7; - FLOAT *pb0, *pb1, *pb2, *pb3, *pb4, *pb5, *pb6, *pb7; + for (i = 0; i < m; i++) { - int i, j, k; - size_t vl; - FLOAT_V_T va; - FLOAT_V_T vc0, vc1, vc2, vc3, vc4, vc5, vc6, vc7; - for (i = 0; i < m; i++) - { aa = *(a + i); - pc = c + i; - for (j = 0; j < n/8; j ++) - { - pb0 = pc + j * ldc * 8; - pb1 = pb0 + ldc; - pb2 = pb1 + ldc; - pb3 = pb2 + ldc; - pb4 = pb3 + ldc; - pb5 = pb4 + ldc; - pb6 = pb5 + ldc; - pb7 = pb6 + ldc; - - bb0 = (*pb0) * aa; - bb1 = (*pb1) * aa; - bb2 = (*pb2) * aa; - bb3 = (*pb3) * aa; - bb4 = (*pb4) * aa; - bb5 = (*pb5) * aa; - bb6 = (*pb6) * aa; - bb7 = (*pb7) * aa; - - *b = bb0; - *(b+1) = bb1; - *(b+2) = bb2; - *(b+3) = bb3; - *(b+4) = bb4; - *(b+5) = bb5; - *(b+6) = bb6; - *(b+7) = bb7; - - *pb0 = bb0; - *pb1 = bb1; - *pb2 = bb2; - *pb3 = bb3; - *pb4 = bb4; - *pb5 = bb5; - *pb6 = bb6; - *pb7 = bb7; - b += 8; - - pa = a + i + 1; - pc0 = pb0 + 1; - pc1 = pc0 + ldc; - pc2 = pc1 + ldc; - pc3 = pc2 + ldc; - pc4 = pc3 + ldc; - pc5 = pc4 + ldc; - pc6 = pc5 + ldc; - pc7 = pc6 + ldc; - - for (k = (m - i - 1); k > 0; k -= vl) - { - vl = VSETVL(k); - vc0 = VLEV_FLOAT(pc0, vl); - vc1 = VLEV_FLOAT(pc1, vl); - vc2 = VLEV_FLOAT(pc2, vl); - vc3 = VLEV_FLOAT(pc3, vl); - vc4 = VLEV_FLOAT(pc4, vl); - vc5 = VLEV_FLOAT(pc5, vl); - vc6 = VLEV_FLOAT(pc6, vl); - vc7 = VLEV_FLOAT(pc7, vl); - - va = VLEV_FLOAT(pa, vl); - - vc0 = VFNMSACVF_FLOAT(vc0, bb0, va, vl); - vc1 = VFNMSACVF_FLOAT(vc1, bb1, va, vl); - vc2 = VFNMSACVF_FLOAT(vc2, bb2, va, vl); - vc3 = VFNMSACVF_FLOAT(vc3, bb3, va, vl); - vc4 = VFNMSACVF_FLOAT(vc4, bb4, va, vl); - vc5 = VFNMSACVF_FLOAT(vc5, bb5, va, vl); - vc6 = VFNMSACVF_FLOAT(vc6, bb6, va, vl); - vc7 = VFNMSACVF_FLOAT(vc7, bb7, va, vl); - - VSEV_FLOAT(pc0, vc0, vl); - VSEV_FLOAT(pc1, vc1, vl); - VSEV_FLOAT(pc2, vc2, vl); - VSEV_FLOAT(pc3, vc3, vl); - VSEV_FLOAT(pc4, vc4, vl); - VSEV_FLOAT(pc5, vc5, vl); - VSEV_FLOAT(pc6, vc6, vl); - VSEV_FLOAT(pc7, vc7, vl); - - pa += vl; - pc0 += vl; - pc1 += vl; - pc2 += vl; - pc3 += vl; - pc4 += vl; - pc5 += vl; - pc6 += vl; - pc7 += vl; - } - } - pc += ldc * (n/8) * 8; - - if (n & 4) - { - pb0 = pc; - pb1 = pb0 + ldc; - pb2 = pb1 + ldc; - pb3 = pb2 + ldc; - - bb0 = (*pb0) * aa; - bb1 = (*pb1) * aa; - bb2 = (*pb2) * aa; - bb3 = (*pb3) * aa; - - *b = bb0; - *(b+1) = bb1; - *(b+2) = bb2; - *(b+3) = bb3; - - *pb0 = bb0; - *pb1 = bb1; - *pb2 = bb2; - *pb3 = bb3; - b += 4; - - pa = a + i + 1; - pc0 = pb0 + 1; - pc1 = pc0 + ldc; - pc2 = pc1 + ldc; - pc3 = pc2 + ldc; - - for (k = (m - i - 1); k > 0; k -= vl) - { - vl = VSETVL(k); - vc0 = VLEV_FLOAT(pc0, vl); - vc1 = VLEV_FLOAT(pc1, vl); - vc2 = VLEV_FLOAT(pc2, vl); - vc3 = VLEV_FLOAT(pc3, vl); - - va = VLEV_FLOAT(pa, vl); - - vc0 = VFNMSACVF_FLOAT(vc0, bb0, va, vl); - vc1 = VFNMSACVF_FLOAT(vc1, bb1, va, vl); - vc2 = VFNMSACVF_FLOAT(vc2, bb2, va, vl); - vc3 = VFNMSACVF_FLOAT(vc3, bb3, va, vl); - - VSEV_FLOAT(pc0, vc0, vl); - VSEV_FLOAT(pc1, vc1, vl); - VSEV_FLOAT(pc2, vc2, vl); - VSEV_FLOAT(pc3, vc3, vl); - - pa += vl; - pc0 += vl; - pc1 += vl; - pc2 += vl; - pc3 += vl; + pc = c; + for (j = n; j > 0; j -= vl) { + vl = VSETVL(j); + vb = VLSEV_FLOAT(pc + i, stride_ldc, vl); + vb = VFMULVF_FLOAT(vb, aa, vl); + VSEV_FLOAT(b, vb, vl); + VSSEV_FLOAT(pc + i, stride_ldc, vb, vl); + b += vl; + + for (k = i + 1; k < m; k++) { + vc = VLSEV_FLOAT(pc + k, stride_ldc, vl); + vc = VFNMSACVF_FLOAT(vc, *(a + k), vb, vl); + VSSEV_FLOAT(pc + k, stride_ldc, vc, vl); } - pc += ldc * 4; + pc += vl * ldc; } - - if (n & 2) - { - pb0 = pc; - pb1 = pb0 + ldc; - bb0 = (*pb0) * aa; - bb1 = (*pb1) * aa; - *b = bb0; - *(b+1) = bb1; - *pb0 = bb0; - *pb1 = bb1; - b += 2; - pa = a + i + 1; - pc0 = pb0 + 1; - pc1 = pc0 + ldc; - for (k = (m - i - 1); k > 0; k -= vl) - { - vl = VSETVL(k); - vc0 = VLEV_FLOAT(pc0, vl); - vc1 = VLEV_FLOAT(pc1, vl); - va = VLEV_FLOAT(pa, vl); - vc0 = VFNMSACVF_FLOAT(vc0, bb0, va, vl); - vc1 = VFNMSACVF_FLOAT(vc1, bb1, va, vl); - VSEV_FLOAT(pc0, vc0, vl); - VSEV_FLOAT(pc1, vc1, vl); - pa += vl; - pc0 += vl; - pc1 += vl; - } - pc += ldc * 2; - } - - if (n & 1) - { - pb0 = pc; - bb0 = *(pb0); - bb0 *= aa; - *b = bb0; - *(c + i) = bb0; - b++; - pa = a + i + 1; - pc0 = pb0 + 1; - for (k = (m - i - 1); k > 0; k -= vl) - { - vl = VSETVL(k); - vc0 = VLEV_FLOAT(pc0, vl); - va = VLEV_FLOAT(pa, vl); - vc0 = VFNMSACVF_FLOAT(vc0, bb0, va, vl); - VSEV_FLOAT(pc0, vc0, vl); - pa += vl; - pc0 += vl; - } - } - a += m; } } @@ -557,146 +131,60 @@ static inline void solve(BLASLONG m, BLASLONG n, FLOAT *a, FLOAT *b, FLOAT *c, B static inline void solve(BLASLONG m, BLASLONG n, FLOAT *a, FLOAT *b, FLOAT *c, BLASLONG ldc) { - FLOAT aa, bb; - - int i, j, k; - - for (i = 0; i < m; i++) { - - aa = *(a + i); - - for (j = 0; j < n; j ++) { - bb = *(c + i + j * ldc); - bb *= aa; - *b = bb; - *(c + i + j * ldc) = bb; - b ++; - - for (k = i + 1; k < m; k ++){ - *(c + k + j * ldc) -= bb * *(a + k); - } - - } - a += m; - } -} - -#endif - -#else - -static inline void solve(BLASLONG m, BLASLONG n, FLOAT *a, FLOAT *b, FLOAT *c, BLASLONG ldc) { - - FLOAT aa1, aa2; - FLOAT bb1, bb2; - FLOAT cc1, cc2; - - int i, j, k; - - ldc *= 2; - - for (i = 0; i < m; i++) { - - aa1 = *(a + i * 2 + 0); - aa2 = *(a + i * 2 + 1); - - for (j = 0; j < n; j ++) { - bb1 = *(c + i * 2 + 0 + j * ldc); - bb2 = *(c + i * 2 + 1 + j * ldc); - -#ifndef CONJ - cc1 = aa1 * bb1 - aa2 * bb2; - cc2 = aa1 * bb2 + aa2 * bb1; -#else - cc1 = aa1 * bb1 + aa2 * bb2; - cc2 = aa1 * bb2 - aa2 * bb1; -#endif - - *(b + 0) = cc1; - *(b + 1) = cc2; - *(c + i * 2 + 0 + j * ldc) = cc1; - *(c + i * 2 + 1 + j * ldc) = cc2; - b += 2; - - for (k = i + 1; k < m; k ++){ -#ifndef CONJ - *(c + k * 2 + 0 + j * ldc) -= cc1 * *(a + k * 2 + 0) - cc2 * *(a + k * 2 + 1); - *(c + k * 2 + 1 + j * ldc) -= cc1 * *(a + k * 2 + 1) + cc2 * *(a + k * 2 + 0); -#else - *(c + k * 2 + 0 + j * ldc) -= cc1 * *(a + k * 2 + 0) + cc2 * *(a + k * 2 + 1); - *(c + k * 2 + 1 + j * ldc) -= -cc1 * *(a + k * 2 + 1) + cc2 * *(a + k * 2 + 0); -#endif - } - - } - a += m * 2; - } -} - - -static inline void solve_N1(BLASLONG m, BLASLONG n, FLOAT *a, FLOAT *b, FLOAT *c, BLASLONG ldc) { - - FLOAT aa1, aa2; - FLOAT bb1, bb2; - FLOAT cc1, cc2; - FLOAT *pa, *pc; - - int i, j, k; - - size_t vl; - FLOAT_V_T va0, va1, vc0, vc1; + FLOAT aa1, aa2; + FLOAT *pc; + int i, j, k; - ldc *= 2; + BLASLONG stride_ldc = sizeof(FLOAT) * ldc * 2; - for (i = 0; i < m; i++) { + FLOAT_V_T vb1, vb2, vc1, vc2, vs1, vs2; + size_t vl; - aa1 = *(a + i * 2 + 0); - aa2 = *(a + i * 2 + 1); + ldc *= 2; - for (j = 0; j < n; j ++) { - bb1 = *(c + i * 2 + 0 + j * ldc); - bb2 = *(c + i * 2 + 1 + j * ldc); + for (i = 0; i < m; i++) { + aa1 = *(a + i * 2 + 0); + aa2 = *(a + i * 2 + 1); + pc = c; + for (j = n; j > 0; j -= vl) { + vl = VSETVL(j); + VLSSEG2_FLOAT(&vb1, &vb2, pc + i * 2, stride_ldc, vl); #ifndef CONJ - cc1 = aa1 * bb1 - aa2 * bb2; - cc2 = aa1 * bb2 + aa2 * bb1; + vs1 = VFMULVF_FLOAT(vb1, aa1, vl); + vs1 = VFNMSACVF_FLOAT(vs1, aa2, vb2, vl); + vs2 = VFMULVF_FLOAT(vb2, aa1, vl); + vs2 = VFMACCVF_FLOAT(vs2, aa2, vb1, vl); #else - cc1 = aa1 * bb1 + aa2 * bb2; - cc2 = aa1 * bb2 - aa2 * bb1; + vs1 = VFMULVF_FLOAT(vb1, aa1, vl); + vs1 = VFMACCVF_FLOAT(vs1, aa2, vb2, vl); + vs2 = VFMULVF_FLOAT(vb2, aa1, vl); + vs2 = VFNMSACVF_FLOAT(vs2, aa2, vb1, vl); #endif + VSSEG2_FLOAT(b, vs1, vs2, vl); + VSSSEG2_FLOAT(pc + i * 2, stride_ldc, vs1, vs2, vl); + b += vl * 2; - *(b + 0) = cc1; - *(b + 1) = cc2; - *(c + i * 2 + 0 + j * ldc) = cc1; - *(c + i * 2 + 1 + j * ldc) = cc2; - b += 2; - - pa = a + (i + 1) * 2; - pc = c + j * ldc + (i + 1) * 2; - for (k = (m - i - 1); k > 0; k -= vl) - { - vl = VSETVL(k); - VLSEG2_FLOAT(&va0, &va1, pa, vl); - VLSEG2_FLOAT(&vc0, &vc1, pc, vl); + for (k = i + 1; k < m; k++) { + VLSSEG2_FLOAT(&vc1, &vc2, pc + k * 2, stride_ldc, vl); #ifndef CONJ - vc0 = VFNMSACVF_FLOAT(vc0, cc1, va0); - vc0 = VFMACCVF_FLOAT(vc0, cc2, va1); - vc1 = VFNMSACVF_FLOAT(vc1, cc1, va1); - vc1 = VFNMSACVF_FLOAT(vc1, cc2, va0); -#else - vc0 = VFNMSACVF_FLOAT(vc0, cc1, va0); - vc0 = VFNMSACVF_FLOAT(vc0, cc2, va1); - vc1 = VFMACCVF_FLOAT(vc1, cc1, va1); - vc1 = VFNMSACVF_FLOAT(vc1, cc2, va0); + vc1 = VFMACCVF_FLOAT(vc1, *(a + k * 2 + 1), vs2, vl); + vc1 = VFNMSACVF_FLOAT(vc1, *(a + k * 2 + 0), vs1, vl); + vc2 = VFNMSACVF_FLOAT(vc2, *(a + k * 2 + 1), vs1, vl); + vc2 = VFNMSACVF_FLOAT(vc2, *(a + k * 2 + 0), vs2, vl); +#else + vc1 = VFNMSACVF_FLOAT(vc1, *(a + k * 2 + 1), vs2, vl); + vc1 = VFNMSACVF_FLOAT(vc1, *(a + k * 2 + 0), vs1, vl); + vc2 = VFMACCVF_FLOAT(vc2, *(a + k * 2 + 1), vs1, vl); + vc2 = VFNMSACVF_FLOAT(vc2, *(a + k * 2 + 0), vs2, vl); #endif - VSSEG2_FLOAT(pc, vc0, vc1, vl); - pa += vl * 2; - pc += vl * 2; + VSSSEG2_FLOAT(pc + k * 2, stride_ldc, vc1, vc2, vl); + } + pc += vl * ldc * 2; } - } + + a += m * 2; } - a += m * 2; - } } #endif @@ -714,7 +202,7 @@ int CNAME(BLASLONG m, BLASLONG n, BLASLONG k, FLOAT dummy1, size_t vl = VSETVL_MAX; - //fprintf(stderr, "%s , %s, m = %4ld n = %4ld k = %4ld offset = %4ld\n", __FILE__, __FUNCTION__, m, n, k, offset); // Debug + //fprintf(stderr, "%s , %s, m = %4ld n = %4ld k = %4ld offset = %4ld\n", __FILE__, __FUNCTION__, m, n, k, offset); // Debug j = (n >> GEMM_UNROLL_N_SHIFT); diff --git a/kernel/riscv64/trsm_kernel_RN_rvv_v1.c b/kernel/riscv64/trsm_kernel_RN_rvv_v1.c index 41368be60..4751ae012 100644 --- a/kernel/riscv64/trsm_kernel_RN_rvv_v1.c +++ b/kernel/riscv64/trsm_kernel_RN_rvv_v1.c @@ -32,28 +32,32 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VSETVL_MAX vsetvlmax_e32m2() #define FLOAT_V_T vfloat32m2_t #define VLEV_FLOAT vle32_v_f32m2 -#define VLSEV_FLOAT vlse32_v_f32m2 -#define VLSEG2_FLOAT vlseg2e32_v_f32m2 -#define VSEV_FLOAT vse32_v_f32m2 #define VSSEV_FLOAT vsse32_v_f32m2 +#define VSEV_FLOAT vse32_v_f32m2 +#define VLSEG2_FLOAT vlseg2e32_v_f32m2 #define VSSEG2_FLOAT vsseg2e32_v_f32m2 +#define VLSSEG2_FLOAT vlsseg2e32_v_f32m2 +#define VSSSEG2_FLOAT vssseg2e32_v_f32m2 #define VFMACCVF_FLOAT vfmacc_vf_f32m2 #define VFNMSACVF_FLOAT vfnmsac_vf_f32m2 +#define VFMULVF_FLOAT vfmul_vf_f32m2 #else #define VSETVL(n) vsetvl_e64m2(n) #define VSETVL_MAX vsetvlmax_e64m2() #define FLOAT_V_T vfloat64m2_t #define VLEV_FLOAT vle64_v_f64m2 -#define VLSEV_FLOAT vlse64_v_f64m2 -#define VLSEG2_FLOAT vlseg2e64_v_f64m2 -#define VSEV_FLOAT vse64_v_f64m2 #define VSSEV_FLOAT vsse64_v_f64m2 +#define VSEV_FLOAT vse64_v_f64m2 +#define VLSEG2_FLOAT vlseg2e64_v_f64m2 #define VSSEG2_FLOAT vsseg2e64_v_f64m2 +#define VLSSEG2_FLOAT vlsseg2e64_v_f64m2 +#define VSSSEG2_FLOAT vssseg2e64_v_f64m2 +#define VFMVVF_FLOAT vfmv_v_f_f64m2 #define VFMACCVF_FLOAT vfmacc_vf_f64m2 #define VFNMSACVF_FLOAT vfnmsac_vf_f64m2 +#define VFMULVF_FLOAT vfmul_vf_f64m2 #endif - static FLOAT dm1 = -1.; #ifdef CONJ @@ -86,569 +90,99 @@ static FLOAT dm1 = -1.; #ifndef COMPLEX -#if GEMM_DEFAULT_UNROLL_N == 1 - static inline void solve(BLASLONG m, BLASLONG n, FLOAT *a, FLOAT *b, FLOAT *c, BLASLONG ldc) { - FLOAT aa, bb; - FLOAT *pb, *pc; - BLASLONG stride_ldc = sizeof(FLOAT) * ldc; - int i, j, k; - size_t vl; - FLOAT_V_T vb, vc; - - for (i = 0; i < n; i++) - { - bb = *(b + i); - - for (j = 0; j < m; j ++) - { - aa = *(c + j + i * ldc); - aa *= bb; - *a = aa; - *(c + j + i * ldc) = aa; - a ++; - - pb = b + i + 1; - pc = c + j + (i + 1) *ldc; - for (k = (n - i - 1); k > 0; k -= vl) - { - vl = VSETVL(k); - vc = VLSEV_FLOAT(pc, stride_ldc, vl); - vb = VLEV_FLOAT(pb, vl); - vc = VFNMSACVF_FLOAT(vc, aa, vb, vl); - VSSEV_FLOAT(pc, stride_ldc, vc, vl); - pb += vl; - pc ++; - } - } - b += n; - } -} - -#elif GEMM_DEFAULT_UNROLL_N == 2 - -static inline void solve(BLASLONG m, BLASLONG n, FLOAT *a, FLOAT *b, FLOAT *c, BLASLONG ldc) { + FLOAT bb; + FLOAT *pci, *pcj; - FLOAT aa0, aa1, bb; - FLOAT *pb, *pc; - FLOAT *pa0, *pa1, *pc0, *pc1; - BLASLONG stride_ldc = sizeof(FLOAT) * ldc; int i, j, k; - size_t vl; - FLOAT_V_T vb, vc0, vc1; - - for (i = 0; i < n; i++) - { - bb = *(b + i); - pc = c + i * ldc; - for (j = 0; j < m/2; j ++) - { - pa0 = pc + j * 2; - pa1 = pc + j * 2 + 1; - aa0 = *pa0 * bb; - aa1 = *pa1 * bb; - - *pa0 = aa0; - *pa1 = aa1; - *a = aa0; - *(a + 1)= aa1; - a += 2; - - pb = b + i + 1; - pc0 = pa0 + ldc; - pc1 = pa1 + ldc; - for (k = (n - i - 1); k > 0; k -= vl) - { - vl = VSETVL(k); - vc0 = VLSEV_FLOAT(pc0, stride_ldc, vl); - vc1 = VLSEV_FLOAT(pc1, stride_ldc, vl); - vb = VLEV_FLOAT(pb, vl); - vc0 = VFNMSACVF_FLOAT(vc0, aa0, vb, vl); - vc1 = VFNMSACVF_FLOAT(vc1, aa1, vb, vl); - VSSEV_FLOAT(pc0, stride_ldc, vc0, vl); - VSSEV_FLOAT(pc1, stride_ldc, vc1, vl); - pb += vl; - pc0++; - pc1++; - } - } - pc += (m/2)*2; - if (m & 1) - { - pa0 = pc; - aa0 = *pa0 * bb; - - *pa0 = aa0; - *a = aa0; - a += 1; - - pb = b + i + 1; - pc0 = pa0 + ldc; - for (k = (n - i - 1); k > 0; k -= vl) - { - vl = VSETVL(k); - vc0 = VLSEV_FLOAT(pc0, stride_ldc, vl); - vb = VLEV_FLOAT(pb, vl); - vc0 = VFNMSACVF_FLOAT(vc0, aa0, vb, vl); - VSSEV_FLOAT(pc0, stride_ldc, vc0, vl); - pb += vl; - pc0++; - } - } - b += n; - } -} - -#elif GEMM_DEFAULT_UNROLL_N == 4 - -static inline void solve(BLASLONG m, BLASLONG n, FLOAT *a, FLOAT *b, FLOAT *c, BLASLONG ldc) { + FLOAT_V_T va, vc; - FLOAT bb; - FLOAT aa0, aa1, aa2, aa3; - FLOAT *pb, *pc; - FLOAT *pa0, *pa1, *pa2, *pa3; - FLOAT *pc0, *pc1, *pc2, *pc3; - BLASLONG stride_ldc = sizeof(FLOAT) * ldc; - int i, j, k; size_t vl; - FLOAT_V_T vb, vc0, vc1, vc2, vc3; + for (i = 0; i < n; i++) { - for (i = 0; i < n; i++) - { bb = *(b + i); - pc = c + i * ldc; - for (j = 0; j < m/4; j ++) - { - pa0 = pc + j * 4; - pa1 = pa0 + 1; - pa2 = pa1 + 1; - pa3 = pa2 + 1; - - aa0 = *pa0 * bb; - aa1 = *pa1 * bb; - aa2 = *pa2 * bb; - aa3 = *pa3 * bb; - - *pa0 = aa0; - *pa1 = aa1; - *pa2 = aa2; - *pa3 = aa3; - - *a = aa0; - *(a + 1)= aa1; - *(a + 2)= aa2; - *(a + 3)= aa3; - - a += 4; - - pb = b + i + 1; - pc0 = pa0 + ldc; - pc1 = pa1 + ldc; - pc2 = pa2 + ldc; - pc3 = pa3 + ldc; - for (k = (n - i - 1); k > 0; k -= vl) - { - vl = VSETVL(k); - vc0 = VLSEV_FLOAT(pc0, stride_ldc, vl); - vc1 = VLSEV_FLOAT(pc1, stride_ldc, vl); - vc2 = VLSEV_FLOAT(pc2, stride_ldc, vl); - vc3 = VLSEV_FLOAT(pc3, stride_ldc, vl); - vb = VLEV_FLOAT(pb, vl); - - vc0 = VFNMSACVF_FLOAT(vc0, aa0, vb, vl); - vc1 = VFNMSACVF_FLOAT(vc1, aa1, vb, vl); - vc2 = VFNMSACVF_FLOAT(vc2, aa2, vb, vl); - vc3 = VFNMSACVF_FLOAT(vc3, aa3, vb, vl); - - VSSEV_FLOAT(pc0, stride_ldc, vc0, vl); - VSSEV_FLOAT(pc1, stride_ldc, vc1, vl); - VSSEV_FLOAT(pc2, stride_ldc, vc2, vl); - VSSEV_FLOAT(pc3, stride_ldc, vc3, vl); - - pb += vl; - pc0++; - pc1++; - pc2++; - pc3++; - } - } - pc += (m/4)*4; - - if (m & 2) - { - pa0 = pc; - pa1 = pa0 + 1; - - aa0 = *pa0 * bb; - aa1 = *pa1 * bb; - - *pa0 = aa0; - *pa1 = aa1; - - *a = aa0; - *(a + 1)= aa1; - - a += 2; - - pb = b + i + 1; - pc0 = pa0 + ldc; - pc1 = pa1 + ldc; - for (k = (n - i - 1); k > 0; k -= vl) - { - vl = VSETVL(k); - vc0 = VLSEV_FLOAT(pc0, stride_ldc, vl); - vc1 = VLSEV_FLOAT(pc1, stride_ldc, vl); - vb = VLEV_FLOAT(pb, vl); - - vc0 = VFNMSACVF_FLOAT(vc0, aa0, vb, vl); - vc1 = VFNMSACVF_FLOAT(vc1, aa1, vb, vl); - - VSSEV_FLOAT(pc0, stride_ldc, vc0, vl); - VSSEV_FLOAT(pc1, stride_ldc, vc1, vl); - - pb += vl; - pc0++; - pc1++; - } - pc += 2; - } - - if (m & 1) - { - pa0 = pc; - aa0 = *pa0 * bb; - - *pa0 = aa0; - *a = aa0; - a += 1; - - pb = b + i + 1; - pc0 = pa0 + ldc; - for (k = (n - i - 1); k > 0; k -= vl) - { - vl = VSETVL(k); - vc0 = VLSEV_FLOAT(pc0, stride_ldc, vl); - vb = VLEV_FLOAT(pb, vl); - vc0 = VFNMSACVF_FLOAT(vc0, aa0, vb, vl); - VSSEV_FLOAT(pc0, stride_ldc, vc0, vl); - pb += vl; - pc0++; + pci = c + i * ldc; + pcj = c; + for (j = m; j > 0; j -= vl) { + vl = VSETVL(j); + va = VLEV_FLOAT(pci, vl); + va = VFMULVF_FLOAT(va, bb, vl); + VSEV_FLOAT(a, va, vl); + VSEV_FLOAT(pci, va, vl); + a += vl; + pci += vl; + for (k = i + 1; k < n; k ++){ + vc = VLEV_FLOAT(pcj + k * ldc, vl); + vc = VFNMSACVF_FLOAT(vc, *(b + k), va, vl); + VSEV_FLOAT(pcj + k * ldc, vc, vl); } + pcj += vl; } b += n; } } -#elif GEMM_DEFAULT_UNROLL_N == 8 - -static inline void solve(BLASLONG m, BLASLONG n, FLOAT *a, FLOAT *b, FLOAT *c, BLASLONG ldc) { - - FLOAT bb; - FLOAT aa0, aa1, aa2, aa3, aa4, aa5, aa6, aa7; - FLOAT *pb, *pc; - FLOAT *pa0, *pa1, *pa2, *pa3, *pa4, *pa5, *pa6, *pa7; - FLOAT *pc0, *pc1, *pc2, *pc3, *pc4, *pc5, *pc6, *pc7; - BLASLONG stride_ldc = sizeof(FLOAT) * ldc; - int i, j, k; - size_t vl; - FLOAT_V_T vb, vc0, vc1, vc2, vc3, vc4, vc5, vc6, vc7; - - for (i = 0; i < n; i++) - { - bb = *(b + i); - pc = c + i * ldc; - for (j = 0; j < m/8; j ++) - { - pa0 = pc + j * 8; - pa1 = pa0 + 1; - pa2 = pa1 + 1; - pa3 = pa2 + 1; - pa4 = pa3 + 1; - pa5 = pa4 + 1; - pa6 = pa5 + 1; - pa7 = pa6 + 1; - - aa0 = *pa0 * bb; - aa1 = *pa1 * bb; - aa2 = *pa2 * bb; - aa3 = *pa3 * bb; - aa4 = *pa4 * bb; - aa5 = *pa5 * bb; - aa6 = *pa6 * bb; - aa7 = *pa7 * bb; - - *pa0 = aa0; - *pa1 = aa1; - *pa2 = aa2; - *pa3 = aa3; - *pa4 = aa4; - *pa5 = aa5; - *pa6 = aa6; - *pa7 = aa7; - - *a = aa0; - *(a + 1)= aa1; - *(a + 2)= aa2; - *(a + 3)= aa3; - *(a + 4)= aa4; - *(a + 5)= aa5; - *(a + 6)= aa6; - *(a + 7)= aa7; - - a += 8; - - pb = b + i + 1; - pc0 = pa0 + ldc; - pc1 = pa1 + ldc; - pc2 = pa2 + ldc; - pc3 = pa3 + ldc; - pc4 = pa4 + ldc; - pc5 = pa5 + ldc; - pc6 = pa6 + ldc; - pc7 = pa7 + ldc; - for (k = (n - i - 1); k > 0; k -= vl) - { - vl = VSETVL(k); - vc0 = VLSEV_FLOAT(pc0, stride_ldc, vl); - vc1 = VLSEV_FLOAT(pc1, stride_ldc, vl); - vc2 = VLSEV_FLOAT(pc2, stride_ldc, vl); - vc3 = VLSEV_FLOAT(pc3, stride_ldc, vl); - vc4 = VLSEV_FLOAT(pc4, stride_ldc, vl); - vc5 = VLSEV_FLOAT(pc5, stride_ldc, vl); - vc6 = VLSEV_FLOAT(pc6, stride_ldc, vl); - vc7 = VLSEV_FLOAT(pc7, stride_ldc, vl); - vb = VLEV_FLOAT(pb, vl); - - vc0 = VFNMSACVF_FLOAT(vc0, aa0, vb, vl); - vc1 = VFNMSACVF_FLOAT(vc1, aa1, vb, vl); - vc2 = VFNMSACVF_FLOAT(vc2, aa2, vb, vl); - vc3 = VFNMSACVF_FLOAT(vc3, aa3, vb, vl); - vc4 = VFNMSACVF_FLOAT(vc4, aa4, vb, vl); - vc5 = VFNMSACVF_FLOAT(vc5, aa5, vb, vl); - vc6 = VFNMSACVF_FLOAT(vc6, aa6, vb, vl); - vc7 = VFNMSACVF_FLOAT(vc7, aa7, vb, vl); - - VSSEV_FLOAT(pc0, stride_ldc, vc0, vl); - VSSEV_FLOAT(pc1, stride_ldc, vc1, vl); - VSSEV_FLOAT(pc2, stride_ldc, vc2, vl); - VSSEV_FLOAT(pc3, stride_ldc, vc3, vl); - VSSEV_FLOAT(pc4, stride_ldc, vc4, vl); - VSSEV_FLOAT(pc5, stride_ldc, vc5, vl); - VSSEV_FLOAT(pc6, stride_ldc, vc6, vl); - VSSEV_FLOAT(pc7, stride_ldc, vc7, vl); - - pb += vl; - pc0++; - pc1++; - pc2++; - pc3++; - pc4++; - pc5++; - pc6++; - pc7++; - } - } - pc += (m/8)*8; - - if (m & 4) - { - pa0 = pc; - pa1 = pa0 + 1; - pa2 = pa1 + 1; - pa3 = pa2 + 1; - - aa0 = *pa0 * bb; - aa1 = *pa1 * bb; - aa2 = *pa2 * bb; - aa3 = *pa3 * bb; - - *pa0 = aa0; - *pa1 = aa1; - *pa2 = aa2; - *pa3 = aa3; - - *a = aa0; - *(a + 1)= aa1; - *(a + 2)= aa2; - *(a + 3)= aa3; - - a += 4; - - pb = b + i + 1; - pc0 = pa0 + ldc; - pc1 = pa1 + ldc; - pc2 = pa2 + ldc; - pc3 = pa3 + ldc; - for (k = (n - i - 1); k > 0; k -= vl) - { - vl = VSETVL(k); - vc0 = VLSEV_FLOAT(pc0, stride_ldc, vl); - vc1 = VLSEV_FLOAT(pc1, stride_ldc, vl); - vc2 = VLSEV_FLOAT(pc2, stride_ldc, vl); - vc3 = VLSEV_FLOAT(pc3, stride_ldc, vl); - vb = VLEV_FLOAT(pb, vl); - - vc0 = VFNMSACVF_FLOAT(vc0, aa0, vb, vl); - vc1 = VFNMSACVF_FLOAT(vc1, aa1, vb, vl); - vc2 = VFNMSACVF_FLOAT(vc2, aa2, vb, vl); - vc3 = VFNMSACVF_FLOAT(vc3, aa3, vb, vl); - - VSSEV_FLOAT(pc0, stride_ldc, vc0, vl); - VSSEV_FLOAT(pc1, stride_ldc, vc1, vl); - VSSEV_FLOAT(pc2, stride_ldc, vc2, vl); - VSSEV_FLOAT(pc3, stride_ldc, vc3, vl); - - pb += vl; - pc0++; - pc1++; - pc2++; - pc3++; - } - pc += 4; - } - - if (m & 2) - { - pa0 = pc; - pa1 = pa0 + 1; - - aa0 = *pa0 * bb; - aa1 = *pa1 * bb; - - *pa0 = aa0; - *pa1 = aa1; - - *a = aa0; - *(a + 1)= aa1; - - a += 2; - - pb = b + i + 1; - pc0 = pa0 + ldc; - pc1 = pa1 + ldc; - for (k = (n - i - 1); k > 0; k -= vl) - { - vl = VSETVL(k); - vc0 = VLSEV_FLOAT(pc0, stride_ldc, vl); - vc1 = VLSEV_FLOAT(pc1, stride_ldc, vl); - vb = VLEV_FLOAT(pb, vl); - - vc0 = VFNMSACVF_FLOAT(vc0, aa0, vb, vl); - vc1 = VFNMSACVF_FLOAT(vc1, aa1, vb, vl); - - VSSEV_FLOAT(pc0, stride_ldc, vc0, vl); - VSSEV_FLOAT(pc1, stride_ldc, vc1, vl); - - pb += vl; - pc0++; - pc1++; - } - pc += 2; - } - - if (m & 1) - { - pa0 = pc; - aa0 = *pa0 * bb; - - *pa0 = aa0; - *a = aa0; - a += 1; - - pb = b + i + 1; - pc0 = pa0 + ldc; - for (k = (n - i - 1); k > 0; k -= vl) - { - vl = VSETVL(k); - vc0 = VLSEV_FLOAT(pc0, stride_ldc, vl); - vb = VLEV_FLOAT(pb, vl); - vc0 = VFNMSACVF_FLOAT(vc0, aa0, vb, vl); - VSSEV_FLOAT(pc0, stride_ldc, vc0, vl); - pb += vl; - pc0++; - } - } - b += n; - } -} #else -static inline void solve(BLASLONG m, BLASLONG n, FLOAT *a, FLOAT *b, FLOAT *c, BLASLONG ldc) { - - FLOAT aa, bb; - int i, j, k; - - for (i = 0; i < n; i++) { - - bb = *(b + i); - - for (j = 0; j < m; j ++) { - aa = *(c + j + i * ldc); - aa *= bb; - *a = aa; - *(c + j + i * ldc) = aa; - a ++; - - for (k = i + 1; k < n; k ++){ - *(c + j + k * ldc) -= aa * *(b + k); - } - - } - b += n; - } -} - -#endif +static inline void solve(BLASLONG m, BLASLONG n, FLOAT *a, FLOAT *b, FLOAT *c, BLASLONG ldc) { -#else + FLOAT bb1, bb2; -static inline void solve(BLASLONG m, BLASLONG n, FLOAT *a, FLOAT *b, FLOAT *c, BLASLONG ldc) { + FLOAT *pci, *pcj; - FLOAT aa1, aa2; - FLOAT bb1, bb2; - FLOAT cc1, cc2; + int i, j, k; - int i, j, k; + FLOAT_V_T va1, va2, vs1, vs2, vc1, vc2; - ldc *= 2; + size_t vl; - for (i = 0; i < n; i++) { + for (i = 0; i < n; i++) { - bb1 = *(b + i * 2 + 0); - bb2 = *(b + i * 2 + 1); + bb1 = *(b + i * 2 + 0); + bb2 = *(b + i * 2 + 1); - for (j = 0; j < m; j ++) { - aa1 = *(c + j * 2 + 0 + i * ldc); - aa2 = *(c + j * 2 + 1 + i * ldc); + pci = c + i * ldc * 2; + pcj = c; + for (j = m; j > 0; j -= vl) { + vl = VSETVL(j); + VLSEG2_FLOAT(&va1, &va2, pci, vl); #ifndef CONJ - cc1 = aa1 * bb1 - aa2 * bb2; - cc2 = aa1 * bb2 + aa2 * bb1; + vs1 = VFMULVF_FLOAT(va1, bb1, vl); + vs1 = VFNMSACVF_FLOAT(vs1, bb2, va2, vl); + vs2 = VFMULVF_FLOAT(va1, bb2, vl); + vs2 = VFMACCVF_FLOAT(vs2, bb1, va2, vl); #else - cc1 = aa1 * bb1 + aa2 * bb2; - cc2 = -aa1 * bb2 + aa2 * bb1; + vs1 = VFMULVF_FLOAT(va1, bb1, vl); + vs1 = VFMACCVF_FLOAT(vs1, bb2, va2, vl); + vs2 = VFMULVF_FLOAT(va2, bb1, vl); + vs2 = VFNMSACVF_FLOAT(vs2, bb2, va1, vl); #endif + VSSEG2_FLOAT(a, vs1, vs2, vl); + VSSEG2_FLOAT(pci, vs1, vs2, vl); + a += vl * 2; + pci += vl * 2; - *(a + 0) = cc1; - *(a + 1) = cc2; - *(c + j * 2 + 0 + i * ldc) = cc1; - *(c + j * 2 + 1 + i * ldc) = cc2; - a += 2; - - for (k = i + 1; k < n; k ++){ + for (k = i + 1; k < n; k ++){ + VLSEG2_FLOAT(&vc1, &vc2, pcj + k * ldc * 2, vl); #ifndef CONJ - *(c + j * 2 + 0 + k * ldc) -= cc1 * *(b + k * 2 + 0) - cc2 * *(b + k * 2 + 1); - *(c + j * 2 + 1 + k * ldc) -= cc1 * *(b + k * 2 + 1) + cc2 * *(b + k * 2 + 0); + vc1 = VFMACCVF_FLOAT(vc1, *(b + k * 2 + 1), vs2, vl); + vc1 = VFNMSACVF_FLOAT(vc1, *(b + k * 2 + 0), vs1, vl); + vc2 = VFNMSACVF_FLOAT(vc2, *(b + k * 2 + 1), vs1, vl); + vc2 = VFNMSACVF_FLOAT(vc2, *(b + k * 2 + 0), vs2, vl); #else - *(c + j * 2 + 0 + k * ldc) -= cc1 * *(b + k * 2 + 0) + cc2 * *(b + k * 2 + 1); - *(c + j * 2 + 1 + k * ldc) -= - cc1 * *(b + k * 2 + 1) + cc2 * *(b + k * 2 + 0); + vc1 = VFNMSACVF_FLOAT(vc1, *(b + k * 2 + 0), vs1, vl); + vc1 = VFNMSACVF_FLOAT(vc1, *(b + k * 2 + 1), vs2, vl); + vc2 = VFMACCVF_FLOAT(vc2, *(b + k * 2 + 1), vs1, vl); + vc2 = VFNMSACVF_FLOAT(vc2, *(b + k * 2 + 0), vs2, vl); #endif - } - + VSSEG2_FLOAT(pcj + k * ldc * 2, vc1, vc2, vl); + } + pcj += vl * 2; + } + b += n * 2; } - b += n * 2; - } } #endif @@ -666,7 +200,7 @@ int CNAME(BLASLONG m, BLASLONG n, BLASLONG k, FLOAT dummy1, size_t vl = VSETVL_MAX; - //fprintf(stderr, "%s , %s, m = %4ld n = %4ld k = %4ld offset = %4ld\n", __FILE__, __FUNCTION__, m, n, k, offset); // Debug + //fprintf(stderr, "%s , %s, m = %4ld n = %4ld k = %4ld offset = %4ld\n", __FILE__, __FUNCTION__, m, n, k, offset); // Debug j = (n >> GEMM_UNROLL_N_SHIFT); diff --git a/kernel/riscv64/trsm_kernel_RT_rvv_v1.c b/kernel/riscv64/trsm_kernel_RT_rvv_v1.c index 459c1663a..93a9e6916 100644 --- a/kernel/riscv64/trsm_kernel_RT_rvv_v1.c +++ b/kernel/riscv64/trsm_kernel_RT_rvv_v1.c @@ -32,25 +32,24 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VSETVL_MAX vsetvlmax_e32m2() #define FLOAT_V_T vfloat32m2_t #define VLEV_FLOAT vle32_v_f32m2 -#define VLSEV_FLOAT vlse32_v_f32m2 -#define VLSEG2_FLOAT vlseg2e32_v_f32m2 #define VSEV_FLOAT vse32_v_f32m2 -#define VSSEV_FLOAT vsse32_v_f32m2 +#define VLSEG2_FLOAT vlseg2e32_v_f32m2 #define VSSEG2_FLOAT vsseg2e32_v_f32m2 #define VFMACCVF_FLOAT vfmacc_vf_f32m2 #define VFNMSACVF_FLOAT vfnmsac_vf_f32m2 +#define VFMULVF_FLOAT vfmul_vf_f32m2 #else #define VSETVL(n) vsetvl_e64m2(n) #define VSETVL_MAX vsetvlmax_e64m2() #define FLOAT_V_T vfloat64m2_t #define VLEV_FLOAT vle64_v_f64m2 -#define VLSEV_FLOAT vlse64_v_f64m2 -#define VLSEG2_FLOAT vlseg2e64_v_f64m2 #define VSEV_FLOAT vse64_v_f64m2 -#define VSSEV_FLOAT vsse64_v_f64m2 +#define VLSEG2_FLOAT vlseg2e64_v_f64m2 #define VSSEG2_FLOAT vsseg2e64_v_f64m2 +#define VFMVVF_FLOAT vfmv_v_f_f64m2 #define VFMACCVF_FLOAT vfmacc_vf_f64m2 #define VFNMSACVF_FLOAT vfnmsac_vf_f64m2 +#define VFMULVF_FLOAT vfmul_vf_f64m2 #endif @@ -86,497 +85,38 @@ static FLOAT dm1 = -1.; #ifndef COMPLEX -#if GEMM_DEFAULT_UNROLL_N == 1 static inline void solve(BLASLONG m, BLASLONG n, FLOAT *a, FLOAT *b, FLOAT *c, BLASLONG ldc) { - FLOAT aa, bb; - FLOAT *pb, *pc; - BLASLONG stride_ldc = sizeof(FLOAT) * ldc; - - int i, j, k; - size_t vl; - FLOAT_V_T vb, vc; - - a += (n - 1) * m; - b += (n - 1) * n; - - for (i = n - 1; i >= 0; i--) { - - bb = *(b + i); - - for (j = 0; j < m; j ++) { - aa = *(c + j + i * ldc); - aa *= bb; - *a = aa; - *(c + j + i * ldc) = aa; - a ++; - - pb = b; - pc = c + j; - for (k = i; k > 0; k -= vl) - { - vl = VSETVL(k); - vc = VLSEV_FLOAT(pc, stride_ldc, vl); - vb = VLEV_FLOAT(pb, vl); - vc = VFNMSACVF_FLOAT(vc, aa, vb, vl); - VSSEV_FLOAT(pc, stride_ldc, vc, vl); - pb += vl; - pc++; - } - } - b -= n; - a -= 2 * m; - } - -} -#elif GEMM_DEFAULT_UNROLL_N == 2 - -static inline void solve(BLASLONG m, BLASLONG n, FLOAT *a, FLOAT *b, FLOAT *c, BLASLONG ldc) { + FLOAT bb; + FLOAT *pci, *pcj; - FLOAT aa0, aa1, bb; - FLOAT *pb, *pc; - FLOAT *pa0, *pa1, *pc0, *pc1; - BLASLONG stride_ldc = sizeof(FLOAT) * ldc; int i, j, k; - size_t vl; - FLOAT_V_T vb, vc0, vc1; - - a += (n - 1) * m; - b += (n - 1) * n; + FLOAT_V_T va, vc; - for (i = n - 1; i >= 0; i--) - { - bb = *(b + i); - pc = c + i * ldc; - for (j = 0; j < m/2; j ++) - { - pa0 = pc + j * 2; - pa1 = pc + j * 2 + 1; - aa0 = *pa0 * bb; - aa1 = *pa1 * bb; - - *pa0 = aa0; - *pa1 = aa1; - *a = aa0; - *(a + 1)= aa1; - a += 2; - - pb = b; - pc0 = c + j * 2; - pc1 = pc0 + 1; - for (k = i; k > 0; k -= vl) - { - vl = VSETVL(k); - vc0 = VLSEV_FLOAT(pc0, stride_ldc, vl); - vc1 = VLSEV_FLOAT(pc1, stride_ldc, vl); - vb = VLEV_FLOAT(pb, vl); - vc0 = VFNMSACVF_FLOAT(vc0, aa0, vb, vl); - vc1 = VFNMSACVF_FLOAT(vc1, aa1, vb, vl); - VSSEV_FLOAT(pc0, stride_ldc, vc0, vl); - VSSEV_FLOAT(pc1, stride_ldc, vc1, vl); - pb += vl; - pc0++; - pc1++; - } - } - pc += (m/2)*2; - - if (m & 1) - { - pa0 = pc; - aa0 = *pa0 * bb; - - *pa0 = aa0; - *a = aa0; - a += 1; - - pb = b; - pc0 = pc - i * ldc; - for (k = i; k > 0; k -= vl) - { - vl = VSETVL(k); - vc0 = VLSEV_FLOAT(pc0, stride_ldc, vl); - vb = VLEV_FLOAT(pb, vl); - vc0 = VFNMSACVF_FLOAT(vc0, aa0, vb, vl); - VSSEV_FLOAT(pc0, stride_ldc, vc0, vl); - pb += vl; - pc0++; - } - } - b -= n; - a -= 2 * m; - } -} - -#elif GEMM_DEFAULT_UNROLL_N == 4 - -static inline void solve(BLASLONG m, BLASLONG n, FLOAT *a, FLOAT *b, FLOAT *c, BLASLONG ldc) { - - FLOAT aa0, aa1, aa2, aa3; - FLOAT bb; - FLOAT *pb, *pc; - FLOAT *pa0, *pa1, *pa2, *pa3; - FLOAT *pc0, *pc1, *pc2, *pc3; - BLASLONG stride_ldc = sizeof(FLOAT) * ldc; - int i, j, k; size_t vl; - FLOAT_V_T vb, vc0, vc1, vc2, vc3; a += (n - 1) * m; b += (n - 1) * n; - for (i = n - 1; i >= 0; i--) - { - bb = *(b + i); - pc = c + i * ldc; - for (j = 0; j < m/4; j ++) - { - pa0 = pc + j * 4; - pa1 = pa0 + 1; - pa2 = pa1 + 1; - pa3 = pa2 + 1; - - aa0 = *pa0 * bb; - aa1 = *pa1 * bb; - aa2 = *pa2 * bb; - aa3 = *pa3 * bb; - - *pa0 = aa0; - *pa1 = aa1; - *pa2 = aa2; - *pa3 = aa3; - - *a = aa0; - *(a + 1)= aa1; - *(a + 2)= aa2; - *(a + 3)= aa3; - a += 4; - - pb = b; - pc0 = c + j * 4; - pc1 = pc0 + 1; - pc2 = pc1 + 1; - pc3 = pc2 + 1; - for (k = i; k > 0; k -= vl) - { - vl = VSETVL(k); - vc0 = VLSEV_FLOAT(pc0, stride_ldc, vl); - vc1 = VLSEV_FLOAT(pc1, stride_ldc, vl); - vc2 = VLSEV_FLOAT(pc2, stride_ldc, vl); - vc3 = VLSEV_FLOAT(pc3, stride_ldc, vl); - vb = VLEV_FLOAT(pb, vl); - - vc0 = VFNMSACVF_FLOAT(vc0, aa0, vb, vl); - vc1 = VFNMSACVF_FLOAT(vc1, aa1, vb, vl); - vc2 = VFNMSACVF_FLOAT(vc2, aa2, vb, vl); - vc3 = VFNMSACVF_FLOAT(vc3, aa3, vb, vl); - - VSSEV_FLOAT(pc0, stride_ldc, vc0, vl); - VSSEV_FLOAT(pc1, stride_ldc, vc1, vl); - VSSEV_FLOAT(pc2, stride_ldc, vc2, vl); - VSSEV_FLOAT(pc3, stride_ldc, vc3, vl); - - pb += vl; - pc0++; - pc1++; - pc2++; - pc3++; - } - } - pc += (m/4)*4; - - if (m & 2) - { - pa0 = pc + j * 2; - pa1 = pa0 + 1; - - aa0 = *pa0 * bb; - aa1 = *pa1 * bb; - - *pa0 = aa0; - *pa1 = aa1; - - *a = aa0; - *(a + 1)= aa1; - a += 2; - - pb = b; - pc0 = c + j * 4; - pc1 = pc0 + 1; - for (k = i; k > 0; k -= vl) - { - vl = VSETVL(k); - vc0 = VLSEV_FLOAT(pc0, stride_ldc, vl); - vc1 = VLSEV_FLOAT(pc1, stride_ldc, vl); - vb = VLEV_FLOAT(pb, vl); - - vc0 = VFNMSACVF_FLOAT(vc0, aa0, vb, vl); - vc1 = VFNMSACVF_FLOAT(vc1, aa1, vb, vl); - - VSSEV_FLOAT(pc0, stride_ldc, vc0, vl); - VSSEV_FLOAT(pc1, stride_ldc, vc1, vl); - - pb += vl; - pc0++; - pc1++; - } - pc += 2; - } - - if (m & 1) - { - pa0 = pc; - aa0 = *pa0 * bb; - - *pa0 = aa0; - *a = aa0; - a += 1; - - pb = b; - pc0 = pc - i * ldc; - for (k = i; k > 0; k -= vl) - { - vl = VSETVL(k); - vc0 = VLSEV_FLOAT(pc0, stride_ldc, vl); - vb = VLEV_FLOAT(pb, vl); - vc0 = VFNMSACVF_FLOAT(vc0, aa0, vb, vl); - VSSEV_FLOAT(pc0, stride_ldc, vc0, vl); - pb += vl; - pc0++; - } - } - b -= n; - a -= 2 * m; - } -} -#elif GEMM_DEFAULT_UNROLL_N == 8 - -static inline void solve(BLASLONG m, BLASLONG n, FLOAT *a, FLOAT *b, FLOAT *c, BLASLONG ldc) { - - FLOAT aa0, aa1, aa2, aa3, aa4, aa5, aa6, aa7; - FLOAT bb; - FLOAT *pb, *pc; - FLOAT *pa0, *pa1, *pa2, *pa3, *pa4, *pa5, *pa6, *pa7; - FLOAT *pc0, *pc1, *pc2, *pc3, *pc4, *pc5, *pc6, *pc7; - BLASLONG stride_ldc = sizeof(FLOAT) * ldc; - int i, j, k; - size_t vl; - FLOAT_V_T vb, vc0, vc1, vc2, vc3, vc4, vc5, vc6, vc7; - - a += (n - 1) * m; - b += (n - 1) * n; + for (i = n - 1; i >= 0; i--) { - for (i = n - 1; i >= 0; i--) - { bb = *(b + i); - pc = c + i * ldc; - for (j = 0; j < m/8; j ++) - { - pa0 = pc + j * 8; - pa1 = pa0 + 1; - pa2 = pa1 + 1; - pa3 = pa2 + 1; - pa4 = pa3 + 1; - pa5 = pa4 + 1; - pa6 = pa5 + 1; - pa7 = pa6 + 1; - - aa0 = *pa0 * bb; - aa1 = *pa1 * bb; - aa2 = *pa2 * bb; - aa3 = *pa3 * bb; - aa4 = *pa4 * bb; - aa5 = *pa5 * bb; - aa6 = *pa6 * bb; - aa7 = *pa7 * bb; - - *pa0 = aa0; - *pa1 = aa1; - *pa2 = aa2; - *pa3 = aa3; - *pa4 = aa4; - *pa5 = aa5; - *pa6 = aa6; - *pa7 = aa7; - - *a = aa0; - *(a + 1)= aa1; - *(a + 2)= aa2; - *(a + 3)= aa3; - *(a + 4)= aa4; - *(a + 5)= aa5; - *(a + 6)= aa6; - *(a + 7)= aa7; - a += 8; - - pb = b; - pc0 = c + j * 8; - pc1 = pc0 + 1; - pc2 = pc1 + 1; - pc3 = pc2 + 1; - pc4 = pc3 + 1; - pc5 = pc4 + 1; - pc6 = pc5 + 1; - pc7 = pc6 + 1; - for (k = i; k > 0; k -= vl) - { - vl = VSETVL(k); - vc0 = VLSEV_FLOAT(pc0, stride_ldc, vl); - vc1 = VLSEV_FLOAT(pc1, stride_ldc, vl); - vc2 = VLSEV_FLOAT(pc2, stride_ldc, vl); - vc3 = VLSEV_FLOAT(pc3, stride_ldc, vl); - vc4 = VLSEV_FLOAT(pc4, stride_ldc, vl); - vc5 = VLSEV_FLOAT(pc5, stride_ldc, vl); - vc6 = VLSEV_FLOAT(pc6, stride_ldc, vl); - vc7 = VLSEV_FLOAT(pc7, stride_ldc, vl); - vb = VLEV_FLOAT(pb, vl); - - vc0 = VFNMSACVF_FLOAT(vc0, aa0, vb, vl); - vc1 = VFNMSACVF_FLOAT(vc1, aa1, vb, vl); - vc2 = VFNMSACVF_FLOAT(vc2, aa2, vb, vl); - vc3 = VFNMSACVF_FLOAT(vc3, aa3, vb, vl); - vc4 = VFNMSACVF_FLOAT(vc4, aa4, vb, vl); - vc5 = VFNMSACVF_FLOAT(vc5, aa5, vb, vl); - vc6 = VFNMSACVF_FLOAT(vc6, aa6, vb, vl); - vc7 = VFNMSACVF_FLOAT(vc7, aa7, vb, vl); - - VSSEV_FLOAT(pc0, stride_ldc, vc0, vl); - VSSEV_FLOAT(pc1, stride_ldc, vc1, vl); - VSSEV_FLOAT(pc2, stride_ldc, vc2, vl); - VSSEV_FLOAT(pc3, stride_ldc, vc3, vl); - VSSEV_FLOAT(pc4, stride_ldc, vc4, vl); - VSSEV_FLOAT(pc5, stride_ldc, vc5, vl); - VSSEV_FLOAT(pc6, stride_ldc, vc6, vl); - VSSEV_FLOAT(pc7, stride_ldc, vc7, vl); - - pb += vl; - pc0++; - pc1++; - pc2++; - pc3++; - pc4++; - pc5++; - pc6++; - pc7++; - } - } - pc += (m/8)*8; - - if (m & 4) - { - pa0 = pc; - pa1 = pa0 + 1; - pa2 = pa1 + 1; - pa3 = pa2 + 1; - - aa0 = *pa0 * bb; - aa1 = *pa1 * bb; - aa2 = *pa2 * bb; - aa3 = *pa3 * bb; - - *pa0 = aa0; - *pa1 = aa1; - *pa2 = aa2; - *pa3 = aa3; - - *a = aa0; - *(a + 1)= aa1; - *(a + 2)= aa2; - *(a + 3)= aa3; - a += 4; - - pb = b; - pc0 = pc - i * ldc; - pc1 = pc0 + 1; - pc2 = pc1 + 1; - pc3 = pc2 + 1; - for (k = i; k > 0; k -= vl) - { - vl = VSETVL(k); - vc0 = VLSEV_FLOAT(pc0, stride_ldc, vl); - vc1 = VLSEV_FLOAT(pc1, stride_ldc, vl); - vc2 = VLSEV_FLOAT(pc2, stride_ldc, vl); - vc3 = VLSEV_FLOAT(pc3, stride_ldc, vl); - vb = VLEV_FLOAT(pb, vl); - - vc0 = VFNMSACVF_FLOAT(vc0, aa0, vb, vl); - vc1 = VFNMSACVF_FLOAT(vc1, aa1, vb, vl); - vc2 = VFNMSACVF_FLOAT(vc2, aa2, vb, vl); - vc3 = VFNMSACVF_FLOAT(vc3, aa3, vb, vl); - - VSSEV_FLOAT(pc0, stride_ldc, vc0, vl); - VSSEV_FLOAT(pc1, stride_ldc, vc1, vl); - VSSEV_FLOAT(pc2, stride_ldc, vc2, vl); - VSSEV_FLOAT(pc3, stride_ldc, vc3, vl); - - pb += vl; - pc0++; - pc1++; - pc2++; - pc3++; - } - pc += 4; - } - - if (m & 2) - { - pa0 = pc; - pa1 = pa0 + 1; - - aa0 = *pa0 * bb; - aa1 = *pa1 * bb; - - *pa0 = aa0; - *pa1 = aa1; - - *a = aa0; - *(a + 1)= aa1; - a += 2; - - pb = b; - pc0 = pc - i * ldc; - pc1 = pc0 + 1; - for (k = i; k > 0; k -= vl) - { - vl = VSETVL(k); - vc0 = VLSEV_FLOAT(pc0, stride_ldc, vl); - vc1 = VLSEV_FLOAT(pc1, stride_ldc, vl); - vb = VLEV_FLOAT(pb, vl); - - vc0 = VFNMSACVF_FLOAT(vc0, aa0, vb, vl); - vc1 = VFNMSACVF_FLOAT(vc1, aa1, vb, vl); - - VSSEV_FLOAT(pc0, stride_ldc, vc0, vl); - VSSEV_FLOAT(pc1, stride_ldc, vc1, vl); - - pb += vl; - pc0++; - pc1++; - } - pc += 2; - } - - if (m & 1) - { - pa0 = pc; - aa0 = *pa0 * bb; - - *pa0 = aa0; - *a = aa0; - a += 1; - - pb = b; - pc0 = pc - i * ldc; - for (k = i; k > 0; k -= vl) - { - vl = VSETVL(k); - vc0 = VLSEV_FLOAT(pc0, stride_ldc, vl); - vb = VLEV_FLOAT(pb, vl); - vc0 = VFNMSACVF_FLOAT(vc0, aa0, vb, vl); - VSSEV_FLOAT(pc0, stride_ldc, vc0, vl); - pb += vl; - pc0++; + pci = c + i * ldc; + pcj = c; + for (j = m; j > 0; j -= vl) { + vl = VSETVL(j); + va = VLEV_FLOAT(pci, vl); + va = VFMULVF_FLOAT(va, bb, vl); + VSEV_FLOAT(a, va, vl); + VSEV_FLOAT(pci, va, vl); + a += vl; + pci += vl; + for (k = 0; k < i; k ++){ + vc = VLEV_FLOAT(pcj + k * ldc, vl); + vc = VFNMSACVF_FLOAT(vc, *(b + k), va, vl); + VSEV_FLOAT(pcj + k * ldc, vc, vl); } + pcj += vl; } b -= n; a -= 2 * m; @@ -587,92 +127,65 @@ static inline void solve(BLASLONG m, BLASLONG n, FLOAT *a, FLOAT *b, FLOAT *c, B static inline void solve(BLASLONG m, BLASLONG n, FLOAT *a, FLOAT *b, FLOAT *c, BLASLONG ldc) { - FLOAT aa, bb; - - int i, j, k; - - a += (n - 1) * m; - b += (n - 1) * n; + FLOAT bb1, bb2; - for (i = n - 1; i >= 0; i--) { + FLOAT *pci, *pcj; - bb = *(b + i); - - for (j = 0; j < m; j ++) { - aa = *(c + j + i * ldc); - aa *= bb; - *a = aa; - *(c + j + i * ldc) = aa; - a ++; - - for (k = 0; k < i; k ++){ - *(c + j + k * ldc) -= aa * *(b + k); - } - - } - b -= n; - a -= 2 * m; - } - -} - -#endif - -#else - -static inline void solve(BLASLONG m, BLASLONG n, FLOAT *a, FLOAT *b, FLOAT *c, BLASLONG ldc) { - - FLOAT aa1, aa2; - FLOAT bb1, bb2; - FLOAT cc1, cc2; - - int i, j, k; - - ldc *= 2; + int i, j, k; - a += (n - 1) * m * 2; - b += (n - 1) * n * 2; + FLOAT_V_T va1, va2, vs1, vs2, vc1, vc2; - for (i = n - 1; i >= 0; i--) { + size_t vl; - bb1 = *(b + i * 2 + 0); - bb2 = *(b + i * 2 + 1); + a += (n - 1) * m * 2; + b += (n - 1) * n * 2; - for (j = 0; j < m; j ++) { + for (i = n - 1; i >= 0; i--) { - aa1 = *(c + j * 2 + 0 + i * ldc); - aa2 = *(c + j * 2 + 1 + i * ldc); + bb1 = *(b + i * 2 + 0); + bb2 = *(b + i * 2 + 1); + pci = c + i * ldc * 2; + pcj = c; + for (j = m; j > 0; j -= vl) { + vl = VSETVL(j); + VLSEG2_FLOAT(&va1, &va2, pci, vl); #ifndef CONJ - cc1 = aa1 * bb1 - aa2 * bb2; - cc2 = aa1 * bb2 + aa2 * bb1; + vs1 = VFMULVF_FLOAT(va1, bb1, vl); + vs1 = VFNMSACVF_FLOAT(vs1, bb2, va2, vl); + vs2 = VFMULVF_FLOAT(va1, bb2, vl); + vs2 = VFMACCVF_FLOAT(vs2, bb1, va2, vl); #else - cc1 = aa1 * bb1 + aa2 * bb2; - cc2 = - aa1 * bb2 + aa2 * bb1; + vs1 = VFMULVF_FLOAT(va1, bb1, vl); + vs1 = VFMACCVF_FLOAT(vs1, bb2, va2, vl); + vs2 = VFMULVF_FLOAT(va2, bb1, vl); + vs2 = VFNMSACVF_FLOAT(vs2, bb2, va1, vl); #endif + VSSEG2_FLOAT(a, vs1, vs2, vl); + VSSEG2_FLOAT(pci, vs1, vs2, vl); + a += vl * 2; + pci += vl * 2; - *(a + 0) = cc1; - *(a + 1) = cc2; - - *(c + j * 2 + 0 + i * ldc) = cc1; - *(c + j * 2 + 1 + i * ldc) = cc2; - a += 2; - - for (k = 0; k < i; k ++){ + for (k = 0; k < i; k ++){ + VLSEG2_FLOAT(&vc1, &vc2, pcj + k * ldc * 2, vl); #ifndef CONJ - *(c + j * 2 + 0 + k * ldc) -= cc1 * *(b + k * 2 + 0) - cc2 * *(b + k * 2 + 1); - *(c + j * 2 + 1 + k * ldc) -= cc1 * *(b + k * 2 + 1) + cc2 * *(b + k * 2 + 0); + vc1 = VFMACCVF_FLOAT(vc1, *(b + k * 2 + 1), vs2, vl); + vc1 = VFNMSACVF_FLOAT(vc1, *(b + k * 2 + 0), vs1, vl); + vc2 = VFNMSACVF_FLOAT(vc2, *(b + k * 2 + 1), vs1, vl); + vc2 = VFNMSACVF_FLOAT(vc2, *(b + k * 2 + 0), vs2, vl); #else - *(c + j * 2 + 0 + k * ldc) -= cc1 * *(b + k * 2 + 0) + cc2 * *(b + k * 2 + 1); - *(c + j * 2 + 1 + k * ldc) -= -cc1 * *(b + k * 2 + 1) + cc2 * *(b + k * 2 + 0); + vc1 = VFNMSACVF_FLOAT(vc1, *(b + k * 2 + 0), vs1, vl); + vc1 = VFNMSACVF_FLOAT(vc1, *(b + k * 2 + 1), vs2, vl); + vc2 = VFMACCVF_FLOAT(vc2, *(b + k * 2 + 1), vs1, vl); + vc2 = VFNMSACVF_FLOAT(vc2, *(b + k * 2 + 0), vs2, vl); #endif - } - + VSSEG2_FLOAT(pcj + k * ldc * 2, vc1, vc2, vl); + } + pcj += vl * 2; + } + b -= n * 2; + a -= 4 * m; } - b -= n * 2; - a -= 4 * m; - } - } #endif @@ -689,7 +202,7 @@ int CNAME(BLASLONG m, BLASLONG n, BLASLONG k, FLOAT dummy1, size_t vl = VSETVL_MAX; - //fprintf(stderr, "%s , %s, m = %4ld n = %4ld k = %4ld offset = %4ld\n", __FILE__, __FUNCTION__, m, n, k, offset); // Debug + //fprintf(stderr, "%s , %s, m = %4ld n = %4ld k = %4ld offset = %4ld\n", __FILE__, __FUNCTION__, m, n, k, offset); // Debug kk = n - offset; c += n * ldc * COMPSIZE; diff --git a/kernel/riscv64/zgemm_ncopy_4_rvv.c b/kernel/riscv64/zgemm_ncopy_4_rvv.c new file mode 100644 index 000000000..389ee5d57 --- /dev/null +++ b/kernel/riscv64/zgemm_ncopy_4_rvv.c @@ -0,0 +1,121 @@ +/*************************************************************************** +Copyright (c) 2022, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" + +#if !defined(DOUBLE) +#define VSETVL(n) vsetvl_e32m1(n) +#define FLOAT_V_T vfloat32m1_t +#define VLSEG2_FLOAT vlseg2e32_v_f32m1 +#define VSSEG2_FLOAT vsseg2e32_v_f32m1 +#define VSSEG4_FLOAT vsseg4e32_v_f32m1 +#define VSSEG8_FLOAT vsseg8e32_v_f32m1 +#else +#define VSETVL(n) vsetvl_e64m1(n) +#define FLOAT_V_T vfloat64m1_t +#define VLSEG2_FLOAT vlseg2e64_v_f64m1 +#define VSSEG2_FLOAT vsseg2e64_v_f64m1 +#define VSSEG4_FLOAT vsseg4e64_v_f64m1 +#define VSSEG8_FLOAT vsseg8e64_v_f64m1 +#endif + +// Optimizes the implementation in ../generic/zgemm_ncopy_4.c + +int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, FLOAT *b){ + BLASLONG i, j; + + FLOAT *aoffset; + FLOAT *aoffset1, *aoffset2, *aoffset3, *aoffset4; + + FLOAT *boffset; + + FLOAT_V_T v11, v12, v21, v22, v31, v32, v41, v42; + size_t vl; + + aoffset = a; + boffset = b; + lda *= 2; + + for (j = (n >> 2); j > 0; j--) { + aoffset1 = aoffset; + aoffset2 = aoffset1 + lda; + aoffset3 = aoffset2 + lda; + aoffset4 = aoffset3 + lda; + aoffset += 4 * lda; + + for (i = m; i > 0; i -= vl) { + vl = VSETVL(i); + VLSEG2_FLOAT(&v11, &v12, aoffset1, vl); + VLSEG2_FLOAT(&v21, &v22, aoffset2, vl); + VLSEG2_FLOAT(&v31, &v32, aoffset3, vl); + VLSEG2_FLOAT(&v41, &v42, aoffset4, vl); + + VSSEG8_FLOAT(boffset, v11, v12, v21, v22, v31, v32, v41, v42, vl); + + aoffset1 += vl * 2; + aoffset2 += vl * 2; + aoffset3 += vl * 2; + aoffset4 += vl * 2; + boffset += vl * 8; + } + } + + if (n & 2) { + aoffset1 = aoffset; + aoffset2 = aoffset1 + lda; + aoffset += 2 * lda; + + for (i = m; i > 0; i -= vl) { + vl = VSETVL(i); + VLSEG2_FLOAT(&v11, &v12, aoffset1, vl); + VLSEG2_FLOAT(&v21, &v22, aoffset2, vl); + + VSSEG4_FLOAT(boffset, v11, v12, v21, v22, vl); + + aoffset1 += vl * 2; + aoffset2 += vl * 2; + boffset += vl * 4; + } + } + + if (n & 1) { + aoffset1 = aoffset; + aoffset += lda; + + for (i = m; i > 0; i -= vl) { + vl = VSETVL(i); + VLSEG2_FLOAT(&v11, &v12, aoffset1, vl); + + VSSEG2_FLOAT(boffset, v11, v12, vl); + + aoffset1 += vl * 2; + boffset += vl * 2; + } + } + + return 0; +} diff --git a/kernel/riscv64/zgemm_ncopy_rvv_v1.c b/kernel/riscv64/zgemm_ncopy_rvv_v1.c new file mode 100644 index 000000000..df039bab6 --- /dev/null +++ b/kernel/riscv64/zgemm_ncopy_rvv_v1.c @@ -0,0 +1,74 @@ +/*************************************************************************** +Copyright (c) 2022, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 +#include "common.h" + +#if !defined(DOUBLE) +#define VSETVL(n) vsetvl_e32m2(n) +#define FLOAT_V_T vfloat32m2_t +#define VLSSEG2_FLOAT vlsseg2e32_v_f32m2 +#define VSSEG2_FLOAT vsseg2e32_v_f32m2 +#else +#define VSETVL(n) vsetvl_e64m2(n) +#define FLOAT_V_T vfloat64m2_t +#define VLSSEG2_FLOAT vlsseg2e64_v_f64m2 +#define VSSEG2_FLOAT vsseg2e64_v_f64m2 +#endif + +int CNAME(BLASLONG m, BLASLONG n, IFLOAT *a, BLASLONG lda, IFLOAT *b){ + + BLASLONG i, j; + + FLOAT *a_offset; + FLOAT *a_offset1; + FLOAT *b_offset; + + FLOAT_V_T v0, v1; + size_t vl; + + //fprintf(stderr, "%s, m=%ld n=%ld lda=%ld\n", __FUNCTION__, m, n, lda); + a_offset = a; + b_offset = b; + + for(j = n; j > 0; j -= vl) { + vl = VSETVL(j); + + a_offset1 = a_offset; + a_offset += vl * lda * 2; + + for(i = m; i > 0; i--) { + VLSSEG2_FLOAT(&v0, &v1, a_offset1, lda * sizeof(FLOAT) * 2, vl); + VSSEG2_FLOAT(b_offset, v0, v1, vl); + + a_offset1 += 2; + b_offset += vl * 2; + } + } + return 0; +} + diff --git a/kernel/riscv64/zgemm_tcopy_4_rvv.c b/kernel/riscv64/zgemm_tcopy_4_rvv.c new file mode 100644 index 000000000..1b34039c8 --- /dev/null +++ b/kernel/riscv64/zgemm_tcopy_4_rvv.c @@ -0,0 +1,181 @@ +/*************************************************************************** +Copyright (c) 2022, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" + +#if !defined(DOUBLE) +#define VSETVL(n) vsetvl_e32m1(n) +#define FLOAT_V_T vfloat32m1_t +#define VLEV_FLOAT vle32_v_f32m1 +#define VSEV_FLOAT vse32_v_f32m1 +#define VLSSEG2_FLOAT vlsseg2e32_v_f32m1 +#define VLSSEG4_FLOAT vlsseg4e32_v_f32m1 +#define VLSSEG8_FLOAT vlsseg8e32_v_f32m1 +#define VSSEG2_FLOAT vsseg2e32_v_f32m1 +#define VSSEG4_FLOAT vsseg4e32_v_f32m1 +#define VSSEG8_FLOAT vsseg8e32_v_f32m1 +#else +#define VSETVL(n) vsetvl_e64m1(n) +#define FLOAT_V_T vfloat64m1_t +#define VLEV_FLOAT vle64_v_f64m1 +#define VSEV_FLOAT vse64_v_f64m1 +#define VLSSEG2_FLOAT vlsseg2e64_v_f64m1 +#define VLSSEG4_FLOAT vlsseg4e64_v_f64m1 +#define VLSSEG8_FLOAT vlsseg8e64_v_f64m1 +#define VSSEG2_FLOAT vsseg2e64_v_f64m1 +#define VSSEG4_FLOAT vsseg4e64_v_f64m1 +#define VSSEG8_FLOAT vsseg8e64_v_f64m1 +#endif + +int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, FLOAT *b){ + + BLASLONG i, j; + + IFLOAT *aoffset; + IFLOAT *aoffset1; + + IFLOAT *boffset, *boffset1, *boffset2, *boffset3; + + FLOAT_V_T v0, v1, v2, v3, v4, v5, v6, v7; + size_t vl; + + //fprintf(stderr, "%s m=%ld n=%ld lda=%ld\n", __FUNCTION__, m, n, lda); + + aoffset = a; + boffset = b; + boffset2 = b + 2 * m * (n & ~3); + boffset3 = b + 2 * m * (n & ~1); + + for(j = (m >> 2); j > 0; j--) { + + aoffset1 = aoffset; + aoffset += 8 * lda; + + boffset1 = boffset; + boffset += 32; + + for(i = (n >> 2); i > 0; i--) { + vl = 4; + + VLSSEG8_FLOAT(&v0, &v1, &v2, &v3, &v4, &v5, &v6, &v7, aoffset1, lda * sizeof(FLOAT) * 2, vl); + VSSEG8_FLOAT(boffset1, v0, v1, v2, v3, v4, v5, v6, v7, vl); + + aoffset1 += 8; + boffset1 += m * 8; + } + + if (n & 2) { + vl = 4; + + VLSSEG4_FLOAT(&v0, &v1, &v2, &v3, aoffset1, lda * sizeof(FLOAT) * 2, vl); + VSSEG4_FLOAT(boffset2, v0, v1, v2, v3, vl); + + aoffset1 += 4; + boffset2 += 16; + } + + if (n & 1) { + vl = 4; + + VLSSEG2_FLOAT(&v0, &v1, aoffset1, lda * sizeof(FLOAT) * 2, vl); + VSSEG2_FLOAT(boffset3, v0, v1, vl); + + aoffset1 += 2; + boffset3 += 8; + } + } + + if (m & 2) { + aoffset1 = aoffset; + aoffset += 4 * lda; + + boffset1 = boffset; + boffset += 16; + + for(i = (n >> 2); i > 0; i--) { + vl = 2; + + VLSSEG8_FLOAT(&v0, &v1, &v2, &v3, &v4, &v5, &v6, &v7, aoffset1, lda * sizeof(FLOAT) * 2, vl); + VSSEG8_FLOAT(boffset1, v0, v1, v2, v3, v4, v5, v6, v7, vl); + + aoffset1 += 8; + boffset1 += m * 8; + } + + if (n & 2) { + vl = 2; + + VLSSEG4_FLOAT(&v0, &v1, &v2, &v3, aoffset1, lda * sizeof(FLOAT) * 2, vl); + VSSEG4_FLOAT(boffset2, v0, v1, v2, v3, vl); + + aoffset1 += 4; + boffset2 += 8; + } + + if (n & 1) { + vl = 2; + + VLSSEG2_FLOAT(&v0, &v1, aoffset1, lda * sizeof(FLOAT) * 2, vl); + VSSEG2_FLOAT(boffset3, v0, v1, vl); + + //aoffset1 += 2; + boffset3 += 4; + } + } + + if (m & 1) { + aoffset1 = aoffset; + boffset1 = boffset; + + for(i = (n >> 2); i > 0; i--) { + vl = 8; + + v0 = VLEV_FLOAT(aoffset1, vl); + VSEV_FLOAT(boffset1, v0, vl); + + aoffset1 += 8; + boffset1 += 8 * m; + } + + if (n & 2) { + vl = 4; + + v0 = VLEV_FLOAT(aoffset1, vl); + VSEV_FLOAT(boffset2, v0, vl); + + aoffset1 += 4; + //boffset2 += 4; + } + + if (n & 1) { + *(boffset3) = *(aoffset1); + *(boffset3 + 1) = *(aoffset1 + 1); + } + } + + return 0; +} diff --git a/kernel/riscv64/zgemm_tcopy_rvv_v1.c b/kernel/riscv64/zgemm_tcopy_rvv_v1.c new file mode 100644 index 000000000..7622fb810 --- /dev/null +++ b/kernel/riscv64/zgemm_tcopy_rvv_v1.c @@ -0,0 +1,74 @@ +/*************************************************************************** +Copyright (c) 2022, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" + +#if !defined(DOUBLE) +#define VSETVL(n) vsetvl_e32m2(n) +#define FLOAT_V_T vfloat32m2_t +#define VLSEG2_FLOAT vlseg2e32_v_f32m2 +#define VSSEG2_FLOAT vsseg2e32_v_f32m2 +#else +#define VSETVL(n) vsetvl_e64m2(n) +#define FLOAT_V_T vfloat64m2_t +#define VLSEG2_FLOAT vlseg2e64_v_f64m2 +#define VSSEG2_FLOAT vsseg2e64_v_f64m2 +#endif + +int CNAME(BLASLONG m, BLASLONG n, IFLOAT *a, BLASLONG lda, IFLOAT *b) +{ + BLASLONG i, j; + + IFLOAT *aoffset; + IFLOAT *aoffset1; + IFLOAT *boffset; + + FLOAT_V_T v0, v1; + size_t vl; + + //fprintf(stderr, "%s, m=%ld n=%ld lda=%ld\n", __FUNCTION__, m, n, lda); + + aoffset = a; + boffset = b; + + for(j = n; j > 0; j -= vl) { + vl = VSETVL(j); + + aoffset1 = aoffset; + aoffset += vl * 2; + + for(i = m; i > 0; i--) { + VLSEG2_FLOAT(&v0, &v1, aoffset1, vl); + VSSEG2_FLOAT(boffset, v0, v1, vl); + + aoffset1 += lda * 2; + boffset += vl * 2; + } + } + + return 0; +} diff --git a/kernel/riscv64/zgemmkernel_rvv_v1x4.c b/kernel/riscv64/zgemmkernel_rvv_v1x4.c new file mode 100644 index 000000000..50e29222f --- /dev/null +++ b/kernel/riscv64/zgemmkernel_rvv_v1x4.c @@ -0,0 +1,475 @@ +/*************************************************************************** +Copyright (c) 2022, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" + +#if !defined(DOUBLE) +#define VSETVL(n) vsetvl_e32m2(n) +#define FLOAT_V_T vfloat32m2_t +#define VLEV_FLOAT vle32_v_f32m2 +#define VSEV_FLOAT vse32_v_f32m2 +#define VLSEG2_FLOAT vlseg2e32_v_f32m2 +#define VSSEG2_FLOAT vsseg2e32_v_f32m2 +#define VFMVVF_FLOAT vfmv_v_f_f32m2 +#define VFMACCVF_FLOAT vfmacc_vf_f32m2 +#define VFNMSACVF_FLOAT vfnmsac_vf_f32m2 +#else +#define VSETVL(n) vsetvl_e64m2(n) +#define FLOAT_V_T vfloat64m2_t +#define VLEV_FLOAT vle64_v_f64m2 +#define VSEV_FLOAT vse64_v_f64m2 +#define VLSEG2_FLOAT vlseg2e64_v_f64m2 +#define VSSEG2_FLOAT vsseg2e64_v_f64m2 +#define VFMVVF_FLOAT vfmv_v_f_f64m2 +#define VFMACCVF_FLOAT vfmacc_vf_f64m2 +#define VFNMSACVF_FLOAT vfnmsac_vf_f64m2 +#endif + +#if defined(NN) || defined(NT) || defined(TN) || defined(TT) +#define OP_rr VFMACCVF_FLOAT +#define OP_ir VFMACCVF_FLOAT +#define OP_ii VFNMSACVF_FLOAT +#define OP_ri VFMACCVF_FLOAT +#elif defined(NR) || defined(NC) || defined(TR) || defined(TC) +#define OP_rr VFMACCVF_FLOAT +#define OP_ir VFMACCVF_FLOAT +#define OP_ii VFMACCVF_FLOAT +#define OP_ri VFNMSACVF_FLOAT +#elif defined(RN) || defined(RT) || defined(CN) || defined(CT) +#define OP_rr VFMACCVF_FLOAT +#define OP_ir VFNMSACVF_FLOAT +#define OP_ii VFMACCVF_FLOAT +#define OP_ri VFMACCVF_FLOAT +#elif defined(RR) || defined(RC) || defined(CR) || defined(CC) +#define OP_rr VFMACCVF_FLOAT +#define OP_ir VFNMSACVF_FLOAT +#define OP_ii VFNMSACVF_FLOAT +#define OP_ri VFNMSACVF_FLOAT +#endif + +int CNAME(BLASLONG bm,BLASLONG bn,BLASLONG bk,FLOAT alphar,FLOAT alphai,FLOAT* ba,FLOAT* bb,FLOAT* C,BLASLONG ldc +#ifdef TRMMKERNEL + , BLASLONG offset +#endif + ) +{ + BLASLONG i,j,k; + FLOAT *C0, *C1, *C2, *C3, *ptrba,*ptrbb; + + FLOAT_V_T va0, va1, va2, va3, va4, va5, va6, va7; + FLOAT_V_T vres0, vres1, vres2, vres3, vres4, vres5, vres6, vres7; + + //fprintf(stderr, "%s, bn=%ld bm=%ld bk=%ld alphar=%f alphai=%f ldc=%ld\n", __FUNCTION__, bn, bm, bk, alphar, alphai, ldc); // Debug + + size_t vl; + for (j = bn/4; j > 0; j--) + { + C0 = C; + C1 = C0 + 2 * ldc; + C2 = C1 + 2 * ldc; + C3 = C2 + 2 * ldc; + ptrba = ba; + for (i = bm; i > 0; i -= vl) + { + vl = VSETVL(i); + ptrbb = bb; + + vres0 = VFMVVF_FLOAT(0.0, vl); + vres1 = VFMVVF_FLOAT(0.0, vl); + vres2 = VFMVVF_FLOAT(0.0, vl); + vres3 = VFMVVF_FLOAT(0.0, vl); + vres4 = VFMVVF_FLOAT(0.0, vl); + vres5 = VFMVVF_FLOAT(0.0, vl); + vres6 = VFMVVF_FLOAT(0.0, vl); + vres7 = VFMVVF_FLOAT(0.0, vl); + + for (k = bk/4; k > 0; k--) + { + VLSEG2_FLOAT(&va0, &va1, ptrba, vl); + ptrba += vl*2; + + VLSEG2_FLOAT(&va2, &va3, ptrba, vl); + ptrba += vl*2; + + vres0 = OP_rr(vres0, *(ptrbb + 0), va0, vl); + vres1 = OP_ir(vres1, *(ptrbb + 0), va1, vl); + vres0 = OP_ii(vres0, *(ptrbb + 1), va1, vl); + vres1 = OP_ri(vres1, *(ptrbb + 1), va0, vl); + + vres2 = OP_rr(vres2, *(ptrbb + 2), va0, vl); + vres3 = OP_ir(vres3, *(ptrbb + 2), va1, vl); + vres2 = OP_ii(vres2, *(ptrbb + 3), va1, vl); + vres3 = OP_ri(vres3, *(ptrbb + 3), va0, vl); + + vres4 = OP_rr(vres4, *(ptrbb + 4), va0, vl); + vres5 = OP_ir(vres5, *(ptrbb + 4), va1, vl); + vres4 = OP_ii(vres4, *(ptrbb + 5), va1, vl); + vres5 = OP_ri(vres5, *(ptrbb + 5), va0, vl); + + vres6 = OP_rr(vres6, *(ptrbb + 6), va0, vl); + vres7 = OP_ir(vres7, *(ptrbb + 6), va1, vl); + vres6 = OP_ii(vres6, *(ptrbb + 7), va1, vl); + vres7 = OP_ri(vres7, *(ptrbb + 7), va0, vl); + + ptrbb += 8; + + VLSEG2_FLOAT(&va4, &va5, ptrba, vl); + ptrba += vl*2; + + vres0 = OP_rr(vres0, *(ptrbb + 0), va2, vl); + vres1 = OP_ir(vres1, *(ptrbb + 0), va3, vl); + vres0 = OP_ii(vres0, *(ptrbb + 1), va3, vl); + vres1 = OP_ri(vres1, *(ptrbb + 1), va2, vl); + + vres2 = OP_rr(vres2, *(ptrbb + 2), va2, vl); + vres3 = OP_ir(vres3, *(ptrbb + 2), va3, vl); + vres2 = OP_ii(vres2, *(ptrbb + 3), va3, vl); + vres3 = OP_ri(vres3, *(ptrbb + 3), va2, vl); + + vres4 = OP_rr(vres4, *(ptrbb + 4), va2, vl); + vres5 = OP_ir(vres5, *(ptrbb + 4), va3, vl); + vres4 = OP_ii(vres4, *(ptrbb + 5), va3, vl); + vres5 = OP_ri(vres5, *(ptrbb + 5), va2, vl); + + vres6 = OP_rr(vres6, *(ptrbb + 6), va2, vl); + vres7 = OP_ir(vres7, *(ptrbb + 6), va3, vl); + vres6 = OP_ii(vres6, *(ptrbb + 7), va3, vl); + vres7 = OP_ri(vres7, *(ptrbb + 7), va2, vl); + + ptrbb += 8; + + VLSEG2_FLOAT(&va6, &va7, ptrba, vl); + ptrba += vl*2; + + vres0 = OP_rr(vres0, *(ptrbb + 0), va4, vl); + vres1 = OP_ir(vres1, *(ptrbb + 0), va5, vl); + vres0 = OP_ii(vres0, *(ptrbb + 1), va5, vl); + vres1 = OP_ri(vres1, *(ptrbb + 1), va4, vl); + + vres2 = OP_rr(vres2, *(ptrbb + 2), va4, vl); + vres3 = OP_ir(vres3, *(ptrbb + 2), va5, vl); + vres2 = OP_ii(vres2, *(ptrbb + 3), va5, vl); + vres3 = OP_ri(vres3, *(ptrbb + 3), va4, vl); + + vres4 = OP_rr(vres4, *(ptrbb + 4), va4, vl); + vres5 = OP_ir(vres5, *(ptrbb + 4), va5, vl); + vres4 = OP_ii(vres4, *(ptrbb + 5), va5, vl); + vres5 = OP_ri(vres5, *(ptrbb + 5), va4, vl); + + vres6 = OP_rr(vres6, *(ptrbb + 6), va4, vl); + vres7 = OP_ir(vres7, *(ptrbb + 6), va5, vl); + vres6 = OP_ii(vres6, *(ptrbb + 7), va5, vl); + vres7 = OP_ri(vres7, *(ptrbb + 7), va4, vl); + ptrbb += 8; + + vres0 = OP_rr(vres0, *(ptrbb + 0), va6, vl); + vres1 = OP_ir(vres1, *(ptrbb + 0), va7, vl); + vres0 = OP_ii(vres0, *(ptrbb + 1), va7, vl); + vres1 = OP_ri(vres1, *(ptrbb + 1), va6, vl); + + vres2 = OP_rr(vres2, *(ptrbb + 2), va6, vl); + vres3 = OP_ir(vres3, *(ptrbb + 2), va7, vl); + vres2 = OP_ii(vres2, *(ptrbb + 3), va7, vl); + vres3 = OP_ri(vres3, *(ptrbb + 3), va6, vl); + + vres4 = OP_rr(vres4, *(ptrbb + 4), va6, vl); + vres5 = OP_ir(vres5, *(ptrbb + 4), va7, vl); + vres4 = OP_ii(vres4, *(ptrbb + 5), va7, vl); + vres5 = OP_ri(vres5, *(ptrbb + 5), va6, vl); + + vres6 = OP_rr(vres6, *(ptrbb + 6), va6, vl); + vres7 = OP_ir(vres7, *(ptrbb + 6), va7, vl); + vres6 = OP_ii(vres6, *(ptrbb + 7), va7, vl); + vres7 = OP_ri(vres7, *(ptrbb + 7), va6, vl); + + ptrbb += 8; + } + + for (k = (bk & 3); k > 0; k--) + { + VLSEG2_FLOAT(&va0, &va1, ptrba, vl); + ptrba += vl*2; + + vres0 = OP_rr(vres0, *(ptrbb + 0), va0, vl); + vres1 = OP_ir(vres1, *(ptrbb + 0), va1, vl); + vres0 = OP_ii(vres0, *(ptrbb + 1), va1, vl); + vres1 = OP_ri(vres1, *(ptrbb + 1), va0, vl); + + vres2 = OP_rr(vres2, *(ptrbb + 2), va0, vl); + vres3 = OP_ir(vres3, *(ptrbb + 2), va1, vl); + vres2 = OP_ii(vres2, *(ptrbb + 3), va1, vl); + vres3 = OP_ri(vres3, *(ptrbb + 3), va0, vl); + + vres4 = OP_rr(vres4, *(ptrbb + 4), va0, vl); + vres5 = OP_ir(vres5, *(ptrbb + 4), va1, vl); + vres4 = OP_ii(vres4, *(ptrbb + 5), va1, vl); + vres5 = OP_ri(vres5, *(ptrbb + 5), va0, vl); + + vres6 = OP_rr(vres6, *(ptrbb + 6), va0, vl); + vres7 = OP_ir(vres7, *(ptrbb + 6), va1, vl); + vres6 = OP_ii(vres6, *(ptrbb + 7), va1, vl); + vres7 = OP_ri(vres7, *(ptrbb + 7), va0, vl); + + ptrbb += 8; + } + + VLSEG2_FLOAT(&va0, &va1, C0, vl); + VLSEG2_FLOAT(&va2, &va3, C1, vl); + + va0 = VFMACCVF_FLOAT(va0, alphar, vres0, vl); + va1 = VFMACCVF_FLOAT(va1, alphar, vres1, vl); + va0 = VFNMSACVF_FLOAT(va0, alphai, vres1, vl); + va1 = VFMACCVF_FLOAT(va1, alphai, vres0, vl); + VSSEG2_FLOAT(C0, va0, va1, vl); + + va2 = VFMACCVF_FLOAT(va2, alphar, vres2, vl); + va3 = VFMACCVF_FLOAT(va3, alphar, vres3, vl); + va2 = VFNMSACVF_FLOAT(va2, alphai, vres3, vl); + va3 = VFMACCVF_FLOAT(va3, alphai, vres2, vl); + VSSEG2_FLOAT(C1, va2, va3, vl); + + VLSEG2_FLOAT(&va0, &va1, C2, vl); + VLSEG2_FLOAT(&va2, &va3, C3, vl); + + va0 = VFMACCVF_FLOAT(va0, alphar, vres4, vl); + va1 = VFMACCVF_FLOAT(va1, alphar, vres5, vl); + va0 = VFNMSACVF_FLOAT(va0, alphai, vres5, vl); + va1 = VFMACCVF_FLOAT(va1, alphai, vres4, vl); + VSSEG2_FLOAT(C2, va0, va1, vl); + + va2 = VFMACCVF_FLOAT(va2, alphar, vres6, vl); + va3 = VFMACCVF_FLOAT(va3, alphar, vres7, vl); + va2 = VFNMSACVF_FLOAT(va2, alphai, vres7, vl); + va3 = VFMACCVF_FLOAT(va3, alphai, vres6, vl); + VSSEG2_FLOAT(C3, va2, va3, vl); + + C0 += vl * 2; + C1 += vl * 2; + C2 += vl * 2; + C3 += vl * 2; + } + + bb += (bk << 3); + C += (ldc << 3); + } + + if (bn & 2) + { + C0 = C; + C1 = C0 + 2 * ldc; + ptrba = ba; + for (i = bm; i > 0; i -= vl) + { + vl = VSETVL(i); + ptrbb = bb; + + vres0 = VFMVVF_FLOAT(0.0, vl); + vres1 = VFMVVF_FLOAT(0.0, vl); + vres2 = VFMVVF_FLOAT(0.0, vl); + vres3 = VFMVVF_FLOAT(0.0, vl); + + for (k = bk/4; k > 0; k--) + { + VLSEG2_FLOAT(&va0, &va1, ptrba, vl); + ptrba += vl*2; + VLSEG2_FLOAT(&va2, &va3, ptrba, vl); + ptrba += vl*2; + + vres0 = OP_rr(vres0, *(ptrbb + 0), va0, vl); + vres1 = OP_ir(vres1, *(ptrbb + 0), va1, vl); + vres0 = OP_ii(vres0, *(ptrbb + 1), va1, vl); + vres1 = OP_ri(vres1, *(ptrbb + 1), va0, vl); + + vres2 = OP_rr(vres2, *(ptrbb + 2), va0, vl); + vres3 = OP_ir(vres3, *(ptrbb + 2), va1, vl); + vres2 = OP_ii(vres2, *(ptrbb + 3), va1, vl); + vres3 = OP_ri(vres3, *(ptrbb + 3), va0, vl); + + ptrbb += 4; + + VLSEG2_FLOAT(&va4, &va5, ptrba, vl); + ptrba += vl*2; + + vres0 = OP_rr(vres0, *(ptrbb + 0), va2, vl); + vres1 = OP_ir(vres1, *(ptrbb + 0), va3, vl); + vres0 = OP_ii(vres0, *(ptrbb + 1), va3, vl); + vres1 = OP_ri(vres1, *(ptrbb + 1), va2, vl); + + vres2 = OP_rr(vres2, *(ptrbb + 2), va2, vl); + vres3 = OP_ir(vres3, *(ptrbb + 2), va3, vl); + vres2 = OP_ii(vres2, *(ptrbb + 3), va3, vl); + vres3 = OP_ri(vres3, *(ptrbb + 3), va2, vl); + + ptrbb += 4; + + VLSEG2_FLOAT(&va6, &va7, ptrba, vl); + ptrba += vl*2; + + vres0 = OP_rr(vres0, *(ptrbb + 0), va4, vl); + vres1 = OP_ir(vres1, *(ptrbb + 0), va5, vl); + vres0 = OP_ii(vres0, *(ptrbb + 1), va5, vl); + vres1 = OP_ri(vres1, *(ptrbb + 1), va4, vl); + + vres2 = OP_rr(vres2, *(ptrbb + 2), va4, vl); + vres3 = OP_ir(vres3, *(ptrbb + 2), va5, vl); + vres2 = OP_ii(vres2, *(ptrbb + 3), va5, vl); + vres3 = OP_ri(vres3, *(ptrbb + 3), va4, vl); + + ptrbb += 4; + + vres0 = OP_rr(vres0, *(ptrbb + 0), va6, vl); + vres1 = OP_ir(vres1, *(ptrbb + 0), va7, vl); + vres0 = OP_ii(vres0, *(ptrbb + 1), va7, vl); + vres1 = OP_ri(vres1, *(ptrbb + 1), va6, vl); + + vres2 = OP_rr(vres2, *(ptrbb + 2), va6, vl); + vres3 = OP_ir(vres3, *(ptrbb + 2), va7, vl); + vres2 = OP_ii(vres2, *(ptrbb + 3), va7, vl); + vres3 = OP_ri(vres3, *(ptrbb + 3), va6, vl); + + ptrbb += 4; + } + + for (k = (bk & 3); k > 0; k--) + { + VLSEG2_FLOAT(&va0, &va1, ptrba, vl); + ptrba += vl*2; + + vres0 = OP_rr(vres0, *(ptrbb + 0), va0, vl); + vres1 = OP_ir(vres1, *(ptrbb + 0), va1, vl); + vres0 = OP_ii(vres0, *(ptrbb + 1), va1, vl); + vres1 = OP_ri(vres1, *(ptrbb + 1), va0, vl); + + vres2 = OP_rr(vres2, *(ptrbb + 2), va0, vl); + vres3 = OP_ir(vres3, *(ptrbb + 2), va1, vl); + vres2 = OP_ii(vres2, *(ptrbb + 3), va1, vl); + vres3 = OP_ri(vres3, *(ptrbb + 3), va0, vl); + + ptrbb += 4; + } + + VLSEG2_FLOAT(&va0, &va1, C0, vl); + VLSEG2_FLOAT(&va2, &va3, C1, vl); + + va0 = VFMACCVF_FLOAT(va0, alphar, vres0, vl); + va1 = VFMACCVF_FLOAT(va1, alphar, vres1, vl); + va0 = VFNMSACVF_FLOAT(va0, alphai, vres1, vl); + va1 = VFMACCVF_FLOAT(va1, alphai, vres0, vl); + VSSEG2_FLOAT(C0, va0, va1, vl); + + va2 = VFMACCVF_FLOAT(va2, alphar, vres2, vl); + va3 = VFMACCVF_FLOAT(va3, alphar, vres3, vl); + va2 = VFNMSACVF_FLOAT(va2, alphai, vres3, vl); + va3 = VFMACCVF_FLOAT(va3, alphai, vres2, vl); + VSSEG2_FLOAT(C1, va2, va3, vl); + + C0 += vl * 2; + C1 += vl * 2; + } + + bb += (bk << 2); + C += (ldc << 2); + } + + if (bn & 1) + { + C0 = C; + ptrba = ba; + for (i = bm; i > 0; i -= vl) + { + vl = VSETVL(i); + ptrbb = bb; + + vres0 = VFMVVF_FLOAT(0.0, vl); + vres1 = VFMVVF_FLOAT(0.0, vl); + + for (k = bk/4; k > 0; k--) + { + VLSEG2_FLOAT(&va0, &va1, ptrba, vl); + ptrba += vl*2; + VLSEG2_FLOAT(&va2, &va3, ptrba, vl); + ptrba += vl*2; + + vres0 = OP_rr(vres0, *(ptrbb + 0), va0, vl); + vres1 = OP_ir(vres1, *(ptrbb + 0), va1, vl); + vres0 = OP_ii(vres0, *(ptrbb + 1), va1, vl); + vres1 = OP_ri(vres1, *(ptrbb + 1), va0, vl); + ptrbb += 2; + + VLSEG2_FLOAT(&va4, &va5, ptrba, vl); + ptrba += vl*2; + + vres0 = OP_rr(vres0, *(ptrbb + 0), va2, vl); + vres1 = OP_ir(vres1, *(ptrbb + 0), va3, vl); + vres0 = OP_ii(vres0, *(ptrbb + 1), va3, vl); + vres1 = OP_ri(vres1, *(ptrbb + 1), va2, vl); + + ptrbb += 2; + + VLSEG2_FLOAT(&va6, &va7, ptrba, vl); + ptrba += vl*2; + + vres0 = OP_rr(vres0, *(ptrbb + 0), va4, vl); + vres1 = OP_ir(vres1, *(ptrbb + 0), va5, vl); + vres0 = OP_ii(vres0, *(ptrbb + 1), va5, vl); + vres1 = OP_ri(vres1, *(ptrbb + 1), va4, vl); + ptrbb += 2; + + vres0 = OP_rr(vres0, *(ptrbb + 0), va6, vl); + vres1 = OP_ir(vres1, *(ptrbb + 0), va7, vl); + vres0 = OP_ii(vres0, *(ptrbb + 1), va7, vl); + vres1 = OP_ri(vres1, *(ptrbb + 1), va6, vl); + ptrbb += 2; + } + + for (k = (bk & 3); k > 0; k--) + { + VLSEG2_FLOAT(&va0, &va1, ptrba, vl); + ptrba += vl*2; + + vres0 = OP_rr(vres0, *(ptrbb + 0), va0, vl); + vres1 = OP_ir(vres1, *(ptrbb + 0), va1, vl); + vres0 = OP_ii(vres0, *(ptrbb + 1), va1, vl); + vres1 = OP_ri(vres1, *(ptrbb + 1), va0, vl); + ptrbb += 2; + } + + VLSEG2_FLOAT(&va0, &va1, C0, vl); + va0 = VFMACCVF_FLOAT(va0, alphar, vres0, vl); + va1 = VFMACCVF_FLOAT(va1, alphar, vres1, vl); + va0 = VFNMSACVF_FLOAT(va0, alphai, vres1, vl); + va1 = VFMACCVF_FLOAT(va1, alphai, vres0, vl); + VSSEG2_FLOAT(C0, va0, va1, vl); + C0 += vl * 2; + } + + bb += bk << 1; + C += ldc << 1; + } + return 0; +} + diff --git a/kernel/riscv64/zhemm_ltcopy_rvv_v1.c b/kernel/riscv64/zhemm_ltcopy_rvv_v1.c new file mode 100644 index 000000000..cf466d3fa --- /dev/null +++ b/kernel/riscv64/zhemm_ltcopy_rvv_v1.c @@ -0,0 +1,124 @@ +/*************************************************************************** +Copyright (c) 2022, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" + +#if !defined(DOUBLE) +#define VSETVL(n) vsetvl_e32m2(n) +#define VSETVL_MAX vsetvlmax_e32m2() +#define FLOAT_V_T vfloat32m2_t +#define VLEV_FLOAT vle32_v_f32m2 +#define VSEV_FLOAT vse32_v_f32m2 +#define VLSEV_FLOAT vlse32_v_f32m2 +#define VLSEG2_FLOAT vlseg2e32_v_f32m2 +#define VLSSEG2_FLOAT vlsseg2e32_v_f32m2 +#define VSSEG2_FLOAT vsseg2e32_v_f32m2 +#define INT_V_T vint32m2_t +#define VID_V_INT vid_v_i32m2 +#define VADD_VX_INT vadd_vx_i32m2 +#define VFRSUB_VF_FLOAT vfrsub_vf_f32m2 +#define VMSGT_VX_INT vmsgt_vx_i32m2_b16 +#define VMSLT_VX_INT vmslt_vx_i32m2_b16 +#define VMSEQ_VX_INT vmseq_vx_i32m2_b16 +#define VBOOL_T vbool16_t +#define VMERGE_VVM_FLOAT vmerge_vvm_f32m2 +#define VFMVVF_FLOAT vfmv_v_f_f32m2 +#else +#define VSETVL(n) vsetvl_e64m2(n) +#define VSETVL_MAX vsetvlmax_e64m2() +#define FLOAT_V_T vfloat64m2_t +#define VLEV_FLOAT vle64_v_f64m2 +#define VSEV_FLOAT vse64_v_f64m2 +#define VLSEV_FLOAT vlse64_v_f64m2 +#define VLSEG2_FLOAT vlseg2e64_v_f64m2 +#define VLSSEG2_FLOAT vlsseg2e64_v_f64m2 +#define VSSEG2_FLOAT vsseg2e64_v_f64m2 +#define INT_V_T vint64m2_t +#define VID_V_INT vid_v_i64m2 +#define VADD_VX_INT vadd_vx_i64m2 +#define VFRSUB_VF_FLOAT vfrsub_vf_f64m2 +#define VMSGT_VX_INT vmsgt_vx_i64m2_b32 +#define VMSLT_VX_INT vmslt_vx_i64m2_b32 +#define VMSEQ_VX_INT vmseq_vx_i64m2_b32 +#define VBOOL_T vbool32_t +#define VMERGE_VVM_FLOAT vmerge_vvm_f64m2 +#define VFMVVF_FLOAT vfmv_v_f_f64m2 +#endif + + +int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG posX, BLASLONG posY, FLOAT *b) +{ + //fprintf(stderr, "%s, %s, m=%ld n=%ld lda=%ld posX=%ld posY=%ld\n", __FUNCTION__, __FILE__, m, n, lda, posX, posY); + + BLASLONG i, js, offset; + + FLOAT *ao1, *ao2; + + BLASLONG stride_lda = sizeof(FLOAT) * lda * 2; + + FLOAT_V_T vb0, vb1, vb2, va10, va11, va20, va21, vzero; + VBOOL_T vbool_gt0, vbool_lt0, vbool_eq0; + INT_V_T vindex_max, vindex; + + size_t vl = VSETVL_MAX; + vindex_max = VID_V_INT(vl); + vzero = VFMVVF_FLOAT(ZERO, vl); + + for (js = n; js > 0; js -= vl, posX += vl) { + vl = VSETVL(js); + offset = posX - posY; + + ao1 = a + posX * 2 + posY * lda * 2; + ao2 = a + posY * 2 + posX * lda * 2; + + for (i = m; i > 0; i--, offset--) { + VLSSEG2_FLOAT(&va20, &va21, ao2, stride_lda, vl); + VLSEG2_FLOAT(&va10, &va11, ao1, vl); + + vindex = VADD_VX_INT(vindex_max, offset, vl); + vbool_gt0 = VMSGT_VX_INT(vindex, 0, vl); + vbool_lt0 = VMSLT_VX_INT(vindex, 0, vl); + vbool_eq0 = VMSEQ_VX_INT(vindex, 0, vl); + + vb0 = VMERGE_VVM_FLOAT(vbool_gt0, va20, va10, vl); + vb1 = VMERGE_VVM_FLOAT(vbool_gt0, va21, va11, vl); + + vb2 = VFRSUB_VF_FLOAT(vb1, ZERO, vl); + + vb1 = VMERGE_VVM_FLOAT(vbool_lt0, vb1, vb2, vl); + vb1 = VMERGE_VVM_FLOAT(vbool_eq0, vb1, vzero, vl); + VSSEG2_FLOAT(b, vb0, vb1, vl); + + b += vl * 2; + ao1 += lda * 2; + ao2 += 2; + } + } + + return 0; +} + diff --git a/kernel/riscv64/zhemm_utcopy_rvv_v1.c b/kernel/riscv64/zhemm_utcopy_rvv_v1.c new file mode 100644 index 000000000..6209f5417 --- /dev/null +++ b/kernel/riscv64/zhemm_utcopy_rvv_v1.c @@ -0,0 +1,120 @@ +/*************************************************************************** +Copyright (c) 2022, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" + +#if !defined(DOUBLE) +#define VSETVL(n) vsetvl_e32m2(n) +#define VSETVL_MAX vsetvlmax_e32m2() +#define FLOAT_V_T vfloat32m2_t +#define VLEV_FLOAT vle32_v_f32m2 +#define VSEV_FLOAT vse32_v_f32m2 +#define VLSEV_FLOAT vlse32_v_f32m2 +#define VLSEG2_FLOAT vlseg2e32_v_f32m2 +#define VLSSEG2_FLOAT vlsseg2e32_v_f32m2 +#define VSSEG2_FLOAT vsseg2e32_v_f32m2 +#define INT_V_T vint32m2_t +#define VID_V_INT vid_v_i32m2 +#define VADD_VX_INT vadd_vx_i32m2 +#define VFRSUB_VF_FLOAT vfrsub_vf_f32m2 +#define VMSGT_VX_INT vmsgt_vx_i32m2_b16 +#define VMSLT_VX_INT vmslt_vx_i32m2_b16 +#define VMSEQ_VX_INT vmseq_vx_i32m2_b16 +#define VBOOL_T vbool16_t +#define VMERGE_VVM_FLOAT vmerge_vvm_f32m2 +#define VFMVVF_FLOAT vfmv_v_f_f32m2 +#else +#define VSETVL(n) vsetvl_e64m2(n) +#define VSETVL_MAX vsetvlmax_e64m2() +#define FLOAT_V_T vfloat64m2_t +#define VLEV_FLOAT vle64_v_f64m2 +#define VSEV_FLOAT vse64_v_f64m2 +#define VLSEV_FLOAT vlse64_v_f64m2 +#define VLSEG2_FLOAT vlseg2e64_v_f64m2 +#define VLSSEG2_FLOAT vlsseg2e64_v_f64m2 +#define VSSEG2_FLOAT vsseg2e64_v_f64m2 +#define INT_V_T vint64m2_t +#define VID_V_INT vid_v_i64m2 +#define VADD_VX_INT vadd_vx_i64m2 +#define VFRSUB_VF_FLOAT vfrsub_vf_f64m2 +#define VMSGT_VX_INT vmsgt_vx_i64m2_b32 +#define VMSLT_VX_INT vmslt_vx_i64m2_b32 +#define VMSEQ_VX_INT vmseq_vx_i64m2_b32 +#define VBOOL_T vbool32_t +#define VMERGE_VVM_FLOAT vmerge_vvm_f64m2 +#define VFMVVF_FLOAT vfmv_v_f_f64m2 +#endif + + +int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG posX, BLASLONG posY, FLOAT *b) +{ + BLASLONG i, js, offset; + + FLOAT *ao1, *ao2; + //fprintf(stderr, "%s, %s, m=%ld n=%ld lda=%ld posX=%ld posY=%ld\n", __FUNCTION__, __FILE__, m, n, lda, posX, posY); + BLASLONG stride_lda = sizeof(FLOAT) * lda * 2; + + FLOAT_V_T vb0, vb1, vb2, va10, va11, va20, va21, vzero; + VBOOL_T vbool_gt0, vbool_eq0; + INT_V_T vindex_max, vindex; + + size_t vl = VSETVL_MAX; + vindex_max = VID_V_INT(vl); + vzero = VFMVVF_FLOAT(ZERO, vl); + + for (js = n; js > 0; js -= vl, posX += vl) { + vl = VSETVL(js); + offset = posX - posY; + + ao1 = a + posY * 2 + posX * lda * 2; + ao2 = a + posX * 2 + posY * lda * 2; + + for (i = m; i > 0; i--, offset--) { + VLSSEG2_FLOAT(&va10, &va11, ao1, stride_lda, vl); + VLSEG2_FLOAT(&va20, &va21, ao2, vl); + + vindex = VADD_VX_INT(vindex_max, offset, vl); + vbool_gt0 = VMSGT_VX_INT(vindex, 0, vl); + vbool_eq0 = VMSEQ_VX_INT(vindex, 0, vl); + + vb0 = VMERGE_VVM_FLOAT(vbool_gt0, va20, va10, vl); + vb1 = VMERGE_VVM_FLOAT(vbool_gt0, va21, va11, vl); + + vb2 = VFRSUB_VF_FLOAT(vb1, ZERO, vl); + + vb1 = VMERGE_VVM_FLOAT(vbool_gt0, vb1, vb2, vl); + vb1 = VMERGE_VVM_FLOAT(vbool_eq0, vb1, vzero, vl); + VSSEG2_FLOAT(b, vb0, vb1, vl); + + b += vl * 2; + ao1 += 2; + ao2 += lda * 2; + } + } + + return 0; +} diff --git a/kernel/riscv64/zsymm_lcopy_rvv_v1.c b/kernel/riscv64/zsymm_lcopy_rvv_v1.c new file mode 100644 index 000000000..df5c916a5 --- /dev/null +++ b/kernel/riscv64/zsymm_lcopy_rvv_v1.c @@ -0,0 +1,106 @@ +/*************************************************************************** +Copyright (c) 2022, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" + +#if !defined(DOUBLE) +#define VSETVL(n) vsetvl_e32m2(n) +#define VSETVL_MAX vsetvlmax_e32m2() +#define FLOAT_V_T vfloat32m2_t +#define VLEV_FLOAT vle32_v_f32m2 +#define VSEV_FLOAT vse32_v_f32m2 +#define VLSEV_FLOAT vlse32_v_f32m2 +#define VLSEG2_FLOAT vlseg2e32_v_f32m2 +#define VLSSEG2_FLOAT vlsseg2e32_v_f32m2 +#define VSSEG2_FLOAT vsseg2e32_v_f32m2 +#define INT_V_T vint32m2_t +#define VID_V_INT vid_v_i32m2 +#define VADD_VX_INT vadd_vx_i32m2 +#define VMSGT_VX_INT vmsgt_vx_i32m2_b16 +#define VBOOL_T vbool16_t +#define VMERGE_VVM_FLOAT vmerge_vvm_f32m2 +#else +#define VSETVL(n) vsetvl_e64m2(n) +#define VSETVL_MAX vsetvlmax_e64m2() +#define FLOAT_V_T vfloat64m2_t +#define VLEV_FLOAT vle64_v_f64m2 +#define VSEV_FLOAT vse64_v_f64m2 +#define VLSEV_FLOAT vlse64_v_f64m2 +#define VLSEG2_FLOAT vlseg2e64_v_f64m2 +#define VLSSEG2_FLOAT vlsseg2e64_v_f64m2 +#define VSSEG2_FLOAT vsseg2e64_v_f64m2 +#define INT_V_T vint64m2_t +#define VID_V_INT vid_v_i64m2 +#define VADD_VX_INT vadd_vx_i64m2 +#define VMSGT_VX_INT vmsgt_vx_i64m2_b32 +#define VBOOL_T vbool32_t +#define VMERGE_VVM_FLOAT vmerge_vvm_f64m2 +#endif + +int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG posX, BLASLONG posY, FLOAT *b) +{ + BLASLONG i, js, offset; + + FLOAT *ao1, *ao2; + + BLASLONG stride_lda = sizeof(FLOAT)*lda*2; + + FLOAT_V_T vb0, vb1, va10, va11, va20, va21; + VBOOL_T vbool; + INT_V_T vindex_max, vindex; + + size_t vl = VSETVL_MAX; + vindex_max = VID_V_INT(vl); + + for (js = n; js > 0; js -= vl, posX += vl) { + vl = VSETVL(js); + offset = posX - posY; + + ao1 = a + posX * 2 + posY * lda * 2; + ao2 = a + posY * 2 + (posX) * lda * 2; + + for (i = m; i > 0; i--, offset--) { + + VLSSEG2_FLOAT(&va20, &va21, ao2, stride_lda, vl); + VLSEG2_FLOAT(&va10, &va11, ao1, vl); + + vindex = VADD_VX_INT(vindex_max, offset, vl); + vbool = VMSGT_VX_INT(vindex, 0, vl); + + vb0 = VMERGE_VVM_FLOAT(vbool, va20, va10, vl); + vb1 = VMERGE_VVM_FLOAT(vbool, va21, va11, vl); + VSSEG2_FLOAT(b, vb0, vb1, vl); + + b += vl * 2; + ao1 += lda * 2; + ao2 += 2; + } + } + + return 0; +} + diff --git a/kernel/riscv64/zsymm_ucopy_rvv_v1.c b/kernel/riscv64/zsymm_ucopy_rvv_v1.c new file mode 100644 index 000000000..dcf2b081a --- /dev/null +++ b/kernel/riscv64/zsymm_ucopy_rvv_v1.c @@ -0,0 +1,106 @@ +/*************************************************************************** +Copyright (c) 2022, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" + +#if !defined(DOUBLE) +#define VSETVL(n) vsetvl_e32m2(n) +#define VSETVL_MAX vsetvlmax_e32m2() +#define FLOAT_V_T vfloat32m2_t +#define VLEV_FLOAT vle32_v_f32m2 +#define VSEV_FLOAT vse32_v_f32m2 +#define VLSEV_FLOAT vlse32_v_f32m2 +#define VLSEG2_FLOAT vlseg2e32_v_f32m2 +#define VLSSEG2_FLOAT vlsseg2e32_v_f32m2 +#define VSSEG2_FLOAT vsseg2e32_v_f32m2 +#define INT_V_T vint32m2_t +#define VID_V_INT vid_v_i32m2 +#define VADD_VX_INT vadd_vx_i32m2 +#define VMSGT_VX_INT vmsgt_vx_i32m2_b16 +#define VBOOL_T vbool16_t +#define VMERGE_VVM_FLOAT vmerge_vvm_f32m2 +#else +#define VSETVL(n) vsetvl_e64m2(n) +#define VSETVL_MAX vsetvlmax_e64m2() +#define FLOAT_V_T vfloat64m2_t +#define VLEV_FLOAT vle64_v_f64m2 +#define VSEV_FLOAT vse64_v_f64m2 +#define VLSEV_FLOAT vlse64_v_f64m2 +#define VLSEG2_FLOAT vlseg2e64_v_f64m2 +#define VLSSEG2_FLOAT vlsseg2e64_v_f64m2 +#define VSSEG2_FLOAT vsseg2e64_v_f64m2 +#define INT_V_T vint64m2_t +#define VID_V_INT vid_v_i64m2 +#define VADD_VX_INT vadd_vx_i64m2 +#define VMSGT_VX_INT vmsgt_vx_i64m2_b32 +#define VBOOL_T vbool32_t +#define VMERGE_VVM_FLOAT vmerge_vvm_f64m2 +#endif + + +int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG posX, BLASLONG posY, FLOAT *b) +{ + BLASLONG i, js, offset; + + FLOAT *ao1, *ao2; + + BLASLONG stride_lda = sizeof(FLOAT)*lda * 2; + + FLOAT_V_T vb0, vb1, va10, va11, va20, va21; + VBOOL_T vbool; + INT_V_T vindex_max, vindex; + + + size_t vl = VSETVL_MAX; + vindex_max = VID_V_INT(vl); + + for (js = n; js > 0; js -= vl, posX += vl) { + vl = VSETVL(js); + offset = posX - posY; + + ao1 = a + posY * 2 + (posX + 0) * lda * 2; + ao2 = a + posX * 2 + 0 + posY * lda * 2; + + for (i = m; i > 0; i--, offset--) { + VLSSEG2_FLOAT(&va10, &va11, ao1, stride_lda, vl); + VLSEG2_FLOAT(&va20, &va21, ao2, vl); + + vindex = VADD_VX_INT(vindex_max, offset, vl); + vbool = VMSGT_VX_INT(vindex, 0, vl); + + vb0 = VMERGE_VVM_FLOAT(vbool, va20, va10, vl); + vb1 = VMERGE_VVM_FLOAT(vbool, va21, va11, vl); + VSSEG2_FLOAT(b, vb0, vb1, vl); + + b += vl * 2; + ao1 += 2; + ao2 += lda * 2; + } + } + + return 0; +} diff --git a/kernel/riscv64/ztrmm_lncopy_rvv_v1.c b/kernel/riscv64/ztrmm_lncopy_rvv_v1.c new file mode 100644 index 000000000..afd694408 --- /dev/null +++ b/kernel/riscv64/ztrmm_lncopy_rvv_v1.c @@ -0,0 +1,145 @@ +/*************************************************************************** +Copyright (c) 2022, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 +#include "common.h" + +#if !defined(DOUBLE) +#define VSETVL(n) vsetvl_e32m2(n) +#define FLOAT_V_T vfloat32m2_t +#define VLEV_FLOAT vle32_v_f32m2 +#define VSEV_FLOAT vse32_v_f32m2 +#define VLSEV_FLOAT vlse32_v_f32m2 +#define VLSEG2_FLOAT vlseg2e32_v_f32m2 +#define VLSSEG2_FLOAT vlsseg2e32_v_f32m2 +#define VSSEG2_FLOAT vsseg2e32_v_f32m2 +#define VBOOL_T vbool16_t +#define UINT_V_T vint32m2_t +#define VID_V_UINT vid_v_i32m2 +#define VMSGTU_VX_UINT vmsgt_vx_i32m2_b16 +#define VMSEQ_VX_UINT vmseq_vx_i32m2_b16 +#define VFMERGE_VFM_FLOAT vfmerge_vfm_f32m2 +#else +#define VSETVL(n) vsetvl_e64m2(n) +#define FLOAT_V_T vfloat64m2_t +#define VLEV_FLOAT vle64_v_f64m2 +#define VSEV_FLOAT vse64_v_f64m2 +#define VLSEV_FLOAT vlse64_v_f64m2 +#define VLSEG2_FLOAT vlseg2e64_v_f64m2 +#define VLSSEG2_FLOAT vlsseg2e64_v_f64m2 +#define VSSEG2_FLOAT vsseg2e64_v_f64m2 +#define VBOOL_T vbool32_t +#define UINT_V_T vuint64m2_t +#define VID_V_UINT vid_v_u64m2 +#define VMSGTU_VX_UINT vmsgtu_vx_u64m2_b32 +#define VMSEQ_VX_UINT vmseq_vx_u64m2_b32 +#define VFMERGE_VFM_FLOAT vfmerge_vfm_f64m2 +#endif + +int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG posX, BLASLONG posY, FLOAT *b){ + + BLASLONG i, js, X; + + FLOAT *ao; + + BLASLONG stride_lda = sizeof(FLOAT)*lda*2; + + FLOAT_V_T va0, va1; + + size_t vl; +#ifdef UNIT + VBOOL_T vbool_eq; +#endif + + VBOOL_T vbool_cmp; + UINT_V_T vindex; + + for (js = n; js > 0; js -= vl) + { + vl = VSETVL(js); + X = posX; + + if (posX <= posY) + { + ao = a + posY * 2 + posX * lda * 2; + } + else + { + ao = a + posX * 2 + posY * lda * 2; + } + + i = 0; + do + { + if (X > posY) + { + VLSSEG2_FLOAT(&va0, &va1, ao, stride_lda, vl); + VSSEG2_FLOAT(b, va0, va1, vl); + + ao += 2; + b += vl * 2; + + X ++; + i ++; + } + else if (X < posY) + { + ao += lda * 2; + b += vl * 2; + X ++; + i ++; + } + else + { + vindex = VID_V_UINT(vl); + for (unsigned int j = 0; j < vl; j++) + { + VLSSEG2_FLOAT(&va0, &va1, ao, stride_lda, vl); + vbool_cmp = VMSGTU_VX_UINT(vindex, j, vl); + va0 = VFMERGE_VFM_FLOAT(vbool_cmp, va0, ZERO, vl); + va1 = VFMERGE_VFM_FLOAT(vbool_cmp, va1, ZERO, vl); +#ifdef UNIT + vbool_eq = VMSEQ_VX_UINT(vindex, j, vl); + va0 = VFMERGE_VFM_FLOAT(vbool_eq, va0, ONE, vl); + va1 = VFMERGE_VFM_FLOAT(vbool_eq, va1, ZERO, vl); +#endif + VSSEG2_FLOAT(b, va0, va1, vl); + ao += 2; + b += vl * 2; + } + + X += vl; + i += vl; + } + } while (i < m); + + posY += vl; + } + + return 0; +} diff --git a/kernel/riscv64/ztrmm_ltcopy_rvv_v1.c b/kernel/riscv64/ztrmm_ltcopy_rvv_v1.c new file mode 100644 index 000000000..c7d593949 --- /dev/null +++ b/kernel/riscv64/ztrmm_ltcopy_rvv_v1.c @@ -0,0 +1,143 @@ +/*************************************************************************** +Copyright (c) 2022, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 +#include "common.h" + +#if !defined(DOUBLE) +#define VSETVL(n) vsetvl_e32m2(n) +#define FLOAT_V_T vfloat32m2_t +#define VLEV_FLOAT vle32_v_f32m2 +#define VSEV_FLOAT vse32_v_f32m2 +#define VLSEG2_FLOAT vlseg2e32_v_f32m2 +#define VLSSEG2_FLOAT vlsseg2e32_v_f32m2 +#define VSSEG2_FLOAT vsseg2e32_v_f32m2 +#define VBOOL_T vbool16_t +#define UINT_V_T vuint32m2_t +#define VID_V_UINT vid_v_u32m2 +#define VMSLTU_VX_UINT vmsltu_vx_u32m2_b16 +#define VMSEQ_VX_UINT vmseq_vx_u32m2_b16 +#define VFMERGE_VFM_FLOAT vfmerge_vfm_f32m2 +#else +#define VSETVL(n) vsetvl_e64m2(n) +#define FLOAT_V_T vfloat64m2_t +#define VLEV_FLOAT vle64_v_f64m2 +#define VSEV_FLOAT vse64_v_f64m2 +#define VLSEG2_FLOAT vlseg2e64_v_f64m2 +#define VLSSEG2_FLOAT vlsseg2e64_v_f64m2 +#define VSSEG2_FLOAT vsseg2e64_v_f64m2 +#define VBOOL_T vbool32_t +#define UINT_V_T vuint64m2_t +#define VID_V_UINT vid_v_u64m2 +#define VMSLTU_VX_UINT vmsltu_vx_u64m2_b32 +#define VMSEQ_VX_UINT vmseq_vx_u64m2_b32 +#define VFMERGE_VFM_FLOAT vfmerge_vfm_f64m2 +#endif + +int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG posX, BLASLONG posY, FLOAT *b){ + + BLASLONG i, js, X; + + FLOAT *ao; + + FLOAT_V_T va0, va1; + size_t vl; +#ifdef UNIT + VBOOL_T vbool_eq; +#endif + + VBOOL_T vbool_cmp; + UINT_V_T vindex; + + for (js = n; js > 0; js -= vl) + { + vl = VSETVL(js); + X = posX; + + if (posX <= posY) + { + ao = a + posY * 2 + posX * lda * 2; + } + else + { + ao = a + posX * 2 + posY * lda * 2; + } + + i = 0; + do + { + if (X > posY) + { + ao += 2; + b += vl * 2; + X++; + i++; + } + else if (X < posY) + { + //va1 = VLEV_FLOAT(ao, vl); + VLSEG2_FLOAT(&va0, &va1, ao, vl); + VSSEG2_FLOAT(b, va0, va1, vl); + + ao += lda * 2; + b += vl * 2; + X ++; + i ++; + } + else + { + vindex = VID_V_UINT(vl); + for (unsigned int j = 0; j < vl; j++) + { + //va1 = VLEV_FLOAT(ao, vl); + VLSEG2_FLOAT(&va0, &va1, ao, vl); + vbool_cmp = VMSLTU_VX_UINT(vindex, j, vl); + va0 = VFMERGE_VFM_FLOAT(vbool_cmp, va0, ZERO, vl); + va1 = VFMERGE_VFM_FLOAT(vbool_cmp, va1, ZERO, vl); +#ifdef UNIT + vbool_eq = VMSEQ_VX_UINT(vindex, j, vl); + va0 = VFMERGE_VFM_FLOAT(vbool_eq, va0, ONE, vl); + va1 = VFMERGE_VFM_FLOAT(vbool_eq, va1, ZERO, vl); +#endif + //VSEV_FLOAT(b, vb, vl); + VSSEG2_FLOAT(b, va0, va1, vl); + ao += lda * 2; + b += vl * 2; + } + X += vl; + i += vl; + + } + } while (i < m); + + posY += vl; + } + + return 0; +} + diff --git a/kernel/riscv64/ztrmm_uncopy_rvv_v1.c b/kernel/riscv64/ztrmm_uncopy_rvv_v1.c new file mode 100644 index 000000000..3c70b6385 --- /dev/null +++ b/kernel/riscv64/ztrmm_uncopy_rvv_v1.c @@ -0,0 +1,144 @@ +/*************************************************************************** +Copyright (c) 2022, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 +#include "common.h" + +#if !defined(DOUBLE) +#define VSETVL(n) vsetvl_e32m2(n) +#define FLOAT_V_T vfloat32m2_t +#define VLEV_FLOAT vle32_v_f32m2 +#define VLSEV_FLOAT vlse32_v_f32m2 +#define VSEV_FLOAT vse32_v_f32m2 +#define VLSEG2_FLOAT vlseg2e32_v_f32m2 +#define VLSSEG2_FLOAT vlsseg2e32_v_f32m2 +#define VSSEG2_FLOAT vsseg2e32_v_f32m2 +#define VBOOL_T vbool16_t +#define UINT_V_T vuint32m2_t +#define VID_V_UINT vid_v_u32m2 +#define VMSLTU_VX_UINT vmsltu_vx_u32m2_b16 +#define VMSEQ_VX_UINT vmseq_vx_u32m2_b16 +#define VFMERGE_VFM_FLOAT vfmerge_vfm_f32m2 +#else +#define VSETVL(n) vsetvl_e64m2(n) +#define FLOAT_V_T vfloat64m2_t +#define VLEV_FLOAT vle64_v_f64m2 +#define VLSEV_FLOAT vlse64_v_f64m2 +#define VSEV_FLOAT vse64_v_f64m2 +#define VLSEG2_FLOAT vlseg2e64_v_f64m2 +#define VLSSEG2_FLOAT vlsseg2e64_v_f64m2 +#define VSSEG2_FLOAT vsseg2e64_v_f64m2 +#define VBOOL_T vbool32_t +#define UINT_V_T vuint64m2_t +#define VID_V_UINT vid_v_u64m2 +#define VMSLTU_VX_UINT vmsltu_vx_u64m2_b32 +#define VMSEQ_VX_UINT vmseq_vx_u64m2_b32 +#define VFMERGE_VFM_FLOAT vfmerge_vfm_f64m2 +#endif + +int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG posX, BLASLONG posY, FLOAT *b){ + + BLASLONG i, js, X; + BLASLONG stride_lda = sizeof(FLOAT) * lda * 2; + FLOAT *ao; + + FLOAT_V_T va0, va1; + size_t vl; + +#ifdef UNIT + VBOOL_T vbool_eq; +#endif + + VBOOL_T vbool_cmp; + UINT_V_T vindex; + + for (js = n; js > 0; js -= vl) + { + vl = VSETVL(js); + X = posX; + + if (posX <= posY) + { + ao = a + posX * 2 + posY * lda * 2; + } + else + { + ao = a + posY * 2 + posX * lda * 2; + } + + i = 0; + do + { + if (X < posY) + { + VLSSEG2_FLOAT(&va0, &va1, ao, stride_lda, vl); + VSSEG2_FLOAT(b, va0, va1, vl); + + ao += 2; + b += vl * 2; + + X++; + i++; + } + else if (X > posY) + { + ao += lda * 2; + b += vl * 2; + + X++; + i++; + } + else + { + vindex = VID_V_UINT(vl); + for (unsigned int j = 0; j < vl; j++) + { + VLSSEG2_FLOAT(&va0, &va1, ao, stride_lda, vl); + vbool_cmp = VMSLTU_VX_UINT(vindex, j, vl); + va0 = VFMERGE_VFM_FLOAT(vbool_cmp, va0, ZERO, vl); + va1 = VFMERGE_VFM_FLOAT(vbool_cmp, va1, ZERO, vl); +#ifdef UNIT + vbool_eq = VMSEQ_VX_UINT(vindex, j, vl); + va0 = VFMERGE_VFM_FLOAT(vbool_eq, va0, ONE, vl); + va1 = VFMERGE_VFM_FLOAT(vbool_eq, va1, ZERO, vl); +#endif + VSSEG2_FLOAT(b, va0, va1, vl); + ao += 2; + b += vl * 2; + } + + X += vl; + i += vl; + } + }while (i < m); + + posY += vl; + } + + return 0; +} diff --git a/kernel/riscv64/ztrmm_utcopy_rvv_v1.c b/kernel/riscv64/ztrmm_utcopy_rvv_v1.c new file mode 100644 index 000000000..706782cf0 --- /dev/null +++ b/kernel/riscv64/ztrmm_utcopy_rvv_v1.c @@ -0,0 +1,140 @@ +/*********************************************************************/ +/* Copyright 2009, 2010 The University of Texas at Austin. */ +/*************************************************************************** +Copyright (c) 2022, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 +#include "common.h" + +#if !defined(DOUBLE) +#define VSETVL(n) vsetvl_e32m2(n) +#define FLOAT_V_T vfloat32m2_t +#define VLEV_FLOAT vle32_v_f32m2 +#define VSEV_FLOAT vse32_v_f32m2 +#define VLSEG2_FLOAT vlseg2e32_v_f32m2 +#define VLSSEG2_FLOAT vlsseg2e32_v_f32m2 +#define VSSEG2_FLOAT vsseg2e32_v_f32m2 +#define VBOOL_T vbool16_t +#define UINT_V_T vuint32m2_t +#define VID_V_UINT vid_v_u32m2 +#define VMSGTU_VX_UINT vmsgtu_vx_u32m2_b16 +#define VMSEQ_VX_UINT vmseq_vx_u32m2_b16 +#define VFMERGE_VFM_FLOAT vfmerge_vfm_f32m2 +#else +#define VSETVL(n) vsetvl_e64m2(n) +#define FLOAT_V_T vfloat64m2_t +#define VLEV_FLOAT vle64_v_f64m2 +#define VSEV_FLOAT vse64_v_f64m2 +#define VLSEG2_FLOAT vlseg2e64_v_f64m2 +#define VLSSEG2_FLOAT vlsseg2e64_v_f64m2 +#define VSSEG2_FLOAT vsseg2e64_v_f64m2 +#define VBOOL_T vbool32_t +#define UINT_V_T vuint64m2_t +#define VID_V_UINT vid_v_u64m2 +#define VMSGTU_VX_UINT vmsgtu_vx_u64m2_b32 +#define VMSEQ_VX_UINT vmseq_vx_u64m2_b32 +#define VFMERGE_VFM_FLOAT vfmerge_vfm_f64m2 +#endif + +int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG posX, BLASLONG posY, FLOAT *b){ + + BLASLONG i, j, js, X; + + FLOAT *ao; + FLOAT_V_T va0, va1; +#ifdef UNIT + VBOOL_T vbool_eq; +#endif + + VBOOL_T vbool_cmp; + UINT_V_T vindex; + + size_t vl; + + for (js = n; js > 0; js -= vl) + { + vl = VSETVL(js); + + X = posX; + + if (posX <= posY) + { + ao = a + posX * 2 + posY * lda * 2; + } + else + { + ao = a + posY * 2 + posX * lda * 2; + } + + i = 0; + do + { + if (X < posY) + { + ao += 2; + b += vl * 2; + X++; + i++; + } + else if (X > posY) + { + VLSEG2_FLOAT(&va0, &va1, ao, vl); + VSSEG2_FLOAT(b, va0, va1, vl); + ao += lda * 2; + b += vl * 2; + X++; + i++; + } + else + { + vindex = VID_V_UINT(vl); + for (j = 0; j < vl; j++) + { + VLSEG2_FLOAT(&va0, &va1, ao, vl); + vbool_cmp = VMSGTU_VX_UINT(vindex, j, vl); + va0 = VFMERGE_VFM_FLOAT(vbool_cmp, va0, ZERO, vl); + va1 = VFMERGE_VFM_FLOAT(vbool_cmp, va1, ZERO, vl); +#ifdef UNIT + vbool_eq = VMSEQ_VX_UINT(vindex, j, vl); + va0 = VFMERGE_VFM_FLOAT(vbool_eq, va0, ONE, vl); + va1 = VFMERGE_VFM_FLOAT(vbool_eq, va1, ZERO, vl); +#endif + VSSEG2_FLOAT(b, va0, va1, vl); + ao += lda * 2; + b += vl * 2; + } + X += vl; + i += vl; + } + }while (i < m); + posY += vl; + } + + return 0; +} + diff --git a/kernel/riscv64/ztrmmkernel_rvv_v1x4.c b/kernel/riscv64/ztrmmkernel_rvv_v1x4.c new file mode 100644 index 000000000..27409ec25 --- /dev/null +++ b/kernel/riscv64/ztrmmkernel_rvv_v1x4.c @@ -0,0 +1,574 @@ +/*************************************************************************** +Copyright (c) 2022, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" + +#if !defined(DOUBLE) +#define VSETVL(n) vsetvl_e32m2(n) +#define FLOAT_V_T vfloat32m2_t +#define VLEV_FLOAT vle32_v_f32m2 +#define VSEV_FLOAT vse32_v_f32m2 +#define VLSEG2_FLOAT vlseg2e32_v_f32m2 +#define VSSEG2_FLOAT vsseg2e32_v_f32m2 +#define VFMVVF_FLOAT vfmv_v_f_f32m2 +#define VFMACCVF_FLOAT vfmacc_vf_f32m2 +#define VFNMSACVF_FLOAT vfnmsac_vf_f32m2 +#define VFMULVF_FLOAT vfmul_vf_f32m2 +#else +#define VSETVL(n) vsetvl_e64m2(n) +#define FLOAT_V_T vfloat64m2_t +#define VLEV_FLOAT vle64_v_f64m2 +#define VSEV_FLOAT vse64_v_f64m2 +#define VLSEG2_FLOAT vlseg2e64_v_f64m2 +#define VSSEG2_FLOAT vsseg2e64_v_f64m2 +#define VFMVVF_FLOAT vfmv_v_f_f64m2 +#define VFMACCVF_FLOAT vfmacc_vf_f64m2 +#define VFNMSACVF_FLOAT vfnmsac_vf_f64m2 +#define VFMULVF_FLOAT vfmul_vf_f64m2 +#endif + +#if defined(NN) || defined(NT) || defined(TN) || defined(TT) +#define OP_rr VFMACCVF_FLOAT +#define OP_ir VFMACCVF_FLOAT +#define OP_ii VFNMSACVF_FLOAT +#define OP_ri VFMACCVF_FLOAT +#elif defined(NR) || defined(NC) || defined(TR) || defined(TC) +#define OP_rr VFMACCVF_FLOAT +#define OP_ir VFMACCVF_FLOAT +#define OP_ii VFMACCVF_FLOAT +#define OP_ri VFNMSACVF_FLOAT +#elif defined(RN) || defined(RT) || defined(CN) || defined(CT) +#define OP_rr VFMACCVF_FLOAT +#define OP_ir VFNMSACVF_FLOAT +#define OP_ii VFMACCVF_FLOAT +#define OP_ri VFMACCVF_FLOAT +#elif defined(RR) || defined(RC) || defined(CR) || defined(CC) +#define OP_rr VFMACCVF_FLOAT +#define OP_ir VFNMSACVF_FLOAT +#define OP_ii VFNMSACVF_FLOAT +#define OP_ri VFNMSACVF_FLOAT +#endif + +int CNAME(BLASLONG bm,BLASLONG bn,BLASLONG bk,FLOAT alphar,FLOAT alphai,FLOAT* ba,FLOAT* bb,FLOAT* C, BLASLONG ldc, BLASLONG offset) +{ + BLASLONG i,j,k; + FLOAT *C0, *C1, *C2, *C3, *ptrba,*ptrbb; + BLASLONG off, temp; + +#if defined(TRMMKERNEL) && !defined(LEFT) + off = -offset; +#else + off = 0; +#endif + + FLOAT_V_T va0, va1, va2, va3, va4, va5, va6, va7; + FLOAT_V_T vres0, vres1, vres2, vres3, vres4, vres5, vres6, vres7; + + //fprintf(stderr, "%s, bn=%ld bm=%ld bk=%ld alphar=%f alphai=%f ldc=%ld, offset=%ld\n", __FUNCTION__, bn, bm, bk, alphar, alphai, ldc, offset); // Debug + + size_t vl; + for (j = bn/4; j > 0; j--) + { + C0 = C; + C1 = C0 + 2 * ldc; + C2 = C1 + 2 * ldc; + C3 = C2 + 2 * ldc; +#if defined(TRMMKERNEL) && defined(LEFT) + off = offset; +#endif + ptrba = ba; + for (i = bm; i > 0; i -= vl) + { + vl = VSETVL(i); +#if (defined(LEFT) && defined(TRANSA)) || (!defined(LEFT) && !defined(TRANSA)) + ptrbb = bb; +#else + ptrba += off*vl*2; + ptrbb = bb + off*4*2; +#endif + + vres0 = VFMVVF_FLOAT(0.0, vl); + vres1 = VFMVVF_FLOAT(0.0, vl); + vres2 = VFMVVF_FLOAT(0.0, vl); + vres3 = VFMVVF_FLOAT(0.0, vl); + vres4 = VFMVVF_FLOAT(0.0, vl); + vres5 = VFMVVF_FLOAT(0.0, vl); + vres6 = VFMVVF_FLOAT(0.0, vl); + vres7 = VFMVVF_FLOAT(0.0, vl); + +#if (defined(LEFT) && !defined(TRANSA)) || (!defined(LEFT) && defined(TRANSA)) + temp = bk-off; +#elif defined(LEFT) + temp = off+vl; // number of values in A +#else + temp = off+4; // number of values in B +#endif + + for (k = temp/4; k > 0; k--) + { + VLSEG2_FLOAT(&va0, &va1, ptrba, vl); + ptrba += vl*2; + + VLSEG2_FLOAT(&va2, &va3, ptrba, vl); + ptrba += vl*2; + + vres0 = OP_rr(vres0, *(ptrbb + 0), va0, vl); + vres1 = OP_ir(vres1, *(ptrbb + 0), va1, vl); + vres0 = OP_ii(vres0, *(ptrbb + 1), va1, vl); + vres1 = OP_ri(vres1, *(ptrbb + 1), va0, vl); + + vres2 = OP_rr(vres2, *(ptrbb + 2), va0, vl); + vres3 = OP_ir(vres3, *(ptrbb + 2), va1, vl); + vres2 = OP_ii(vres2, *(ptrbb + 3), va1, vl); + vres3 = OP_ri(vres3, *(ptrbb + 3), va0, vl); + + vres4 = OP_rr(vres4, *(ptrbb + 4), va0, vl); + vres5 = OP_ir(vres5, *(ptrbb + 4), va1, vl); + vres4 = OP_ii(vres4, *(ptrbb + 5), va1, vl); + vres5 = OP_ri(vres5, *(ptrbb + 5), va0, vl); + + vres6 = OP_rr(vres6, *(ptrbb + 6), va0, vl); + vres7 = OP_ir(vres7, *(ptrbb + 6), va1, vl); + vres6 = OP_ii(vres6, *(ptrbb + 7), va1, vl); + vres7 = OP_ri(vres7, *(ptrbb + 7), va0, vl); + + ptrbb += 8; + + VLSEG2_FLOAT(&va4, &va5, ptrba, vl); + ptrba += vl*2; + + vres0 = OP_rr(vres0, *(ptrbb + 0), va2, vl); + vres1 = OP_ir(vres1, *(ptrbb + 0), va3, vl); + vres0 = OP_ii(vres0, *(ptrbb + 1), va3, vl); + vres1 = OP_ri(vres1, *(ptrbb + 1), va2, vl); + + vres2 = OP_rr(vres2, *(ptrbb + 2), va2, vl); + vres3 = OP_ir(vres3, *(ptrbb + 2), va3, vl); + vres2 = OP_ii(vres2, *(ptrbb + 3), va3, vl); + vres3 = OP_ri(vres3, *(ptrbb + 3), va2, vl); + + vres4 = OP_rr(vres4, *(ptrbb + 4), va2, vl); + vres5 = OP_ir(vres5, *(ptrbb + 4), va3, vl); + vres4 = OP_ii(vres4, *(ptrbb + 5), va3, vl); + vres5 = OP_ri(vres5, *(ptrbb + 5), va2, vl); + + vres6 = OP_rr(vres6, *(ptrbb + 6), va2, vl); + vres7 = OP_ir(vres7, *(ptrbb + 6), va3, vl); + vres6 = OP_ii(vres6, *(ptrbb + 7), va3, vl); + vres7 = OP_ri(vres7, *(ptrbb + 7), va2, vl); + + ptrbb += 8; + + VLSEG2_FLOAT(&va6, &va7, ptrba, vl); + ptrba += vl*2; + + vres0 = OP_rr(vres0, *(ptrbb + 0), va4, vl); + vres1 = OP_ir(vres1, *(ptrbb + 0), va5, vl); + vres0 = OP_ii(vres0, *(ptrbb + 1), va5, vl); + vres1 = OP_ri(vres1, *(ptrbb + 1), va4, vl); + + vres2 = OP_rr(vres2, *(ptrbb + 2), va4, vl); + vres3 = OP_ir(vres3, *(ptrbb + 2), va5, vl); + vres2 = OP_ii(vres2, *(ptrbb + 3), va5, vl); + vres3 = OP_ri(vres3, *(ptrbb + 3), va4, vl); + + vres4 = OP_rr(vres4, *(ptrbb + 4), va4, vl); + vres5 = OP_ir(vres5, *(ptrbb + 4), va5, vl); + vres4 = OP_ii(vres4, *(ptrbb + 5), va5, vl); + vres5 = OP_ri(vres5, *(ptrbb + 5), va4, vl); + + vres6 = OP_rr(vres6, *(ptrbb + 6), va4, vl); + vres7 = OP_ir(vres7, *(ptrbb + 6), va5, vl); + vres6 = OP_ii(vres6, *(ptrbb + 7), va5, vl); + vres7 = OP_ri(vres7, *(ptrbb + 7), va4, vl); + + ptrbb += 8; + + vres0 = OP_rr(vres0, *(ptrbb + 0), va6, vl); + vres1 = OP_ir(vres1, *(ptrbb + 0), va7, vl); + vres0 = OP_ii(vres0, *(ptrbb + 1), va7, vl); + vres1 = OP_ri(vres1, *(ptrbb + 1), va6, vl); + + vres2 = OP_rr(vres2, *(ptrbb + 2), va6, vl); + vres3 = OP_ir(vres3, *(ptrbb + 2), va7, vl); + vres2 = OP_ii(vres2, *(ptrbb + 3), va7, vl); + vres3 = OP_ri(vres3, *(ptrbb + 3), va6, vl); + + vres4 = OP_rr(vres4, *(ptrbb + 4), va6, vl); + vres5 = OP_ir(vres5, *(ptrbb + 4), va7, vl); + vres4 = OP_ii(vres4, *(ptrbb + 5), va7, vl); + vres5 = OP_ri(vres5, *(ptrbb + 5), va6, vl); + + vres6 = OP_rr(vres6, *(ptrbb + 6), va6, vl); + vres7 = OP_ir(vres7, *(ptrbb + 6), va7, vl); + vres6 = OP_ii(vres6, *(ptrbb + 7), va7, vl); + vres7 = OP_ri(vres7, *(ptrbb + 7), va6, vl); + + ptrbb += 8; + } + + for (k = temp & 3; k > 0; k--) + { + VLSEG2_FLOAT(&va0, &va1, ptrba, vl); + ptrba += vl*2; + + vres0 = OP_rr(vres0, *(ptrbb + 0), va0, vl); + vres1 = OP_ir(vres1, *(ptrbb + 0), va1, vl); + vres0 = OP_ii(vres0, *(ptrbb + 1), va1, vl); + vres1 = OP_ri(vres1, *(ptrbb + 1), va0, vl); + + vres2 = OP_rr(vres2, *(ptrbb + 2), va0, vl); + vres3 = OP_ir(vres3, *(ptrbb + 2), va1, vl); + vres2 = OP_ii(vres2, *(ptrbb + 3), va1, vl); + vres3 = OP_ri(vres3, *(ptrbb + 3), va0, vl); + + vres4 = OP_rr(vres4, *(ptrbb + 4), va0, vl); + vres5 = OP_ir(vres5, *(ptrbb + 4), va1, vl); + vres4 = OP_ii(vres4, *(ptrbb + 5), va1, vl); + vres5 = OP_ri(vres5, *(ptrbb + 5), va0, vl); + + vres6 = OP_rr(vres6, *(ptrbb + 6), va0, vl); + vres7 = OP_ir(vres7, *(ptrbb + 6), va1, vl); + vres6 = OP_ii(vres6, *(ptrbb + 7), va1, vl); + vres7 = OP_ri(vres7, *(ptrbb + 7), va0, vl); + + ptrbb += 8; + } + va0 = VFMULVF_FLOAT(vres0, alphar, vl); + va1 = VFMULVF_FLOAT(vres1, alphar, vl); + va0 = VFNMSACVF_FLOAT(va0, alphai, vres1, vl); + va1 = VFMACCVF_FLOAT(va1, alphai, vres0, vl); + VSSEG2_FLOAT(C0, va0, va1, vl); + + va2 = VFMULVF_FLOAT(vres2, alphar, vl); + va3 = VFMULVF_FLOAT(vres3, alphar, vl); + va2 = VFNMSACVF_FLOAT(va2, alphai, vres3, vl); + va3 = VFMACCVF_FLOAT(va3, alphai, vres2, vl); + VSSEG2_FLOAT(C1, va2, va3, vl); + + va0 = VFMULVF_FLOAT(vres4, alphar, vl); + va1 = VFMULVF_FLOAT(vres5, alphar, vl); + va0 = VFNMSACVF_FLOAT(va0, alphai, vres5, vl); + va1 = VFMACCVF_FLOAT(va1, alphai, vres4, vl); + VSSEG2_FLOAT(C2, va0, va1, vl); + + va2 = VFMULVF_FLOAT(vres6, alphar, vl); + va3 = VFMULVF_FLOAT(vres7, alphar, vl); + va2 = VFNMSACVF_FLOAT(va2, alphai, vres7, vl); + va3 = VFMACCVF_FLOAT(va3, alphai, vres6, vl); + VSSEG2_FLOAT(C3, va2, va3, vl); + +#if ( defined(LEFT) && defined(TRANSA)) || (!defined(LEFT) && !defined(TRANSA)) + temp = bk - off; +#ifdef LEFT + temp -= vl; // number of values in A +#else + temp -= 4; // number of values in B +#endif + ptrba += temp*vl*2; + ptrbb += temp*4*2; +#endif + +#ifdef LEFT + off += vl; // number of values in A +#endif + + C0 += vl * 2; + C1 += vl * 2; + C2 += vl * 2; + C3 += vl * 2; + } +#if defined(TRMMKERNEL) && !defined(LEFT) + off += 4; +#endif + + bb += (bk << 3); + C += (ldc << 3); + } + + if (bn & 2) + { + C0 = C; + C1 = C0 + 2 * ldc; +#if defined(TRMMKERNEL) && defined(LEFT) + off = offset; +#endif + ptrba = ba; + for (i = bm; i > 0; i -= vl) + { + vl = VSETVL(i); +#if (defined(LEFT) && defined(TRANSA)) || (!defined(LEFT) && !defined(TRANSA)) + ptrbb = bb; +#else + ptrba += off*vl*2; + ptrbb = bb + off*2*2; +#endif + + vres0 = VFMVVF_FLOAT(0.0, vl); + vres1 = VFMVVF_FLOAT(0.0, vl); + vres2 = VFMVVF_FLOAT(0.0, vl); + vres3 = VFMVVF_FLOAT(0.0, vl); + +#if (defined(LEFT) && !defined(TRANSA)) || (!defined(LEFT) && defined(TRANSA)) + temp = bk-off; +#elif defined(LEFT) + temp = off+vl; // number of values in A +#else + temp = off+2; // number of values in B +#endif + for (k = temp/4; k > 0; k--) + { + VLSEG2_FLOAT(&va0, &va1, ptrba, vl); + ptrba += vl*2; + + VLSEG2_FLOAT(&va2, &va3, ptrba, vl); + ptrba += vl*2; + + vres0 = OP_rr(vres0, *(ptrbb + 0), va0, vl); + vres1 = OP_ir(vres1, *(ptrbb + 0), va1, vl); + vres0 = OP_ii(vres0, *(ptrbb + 1), va1, vl); + vres1 = OP_ri(vres1, *(ptrbb + 1), va0, vl); + + vres2 = OP_rr(vres2, *(ptrbb + 2), va0, vl); + vres3 = OP_ir(vres3, *(ptrbb + 2), va1, vl); + vres2 = OP_ii(vres2, *(ptrbb + 3), va1, vl); + vres3 = OP_ri(vres3, *(ptrbb + 3), va0, vl); + + ptrbb += 4; + + VLSEG2_FLOAT(&va4, &va5, ptrba, vl); + ptrba += vl*2; + + vres0 = OP_rr(vres0, *(ptrbb + 0), va2, vl); + vres1 = OP_ir(vres1, *(ptrbb + 0), va3, vl); + vres0 = OP_ii(vres0, *(ptrbb + 1), va3, vl); + vres1 = OP_ri(vres1, *(ptrbb + 1), va2, vl); + + vres2 = OP_rr(vres2, *(ptrbb + 2), va2, vl); + vres3 = OP_ir(vres3, *(ptrbb + 2), va3, vl); + vres2 = OP_ii(vres2, *(ptrbb + 3), va3, vl); + vres3 = OP_ri(vres3, *(ptrbb + 3), va2, vl); + + ptrbb += 4; + + VLSEG2_FLOAT(&va6, &va7, ptrba, vl); + ptrba += vl*2; + + vres0 = OP_rr(vres0, *(ptrbb + 0), va4, vl); + vres1 = OP_ir(vres1, *(ptrbb + 0), va5, vl); + vres0 = OP_ii(vres0, *(ptrbb + 1), va5, vl); + vres1 = OP_ri(vres1, *(ptrbb + 1), va4, vl); + + vres2 = OP_rr(vres2, *(ptrbb + 2), va4, vl); + vres3 = OP_ir(vres3, *(ptrbb + 2), va5, vl); + vres2 = OP_ii(vres2, *(ptrbb + 3), va5, vl); + vres3 = OP_ri(vres3, *(ptrbb + 3), va4, vl); + + ptrbb += 4; + + vres0 = OP_rr(vres0, *(ptrbb + 0), va6, vl); + vres1 = OP_ir(vres1, *(ptrbb + 0), va7, vl); + vres0 = OP_ii(vres0, *(ptrbb + 1), va7, vl); + vres1 = OP_ri(vres1, *(ptrbb + 1), va6, vl); + + vres2 = OP_rr(vres2, *(ptrbb + 2), va6, vl); + vres3 = OP_ir(vres3, *(ptrbb + 2), va7, vl); + vres2 = OP_ii(vres2, *(ptrbb + 3), va7, vl); + vres3 = OP_ri(vres3, *(ptrbb + 3), va6, vl); + + ptrbb += 4; + } + + for (k = temp & 3; k > 0; k--) + { + VLSEG2_FLOAT(&va0, &va1, ptrba, vl); + ptrba += vl*2; + + vres0 = OP_rr(vres0, *(ptrbb + 0), va0, vl); + vres1 = OP_ir(vres1, *(ptrbb + 0), va1, vl); + vres0 = OP_ii(vres0, *(ptrbb + 1), va1, vl); + vres1 = OP_ri(vres1, *(ptrbb + 1), va0, vl); + + vres2 = OP_rr(vres2, *(ptrbb + 2), va0, vl); + vres3 = OP_ir(vres3, *(ptrbb + 2), va1, vl); + vres2 = OP_ii(vres2, *(ptrbb + 3), va1, vl); + vres3 = OP_ri(vres3, *(ptrbb + 3), va0, vl); + + ptrbb += 4; + } + + va0 = VFMULVF_FLOAT(vres0, alphar, vl); + va1 = VFMULVF_FLOAT(vres1, alphar, vl); + va0 = VFNMSACVF_FLOAT(va0, alphai, vres1, vl); + va1 = VFMACCVF_FLOAT(va1, alphai, vres0, vl); + VSSEG2_FLOAT(C0, va0, va1, vl); + + va2 = VFMULVF_FLOAT(vres2, alphar, vl); + va3 = VFMULVF_FLOAT(vres3, alphar, vl); + va2 = VFNMSACVF_FLOAT(va2, alphai, vres3, vl); + va3 = VFMACCVF_FLOAT(va3, alphai, vres2, vl); + VSSEG2_FLOAT(C1, va2, va3, vl); + +#if ( defined(LEFT) && defined(TRANSA)) || (!defined(LEFT) && !defined(TRANSA)) + temp = bk - off; +#ifdef LEFT + temp -= vl; // number of values in A +#else + temp -= 2; // number of values in B +#endif + ptrba += temp*vl*2; + ptrbb += temp*2*2; +#endif + +#ifdef LEFT + off += vl; // number of values in A +#endif + C0 += vl * 2; + C1 += vl * 2; + } + +#if defined(TRMMKERNEL) && !defined(LEFT) + off += 2; +#endif + bb += (bk << 2); + C += (ldc << 2); + } + + if (bn & 1) + { + C0 = C; +#if defined(TRMMKERNEL) && defined(LEFT) + off = offset; +#endif + ptrba = ba; + for (i = bm; i > 0; i -= vl) + { + vl = VSETVL(i); +#if (defined(LEFT) && defined(TRANSA)) || (!defined(LEFT) && !defined(TRANSA)) + ptrbb = bb; +#else + ptrba += off*vl*2; + ptrbb = bb + off*2; +#endif + + vres0 = VFMVVF_FLOAT(0.0, vl); + vres1 = VFMVVF_FLOAT(0.0, vl); + +#if (defined(LEFT) && !defined(TRANSA)) || (!defined(LEFT) && defined(TRANSA)) + temp = bk-off; +#elif defined(LEFT) + temp = off+vl; // number of values in A +#else + temp = off+1; // number of values in B +#endif + for (k = temp/4; k > 0; k--) + { + VLSEG2_FLOAT(&va0, &va1, ptrba, vl); + ptrba += vl*2; + + VLSEG2_FLOAT(&va2, &va3, ptrba, vl); + ptrba += vl*2; + + vres0 = OP_rr(vres0, *(ptrbb + 0), va0, vl); + vres1 = OP_ir(vres1, *(ptrbb + 0), va1, vl); + vres0 = OP_ii(vres0, *(ptrbb + 1), va1, vl); + vres1 = OP_ri(vres1, *(ptrbb + 1), va0, vl); + + ptrbb += 2; + + VLSEG2_FLOAT(&va4, &va5, ptrba, vl); + ptrba += vl*2; + + vres0 = OP_rr(vres0, *(ptrbb + 0), va2, vl); + vres1 = OP_ir(vres1, *(ptrbb + 0), va3, vl); + vres0 = OP_ii(vres0, *(ptrbb + 1), va3, vl); + vres1 = OP_ri(vres1, *(ptrbb + 1), va2, vl); + + ptrbb += 2; + + VLSEG2_FLOAT(&va6, &va7, ptrba, vl); + ptrba += vl*2; + + vres0 = OP_rr(vres0, *(ptrbb + 0), va4, vl); + vres1 = OP_ir(vres1, *(ptrbb + 0), va5, vl); + vres0 = OP_ii(vres0, *(ptrbb + 1), va5, vl); + vres1 = OP_ri(vres1, *(ptrbb + 1), va4, vl); + + ptrbb += 2; + + vres0 = OP_rr(vres0, *(ptrbb + 0), va6, vl); + vres1 = OP_ir(vres1, *(ptrbb + 0), va7, vl); + vres0 = OP_ii(vres0, *(ptrbb + 1), va7, vl); + vres1 = OP_ri(vres1, *(ptrbb + 1), va6, vl); + + ptrbb += 2; + } + + for (k = temp & 3; k > 0; k--) + { + VLSEG2_FLOAT(&va0, &va1, ptrba, vl); + ptrba += vl*2; + + vres0 = OP_rr(vres0, *(ptrbb + 0), va0, vl); + vres1 = OP_ir(vres1, *(ptrbb + 0), va1, vl); + vres0 = OP_ii(vres0, *(ptrbb + 1), va1, vl); + vres1 = OP_ri(vres1, *(ptrbb + 1), va0, vl); + + ptrbb += 2; + } + + va0 = VFMULVF_FLOAT(vres0, alphar, vl); + va1 = VFMULVF_FLOAT(vres1, alphar, vl); + va0 = VFNMSACVF_FLOAT(va0, alphai, vres1, vl); + va1 = VFMACCVF_FLOAT(va1, alphai, vres0, vl); + VSSEG2_FLOAT(C0, va0, va1, vl); + +#if ( defined(LEFT) && defined(TRANSA)) || (!defined(LEFT) && !defined(TRANSA)) + temp = bk - off; +#ifdef LEFT + temp -= vl; // number of values in A +#else + temp -= 1; // number of values in B +#endif + ptrba += temp*vl*2; + ptrbb += temp*2; +#endif + +#ifdef LEFT + off += vl; // number of values in A +#endif + C0 += vl * 2; + } + +#if defined(TRMMKERNEL) && !defined(LEFT) + off += 1; +#endif + bb += bk << 1; + C += ldc << 1; + } + return 0; +} diff --git a/kernel/riscv64/ztrsm_lncopy_rvv_v1.c b/kernel/riscv64/ztrsm_lncopy_rvv_v1.c new file mode 100644 index 000000000..b7ccb1eb3 --- /dev/null +++ b/kernel/riscv64/ztrsm_lncopy_rvv_v1.c @@ -0,0 +1,115 @@ +/*************************************************************************** +Copyright (c) 2022, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 +#include "common.h" + +#if !defined(DOUBLE) +#define VSETVL(n) vsetvl_e32m2(n) +#define FLOAT_V_T vfloat32m2_t +#define VLSSEG2_FLOAT vlsseg2e32_v_f32m2 +#define VSSEG2_FLOAT vsseg2e32_v_f32m2 +#define VSSEG2_FLOAT_M vsseg2e32_v_f32m2_m +#define VBOOL_T vbool16_t +#define UINT_V_T vuint32m2_t +#define VID_V_UINT vid_v_u32m2 +#define VMSLTU_VX_UINT vmsltu_vx_u32m2_b16 +#else +#define VSETVL(n) vsetvl_e64m2(n) +#define FLOAT_V_T vfloat64m2_t +#define VLSSEG2_FLOAT vlsseg2e64_v_f64m2 +#define VSSEG2_FLOAT vsseg2e64_v_f64m2 +#define VSSEG2_FLOAT_M vsseg2e64_v_f64m2_m +#define VBOOL_T vbool32_t +#define UINT_V_T vuint64m2_t +#define VID_V_UINT vid_v_u64m2 +#define VMSLTU_VX_UINT vmsltu_vx_u64m2_b32 + +#endif + + +int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG offset, FLOAT *b){ + + //fprintf(stderr, "%s , %s, m = %4ld n = %4ld lda = %4ld offset = %4ld\n", __FILE__, __FUNCTION__, m, n, lda, offset); // Debug + + BLASLONG i, ii, jj, js; + + FLOAT *ao; + + jj = offset; + + BLASLONG stride_lda = sizeof(FLOAT)*lda*2; + + FLOAT_V_T va0, va1; + VBOOL_T vbool_cmp; + UINT_V_T vindex; + size_t vl; + + for (js = n; js > 0; js -= vl) + { + vl = VSETVL(js); + ao = a; + + ii = 0; + for (i = 0; i < m;) + { + if (ii == jj) + { + vindex = VID_V_UINT(vl); + for (unsigned int j = 0; j < vl; j++) + { + VLSSEG2_FLOAT(&va0, &va1, ao, stride_lda, vl); + vbool_cmp = VMSLTU_VX_UINT(vindex, j, vl); + VSSEG2_FLOAT_M(vbool_cmp, b, va0, va1, vl); + + compinv((b + j * 2), *(ao + j * lda * 2), *(ao + j * lda * 2 + 1)); + ao += 2; + b += vl * 2; + } + i += vl; + ii += vl; + } + else + { + if (ii > jj) + { + VLSSEG2_FLOAT(&va0, &va1, ao, stride_lda, vl); + VSSEG2_FLOAT(b, va0, va1, vl); + } + ao += 2; + b += vl * 2; + i++; + ii++; + } + } + + a += vl * lda * 2; + jj += vl; + } + + return 0; +} diff --git a/kernel/riscv64/ztrsm_ltcopy_rvv_v1.c b/kernel/riscv64/ztrsm_ltcopy_rvv_v1.c new file mode 100644 index 000000000..911b81de5 --- /dev/null +++ b/kernel/riscv64/ztrsm_ltcopy_rvv_v1.c @@ -0,0 +1,114 @@ +/*************************************************************************** +Copyright (c) 2022, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 +#include "common.h" + +#if !defined(DOUBLE) +#define VSETVL(n) vsetvl_e32m2(n) +#define FLOAT_V_T vfloat32m2_t +#define VLSEG2_FLOAT vlseg2e32_v_f32m2 +#define VSSEG2_FLOAT vsseg2e32_v_f32m2 +#define VSSEG2_FLOAT_M vsseg2e32_v_f32m2_m +#define VBOOL_T vbool16_t +#define UINT_V_T vuint32m2_t +#define VID_V_UINT vid_v_u32m2 +#define VMSGTU_VX_UINT vmsgtu_vx_u32m2_b16 +#else +#define VSETVL(n) vsetvl_e64m2(n) +#define FLOAT_V_T vfloat64m2_t +#define VLSEG2_FLOAT vlseg2e64_v_f64m2 +#define VSSEG2_FLOAT vsseg2e64_v_f64m2 +#define VSSEG2_FLOAT_M vsseg2e64_v_f64m2_m +#define VBOOL_T vbool32_t +#define UINT_V_T vuint64m2_t +#define VID_V_UINT vid_v_u64m2 +#define VMSGTU_VX_UINT vmsgtu_vx_u64m2_b32 +#endif + +int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG offset, FLOAT *b){ + + //fprintf(stderr, "%s , %s, m = %4ld n = %4ld lda = %4ld offset = %4ld\n", __FILE__, __FUNCTION__, m, n, lda, offset); // Debug + + BLASLONG i, ii, jj, js; + + FLOAT *ao; + + jj = offset; + + FLOAT_V_T va0, va1; + VBOOL_T vbool_cmp; + UINT_V_T vindex; + + size_t vl; + + for (js = n; js > 0; js -= vl) + { + vl = VSETVL(js); + ao = a; + + ii = 0; + for (i = 0; i < m;) + { + + if (ii == jj) + { + vindex = VID_V_UINT(vl); + for (unsigned int j = 0; j < vl; j++) + { + compinv((b + j * 2), *(ao + j * 2), *(ao + j * 2 + 1)); + + VLSEG2_FLOAT(&va0, &va1, ao, vl); + vbool_cmp = VMSGTU_VX_UINT(vindex, j, vl); + VSSEG2_FLOAT_M(vbool_cmp, b, va0, va1, vl); + + b += vl * 2; + ao += lda * 2; + } + i += vl; + ii += vl; + } + else + { + if (ii < jj) + { + VLSEG2_FLOAT(&va0, &va1, ao, vl); + VSSEG2_FLOAT(b, va0, va1, vl); + } + ao += lda * 2; + b += vl * 2; + i ++; + ii ++; + } + } + + a += vl * 2; + jj += vl; + } + return 0; +} + diff --git a/kernel/riscv64/ztrsm_uncopy_rvv_v1.c b/kernel/riscv64/ztrsm_uncopy_rvv_v1.c new file mode 100644 index 000000000..db075c29b --- /dev/null +++ b/kernel/riscv64/ztrsm_uncopy_rvv_v1.c @@ -0,0 +1,113 @@ +/*************************************************************************** +Copyright (c) 2022, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 +#include "common.h" + +#if !defined(DOUBLE) +#define VSETVL(n) vsetvl_e32m2(n) +#define FLOAT_V_T vfloat32m2_t +#define VLSSEG2_FLOAT vlsseg2e32_v_f32m2 +#define VSSEG2_FLOAT vsseg2e32_v_f32m2 +#define VSSEG2_FLOAT_M vsseg2e32_v_f32m2_m +#define VBOOL_T vbool16_t +#define UINT_V_T vuint32m2_t +#define VID_V_UINT vid_v_u32m2 +#define VMSGTU_VX_UINT vmsgtu_vx_u32m2_b16 +#else +#define VSETVL(n) vsetvl_e64m2(n) +#define FLOAT_V_T vfloat64m2_t +#define VLSSEG2_FLOAT vlsseg2e64_v_f64m2 +#define VSSEG2_FLOAT vsseg2e64_v_f64m2 +#define VSSEG2_FLOAT_M vsseg2e64_v_f64m2_m +#define VBOOL_T vbool32_t +#define UINT_V_T vuint64m2_t +#define VID_V_UINT vid_v_u64m2 +#define VMSGTU_VX_UINT vmsgtu_vx_u64m2_b32 +#endif + + +int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG offset, FLOAT *b){ + + //fprintf(stderr, "%s , %s, m = %4ld n = %4ld lda = %4ld offset = %4ld\n", __FILE__, __FUNCTION__, m, n, lda, offset); // Debug + + BLASLONG i, ii, jj, js; + BLASLONG stride_lda = sizeof(FLOAT)*lda*2; + + FLOAT *ao; + jj = offset; + + FLOAT_V_T va0, va1; + VBOOL_T vbool_cmp; + UINT_V_T vindex; + + size_t vl; + + for (js = n; js > 0; js -= vl) + { + vl = VSETVL(js); + ao = a; + + i = 0; + ii = 0; + for (i = 0; i < m;) + { + if (ii == jj) + { + vindex = VID_V_UINT(vl); + for (unsigned int j = 0; j < vl; j++) + { + compinv((b + j * 2), *(ao + j * lda * 2), *(ao + j * lda * 2 + 1)); + VLSSEG2_FLOAT(&va0, &va1, ao, stride_lda, vl); + vbool_cmp = VMSGTU_VX_UINT(vindex, j, vl); + VSSEG2_FLOAT_M(vbool_cmp, b, va0, va1, vl); + ao += 2; + b += vl * 2; + } + i += vl; + ii += vl; + } + else + { + if (ii < jj) + { + VLSSEG2_FLOAT(&va0, &va1, ao, stride_lda, vl); + VSSEG2_FLOAT(b, va0, va1, vl); + } + ao += 2; + b += vl * 2; + i++; + ii++; + } + } + + a += vl * lda * 2; + jj += vl; + } + return 0; +} diff --git a/kernel/riscv64/ztrsm_utcopy_rvv_v1.c b/kernel/riscv64/ztrsm_utcopy_rvv_v1.c new file mode 100644 index 000000000..e121c6273 --- /dev/null +++ b/kernel/riscv64/ztrsm_utcopy_rvv_v1.c @@ -0,0 +1,115 @@ +/*************************************************************************** +Copyright (c) 2022, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 +#include "common.h" + +#if !defined(DOUBLE) +#define VSETVL(n) vsetvl_e32m2(n) +#define FLOAT_V_T vfloat32m2_t +#define VLSEG2_FLOAT vlseg2e32_v_f32m2 +#define VSSEG2_FLOAT vsseg2e32_v_f32m2 +#define VSSEG2_FLOAT_M vsseg2e32_v_f32m2_m +#define VBOOL_T vbool16_t +#define UINT_V_T vuint32m2_t +#define VID_V_UINT vid_v_u32m2 +#define VMSLTU_VX_UINT vmsltu_vx_u32m2_b16 +#else +#define VSETVL(n) vsetvl_e64m2(n) +#define FLOAT_V_T vfloat64m2_t +#define VLSEG2_FLOAT vlseg2e64_v_f64m2 +#define VSSEG2_FLOAT vsseg2e64_v_f64m2 +#define VSSEG2_FLOAT_M vsseg2e64_v_f64m2_m +#define VBOOL_T vbool32_t +#define UINT_V_T vuint64m2_t +#define VID_V_UINT vid_v_u64m2 +#define VMSLTU_VX_UINT vmsltu_vx_u64m2_b32 +#endif + + +int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG offset, FLOAT *b){ + + //fprintf(stderr, "%s , %s, m = %4ld n = %4ld lda = %4ld offset = %4ld\n", __FILE__, __FUNCTION__, m, n, lda, offset); // Debug + + BLASLONG i, ii, jj, js; + + FLOAT *ao; + + jj = offset; + FLOAT_V_T va0, va1; + + VBOOL_T vbool_cmp; + UINT_V_T vindex; + + size_t vl; + + for (js = n; js > 0; js -= vl) + { + vl = VSETVL(js); + ao = a; + + ii = 0; + for (i = 0; i < m;) + { + + if (ii == jj) + { + vindex = VID_V_UINT(vl); + for (unsigned int j = 0; j < vl; j++) + { + VLSEG2_FLOAT(&va0, &va1, ao, vl); + vbool_cmp = VMSLTU_VX_UINT(vindex, j, vl); + VSSEG2_FLOAT_M(vbool_cmp, b, va0, va1, vl); + + compinv((b + j * 2), *(ao + j * 2), *(ao + j * 2 + 1)); + + ao += lda * 2; + b += vl * 2; + } + i += vl; + ii += vl; + } + else + { + if (ii > jj) + { + VLSEG2_FLOAT(&va0, &va1, ao, vl); + VSSEG2_FLOAT(b, va0, va1, vl); + } + ao += lda * 2; + b += vl * 2; + i ++; + ii ++; + } + } + + a += vl * 2; + jj += vl; + } + + return 0; +} diff --git a/param.h b/param.h index 62b675d6c..236f50075 100644 --- a/param.h +++ b/param.h @@ -3055,11 +3055,13 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define DGEMM_DEFAULT_UNROLL_N 8 //2 // 4 #define DGEMM_DEFAULT_UNROLL_MN 32 -#define CGEMM_DEFAULT_UNROLL_M 2 -#define CGEMM_DEFAULT_UNROLL_N 2 +#define CGEMM_DEFAULT_UNROLL_M 8 +#define CGEMM_DEFAULT_UNROLL_N 4 +#define CGEMM_DEFAULT_UNROLL_MN 16 -#define ZGEMM_DEFAULT_UNROLL_M 2 -#define ZGEMM_DEFAULT_UNROLL_N 2 +#define ZGEMM_DEFAULT_UNROLL_M 8 +#define ZGEMM_DEFAULT_UNROLL_N 4 +#define ZGEMM_DEFAULT_UNROLL_MN 16 #define SGEMM_DEFAULT_P 160 #define DGEMM_DEFAULT_P 160 From 240695862984d4de845f1c42821a883946932df7 Mon Sep 17 00:00:00 2001 From: Sergei Lewis Date: Fri, 24 Feb 2023 10:44:55 +0000 Subject: [PATCH 010/311] * update intrinsics to match latest spec at https://github.com/riscv-non-isa/rvv-intrinsic-doc (in particular, __riscv_ prefixes for rvv intrinsics) * fix multiple numerical stability and corner case issues * add a script to generate arbitrary gemm kernel shapes * add a generic zvl256b target to demonstrate large gemm kernel unrolls --- common_riscv64.h | 15 +- cpuid_riscv64.c | 10 +- kernel/generic/trmmkernel_16x8.c | 3676 ++++++++++++++++++++ kernel/generic/zlaswp_ncopy_8.c | 1051 ++++++ kernel/riscv64/KERNEL.RISCV64_ZVL256B | 199 ++ kernel/riscv64/amax_vector.c | 231 +- kernel/riscv64/amin_vector.c | 252 +- kernel/riscv64/asum_vector.c | 99 +- kernel/riscv64/axpby_vector.c | 47 +- kernel/riscv64/axpy_vector.c | 42 +- kernel/riscv64/cgemm_kernel_8x8_zvl256b.c | 1931 ++++++++++ kernel/riscv64/copy_vector.c | 39 +- kernel/riscv64/ctrmm_kernel_8x8_zvl256b.c | 2007 +++++++++++ kernel/riscv64/dgemm_kernel_8x8_zvl256b.c | 860 +++++ kernel/riscv64/dot.c | 2 +- kernel/riscv64/dot_vector.c | 86 +- kernel/riscv64/dtrmm_kernel_8x8_zvl256b.c | 1068 ++++++ kernel/riscv64/gemv_n_vector.c | 24 +- kernel/riscv64/gemv_t_vector.c | 91 +- kernel/riscv64/generate_kernel.py | 670 ++++ kernel/riscv64/iamax_vector.c | 180 +- kernel/riscv64/iamin_vector.c | 160 +- kernel/riscv64/imax_vector.c | 124 +- kernel/riscv64/imin_vector.c | 185 +- kernel/riscv64/izamax_vector.c | 277 +- kernel/riscv64/izamin_vector.c | 275 +- kernel/riscv64/max_vector.c | 77 +- kernel/riscv64/min_vector.c | 77 +- kernel/riscv64/nrm2_vector.c | 342 +- kernel/riscv64/nrm2_vector_dot.c | 8 +- kernel/riscv64/rot_vector.c | 42 +- kernel/riscv64/scal_vector.c | 83 +- kernel/riscv64/sgemm_kernel_16x8_zvl256b.c | 1081 ++++++ kernel/riscv64/strmm_kernel_16x8_zvl256b.c | 1330 +++++++ kernel/riscv64/sum_vector.c | 114 + kernel/riscv64/swap_vector.c | 54 +- kernel/riscv64/symv_L_vector.c | 82 +- kernel/riscv64/symv_U_vector.c | 86 +- kernel/riscv64/zamax_vector.c | 90 +- kernel/riscv64/zamin_vector.c | 89 +- kernel/riscv64/zasum_vector.c | 107 +- kernel/riscv64/zaxpby_vector.c | 32 +- kernel/riscv64/zaxpy_vector.c | 20 +- kernel/riscv64/zcopy_vector.c | 12 +- kernel/riscv64/zdot_vector.c | 60 +- kernel/riscv64/zgemm_kernel_8x4_zvl256b.c | 1253 +++++++ kernel/riscv64/zgemm_kernel_generic.c | 140 + kernel/riscv64/zgemv_n_vector.c | 28 +- kernel/riscv64/zgemv_t_vector.c | 88 +- kernel/riscv64/zhemv_LM_vector.c | 60 +- kernel/riscv64/zhemv_UV_vector.c | 60 +- kernel/riscv64/znrm2_vector.c | 365 +- kernel/riscv64/zrot_vector.c | 38 +- kernel/riscv64/zscal_vector.c | 32 +- kernel/riscv64/zsum_vector.c | 131 + kernel/riscv64/zswap_vector.c | 50 +- kernel/riscv64/ztrmm_kernel_8x4_zvl256b.c | 1337 +++++++ param.h | 39 + 58 files changed, 18634 insertions(+), 2374 deletions(-) create mode 100644 kernel/generic/trmmkernel_16x8.c create mode 100644 kernel/generic/zlaswp_ncopy_8.c create mode 100644 kernel/riscv64/KERNEL.RISCV64_ZVL256B create mode 100644 kernel/riscv64/cgemm_kernel_8x8_zvl256b.c create mode 100644 kernel/riscv64/ctrmm_kernel_8x8_zvl256b.c create mode 100644 kernel/riscv64/dgemm_kernel_8x8_zvl256b.c create mode 100644 kernel/riscv64/dtrmm_kernel_8x8_zvl256b.c create mode 100755 kernel/riscv64/generate_kernel.py create mode 100644 kernel/riscv64/sgemm_kernel_16x8_zvl256b.c create mode 100644 kernel/riscv64/strmm_kernel_16x8_zvl256b.c create mode 100644 kernel/riscv64/sum_vector.c create mode 100644 kernel/riscv64/zgemm_kernel_8x4_zvl256b.c create mode 100644 kernel/riscv64/zgemm_kernel_generic.c create mode 100644 kernel/riscv64/zsum_vector.c create mode 100644 kernel/riscv64/ztrmm_kernel_8x4_zvl256b.c diff --git a/common_riscv64.h b/common_riscv64.h index 2092bd5ab..de79c8cab 100644 --- a/common_riscv64.h +++ b/common_riscv64.h @@ -91,12 +91,15 @@ static inline int blas_quickdivide(blasint x, blasint y){ #define BUFFER_SIZE ( 32 << 20) #define SEEK_ADDRESS -#if defined(C910V) -#include -#endif - -#if defined(x280) -#include +#if defined(C910V) || defined(RISCV64_ZVL256B) || defined(__riscv_v) +# include +# if !defined(DOUBLE) +# define EXTRACT_FLOAT(v) __riscv_vfmv_f_s_f32m1_f32(v) +# else +# define EXTRACT_FLOAT(v) __riscv_vfmv_f_s_f64m1_f64(v) +# endif +#else +# define EXTRACT_FLOAT(v) (v[0]) #endif #endif diff --git a/cpuid_riscv64.c b/cpuid_riscv64.c index 5326787e6..1b6b62f21 100644 --- a/cpuid_riscv64.c +++ b/cpuid_riscv64.c @@ -70,14 +70,14 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. /* or implied, of The University of Texas at Austin. */ /*********************************************************************/ -#define CPU_GENERIC 0 -#define CPU_C910V 1 -#define CPU_x280 2 +#define CPU_GENERIC 0 +#define CPU_C910V 1 +#define CPU_RISCV64_ZVL256B 2 static char *cpuname[] = { "RISCV64_GENERIC", - "C910V" - "x280" + "C910V", + "CPU_RISCV64_ZVL256B" }; int detect(void){ diff --git a/kernel/generic/trmmkernel_16x8.c b/kernel/generic/trmmkernel_16x8.c new file mode 100644 index 000000000..5412eab70 --- /dev/null +++ b/kernel/generic/trmmkernel_16x8.c @@ -0,0 +1,3676 @@ +#include "common.h" + +int CNAME(BLASLONG bm,BLASLONG bn,BLASLONG bk,FLOAT alpha,FLOAT* ba,FLOAT* bb,FLOAT* C,BLASLONG ldc ,BLASLONG offset) +{ + BLASLONG i,j,k; + FLOAT *C0,*C1,*C2,*C3,*C4,*C5,*C6,*C7,*ptrba,*ptrbb; + + FLOAT res0_0; + FLOAT res0_1; + FLOAT res0_2; + FLOAT res0_3; + FLOAT res0_4; + FLOAT res0_5; + FLOAT res0_6; + FLOAT res0_7; + + FLOAT res0_8; + FLOAT res0_9; + FLOAT res0_10; + FLOAT res0_11; + FLOAT res0_12; + FLOAT res0_13; + FLOAT res0_14; + FLOAT res0_15; + + FLOAT res1_0; + FLOAT res1_1; + FLOAT res1_2; + FLOAT res1_3; + FLOAT res1_4; + FLOAT res1_5; + FLOAT res1_6; + FLOAT res1_7; + + FLOAT res1_8; + FLOAT res1_9; + FLOAT res1_10; + FLOAT res1_11; + FLOAT res1_12; + FLOAT res1_13; + FLOAT res1_14; + FLOAT res1_15; + + FLOAT res2_0; + FLOAT res2_1; + FLOAT res2_2; + FLOAT res2_3; + FLOAT res2_4; + FLOAT res2_5; + FLOAT res2_6; + FLOAT res2_7; + + FLOAT res2_8; + FLOAT res2_9; + FLOAT res2_10; + FLOAT res2_11; + FLOAT res2_12; + FLOAT res2_13; + FLOAT res2_14; + FLOAT res2_15; + + FLOAT res3_0; + FLOAT res3_1; + FLOAT res3_2; + FLOAT res3_3; + FLOAT res3_4; + FLOAT res3_5; + FLOAT res3_6; + FLOAT res3_7; + + FLOAT res3_8; + FLOAT res3_9; + FLOAT res3_10; + FLOAT res3_11; + FLOAT res3_12; + FLOAT res3_13; + FLOAT res3_14; + FLOAT res3_15; + + FLOAT res4_0; + FLOAT res4_1; + FLOAT res4_2; + FLOAT res4_3; + FLOAT res4_4; + FLOAT res4_5; + FLOAT res4_6; + FLOAT res4_7; + + FLOAT res4_8; + FLOAT res4_9; + FLOAT res4_10; + FLOAT res4_11; + FLOAT res4_12; + FLOAT res4_13; + FLOAT res4_14; + FLOAT res4_15; + + FLOAT res5_0; + FLOAT res5_1; + FLOAT res5_2; + FLOAT res5_3; + FLOAT res5_4; + FLOAT res5_5; + FLOAT res5_6; + FLOAT res5_7; + + FLOAT res5_8; + FLOAT res5_9; + FLOAT res5_10; + FLOAT res5_11; + FLOAT res5_12; + FLOAT res5_13; + FLOAT res5_14; + FLOAT res5_15; + + FLOAT res6_0; + FLOAT res6_1; + FLOAT res6_2; + FLOAT res6_3; + FLOAT res6_4; + FLOAT res6_5; + FLOAT res6_6; + FLOAT res6_7; + + FLOAT res6_8; + FLOAT res6_9; + FLOAT res6_10; + FLOAT res6_11; + FLOAT res6_12; + FLOAT res6_13; + FLOAT res6_14; + FLOAT res6_15; + + FLOAT res7_0; + FLOAT res7_1; + FLOAT res7_2; + FLOAT res7_3; + FLOAT res7_4; + FLOAT res7_5; + FLOAT res7_6; + FLOAT res7_7; + + FLOAT res7_8; + FLOAT res7_9; + FLOAT res7_10; + FLOAT res7_11; + FLOAT res7_12; + FLOAT res7_13; + FLOAT res7_14; + FLOAT res7_15; + + FLOAT a0; + FLOAT a1; + + FLOAT b0; + FLOAT b1; + FLOAT b2; + FLOAT b3; + FLOAT b4; + FLOAT b5; + FLOAT b6; + FLOAT b7; + + BLASLONG off, temp; + +#if !defined(LEFT) + off = -offset; +#else + off = 0; +#endif + + for (j=0; j +#include "common.h" + +#define a2 (a1 + 2) +#define a4 (a3 + 2) +#define a6 (a5 + 2) +#define a8 (a7 + 2) + +int CNAME(BLASLONG n, BLASLONG k1, BLASLONG k2, FLOAT *a, BLASLONG lda, blasint *ipiv, FLOAT *buffer){ + + BLASLONG i, j, ip1, ip2; + blasint *piv; + FLOAT *a1, *a3, *a5, *a7; + FLOAT *b1, *b2, *b3, *b4; + FLOAT *b5, *b6, *b7, *b8; + FLOAT A1, A2, A3, A4, A5, A6, A7, A8; + FLOAT B1, B2, B3, B4, B5, B6, B7, B8; + + FLOAT A9, A10, A11, A12, A13, A14, A15, A16; + FLOAT B9, B10, B11, B12, B13, B14, B15, B16; + + a -= 2; + lda *= 2; + k1 --; + + ipiv += k1; + + if (n <= 0) return 0; + + j = (n >> 3); + if (j > 0) { + do { + piv = ipiv; + + a1 = a + (k1 + 1) * 2; + + a3 = a1 + 1 * lda; + a5 = a1 + 2 * lda; + a7 = a1 + 3 * lda; + + ip1 = *(piv + 0) * 2; + ip2 = *(piv + 1) * 2; + piv += 2; + + b1 = a + ip1; + b2 = a + ip2; + + b3 = b1 + 1 * lda; + b4 = b2 + 1 * lda; + b5 = b1 + 2 * lda; + b6 = b2 + 2 * lda; + b7 = b1 + 3 * lda; + b8 = b2 + 3 * lda; + + i = ((k2 - k1) >> 1); + + if (i > 0) { + do { + ip1 = *(piv + 0) * 2; + ip2 = *(piv + 1) * 2; + piv += 2; + + for( int pass = 0; pass < 2; ++pass ) { + A1 = *(a1 + 0); + A9 = *(a1 + 1); + A2 = *(a2 + 0); + A10 = *(a2 + 1); + A3 = *(a3 + 0); + A11 = *(a3 + 1); + A4 = *(a4 + 0); + A12 = *(a4 + 1); + A5 = *(a5 + 0); + A13 = *(a5 + 1); + A6 = *(a6 + 0); + A14 = *(a6 + 1); + A7 = *(a7 + 0); + A15 = *(a7 + 1); + A8 = *(a8 + 0); + A16 = *(a8 + 1); + + B1 = *(b1 + 0); + B9 = *(b1 + 1); + B2 = *(b2 + 0); + B10 = *(b2 + 1); + B3 = *(b3 + 0); + B11 = *(b3 + 1); + B4 = *(b4 + 0); + B12 = *(b4 + 1); + B5 = *(b5 + 0); + B13 = *(b5 + 1); + B6 = *(b6 + 0); + B14 = *(b6 + 1); + B7 = *(b7 + 0); + B15 = *(b7 + 1); + B8 = *(b8 + 0); + B16 = *(b8 + 1); + + if (b1 == a1) { + if (b2 == a2) { + *(buffer + 0) = A1; + *(buffer + 1) = A9; + *(buffer + 2) = A3; + *(buffer + 3) = A11; + *(buffer + 4) = A5; + *(buffer + 5) = A13; + *(buffer + 6) = A7; + *(buffer + 7) = A15; + + *(buffer + 8) = A2; + *(buffer + 9) = A10; + *(buffer + 10) = A4; + *(buffer + 11) = A12; + *(buffer + 12) = A6; + *(buffer + 13) = A14; + *(buffer + 14) = A8; + *(buffer + 15) = A16; + } else { + *(buffer + 0) = A1; + *(buffer + 1) = A9; + *(buffer + 2) = A3; + *(buffer + 3) = A11; + *(buffer + 4) = A5; + *(buffer + 5) = A13; + *(buffer + 6) = A7; + *(buffer + 7) = A15; + + *(buffer + 8) = B2; + *(buffer + 9) = B10; + *(buffer + 10) = B4; + *(buffer + 11) = B12; + *(buffer + 12) = B6; + *(buffer + 13) = B14; + *(buffer + 14) = B8; + *(buffer + 15) = B16; + + *(b2 + 0) = A2; + *(b2 + 1) = A10; + *(b4 + 0) = A4; + *(b4 + 1) = A12; + *(b6 + 0) = A6; + *(b6 + 1) = A14; + *(b8 + 0) = A8; + *(b8 + 1) = A16; + } + } else + if (b1 == a2) { + if (b2 == a2) { + *(buffer + 0) = A2; + *(buffer + 1) = A10; + *(buffer + 2) = A4; + *(buffer + 3) = A12; + *(buffer + 4) = A6; + *(buffer + 5) = A14; + *(buffer + 6) = A8; + *(buffer + 7) = A16; + *(buffer + 8) = A1; + *(buffer + 9) = A9; + *(buffer + 10) = A3; + *(buffer + 11) = A11; + *(buffer + 12) = A5; + *(buffer + 13) = A13; + *(buffer + 14) = A7; + *(buffer + 15) = A15; + + } else { + *(buffer + 0) = A2; + *(buffer + 1) = A10; + *(buffer + 2) = A4; + *(buffer + 3) = A12; + *(buffer + 4) = A6; + *(buffer + 5) = A14; + *(buffer + 6) = A8; + *(buffer + 7) = A16; + *(buffer + 8) = B2; + *(buffer + 9) = B10; + *(buffer + 10) = B4; + *(buffer + 11) = B12; + *(buffer + 12) = B6; + *(buffer + 13) = B14; + *(buffer + 14) = B8; + *(buffer + 15) = B16; + + *(b2 + 0) = A1; + *(b2 + 1) = A9; + *(b4 + 0) = A3; + *(b4 + 1) = A11; + *(b6 + 0) = A5; + *(b6 + 1) = A13; + *(b8 + 0) = A7; + *(b8 + 1) = A15; + } + } else { + if (b2 == a2) { + *(buffer + 0) = B1; + *(buffer + 1) = B9; + *(buffer + 2) = B3; + *(buffer + 3) = B11; + *(buffer + 4) = B5; + *(buffer + 5) = B13; + *(buffer + 6) = B7; + *(buffer + 7) = B15; + *(buffer + 8) = A2; + *(buffer + 9) = A10; + *(buffer + 10) = A4; + *(buffer + 11) = A12; + *(buffer + 12) = A6; + *(buffer + 13) = A14; + *(buffer + 14) = A8; + *(buffer + 15) = A16; + + *(b1 + 0) = A1; + *(b1 + 1) = A9; + *(b3 + 0) = A3; + *(b3 + 1) = A11; + *(b5 + 0) = A5; + *(b5 + 1) = A13; + *(b7 + 0) = A7; + *(b7 + 1) = A15; + } else + if (b2 == b1) { + *(buffer + 0) = B1; + *(buffer + 1) = B9; + *(buffer + 2) = B3; + *(buffer + 3) = B11; + *(buffer + 4) = B5; + *(buffer + 5) = B13; + *(buffer + 6) = B7; + *(buffer + 7) = B15; + *(buffer + 8) = A1; + *(buffer + 9) = A9; + *(buffer + 10) = A3; + *(buffer + 11) = A11; + *(buffer + 12) = A5; + *(buffer + 13) = A13; + *(buffer + 14) = A7; + *(buffer + 15) = A15; + + *(b1 + 0) = A2; + *(b1 + 1) = A10; + *(b3 + 0) = A4; + *(b3 + 1) = A12; + *(b5 + 0) = A6; + *(b5 + 1) = A14; + *(b7 + 0) = A8; + *(b7 + 1) = A16; + } else { + *(buffer + 0) = B1; + *(buffer + 1) = B9; + *(buffer + 2) = B3; + *(buffer + 3) = B11; + *(buffer + 4) = B5; + *(buffer + 5) = B13; + *(buffer + 6) = B7; + *(buffer + 7) = B15; + *(buffer + 8) = B2; + *(buffer + 9) = B10; + *(buffer + 10) = B4; + *(buffer + 11) = B12; + *(buffer + 12) = B6; + *(buffer + 13) = B14; + *(buffer + 14) = B8; + *(buffer + 15) = B16; + + *(b1 + 0) = A1; + *(b1 + 1) = A9; + *(b2 + 0) = A2; + *(b2 + 1) = A10; + *(b3 + 0) = A3; + *(b3 + 1) = A11; + *(b4 + 0) = A4; + *(b4 + 1) = A12; + *(b5 + 0) = A5; + *(b5 + 1) = A13; + *(b6 + 0) = A6; + *(b6 + 1) = A14; + *(b7 + 0) = A7; + *(b7 + 1) = A15; + *(b8 + 0) = A8; + *(b8 + 1) = A16; + } + } + b1 += 4*lda; + b2 += 4*lda; + b3 += 4*lda; + b4 += 4*lda; + b5 += 4*lda; + b6 += 4*lda; + b7 += 4*lda; + b8 += 4*lda; + + a1 += 4; + a3 += 4; + a5 += 4; + a7 += 4; + + buffer += 16; + } + + b1 = a + ip1; + b2 = a + ip2; + + b3 = b1 + 1 * lda; + b4 = b2 + 1 * lda; + b5 = b1 + 2 * lda; + b6 = b2 + 2 * lda; + b7 = b1 + 3 * lda; + b8 = b2 + 3 * lda; + + i --; + } while (i > 0); + } + + i = ((k2 - k1) & 1); + + if (i > 0) { + A1 = *(a1 + 0); + A9 = *(a1 + 1); + B1 = *(b1 + 0); + B9 = *(b1 + 1); + A3 = *(a3 + 0); + A11 = *(a3 + 1); + B3 = *(b3 + 0); + B11 = *(b3 + 1); + A5 = *(a5 + 0); + A13 = *(a5 + 1); + B5 = *(b5 + 0); + B13 = *(b5 + 1); + A7 = *(a7 + 0); + A15 = *(a7 + 1); + B7 = *(b7 + 0); + B15 = *(b7 + 1); + + if (a1 == b1) { + *(buffer + 0) = A1; + *(buffer + 1) = A9; + *(buffer + 2) = A3; + *(buffer + 3) = A11; + *(buffer + 4) = A5; + *(buffer + 5) = A13; + *(buffer + 6) = A7; + *(buffer + 7) = A15; + } else { + *(buffer + 0) = B1; + *(buffer + 1) = B9; + *(buffer + 2) = B3; + *(buffer + 3) = B11; + *(buffer + 4) = B5; + *(buffer + 5) = B13; + *(buffer + 6) = B7; + *(buffer + 7) = B15; + + *(b1 + 0) = A1; + *(b1 + 1) = A9; + *(b3 + 0) = A3; + *(b3 + 1) = A11; + *(b5 + 0) = A5; + *(b5 + 1) = A13; + *(b7 + 0) = A7; + *(b7 + 1) = A15; + } + buffer += 8; + } + + a += 4 * lda; + + j --; + } while (j > 0); + } + + + if (n & 4) { + { + piv = ipiv; + + a1 = a + (k1 + 1) * 2; + + a3 = a1 + 1 * lda; + a5 = a1 + 2 * lda; + a7 = a1 + 3 * lda; + + ip1 = *(piv + 0) * 2; + ip2 = *(piv + 1) * 2; + piv += 2; + + b1 = a + ip1; + b2 = a + ip2; + + b3 = b1 + 1 * lda; + b4 = b2 + 1 * lda; + b5 = b1 + 2 * lda; + b6 = b2 + 2 * lda; + b7 = b1 + 3 * lda; + b8 = b2 + 3 * lda; + + i = ((k2 - k1) >> 1); + + if (i > 0) { + do { + A1 = *(a1 + 0); + A9 = *(a1 + 1); + A2 = *(a2 + 0); + A10 = *(a2 + 1); + A3 = *(a3 + 0); + A11 = *(a3 + 1); + A4 = *(a4 + 0); + A12 = *(a4 + 1); + A5 = *(a5 + 0); + A13 = *(a5 + 1); + A6 = *(a6 + 0); + A14 = *(a6 + 1); + A7 = *(a7 + 0); + A15 = *(a7 + 1); + A8 = *(a8 + 0); + A16 = *(a8 + 1); + + B1 = *(b1 + 0); + B9 = *(b1 + 1); + B2 = *(b2 + 0); + B10 = *(b2 + 1); + B3 = *(b3 + 0); + B11 = *(b3 + 1); + B4 = *(b4 + 0); + B12 = *(b4 + 1); + B5 = *(b5 + 0); + B13 = *(b5 + 1); + B6 = *(b6 + 0); + B14 = *(b6 + 1); + B7 = *(b7 + 0); + B15 = *(b7 + 1); + B8 = *(b8 + 0); + B16 = *(b8 + 1); + + ip1 = *(piv + 0) * 2; + ip2 = *(piv + 1) * 2; + piv += 2; + + if (b1 == a1) { + if (b2 == a2) { + *(buffer + 0) = A1; + *(buffer + 1) = A9; + *(buffer + 2) = A3; + *(buffer + 3) = A11; + *(buffer + 4) = A5; + *(buffer + 5) = A13; + *(buffer + 6) = A7; + *(buffer + 7) = A15; + + *(buffer + 8) = A2; + *(buffer + 9) = A10; + *(buffer + 10) = A4; + *(buffer + 11) = A12; + *(buffer + 12) = A6; + *(buffer + 13) = A14; + *(buffer + 14) = A8; + *(buffer + 15) = A16; + } else { + *(buffer + 0) = A1; + *(buffer + 1) = A9; + *(buffer + 2) = A3; + *(buffer + 3) = A11; + *(buffer + 4) = A5; + *(buffer + 5) = A13; + *(buffer + 6) = A7; + *(buffer + 7) = A15; + + *(buffer + 8) = B2; + *(buffer + 9) = B10; + *(buffer + 10) = B4; + *(buffer + 11) = B12; + *(buffer + 12) = B6; + *(buffer + 13) = B14; + *(buffer + 14) = B8; + *(buffer + 15) = B16; + + *(b2 + 0) = A2; + *(b2 + 1) = A10; + *(b4 + 0) = A4; + *(b4 + 1) = A12; + *(b6 + 0) = A6; + *(b6 + 1) = A14; + *(b8 + 0) = A8; + *(b8 + 1) = A16; + } + } else + if (b1 == a2) { + if (b2 == a2) { + *(buffer + 0) = A2; + *(buffer + 1) = A10; + *(buffer + 2) = A4; + *(buffer + 3) = A12; + *(buffer + 4) = A6; + *(buffer + 5) = A14; + *(buffer + 6) = A8; + *(buffer + 7) = A16; + *(buffer + 8) = A1; + *(buffer + 9) = A9; + *(buffer + 10) = A3; + *(buffer + 11) = A11; + *(buffer + 12) = A5; + *(buffer + 13) = A13; + *(buffer + 14) = A7; + *(buffer + 15) = A15; + + } else { + *(buffer + 0) = A2; + *(buffer + 1) = A10; + *(buffer + 2) = A4; + *(buffer + 3) = A12; + *(buffer + 4) = A6; + *(buffer + 5) = A14; + *(buffer + 6) = A8; + *(buffer + 7) = A16; + *(buffer + 8) = B2; + *(buffer + 9) = B10; + *(buffer + 10) = B4; + *(buffer + 11) = B12; + *(buffer + 12) = B6; + *(buffer + 13) = B14; + *(buffer + 14) = B8; + *(buffer + 15) = B16; + + *(b2 + 0) = A1; + *(b2 + 1) = A9; + *(b4 + 0) = A3; + *(b4 + 1) = A11; + *(b6 + 0) = A5; + *(b6 + 1) = A13; + *(b8 + 0) = A7; + *(b8 + 1) = A15; + } + } else { + if (b2 == a2) { + *(buffer + 0) = B1; + *(buffer + 1) = B9; + *(buffer + 2) = B3; + *(buffer + 3) = B11; + *(buffer + 4) = B5; + *(buffer + 5) = B13; + *(buffer + 6) = B7; + *(buffer + 7) = B15; + *(buffer + 8) = A2; + *(buffer + 9) = A10; + *(buffer + 10) = A4; + *(buffer + 11) = A12; + *(buffer + 12) = A6; + *(buffer + 13) = A14; + *(buffer + 14) = A8; + *(buffer + 15) = A16; + + *(b1 + 0) = A1; + *(b1 + 1) = A9; + *(b3 + 0) = A3; + *(b3 + 1) = A11; + *(b5 + 0) = A5; + *(b5 + 1) = A13; + *(b7 + 0) = A7; + *(b7 + 1) = A15; + } else + if (b2 == b1) { + *(buffer + 0) = B1; + *(buffer + 1) = B9; + *(buffer + 2) = B3; + *(buffer + 3) = B11; + *(buffer + 4) = B5; + *(buffer + 5) = B13; + *(buffer + 6) = B7; + *(buffer + 7) = B15; + *(buffer + 8) = A1; + *(buffer + 9) = A9; + *(buffer + 10) = A3; + *(buffer + 11) = A11; + *(buffer + 12) = A5; + *(buffer + 13) = A13; + *(buffer + 14) = A7; + *(buffer + 15) = A15; + + *(b1 + 0) = A2; + *(b1 + 1) = A10; + *(b3 + 0) = A4; + *(b3 + 1) = A12; + *(b5 + 0) = A6; + *(b5 + 1) = A14; + *(b7 + 0) = A8; + *(b7 + 1) = A16; + } else { + *(buffer + 0) = B1; + *(buffer + 1) = B9; + *(buffer + 2) = B3; + *(buffer + 3) = B11; + *(buffer + 4) = B5; + *(buffer + 5) = B13; + *(buffer + 6) = B7; + *(buffer + 7) = B15; + *(buffer + 8) = B2; + *(buffer + 9) = B10; + *(buffer + 10) = B4; + *(buffer + 11) = B12; + *(buffer + 12) = B6; + *(buffer + 13) = B14; + *(buffer + 14) = B8; + *(buffer + 15) = B16; + + *(b1 + 0) = A1; + *(b1 + 1) = A9; + *(b2 + 0) = A2; + *(b2 + 1) = A10; + *(b3 + 0) = A3; + *(b3 + 1) = A11; + *(b4 + 0) = A4; + *(b4 + 1) = A12; + *(b5 + 0) = A5; + *(b5 + 1) = A13; + *(b6 + 0) = A6; + *(b6 + 1) = A14; + *(b7 + 0) = A7; + *(b7 + 1) = A15; + *(b8 + 0) = A8; + *(b8 + 1) = A16; + } + } + + buffer += 16; + + b1 = a + ip1; + b2 = a + ip2; + + b3 = b1 + 1 * lda; + b4 = b2 + 1 * lda; + b5 = b1 + 2 * lda; + b6 = b2 + 2 * lda; + b7 = b1 + 3 * lda; + b8 = b2 + 3 * lda; + + a1 += 4; + a3 += 4; + a5 += 4; + a7 += 4; + + i --; + } while (i > 0); + } + + i = ((k2 - k1) & 1); + + if (i > 0) { + A1 = *(a1 + 0); + A9 = *(a1 + 1); + B1 = *(b1 + 0); + B9 = *(b1 + 1); + A3 = *(a3 + 0); + A11 = *(a3 + 1); + B3 = *(b3 + 0); + B11 = *(b3 + 1); + A5 = *(a5 + 0); + A13 = *(a5 + 1); + B5 = *(b5 + 0); + B13 = *(b5 + 1); + A7 = *(a7 + 0); + A15 = *(a7 + 1); + B7 = *(b7 + 0); + B15 = *(b7 + 1); + + if (a1 == b1) { + *(buffer + 0) = A1; + *(buffer + 1) = A9; + *(buffer + 2) = A3; + *(buffer + 3) = A11; + *(buffer + 4) = A5; + *(buffer + 5) = A13; + *(buffer + 6) = A7; + *(buffer + 7) = A15; + } else { + *(buffer + 0) = B1; + *(buffer + 1) = B9; + *(buffer + 2) = B3; + *(buffer + 3) = B11; + *(buffer + 4) = B5; + *(buffer + 5) = B13; + *(buffer + 6) = B7; + *(buffer + 7) = B15; + + *(b1 + 0) = A1; + *(b1 + 1) = A9; + *(b3 + 0) = A3; + *(b3 + 1) = A11; + *(b5 + 0) = A5; + *(b5 + 1) = A13; + *(b7 + 0) = A7; + *(b7 + 1) = A15; + } + buffer += 8; + } + + a += 4 * lda; + } + } //if (n & 4) + + if (n & 2) { + piv = ipiv; + + a1 = a + (k1 + 1) * 2; + a3 = a1 + lda; + + ip1 = *(piv + 0) * 2; + ip2 = *(piv + 1) * 2; + piv += 2; + + b1 = a + ip1; + b2 = a + ip2; + + b3 = b1 + lda; + b4 = b2 + lda; + + i = ((k2 - k1) >> 1); + + if (i > 0) { + do { + A1 = *(a1 + 0); + A2 = *(a1 + 1); + A3 = *(a2 + 0); + A4 = *(a2 + 1); + A5 = *(a3 + 0); + A6 = *(a3 + 1); + A7 = *(a4 + 0); + A8 = *(a4 + 1); + + B1 = *(b1 + 0); + B2 = *(b1 + 1); + B3 = *(b2 + 0); + B4 = *(b2 + 1); + B5 = *(b3 + 0); + B6 = *(b3 + 1); + B7 = *(b4 + 0); + B8 = *(b4 + 1); + + ip1 = *(piv + 0) * 2; + ip2 = *(piv + 1) * 2; + piv += 2; + + if (b1 == a1) { + if (b2 == a2) { + *(buffer + 0) = A1; + *(buffer + 1) = A2; + *(buffer + 2) = A5; + *(buffer + 3) = A6; + *(buffer + 4) = A3; + *(buffer + 5) = A4; + *(buffer + 6) = A7; + *(buffer + 7) = A8; + } else { + *(buffer + 0) = A1; + *(buffer + 1) = A2; + *(buffer + 2) = A5; + *(buffer + 3) = A6; + *(buffer + 4) = B3; + *(buffer + 5) = B4; + *(buffer + 6) = B7; + *(buffer + 7) = B8; + + *(b2 + 0) = A3; + *(b2 + 1) = A4; + *(b4 + 0) = A7; + *(b4 + 1) = A8; + } + } else { + if (b1 == a2) { + if (b2 == a2) { + *(buffer + 0) = A3; + *(buffer + 1) = A4; + *(buffer + 2) = A7; + *(buffer + 3) = A8; + *(buffer + 4) = A1; + *(buffer + 5) = A2; + *(buffer + 6) = A5; + *(buffer + 7) = A6; + } else { + *(buffer + 0) = A3; + *(buffer + 1) = A4; + *(buffer + 2) = A7; + *(buffer + 3) = A8; + *(buffer + 4) = B3; + *(buffer + 5) = B4; + *(buffer + 6) = B7; + *(buffer + 7) = B8; + + *(b2 + 0) = A1; + *(b2 + 1) = A2; + *(b4 + 0) = A5; + *(b4 + 1) = A6; + } + } else { + if (b2 == a2) { + *(buffer + 0) = B1; + *(buffer + 1) = B2; + *(buffer + 2) = B5; + *(buffer + 3) = B6; + *(buffer + 4) = A3; + *(buffer + 5) = A4; + *(buffer + 6) = A7; + *(buffer + 7) = A8; + + *(b1 + 0) = A1; + *(b1 + 1) = A2; + *(b3 + 0) = A5; + *(b3 + 1) = A6; + } else { + if (b2 == b1) { + *(buffer + 0) = B1; + *(buffer + 1) = B2; + *(buffer + 2) = B5; + *(buffer + 3) = B6; + *(buffer + 4) = A1; + *(buffer + 5) = A2; + *(buffer + 6) = A5; + *(buffer + 7) = A6; + + *(b1 + 0) = A3; + *(b1 + 1) = A4; + *(b3 + 0) = A7; + *(b3 + 1) = A8; + } else { + *(buffer + 0) = B1; + *(buffer + 1) = B2; + *(buffer + 2) = B5; + *(buffer + 3) = B6; + *(buffer + 4) = B3; + *(buffer + 5) = B4; + *(buffer + 6) = B7; + *(buffer + 7) = B8; + *(b1 + 0) = A1; + *(b1 + 1) = A2; + *(b2 + 0) = A3; + *(b2 + 1) = A4; + *(b3 + 0) = A5; + *(b3 + 1) = A6; + *(b4 + 0) = A7; + *(b4 + 1) = A8; + } + } + } + } + + buffer += 8; + + b1 = a + ip1; + b2 = a + ip2; + + b3 = b1 + lda; + b4 = b2 + lda; + + a1 += 4; + a3 += 4; + + i --; + } while (i > 0); + } + + i = ((k2 - k1) & 1); + + if (i > 0) { + A1 = *(a1 + 0); + A2 = *(a1 + 1); + B1 = *(b1 + 0); + B2 = *(b1 + 1); + A3 = *(a3 + 0); + A4 = *(a3 + 1); + B3 = *(b3 + 0); + B4 = *(b3 + 1); + + if (a1 == b1) { + *(buffer + 0) = A1; + *(buffer + 1) = A2; + *(buffer + 2) = A3; + *(buffer + 3) = A4; + + } else { + *(buffer + 0) = B1; + *(buffer + 1) = B2; + *(buffer + 2) = B3; + *(buffer + 3) = B4; + *(b1 + 0) = A1; + *(b1 + 1) = A2; + *(b3 + 0) = A3; + *(b3 + 1) = A4; + } + buffer += 4; + } + + a += 2 * lda; + } + + if (n & 1) { + piv = ipiv; + + a1 = a + (k1 + 1) * 2; + + ip1 = *(piv + 0) * 2; + ip2 = *(piv + 1) * 2; + piv += 2; + + b1 = a + ip1; + b2 = a + ip2; + + i = ((k2 - k1) >> 1); + + if (i > 0) { + do { + A1 = *(a1 + 0); + A2 = *(a1 + 1); + A3 = *(a2 + 0); + A4 = *(a2 + 1); + B1 = *(b1 + 0); + B2 = *(b1 + 1); + B3 = *(b2 + 0); + B4 = *(b2 + 1); + + ip1 = *(piv + 0) * 2; + ip2 = *(piv + 1) * 2; + piv += 2; + + if (b1 == a1) { + if (b2 == a2) { + *(buffer + 0) = A1; + *(buffer + 1) = A2; + *(buffer + 2) = A3; + *(buffer + 3) = A4; + } else { + *(buffer + 0) = A1; + *(buffer + 1) = A2; + *(buffer + 2) = B3; + *(buffer + 3) = B4; + + *(b2 + 0) = A3; + *(b2 + 1) = A4; + } + } else + if (b1 == a2) { + if (b2 == a2) { + *(buffer + 0) = A3; + *(buffer + 1) = A4; + *(buffer + 2) = A1; + *(buffer + 3) = A2; + } else { + *(buffer + 0) = A3; + *(buffer + 1) = A4; + *(buffer + 2) = B3; + *(buffer + 3) = B4; + *(b2 + 0) = A1; + *(b2 + 1) = A2; + } + } else { + if (b2 == a2) { + *(buffer + 0) = B1; + *(buffer + 1) = B2; + *(buffer + 2) = A3; + *(buffer + 3) = A4; + *(b1 + 0) = A1; + *(b1 + 1) = A2; + } else + if (b2 == b1) { + *(buffer + 0) = B1; + *(buffer + 1) = B2; + *(buffer + 2) = A1; + *(buffer + 3) = A2; + *(b1 + 0) = A3; + *(b1 + 1) = A4; + } else { + *(buffer + 0) = B1; + *(buffer + 1) = B2; + *(buffer + 2) = B3; + *(buffer + 3) = B4; + *(b1 + 0) = A1; + *(b1 + 1) = A2; + *(b2 + 0) = A3; + *(b2 + 1) = A4; + } + } + + buffer += 4; + + b1 = a + ip1; + b2 = a + ip2; + + a1 += 4; + + i --; + } while (i > 0); + } + + i = ((k2 - k1) & 1); + + if (i > 0) { + A1 = *(a1 + 0); + A2 = *(a1 + 1); + B1 = *(b1 + 0); + B2 = *(b1 + 1); + + if (a1 == b1) { + *(buffer + 0) = A1; + *(buffer + 1) = A2; + } else { + *(buffer + 0) = B1; + *(buffer + 1) = B2; + *(b1 + 0) = A1; + *(b1 + 1) = A2; + } + // buffer += 2; + } + } + + return 0; +} + diff --git a/kernel/riscv64/KERNEL.RISCV64_ZVL256B b/kernel/riscv64/KERNEL.RISCV64_ZVL256B new file mode 100644 index 000000000..d8690682f --- /dev/null +++ b/kernel/riscv64/KERNEL.RISCV64_ZVL256B @@ -0,0 +1,199 @@ +SAMAXKERNEL = amax_vector.c +DAMAXKERNEL = amax_vector.c +CAMAXKERNEL = zamax_vector.c +ZAMAXKERNEL = zamax_vector.c + +SAMINKERNEL = amin_vector.c +DAMINKERNEL = amin_vector.c +CAMINKERNEL = zamin_vector.c +ZAMINKERNEL = zamin_vector.c + +SMAXKERNEL = max_vector.c +DMAXKERNEL = max_vector.c + +SMINKERNEL = min_vector.c +DMINKERNEL = min_vector.c + +ISAMAXKERNEL = iamax_vector.c +IDAMAXKERNEL = iamax_vector.c +ICAMAXKERNEL = izamax_vector.c +IZAMAXKERNEL = izamax_vector.c + +ISAMINKERNEL = iamin_vector.c +IDAMINKERNEL = iamin_vector.c +ICAMINKERNEL = izamin_vector.c +IZAMINKERNEL = izamin_vector.c + +ISMAXKERNEL = imax_vector.c +IDMAXKERNEL = imax_vector.c + +ISMINKERNEL = imin_vector.c +IDMINKERNEL = imin_vector.c + +SASUMKERNEL = asum_vector.c +DASUMKERNEL = asum_vector.c +CASUMKERNEL = zasum_vector.c +ZASUMKERNEL = zasum_vector.c + +SSUMKERNEL = sum_vector.c +DSUMKERNEL = sum_vector.c +CSUMKERNEL = zsum_vector.c +ZSUMKERNEL = zsum_vector.c + +SAXPYKERNEL = axpy_vector.c +DAXPYKERNEL = axpy_vector.c +CAXPYKERNEL = zaxpy_vector.c +ZAXPYKERNEL = zaxpy_vector.c + +SCOPYKERNEL = copy_vector.c +DCOPYKERNEL = copy_vector.c +CCOPYKERNEL = zcopy_vector.c +ZCOPYKERNEL = zcopy_vector.c + +SDOTKERNEL = dot_vector.c +DDOTKERNEL = dot_vector.c +CDOTKERNEL = zdot_vector.c +ZDOTKERNEL = zdot_vector.c +DSDOTKERNEL = ../generic/dot.c + +SNRM2KERNEL = nrm2_vector.c +DNRM2KERNEL = nrm2_vector.c +CNRM2KERNEL = znrm2_vector.c +ZNRM2KERNEL = znrm2_vector.c + +SROTKERNEL = rot_vector.c +DROTKERNEL = rot_vector.c +CROTKERNEL = zrot_vector.c +ZROTKERNEL = zrot_vector.c + +SSCALKERNEL = scal_vector.c +DSCALKERNEL = scal_vector.c +CSCALKERNEL = zscal_vector.c +ZSCALKERNEL = zscal_vector.c + +SSWAPKERNEL = swap_vector.c +DSWAPKERNEL = swap_vector.c +CSWAPKERNEL = zswap_vector.c +ZSWAPKERNEL = zswap_vector.c + +SGEMVNKERNEL = gemv_n_vector.c +DGEMVNKERNEL = gemv_n_vector.c +CGEMVNKERNEL = zgemv_n_vector.c +ZGEMVNKERNEL = zgemv_n_vector.c + +SGEMVTKERNEL = gemv_t_vector.c +DGEMVTKERNEL = gemv_t_vector.c +CGEMVTKERNEL = zgemv_t_vector.c +ZGEMVTKERNEL = zgemv_t_vector.c + +STRMMKERNEL = strmm_kernel_$(SGEMM_UNROLL_M)x$(SGEMM_UNROLL_N)_zvl256b.c +DTRMMKERNEL = dtrmm_kernel_$(DGEMM_UNROLL_M)x$(DGEMM_UNROLL_N)_zvl256b.c +CTRMMKERNEL = ctrmm_kernel_$(CGEMM_UNROLL_M)x$(CGEMM_UNROLL_N)_zvl256b.c +ZTRMMKERNEL = ztrmm_kernel_$(ZGEMM_UNROLL_M)x$(ZGEMM_UNROLL_N)_zvl256b.c + +SGEMMKERNEL = sgemm_kernel_$(SGEMM_UNROLL_M)x$(SGEMM_UNROLL_N)_zvl256b.c +SGEMMONCOPY = ../generic/gemm_ncopy_$(SGEMM_UNROLL_N).c +SGEMMOTCOPY = ../generic/gemm_tcopy_$(SGEMM_UNROLL_N).c +SGEMMONCOPYOBJ = sgemm_oncopy$(TSUFFIX).$(SUFFIX) +SGEMMOTCOPYOBJ = sgemm_otcopy$(TSUFFIX).$(SUFFIX) +ifneq ($(SGEMM_UNROLL_M), $(SGEMM_UNROLL_N)) +SGEMMINCOPY = ../generic/gemm_ncopy_$(SGEMM_UNROLL_M).c +SGEMMITCOPY = ../generic/gemm_tcopy_$(SGEMM_UNROLL_M).c +SGEMMINCOPYOBJ = sgemm_incopy$(TSUFFIX).$(SUFFIX) +SGEMMITCOPYOBJ = sgemm_itcopy$(TSUFFIX).$(SUFFIX) +endif + +DGEMMKERNEL = dgemm_kernel_$(DGEMM_UNROLL_M)x$(DGEMM_UNROLL_N)_zvl256b.c +DGEMMONCOPY = ../generic/gemm_ncopy_$(DGEMM_UNROLL_N).c +DGEMMOTCOPY = ../generic/gemm_tcopy_$(DGEMM_UNROLL_N).c +DGEMMONCOPYOBJ = dgemm_oncopy$(TSUFFIX).$(SUFFIX) +DGEMMOTCOPYOBJ = dgemm_otcopy$(TSUFFIX).$(SUFFIX) +ifneq ($(DGEMM_UNROLL_M), $(DGEMM_UNROLL_N)) +DGEMMINCOPY = ../generic/gemm_ncopy_$(DGEMM_UNROLL_M).c +DGEMMITCOPY = ../generic/gemm_tcopy_$(DGEMM_UNROLL_M).c +DGEMMINCOPYOBJ = dgemm_incopy$(TSUFFIX).$(SUFFIX) +DGEMMITCOPYOBJ = dgemm_itcopy$(TSUFFIX).$(SUFFIX) +endif + +CGEMMKERNEL = cgemm_kernel_$(CGEMM_UNROLL_M)x$(CGEMM_UNROLL_N)_zvl256b.c +CGEMMONCOPY = ../generic/zgemm_ncopy_$(CGEMM_UNROLL_N).c +CGEMMOTCOPY = ../generic/zgemm_tcopy_$(CGEMM_UNROLL_N).c +CGEMMONCOPYOBJ = cgemm_oncopy$(TSUFFIX).$(SUFFIX) +CGEMMOTCOPYOBJ = cgemm_otcopy$(TSUFFIX).$(SUFFIX) + +ifneq ($(CGEMM_UNROLL_M), $(CGEMM_UNROLL_N)) +CGEMMINCOPY = ../generic/zgemm_ncopy_$(CGEMM_UNROLL_M).c +CGEMMITCOPY = ../generic/zgemm_tcopy_$(CGEMM_UNROLL_M).c +CGEMMINCOPYOBJ = cgemm_incopy$(TSUFFIX).$(SUFFIX) +CGEMMITCOPYOBJ = cgemm_itcopy$(TSUFFIX).$(SUFFIX) +endif + +ZGEMMKERNEL = zgemm_kernel_$(ZGEMM_UNROLL_M)x$(ZGEMM_UNROLL_N)_zvl256b.c +ZGEMMONCOPY = ../generic/zgemm_ncopy_$(ZGEMM_UNROLL_N).c +ZGEMMOTCOPY = ../generic/zgemm_tcopy_$(ZGEMM_UNROLL_N).c +ZGEMMONCOPYOBJ = zgemm_oncopy$(TSUFFIX).$(SUFFIX) +ZGEMMOTCOPYOBJ = zgemm_otcopy$(TSUFFIX).$(SUFFIX) + +ifneq ($(ZGEMM_UNROLL_M), $(ZGEMM_UNROLL_N)) +ZGEMMINCOPY = ../generic/zgemm_ncopy_$(ZGEMM_UNROLL_M).c +ZGEMMITCOPY = ../generic/zgemm_tcopy_$(ZGEMM_UNROLL_M).c +ZGEMMINCOPYOBJ = zgemm_incopy$(TSUFFIX).$(SUFFIX) +ZGEMMITCOPYOBJ = zgemm_itcopy$(TSUFFIX).$(SUFFIX) +endif + +STRSMKERNEL_LN = ../generic/trsm_kernel_LN.c +STRSMKERNEL_LT = ../generic/trsm_kernel_LT.c +STRSMKERNEL_RN = ../generic/trsm_kernel_RN.c +STRSMKERNEL_RT = ../generic/trsm_kernel_RT.c + +DTRSMKERNEL_LN = ../generic/trsm_kernel_LN.c +DTRSMKERNEL_LT = ../generic/trsm_kernel_LT.c +DTRSMKERNEL_RN = ../generic/trsm_kernel_RN.c +DTRSMKERNEL_RT = ../generic/trsm_kernel_RT.c + +CTRSMKERNEL_LN = ../generic/trsm_kernel_LN.c +CTRSMKERNEL_LT = ../generic/trsm_kernel_LT.c +CTRSMKERNEL_RN = ../generic/trsm_kernel_RN.c +CTRSMKERNEL_RT = ../generic/trsm_kernel_RT.c + +ZTRSMKERNEL_LN = ../generic/trsm_kernel_LN.c +ZTRSMKERNEL_LT = ../generic/trsm_kernel_LT.c +ZTRSMKERNEL_RN = ../generic/trsm_kernel_RN.c +ZTRSMKERNEL_RT = ../generic/trsm_kernel_RT.c + +SSYMV_U_KERNEL = symv_U_vector.c +SSYMV_L_KERNEL = symv_L_vector.c +DSYMV_U_KERNEL = symv_U_vector.c +DSYMV_L_KERNEL = symv_L_vector.c +CSYMV_U_KERNEL = ../generic/zsymv_k.c +CSYMV_L_KERNEL = ../generic/zsymv_k.c +ZSYMV_U_KERNEL = ../generic/zsymv_k.c +ZSYMV_L_KERNEL = ../generic/zsymv_k.c + +CHEMV_L_KERNEL = zhemv_LM_vector.c +CHEMV_M_KERNEL = zhemv_LM_vector.c +CHEMV_U_KERNEL = zhemv_UV_vector.c +CHEMV_V_KERNEL = zhemv_UV_vector.c +ZHEMV_L_KERNEL = zhemv_LM_vector.c +ZHEMV_M_KERNEL = zhemv_LM_vector.c +ZHEMV_U_KERNEL = zhemv_UV_vector.c +ZHEMV_V_KERNEL = zhemv_UV_vector.c + +LSAME_KERNEL = ../generic/lsame.c + +SCABS_KERNEL = ../generic/cabs.c +DCABS_KERNEL = ../generic/cabs.c +QCABS_KERNEL = ../generic/cabs.c + +ifndef SGEMM_BETA +SGEMM_BETA = ../generic/gemm_beta.c +endif +ifndef DGEMM_BETA +DGEMM_BETA = ../generic/gemm_beta.c +endif +ifndef CGEMM_BETA +CGEMM_BETA = ../generic/zgemm_beta.c +endif +ifndef ZGEMM_BETA +ZGEMM_BETA = ../generic/zgemm_beta.c +endif diff --git a/kernel/riscv64/amax_vector.c b/kernel/riscv64/amax_vector.c index 1b7799340..81a39af32 100644 --- a/kernel/riscv64/amax_vector.c +++ b/kernel/riscv64/amax_vector.c @@ -28,36 +28,37 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include "common.h" #include -#if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m8(n) -#define VSETVL_MAX vsetvlmax_e32m1() -#define FLOAT_V_T vfloat32m8_t -#define FLOAT_V_T_M1 vfloat32m1_t -#define VLEV_FLOAT vle32_v_f32m8 -#define VLSEV_FLOAT vlse32_v_f32m8 -#define VFREDMAXVS_FLOAT vfredmax_vs_f32m8_f32m1 -#define MASK_T vbool4_t -#define VMFLTVF_FLOAT vmflt_vf_f32m8_b4 -#define VFMVVF_FLOAT vfmv_v_f_f32m8 -#define VFMVVF_FLOAT_M1 vfmv_v_f_f32m1 -#define VFRSUBVF_MASK_FLOAT vfrsub_vf_f32m8_m -#define VFMAXVV_FLOAT vfmax_vv_f32m8 +#ifdef RISCV64_ZVL256B +# define LMUL m2 +# if defined(DOUBLE) +# define ELEN 64 +# else +# define ELEN 32 +# endif #else -#define VSETVL(n) vsetvl_e64m8(n) -#define VSETVL_MAX vsetvlmax_e64m1() -#define FLOAT_V_T vfloat64m8_t -#define FLOAT_V_T_M1 vfloat64m1_t -#define VLEV_FLOAT vle64_v_f64m8 -#define VLSEV_FLOAT vlse64_v_f64m8 -#define VFREDMAXVS_FLOAT vfredmax_vs_f64m8_f64m1 -#define MASK_T vbool8_t -#define VMFLTVF_FLOAT vmflt_vf_f64m8_b8 -#define VFMVVF_FLOAT vfmv_v_f_f64m8 -#define VFMVVF_FLOAT_M1 vfmv_v_f_f64m1 -#define VFRSUBVF_MASK_FLOAT vfrsub_vf_f64m8_m -#define VFMAXVV_FLOAT vfmax_vv_f64m8 +# define LMUL m8 +# if defined(DOUBLE) +# define ELEN 64 +# else +# define ELEN 32 +# endif #endif +#define _ +#define JOIN2_X(x, y) x ## y +#define JOIN2(x, y) JOIN2_X(x, y) +#define JOIN(v, w, x, y, z) JOIN2( JOIN2( JOIN2( JOIN2( v, w ), x), y), z) + +#define VSETVL JOIN(__riscv_vsetvl, _e, ELEN, LMUL, _) +#define FLOAT_V_T JOIN(vfloat, ELEN, LMUL, _t, _) +#define FLOAT_V_T_M1 JOIN(vfloat, ELEN, m1, _t, _) +#define VLEV_FLOAT JOIN(__riscv_vle, ELEN, _v_f, ELEN, LMUL) +#define VLSEV_FLOAT JOIN(__riscv_vlse, ELEN, _v_f, ELEN, LMUL) +#define VFREDMAXVS_FLOAT JOIN(__riscv_vfredmax_vs_f, ELEN, LMUL, _f, JOIN2( ELEN, m1)) +#define VFABS_FLOAT JOIN(__riscv_vfabs, _v_f, ELEN, LMUL, _) +#define VFMVVF_FLOAT JOIN(__riscv_vfmv, _v_f_f, ELEN, LMUL, _) +#define VFMVVF_FLOAT_M1 JOIN(__riscv_vfmv, _v_f_f, ELEN, m1, _) + FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) { BLASLONG i=0, j=0; @@ -65,103 +66,28 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) FLOAT maxf=0.0; if (n <= 0 || inc_x <= 0) return(maxf); unsigned int gvl = 0; - FLOAT_V_T v0, v1, v_max; - FLOAT_V_T_M1 v_res, v_zero; - gvl = VSETVL_MAX; - v_res = VFMVVF_FLOAT_M1(0, gvl); - v_zero = VFMVVF_FLOAT_M1(0, gvl); + FLOAT_V_T v0, v1; + FLOAT_V_T_M1 v_res; + v_res = VFMVVF_FLOAT_M1(0, 1); - MASK_T mask0, mask1; - FLOAT zero = 0.0; if(inc_x == 1){ gvl = VSETVL(n); if(gvl <= n/2){ - v_max = VFMVVF_FLOAT(0, gvl); for(i=0,j=0; i maxf) - maxf = *((FLOAT*)&v_res); + v0 = VFABS_FLOAT(v0, gvl); + v_res = VFREDMAXVS_FLOAT(v0, v_res, gvl); j += gvl; } }else{ @@ -169,94 +95,27 @@ asm volatile( BLASLONG stride_x = inc_x * sizeof(FLOAT); if(gvl <= n/2){ BLASLONG inc_xv = inc_x * gvl; - v_max = VFMVVF_FLOAT(0, gvl); for(i=0,j=0; i maxf) - maxf = *((FLOAT*)&v_res); + v0 = VFABS_FLOAT(v0, gvl); + v_res = VFREDMAXVS_FLOAT(v0, v_res, gvl); j += gvl; } } + + maxf = EXTRACT_FLOAT(v_res); return(maxf); } diff --git a/kernel/riscv64/amin_vector.c b/kernel/riscv64/amin_vector.c index f9b7defae..c8ba75f4a 100644 --- a/kernel/riscv64/amin_vector.c +++ b/kernel/riscv64/amin_vector.c @@ -26,232 +26,100 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. *****************************************************************************/ #include "common.h" -#include -#include -#if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m8(n) -#define VSETVL_MAX vsetvlmax_e32m1() -#define FLOAT_V_T vfloat32m8_t -#define FLOAT_V_T_M1 vfloat32m1_t -#define VLEV_FLOAT vle32_v_f32m8 -#define VLSEV_FLOAT vlse32_v_f32m8 -#define VFREDMINVS_FLOAT vfredmin_vs_f32m8_f32m1 -#define MASK_T vbool4_t -#define VMFLTVF_FLOAT vmflt_vf_f32m8_b4 -#define VFMVVF_FLOAT vfmv_v_f_f32m8 -#define VFMVVF_FLOAT_M1 vfmv_v_f_f32m1 -#define VFRSUBVF_MASK_FLOAT vfrsub_vf_f32m8_m -#define VFMINVV_FLOAT vfmin_vv_f32m8 +#ifdef RISCV64_ZVL256B +# define LMUL m2 +# if defined(DOUBLE) +# define ELEN 64 +# else +# define ELEN 32 +# endif #else -#define VSETVL(n) vsetvl_e64m8(n) -#define VSETVL_MAX vsetvlmax_e32m1() -#define FLOAT_V_T vfloat64m8_t -#define FLOAT_V_T_M1 vfloat64m1_t -#define VLEV_FLOAT vle64_v_f64m8 -#define VLSEV_FLOAT vlse64_v_f64m8 -#define VFREDMINVS_FLOAT vfredmin_vs_f64m8_f64m1 -#define MASK_T vbool8_t -#define VMFLTVF_FLOAT vmflt_vf_f64m8_b8 -#define VFMVVF_FLOAT vfmv_v_f_f64m8 -#define VFMVVF_FLOAT_M1 vfmv_v_f_f64m1 -#define VFRSUBVF_MASK_FLOAT vfrsub_vf_f64m8_m -#define VFMINVV_FLOAT vfmin_vv_f64m8 +# define LMUL m8 +# if defined(DOUBLE) +# define ELEN 64 +# else +# define ELEN 32 +# endif #endif +#define _ +#define JOIN2_X(x, y) x ## y +#define JOIN2(x, y) JOIN2_X(x, y) +#define JOIN(v, w, x, y, z) JOIN2( JOIN2( JOIN2( JOIN2( v, w ), x), y), z) + +#define VSETVL JOIN(__riscv_vsetvl, _e, ELEN, LMUL, _) +#define FLOAT_V_T JOIN(vfloat, ELEN, LMUL, _t, _) +#define FLOAT_V_T_M1 JOIN(vfloat, ELEN, m1, _t, _) +#define VLEV_FLOAT JOIN(__riscv_vle, ELEN, _v_f, ELEN, LMUL) +#define VLSEV_FLOAT JOIN(__riscv_vlse, ELEN, _v_f, ELEN, LMUL) +#define VFREDMINVS_FLOAT JOIN(__riscv_vfredmin_vs_f, ELEN, LMUL, _f, JOIN2( ELEN, m1)) +#define VFABS_FLOAT JOIN(__riscv_vfabs, _v_f, ELEN, LMUL, _) +#define VFMVVF_FLOAT JOIN(__riscv_vfmv, _v_f_f ELEN, LMUL, _) +#define VFMVVF_FLOAT_M1 JOIN(__riscv_vfmv, _v_f_f, ELEN, m1, _) + FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) { - BLASLONG i=0, j=0; - if (n <= 0 || inc_x <= 0) return(0.0); - FLOAT minf=FLT_MAX; + BLASLONG i=0, j=0; + BLASLONG ix=0; + FLOAT minf=0.0; + if (n <= 0 || inc_x <= 0) return(minf); + + minf = *x; + x += inc_x; + --n; + if (n == 0) return(minf); + unsigned int gvl = 0; - FLOAT_V_T v0, v1, v_min; - FLOAT_V_T_M1 v_res, v_max; - gvl = VSETVL_MAX; - v_res = VFMVVF_FLOAT_M1(0, gvl); - v_max = VFMVVF_FLOAT_M1(FLT_MAX, gvl); + FLOAT_V_T v0, v1; + FLOAT_V_T_M1 v_res; + v_res = VFMVVF_FLOAT_M1(minf, 1); - MASK_T mask0, mask1; - FLOAT zero = 0.0; if(inc_x == 1){ gvl = VSETVL(n); if(gvl <= n/2){ - v_min = VFMVVF_FLOAT(FLT_MAX, gvl); for(i=0,j=0; i -#if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m8(n) -#define VSETVL_MAX vsetvlmax_e32m1() -#define FLOAT_V_T vfloat32m8_t -#define FLOAT_V_T_M1 vfloat32m1_t -#define VLEV_FLOAT vle32_v_f32m8 -#define VLSEV_FLOAT vlse32_v_f32m8 -#define VFREDSUMVS_FLOAT vfredosum_vs_f32m8_f32m1 -#define MASK_T vbool4_t -#define VMFLTVF_FLOAT vmflt_vf_f32m8_b4 -#define VFMVVF_FLOAT vfmv_v_f_f32m8 -#define VFMVVF_FLOAT_M1 vfmv_v_f_f32m1 -#define VFRSUBVF_MASK_FLOAT vfrsub_vf_f32m8_m -#define VFADDVV_FLOAT vfadd_vv_f32m8 +#ifdef RISCV64_ZVL256B +# define LMUL m2 +# if defined(DOUBLE) +# define ELEN 64 +# else +# define ELEN 32 +# endif #else -#define VSETVL(n) vsetvl_e64m8(n) -#define VSETVL_MAX vsetvlmax_e64m1() -#define FLOAT_V_T vfloat64m8_t -#define FLOAT_V_T_M1 vfloat64m1_t -#define VLEV_FLOAT vle64_v_f64m8 -#define VLSEV_FLOAT vlse64_v_f64m8 -#define VFREDSUMVS_FLOAT vfredusum_vs_f64m8_f64m1 -#define MASK_T vbool8_t -#define VMFLTVF_FLOAT vmflt_vf_f64m8_b8 -#define VFMVVF_FLOAT vfmv_v_f_f64m8 -#define VFMVVF_FLOAT_M1 vfmv_v_f_f64m1 -#define VFRSUBVF_MASK_FLOAT vfrsub_vf_f64m8_m -#define VFADDVV_FLOAT vfadd_vv_f64m8 +# define LMUL m8 +# if defined(DOUBLE) +# define ELEN 64 +# else +# define ELEN 32 +# endif #endif + +#define _ +#define JOIN2_X(x, y) x ## y +#define JOIN2(x, y) JOIN2_X(x, y) +#define JOIN(v, w, x, y, z) JOIN2( JOIN2( JOIN2( JOIN2( v, w ), x), y), z) + +#define VSETVL JOIN(__riscv_vsetvl, _e, ELEN, LMUL, _) +#define FLOAT_V_T JOIN(vfloat, ELEN, LMUL, _t, _) +#define FLOAT_V_T_M1 JOIN(vfloat, ELEN, m1, _t, _) +#define VLEV_FLOAT JOIN(__riscv_vle, ELEN, _v_f, ELEN, LMUL) +#define VLSEV_FLOAT JOIN(__riscv_vlse, ELEN, _v_f, ELEN, LMUL) +#define VFREDSUMVS_FLOAT JOIN(__riscv_vfredusum_vs_f, ELEN, LMUL, _f, JOIN2( ELEN, m1)) +#define VFABS_FLOAT JOIN(__riscv_vfabs, _v_f, ELEN, LMUL, _) +#define VFMVVF_FLOAT JOIN(__riscv_vfmv, _v_f_f, ELEN, LMUL, _) +#define VFMVVF_FLOAT_M1 JOIN(__riscv_vfmv, _v_f_f, ELEN, m1, _) +#define VFADDVV_FLOAT JOIN(__riscv_vfadd, _vv_f, ELEN, LMUL, _) + FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) { BLASLONG i=0, j=0; @@ -64,75 +67,61 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) FLOAT asumf=0.0; if (n <= 0 || inc_x <= 0) return(asumf); unsigned int gvl = 0; - FLOAT_V_T v0, v1, v_zero,v_sum; - FLOAT_V_T_M1 v_res, v_z0; - gvl = VSETVL_MAX; - v_res = VFMVVF_FLOAT_M1(0, gvl); - v_z0 = VFMVVF_FLOAT_M1(0, gvl); + FLOAT_V_T v0, v1, v_sum; + FLOAT_V_T_M1 v_res; + v_res = VFMVVF_FLOAT_M1(0, 1); - MASK_T mask0, mask1; if(inc_x == 1){ gvl = VSETVL(n); - v_zero = VFMVVF_FLOAT(0, gvl); if(gvl <= n/2){ v_sum = VFMVVF_FLOAT(0, gvl); for(i=0,j=0; i 0){ - v_res = VFREDSUM_FLOAT(v_res, vr, v_z0, gvl); - dot += (double)VFMVFS_FLOAT(v_res); + v_res = VFREDSUM_FLOAT(vr, v_z0, gvl); + dot += (double)EXTRACT_FLOAT(v_res); } //tail if(j < n){ @@ -93,13 +91,13 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y) FLOAT_V_T vz = VFMVVF_FLOAT(0, gvl); //vr = VFDOTVV_FLOAT(vx, vy, gvl); vr = VFMACCVV_FLOAT(vz, vx, vy, gvl); - v_res = VFREDSUM_FLOAT(v_res, vr, v_z0, gvl); - dot += (double)VFMVFS_FLOAT(v_res); + v_res = VFREDSUM_FLOAT(vr, v_z0, gvl); + dot += (double)EXTRACT_FLOAT(v_res); } }else if(inc_y == 1){ gvl = VSETVL(n); vr = VFMVVF_FLOAT(0, gvl); - int stride_x = inc_x * sizeof(FLOAT); + BLASLONG stride_x = inc_x * sizeof(FLOAT); for(i=0,j=0; i 0){ - v_res = VFREDSUM_FLOAT(v_res, vr, v_z0, gvl); - dot += (double)VFMVFS_FLOAT(v_res); - + v_res = VFREDSUM_FLOAT(vr, v_z0, gvl); + dot += (double)EXTRACT_FLOAT(v_res); } //tail if(j < n){ @@ -119,14 +116,13 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y) FLOAT_V_T vz = VFMVVF_FLOAT(0, gvl); //vr = VFDOTVV_FLOAT(vx, vy, gvl); vr = VFMACCVV_FLOAT(vz, vx, vy, gvl); - v_res = VFREDSUM_FLOAT(v_res, vr, v_z0, gvl); - dot += (double)VFMVFS_FLOAT(v_res); - + v_res = VFREDSUM_FLOAT(vr, v_z0, gvl); + dot += (double)EXTRACT_FLOAT(v_res); } }else if(inc_x == 1){ gvl = VSETVL(n); vr = VFMVVF_FLOAT(0, gvl); - int stride_y = inc_y * sizeof(FLOAT); + BLASLONG stride_y = inc_y * sizeof(FLOAT); for(i=0,j=0; i 0){ - v_res = VFREDSUM_FLOAT(v_res, vr, v_z0, gvl); - dot += (double)VFMVFS_FLOAT(v_res); - + v_res = VFREDSUM_FLOAT(vr, v_z0, gvl); + dot += (double)EXTRACT_FLOAT(v_res); } //tail if(j < n){ @@ -146,15 +141,14 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y) FLOAT_V_T vz = VFMVVF_FLOAT(0, gvl); //vr = VFDOTVV_FLOAT(vx, vy, gvl); vr = VFMACCVV_FLOAT(vz, vx, vy, gvl); - v_res = VFREDSUM_FLOAT(v_res, vr, v_z0, gvl); - dot += (double)VFMVFS_FLOAT(v_res); - + v_res = VFREDSUM_FLOAT(vr, v_z0, gvl); + dot += (double)EXTRACT_FLOAT(v_res); } }else{ gvl = VSETVL(n); vr = VFMVVF_FLOAT(0, gvl); - int stride_x = inc_x * sizeof(FLOAT); - int stride_y = inc_y * sizeof(FLOAT); + BLASLONG stride_x = inc_x * sizeof(FLOAT); + BLASLONG stride_y = inc_y * sizeof(FLOAT); for(i=0,j=0; i 0){ - v_res = VFREDSUM_FLOAT(v_res, vr, v_z0, gvl); - dot += (double)VFMVFS_FLOAT(v_res); - + v_res = VFREDSUM_FLOAT(vr, v_z0, gvl); + dot += (double)EXTRACT_FLOAT(v_res); } //tail if(j < n){ @@ -174,9 +167,8 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y) FLOAT_V_T vz = VFMVVF_FLOAT(0, gvl); //vr = VFDOTVV_FLOAT(vx, vy, gvl); vr = VFMACCVV_FLOAT(vz, vx, vy, gvl); - v_res = VFREDSUM_FLOAT(v_res, vr, v_z0, gvl); - dot += (double)VFMVFS_FLOAT(v_res); - + v_res = VFREDSUM_FLOAT(vr, v_z0, gvl); + dot += (double)EXTRACT_FLOAT(v_res); } } return(dot); diff --git a/kernel/riscv64/dtrmm_kernel_8x8_zvl256b.c b/kernel/riscv64/dtrmm_kernel_8x8_zvl256b.c new file mode 100644 index 000000000..b1739f248 --- /dev/null +++ b/kernel/riscv64/dtrmm_kernel_8x8_zvl256b.c @@ -0,0 +1,1068 @@ +/* + +AUTOGENERATED KERNEL +Settings: + LMUL=1 + M=8 + M_tail_scalar_from=2 + N=8 + __riscv_='__riscv_' + complex=False + conjugate=False + cpu='zvl256b' + force_acc_double=False + index_type='BLASLONG' + op='trmm' + param_precision='double' + reg_width_bits=256 + tail_policy='' + trace=False + +Derived: + ELEN_ACC=64 + ELEN_PARAM=64 + LMUL_ACC=1 + VFMACC='__riscv_vfmacc_vf_f64m1' + VFMUL='__riscv_vfmul_vf_f64m1' + VLEV='__riscv_vle64_v_f64m1' + VLSEV='__riscv_vlse64_v_f64m1' + VMACC_TO_ACC='__riscv_vfmacc_vf_f64m1' + VMUL_TO_ACC='__riscv_vfmul_vf_f64m1' + VSETVL='__riscv_vsetvl_e64m1' + VSEV='__riscv_vse64_v_f64m1' + VSSEV='__riscv_vsse64_v_f64m1' + acc_vector_t='vfloat64m1_t' + output='dtrmm_kernel_8x8_zvl256b.c' + param_scalar_t='double' + param_vector_t='vfloat64m1_t' + +*/ + +#include "common.h" + + + +#if defined(LEFT) != defined(TRANSA) + #define BACKWARDS +#endif + +int CNAME(BLASLONG M, BLASLONG N, BLASLONG K, FLOAT alpha, FLOAT* A, FLOAT* B, FLOAT* C, BLASLONG ldc, BLASLONG offset) + +{ + BLASLONG gvl = 0; + BLASLONG m_top = 0; + BLASLONG n_top = 0; + + + // -- MAIN PASS + + for (BLASLONG j=0; j 1 and (tmp_regs/(tmp_unroll_i*2)) < tmp_unroll_j: + tmp_unroll_j = int(tmp_unroll_j / 2) + + if tmp_unroll_i < a_regs or tmp_unroll_j < N: + dest.write("// performing {ops} operations between reuses of temporaries", ops=tmp_unroll_j*tmp_unroll_i) + + for tj in range(0, N, tmp_unroll_j): + for ti in range(0, a_regs, tmp_unroll_i): + for j in range(tj, tj+tmp_unroll_j): + for i in range(ti, ti+tmp_unroll_i): + with dest.map(dest=j*a_regs+i, tmp=(i-ti)+tmp_unroll_i*(j-tj), i=i, j=j): + if ti == 0 and tj==0: + dest.write("{acc_vector_t} tmp{tmp}r = {VMUL_TO_ACC}( A{i}i, B{j}i, gvl);") + dest.write("{acc_vector_t} tmp{tmp}i = {VMUL_TO_ACC}( A{i}r, B{j}i, gvl);") + else: + dest.write("tmp{tmp}r = {VMUL_TO_ACC}( A{i}i, B{j}i, gvl);") + dest.write("tmp{tmp}i = {VMUL_TO_ACC}( A{i}r, B{j}i, gvl);") + for j in range(tj, tj+tmp_unroll_j): + for i in range(ti, ti+tmp_unroll_i): + with dest.map(dest=j*a_regs+i, tmp=(i-ti)+tmp_unroll_i*(j-tj), i=i, j=j): + dest.write("tmp{tmp}r = VFMACC_RR( tmp{tmp}r, B{j}r, A{i}r, gvl);") + dest.write("tmp{tmp}i = VFMACC_RI( tmp{tmp}i, B{j}r, A{i}i, gvl);") + + for j in range(tj, tj+tmp_unroll_j): + for i in range(ti, ti+tmp_unroll_i): + with dest.map(dest=j*a_regs+i, tmp=(i-ti)+tmp_unroll_i*(j-tj), i=i, j=j): + dest.write("{acc_vector_t} ACC{dest}r = tmp{tmp}r;") + dest.write("{acc_vector_t} ACC{dest}i = tmp{tmp}i;") + + with dest.block("for({index_type} k=1; k<{Kend}; k++) {{", "}}", Kend=('pass_K' if TRMM else 'K')): + for i in range(N): + dest.write("B{i}r = B[bi+{i}*2+0];", i=i) + dest.write("B{i}i = B[bi+{i}*2+1];", i=i) + dest.write("bi += {N}*2;") + dest.write() + + for i in range(a_regs): + dest.write("A{i}r = {VLSEV}( &A[ai+{i}*gvl*2], sizeof(FLOAT)*2, gvl );", i=i) + dest.write("A{i}i = {VLSEV}( &A[ai+{i}*gvl*2+1], sizeof(FLOAT)*2, gvl );", i=i) + + dest.write("ai += {M}*2;") + dest.write() + + + for tj in range(0, N, tmp_unroll_j): + for ti in range(0, a_regs, tmp_unroll_i): + # note the values in tmp{tmp}* are frequently of similar magnitude and opposite sign + # so accumulating them directly to ACC would lose precision when ACC is larger + + for j in range(tj, tj+tmp_unroll_j): + for i in range(ti, ti+tmp_unroll_i): + with dest.map(dest=j*a_regs+i, tmp=(i-ti)+tmp_unroll_i*(j-tj), i=i, j=j): + dest.write("tmp{tmp}r = {VMUL_TO_ACC}( A{i}i, B{j}i, gvl);") + dest.write("tmp{tmp}i = {VMUL_TO_ACC}( A{i}r, B{j}i, gvl);") + for j in range(tj, tj+tmp_unroll_j): + for i in range(ti, ti+tmp_unroll_i): + with dest.map(dest=j*a_regs+i, tmp=(i-ti)+tmp_unroll_i*(j-tj), i=i, j=j): + dest.write("tmp{tmp}r = VFMACC_RR( tmp{tmp}r, B{j}r, A{i}r, gvl);") + dest.write("tmp{tmp}i = VFMACC_RI( tmp{tmp}i, B{j}r, A{i}i, gvl);") + for j in range(tj, tj+tmp_unroll_j): + for i in range(ti, ti+tmp_unroll_i): + with dest.map(dest=j*a_regs+i, tmp=(i-ti)+tmp_unroll_i*(j-tj), i=i, j=j): + dest.write("ACC{dest}r = {__riscv_}vfadd( ACC{dest}r, tmp{tmp}r, gvl);") + dest.write("ACC{dest}i = {__riscv_}vfadd( ACC{dest}i, tmp{tmp}i, gvl);") + + dest.write() + dest.write("{index_type} ci=n_top*ldc+m_top;") + dest.write() + + for j in range(N): + if TRMM: + for i in range(a_regs): + with dest.map(idx=j*a_regs+i): + dest.write("{param_vector_t} C{idx}r = {__riscv_}vfmul( ACC{idx}r, alphar, gvl );") + dest.write("{param_vector_t} C{idx}i = {__riscv_}vfmul( ACC{idx}i, alphar, gvl );") + else: + for i in range(a_regs): + idx = j*a_regs+i + increment = 'ci += ldc-gvl*{};'.format(a_regs-1) if (i == a_regs-1) else ' ci += gvl;' + if idx == N*a_regs-1: + increment = '' + with dest.map(idx=j*a_regs+i, increment=increment): + dest.write("{param_vector_t} C{idx}r = {VLSEV}( &C[ci*2+0], sizeof(FLOAT)*2, gvl );") + dest.write("{param_vector_t} C{idx}i = {VLSEV}( &C[ci*2+1], sizeof(FLOAT)*2, gvl );") + dest.write("{increment}") + + if not TRMM: + for j in range(N): + for i in range(a_regs): + with dest.map(idx=j*a_regs+i): + dest.write("C{idx}r = {__riscv_}vfmacc( C{idx}r, alphar, ACC{idx}r, gvl );") + dest.write("C{idx}i = {__riscv_}vfmacc( C{idx}i, alphar, ACC{idx}i, gvl );") + + for j in range(N): + for i in range(a_regs): + with dest.map(idx=j*a_regs+i): + dest.write("C{idx}r = {__riscv_}vfnmsac( C{idx}r, alphai, ACC{idx}i, gvl );") + dest.write("C{idx}i = {__riscv_}vfmacc ( C{idx}i, alphai, ACC{idx}r, gvl );") + + if not TRMM: + dest.write() + dest.write("ci=n_top*ldc+m_top;") + dest.write() + + for j in range(N): + for i in range(a_regs): + idx = j*a_regs+i + increment = 'ci += ldc-gvl*{};'.format(a_regs-1) if (i == a_regs-1) else ' ci += gvl;' + if idx == N*a_regs-1: + increment = '' + with dest.map(idx=j*a_regs+i, increment=increment): + dest.write("{VSSEV}( &C[ci*2+0], sizeof(FLOAT)*2, C{idx}r, gvl);") + dest.write("{VSSEV}( &C[ci*2+1], sizeof(FLOAT)*2, C{idx}i, gvl);") + dest.write("{increment}") + +#----------------------------------------------------------------------- +def generate_gemm_kernel( settings, OUTPUT ): + if settings['conjugate'].value: + ERROR('conjugate gemm not yet supported') + + is_complex = settings['complex'].value + generate_gemm_kernel_inner = generate_gemm_kernel_inner_complex if is_complex else generate_gemm_kernel_inner_real + dest = Target(OUTPUT, { k:str(settings[k].value) for k in settings }) + + M = settings['M'].value + N = settings['N'].value + vlenmax = int( settings['reg_width_bits'].value / settings['ELEN_PARAM'].value ) + a_regs = max(int(M/vlenmax), 1) + + accumulation_regs = a_regs * N * settings['LMUL_ACC'].value + required_regs = accumulation_regs + a_regs + if is_complex: + required_regs = required_regs * 2 + 2 + dest.write(''' +#if defined(NN) || defined(NT) || defined(TN) || defined(TT) + #define S0 1 + #define S1 -1 + #define S2 1 + #define S3 1 + #define VFMACC_RR __riscv_vfmsac{tail_policy} + #define VFMACC_RI __riscv_vfmacc{tail_policy} +#endif +#if defined(NR) || defined(NC) || defined(TR) || defined(TC) + #define S0 1 + #define S1 1 + #define S2 1 + #define S3 -1 + #define VFMACC_RR __riscv_vfmacc{tail_policy} + #define VFMACC_RI __riscv_vfmsac{tail_policy} +#endif +#if defined(RN) || defined(RT) || defined(CN) || defined(CT) + #define S0 1 + #define S1 1 + #define S2 -1 + #define S3 1 + #define VFMACC_RR __riscv_vfmacc{tail_policy} + #define VFMACC_RI __riscv_vfnmsac{tail_policy} +#endif +#if defined(RR) || defined(RC) || defined(CR) || defined(CC) + #define S0 1 + #define S1 -1 + #define S2 -1 + #define S3 -1 + #define VFMACC_RR __riscv_vfmsac{tail_policy} + #define VFMACC_RI __riscv_vfnmacc{tail_policy} +#endif +'''.format(tail_policy=settings['tail_policy'].value)) + + + if required_regs > 32: + raise Exception("{} vector registers needed during accumulation for unrolling {} x {}{} but only 32 are available".format( + required_regs, N, M, (" with wide accumulator" if settings['LMUL_ACC'].value > 1 else '') + )) + + TRMM = (settings['op'].value == 'trmm') + if TRMM: + with dest.block("#if defined(LEFT) != defined(TRANSA)", "#endif"): + dest.write("#define BACKWARDS") + + dest.write("int CNAME(BLASLONG M, BLASLONG N, BLASLONG K, {alpha}, FLOAT* A, FLOAT* B, FLOAT* C, BLASLONG ldc{trmm})", + alpha = ('FLOAT alphar, FLOAT alphai' if is_complex else 'FLOAT alpha'), + trmm = (', BLASLONG offset' if TRMM else '') + ) + + with dest.block("{{", "}}", elt_size='*2' if is_complex else ''): + if settings['trace'].value: + dest.write("printf(\"\\n\\nENTRY: %s(%d) M %d N %d K %d ldc %d\\n\", __FILE__, __LINE__, M, N, K, ldc);") + dest.write("{index_type} gvl = 0;") + dest.write("{index_type} m_top = 0;") + dest.write("{index_type} n_top = 0;") + + dest.write() + dest.write() + dest.write("// -- MAIN PASS") + + with dest.block("for ({index_type} j=0; j 0 ): + with dest.map(N=N_tail): + dest.write() + dest.write() + dest.write("// -- tails for N={N}") + with dest.block("if( N & {N} ) {{", "}}" ): + if settings['trace'].value: + dest.write("printf(\"N tail entry: %s(%d) M %d N %d K %d m_top %d n_top %d\\n\", __FILE__, __LINE__, M, N, K, m_top, n_top);") + dest.write("gvl = {VSETVL}({vlenmax});", vlenmax=min(vlenmax,max(int(M/a_regs),1))) + dest.write("m_top = 0;") + with dest.block("for ({index_type} i=0; i M_tail_min ): + with dest.block("if( M & {M_tail} ) {{", "}}", M_tail=M_tail ): + if settings['trace'].value: + dest.write("printf(\"tail: %s(%d) M %d N %d K %d m_top %d n_top %d\\n\", __FILE__, __LINE__, M, N, K, m_top, n_top);") + a_regs = max( 1, int(M_tail/vlenmax) ) + vlen = int(M_tail/a_regs) + dest.write("gvl = {VSETVL}({vlen});\n", vlen=vlen) + + generate_gemm_kernel_inner( settings, dest, M_tail, N, vlen, a_regs ) + dest.write( "m_top += {M_tail};" ) + + M_tail = int( M_tail / 2 ) + + while( M_tail > 0 ): + with dest.block("if( M & {M_tail} ) {{", "}}", + M_tail=M_tail, + N=N, + result_t = ('double' if settings['force_acc_double'].value else settings['param_scalar_t'].value) + ): + if settings['trace'].value: + dest.write("printf(\"tail: %s(%d) M %d N %d K %d m_top %d n_top %d\\n\", __FILE__, __LINE__, M, N, K, m_top, n_top);") + for r in range(M_tail * N * (2 if is_complex else 1)): + dest.write("{result_t} result{r} = 0;", + r=r + ) + + dest.write("{index_type} ai=m_top*K{elt_size};") + dest.write("{index_type} bi=n_top*K{elt_size};") + + if TRMM: + with dest.map(M=M_tail, N=N): + generate_trmm_block( dest ) + + with dest.block("for({index_type} k=0; k<{Kend}; k++) {{", "}}", Kend = ('pass_K' if TRMM else 'K') ): + for ki in range( N ): + for kj in range( M_tail ): + if is_complex: + dest.write("result{dest}+=S0*A[ai+{kj}+0]*B[bi+{ki}+0] + S1*A[ai+{kj}+1]*B[bi+{ki}+1];".format( + dest=(ki*M_tail+kj)*2, kj=kj*2, ki=ki*2 + )) + dest.write("result{dest}+=S2*A[ai+{kj}+1]*B[bi+{ki}+0] + S3*A[ai+{kj}+0]*B[bi+{ki}+1];".format( + dest=(ki*M_tail+kj)*2+1, kj=kj*2, ki=ki*2 + )) + else: + dest.write("result{dest}+=A[ai+{kj}]*B[bi+{ki}];".format( + dest=ki*M_tail+kj, kj=kj, ki=ki + )) + dest.write("ai+={M_tail}{elt_size};") + dest.write("bi+={N}{elt_size};") + + dest.write("{index_type} ci=n_top*ldc+m_top;") + if is_complex: + dest.write("{result_t} Cr, Ci;") + for ki in range( N ): + for kj in range( M_tail ): + if is_complex: + if TRMM: + dest.write('Cr = result{dest}*alphar;', dest=(ki*M_tail+kj)*2+0) + dest.write('Ci = result{dest}*alphar;', dest=(ki*M_tail+kj)*2+1) + else: + dest.write('Cr = C[(ci+{ki}*ldc+{kj})*2+0];', ki=ki, kj=kj) + dest.write('Ci = C[(ci+{ki}*ldc+{kj})*2+1];', ki=ki, kj=kj) + dest.write('Cr += result{dest}*alphar;', dest=(ki*M_tail+kj)*2+0) + dest.write('Ci += result{dest}*alphar;', dest=(ki*M_tail+kj)*2+1) + dest.write('Cr -= result{dest}*alphai;', dest=(ki*M_tail+kj)*2+1) + dest.write('Ci += result{dest}*alphai;', dest=(ki*M_tail+kj)*2+0) + dest.write("C[(ci+{ki}*ldc+{kj})*2+0] = Cr;", ki=ki, kj=kj ) + dest.write("C[(ci+{ki}*ldc+{kj})*2+1] = Ci;", ki=ki, kj=kj ) + else: + op = '' if TRMM else '+' + dest.write("C[ci+{ki}*ldc+{kj}] {op}= alpha * result{dest};", + ki=ki, kj=kj, op=op, dest=ki*M_tail+kj + ) + dest.write("m_top+={M_tail};") + + M_tail = int(M_tail/2) + + +#----------------------------------------------------------------------- +class Setting(object): + def __init__( self, value, convert = None ): + self._value = value + self._convert = convert + + @classmethod + def ENUM( cls, *values ): + def closure( values ): + return lambda value: values[value.lower()] + return closure( { v.lower():v for v in values } ) + + @classmethod + def BOOL( cls, value ): + return value.lower().startswith('t') or value == '1' + + @property + def value( self ): + return self._value + + @property + def configurable( self ): + return self._convert is not None + + @value.setter + def value( self, value ): + self._value = self._convert( value ) + + def __str__( self ): + return str(self._value) + +#----------------------------------------------------------------------- +def main(): + settings = { + 'op': Setting( 'gemm', Setting.ENUM( 'gemm', 'trmm' ) ), + 'M': Setting( 16, int ), + 'N': Setting( 4, int ), + 'reg_width_bits': Setting( 256, int ), + 'LMUL': Setting( 1, int ), + 'M_tail_scalar_from':Setting( 2, int ), + 'cpu': Setting( 'zvl256b', str ), + 'param_precision': Setting( 'float', Setting.ENUM( 'float', 'double' ) ), + 'force_acc_double': Setting( False, Setting.BOOL ), + 'complex': Setting( False, Setting.BOOL ), + 'conjugate': Setting( False, Setting.BOOL ), + 'index_type': Setting( 'BLASLONG', str ), + 'trace': Setting( False, Setting.BOOL ), + 'output': Setting( None, str ), + 'tail_policy': Setting( '', str ), # _ta, if toolchain supports it + '__riscv_': Setting( '__riscv_', str), + } + + for item in sys.argv[1:]: + try: + name, value = tuple(item.split( '=', 1 )) + except: + ERROR("couldn't parse {}, expected arguments of the form name=value".format(item)) + + if name not in settings: + ERROR("couldn't parse {}, {} it is not a known option\n".format( item, name ) + +"options (and current defaults) are\n{}".format( + " ".join([ '{}={}'.format(k, settings[k].value) for k in settings.keys()])) + ) + + try: + settings[name].value = value + except: + import traceback + traceback.print_exc() + ERROR("couldn't parse {}".format(item)) + + if settings['output'].value is None: + if settings['complex'].value: + prefix = 'z' if settings['param_precision'].value == 'double' else 'c' + else: + prefix = 'd' if settings['param_precision'].value == 'double' else 's' + settings['output'] = Setting('{}{}_kernel_{}x{}_{}.c'.format( + prefix, + settings['op'], + settings['M'], + settings['N'], + settings['cpu'] + )) + + if settings['param_precision'].value == 'double': + settings['param_scalar_t'] = Setting( 'double' ) + settings['ELEN_PARAM'] = Setting(64) + else: + settings['param_scalar_t'] = Setting( 'float' ) + settings['ELEN_PARAM'] = Setting(32) + + settings['VFMUL'] = Setting( '{}vfmul_vf_f{}m{}{}'.format(settings['__riscv_'], settings['ELEN_PARAM'], settings['LMUL'], settings['tail_policy']) ) + settings['VFMACC'] = Setting( '{}vfmacc_vf_f{}m{}{}'.format(settings['__riscv_'], settings['ELEN_PARAM'], settings['LMUL'], settings['tail_policy']) ) + + settings['ELEN_ACC'] = settings['ELEN_PARAM'] + settings['LMUL_ACC'] = Setting(settings['LMUL'].value) + widen = '' + + if settings['force_acc_double'].value and (settings['param_precision'].value == 'float'): + settings['ELEN_ACC'] = Setting(64) + settings['LMUL_ACC'] = Setting(settings['LMUL'].value*2) + settings['VFNCVT'] = Setting('{}vfncvt_f_f_w_f{}m{}{}'.format(settings['__riscv_'], settings['ELEN_PARAM'], settings['LMUL'], settings['tail_policy'])) + widen = 'w' + + settings['VMUL_TO_ACC'] = Setting( '{}vf{}mul_vf_f{}m{}{}'.format(settings['__riscv_'], widen, settings['ELEN_ACC'], settings['LMUL_ACC'], settings['tail_policy']) ) + settings['VMACC_TO_ACC'] = Setting( '{}vf{}macc_vf_f{}m{}{}'.format(settings['__riscv_'], widen, settings['ELEN_ACC'], settings['LMUL_ACC'], settings['tail_policy']) ) + + settings['param_vector_t']=Setting('vfloat{}m{}_t'.format(settings['ELEN_PARAM'], settings['LMUL'])) + settings['acc_vector_t'] =Setting('vfloat{}m{}_t'.format(settings['ELEN_ACC'], settings['LMUL_ACC'])) + settings['VLEV'] =Setting('{}vle{}_v_f{}m{}'.format(settings['__riscv_'], settings['ELEN_PARAM'], settings['ELEN_PARAM'], settings['LMUL'])) + settings['VSEV'] =Setting('{}vse{}_v_f{}m{}'.format(settings['__riscv_'], settings['ELEN_PARAM'], settings['ELEN_PARAM'], settings['LMUL'])) + settings['VLSEV'] =Setting('{}vlse{}_v_f{}m{}'.format(settings['__riscv_'], settings['ELEN_PARAM'], settings['ELEN_PARAM'], settings['LMUL'])) + settings['VSSEV'] =Setting('{}vsse{}_v_f{}m{}'.format(settings['__riscv_'], settings['ELEN_PARAM'], settings['ELEN_PARAM'], settings['LMUL'])) + settings['VSETVL'] =Setting('{}vsetvl_e{}m{}'.format(settings['__riscv_'], settings['ELEN_PARAM'], settings['LMUL'])) + + + to_stdout = (settings['output'].value == '-') + if not to_stdout: + print("Writing {}".format(settings['output'].value), file=sys.stderr) + + with open(sys.stdout.fileno() if to_stdout else settings['output'].value, 'w') as destination_file: + def OUTPUT(*args, **kwargs): + print(*args, file=destination_file, **kwargs) + + OUTPUT("/*\n\nAUTOGENERATED KERNEL\nSettings:\n {}".format(" ".join([ "{}={}\n".format(k, repr(settings[k].value)) for k in sorted(settings.keys()) if settings[k].configurable]))) + OUTPUT("Derived:\n {}\n*/\n".format(" ".join([ "{}={}\n".format(k, repr(settings[k].value)) for k in sorted(settings.keys()) if not settings[k].configurable]))) + + OUTPUT('#include "common.h"') + OUTPUT("\n") + + if settings['op'].value in ('gemm', 'trmm'): + generate_gemm_kernel(settings, OUTPUT) + else: + ERROR("unsupported kernel type {}".format(settings['op'])) + +if __name__ == "__main__": + main() \ No newline at end of file diff --git a/kernel/riscv64/iamax_vector.c b/kernel/riscv64/iamax_vector.c index 9fea522f7..92880fbcf 100644 --- a/kernel/riscv64/iamax_vector.c +++ b/kernel/riscv64/iamax_vector.c @@ -27,118 +27,111 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include "common.h" #include +#include #if defined(DOUBLE) -#define ABS fabs -#define VSETVL(n) vsetvl_e64m8(n) -#define VSETVL_MAX vsetvlmax_e64m1() -#define FLOAT_V_T vfloat64m8_t +#define VSETVL(n) __riscv_vsetvl_e64m4(n) +#define FLOAT_V_T vfloat64m4_t #define FLOAT_V_T_M1 vfloat64m1_t -#define VLEV_FLOAT vle64_v_f64m8 -#define VLSEV_FLOAT vlse64_v_f64m8 -#define VFREDMAXVS_FLOAT vfredmax_vs_f64m8_f64m1 -#define MASK_T vbool8_t -#define VMFLTVF_FLOAT vmflt_vf_f64m8_b8 -#define VMFLTVV_FLOAT vmflt_vv_f64m8_b8 -#define VFMVVF_FLOAT vfmv_v_f_f64m8 -#define VFMVVF_FLOAT_M1 vfmv_v_f_f64m1 -#define VFRSUBVF_MASK_FLOAT vfrsub_vf_f64m8_m -#define VFMAXVV_FLOAT vfmax_vv_f64m8 -#define VMFGEVF_FLOAT vmfge_vf_f64m8_b8 -#define VMFIRSTM vmfirst_m_b8 -#define UINT_V_T vuint64m8_t -#define VIDV_MASK_UINT vid_v_u64m8_m -#define VIDV_UINT vid_v_u64m8 -#define VADDVX_MASK_UINT vadd_vx_u64m8_m -#define VADDVX_UINT vadd_vx_u64m8 -#define VMVVX_UINT vmv_v_x_u64m8 +#define VLEV_FLOAT __riscv_vle64_v_f64m4 +#define VLSEV_FLOAT __riscv_vlse64_v_f64m4 +#define VFREDMAXVS_FLOAT __riscv_vfredmax_vs_f64m4_f64m1 +#define MASK_T vbool16_t +#define VMFLTVV_FLOAT __riscv_vmflt_vv_f64m4_b16 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m4 +#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f64m1 +#define VFMAXVV_FLOAT __riscv_vfmax_vv_f64m4 +#define VMFGEVF_FLOAT __riscv_vmfge_vf_f64m4_b16 +#define VMFIRSTM __riscv_vfirst_m_b16 +#define UINT_V_T vuint64m4_t +#define VIDV_UINT __riscv_vid_v_u64m4 +#define VADDVX_MASK_UINT __riscv_vadd_vx_u64m4_mu +#define VADDVX_UINT __riscv_vadd_vx_u64m4 +#define VMVVX_UINT __riscv_vmv_v_x_u64m4 +#define VFABS_FLOAT __riscv_vfabs_v_f64m4 +#define VCOMPRESS __riscv_vcompress_vm_u64m4 +#define VMV_X __riscv_vmv_x_s_u64m4_u64 #else -#define ABS fabsf -#define VSETVL(n) vsetvl_e32m8(n) -#define VSETVL_MAX vsetvlmax_e32m1() -#define FLOAT_V_T vfloat32m8_t +#define VSETVL(n) __riscv_vsetvl_e32m4(n) +#define FLOAT_V_T vfloat32m4_t #define FLOAT_V_T_M1 vfloat32m1_t -#define VLEV_FLOAT vle32_v_f32m8 -#define VLSEV_FLOAT vlse32_v_f32m8 -#define VFREDMAXVS_FLOAT vfredmax_vs_f32m8_f32m1 -#define MASK_T vbool4_t -#define VMFLTVF_FLOAT vmflt_vf_f32m8_b4 -#define VMFLTVV_FLOAT vmflt_vv_f32m8_b4 -#define VFMVVF_FLOAT vfmv_v_f_f32m8 -#define VFMVVF_FLOAT_M1 vfmv_v_f_f32m1 -#define VFRSUBVF_MASK_FLOAT vfrsub_vf_f32m8_m -#define VFMAXVV_FLOAT vfmax_vv_f32m8 -#define VMFGEVF_FLOAT vmfge_vf_f32m8_b4 -#define VMFIRSTM vmfirst_m_b4 -#define UINT_V_T vuint32m8_t -#define VIDV_MASK_UINT vid_v_u32m8_m -#define VIDV_UINT vid_v_u32m8 -#define VADDVX_MASK_UINT vadd_vx_u32m8_m -#define VADDVX_UINT vadd_vx_u32m8 -#define VMVVX_UINT vmv_v_x_u32m8 +#define VLEV_FLOAT __riscv_vle32_v_f32m4 +#define VLSEV_FLOAT __riscv_vlse32_v_f32m4 +#define VFREDMAXVS_FLOAT __riscv_vfredmax_vs_f32m4_f32m1 +#define MASK_T vbool8_t +#define VMFLTVV_FLOAT __riscv_vmflt_vv_f32m4_b8 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m4 +#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f32m1 +#define VFMAXVV_FLOAT __riscv_vfmax_vv_f32m4 +#define VMFGEVF_FLOAT __riscv_vmfge_vf_f32m4_b8 +#define VMFIRSTM __riscv_vfirst_m_b8 +#define UINT_V_T vuint32m4_t +#define VIDV_UINT __riscv_vid_v_u32m4 +#define VADDVX_MASK_UINT __riscv_vadd_vx_u32m4_mu +#define VADDVX_UINT __riscv_vadd_vx_u32m4 +#define VMVVX_UINT __riscv_vmv_v_x_u32m4 +#define VFABS_FLOAT __riscv_vfabs_v_f32m4 +#define VCOMPRESS __riscv_vcompress_vm_u32m4 +#define VMV_X __riscv_vmv_x_s_u32m4_u32 #endif BLASLONG CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) { - BLASLONG i=0, j=0; - FLOAT maxf=0.0; + BLASLONG i=0, j=0; unsigned int max_index = 0; - if (n <= 0 || inc_x <= 0) return(max_index); + if (n <= 0 || inc_x <= 0) return(max_index); + FLOAT maxf=-FLT_MAX; FLOAT_V_T vx, v_max; UINT_V_T v_max_index; MASK_T mask; unsigned int gvl = 0; - FLOAT_V_T_M1 v_res, v_z0; - gvl = VSETVL_MAX; - v_res = VFMVVF_FLOAT_M1(0, gvl); - v_z0 = VFMVVF_FLOAT_M1(0, gvl); + FLOAT_V_T_M1 v_res; + v_res = VFMVVF_FLOAT_M1(-FLT_MAX, 1); + + gvl = VSETVL(n); + UINT_V_T vid = VIDV_UINT(gvl); if(inc_x == 1){ - gvl = VSETVL(n); v_max_index = VMVVX_UINT(0, gvl); - v_max = VFMVVF_FLOAT(-1, gvl); + v_max = VFMVVF_FLOAT(-FLT_MAX, gvl); for(i=0,j=0; i < n/gvl; i++){ vx = VLEV_FLOAT(&x[j], gvl); - //fabs(vector) - mask = VMFLTVF_FLOAT(vx, 0, gvl); - vx = VFRSUBVF_MASK_FLOAT(mask, vx, vx, 0, gvl); + vx = VFABS_FLOAT(vx, gvl); //index where element greater than v_max mask = VMFLTVV_FLOAT(v_max, vx, gvl); - v_max_index = VIDV_MASK_UINT(mask, v_max_index, gvl); - v_max_index = VADDVX_MASK_UINT(mask, v_max_index, v_max_index, j,gvl); + v_max_index = VADDVX_MASK_UINT(mask, v_max_index, vid, j, gvl); //update v_max and start_index j v_max = VFMAXVV_FLOAT(v_max, vx, gvl); j += gvl; } - v_res = VFREDMAXVS_FLOAT(v_res, v_max, v_z0, gvl); - maxf = *((FLOAT*)&v_res); + v_res = VFREDMAXVS_FLOAT(v_max, v_res, gvl); + maxf = EXTRACT_FLOAT(v_res); mask = VMFGEVF_FLOAT(v_max, maxf, gvl); - max_index = VMFIRSTM(mask,gvl); - max_index = *((unsigned int*)&v_max_index+max_index); + UINT_V_T compressed; + compressed = VCOMPRESS(v_max_index, mask, gvl); + max_index = VMV_X(compressed); if(j < n){ gvl = VSETVL(n-j); - vx = VLEV_FLOAT(&x[j], gvl); - //fabs(vector) - mask = VMFLTVF_FLOAT(vx, 0, gvl); - v_max = VFRSUBVF_MASK_FLOAT(mask, vx, vx, 0, gvl); + v_max = VLEV_FLOAT(&x[j], gvl); + v_max = VFABS_FLOAT(v_max, gvl); - v_res = VFREDMAXVS_FLOAT(v_res, v_max, v_z0, gvl); - FLOAT cur_maxf = *((FLOAT*)&v_res); + v_res = VFREDMAXVS_FLOAT(v_max, v_res, gvl); + FLOAT cur_maxf = EXTRACT_FLOAT(v_res); if(cur_maxf > maxf){ //tail index - v_max_index = VIDV_UINT(gvl); - v_max_index = VADDVX_UINT(v_max_index, j, gvl); + v_max_index = VADDVX_UINT(vid, j, gvl); mask = VMFGEVF_FLOAT(v_max, cur_maxf, gvl); - max_index = VMFIRSTM(mask,gvl); - max_index = *((unsigned int*)&v_max_index+max_index); + UINT_V_T compressed; + compressed = VCOMPRESS(v_max_index, mask, gvl); + max_index = VMV_X(compressed); } } }else{ @@ -146,51 +139,48 @@ BLASLONG CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) unsigned int stride_x = inc_x * sizeof(FLOAT); unsigned int idx = 0, inc_v = gvl * inc_x; + v_max = VFMVVF_FLOAT(-FLT_MAX, gvl); v_max_index = VMVVX_UINT(0, gvl); - v_max = VFMVVF_FLOAT(-1, gvl); for(i=0,j=0; i < n/gvl; i++){ vx = VLSEV_FLOAT(&x[idx], stride_x, gvl); - //fabs(vector) - mask = VMFLTVF_FLOAT(vx, 0, gvl); - vx = VFRSUBVF_MASK_FLOAT(mask, vx, vx, 0, gvl); + vx = VFABS_FLOAT(vx, gvl); //index where element greater than v_max mask = VMFLTVV_FLOAT(v_max, vx, gvl); - v_max_index = VIDV_MASK_UINT(mask, v_max_index, gvl); - v_max_index = VADDVX_MASK_UINT(mask, v_max_index, v_max_index, j, gvl); + v_max_index = VADDVX_MASK_UINT(mask, v_max_index, vid, j, gvl); //update v_max and start_index j v_max = VFMAXVV_FLOAT(v_max, vx, gvl); j += gvl; idx += inc_v; } - v_res = VFREDMAXVS_FLOAT(v_res, v_max, v_z0, gvl); - maxf = *((FLOAT*)&v_res); + + v_res = VFREDMAXVS_FLOAT(v_max, v_res, gvl); + maxf = EXTRACT_FLOAT(v_res); mask = VMFGEVF_FLOAT(v_max, maxf, gvl); - max_index = VMFIRSTM(mask,gvl); - max_index = *((unsigned int*)&v_max_index+max_index); + UINT_V_T compressed; + compressed = VCOMPRESS(v_max_index, mask, gvl); + max_index = VMV_X(compressed); if(j < n){ gvl = VSETVL(n-j); - vx = VLSEV_FLOAT(&x[idx], stride_x, gvl); - //fabs(vector) - mask = VMFLTVF_FLOAT(vx, 0, gvl); - v_max = VFRSUBVF_MASK_FLOAT(mask, vx, vx, 0, gvl); + v_max = VLSEV_FLOAT(&x[idx], stride_x, gvl); + v_max = VFABS_FLOAT(v_max, gvl); + + v_res = VFREDMAXVS_FLOAT(v_max, v_res, gvl); + FLOAT cur_maxf = EXTRACT_FLOAT(v_res); - v_res = VFREDMAXVS_FLOAT(v_res, v_max, v_z0, gvl); - FLOAT cur_maxf = *((FLOAT*)&v_res); if(cur_maxf > maxf){ //tail index - v_max_index = VIDV_UINT(gvl); - v_max_index = VADDVX_UINT(v_max_index, j, gvl); + v_max_index = VADDVX_UINT(vid, j, gvl); mask = VMFGEVF_FLOAT(v_max, cur_maxf, gvl); - max_index = VMFIRSTM(mask,gvl); - max_index = *((unsigned int*)&v_max_index+max_index); + + UINT_V_T compressed; + compressed = VCOMPRESS(v_max_index, mask, gvl); + max_index = VMV_X(compressed); } } } - return(max_index+1); + return(max_index+1); } - - diff --git a/kernel/riscv64/iamin_vector.c b/kernel/riscv64/iamin_vector.c index 4e81e7848..0503f9948 100644 --- a/kernel/riscv64/iamin_vector.c +++ b/kernel/riscv64/iamin_vector.c @@ -31,85 +31,79 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #if defined(DOUBLE) -#define ABS fabs -#define VSETVL(n) vsetvl_e64m8(n) -#define VSETVL_MAX vsetvlmax_e64m1() +#define VSETVL(n) __riscv_vsetvl_e64m8(n) #define FLOAT_V_T vfloat64m8_t #define FLOAT_V_T_M1 vfloat64m1_t -#define VLEV_FLOAT vle64_v_f64m8 -#define VLSEV_FLOAT vlse64_v_f64m8 -#define VFREDMINVS_FLOAT vfredmin_vs_f64m8_f64m1 +#define VLEV_FLOAT __riscv_vle64_v_f64m8 +#define VLSEV_FLOAT __riscv_vlse64_v_f64m8 +#define VFREDMINVS_FLOAT __riscv_vfredmin_vs_f64m8_f64m1 #define MASK_T vbool8_t -#define VMFLTVF_FLOAT vmflt_vf_f64m8_b8 -#define VMFLTVV_FLOAT vmflt_vv_f64m8_b8 -#define VFMVVF_FLOAT vfmv_v_f_f64m8 -#define VFMVVF_FLOAT_M1 vfmv_v_f_f64m1 -#define VFRSUBVF_MASK_FLOAT vfrsub_vf_f64m8_m -#define VFMINVV_FLOAT vfmin_vv_f64m8 -#define VMFLEVF_FLOAT vmfle_vf_f64m8_b8 -#define VMFIRSTM vmfirst_m_b8 +#define VMFGTVV_FLOAT __riscv_vmfgt_vv_f64m8_b8 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m8 +#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f64m1 +#define VFMINVV_FLOAT __riscv_vfmin_vv_f64m8 +#define VMFLEVF_FLOAT __riscv_vmfle_vf_f64m8_b8 +#define VMFIRSTM __riscv_vfirst_m_b8 #define UINT_V_T vuint64m8_t -#define VIDV_MASK_UINT vid_v_u64m8_m -#define VIDV_UINT vid_v_u64m8 -#define VADDVX_MASK_UINT vadd_vx_u64m8_m -#define VADDVX_UINT vadd_vx_u64m8 -#define VMVVX_UINT vmv_v_x_u64m8 +#define VIDV_MASK_UINT __riscv_vid_v_u64m8_mu +#define VIDV_UINT __riscv_vid_v_u64m8 +#define VADDVX_MASK_UINT __riscv_vadd_vx_u64m8_mu +#define VADDVX_UINT __riscv_vadd_vx_u64m8 +#define VMVVX_UINT __riscv_vmv_v_x_u64m8 +#define VFABS_FLOAT __riscv_vfabs_v_f64m8 +#define VCOMPRESS __riscv_vcompress_vm_u64m8 +#define VMV_X __riscv_vmv_x_s_u64m8_u64 #else -#define ABS fabsf -#define VSETVL(n) vsetvl_e32m8(n) -#define VSETVL_MAX vsetvlmax_e32m1() +#define VSETVL(n) __riscv_vsetvl_e32m8(n) #define FLOAT_V_T vfloat32m8_t #define FLOAT_V_T_M1 vfloat32m1_t -#define VLEV_FLOAT vle32_v_f32m8 -#define VLSEV_FLOAT vlse32_v_f32m8 -#define VFREDMINVS_FLOAT vfredmin_vs_f32m8_f32m1 +#define VLEV_FLOAT __riscv_vle32_v_f32m8 +#define VLSEV_FLOAT __riscv_vlse32_v_f32m8 +#define VFREDMINVS_FLOAT __riscv_vfredmin_vs_f32m8_f32m1 #define MASK_T vbool4_t -#define VMFLTVF_FLOAT vmflt_vf_f32m8_b4 -#define VMFLTVV_FLOAT vmflt_vv_f32m8_b4 -#define VFMVVF_FLOAT vfmv_v_f_f32m8 -#define VFMVVF_FLOAT_M1 vfmv_v_f_f32m1 -#define VFRSUBVF_MASK_FLOAT vfrsub_vf_f32m8_m -#define VFMINVV_FLOAT vfmin_vv_f32m8 -#define VMFLEVF_FLOAT vmfle_vf_f32m8_b4 -#define VMFIRSTM vmfirst_m_b4 +#define VMFGTVV_FLOAT __riscv_vmfgt_vv_f32m8_b4 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m8 +#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f32m1 +#define VFMINVV_FLOAT __riscv_vfmin_vv_f32m8 +#define VMFLEVF_FLOAT __riscv_vmfle_vf_f32m8_b4 +#define VMFIRSTM __riscv_vfirst_m_b4 #define UINT_V_T vuint32m8_t -#define VIDV_MASK_UINT vid_v_u32m8_m -#define VIDV_UINT vid_v_u32m8 -#define VADDVX_MASK_UINT vadd_vx_u32m8_m -#define VADDVX_UINT vadd_vx_u32m8 -#define VMVVX_UINT vmv_v_x_u32m8 +#define VIDV_MASK_UINT __riscv_vid_v_u32m8_mu +#define VIDV_UINT __riscv_vid_v_u32m8 +#define VADDVX_MASK_UINT __riscv_vadd_vx_u32m8_mu +#define VADDVX_UINT __riscv_vadd_vx_u32m8 +#define VMVVX_UINT __riscv_vmv_v_x_u32m8 +#define VFABS_FLOAT __riscv_vfabs_v_f32m8 +#define VCOMPRESS __riscv_vcompress_vm_u32m8 +#define VMV_X __riscv_vmv_x_s_u32m8_u32 #endif BLASLONG CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) { - BLASLONG i=0, j=0; - FLOAT minf=FLT_MAX; + BLASLONG i=0, j=0; unsigned int min_index = 0; - if (n <= 0 || inc_x <= 0) return(min_index); + if (n <= 0 || inc_x <= 0) return(min_index); + FLOAT minf=FLT_MAX; FLOAT_V_T vx, v_min; UINT_V_T v_min_index; MASK_T mask; unsigned int gvl = 0; - FLOAT_V_T_M1 v_res, v_max; - gvl = VSETVL_MAX; - v_res = VFMVVF_FLOAT_M1(0, gvl); - v_max = VFMVVF_FLOAT_M1(FLT_MAX, gvl); + FLOAT_V_T_M1 v_res; + v_res = VFMVVF_FLOAT_M1(FLT_MAX, 1); if(inc_x == 1){ gvl = VSETVL(n); - v_min = VFMVVF_FLOAT(FLT_MAX, gvl); v_min_index = VMVVX_UINT(0, gvl); + v_min = VFMVVF_FLOAT(FLT_MAX, gvl); for(i=0,j=0; i < n/gvl; i++){ vx = VLEV_FLOAT(&x[j], gvl); - //fabs(vector) - mask = VMFLTVF_FLOAT(vx, 0, gvl); - vx = VFRSUBVF_MASK_FLOAT(mask, vx, vx, 0, gvl); + vx = VFABS_FLOAT(vx, gvl); - //index where element less than v_min - mask = VMFLTVV_FLOAT(vx, v_min, gvl); + //index where element greater than v_min + mask = VMFGTVV_FLOAT(v_min, vx, gvl); v_min_index = VIDV_MASK_UINT(mask, v_min_index, gvl); v_min_index = VADDVX_MASK_UINT(mask, v_min_index, v_min_index, j, gvl); @@ -117,29 +111,29 @@ BLASLONG CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) v_min = VFMINVV_FLOAT(v_min, vx, gvl); j += gvl; } - v_res = VFREDMINVS_FLOAT(v_res, v_min, v_max, gvl); - minf = *((FLOAT*)&v_res); + v_res = VFREDMINVS_FLOAT(v_min, v_res, gvl); + minf = EXTRACT_FLOAT(v_res); mask = VMFLEVF_FLOAT(v_min, minf, gvl); - min_index = VMFIRSTM(mask,gvl); - min_index = *((unsigned int*)&v_min_index+min_index); + UINT_V_T compressed; + compressed = VCOMPRESS(v_min_index, mask, gvl); + min_index = VMV_X(compressed); if(j < n){ gvl = VSETVL(n-j); - vx = VLEV_FLOAT(&x[j], gvl); - //fabs(vector) - mask = VMFLTVF_FLOAT(vx, 0, gvl); - v_min = VFRSUBVF_MASK_FLOAT(mask, vx, vx, 0, gvl); + v_min = VLEV_FLOAT(&x[j], gvl); + v_min = VFABS_FLOAT(v_min, gvl); - v_res = VFREDMINVS_FLOAT(v_res, v_min, v_max, gvl); - FLOAT cur_minf = *((FLOAT*)&v_res); - if(cur_minf < minf){ + v_res = VFREDMINVS_FLOAT(v_min, v_res, gvl); + FLOAT cur_minf = EXTRACT_FLOAT(v_res); + if(cur_minf > minf){ //tail index v_min_index = VIDV_UINT(gvl); v_min_index = VADDVX_UINT(v_min_index, j, gvl); mask = VMFLEVF_FLOAT(v_min, cur_minf, gvl); - min_index = VMFIRSTM(mask,gvl); - min_index = *((unsigned int*)&v_min_index+min_index); + UINT_V_T compressed; + compressed = VCOMPRESS(v_min_index, mask, gvl); + min_index = VMV_X(compressed); } } }else{ @@ -151,12 +145,10 @@ BLASLONG CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) v_min_index = VMVVX_UINT(0, gvl); for(i=0,j=0; i < n/gvl; i++){ vx = VLSEV_FLOAT(&x[idx], stride_x, gvl); - //fabs(vector) - mask = VMFLTVF_FLOAT(vx, 0, gvl); - vx = VFRSUBVF_MASK_FLOAT(mask, vx, vx, 0, gvl); + vx = VFABS_FLOAT(vx, gvl); - //index where element less than v_min - mask = VMFLTVV_FLOAT(vx, v_min, gvl); + //index where element greater than v_min + mask = VMFGTVV_FLOAT(v_min, vx, gvl); v_min_index = VIDV_MASK_UINT(mask, v_min_index, gvl); v_min_index = VADDVX_MASK_UINT(mask, v_min_index, v_min_index, j, gvl); @@ -165,33 +157,31 @@ BLASLONG CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) j += gvl; idx += inc_v; } - v_res = VFREDMINVS_FLOAT(v_res, v_min, v_max, gvl); - minf = *((FLOAT*)&v_res); + v_res = VFREDMINVS_FLOAT(v_min, v_res, gvl); + minf = EXTRACT_FLOAT(v_res); mask = VMFLEVF_FLOAT(v_min, minf, gvl); - min_index = VMFIRSTM(mask,gvl); - min_index = *((unsigned int*)&v_min_index+min_index); + UINT_V_T compressed; + compressed = VCOMPRESS(v_min_index, mask, gvl); + min_index = VMV_X(compressed); if(j < n){ gvl = VSETVL(n-j); - vx = VLSEV_FLOAT(&x[idx], stride_x, gvl); - //fabs(vector) - mask = VMFLTVF_FLOAT(vx, 0, gvl); - v_min = VFRSUBVF_MASK_FLOAT(mask, vx, vx, 0, gvl); + v_min = VLSEV_FLOAT(&x[idx], stride_x, gvl); + v_min = VFABS_FLOAT(v_min, gvl); - v_res = VFREDMINVS_FLOAT(v_res, v_min, v_max, gvl); - FLOAT cur_minf = *((FLOAT*)&v_res); - if(cur_minf < minf){ + v_res = VFREDMINVS_FLOAT(v_min, v_res, gvl); + FLOAT cur_minf = EXTRACT_FLOAT(v_res); + if(cur_minf > minf){ //tail index v_min_index = VIDV_UINT(gvl); v_min_index = VADDVX_UINT(v_min_index, j, gvl); mask = VMFLEVF_FLOAT(v_min, cur_minf, gvl); - min_index = VMFIRSTM(mask,gvl); - min_index = *((unsigned int*)&v_min_index+min_index); + UINT_V_T compressed; + compressed = VCOMPRESS(v_min_index, mask, gvl); + min_index = VMV_X(compressed); } } } - return(min_index+1); + return(min_index+1); } - - diff --git a/kernel/riscv64/imax_vector.c b/kernel/riscv64/imax_vector.c index ca48a3c48..e24f9fd48 100644 --- a/kernel/riscv64/imax_vector.c +++ b/kernel/riscv64/imax_vector.c @@ -31,68 +31,66 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #if defined(DOUBLE) -#define ABS fabs -#define VSETVL(n) vsetvl_e64m8(n) -#define VSETVL_MAX vsetvlmax_e64m1() +#define VSETVL(n) __riscv_vsetvl_e64m8(n) #define FLOAT_V_T vfloat64m8_t #define FLOAT_V_T_M1 vfloat64m1_t -#define VLEV_FLOAT vle64_v_f64m8 -#define VLSEV_FLOAT vlse64_v_f64m8 -#define VFREDMAXVS_FLOAT vfredmax_vs_f64m8_f64m1 +#define VLEV_FLOAT __riscv_vle64_v_f64m8 +#define VLSEV_FLOAT __riscv_vlse64_v_f64m8 +#define VFREDMAXVS_FLOAT __riscv_vfredmax_vs_f64m8_f64m1 #define MASK_T vbool8_t -#define VMFLTVV_FLOAT vmflt_vv_f64m8_b8 -#define VFMVVF_FLOAT vfmv_v_f_f64m8 -#define VFMVVF_FLOAT_M1 vfmv_v_f_f64m1 -#define VFMAXVV_FLOAT vfmax_vv_f64m8 -#define VMFGEVF_FLOAT vmfge_vf_f64m8_b8 -#define VMFIRSTM vmfirst_m_b8 +#define VMFLTVV_FLOAT __riscv_vmflt_vv_f64m8_b8 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m8 +#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f64m1 +#define VFMAXVV_FLOAT __riscv_vfmax_vv_f64m8 +#define VMFGEVF_FLOAT __riscv_vmfge_vf_f64m8_b8 +#define VMFIRSTM __riscv_vfirst_m_b8 #define UINT_V_T vuint64m8_t -#define VIDV_MASK_UINT vid_v_u64m8_m -#define VIDV_UINT vid_v_u64m8 -#define VADDVX_MASK_UINT vadd_vx_u64m8_m -#define VADDVX_UINT vadd_vx_u64m8 -#define VMVVX_UINT vmv_v_x_u64m8 +#define VIDV_MASK_UINT __riscv_vid_v_u64m8_mu +#define VIDV_UINT __riscv_vid_v_u64m8 +#define VADDVX_MASK_UINT __riscv_vadd_vx_u64m8_mu +#define VADDVX_UINT __riscv_vadd_vx_u64m8 +#define VMVVX_UINT __riscv_vmv_v_x_u64m8 +#define VCOMPRESS __riscv_vcompress_vm_u64m8 +#define VMV_X __riscv_vmv_x_s_u64m8_u64 #else -#define ABS fabsf -#define VSETVL(n) vsetvl_e32m8(n) -#define VSETVL_MAX vsetvlmax_e32m1() +#define VSETVL(n) __riscv_vsetvl_e32m8(n) #define FLOAT_V_T vfloat32m8_t #define FLOAT_V_T_M1 vfloat32m1_t -#define VLEV_FLOAT vle32_v_f32m8 -#define VLSEV_FLOAT vlse32_v_f32m8 -#define VFREDMAXVS_FLOAT vfredmax_vs_f32m8_f32m1 +#define VLEV_FLOAT __riscv_vle32_v_f32m8 +#define VLSEV_FLOAT __riscv_vlse32_v_f32m8 +#define VFREDMAXVS_FLOAT __riscv_vfredmax_vs_f32m8_f32m1 #define MASK_T vbool4_t -#define VMFLTVV_FLOAT vmflt_vv_f32m8_b4 -#define VFMVVF_FLOAT vfmv_v_f_f32m8 -#define VFMVVF_FLOAT_M1 vfmv_v_f_f32m1 -#define VFMAXVV_FLOAT vfmax_vv_f32m8 -#define VMFGEVF_FLOAT vmfge_vf_f32m8_b4 -#define VMFIRSTM vmfirst_m_b4 +#define VMFLTVV_FLOAT __riscv_vmflt_vv_f32m8_b4 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m8 +#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f32m1 +#define VFMAXVV_FLOAT __riscv_vfmax_vv_f32m8 +#define VMFGEVF_FLOAT __riscv_vmfge_vf_f32m8_b4 +#define VMFIRSTM __riscv_vfirst_m_b4 #define UINT_V_T vuint32m8_t -#define VIDV_MASK_UINT vid_v_u32m8_m -#define VIDV_UINT vid_v_u32m8 -#define VADDVX_MASK_UINT vadd_vx_u32m8_m -#define VADDVX_UINT vadd_vx_u32m8 -#define VMVVX_UINT vmv_v_x_u32m8 +#define VIDV_MASK_UINT __riscv_vid_v_u32m8_mu +#define VIDV_UINT __riscv_vid_v_u32m8 +#define VADDVX_MASK_UINT __riscv_vadd_vx_u32m8_mu +#define VADDVX_UINT __riscv_vadd_vx_u32m8 +#define VMVVX_UINT __riscv_vmv_v_x_u32m8 +#define VCOMPRESS __riscv_vcompress_vm_u32m8 +#define VMV_X __riscv_vmv_x_s_u32m8_u32 #endif BLASLONG CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) { - BLASLONG i=0, j=0; + BLASLONG i=0, j=0; unsigned int max_index = 0; - if (n <= 0 || inc_x <= 0) return(max_index); - FLOAT maxf=-FLT_MAX; + if (n <= 0 || inc_x <= 0) return(max_index); + FLOAT maxf=-FLT_MAX; FLOAT_V_T vx, v_max; UINT_V_T v_max_index; MASK_T mask; unsigned int gvl = 0; - FLOAT_V_T_M1 v_res, v_min; - gvl = VSETVL_MAX; - v_res = VFMVVF_FLOAT_M1(0, gvl); - v_min = VFMVVF_FLOAT_M1(-FLT_MAX, gvl); + FLOAT_V_T_M1 v_res; + v_res = VFMVVF_FLOAT_M1(-FLT_MAX, 1); if(inc_x == 1){ gvl = VSETVL(n); @@ -104,32 +102,34 @@ BLASLONG CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) //index where element greater than v_max mask = VMFLTVV_FLOAT(v_max, vx, gvl); v_max_index = VIDV_MASK_UINT(mask, v_max_index, gvl); - v_max_index = VADDVX_MASK_UINT(mask, v_max_index, v_max_index, j,gvl); + v_max_index = VADDVX_MASK_UINT(mask, v_max_index, v_max_index, j, gvl); //update v_max and start_index j v_max = VFMAXVV_FLOAT(v_max, vx, gvl); j += gvl; } - v_res = VFREDMAXVS_FLOAT(v_res, v_max, v_min, gvl); - maxf = *((FLOAT*)&v_res); + v_res = VFREDMAXVS_FLOAT(v_max, v_res, gvl); + maxf = EXTRACT_FLOAT(v_res); mask = VMFGEVF_FLOAT(v_max, maxf, gvl); - max_index = VMFIRSTM(mask,gvl); - max_index = *((unsigned int*)&v_max_index+max_index); + UINT_V_T compressed; + compressed = VCOMPRESS(v_max_index, mask, gvl); + max_index = VMV_X(compressed); if(j < n){ gvl = VSETVL(n-j); v_max = VLEV_FLOAT(&x[j], gvl); - v_res = VFREDMAXVS_FLOAT(v_res, v_max, v_min, gvl); - FLOAT cur_maxf = *((FLOAT*)&v_res); + v_res = VFREDMAXVS_FLOAT(v_max, v_res, gvl); + FLOAT cur_maxf = EXTRACT_FLOAT(v_res); if(cur_maxf > maxf){ //tail index v_max_index = VIDV_UINT(gvl); v_max_index = VADDVX_UINT(v_max_index, j, gvl); mask = VMFGEVF_FLOAT(v_max, cur_maxf, gvl); - max_index = VMFIRSTM(mask,gvl); - max_index = *((unsigned int*)&v_max_index+max_index); + UINT_V_T compressed; + compressed = VCOMPRESS(v_max_index, mask, gvl); + max_index = VMV_X(compressed); } } }else{ @@ -145,37 +145,37 @@ BLASLONG CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) //index where element greater than v_max mask = VMFLTVV_FLOAT(v_max, vx, gvl); v_max_index = VIDV_MASK_UINT(mask, v_max_index, gvl); - v_max_index = VADDVX_MASK_UINT(mask, v_max_index, v_max_index, j,gvl); + v_max_index = VADDVX_MASK_UINT(mask, v_max_index, v_max_index, j, gvl); //update v_max and start_index j v_max = VFMAXVV_FLOAT(v_max, vx, gvl); j += gvl; idx += inc_v; } - v_res = VFREDMAXVS_FLOAT(v_res, v_max, v_min, gvl); - maxf = *((FLOAT*)&v_res); + v_res = VFREDMAXVS_FLOAT(v_max, v_res, gvl); + maxf = EXTRACT_FLOAT(v_res); mask = VMFGEVF_FLOAT(v_max, maxf, gvl); - max_index = VMFIRSTM(mask,gvl); - max_index = *((unsigned int*)&v_max_index+max_index); + UINT_V_T compressed; + compressed = VCOMPRESS(v_max_index, mask, gvl); + max_index = VMV_X(compressed); if(j < n){ gvl = VSETVL(n-j); v_max = VLSEV_FLOAT(&x[idx], stride_x, gvl); - v_res = VFREDMAXVS_FLOAT(v_res, v_max, v_min, gvl); - FLOAT cur_maxf = *((FLOAT*)&v_res); + v_res = VFREDMAXVS_FLOAT(v_max, v_res, gvl); + FLOAT cur_maxf = EXTRACT_FLOAT(v_res); if(cur_maxf > maxf){ //tail index v_max_index = VIDV_UINT(gvl); v_max_index = VADDVX_UINT(v_max_index, j, gvl); mask = VMFGEVF_FLOAT(v_max, cur_maxf, gvl); - max_index = VMFIRSTM(mask,gvl); - max_index = *((unsigned int*)&v_max_index+max_index); + UINT_V_T compressed; + compressed = VCOMPRESS(v_max_index, mask, gvl); + max_index = VMV_X(compressed); } } } - return(max_index+1); + return(max_index+1); } - - diff --git a/kernel/riscv64/imin_vector.c b/kernel/riscv64/imin_vector.c index 2a677098d..a60bd3d07 100644 --- a/kernel/riscv64/imin_vector.c +++ b/kernel/riscv64/imin_vector.c @@ -31,122 +31,105 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #if defined(DOUBLE) -#define ABS fabs -#define VSETVL(n) vsetvl_e64m8(n) -#define VSETVL_MAX vsetvlmax_e64m1() +#define VSETVL(n) __riscv_vsetvl_e64m8(n) #define FLOAT_V_T vfloat64m8_t #define FLOAT_V_T_M1 vfloat64m1_t -#define VLEV_FLOAT vle64_v_f64m8 -#define VLSEV_FLOAT vlse64_v_f64m8 -#define VFREDMINVS_FLOAT vfredmin_vs_f64m8_f64m1 +#define VLEV_FLOAT __riscv_vle64_v_f64m8 +#define VLSEV_FLOAT __riscv_vlse64_v_f64m8 +#define VFREDMINVS_FLOAT __riscv_vfredmin_vs_f64m8_f64m1 #define MASK_T vbool8_t -#define VMFLTVV_FLOAT vmflt_vv_f64m8_b8 -#define VFMVVF_FLOAT vfmv_v_f_f64m8 -#define VFMVVF_FLOAT_M1 vfmv_v_f_f64m1 -#define VFMINVV_FLOAT vfmin_vv_f64m8 -#define VMFLEVF_FLOAT vmfle_vf_f64m8_b8 -#define VMFIRSTM vmfirst_m_b8 +#define VMFGTVV_FLOAT __riscv_vmfgt_vv_f64m8_b8 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m8 +#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f64m1 +#define VFMINVV_FLOAT __riscv_vfmin_vv_f64m8 +#define VMFLEVF_FLOAT __riscv_vmfle_vf_f64m8_b8 +#define VMFIRSTM __riscv_vfirst_m_b8 #define UINT_V_T vuint64m8_t -#define VIDV_MASK_UINT vid_v_u64m8_m -#define VIDV_UINT vid_v_u64m8 -#define VADDVX_MASK_UINT vadd_vx_u64m8_m -#define VADDVX_UINT vadd_vx_u64m8 -#define VMVVX_UINT vmv_v_x_u64m8 +#define VIDV_MASK_UINT __riscv_vid_v_u64m8_m +#define VIDV_UINT __riscv_vid_v_u64m8 +#define VADDVX_MASK_UINT __riscv_vadd_vx_u64m8_m +#define VADDVX_UINT __riscv_vadd_vx_u64m8 +#define VMVVX_UINT __riscv_vmv_v_x_u64m8 +#define VCOMPRESS __riscv_vcompress_vm_u64m8 +#define VMV_X __riscv_vmv_x_s_u64m8_u64 #else -#define ABS fabsf -#define VSETVL(n) vsetvl_e32m8(n) -#define VSETVL_MAX vsetvlmax_e32m1() +#define VSETVL(n) __riscv_vsetvl_e32m8(n) #define FLOAT_V_T vfloat32m8_t #define FLOAT_V_T_M1 vfloat32m1_t -#define VLEV_FLOAT vle32_v_f32m8 -#define VLSEV_FLOAT vlse32_v_f32m8 -#define VFREDMINVS_FLOAT vfredmin_vs_f32m8_f32m1 +#define VLEV_FLOAT __riscv_vle32_v_f32m8 +#define VLSEV_FLOAT __riscv_vlse32_v_f32m8 +#define VFREDMINVS_FLOAT __riscv_vfredmin_vs_f32m8_f32m1 #define MASK_T vbool4_t -#define VMFLTVV_FLOAT vmflt_vv_f32m8_b4 -#define VFMVVF_FLOAT vfmv_v_f_f32m8 -#define VFMVVF_FLOAT_M1 vfmv_v_f_f32m1 -#define VFMINVV_FLOAT vfmin_vv_f32m8 -#define VMFLEVF_FLOAT vmfle_vf_f32m8_b4 -#define VMFIRSTM vmfirst_m_b4 +#define VMFGTVV_FLOAT __riscv_vmfgt_vv_f32m8_b4 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m8 +#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f32m1 +#define VFMINVV_FLOAT __riscv_vfmin_vv_f32m8 +#define VMFLEVF_FLOAT __riscv_vmfle_vf_f32m8_b4 +#define VMFIRSTM __riscv_vfirst_m_b4 #define UINT_V_T vuint32m8_t -#define VIDV_MASK_UINT vid_v_u32m8_m -#define VIDV_UINT vid_v_u32m8 -#define VADDVX_MASK_UINT vadd_vx_u32m8_m -#define VADDVX_UINT vadd_vx_u32m8 -#define VMVVX_UINT vmv_v_x_u32m8 +#define VIDV_MASK_UINT __riscv_vid_v_u32m8_m +#define VIDV_UINT __riscv_vid_v_u32m8 +#define VADDVX_MASK_UINT __riscv_vadd_vx_u32m8_m +#define VADDVX_UINT __riscv_vadd_vx_u32m8 +#define VMVVX_UINT __riscv_vmv_v_x_u32m8 +#define VCOMPRESS __riscv_vcompress_vm_u32m8 +#define VMV_X __riscv_vmv_x_s_u32m8_u32 #endif BLASLONG CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) { - BLASLONG i=0, j=0; - FLOAT minf=FLT_MAX; + BLASLONG i=0, j=0; unsigned int min_index = 0; - if (n <= 0 || inc_x <= 0) return(min_index); + if (n <= 0 || inc_x <= 0) return(min_index); + FLOAT minf=FLT_MAX; FLOAT_V_T vx, v_min; UINT_V_T v_min_index; MASK_T mask; unsigned int gvl = 0; - FLOAT_V_T_M1 v_res, v_max; - gvl = VSETVL_MAX; - v_res = VFMVVF_FLOAT_M1(0, gvl); - v_max = VFMVVF_FLOAT_M1(FLT_MAX, gvl); + FLOAT_V_T_M1 v_res; + v_res = VFMVVF_FLOAT_M1(FLT_MAX, 1); if(inc_x == 1){ gvl = VSETVL(n); - v_min = VFMVVF_FLOAT(FLT_MAX, gvl); v_min_index = VMVVX_UINT(0, gvl); + v_min = VFMVVF_FLOAT(FLT_MAX, gvl); for(i=0,j=0; i < n/gvl; i++){ vx = VLEV_FLOAT(&x[j], gvl); - //index where element less than v_min - mask = VMFLTVV_FLOAT(vx, v_min, gvl); - v_min_index = VIDV_MASK_UINT(mask, v_min_index, gvl); -/* -#if defined(DOUBLE) -asm volatile( - "vor.vv v0, %1, %1 \n\t" - "vsetvli x0, %2, e64,m8 \n\t" - "vid.v %0, v0.t \n\t" - :"+v"(v_min_index) - :"v"(mask), "r"(gvl) - :"v0"); -#else -asm volatile( - "vor.vv v0, %1, %1 \n\t" - "vsetvli x0, %2, e32,m8 \n\t" - "vid.v %0, v0.t \n\t" - :"+v"(v_min_index) - :"v"(mask), "r"(gvl) - :"v0"); -#endif -*/ - v_min_index = VADDVX_MASK_UINT(mask, v_min_index, v_min_index, j,gvl); + + //index where element greater than v_min + mask = VMFGTVV_FLOAT(v_min, vx, gvl); + v_min_index = VIDV_MASK_UINT(mask, gvl); + v_min_index = VADDVX_MASK_UINT(mask, v_min_index, j, gvl); //update v_min and start_index j v_min = VFMINVV_FLOAT(v_min, vx, gvl); j += gvl; } - v_res = VFREDMINVS_FLOAT(v_res, v_min, v_max, gvl); - minf = *((FLOAT*)&v_res); + v_res = VFREDMINVS_FLOAT(v_min, v_res, gvl); + minf = EXTRACT_FLOAT(v_res); mask = VMFLEVF_FLOAT(v_min, minf, gvl); - min_index = VMFIRSTM(mask,gvl); - min_index = *((unsigned int*)&v_min_index+min_index); + UINT_V_T compressed; + compressed = VCOMPRESS(v_min_index, mask, gvl); + min_index = VMV_X(compressed); if(j < n){ gvl = VSETVL(n-j); v_min = VLEV_FLOAT(&x[j], gvl); - v_res = VFREDMINVS_FLOAT(v_res, v_min, v_max, gvl); - FLOAT cur_minf = *((FLOAT*)&v_res); - if(cur_minf < minf){ + v_res = VFREDMINVS_FLOAT(v_min, v_res, gvl); + FLOAT cur_minf = EXTRACT_FLOAT(v_res); + if(cur_minf > minf){ //tail index v_min_index = VIDV_UINT(gvl); v_min_index = VADDVX_UINT(v_min_index, j, gvl); + mask = VMFLEVF_FLOAT(v_min, cur_minf, gvl); - min_index = VMFIRSTM(mask,gvl); - min_index = *((unsigned int*)&v_min_index+min_index); + UINT_V_T compressed; + compressed = VCOMPRESS(v_min_index, mask, gvl); + min_index = VMV_X(compressed); } } }else{ @@ -159,59 +142,39 @@ asm volatile( for(i=0,j=0; i < n/gvl; i++){ vx = VLSEV_FLOAT(&x[idx], stride_x, gvl); - //index where element less than v_min - mask = VMFLTVV_FLOAT(vx, v_min, gvl); - v_min_index = VIDV_MASK_UINT(mask, v_min_index, gvl); -/* -#if defined(DOUBLE) -asm volatile( - "vor.vv v0, %1, %1 \n\t" - "vsetvli x0, %2, e64,m8 \n\t" - "vid.v %0, v0.t \n\t" - :"+v"(v_min_index) - :"v"(mask), "r"(gvl) - :"v0"); -#else -asm volatile( - "vor.vv v0, %1, %1 \n\t" - "vsetvli x0, %2, e32,m8 \n\t" - "vid.v %0, v0.t \n\t" - :"+v"(v_min_index) - :"v"(mask), "r"(gvl) - :"v0"); -#endif -*/ - - v_min_index = VADDVX_MASK_UINT(mask, v_min_index, v_min_index, j,gvl); + //index where element greater than v_min + mask = VMFGTVV_FLOAT(v_min, vx, gvl); + v_min_index = VIDV_MASK_UINT(mask, gvl); + v_min_index = VADDVX_MASK_UINT(mask, v_min_index, j, gvl); //update v_min and start_index j v_min = VFMINVV_FLOAT(v_min, vx, gvl); j += gvl; idx += inc_v; } - v_res = VFREDMINVS_FLOAT(v_res, v_min, v_max, gvl); - minf = *((FLOAT*)&v_res); + v_res = VFREDMINVS_FLOAT(v_min, v_res, gvl); + minf = EXTRACT_FLOAT(v_res); mask = VMFLEVF_FLOAT(v_min, minf, gvl); - min_index = VMFIRSTM(mask,gvl); - min_index = *((unsigned int*)&v_min_index+min_index); + UINT_V_T compressed; + compressed = VCOMPRESS(v_min_index, mask, gvl); + min_index = VMV_X(compressed); if(j < n){ gvl = VSETVL(n-j); v_min = VLSEV_FLOAT(&x[idx], stride_x, gvl); - - v_res = VFREDMINVS_FLOAT(v_res, v_min, v_max, gvl); - FLOAT cur_minf = *((FLOAT*)&v_res); - if(cur_minf < minf){ + v_res = VFREDMINVS_FLOAT(v_min, v_res, gvl); + FLOAT cur_minf = EXTRACT_FLOAT(v_res); + if(cur_minf > minf){ //tail index v_min_index = VIDV_UINT(gvl); v_min_index = VADDVX_UINT(v_min_index, j, gvl); + mask = VMFLEVF_FLOAT(v_min, cur_minf, gvl); - min_index = VMFIRSTM(mask,gvl); - min_index = *((unsigned int*)&v_min_index+min_index); + UINT_V_T compressed; + compressed = VCOMPRESS(v_min_index, mask, gvl); + min_index = VMV_X(compressed); } } } - return(min_index+1); + return(min_index+1); } - - diff --git a/kernel/riscv64/izamax_vector.c b/kernel/riscv64/izamax_vector.c index 66a101566..89cd510c1 100644 --- a/kernel/riscv64/izamax_vector.c +++ b/kernel/riscv64/izamax_vector.c @@ -27,241 +27,132 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include "common.h" #include +#include #if defined(DOUBLE) -#define VSETVL(n) vsetvl_e64m8(n) -#define VSETVL_MAX vsetvlmax_e64m1() +#define VSETVL(n) __riscv_vsetvl_e64m8(n) #define FLOAT_V_T vfloat64m8_t #define FLOAT_V_T_M1 vfloat64m1_t -#define VFMVFS_FLOAT vfmv_f_s_f64m1_f64 -#define VLSEV_FLOAT vlse64_v_f64m8 -#define VFREDMAXVS_FLOAT vfredmax_vs_f64m8_f64m1 +#define VLEV_FLOAT __riscv_vle64_v_f64m8 +#define VLSEV_FLOAT __riscv_vlse64_v_f64m8 +#define VFREDMAXVS_FLOAT __riscv_vfredmax_vs_f64m8_f64m1 #define MASK_T vbool8_t -#define VMFLTVF_FLOAT vmflt_vf_f64m8_b8 -#define VMFLTVV_FLOAT vmflt_vv_f64m8_b8 -#define VFMVVF_FLOAT vfmv_v_f_f64m8 -#define VFMVVF_FLOAT_M1 vfmv_v_f_f64m1 -#define VFRSUBVF_MASK_FLOAT vfrsub_vf_f64m8_m -#define VFMAXVV_FLOAT vfmax_vv_f64m8 -#define VMFGEVF_FLOAT vmfge_vf_f64m8_b8 -#define VMFIRSTM vmfirst_m_b8 +#define VMFLTVV_FLOAT __riscv_vmflt_vv_f64m8_b8 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m8 +#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f64m1 +#define VFMAXVV_FLOAT __riscv_vfmax_vv_f64m8 +#define VMFGEVF_FLOAT __riscv_vmfge_vf_f64m8_b8 +#define VMFIRSTM __riscv_vfirst_m_b8 #define UINT_V_T vuint64m8_t -#define VSEVU_UINT vse64_v_u64m8 +#define VSEVU_UINT __riscv_vse64_v_u64m8 #define UINT_T long unsigned int -#define VIDV_MASK_UINT vid_v_u64m8_m -#define VIDV_UINT vid_v_u64m8 -#define VADDVX_MASK_UINT vadd_vx_u64m8_m -#define VADDVX_UINT vadd_vx_u64m8 -#define VFADDVV_FLOAT vfadd_vv_f64m8 -#define VMVVX_UINT vmv_v_x_u64m8 +#define VIDV_MASK_UINT __riscv_vid_v_u64m8_mu +#define VIDV_UINT __riscv_vid_v_u64m8 +#define VADDVX_MASK_UINT __riscv_vadd_vx_u64m8_mu +#define VADDVX_UINT __riscv_vadd_vx_u64m8 +#define VMVVX_UINT __riscv_vmv_v_x_u64m8 +#define VFABS_FLOAT __riscv_vfabs_v_f64m8 +#define VFADDVV_FLOAT __riscv_vfadd_vv_f64m8 +#define VCOMPRESS __riscv_vcompress_vm_u64m8 +#define VMV_X __riscv_vmv_x_s_u64m8_u64 #else -#define ABS fabsf -#define VSETVL(n) vsetvl_e32m8(n) -#define VSETVL_MAX vsetvlmax_e32m1() +#define VSETVL(n) __riscv_vsetvl_e32m8(n) #define FLOAT_V_T vfloat32m8_t #define FLOAT_V_T_M1 vfloat32m1_t -#define VFMVFS_FLOAT vfmv_f_s_f32m1_f32 -#define VLSEV_FLOAT vlse32_v_f32m8 -#define VFREDMAXVS_FLOAT vfredmax_vs_f32m8_f32m1 +#define VLEV_FLOAT __riscv_vle32_v_f32m8 +#define VLSEV_FLOAT __riscv_vlse32_v_f32m8 +#define VFREDMAXVS_FLOAT __riscv_vfredmax_vs_f32m8_f32m1 #define MASK_T vbool4_t -#define VMFLTVF_FLOAT vmflt_vf_f32m8_b4 -#define VMFLTVV_FLOAT vmflt_vv_f32m8_b4 -#define VFMVVF_FLOAT vfmv_v_f_f32m8 -#define VFMVVF_FLOAT_M1 vfmv_v_f_f32m1 -#define VFRSUBVF_MASK_FLOAT vfrsub_vf_f32m8_m -#define VFMAXVV_FLOAT vfmax_vv_f32m8 -#define VMFGEVF_FLOAT vmfge_vf_f32m8_b4 -#define VMFIRSTM vmfirst_m_b4 +#define VMFLTVV_FLOAT __riscv_vmflt_vv_f32m8_b4 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m8 +#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f32m1 +#define VFMAXVV_FLOAT __riscv_vfmax_vv_f32m8 +#define VMFGEVF_FLOAT __riscv_vmfge_vf_f32m8_b4 +#define VMFIRSTM __riscv_vfirst_m_b4 #define UINT_V_T vuint32m8_t #define UINT_T unsigned int -#define VSEVU_UINT vse32_v_u32m8 -#define VIDV_MASK_UINT vid_v_u32m8_m -#define VIDV_UINT vid_v_u32m8 -#define VADDVX_MASK_UINT vadd_vx_u32m8_m -#define VADDVX_UINT vadd_vx_u32m8 -#define VFADDVV_FLOAT vfadd_vv_f32m8 -#define VMVVX_UINT vmv_v_x_u32m8 +#define VSEVU_UINT __riscv_vse32_v_u32m8 +#define VIDV_MASK_UINT __riscv_vid_v_u32m8_mu +#define VIDV_UINT __riscv_vid_v_u32m8 +#define VADDVX_MASK_UINT __riscv_vadd_vx_u32m8_mu +#define VADDVX_UINT __riscv_vadd_vx_u32m8 +#define VMVVX_UINT __riscv_vmv_v_x_u32m8 +#define VFABS_FLOAT __riscv_vfabs_v_f32m8 +#define VFADDVV_FLOAT __riscv_vfadd_vv_f32m8 +#define VCOMPRESS __riscv_vcompress_vm_u32m8 +#define VMV_X __riscv_vmv_x_s_u32m8_u32 #endif -#define RVV_M RVV_M8 BLASLONG CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) { - BLASLONG i=0, j=0; - FLOAT maxf=0.0; + BLASLONG i=0, j=0; unsigned int max_index = 0; - if (n <= 0 || inc_x <= 0) return(max_index); + if (n <= 0 || inc_x <= 0) return(max_index); + FLOAT maxf=-FLT_MAX; - FLOAT_V_T vx0, vx1, v_max; + FLOAT_V_T vx, vx2, v_max; UINT_V_T v_max_index; - MASK_T mask0, mask1; + MASK_T mask; unsigned int gvl = 0; - FLOAT_V_T_M1 v_res, v_z0; - gvl = VSETVL_MAX; - v_res = VFMVVF_FLOAT_M1(0, gvl); - v_z0 = VFMVVF_FLOAT_M1(0, gvl); + FLOAT_V_T_M1 v_res; + v_res = VFMVVF_FLOAT_M1(-FLT_MAX, 1); gvl = VSETVL(n); - UINT_T temp_uint[gvl]; + unsigned int stride_x = inc_x * 2 * sizeof(FLOAT); + unsigned int idx = 0, inc_v = gvl * inc_x * 2; + + v_max = VFMVVF_FLOAT(-FLT_MAX, gvl); v_max_index = VMVVX_UINT(0, gvl); - v_max = VFMVVF_FLOAT(-1, gvl); - BLASLONG stride_x = inc_x * 2 * sizeof(FLOAT); - BLASLONG inc_xv = gvl * inc_x * 2; - BLASLONG ix = 0; for(i=0,j=0; i < n/gvl; i++){ - vx0 = VLSEV_FLOAT(&x[ix], stride_x, gvl); - //fabs(vector) - mask0 = VMFLTVF_FLOAT(vx0, 0, gvl); - vx0 = VFRSUBVF_MASK_FLOAT(mask0, vx0, vx0, 0, gvl); -/* -#if defined(DOUBLE) -asm volatile( - "vor.vv v0, %1, %1\n\t" - "vsetvli x0, %3, e64,m8 \n\t" - "vfrsub.vf %0, %0, %2, v0.t \n\t" - :"+v"(vx0) - :"v"(mask0), "f"(zero), "r"(gvl) - :"v0"); -#else -asm volatile( - "vor.vv v0, %1, %1\n\t" - "vsetvli x0, %3, e32,m8 \n\t" - "vfrsub.vf %0, %0, %2, v0.t \n\t" - :"+v"(vx0) - :"v"(mask0), "f"(zero), "r"(gvl) - :"v0"); -#endif -*/ - vx1 = VLSEV_FLOAT(&x[ix+1], stride_x, gvl); - //fabs(vector) - mask1 = VMFLTVF_FLOAT(vx1, 0, gvl); - vx1 = VFRSUBVF_MASK_FLOAT(mask1, vx1, vx1, 0, gvl); -/* -#if defined(DOUBLE) -asm volatile( - "vor.vv v0, %1, %1\n\t" - "vsetvli x0, %3, e64,m8 \n\t" - "vfrsub.vf %0, %0, %2, v0.t \n\t" - :"+v"(vx1) - :"v"(mask1), "f"(zero), "r"(gvl) - :"v0"); -#else -asm volatile( - "vor.vv v0, %1, %1\n\t" - "vsetvli x0, %3, e32,m8 \n\t" - "vfrsub.vf %0, %0, %2, v0.t \n\t" - :"+v"(vx1) - :"v"(mask1), "f"(zero), "r"(gvl) - :"v0"); -#endif -*/ - vx0 = VFADDVV_FLOAT(vx0, vx1, gvl); + vx = VLSEV_FLOAT(&x[idx], stride_x, gvl); + vx2 = VLSEV_FLOAT(&x[idx+1], stride_x, gvl); + vx = VFABS_FLOAT(vx, gvl); + vx2 = VFABS_FLOAT(vx2, gvl); + vx = VFADDVV_FLOAT(vx, vx2, gvl); + //index where element greater than v_max - mask0 = VMFLTVV_FLOAT(v_max, vx0, gvl); - v_max_index = VIDV_MASK_UINT(mask0, v_max_index, gvl); -/* -#if defined(DOUBLE) -asm volatile( - "vor.vv v0, %1, %1 \n\t" - "vsetvli x0, %2, e64,m8 \n\t" - "vid.v %0, v0.t \n\t" - :"+v"(v_max_index) - :"v"(mask0), "r"(gvl) - :"v0"); -#else -asm volatile( - "vor.vv v0, %1, %1 \n\t" - "vsetvli x0, %2, e32,m8 \n\t" - "vid.v %0, v0.t \n\t" - :"+v"(v_max_index) - :"v"(mask0), "r"(gvl) - :"v0"); -#endif -*/ - v_max_index = VADDVX_MASK_UINT(mask0, v_max_index, v_max_index, j, gvl); + mask = VMFLTVV_FLOAT(v_max, vx, gvl); + v_max_index = VIDV_MASK_UINT(mask, v_max_index, gvl); + v_max_index = VADDVX_MASK_UINT(mask, v_max_index, v_max_index, j, gvl); //update v_max and start_index j - v_max = VFMAXVV_FLOAT(v_max, vx0, gvl); + v_max = VFMAXVV_FLOAT(v_max, vx, gvl); j += gvl; - ix += inc_xv; + idx += inc_v; } - vx0 = VFMVVF_FLOAT(0, gvl); - v_res = VFREDMAXVS_FLOAT(v_res, v_max, v_z0, gvl); - maxf = VFMVFS_FLOAT(v_res); - mask0 = VMFGEVF_FLOAT(v_max, maxf, gvl); - max_index = VMFIRSTM(mask0,gvl); - VSEVU_UINT(temp_uint,v_max_index,gvl); - max_index = temp_uint[max_index]; - + v_res = VFREDMAXVS_FLOAT(v_max, v_res, gvl); + maxf = EXTRACT_FLOAT(v_res); + mask = VMFGEVF_FLOAT(v_max, maxf, gvl); + UINT_V_T compressed; + compressed = VCOMPRESS(v_max_index, mask, gvl); + max_index = VMV_X(compressed); if(j < n){ gvl = VSETVL(n-j); - v_max_index = VMVVX_UINT(0, gvl); - vx0 = VLSEV_FLOAT(&x[ix], stride_x, gvl); - //fabs(vector) - mask0 = VMFLTVF_FLOAT(vx0, 0, gvl); - vx0 = VFRSUBVF_MASK_FLOAT(mask0, vx0, vx0, 0, gvl); -/* -#if defined(DOUBLE) -asm volatile( - "vor.vv v0, %1, %1\n\t" - "vsetvli x0, %3, e64,m8 \n\t" - "vfrsub.vf %0, %0, %2, v0.t \n\t" - :"+v"(vx0) - :"v"(mask0), "f"(zero), "r"(gvl) - :"v0"); -#else -asm volatile( - "vor.vv v0, %1, %1\n\t" - "vsetvli x0, %3, e32,m8 \n\t" - "vfrsub.vf %0, %0, %2, v0.t \n\t" - :"+v"(vx0) - :"v"(mask0), "f"(zero), "r"(gvl) - :"v0"); -#endif -*/ - vx1 = VLSEV_FLOAT(&x[ix+1], stride_x, gvl); - //fabs(vector) - mask1 = VMFLTVF_FLOAT(vx1, 0, gvl); - vx1 = VFRSUBVF_MASK_FLOAT(mask1, vx1, vx1, 0, gvl); -/* -#if defined(DOUBLE) -asm volatile( - "vor.vv v0, %1, %1\n\t" - "vsetvli x0, %3, e64,m8 \n\t" - "vfrsub.vf %0, %0, %2, v0.t \n\t" - :"+v"(vx1) - :"v"(mask1), "f"(zero), "r"(gvl) - :"v0"); -#else -asm volatile( - "vor.vv v0, %1, %1\n\t" - "vsetvli x0, %3, e32,m8 \n\t" - "vfrsub.vf %0, %0, %2, v0.t \n\t" - :"+v"(vx1) - :"v"(mask1), "f"(zero), "r"(gvl) - :"v0"); -#endif -*/ - v_max = VFADDVV_FLOAT(vx0, vx1, gvl); - v_res = VFREDMAXVS_FLOAT(v_res, v_max, v_z0, gvl); - FLOAT cur_maxf = VFMVFS_FLOAT(v_res); + v_max = VLSEV_FLOAT(&x[idx], stride_x, gvl); + vx2 = VLSEV_FLOAT(&x[idx+1], stride_x, gvl); + v_max = VFABS_FLOAT(v_max, gvl); + vx2 = VFABS_FLOAT(vx2, gvl); + v_max = VFADDVV_FLOAT(v_max, vx2, gvl); + + v_res = VFREDMAXVS_FLOAT(v_max, v_res, gvl); + FLOAT cur_maxf = EXTRACT_FLOAT(v_res); + if(cur_maxf > maxf){ //tail index v_max_index = VIDV_UINT(gvl); v_max_index = VADDVX_UINT(v_max_index, j, gvl); - mask0 = VMFGEVF_FLOAT(v_max, cur_maxf, gvl); - max_index = VMFIRSTM(mask0,gvl); - VSEVU_UINT(temp_uint,v_max_index,gvl); - max_index = temp_uint[max_index]; - + mask = VMFGEVF_FLOAT(v_max, cur_maxf, gvl); + UINT_V_T compressed; + compressed = VCOMPRESS(v_max_index, mask, gvl); + max_index = VMV_X(compressed); } } - return(max_index+1); -} - + return(max_index+1); +} diff --git a/kernel/riscv64/izamin_vector.c b/kernel/riscv64/izamin_vector.c index 818193a9e..74daf32b8 100644 --- a/kernel/riscv64/izamin_vector.c +++ b/kernel/riscv64/izamin_vector.c @@ -31,235 +31,128 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #if defined(DOUBLE) -#define VSETVL(n) vsetvl_e64m8(n) -#define VSETVL_MAX vsetvlmax_e64m1() +#define VSETVL(n) __riscv_vsetvl_e64m8(n) #define FLOAT_V_T vfloat64m8_t #define FLOAT_V_T_M1 vfloat64m1_t -#define VFMVFS_FLOAT vfmv_f_s_f64m1_f64 -#define VLSEV_FLOAT vlse64_v_f64m8 -#define VFREDMINVS_FLOAT vfredmin_vs_f64m8_f64m1 +#define VLEV_FLOAT __riscv_vle64_v_f64m8 +#define VLSEV_FLOAT __riscv_vlse64_v_f64m8 +#define VFREDMINVS_FLOAT __riscv_vfredmin_vs_f64m8_f64m1 #define MASK_T vbool8_t -#define VMFLTVF_FLOAT vmflt_vf_f64m8_b8 -#define VMFLTVV_FLOAT vmflt_vv_f64m8_b8 -#define VFMVVF_FLOAT vfmv_v_f_f64m8 -#define VFMVVF_FLOAT_M1 vfmv_v_f_f64m1 -#define VFRSUBVF_MASK_FLOAT vfrsub_vf_f64m8_m -#define VFMINVV_FLOAT vfmin_vv_f64m8 -#define VMFLEVF_FLOAT vmfle_vf_f64m8_b8 -#define VMFIRSTM vmfirst_m_b8 +#define VMFGTVV_FLOAT __riscv_vmfgt_vv_f64m8_b8 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m8 +#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f64m1 +#define VFMINVV_FLOAT __riscv_vfmin_vv_f64m8 +#define VMFLEVF_FLOAT __riscv_vmfle_vf_f64m8_b8 +#define VMFIRSTM __riscv_vfirst_m_b8 #define UINT_V_T vuint64m8_t #define VSEVU_UINT vse64_v_u64m8 #define UINT_T long unsigned int -#define VIDV_MASK_UINT vid_v_u64m8_m -#define VIDV_UINT vid_v_u64m8 -#define VADDVX_MASK_UINT vadd_vx_u64m8_m -#define VADDVX_UINT vadd_vx_u64m8 -#define VFADDVV_FLOAT vfadd_vv_f64m8 -#define VMVVX_UINT vmv_v_x_u64m8 +#define VIDV_MASK_UINT __riscv_vid_v_u64m8_mu +#define VIDV_UINT __riscv_vid_v_u64m8 +#define VADDVX_MASK_UINT __riscv_vadd_vx_u64m8_mu +#define VADDVX_UINT __riscv_vadd_vx_u64m8 +#define VMVVX_UINT __riscv_vmv_v_x_u64m8 +#define VFABS_FLOAT __riscv_vfabs_v_f64m8 +#define VFADDVV_FLOAT __riscv_vfadd_vv_f64m8 +#define VCOMPRESS __riscv_vcompress_vm_u64m8 +#define VMV_X __riscv_vmv_x_s_u64m8_u64 #else -#define ABS fabsf -#define VSETVL(n) vsetvl_e32m8(n) -#define VSETVL_MAX vsetvlmax_e32m1() +#define VSETVL(n) __riscv_vsetvl_e32m8(n) #define FLOAT_V_T vfloat32m8_t #define FLOAT_V_T_M1 vfloat32m1_t -#define VFMVFS_FLOAT vfmv_f_s_f32m1_f32 -#define VLSEV_FLOAT vlse32_v_f32m8 -#define VFREDMINVS_FLOAT vfredmin_vs_f32m8_f32m1 +#define VLEV_FLOAT __riscv_vle32_v_f32m8 +#define VLSEV_FLOAT __riscv_vlse32_v_f32m8 +#define VFREDMINVS_FLOAT __riscv_vfredmin_vs_f32m8_f32m1 #define MASK_T vbool4_t -#define VMFLTVF_FLOAT vmflt_vf_f32m8_b4 -#define VMFLTVV_FLOAT vmflt_vv_f32m8_b4 -#define VFMVVF_FLOAT vfmv_v_f_f32m8 -#define VFMVVF_FLOAT_M1 vfmv_v_f_f32m1 -#define VFRSUBVF_MASK_FLOAT vfrsub_vf_f32m8_m -#define VFMINVV_FLOAT vfmin_vv_f32m8 -#define VMFLEVF_FLOAT vmfle_vf_f32m8_b4 -#define VMFIRSTM vmfirst_m_b4 +#define VMFGTVV_FLOAT __riscv_vmfgt_vv_f32m8_b4 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m8 +#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f32m1 +#define VFMINVV_FLOAT __riscv_vfmin_vv_f32m8 +#define VMFLEVF_FLOAT __riscv_vmfle_vf_f32m8_b4 +#define VMFIRSTM __riscv_vfirst_m_b4 #define UINT_V_T vuint32m8_t #define UINT_T unsigned int -#define VSEVU_UINT vse32_v_u32m8 -#define VIDV_MASK_UINT vid_v_u32m8_m -#define VIDV_UINT vid_v_u32m8 -#define VADDVX_MASK_UINT vadd_vx_u32m8_m -#define VADDVX_UINT vadd_vx_u32m8 -#define VFADDVV_FLOAT vfadd_vv_f32m8 -#define VMVVX_UINT vmv_v_x_u32m8 +#define VSEVU_UINT __riscv_vse32_v_u32m8 +#define VIDV_MASK_UINT __riscv_vid_v_u32m8_mu +#define VIDV_UINT __riscv_vid_v_u32m8 +#define VADDVX_MASK_UINT __riscv_vadd_vx_u32m8_mu +#define VADDVX_UINT __riscv_vadd_vx_u32m8 +#define VMVVX_UINT __riscv_vmv_v_x_u32m8 +#define VFABS_FLOAT __riscv_vfabs_v_f32m8 +#define VFADDVV_FLOAT __riscv_vfadd_vv_f32m8 +#define VCOMPRESS __riscv_vcompress_vm_u32m8 +#define VMV_X __riscv_vmv_x_s_u32m8_u32 #endif BLASLONG CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) { - BLASLONG i=0, j=0; - FLOAT minf=FLT_MAX; + BLASLONG i=0, j=0; unsigned int min_index = 0; - if (n <= 0 || inc_x <= 0) return(min_index); + if (n <= 0 || inc_x <= 0) return(min_index); + FLOAT minf=FLT_MAX; - FLOAT_V_T vx0, vx1, v_min; + FLOAT_V_T vx, vx2, v_min; UINT_V_T v_min_index; - MASK_T mask0, mask1; + MASK_T mask; unsigned int gvl = 0; - FLOAT_V_T_M1 v_res, v_max; - gvl = VSETVL_MAX; - v_res = VFMVVF_FLOAT_M1(0, gvl); - v_max = VFMVVF_FLOAT_M1(FLT_MAX, gvl); + FLOAT_V_T_M1 v_res; + v_res = VFMVVF_FLOAT_M1(FLT_MAX, 1); gvl = VSETVL(n); - UINT_T temp_uint[gvl]; - v_min_index = VMVVX_UINT(0, gvl); + unsigned int stride_x = inc_x * 2 * sizeof(FLOAT); + unsigned int idx = 0, inc_v = gvl * inc_x * 2; + v_min = VFMVVF_FLOAT(FLT_MAX, gvl); - BLASLONG stride_x = inc_x * 2 * sizeof(FLOAT); - BLASLONG inc_xv = gvl * inc_x * 2; - BLASLONG ix = 0; + v_min_index = VMVVX_UINT(0, gvl); for(i=0,j=0; i < n/gvl; i++){ - vx0 = VLSEV_FLOAT(&x[ix], stride_x, gvl); - //fabs(vector) - mask0 = VMFLTVF_FLOAT(vx0, 0, gvl); - vx0 = VFRSUBVF_MASK_FLOAT(mask0, vx0, vx0, 0, gvl); -/* -#if defined(DOUBLE) -asm volatile( - "vor.vv v0, %1, %1\n\t" - "vsetvli x0, %3, e64,m8 \n\t" - "vfrsub.vf %0, %0, %2, v0.t \n\t" - :"+v"(vx0) - :"v"(mask0), "f"(zero), "r"(gvl) - :"v0"); -#else -asm volatile( - "vor.vv v0, %1, %1\n\t" - "vsetvli x0, %3, e32,m8 \n\t" - "vfrsub.vf %0, %0, %2, v0.t \n\t" - :"+v"(vx0) - :"v"(mask0), "f"(zero), "r"(gvl) - :"v0"); -#endif -*/ - vx1 = VLSEV_FLOAT(&x[ix+1], stride_x, gvl); - //fabs(vector) - mask1 = VMFLTVF_FLOAT(vx1, 0, gvl); - vx1 = VFRSUBVF_MASK_FLOAT(mask1, vx1, vx1, 0, gvl); -/* -#if defined(DOUBLE) -asm volatile( - "vor.vv v0, %1, %1\n\t" - "vsetvli x0, %3, e64,m8 \n\t" - "vfrsub.vf %0, %0, %2, v0.t \n\t" - :"+v"(vx1) - :"v"(mask1), "f"(zero), "r"(gvl) - :"v0"); -#else -asm volatile( - "vor.vv v0, %1, %1\n\t" - "vsetvli x0, %3, e32,m8 \n\t" - "vfrsub.vf %0, %0, %2, v0.t \n\t" - :"+v"(vx1) - :"v"(mask1), "f"(zero), "r"(gvl) - :"v0"); -#endif -*/ - vx0 = VFADDVV_FLOAT(vx0, vx1, gvl); + vx = VLSEV_FLOAT(&x[idx], stride_x, gvl); + vx2 = VLSEV_FLOAT(&x[idx+1], stride_x, gvl); + vx = VFABS_FLOAT(vx, gvl); + vx2 = VFABS_FLOAT(vx2, gvl); + vx = VFADDVV_FLOAT(vx, vx2, gvl); - //index where element less than v_min - mask0 = VMFLTVV_FLOAT(vx0, v_min, gvl); - v_min_index = VIDV_MASK_UINT(mask0, v_min_index, gvl); -/* -#if defined(DOUBLE) -asm volatile( - "vor.vv v0, %1, %1 \n\t" - "vsetvli x0, %2, e64,m8 \n\t" - "vid.v %0, v0.t \n\t" - :"+v"(v_min_index) - :"v"(mask0), "r"(gvl) - :"v0"); -#else -asm volatile( - "vor.vv v0, %1, %1 \n\t" - "vsetvli x0, %2, e32,m8 \n\t" - "vid.v %0, v0.t \n\t" - :"+v"(v_min_index) - :"v"(mask0), "r"(gvl) - :"v0"); -#endif -*/ - v_min_index = VADDVX_MASK_UINT(mask0, v_min_index, v_min_index, j, gvl); + + //index where element greater than v_min + mask = VMFGTVV_FLOAT(v_min, vx, gvl); + v_min_index = VIDV_MASK_UINT(mask, v_min_index, gvl); + v_min_index = VADDVX_MASK_UINT(mask, v_min_index, v_min_index, j, gvl); //update v_min and start_index j - v_min = VFMINVV_FLOAT(v_min, vx0, gvl); + v_min = VFMINVV_FLOAT(v_min, vx, gvl); j += gvl; - ix += inc_xv; + idx += inc_v; } - v_res = VFREDMINVS_FLOAT(v_res, v_min, v_max, gvl); - minf = VFMVFS_FLOAT(v_res); - mask0 = VMFLEVF_FLOAT(v_min, minf, gvl); - min_index = VMFIRSTM(mask0,gvl); - VSEVU_UINT(temp_uint,v_min_index,gvl); - min_index = temp_uint[min_index]; + + v_res = VFREDMINVS_FLOAT(v_min, v_res, gvl); + minf = EXTRACT_FLOAT(v_res); + mask = VMFLEVF_FLOAT(v_min, minf, gvl); + UINT_V_T compressed; + compressed = VCOMPRESS(v_min_index, mask, gvl); + min_index = VMV_X(compressed); if(j < n){ gvl = VSETVL(n-j); - v_min_index = VMVVX_UINT(0, gvl); - vx0 = VLSEV_FLOAT(&x[ix], stride_x, gvl); - //fabs(vector) - mask0 = VMFLTVF_FLOAT(vx0, 0, gvl); - vx0 = VFRSUBVF_MASK_FLOAT(mask0, vx0, vx0, 0, gvl); -/* -#if defined(DOUBLE) -asm volatile( - "vor.vv v0, %1, %1\n\t" - "vsetvli x0, %3, e64,m8 \n\t" - "vfrsub.vf %0, %0, %2, v0.t \n\t" - :"+v"(vx0) - :"v"(mask0), "f"(zero), "r"(gvl) - :"v0"); -#else -asm volatile( - "vor.vv v0, %1, %1\n\t" - "vsetvli x0, %3, e32,m8 \n\t" - "vfrsub.vf %0, %0, %2, v0.t \n\t" - :"+v"(vx0) - :"v"(mask0), "f"(zero), "r"(gvl) - :"v0"); -#endif -*/ - vx1 = VLSEV_FLOAT(&x[ix+1], stride_x, gvl); - //fabs(vector) - mask1 = VMFLTVF_FLOAT(vx1, 0, gvl); - vx1 = VFRSUBVF_MASK_FLOAT(mask1, vx1, vx1, 0, gvl); -/* -#if defined(DOUBLE) -asm volatile( - "vor.vv v0, %1, %1\n\t" - "vsetvli x0, %3, e64,m8 \n\t" - "vfrsub.vf %0, %0, %2, v0.t \n\t" - :"+v"(vx1) - :"v"(mask1), "f"(zero), "r"(gvl) - :"v0"); -#else -asm volatile( - "vor.vv v0, %1, %1\n\t" - "vsetvli x0, %3, e32,m8 \n\t" - "vfrsub.vf %0, %0, %2, v0.t \n\t" - :"+v"(vx1) - :"v"(mask1), "f"(zero), "r"(gvl) - :"v0"); -#endif -*/ - v_min = VFADDVV_FLOAT(vx0, vx1, gvl); - v_res = VFREDMINVS_FLOAT(v_res, v_min, v_max, gvl); - FLOAT cur_minf = VFMVFS_FLOAT(v_res); - if(cur_minf < minf){ + v_min = VLSEV_FLOAT(&x[idx], stride_x, gvl); + vx2 = VLSEV_FLOAT(&x[idx+1], stride_x, gvl); + v_min = VFABS_FLOAT(v_min, gvl); + vx2 = VFABS_FLOAT(vx2, gvl); + v_min = VFADDVV_FLOAT(v_min, vx2, gvl); + + v_res = VFREDMINVS_FLOAT(v_min, v_res, gvl); + FLOAT cur_minf = EXTRACT_FLOAT(v_res); + if(cur_minf > minf){ //tail index v_min_index = VIDV_UINT(gvl); v_min_index = VADDVX_UINT(v_min_index, j, gvl); - mask0 = VMFLEVF_FLOAT(v_min, cur_minf, gvl); - min_index = VMFIRSTM(mask0,gvl); - VSEVU_UINT(temp_uint,v_min_index,gvl); - min_index = temp_uint[min_index]; - + mask = VMFLEVF_FLOAT(v_min, cur_minf, gvl); + UINT_V_T compressed; + compressed = VCOMPRESS(v_min_index, mask, gvl); + min_index = VMV_X(compressed); } } - return(min_index+1); -} - + return(min_index+1); +} diff --git a/kernel/riscv64/max_vector.c b/kernel/riscv64/max_vector.c index 7f31e9a53..97f602e51 100644 --- a/kernel/riscv64/max_vector.c +++ b/kernel/riscv64/max_vector.c @@ -28,30 +28,44 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include "common.h" #include #include -#if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m8(n) -#define VSETVL_MAX vsetvlmax_e32m1() -#define FLOAT_V_T vfloat32m8_t -#define FLOAT_V_T_M1 vfloat32m1_t -#define VLEV_FLOAT vle32_v_f32m8 -#define VLSEV_FLOAT vlse32_v_f32m8 -#define VFREDMAXVS_FLOAT vfredmax_vs_f32m8_f32m1 -#define VFMVVF_FLOAT vfmv_v_f_f32m8 -#define VFMVVF_FLOAT_M1 vfmv_v_f_f32m1 -#define VFMAXVV_FLOAT vfmax_vv_f32m8 + +#ifdef RISCV64_ZVL256B +# define LMUL m2 +# if defined(DOUBLE) +# define ELEN 64 +# define MLEN 32 +# else +# define ELEN 32 +# define MLEN 16 +# endif #else -#define VSETVL(n) vsetvl_e64m8(n) -#define VSETVL_MAX vsetvlmax_e64m1() -#define FLOAT_V_T vfloat64m8_t -#define FLOAT_V_T_M1 vfloat64m1_t -#define VLEV_FLOAT vle64_v_f64m8 -#define VLSEV_FLOAT vlse64_v_f64m8 -#define VFREDMAXVS_FLOAT vfredmax_vs_f64m8_f64m1 -#define VFMVVF_FLOAT vfmv_v_f_f64m8 -#define VFMVVF_FLOAT_M1 vfmv_v_f_f64m1 -#define VFMAXVV_FLOAT vfmax_vv_f64m8 +# define LMUL m8 +# if defined(DOUBLE) +# define ELEN 64 +# define MLEN 8 +# else +# define ELEN 32 +# define MLEN 4 +# endif #endif +#define _ +#define JOIN2_X(x, y) x ## y +#define JOIN2(x, y) JOIN2_X(x, y) +#define JOIN(v, w, x, y, z) JOIN2( JOIN2( JOIN2( JOIN2( v, w ), x), y), z) + +#define VSETVL JOIN(__riscv_vsetvl, _e, ELEN, LMUL, _) +#define FLOAT_V_T JOIN(vfloat, ELEN, LMUL, _t, _) +#define FLOAT_V_T_M1 JOIN(vfloat, ELEN, m1, _t, _) +#define VLEV_FLOAT JOIN(__riscv_vle, ELEN, _v_f, ELEN, LMUL) +#define VLSEV_FLOAT JOIN(__riscv_vlse, ELEN, _v_f, ELEN, LMUL) +#define VFREDMAXVS_FLOAT JOIN(__riscv_vfredmax_vs_f, ELEN, LMUL, _f, JOIN2( ELEN, m1)) +#define MASK_T JOIN(vbool, MLEN, _t, _, _) +#define VMFLTVF_FLOAT JOIN(__riscv_vmflt_vf_f, ELEN, LMUL, _b, MLEN) +#define VFMVVF_FLOAT JOIN(__riscv_vfmv, _v_f_f, ELEN, LMUL, _) +#define VFMVVF_FLOAT_M1 JOIN(__riscv_vfmv, _v_f_f, ELEN, m1, _) +#define VFMAXVV_FLOAT JOIN(__riscv_vfmax, _vv_f, ELEN, LMUL, _) + FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) { BLASLONG i=0, j=0; @@ -59,10 +73,8 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) FLOAT maxf=-FLT_MAX; unsigned int gvl = 0; FLOAT_V_T v0, v1, v_max; - FLOAT_V_T_M1 v_res, v_min; - gvl = VSETVL_MAX; - v_res = VFMVVF_FLOAT_M1(0, gvl); - v_min = VFMVVF_FLOAT_M1(-FLT_MAX, gvl); + FLOAT_V_T_M1 v_res; + v_res = VFMVVF_FLOAT_M1(-FLT_MAX, 1); if(inc_x == 1){ gvl = VSETVL(n); @@ -76,15 +88,12 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) v_max = VFMAXVV_FLOAT(v_max, v1, gvl); j += gvl * 2; } - v_res = VFREDMAXVS_FLOAT(v_res, v_max, v_min, gvl); - maxf = *((FLOAT*)&v_res); + v_res = VFREDMAXVS_FLOAT(v_max, v_res, gvl); } for(;j maxf) - maxf = *((FLOAT*)&v_res); + v_res = VFREDMAXVS_FLOAT(v0, v_res, gvl); j += gvl; } }else{ @@ -102,18 +111,16 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) j += gvl * 2; idx += inc_xv * 2; } - v_res = VFREDMAXVS_FLOAT(v_res, v_max, v_min, gvl); - maxf = *((FLOAT*)&v_res); + v_res = VFREDMAXVS_FLOAT(v_max, v_res, gvl); } for(;j maxf) - maxf = *((FLOAT*)&v_res); + v_res = VFREDMAXVS_FLOAT(v0, v_res, gvl); j += gvl; } } + maxf = EXTRACT_FLOAT(v_res); return(maxf); } diff --git a/kernel/riscv64/min_vector.c b/kernel/riscv64/min_vector.c index 14b7e01ed..77bf19b9d 100644 --- a/kernel/riscv64/min_vector.c +++ b/kernel/riscv64/min_vector.c @@ -28,30 +28,44 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include "common.h" #include #include -#if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m8(n) -#define VSETVL_MAX vsetvlmax_e32m1() -#define FLOAT_V_T vfloat32m8_t -#define FLOAT_V_T_M1 vfloat32m1_t -#define VLEV_FLOAT vle32_v_f32m8 -#define VLSEV_FLOAT vlse32_v_f32m8 -#define VFREDMINVS_FLOAT vfredmin_vs_f32m8_f32m1 -#define VFMVVF_FLOAT vfmv_v_f_f32m8 -#define VFMVVF_FLOAT_M1 vfmv_v_f_f32m1 -#define VFMINVV_FLOAT vfmin_vv_f32m8 + +#ifdef RISCV64_ZVL256B +# define LMUL m2 +# if defined(DOUBLE) +# define ELEN 64 +# define MLEN 32 +# else +# define ELEN 32 +# define MLEN 16 +# endif #else -#define VSETVL(n) vsetvl_e64m8(n) -#define VSETVL_MAX vsetvlmax_e64m1() -#define FLOAT_V_T vfloat64m8_t -#define FLOAT_V_T_M1 vfloat64m1_t -#define VLEV_FLOAT vle64_v_f64m8 -#define VLSEV_FLOAT vlse64_v_f64m8 -#define VFREDMINVS_FLOAT vfredmin_vs_f64m8_f64m1 -#define VFMVVF_FLOAT vfmv_v_f_f64m8 -#define VFMVVF_FLOAT_M1 vfmv_v_f_f64m1 -#define VFMINVV_FLOAT vfmin_vv_f64m8 +# define LMUL m8 +# if defined(DOUBLE) +# define ELEN 64 +# define MLEN 8 +# else +# define ELEN 32 +# define MLEN 4 +# endif #endif +#define _ +#define JOIN2_X(x, y) x ## y +#define JOIN2(x, y) JOIN2_X(x, y) +#define JOIN(v, w, x, y, z) JOIN2( JOIN2( JOIN2( JOIN2( v, w ), x), y), z) + +#define VSETVL JOIN(__riscv_vsetvl, _e, ELEN, LMUL, _) +#define FLOAT_V_T JOIN(vfloat, ELEN, LMUL, _t, _) +#define FLOAT_V_T_M1 JOIN(vfloat, ELEN, m1, _t, _) +#define VLEV_FLOAT JOIN(__riscv_vle, ELEN, _v_f, ELEN, LMUL) +#define VLSEV_FLOAT JOIN(__riscv_vlse, ELEN, _v_f, ELEN, LMUL) +#define VFREDMINVS_FLOAT JOIN(__riscv_vfredmin_vs_f, ELEN, LMUL, _f, JOIN2( ELEN, m1)) +#define MASK_T JOIN(vbool, MLEN, _t, _, _) +#define VMFLTVF_FLOAT JOIN(__riscv_vmflt_vf_f, ELEN, LMUL, _b, MLEN) +#define VFMVVF_FLOAT JOIN(__riscv_vfmv, _v_f_f, ELEN, LMUL, _) +#define VFMVVF_FLOAT_M1 JOIN(__riscv_vfmv, _v_f_f, ELEN, m1, _) +#define VFMINVV_FLOAT JOIN(__riscv_vfmin, _vv_f, ELEN, LMUL, _) + FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) { BLASLONG i=0, j=0; @@ -59,10 +73,8 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) FLOAT minf=FLT_MAX; unsigned int gvl = 0; FLOAT_V_T v0, v1, v_min; - FLOAT_V_T_M1 v_res, v_max; - gvl = VSETVL_MAX; - v_res = VFMVVF_FLOAT_M1(0, gvl); - v_max = VFMVVF_FLOAT_M1(FLT_MAX, gvl); + FLOAT_V_T_M1 v_res; + v_res = VFMVVF_FLOAT_M1(FLT_MAX, 1); if(inc_x == 1){ gvl = VSETVL(n); @@ -76,15 +88,12 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) v_min = VFMINVV_FLOAT(v_min, v1, gvl); j += gvl * 2; } - v_res = VFREDMINVS_FLOAT(v_res, v_min, v_max, gvl); - minf = *((FLOAT*)&v_res); + v_res = VFREDMINVS_FLOAT(v_min, v_res, gvl); } for(;j= gvl ) // don't pay overheads if we're not doing useful work + { + for(i=0; i + +#if !defined(DOUBLE) +#define VSETVL(n) __riscv_vsetvl_e32m8(n) +#define VSETVL_MAX __riscv_vsetvlmax_e32m1() +#define FLOAT_V_T vfloat32m8_t +#define FLOAT_V_T_M1 vfloat32m1_t +#define VLEV_FLOAT __riscv_vle32_v_f32m8 +#define VLSEV_FLOAT __riscv_vlse32_v_f32m8 +#define VFREDSUMVS_FLOAT __riscv_vfredusum_vs_f32m8_f32m1 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m8 +#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f32m1 +#define VFADDVV_FLOAT __riscv_vfadd_vv_f32m8 +#else +#define VSETVL(n) __riscv_vsetvl_e64m8(n) +#define VSETVL_MAX __riscv_vsetvlmax_e64m1() +#define FLOAT_V_T vfloat64m8_t +#define FLOAT_V_T_M1 vfloat64m1_t +#define VLEV_FLOAT __riscv_vle64_v_f64m8 +#define VLSEV_FLOAT __riscv_vlse64_v_f64m8 +#define VFREDSUMVS_FLOAT __riscv_vfredusum_vs_f64m8_f64m1 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m8 +#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f64m1 +#define VFADDVV_FLOAT __riscv_vfadd_vv_f64m8 +#endif +FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) +{ + BLASLONG i=0, j=0; + BLASLONG ix=0; + FLOAT asumf=0.0; + if (n <= 0 || inc_x <= 0) return(asumf); + unsigned int gvl = 0; + FLOAT_V_T v0, v1, v_sum; + FLOAT_V_T_M1 v_res; + gvl = VSETVL_MAX; + v_res = VFMVVF_FLOAT_M1(0, gvl); + + if(inc_x == 1){ + gvl = VSETVL(n); + if(gvl <= n/2){ + v_sum = VFMVVF_FLOAT(0, gvl); + for(i=0,j=0; i -#if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m8(n) -#define VSETVL_MAX vsetvlmax_e32m1() -#define FLOAT_V_T vfloat32m8_t -#define VLEV_FLOAT vle32_v_f32m8 -#define VLSEV_FLOAT vlse32_v_f32m8 -#define VSEV_FLOAT vse32_v_f32m8 -#define VSSEV_FLOAT vsse32_v_f32m8 + +#ifdef RISCV64_ZVL256B +# define LMUL m2 +# if defined(DOUBLE) +# define ELEN 64 +# define MLEN 32 +# else +# define ELEN 32 +# define MLEN 16 +# endif #else -#define VSETVL(n) vsetvl_e64m8(n) -#define VSETVL_MAX vsetvlmax_e64m1() -#define FLOAT_V_T vfloat64m8_t -#define VLEV_FLOAT vle64_v_f64m8 -#define VLSEV_FLOAT vlse64_v_f64m8 -#define VSEV_FLOAT vse64_v_f64m8 -#define VSSEV_FLOAT vsse64_v_f64m8 +# define LMUL m8 +# if defined(DOUBLE) +# define ELEN 64 +# define MLEN 8 +# else +# define ELEN 32 +# define MLEN 4 +# endif #endif +#define _ +#define JOIN2_X(x, y) x ## y +#define JOIN2(x, y) JOIN2_X(x, y) +#define JOIN(v, w, x, y, z) JOIN2( JOIN2( JOIN2( JOIN2( v, w ), x), y), z) + +#define VSETVL JOIN(__riscv_vsetvl, _e, ELEN, LMUL, _) +#define FLOAT_V_T JOIN(vfloat, ELEN, LMUL, _t, _) +#define VLEV_FLOAT JOIN(__riscv_vle, ELEN, _v_f, ELEN, LMUL) +#define VLSEV_FLOAT JOIN(__riscv_vlse, ELEN, _v_f, ELEN, LMUL) +#define VSEV_FLOAT JOIN(__riscv_vse, ELEN, _v_f, ELEN, LMUL) +#define VSSEV_FLOAT JOIN(__riscv_vsse, ELEN, _v_f, ELEN, LMUL) + int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT dummy3, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y, FLOAT *dummy, BLASLONG dummy2) { BLASLONG i = 0, j = 0; BLASLONG ix = 0,iy = 0; BLASLONG stride_x, stride_y; FLOAT_V_T vx0, vx1, vy0, vy1; - unsigned int gvl = 0; if (n < 0) return(0); + + unsigned int gvl = VSETVL((inc_x != 0 && inc_y != 0) ? n : 1); + if( inc_x == 0 && inc_y == 0 ) { n = n & 1; } + if(inc_x == 1 && inc_y == 1){ - gvl = VSETVL(n); if(gvl <= n/2){ for(i=0,j=0; i -#if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m8(n) -#define VSETVL_MAX vsetvlmax_e32m1() -#define FLOAT_V_T vfloat32m8_t -#define FLOAT_V_T_M1 vfloat32m1_t -#define VFMVFS_FLOAT vfmv_f_s_f32m1_f32 -#define VLSEV_FLOAT vlse32_v_f32m8 -#define VFREDMAXVS_FLOAT vfredmax_vs_f32m8_f32m1 -#define MASK_T vbool4_t -#define VMFLTVF_FLOAT vmflt_vf_f32m8_b4 -#define VFMVVF_FLOAT vfmv_v_f_f32m8 -#define VFMVVF_FLOAT_M1 vfmv_v_f_f32m1 -#define VFRSUBVF_MASK_FLOAT vfrsub_vf_f32m8_m -#define VFMAXVV_FLOAT vfmax_vv_f32m8 -#define VFADDVV_FLOAT vfadd_vv_f32m8 - +#ifdef RISCV64_ZVL256B +# define LMUL m2 +# if defined(DOUBLE) +# define ELEN 64 +# define MLEN 32 +# else +# define ELEN 32 +# define MLEN 16 +# endif #else -#define VSETVL(n) vsetvl_e64m8(n) -#define VSETVL_MAX vsetvlmax_e64m1() -#define FLOAT_V_T vfloat64m8_t -#define FLOAT_V_T_M1 vfloat64m1_t -#define VFMVFS_FLOAT vfmv_f_s_f64m1_f64 -#define VLSEV_FLOAT vlse64_v_f64m8 -#define VFREDMAXVS_FLOAT vfredmax_vs_f64m8_f64m1 -#define MASK_T vbool8_t -#define VMFLTVF_FLOAT vmflt_vf_f64m8_b8 -#define VFMVVF_FLOAT vfmv_v_f_f64m8 -#define VFMVVF_FLOAT_M1 vfmv_v_f_f64m1 -#define VFRSUBVF_MASK_FLOAT vfrsub_vf_f64m8_m -#define VFMAXVV_FLOAT vfmax_vv_f64m8 -#define VFADDVV_FLOAT vfadd_vv_f64m8 - +# define LMUL m8 +# if defined(DOUBLE) +# define ELEN 64 +# define MLEN 8 +# else +# define ELEN 32 +# define MLEN 4 +# endif #endif +#define _ +#define JOIN2_X(x, y) x ## y +#define JOIN2(x, y) JOIN2_X(x, y) +#define JOIN(v, w, x, y, z) JOIN2( JOIN2( JOIN2( JOIN2( v, w ), x), y), z) + +#define VSETVL JOIN(__riscv_vsetvl, _e, ELEN, LMUL, _) +#define FLOAT_V_T JOIN(vfloat, ELEN, LMUL, _t, _) +#define FLOAT_V_T_M1 JOIN(vfloat, ELEN, m1, _t, _) +#define VLEV_FLOAT JOIN(__riscv_vle, ELEN, _v_f, ELEN, LMUL) +#define VLSEV_FLOAT JOIN(__riscv_vlse, ELEN, _v_f, ELEN, LMUL) +#define VFREDMAXVS_FLOAT JOIN(__riscv_vfredmax_vs_f, ELEN, LMUL, _f, JOIN2( ELEN, m1)) +#define MASK_T JOIN(vbool, MLEN, _t, _, _) +#define VMFLTVF_FLOAT JOIN(__riscv_vmflt_vf_f, ELEN, LMUL, _b, MLEN) +#define VFMVVF_FLOAT JOIN(__riscv_vfmv, _v_f_f, ELEN, LMUL, _) +#define VFMVVF_FLOAT_M1 JOIN(__riscv_vfmv, _v_f_f, ELEN, m1, _) +#define VFRSUBVF_MASK_FLOAT JOIN(__riscv_vfrsub,_vf_f, ELEN, LMUL, _m) +#define VFMAXVV_FLOAT JOIN(__riscv_vfmax, _vv_f, ELEN, LMUL, _) +#define VFADDVV_FLOAT JOIN(__riscv_vfadd, _vv_f, ELEN, LMUL, _) + FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) { BLASLONG i=0, j=0; @@ -70,10 +75,8 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) if (n <= 0 || inc_x <= 0) return(maxf); unsigned int gvl = 0; FLOAT_V_T v0, v1, v_max; - FLOAT_V_T_M1 v_res, v_z0; - gvl = VSETVL_MAX; - v_res = VFMVVF_FLOAT_M1(0, gvl); - v_z0 = VFMVVF_FLOAT_M1(0, gvl); + FLOAT_V_T_M1 v_res; + v_res = VFMVVF_FLOAT_M1(0, 1); MASK_T mask0, mask1; BLASLONG stride_x = inc_x * sizeof(FLOAT) * 2; @@ -84,9 +87,9 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) v0 = VLSEV_FLOAT(&x[ix], stride_x, gvl); v1 = VLSEV_FLOAT(&x[ix+1], stride_x, gvl); mask0 = VMFLTVF_FLOAT(v0, 0, gvl); - v0 = VFRSUBVF_MASK_FLOAT(mask0, v0, v0, 0, gvl); + v0 = VFRSUBVF_MASK_FLOAT(mask0, v0, 0, gvl); mask1 = VMFLTVF_FLOAT(v1, 0, gvl); - v1 = VFRSUBVF_MASK_FLOAT(mask1, v1, v1, 0, gvl); + v1 = VFRSUBVF_MASK_FLOAT(mask1, v1, 0, gvl); v0 = VFADDVV_FLOAT(v0, v1, gvl); v_max = VFMAXVV_FLOAT(v_max, v0, gvl); @@ -94,22 +97,19 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) j += gvl; ix += inc_xv; } - v_res = VFREDMAXVS_FLOAT(v_res, v_max, v_z0, gvl); - maxf = VFMVFS_FLOAT(v_res); + v_res = VFREDMAXVS_FLOAT(v_max, v_res, gvl); if(j maxf) - maxf = VFMVFS_FLOAT(v_res); + v_res = VFREDMAXVS_FLOAT(v1, v_res, gvl); } + maxf = EXTRACT_FLOAT(v_res); return(maxf); } diff --git a/kernel/riscv64/zamin_vector.c b/kernel/riscv64/zamin_vector.c index d9eca7f10..095b1c3df 100644 --- a/kernel/riscv64/zamin_vector.c +++ b/kernel/riscv64/zamin_vector.c @@ -29,38 +29,46 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include #include -#if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m8(n) -#define VSETVL_MAX vsetvlmax_e32m1() -#define FLOAT_V_T vfloat32m8_t -#define FLOAT_V_T_M1 vfloat32m1_t -#define VFMVFS_FLOAT vfmv_f_s_f32m1_f32 -#define VLSEV_FLOAT vlse32_v_f32m8 -#define VFREDMINVS_FLOAT vfredmin_vs_f32m8_f32m1 -#define MASK_T vbool4_t -#define VMFLTVF_FLOAT vmflt_vf_f32m8_b4 -#define VFMVVF_FLOAT vfmv_v_f_f32m8 -#define VFMVVF_FLOAT_M1 vfmv_v_f_f32m1 -#define VFRSUBVF_MASK_FLOAT vfrsub_vf_f32m8_m -#define VFMINVV_FLOAT vfmin_vv_f32m8 -#define VFADDVV_FLOAT vfadd_vv_f32m8 + +#ifdef RISCV64_ZVL256B +# define LMUL m2 +# if defined(DOUBLE) +# define ELEN 64 +# define MLEN 32 +# else +# define ELEN 32 +# define MLEN 16 +# endif #else -#define VSETVL(n) vsetvl_e64m8(n) -#define VSETVL_MAX vsetvlmax_e32m1() -#define FLOAT_V_T vfloat64m8_t -#define FLOAT_V_T_M1 vfloat64m1_t -#define VFMVFS_FLOAT vfmv_f_s_f64m1_f64 -#define VLSEV_FLOAT vlse64_v_f64m8 -#define VFREDMINVS_FLOAT vfredmin_vs_f64m8_f64m1 -#define MASK_T vbool8_t -#define VMFLTVF_FLOAT vmflt_vf_f64m8_b8 -#define VFMVVF_FLOAT vfmv_v_f_f64m8 -#define VFMVVF_FLOAT_M1 vfmv_v_f_f64m1 -#define VFRSUBVF_MASK_FLOAT vfrsub_vf_f64m8_m -#define VFMINVV_FLOAT vfmin_vv_f64m8 -#define VFADDVV_FLOAT vfadd_vv_f64m8 +# define LMUL m8 +# if defined(DOUBLE) +# define ELEN 64 +# define MLEN 8 +# else +# define ELEN 32 +# define MLEN 4 +# endif #endif +#define _ +#define JOIN2_X(x, y) x ## y +#define JOIN2(x, y) JOIN2_X(x, y) +#define JOIN(v, w, x, y, z) JOIN2( JOIN2( JOIN2( JOIN2( v, w ), x), y), z) + +#define VSETVL JOIN(__riscv_vsetvl, _e, ELEN, LMUL, _) +#define FLOAT_V_T JOIN(vfloat, ELEN, LMUL, _t, _) +#define FLOAT_V_T_M1 JOIN(vfloat, ELEN, m1, _t, _) +#define VLEV_FLOAT JOIN(__riscv_vle, ELEN, _v_f, ELEN, LMUL) +#define VLSEV_FLOAT JOIN(__riscv_vlse, ELEN, _v_f, ELEN, LMUL) +#define VFREDMINVS_FLOAT JOIN(__riscv_vfredmin_vs_f, ELEN, LMUL, _f, JOIN2( ELEN, m1)) +#define MASK_T JOIN(vbool, MLEN, _t, _, _) +#define VMFLTVF_FLOAT JOIN(__riscv_vmflt_vf_f, ELEN, LMUL, _b, MLEN) +#define VFMVVF_FLOAT JOIN(__riscv_vfmv, _v_f_f, ELEN, LMUL, _) +#define VFMVVF_FLOAT_M1 JOIN(__riscv_vfmv, _v_f_f, ELEN, m1, _) +#define VFRSUBVF_MASK_FLOAT JOIN(__riscv_vfrsub,_vf_f, ELEN, LMUL, _m) +#define VFMINVV_FLOAT JOIN(__riscv_vfmin, _vv_f, ELEN, LMUL, _) +#define VFADDVV_FLOAT JOIN(__riscv_vfadd, _vv_f, ELEN, LMUL, _) + FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) { BLASLONG i=0, j=0; @@ -69,10 +77,8 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) FLOAT minf=FLT_MAX; unsigned int gvl = 0; FLOAT_V_T v0, v1, v_min; - FLOAT_V_T_M1 v_res, v_max; - gvl = VSETVL_MAX; - v_res = VFMVVF_FLOAT_M1(0, gvl); - v_max = VFMVVF_FLOAT_M1(FLT_MAX, gvl); + FLOAT_V_T_M1 v_res; + v_res = VFMVVF_FLOAT_M1(FLT_MAX, 1); MASK_T mask0, mask1; BLASLONG stride_x = inc_x * sizeof(FLOAT) * 2; @@ -83,9 +89,9 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) v0 = VLSEV_FLOAT(&x[ix], stride_x, gvl); v1 = VLSEV_FLOAT(&x[ix+1], stride_x, gvl); mask0 = VMFLTVF_FLOAT(v0, 0, gvl); - v0 = VFRSUBVF_MASK_FLOAT(mask0, v0, v0, 0, gvl); + v0 = VFRSUBVF_MASK_FLOAT(mask0, v0, 0, gvl); mask1 = VMFLTVF_FLOAT(v1, 0, gvl); - v1 = VFRSUBVF_MASK_FLOAT(mask1, v1, v1, 0, gvl); + v1 = VFRSUBVF_MASK_FLOAT(mask1, v1, 0, gvl); v0 = VFADDVV_FLOAT(v0, v1, gvl); v_min = VFMINVV_FLOAT(v_min, v0, gvl); @@ -93,21 +99,20 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) j += gvl; ix += inc_xv; } - v_res = VFREDMINVS_FLOAT(v_res, v_min, v_max, gvl); - minf = VFMVFS_FLOAT(v_res); + v_res = VFREDMINVS_FLOAT(v_min, v_res, gvl); if(j -#if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m8(n) -#define VSETVL_MAX vsetvlmax_e32m1() -#define FLOAT_V_T vfloat32m8_t -#define FLOAT_V_T_M1 vfloat32m1_t -#define VFFMVFS_FLOAT vfmv_f_s_f32m1_f32 -#define VLEV_FLOAT vle32_v_f32m8 -#define VLSEV_FLOAT vlse32_v_f32m8 -#define VFREDSUMVS_FLOAT vfredusum_vs_f32m8_f32m1 -#define MASK_T vbool4_t -#define VMFLTVF_FLOAT vmflt_vf_f32m8_b4 -#define VFMVVF_FLOAT vfmv_v_f_f32m8 -#define VFMVVF_FLOAT_M1 vfmv_v_f_f32m1 -#define VFRSUBVF_MASK_FLOAT vfrsub_vf_f32m8_m -#define VFADDVV_FLOAT vfadd_vv_f32m8 +#ifdef RISCV64_ZVL256B +# define LMUL m2 +# if defined(DOUBLE) +# define ELEN 64 +# define MLEN _b32 +# else +# define ELEN 32 +# define MLEN _b16 +# endif #else -#define VSETVL(n) vsetvl_e64m8(n) -#define VSETVL_MAX vsetvlmax_e64m1() -#define FLOAT_V_T vfloat64m8_t -#define FLOAT_V_T_M1 vfloat64m1_t -#define VFFMVFS_FLOAT vfmv_f_s_f64m1_f64 -#define VLEV_FLOAT vle64_v_f64m8 -#define VLSEV_FLOAT vlse64_v_f64m8 -#define VFREDSUMVS_FLOAT vfredusum_vs_f64m8_f64m1 -#define MASK_T vbool8_t -#define VMFLTVF_FLOAT vmflt_vf_f64m8_b8 -#define VFMVVF_FLOAT vfmv_v_f_f64m8 -#define VFMVVF_FLOAT_M1 vfmv_v_f_f64m1 -#define VFRSUBVF_MASK_FLOAT vfrsub_vf_f64m8_m -#define VFADDVV_FLOAT vfadd_vv_f64m8 +# define LMUL m8 +# if defined(DOUBLE) +# define ELEN 64 +# define MLEN _b8 +# else +# define ELEN 32 +# define MLEN _b4 +# endif #endif + +#define _ +#define JOIN2_X(x, y) x ## y +#define JOIN2(x, y) JOIN2_X(x, y) +#define JOIN(v, w, x, y, z) JOIN2( JOIN2( JOIN2( JOIN2( v, w ), x), y), z) + +#define VSETVL JOIN(__riscv_vsetvl, _e, ELEN, LMUL, _) +#define FLOAT_V_T JOIN(vfloat, ELEN, LMUL, _t, _) +#define FLOAT_V_T_M1 JOIN(vfloat, ELEN, m1, _t, _) +#define VLEV_FLOAT JOIN(__riscv_vle, ELEN, _v_f, ELEN, LMUL) +#define VLSEV_FLOAT JOIN(__riscv_vlse, ELEN, _v_f, ELEN, LMUL) +#define VFREDSUMVS_FLOAT JOIN(__riscv_vfredusum_vs_f, ELEN, LMUL, _f, JOIN2( ELEN, m1)) +#define VFABS_FLOAT JOIN(__riscv_vfabs, _v_f, ELEN, LMUL, _) +#define VFMVVF_FLOAT JOIN(__riscv_vfmv, _v_f_f, ELEN, LMUL, _) +#define VFMVVF_FLOAT_M1 JOIN(__riscv_vfmv, _v_f_f, ELEN, m1, _) +#define VFADDVV_FLOAT JOIN(__riscv_vfadd, _vv_f, ELEN, LMUL, _) +#define VMFLTVF_FLOAT JOIN(__riscv_vmflt, _vf_f, ELEN, LMUL, MLEN) + FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) { BLASLONG i=0, j=0; @@ -67,12 +73,9 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) if (n <= 0 || inc_x <= 0) return(asumf); unsigned int gvl = 0; FLOAT_V_T v0, v1, v_zero,v_sum; - FLOAT_V_T_M1 v_res, v_z0; - gvl = VSETVL_MAX; - v_res = VFMVVF_FLOAT_M1(0, gvl); - v_z0 = VFMVVF_FLOAT_M1(0, gvl); + FLOAT_V_T_M1 v_res; + v_res = VFMVVF_FLOAT_M1(0, 1); - MASK_T mask0, mask1; if(inc_x == 1){ BLASLONG n2 = n * 2; gvl = VSETVL(n2); @@ -81,26 +84,21 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) v_sum = VFMVVF_FLOAT(0, gvl); for(i=0,j=0; i N ) + n_packing >>= 1; + + BLASLONG m_packing = UNROLL_M; + BLASLONG m_top = 0; + while (m_top < M) + { + while( m_top+m_packing > M ) + m_packing >>= 1; + + BLASLONG ai = K*m_top*2; + BLASLONG bi = K*n_top*2; + + BLASLONG pass_K = K; + + + #ifdef TRMMKERNEL + #ifdef LEFT + BLASLONG off = offset + m_top; + #else + BLASLONG off = -offset + n_top; + #endif + #ifdef BACKWARDS + ai += off * m_packing*2; + bi += off * n_packing*2; + pass_K -= off; + #else + #ifdef LEFT + pass_K = off + m_packing; + #else + pass_K = off + n_packing; + #endif + #endif + #endif + + memset( res, 0, UNROLL_M*UNROLL_N*2*sizeof(FLOAT) ); + + for (BLASLONG k=0; k 0 ){ // scale change? + // find largest element in v0 and v1 + v_res = VFREDMAX( v0, v_z0, gvl ); + v_res = VFREDMAX( v1, v_res, gvl ); + FLOAT const largest_elt = EXTRACT_FLOAT( v_res ); + + v_scale = VFDIV( v_scale, largest_elt, gvl ); // scale/largest_elt + v_scale = VFMUL( v_scale, v_scale, gvl ); // (scale/largest_elt)*(scale/largest_elt) + v_ssq = VFMUL( v_scale, v_ssq, gvl ); // ssq*(scale/largest_elt)*(scale/largest_elt) + + v_scale = VFMVVF_FLOAT( largest_elt, gvl ); // splated largest_elt becomes new scale } - //ssq in vector vr: vr[0] - v_res = VFREDSUM_FLOAT(v_res, vr, v_z0, gvl); - //total ssq now - ssq += VFMVFS_FLOAT(v_res); - //tail - if(j < n){ - gvl = VSETVL(n-j); - v0 = VLSEV_FLOAT(&x[idx], stride_x, gvl); - //fabs(vector) - mask = VMFLTVF_FLOAT(v0, 0, gvl); - v0 = VFRSUBVF_MASK_FLOAT(mask, v0, v0, 0, gvl); - //if scale change - mask = VMFGTVF_FLOAT(v0, scale, gvl); - index = VMFIRSTM(mask, gvl); - if(index == -1){//no elements greater than scale - if(scale != 0.0){ - v0 = VFDIVVF_FLOAT(v0, scale, gvl); - vr = VFMACCVV_FLOAT(v_zero, v0, v0, gvl); + MASK_T nonzero_mask0 = VMFNE( v0, 0, gvl ); + MASK_T nonzero_mask1 = VMFNE( v1, 0, gvl ); + v0 = VFDIV_M( nonzero_mask0, v_zero, v0, v_scale, gvl ); + v1 = VFDIV_M( nonzero_mask1, v_zero, v1, v_scale, gvl ); + v_ssq = VFMACC_M( nonzero_mask0, v_ssq, v0, v0, gvl ); + v_ssq = VFMACC_M( nonzero_mask1, v_ssq, v1, v1, gvl ); + + idx += inc_x * gvl * 2; + } + + v_res = VFREDUSUM(v_ssq, v_z0, gvl); + FLOAT ssq = EXTRACT_FLOAT(v_res); + FLOAT scale = EXTRACT_FLOAT0_V(v_scale); + + //finish any tail using scalar ops + i*=gvl; + if(i + +#ifdef RISCV64_ZVL256B +# define LMUL m2 +# if defined(DOUBLE) +# define ELEN 64 +# define MLEN _b32 +# else +# define ELEN 32 +# define MLEN _b16 +# endif +#else +# define LMUL m8 +# if defined(DOUBLE) +# define ELEN 64 +# define MLEN _b8 +# else +# define ELEN 32 +# define MLEN _b4 +# endif +#endif + +#define _ +#define JOIN2_X(x, y) x ## y +#define JOIN2(x, y) JOIN2_X(x, y) +#define JOIN(v, w, x, y, z) JOIN2( JOIN2( JOIN2( JOIN2( v, w ), x), y), z) + +#define VSETVL JOIN(__riscv_vsetvl, _e, ELEN, LMUL, _) +#define FLOAT_V_T JOIN(vfloat, ELEN, LMUL, _t, _) +#define FLOAT_V_T_M1 JOIN(vfloat, ELEN, m1, _t, _) +#define VLEV_FLOAT JOIN(__riscv_vle, ELEN, _v_f, ELEN, LMUL) +#define VLSEV_FLOAT JOIN(__riscv_vlse, ELEN, _v_f, ELEN, LMUL) +#define VFREDSUMVS_FLOAT JOIN(__riscv_vfredusum_vs_f, ELEN, LMUL, _f, JOIN2( ELEN, m1)) +#define VFMVVF_FLOAT JOIN(__riscv_vfmv, _v_f_f, ELEN, LMUL, _) +#define VFMVVF_FLOAT_M1 JOIN(__riscv_vfmv, _v_f_f, ELEN, m1, _) +#define VFADDVV_FLOAT JOIN(__riscv_vfadd, _vv_f, ELEN, LMUL, _) +#define VMFLTVF_FLOAT JOIN(__riscv_vmflt, _vf_f, ELEN, LMUL, MLEN) + +FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) +{ + BLASLONG i=0, j=0; + BLASLONG ix=0; + FLOAT asumf=0.0; + if (n <= 0 || inc_x <= 0) return(asumf); + unsigned int gvl = 0; + FLOAT_V_T v0, v1, v_zero,v_sum; + FLOAT_V_T_M1 v_res; + v_res = VFMVVF_FLOAT_M1(0, 1); + + if(inc_x == 1){ + BLASLONG n2 = n * 2; + gvl = VSETVL(n2); + v_zero = VFMVVF_FLOAT(0, gvl); + if(gvl <= n2/2){ + v_sum = VFMVVF_FLOAT(0, gvl); + for(i=0,j=0; i -#if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m8(n) -#define VSETVL_MAX vsetvlmax_e32m1() -#define FLOAT_V_T vfloat32m8_t -#define VLEV_FLOAT vle32_v_f32m8 -#define VLSEV_FLOAT vlse32_v_f32m8 -#define VSEV_FLOAT vse32_v_f32m8 -#define VSSEV_FLOAT vsse32_v_f32m8 + +#ifdef RISCV64_ZVL256B +# define LMUL m2 +# if defined(DOUBLE) +# define ELEN 64 +# define MLEN 64 +# else +# define ELEN 32 +# define MLEN 32 +# endif #else -#define VSETVL(n) vsetvl_e64m8(n) -#define VSETVL_MAX vsetvlmax_e64m1() -#define FLOAT_V_T vfloat64m8_t -#define VLEV_FLOAT vle64_v_f64m8 -#define VLSEV_FLOAT vlse64_v_f64m8 -#define VSEV_FLOAT vse64_v_f64m8 -#define VSSEV_FLOAT vsse64_v_f64m8 +# define LMUL m8 +# if defined(DOUBLE) +# define ELEN 64 +# define MLEN 16 +# else +# define ELEN 32 +# define MLEN 8 +# endif #endif +#define _ +#define JOIN2_X(x, y) x ## y +#define JOIN2(x, y) JOIN2_X(x, y) +#define JOIN(v, w, x, y, z) JOIN2( JOIN2( JOIN2( JOIN2( v, w ), x), y), z) + +#define VSETVL JOIN(__riscv_vsetvl, _e, ELEN, LMUL, _) +#define FLOAT_V_T JOIN(vfloat, ELEN, LMUL, _t, _) +#define VLEV_FLOAT JOIN(__riscv_vle, ELEN, _v_f, ELEN, LMUL) +#define VLSEV_FLOAT JOIN(__riscv_vlse, ELEN, _v_f, ELEN, LMUL) +#define VSEV_FLOAT JOIN(__riscv_vse, ELEN, _v_f, ELEN, LMUL) +#define VSSEV_FLOAT JOIN(__riscv_vsse, ELEN, _v_f, ELEN, LMUL) + int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT dummy3, FLOAT dummy4, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y, FLOAT *dummy, BLASLONG dummy2) { BLASLONG i = 0, j = 0; BLASLONG ix = 0,iy = 0; BLASLONG stride_x, stride_y; FLOAT_V_T vx0, vx1, vy0, vy1; - unsigned int gvl = 0; + unsigned int gvl = VSETVL((inc_x != 0 && inc_y != 0) ? n : 1); + if( inc_x == 0 && inc_y == 0 ) { n = n & 1; } if (n < 0) return(0); if(inc_x == 1 && inc_y == 1){ - gvl = VSETVL(n); BLASLONG n2 = n * 2; if(gvl <= n2/2){ for(i=0,j=0; i Date: Wed, 1 Mar 2023 17:40:42 +0000 Subject: [PATCH 011/311] factoring riscv64/dot.c fix into separate PR as requested --- kernel/riscv64/dot.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/kernel/riscv64/dot.c b/kernel/riscv64/dot.c index bf55998ca..46a84ad18 100644 --- a/kernel/riscv64/dot.c +++ b/kernel/riscv64/dot.c @@ -46,7 +46,7 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y) BLASLONG ix=0,iy=0; double dot = 0.0 ; - if ( n < 1 ) return(dot); + if ( n < 0 ) return(dot); while(i < n) { From 1374a2d08b078451dcfaf723614ea13e441e1d06 Mon Sep 17 00:00:00 2001 From: Heller Zheng Date: Sun, 19 Mar 2023 23:59:03 -0700 Subject: [PATCH 012/311] This PR adapts latest spec changes Add prefix (_riscv) for all riscv intrinsics Update some intrinsics' parameter, like vfredxxxx, vmerge --- kernel/riscv64/amax_rvv.c | 54 +++++------ kernel/riscv64/amin_rvv.c | 54 +++++------ kernel/riscv64/asum_rvv.c | 54 +++++------ kernel/riscv64/axpby_rvv.c | 36 +++---- kernel/riscv64/axpy_rvv.c | 28 +++--- kernel/riscv64/copy_rvv.c | 24 ++--- kernel/riscv64/dot_rvv.c | 66 ++++++------- kernel/riscv64/gemm_beta_rvv.c | 24 ++--- kernel/riscv64/gemm_ncopy_8_rvv.c | 28 +++--- kernel/riscv64/gemm_ncopy_rvv_v1.c | 20 ++-- kernel/riscv64/gemm_tcopy_8_rvv.c | 44 ++++----- kernel/riscv64/gemm_tcopy_rvv_v1.c | 16 ++-- kernel/riscv64/gemmkernel_rvv_v1x8.c | 24 ++--- kernel/riscv64/gemv_n_rvv.c | 28 +++--- kernel/riscv64/gemv_t_rvv.c | 53 +++++------ kernel/riscv64/iamax_rvv.c | 115 +++++++++++----------- kernel/riscv64/iamin_rvv.c | 117 +++++++++++------------ kernel/riscv64/imax_rvv.c | 113 +++++++++++----------- kernel/riscv64/imin_rvv.c | 113 +++++++++++----------- kernel/riscv64/izamax_rvv.c | 127 ++++++++++++------------- kernel/riscv64/izamin_rvv.c | 121 ++++++++++++----------- kernel/riscv64/max_rvv.c | 50 +++++----- kernel/riscv64/min_rvv.c | 50 +++++----- kernel/riscv64/nrm2_rvv.c | 46 ++++----- kernel/riscv64/rot_rvv.c | 36 +++---- kernel/riscv64/scal_rvv.c | 32 +++---- kernel/riscv64/sum_rvv.c | 50 +++++----- kernel/riscv64/swap_rvv.c | 28 +++--- kernel/riscv64/symm_lcopy_rvv_v1.c | 50 +++++----- kernel/riscv64/symm_ucopy_rvv_v1.c | 50 +++++----- kernel/riscv64/symv_L_rvv.c | 81 ++++++++-------- kernel/riscv64/symv_U_rvv.c | 81 ++++++++-------- kernel/riscv64/trmm_lncopy_rvv_v1.c | 48 +++++----- kernel/riscv64/trmm_ltcopy_rvv_v1.c | 44 ++++----- kernel/riscv64/trmm_uncopy_rvv_v1.c | 48 +++++----- kernel/riscv64/trmm_utcopy_rvv_v1.c | 44 ++++----- kernel/riscv64/trmmkernel_rvv_v1x8.c | 28 +++--- kernel/riscv64/trsm_kernel_LN_rvv_v1.c | 54 +++++------ kernel/riscv64/trsm_kernel_LT_rvv_v1.c | 54 +++++------ kernel/riscv64/trsm_kernel_RN_rvv_v1.c | 54 +++++------ kernel/riscv64/trsm_kernel_RT_rvv_v1.c | 42 ++++---- kernel/riscv64/trsm_lncopy_rvv_v1.c | 40 ++++---- kernel/riscv64/trsm_ltcopy_rvv_v1.c | 40 ++++---- kernel/riscv64/trsm_uncopy_rvv_v1.c | 40 ++++---- kernel/riscv64/trsm_utcopy_rvv_v1.c | 40 ++++---- kernel/riscv64/zamax_rvv.c | 58 +++++------ kernel/riscv64/zamin_rvv.c | 58 +++++------ kernel/riscv64/zasum_rvv.c | 51 +++++----- kernel/riscv64/zaxpby_rvv.c | 52 +++++----- kernel/riscv64/zaxpy_rvv.c | 32 +++---- kernel/riscv64/zcopy_rvv.c | 44 ++++----- kernel/riscv64/zdot_rvv.c | 65 +++++++------ kernel/riscv64/zgemm_beta_rvv.c | 32 +++---- kernel/riscv64/zgemm_ncopy_4_rvv.c | 24 ++--- kernel/riscv64/zgemm_ncopy_rvv_v1.c | 16 ++-- kernel/riscv64/zgemm_tcopy_4_rvv.c | 40 ++++---- kernel/riscv64/zgemm_tcopy_rvv_v1.c | 16 ++-- kernel/riscv64/zgemmkernel_rvv_v1x4.c | 36 +++---- kernel/riscv64/zgemv_n_rvv.c | 48 +++++----- kernel/riscv64/zgemv_t_rvv.c | 61 ++++++------ kernel/riscv64/zhemm_ltcopy_rvv_v1.c | 84 ++++++++-------- kernel/riscv64/zhemm_utcopy_rvv_v1.c | 84 ++++++++-------- kernel/riscv64/znrm2_rvv.c | 66 ++++++------- kernel/riscv64/zrot_rvv.c | 52 +++++----- kernel/riscv64/zscal_rvv.c | 44 ++++----- kernel/riscv64/zsum_rvv.c | 47 +++++---- kernel/riscv64/zswap_rvv.c | 24 ++--- kernel/riscv64/zsymm_lcopy_rvv_v1.c | 64 ++++++------- kernel/riscv64/zsymm_ucopy_rvv_v1.c | 64 ++++++------- kernel/riscv64/ztrmm_lncopy_rvv_v1.c | 64 ++++++------- kernel/riscv64/ztrmm_ltcopy_rvv_v1.c | 61 ++++++------ kernel/riscv64/ztrmm_uncopy_rvv_v1.c | 64 ++++++------- kernel/riscv64/ztrmm_utcopy_rvv_v1.c | 60 ++++++------ kernel/riscv64/ztrmmkernel_2x2_rvv.c | 60 ++++++------ kernel/riscv64/ztrmmkernel_rvv_v1x4.c | 40 ++++---- kernel/riscv64/ztrsm_lncopy_rvv_v1.c | 36 +++---- kernel/riscv64/ztrsm_ltcopy_rvv_v1.c | 36 +++---- kernel/riscv64/ztrsm_uncopy_rvv_v1.c | 36 +++---- kernel/riscv64/ztrsm_utcopy_rvv_v1.c | 36 +++---- 79 files changed, 2013 insertions(+), 2031 deletions(-) diff --git a/kernel/riscv64/amax_rvv.c b/kernel/riscv64/amax_rvv.c index c9c6e7f73..be0bdbea0 100644 --- a/kernel/riscv64/amax_rvv.c +++ b/kernel/riscv64/amax_rvv.c @@ -29,33 +29,33 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include #if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m8(n) -#define VSETVL_MAX vsetvlmax_e32m8() -#define VSETVL_MAX_M1 vsetvlmax_e32m1() -#define FLOAT_V_T vfloat32m8_t -#define FLOAT_V_T_M1 vfloat32m1_t -#define VLEV_FLOAT vle32_v_f32m8 -#define VLSEV_FLOAT vlse32_v_f32m8 -#define VFREDMAXVS_FLOAT vfredmax_vs_f32m8_f32m1 -#define VFMVVF_FLOAT vfmv_v_f_f32m8 -#define VFMVVF_FLOAT_M1 vfmv_v_f_f32m1 -#define VFMAXVV_FLOAT vfmax_vv_f32m8 -#define VFABSV_FLOAT vfabs_v_f32m8 -#define VFMVFS_FLOAT_M1 vfmv_f_s_f32m1_f32 +#define VSETVL(n) __riscv_vsetvl_e32m8(n) +#define VSETVL_MAX __riscv_vsetvlmax_e32m8() +#define VSETVL_MAX_M1 __riscv_vsetvlmax_e32m1() +#define FLOAT_V_T vfloat32m8_t +#define FLOAT_V_T_M1 vfloat32m1_t +#define VLEV_FLOAT __riscv_vle32_v_f32m8 +#define VLSEV_FLOAT __riscv_vlse32_v_f32m8 +#define VFREDMAXVS_FLOAT __riscv_vfredmax_vs_f32m8_f32m1 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m8 +#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f32m1 +#define VFMAXVV_FLOAT __riscv_vfmax_vv_f32m8 +#define VFABSV_FLOAT __riscv_vfabs_v_f32m8 +#define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f32m1_f32 #else -#define VSETVL(n) vsetvl_e64m8(n) -#define VSETVL_MAX vsetvlmax_e64m8() -#define VSETVL_MAX_M1 vsetvlmax_e64m1() -#define FLOAT_V_T vfloat64m8_t -#define FLOAT_V_T_M1 vfloat64m1_t -#define VLEV_FLOAT vle64_v_f64m8 -#define VLSEV_FLOAT vlse64_v_f64m8 -#define VFREDMAXVS_FLOAT vfredmax_vs_f64m8_f64m1 -#define VFMVVF_FLOAT vfmv_v_f_f64m8 -#define VFMVVF_FLOAT_M1 vfmv_v_f_f64m1 -#define VFMAXVV_FLOAT vfmax_vv_f64m8 -#define VFABSV_FLOAT vfabs_v_f64m8 -#define VFMVFS_FLOAT_M1 vfmv_f_s_f64m1_f64 +#define VSETVL(n) __riscv_vsetvl_e64m8(n) +#define VSETVL_MAX __riscv_vsetvlmax_e64m8() +#define VSETVL_MAX_M1 __riscv_vsetvlmax_e64m1() +#define FLOAT_V_T vfloat64m8_t +#define FLOAT_V_T_M1 vfloat64m1_t +#define VLEV_FLOAT __riscv_vle64_v_f64m8 +#define VLSEV_FLOAT __riscv_vlse64_v_f64m8 +#define VFREDMAXVS_FLOAT __riscv_vfredmax_vs_f64m8_f64m1 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m8 +#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f64m1 +#define VFMAXVV_FLOAT __riscv_vfmax_vv_f64m8 +#define VFABSV_FLOAT __riscv_vfabs_v_f64m8 +#define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f64m1_f64 #endif FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) @@ -95,7 +95,7 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) } - v_res = VFREDMAXVS_FLOAT(v_res, vmax, v_res, vlmax); + v_res = VFREDMAXVS_FLOAT(vmax, v_res, vlmax); maxf = VFMVFS_FLOAT_M1(v_res); return(maxf); diff --git a/kernel/riscv64/amin_rvv.c b/kernel/riscv64/amin_rvv.c index 370b6c338..d4926084b 100644 --- a/kernel/riscv64/amin_rvv.c +++ b/kernel/riscv64/amin_rvv.c @@ -29,33 +29,33 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include #if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m8(n) -#define VSETVL_MAX vsetvlmax_e32m8() -#define VSETVL_MAX_M1 vsetvlmax_e32m1() -#define FLOAT_V_T vfloat32m8_t -#define FLOAT_V_T_M1 vfloat32m1_t -#define VLEV_FLOAT vle32_v_f32m8 -#define VLSEV_FLOAT vlse32_v_f32m8 -#define VFREDMINVS_FLOAT vfredmin_vs_f32m8_f32m1 -#define VFMVVF_FLOAT vfmv_v_f_f32m8 -#define VFMVVF_FLOAT_M1 vfmv_v_f_f32m1 -#define VFMINVV_FLOAT vfmin_vv_f32m8 -#define VFABSV_FLOAT vfabs_v_f32m8 -#define VFMVFS_FLOAT_M1 vfmv_f_s_f32m1_f32 +#define VSETVL(n) __riscv_vsetvl_e32m8(n) +#define VSETVL_MAX __riscv_vsetvlmax_e32m8() +#define VSETVL_MAX_M1 __riscv_vsetvlmax_e32m1() +#define FLOAT_V_T vfloat32m8_t +#define FLOAT_V_T_M1 vfloat32m1_t +#define VLEV_FLOAT __riscv_vle32_v_f32m8 +#define VLSEV_FLOAT __riscv_vlse32_v_f32m8 +#define VFREDMINVS_FLOAT __riscv_vfredmin_vs_f32m8_f32m1 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m8 +#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f32m1 +#define VFMINVV_FLOAT __riscv_vfmin_vv_f32m8 +#define VFABSV_FLOAT __riscv_vfabs_v_f32m8 +#define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f32m1_f32 #else -#define VSETVL(n) vsetvl_e64m8(n) -#define VSETVL_MAX vsetvlmax_e64m8() -#define VSETVL_MAX_M1 vsetvlmax_e64m1() -#define FLOAT_V_T vfloat64m8_t -#define FLOAT_V_T_M1 vfloat64m1_t -#define VLEV_FLOAT vle64_v_f64m8 -#define VLSEV_FLOAT vlse64_v_f64m8 -#define VFREDMINVS_FLOAT vfredmin_vs_f64m8_f64m1 -#define VFMVVF_FLOAT vfmv_v_f_f64m8 -#define VFMVVF_FLOAT_M1 vfmv_v_f_f64m1 -#define VFMINVV_FLOAT vfmin_vv_f64m8 -#define VFABSV_FLOAT vfabs_v_f64m8 -#define VFMVFS_FLOAT_M1 vfmv_f_s_f64m1_f64 +#define VSETVL(n) __riscv_vsetvl_e64m8(n) +#define VSETVL_MAX __riscv_vsetvlmax_e64m8() +#define VSETVL_MAX_M1 __riscv_vsetvlmax_e64m1() +#define FLOAT_V_T vfloat64m8_t +#define FLOAT_V_T_M1 vfloat64m1_t +#define VLEV_FLOAT __riscv_vle64_v_f64m8 +#define VLSEV_FLOAT __riscv_vlse64_v_f64m8 +#define VFREDMINVS_FLOAT __riscv_vfredmin_vs_f64m8_f64m1 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m8 +#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f64m1 +#define VFMINVV_FLOAT __riscv_vfmin_vv_f64m8 +#define VFABSV_FLOAT __riscv_vfabs_v_f64m8 +#define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f64m1_f64 #endif FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) @@ -95,7 +95,7 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) } - v_res = VFREDMINVS_FLOAT(v_res, vmin, v_res, vlmax); + v_res = VFREDMINVS_FLOAT(vmin, v_res, vlmax); minf = VFMVFS_FLOAT_M1(v_res); return(minf); diff --git a/kernel/riscv64/asum_rvv.c b/kernel/riscv64/asum_rvv.c index 4f711c9be..691591e22 100644 --- a/kernel/riscv64/asum_rvv.c +++ b/kernel/riscv64/asum_rvv.c @@ -28,33 +28,33 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include "common.h" #if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m8(n) -#define VSETVL_MAX vsetvlmax_e32m8() -#define VSETVL_MAX_M1 vsetvlmax_e32m1() -#define FLOAT_V_T vfloat32m8_t -#define FLOAT_V_T_M1 vfloat32m1_t -#define VLEV_FLOAT vle32_v_f32m8 -#define VLSEV_FLOAT vlse32_v_f32m8 -#define VFMVVF_FLOAT vfmv_v_f_f32m8 -#define VFADDVV_FLOAT vfadd_vv_f32m8 -#define VFABSV_FLOAT vfabs_v_f32m8 -#define VFREDSUMVS_FLOAT vfredusum_vs_f32m8_f32m1 -#define VFMVVF_FLOAT_M1 vfmv_v_f_f32m1 -#define VFMVFS_FLOAT_M1 vfmv_f_s_f32m1_f32 +#define VSETVL(n) __riscv_vsetvl_e32m8(n) +#define VSETVL_MAX __riscv_vsetvlmax_e32m8() +#define VSETVL_MAX_M1 __riscv_vsetvlmax_e32m1() +#define FLOAT_V_T vfloat32m8_t +#define FLOAT_V_T_M1 vfloat32m1_t +#define VLEV_FLOAT __riscv_vle32_v_f32m8 +#define VLSEV_FLOAT __riscv_vlse32_v_f32m8 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m8 +#define VFADDVV_FLOAT __riscv_vfadd_vv_f32m8 +#define VFABSV_FLOAT __riscv_vfabs_v_f32m8 +#define VFREDSUMVS_FLOAT __riscv_vfredusum_vs_f32m8_f32m1 +#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f32m1 +#define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f32m1_f32 #else -#define VSETVL(n) vsetvl_e64m8(n) -#define VSETVL_MAX vsetvlmax_e64m8() -#define VSETVL_MAX_M1 vsetvlmax_e64m1() -#define FLOAT_V_T vfloat64m8_t -#define FLOAT_V_T_M1 vfloat64m1_t -#define VLEV_FLOAT vle64_v_f64m8 -#define VLSEV_FLOAT vlse64_v_f64m8 -#define VFMVVF_FLOAT vfmv_v_f_f64m8 -#define VFADDVV_FLOAT vfadd_vv_f64m8 -#define VFABSV_FLOAT vfabs_v_f64m8 -#define VFREDSUMVS_FLOAT vfredusum_vs_f64m8_f64m1 -#define VFMVVF_FLOAT_M1 vfmv_v_f_f64m1 -#define VFMVFS_FLOAT_M1 vfmv_f_s_f64m1_f64 +#define VSETVL(n) __riscv_vsetvl_e64m8(n) +#define VSETVL_MAX __riscv_vsetvlmax_e64m8() +#define VSETVL_MAX_M1 __riscv_vsetvlmax_e64m1() +#define FLOAT_V_T vfloat64m8_t +#define FLOAT_V_T_M1 vfloat64m1_t +#define VLEV_FLOAT __riscv_vle64_v_f64m8 +#define VLSEV_FLOAT __riscv_vlse64_v_f64m8 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m8 +#define VFADDVV_FLOAT __riscv_vfadd_vv_f64m8 +#define VFABSV_FLOAT __riscv_vfabs_v_f64m8 +#define VFREDSUMVS_FLOAT __riscv_vfredusum_vs_f64m8_f64m1 +#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f64m1 +#define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f64m1_f64 #endif FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) @@ -93,7 +93,7 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) } - v_res = VFREDSUMVS_FLOAT(v_res, vsum, v_res, vlmax); + v_res = VFREDSUMVS_FLOAT(vsum, v_res, vlmax); asumf = VFMVFS_FLOAT_M1(v_res); return(asumf); } diff --git a/kernel/riscv64/axpby_rvv.c b/kernel/riscv64/axpby_rvv.c index 7c35c563d..a1dbdb0e4 100644 --- a/kernel/riscv64/axpby_rvv.c +++ b/kernel/riscv64/axpby_rvv.c @@ -28,25 +28,25 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include "common.h" #if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m8(n) -#define FLOAT_V_T vfloat32m8_t -#define VLEV_FLOAT vle32_v_f32m8 -#define VLSEV_FLOAT vlse32_v_f32m8 -#define VSEV_FLOAT vse32_v_f32m8 -#define VSSEV_FLOAT vsse32_v_f32m8 -#define VFMACCVF_FLOAT vfmacc_vf_f32m8 -#define VFMULVF_FLOAT vfmul_vf_f32m8 -#define VFMVVF_FLOAT vfmv_v_f_f32m8 +#define VSETVL(n) __riscv_vsetvl_e32m8(n) +#define FLOAT_V_T vfloat32m8_t +#define VLEV_FLOAT __riscv_vle32_v_f32m8 +#define VLSEV_FLOAT __riscv_vlse32_v_f32m8 +#define VSEV_FLOAT __riscv_vse32_v_f32m8 +#define VSSEV_FLOAT __riscv_vsse32_v_f32m8 +#define VFMACCVF_FLOAT __riscv_vfmacc_vf_f32m8 +#define VFMULVF_FLOAT __riscv_vfmul_vf_f32m8 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m8 #else -#define VSETVL(n) vsetvl_e64m8(n) -#define FLOAT_V_T vfloat64m8_t -#define VLEV_FLOAT vle64_v_f64m8 -#define VLSEV_FLOAT vlse64_v_f64m8 -#define VSEV_FLOAT vse64_v_f64m8 -#define VSSEV_FLOAT vsse64_v_f64m8 -#define VFMACCVF_FLOAT vfmacc_vf_f64m8 -#define VFMULVF_FLOAT vfmul_vf_f64m8 -#define VFMVVF_FLOAT vfmv_v_f_f64m8 +#define VSETVL(n) __riscv_vsetvl_e64m8(n) +#define FLOAT_V_T vfloat64m8_t +#define VLEV_FLOAT __riscv_vle64_v_f64m8 +#define VLSEV_FLOAT __riscv_vlse64_v_f64m8 +#define VSEV_FLOAT __riscv_vse64_v_f64m8 +#define VSSEV_FLOAT __riscv_vsse64_v_f64m8 +#define VFMACCVF_FLOAT __riscv_vfmacc_vf_f64m8 +#define VFMULVF_FLOAT __riscv_vfmul_vf_f64m8 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m8 #endif int CNAME(BLASLONG n, FLOAT alpha, FLOAT *x, BLASLONG inc_x, FLOAT beta, FLOAT *y, BLASLONG inc_y) diff --git a/kernel/riscv64/axpy_rvv.c b/kernel/riscv64/axpy_rvv.c index 3986f4e21..8bc2f30de 100644 --- a/kernel/riscv64/axpy_rvv.c +++ b/kernel/riscv64/axpy_rvv.c @@ -28,21 +28,21 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include "common.h" #if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m8(n) -#define FLOAT_V_T vfloat32m8_t -#define VLEV_FLOAT vle32_v_f32m8 -#define VLSEV_FLOAT vlse32_v_f32m8 -#define VSEV_FLOAT vse32_v_f32m8 -#define VSSEV_FLOAT vsse32_v_f32m8 -#define VFMACCVF_FLOAT vfmacc_vf_f32m8 +#define VSETVL(n) __riscv_vsetvl_e32m8(n) +#define FLOAT_V_T vfloat32m8_t +#define VLEV_FLOAT __riscv_vle32_v_f32m8 +#define VLSEV_FLOAT __riscv_vlse32_v_f32m8 +#define VSEV_FLOAT __riscv_vse32_v_f32m8 +#define VSSEV_FLOAT __riscv_vsse32_v_f32m8 +#define VFMACCVF_FLOAT __riscv_vfmacc_vf_f32m8 #else -#define VSETVL(n) vsetvl_e64m8(n) -#define FLOAT_V_T vfloat64m8_t -#define VLEV_FLOAT vle64_v_f64m8 -#define VLSEV_FLOAT vlse64_v_f64m8 -#define VSEV_FLOAT vse64_v_f64m8 -#define VSSEV_FLOAT vsse64_v_f64m8 -#define VFMACCVF_FLOAT vfmacc_vf_f64m8 +#define VSETVL(n) __riscv_vsetvl_e64m8(n) +#define FLOAT_V_T vfloat64m8_t +#define VLEV_FLOAT __riscv_vle64_v_f64m8 +#define VLSEV_FLOAT __riscv_vlse64_v_f64m8 +#define VSEV_FLOAT __riscv_vse64_v_f64m8 +#define VSSEV_FLOAT __riscv_vsse64_v_f64m8 +#define VFMACCVF_FLOAT __riscv_vfmacc_vf_f64m8 #endif int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT da, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y, FLOAT *dummy, BLASLONG dummy2) diff --git a/kernel/riscv64/copy_rvv.c b/kernel/riscv64/copy_rvv.c index 5d5a8bd04..041fd2dae 100644 --- a/kernel/riscv64/copy_rvv.c +++ b/kernel/riscv64/copy_rvv.c @@ -28,19 +28,19 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include "common.h" #if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m8(n) -#define FLOAT_V_T vfloat32m8_t -#define VLEV_FLOAT vle32_v_f32m8 -#define VLSEV_FLOAT vlse32_v_f32m8 -#define VSEV_FLOAT vse32_v_f32m8 -#define VSSEV_FLOAT vsse32_v_f32m8 +#define VSETVL(n) __riscv_vsetvl_e32m8(n) +#define FLOAT_V_T vfloat32m8_t +#define VLEV_FLOAT __riscv_vle32_v_f32m8 +#define VLSEV_FLOAT __riscv_vlse32_v_f32m8 +#define VSEV_FLOAT __riscv_vse32_v_f32m8 +#define VSSEV_FLOAT __riscv_vsse32_v_f32m8 #else -#define VSETVL(n) vsetvl_e64m8(n) -#define FLOAT_V_T vfloat64m8_t -#define VLEV_FLOAT vle64_v_f64m8 -#define VLSEV_FLOAT vlse64_v_f64m8 -#define VSEV_FLOAT vse64_v_f64m8 -#define VSSEV_FLOAT vsse64_v_f64m8 +#define VSETVL(n) __riscv_vsetvl_e64m8(n) +#define FLOAT_V_T vfloat64m8_t +#define VLEV_FLOAT __riscv_vle64_v_f64m8 +#define VLSEV_FLOAT __riscv_vlse64_v_f64m8 +#define VSEV_FLOAT __riscv_vse64_v_f64m8 +#define VSSEV_FLOAT __riscv_vsse64_v_f64m8 #endif int CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y) diff --git a/kernel/riscv64/dot_rvv.c b/kernel/riscv64/dot_rvv.c index 60dcac2f5..3276695b6 100644 --- a/kernel/riscv64/dot_rvv.c +++ b/kernel/riscv64/dot_rvv.c @@ -37,24 +37,24 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y) if ( n <= 0 ) return(dot); - size_t vlmax = vsetvlmax_e64m8(); - vfloat64m8_t vr = vfmv_v_f_f64m8(0, vlmax); + size_t vlmax = __riscv_vsetvlmax_e64m8(); + vfloat64m8_t vr = __riscv_vfmv_v_f_f64m8(0, vlmax); if(inc_x == 1 && inc_y == 1) { for (size_t vl; n > 0; n -= vl, x += vl, y += vl) { - vl = vsetvl_e64m8(n); + vl = __riscv_vsetvl_e64m8(n); #if !defined(DOUBLE) - vfloat32m4_t vx = vle32_v_f32m4(x, vl); - vfloat32m4_t vy = vle32_v_f32m4(y, vl); + vfloat32m4_t vx = __riscv_vle32_v_f32m4(x, vl); + vfloat32m4_t vy = __riscv_vle32_v_f32m4(y, vl); - vr = vfwmacc_vv_f64m8(vr, vx, vy, vl); + vr = __riscv_vfwmacc_vv_f64m8(vr, vx, vy, vl); #else - vfloat64m8_t vx = vle64_v_f64m8(x, vl); - vfloat64m8_t vy = vle64_v_f64m8(y, vl); + vfloat64m8_t vx = __riscv_vle64_v_f64m8(x, vl); + vfloat64m8_t vy = __riscv_vle64_v_f64m8(y, vl); - vr = vfmacc_vv_f64m8(vr, vx, vy, vl); + vr = __riscv_vfmacc_vv_f64m8(vr, vx, vy, vl); #endif } @@ -63,18 +63,18 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y) BLASLONG stride_y = inc_y * sizeof(FLOAT); for (size_t vl; n > 0; n -= vl, x += vl, y += vl*inc_y) { - vl = vsetvl_e64m8(n); + vl = __riscv_vsetvl_e64m8(n); #if !defined(DOUBLE) - vfloat32m4_t vx = vle32_v_f32m4(x, vl); - vfloat32m4_t vy = vlse32_v_f32m4(y, stride_y, vl); + vfloat32m4_t vx = __riscv_vle32_v_f32m4(x, vl); + vfloat32m4_t vy = __riscv_vlse32_v_f32m4(y, stride_y, vl); - vr = vfwmacc_vv_f64m8(vr, vx, vy, vl); + vr = __riscv_vfwmacc_vv_f64m8(vr, vx, vy, vl); #else - vfloat64m8_t vx = vle64_v_f64m8(x, vl); - vfloat64m8_t vy = vlse64_v_f64m8(y, stride_y, vl); + vfloat64m8_t vx = __riscv_vle64_v_f64m8(x, vl); + vfloat64m8_t vy = __riscv_vlse64_v_f64m8(y, stride_y, vl); - vr = vfmacc_vv_f64m8(vr, vx, vy, vl); + vr = __riscv_vfmacc_vv_f64m8(vr, vx, vy, vl); #endif } } else if (1 == inc_y) { @@ -82,18 +82,18 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y) BLASLONG stride_x = inc_x * sizeof(FLOAT); for (size_t vl; n > 0; n -= vl, x += vl*inc_x, y += vl) { - vl = vsetvl_e64m8(n); + vl = __riscv_vsetvl_e64m8(n); #if !defined(DOUBLE) - vfloat32m4_t vx = vlse32_v_f32m4(x, stride_x, vl); - vfloat32m4_t vy = vle32_v_f32m4(y, vl); + vfloat32m4_t vx = __riscv_vlse32_v_f32m4(x, stride_x, vl); + vfloat32m4_t vy = __riscv_vle32_v_f32m4(y, vl); - vr = vfwmacc_vv_f64m8(vr, vx, vy, vl); + vr = __riscv_vfwmacc_vv_f64m8(vr, vx, vy, vl); #else - vfloat64m8_t vx = vlse64_v_f64m8(x, stride_x, vl); - vfloat64m8_t vy = vle64_v_f64m8(y, vl); + vfloat64m8_t vx = __riscv_vlse64_v_f64m8(x, stride_x, vl); + vfloat64m8_t vy = __riscv_vle64_v_f64m8(y, vl); - vr = vfmacc_vv_f64m8(vr, vx, vy, vl); + vr = __riscv_vfmacc_vv_f64m8(vr, vx, vy, vl); #endif } } else { @@ -102,25 +102,25 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y) BLASLONG stride_y = inc_y * sizeof(FLOAT); for (size_t vl; n > 0; n -= vl, x += vl*inc_x, y += vl*inc_y) { - vl = vsetvl_e64m8(n); + vl = __riscv_vsetvl_e64m8(n); #if !defined(DOUBLE) - vfloat32m4_t vx = vlse32_v_f32m4(x, stride_x, vl); - vfloat32m4_t vy = vlse32_v_f32m4(y, stride_y, vl); + vfloat32m4_t vx = __riscv_vlse32_v_f32m4(x, stride_x, vl); + vfloat32m4_t vy = __riscv_vlse32_v_f32m4(y, stride_y, vl); - vr = vfwmacc_vv_f64m8(vr, vx, vy, vl); + vr = __riscv_vfwmacc_vv_f64m8(vr, vx, vy, vl); #else - vfloat64m8_t vx = vlse64_v_f64m8(x, stride_x, vl); - vfloat64m8_t vy = vlse64_v_f64m8(y, stride_y, vl); + vfloat64m8_t vx = __riscv_vlse64_v_f64m8(x, stride_x, vl); + vfloat64m8_t vy = __riscv_vlse64_v_f64m8(y, stride_y, vl); - vr = vfmacc_vv_f64m8(vr, vx, vy, vl); + vr = __riscv_vfmacc_vv_f64m8(vr, vx, vy, vl); #endif } } - vfloat64m1_t vec_zero = vfmv_v_f_f64m1(0, vlmax); - vfloat64m1_t vec_sum = vfredusum_vs_f64m8_f64m1(vec_zero, vr, vec_zero, vlmax); - dot = vfmv_f_s_f64m1_f64(vec_sum); + vfloat64m1_t vec_zero = __riscv_vfmv_v_f_f64m1(0, vlmax); + vfloat64m1_t vec_sum = __riscv_vfredusum_vs_f64m8_f64m1(vr, vec_zero, vlmax); + dot = __riscv_vfmv_f_s_f64m1_f64(vec_sum); return(dot); } diff --git a/kernel/riscv64/gemm_beta_rvv.c b/kernel/riscv64/gemm_beta_rvv.c index 34d1ea078..f3cf6491d 100644 --- a/kernel/riscv64/gemm_beta_rvv.c +++ b/kernel/riscv64/gemm_beta_rvv.c @@ -28,19 +28,19 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include "common.h" #if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m8(n) -#define FLOAT_V_T vfloat32m8_t -#define VLEV_FLOAT vle32_v_f32m8 -#define VFMVVF_FLOAT vfmv_v_f_f32m8 -#define VFMULVF_FLOAT vfmul_vf_f32m8 -#define VSEV_FLOAT vse32_v_f32m8 +#define VSETVL(n) __riscv_vsetvl_e32m8(n) +#define FLOAT_V_T vfloat32m8_t +#define VLEV_FLOAT __riscv_vle32_v_f32m8 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m8 +#define VFMULVF_FLOAT __riscv_vfmul_vf_f32m8 +#define VSEV_FLOAT __riscv_vse32_v_f32m8 #else -#define VSETVL(n) vsetvl_e64m8(n) -#define FLOAT_V_T vfloat64m8_t -#define VLEV_FLOAT vle64_v_f64m8 -#define VFMVVF_FLOAT vfmv_v_f_f64m8 -#define VFMULVF_FLOAT vfmul_vf_f64m8 -#define VSEV_FLOAT vse64_v_f64m8 +#define VSETVL(n) __riscv_vsetvl_e64m8(n) +#define FLOAT_V_T vfloat64m8_t +#define VLEV_FLOAT __riscv_vle64_v_f64m8 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m8 +#define VFMULVF_FLOAT __riscv_vfmul_vf_f64m8 +#define VSEV_FLOAT __riscv_vse64_v_f64m8 #endif // Optimizes the implementation in ../generic/gemm_beta.c diff --git a/kernel/riscv64/gemm_ncopy_8_rvv.c b/kernel/riscv64/gemm_ncopy_8_rvv.c index 525b223c2..3030d67fb 100644 --- a/kernel/riscv64/gemm_ncopy_8_rvv.c +++ b/kernel/riscv64/gemm_ncopy_8_rvv.c @@ -28,21 +28,21 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include "common.h" #if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m1(n) -#define FLOAT_V_T vfloat32m1_t -#define VLEV_FLOAT vle32_v_f32m1 -#define VSEV_FLOAT vse32_v_f32m1 -#define VSSEG2_FLOAT vsseg2e32_v_f32m1 -#define VSSEG4_FLOAT vsseg4e32_v_f32m1 -#define VSSEG8_FLOAT vsseg8e32_v_f32m1 +#define VSETVL(n) __riscv_vsetvl_e32m1(n) +#define FLOAT_V_T vfloat32m1_t +#define VLEV_FLOAT __riscv_vle32_v_f32m1 +#define VSEV_FLOAT __riscv_vse32_v_f32m1 +#define VSSEG2_FLOAT __riscv_vsseg2e32_v_f32m1 +#define VSSEG4_FLOAT __riscv_vsseg4e32_v_f32m1 +#define VSSEG8_FLOAT __riscv_vsseg8e32_v_f32m1 #else -#define VSETVL(n) vsetvl_e64m1(n) -#define FLOAT_V_T vfloat64m1_t -#define VLEV_FLOAT vle64_v_f64m1 -#define VSEV_FLOAT vse64_v_f64m1 -#define VSSEG2_FLOAT vsseg2e64_v_f64m1 -#define VSSEG4_FLOAT vsseg4e64_v_f64m1 -#define VSSEG8_FLOAT vsseg8e64_v_f64m1 +#define VSETVL(n) __riscv_vsetvl_e64m1(n) +#define FLOAT_V_T vfloat64m1_t +#define VLEV_FLOAT __riscv_vle64_v_f64m1 +#define VSEV_FLOAT __riscv_vse64_v_f64m1 +#define VSSEG2_FLOAT __riscv_vsseg2e64_v_f64m1 +#define VSSEG4_FLOAT __riscv_vsseg4e64_v_f64m1 +#define VSSEG8_FLOAT __riscv_vsseg8e64_v_f64m1 #endif // Optimizes the implementation in ../generic/gemm_ncopy_8.c diff --git a/kernel/riscv64/gemm_ncopy_rvv_v1.c b/kernel/riscv64/gemm_ncopy_rvv_v1.c index 2c5230752..2d6db15e5 100644 --- a/kernel/riscv64/gemm_ncopy_rvv_v1.c +++ b/kernel/riscv64/gemm_ncopy_rvv_v1.c @@ -28,17 +28,17 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include "common.h" #if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m2(n) -#define FLOAT_V_T vfloat32m2_t -#define VLEV_FLOAT vle32_v_f32m2 -#define VLSEV_FLOAT vlse32_v_f32m2 -#define VSEV_FLOAT vse32_v_f32m2 +#define VSETVL(n) __riscv_vsetvl_e32m2(n) +#define FLOAT_V_T vfloat32m2_t +#define VLEV_FLOAT __riscv_vle32_v_f32m2 +#define VLSEV_FLOAT __riscv_vlse32_v_f32m2 +#define VSEV_FLOAT __riscv_vse32_v_f32m2 #else -#define VSETVL(n) vsetvl_e64m2(n) -#define FLOAT_V_T vfloat64m2_t -#define VLEV_FLOAT vle64_v_f64m2 -#define VLSEV_FLOAT vlse64_v_f64m2 -#define VSEV_FLOAT vse64_v_f64m2 +#define VSETVL(n) __riscv_vsetvl_e64m2(n) +#define FLOAT_V_T vfloat64m2_t +#define VLEV_FLOAT __riscv_vle64_v_f64m2 +#define VLSEV_FLOAT __riscv_vlse64_v_f64m2 +#define VSEV_FLOAT __riscv_vse64_v_f64m2 #endif int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, FLOAT *b) diff --git a/kernel/riscv64/gemm_tcopy_8_rvv.c b/kernel/riscv64/gemm_tcopy_8_rvv.c index 81c1f962b..080a87312 100644 --- a/kernel/riscv64/gemm_tcopy_8_rvv.c +++ b/kernel/riscv64/gemm_tcopy_8_rvv.c @@ -28,29 +28,29 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include "common.h" #if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m1(n) -#define FLOAT_V_T vfloat32m1_t -#define VLEV_FLOAT vle32_v_f32m1 -#define VLSEV_FLOAT vlse32_v_f32m1 -#define VSEV_FLOAT vse32_v_f32m1 -#define VLSSEG2_FLOAT vlsseg2e32_v_f32m1 -#define VSSEG2_FLOAT vsseg2e32_v_f32m1 -#define VLSSEG4_FLOAT vlsseg4e32_v_f32m1 -#define VSSEG4_FLOAT vsseg4e32_v_f32m1 -#define VLSSEG8_FLOAT vlsseg8e32_v_f32m1 -#define VSSEG8_FLOAT vsseg8e32_v_f32m1 +#define VSETVL(n) __riscv_vsetvl_e32m1(n) +#define FLOAT_V_T vfloat32m1_t +#define VLEV_FLOAT __riscv_vle32_v_f32m1 +#define VLSEV_FLOAT __riscv_vlse32_v_f32m1 +#define VSEV_FLOAT __riscv_vse32_v_f32m1 +#define VLSSEG2_FLOAT __riscv_vlsseg2e32_v_f32m1 +#define VSSEG2_FLOAT __riscv_vsseg2e32_v_f32m1 +#define VLSSEG4_FLOAT __riscv_vlsseg4e32_v_f32m1 +#define VSSEG4_FLOAT __riscv_vsseg4e32_v_f32m1 +#define VLSSEG8_FLOAT __riscv_vlsseg8e32_v_f32m1 +#define VSSEG8_FLOAT __riscv_vsseg8e32_v_f32m1 #else -#define VSETVL(n) vsetvl_e64m1(n) -#define FLOAT_V_T vfloat64m1_t -#define VLEV_FLOAT vle64_v_f64m1 -#define VLSEV_FLOAT vlse64_v_f64m1 -#define VSEV_FLOAT vse64_v_f64m1 -#define VLSSEG2_FLOAT vlsseg2e64_v_f64m1 -#define VSSEG2_FLOAT vsseg2e64_v_f64m1 -#define VLSSEG4_FLOAT vlsseg4e64_v_f64m1 -#define VSSEG4_FLOAT vsseg4e64_v_f64m1 -#define VLSSEG8_FLOAT vlsseg8e64_v_f64m1 -#define VSSEG8_FLOAT vsseg8e64_v_f64m1 +#define VSETVL(n) __riscv_vsetvl_e64m1(n) +#define FLOAT_V_T vfloat64m1_t +#define VLEV_FLOAT __riscv_vle64_v_f64m1 +#define VLSEV_FLOAT __riscv_vlse64_v_f64m1 +#define VSEV_FLOAT __riscv_vse64_v_f64m1 +#define VLSSEG2_FLOAT __riscv_vlsseg2e64_v_f64m1 +#define VSSEG2_FLOAT __riscv_vsseg2e64_v_f64m1 +#define VLSSEG4_FLOAT __riscv_vlsseg4e64_v_f64m1 +#define VSSEG4_FLOAT __riscv_vsseg4e64_v_f64m1 +#define VLSSEG8_FLOAT __riscv_vlsseg8e64_v_f64m1 +#define VSSEG8_FLOAT __riscv_vsseg8e64_v_f64m1 #endif int CNAME(BLASLONG m, BLASLONG n, IFLOAT *a, BLASLONG lda, IFLOAT *b) diff --git a/kernel/riscv64/gemm_tcopy_rvv_v1.c b/kernel/riscv64/gemm_tcopy_rvv_v1.c index a291b70b8..c5fb6479f 100644 --- a/kernel/riscv64/gemm_tcopy_rvv_v1.c +++ b/kernel/riscv64/gemm_tcopy_rvv_v1.c @@ -28,15 +28,15 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include "common.h" #if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m2(n) -#define FLOAT_V_T vfloat32m2_t -#define VLEV_FLOAT vle32_v_f32m2 -#define VSEV_FLOAT vse32_v_f32m2 +#define VSETVL(n) __riscv_vsetvl_e32m2(n) +#define FLOAT_V_T vfloat32m2_t +#define VLEV_FLOAT __riscv_vle32_v_f32m2 +#define VSEV_FLOAT __riscv_vse32_v_f32m2 #else -#define VSETVL(n) vsetvl_e64m2(n) -#define FLOAT_V_T vfloat64m2_t -#define VLEV_FLOAT vle64_v_f64m2 -#define VSEV_FLOAT vse64_v_f64m2 +#define VSETVL(n) __riscv_vsetvl_e64m2(n) +#define FLOAT_V_T vfloat64m2_t +#define VLEV_FLOAT __riscv_vle64_v_f64m2 +#define VSEV_FLOAT __riscv_vse64_v_f64m2 #endif int CNAME(BLASLONG m, BLASLONG n, IFLOAT *a, BLASLONG lda, IFLOAT *b) diff --git a/kernel/riscv64/gemmkernel_rvv_v1x8.c b/kernel/riscv64/gemmkernel_rvv_v1x8.c index 5cd509f93..471b3158f 100644 --- a/kernel/riscv64/gemmkernel_rvv_v1x8.c +++ b/kernel/riscv64/gemmkernel_rvv_v1x8.c @@ -28,19 +28,19 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include "common.h" #if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m2(n) -#define FLOAT_V_T vfloat32m2_t -#define VLEV_FLOAT vle32_v_f32m2 -#define VSEV_FLOAT vse32_v_f32m2 -#define VFMVVF_FLOAT vfmv_v_f_f32m2 -#define VFMACCVF_FLOAT vfmacc_vf_f32m2 +#define VSETVL(n) __riscv_vsetvl_e32m2(n) +#define FLOAT_V_T vfloat32m2_t +#define VLEV_FLOAT __riscv_vle32_v_f32m2 +#define VSEV_FLOAT __riscv_vse32_v_f32m2 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m2 +#define VFMACCVF_FLOAT __riscv_vfmacc_vf_f32m2 #else -#define VSETVL(n) vsetvl_e64m2(n) -#define FLOAT_V_T vfloat64m2_t -#define VLEV_FLOAT vle64_v_f64m2 -#define VSEV_FLOAT vse64_v_f64m2 -#define VFMVVF_FLOAT vfmv_v_f_f64m2 -#define VFMACCVF_FLOAT vfmacc_vf_f64m2 +#define VSETVL(n) __riscv_vsetvl_e64m2(n) +#define FLOAT_V_T vfloat64m2_t +#define VLEV_FLOAT __riscv_vle64_v_f64m2 +#define VSEV_FLOAT __riscv_vse64_v_f64m2 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m2 +#define VFMACCVF_FLOAT __riscv_vfmacc_vf_f64m2 #endif int CNAME(BLASLONG bm, BLASLONG bn, BLASLONG bk, FLOAT alpha, IFLOAT* ba, IFLOAT* bb, FLOAT* C, BLASLONG ldc diff --git a/kernel/riscv64/gemv_n_rvv.c b/kernel/riscv64/gemv_n_rvv.c index 9d2dee615..1366eb5ad 100644 --- a/kernel/riscv64/gemv_n_rvv.c +++ b/kernel/riscv64/gemv_n_rvv.c @@ -28,21 +28,21 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include "common.h" #if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m8(n) -#define FLOAT_V_T vfloat32m8_t -#define VLEV_FLOAT vle32_v_f32m8 -#define VLSEV_FLOAT vlse32_v_f32m8 -#define VSEV_FLOAT vse32_v_f32m8 -#define VSSEV_FLOAT vsse32_v_f32m8 -#define VFMACCVF_FLOAT vfmacc_vf_f32m8 +#define VSETVL(n) __riscv_vsetvl_e32m8(n) +#define FLOAT_V_T vfloat32m8_t +#define VLEV_FLOAT __riscv_vle32_v_f32m8 +#define VLSEV_FLOAT __riscv_vlse32_v_f32m8 +#define VSEV_FLOAT __riscv_vse32_v_f32m8 +#define VSSEV_FLOAT __riscv_vsse32_v_f32m8 +#define VFMACCVF_FLOAT __riscv_vfmacc_vf_f32m8 #else -#define VSETVL(n) vsetvl_e64m8(n) -#define FLOAT_V_T vfloat64m8_t -#define VLEV_FLOAT vle64_v_f64m8 -#define VLSEV_FLOAT vlse64_v_f64m8 -#define VSEV_FLOAT vse64_v_f64m8 -#define VSSEV_FLOAT vsse64_v_f64m8 -#define VFMACCVF_FLOAT vfmacc_vf_f64m8 +#define VSETVL(n) __riscv_vsetvl_e64m8(n) +#define FLOAT_V_T vfloat64m8_t +#define VLEV_FLOAT __riscv_vle64_v_f64m8 +#define VLSEV_FLOAT __riscv_vlse64_v_f64m8 +#define VSEV_FLOAT __riscv_vse64_v_f64m8 +#define VSSEV_FLOAT __riscv_vsse64_v_f64m8 +#define VFMACCVF_FLOAT __riscv_vfmacc_vf_f64m8 #endif int CNAME(BLASLONG m, BLASLONG n, BLASLONG dummy1, FLOAT alpha, FLOAT *a, BLASLONG lda, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y, FLOAT *buffer) diff --git a/kernel/riscv64/gemv_t_rvv.c b/kernel/riscv64/gemv_t_rvv.c index a80af81b6..f0c834866 100644 --- a/kernel/riscv64/gemv_t_rvv.c +++ b/kernel/riscv64/gemv_t_rvv.c @@ -28,31 +28,31 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include "common.h" #if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m8(n) -#define VSETVL_MAX vsetvlmax_e32m8() -#define VSETVL_MAX_M1 vsetvlmax_e32m1() -#define FLOAT_V_T vfloat32m8_t -#define FLOAT_V_T_M1 vfloat32m1_t -#define VLEV_FLOAT vle32_v_f32m8 -#define VLSEV_FLOAT vlse32_v_f32m8 -#define VFREDSUM_FLOAT vfredusum_vs_f32m8_f32m1 -#define VFMACCVV_FLOAT vfmacc_vv_f32m8 -#define VFMVVF_FLOAT vfmv_v_f_f32m8 -#define VFMVVF_FLOAT_M1 vfmv_v_f_f32m1 -#define VFMVFS_FLOAT_M1 vfmv_f_s_f32m1_f32 +#define VSETVL(n) __riscv_vsetvl_e32m8(n) +#define VSETVL_MAX __riscv_vsetvlmax_e32m8() +#define VSETVL_MAX_M1 __riscv_vsetvlmax_e32m1() +#define FLOAT_V_T vfloat32m8_t +#define FLOAT_V_T_M1 vfloat32m1_t +#define VLEV_FLOAT __riscv_vle32_v_f32m8 +#define VLSEV_FLOAT __riscv_vlse32_v_f32m8 +#define VFREDSUM_FLOAT __riscv_vfredusum_vs_f32m8_f32m1 +#define VFMACCVV_FLOAT __riscv_vfmacc_vv_f32m8 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m8 +#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f32m1 +#define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f32m1_f32 #else -#define VSETVL(n) vsetvl_e64m8(n) -#define VSETVL_MAX vsetvlmax_e64m8() -#define VSETVL_MAX_M1 vsetvlmax_e64m1() -#define FLOAT_V_T vfloat64m8_t -#define FLOAT_V_T_M1 vfloat64m1_t -#define VLEV_FLOAT vle64_v_f64m8 -#define VLSEV_FLOAT vlse64_v_f64m8 -#define VFREDSUM_FLOAT vfredusum_vs_f64m8_f64m1 -#define VFMACCVV_FLOAT vfmacc_vv_f64m8 -#define VFMVVF_FLOAT vfmv_v_f_f64m8 -#define VFMVVF_FLOAT_M1 vfmv_v_f_f64m1 -#define VFMVFS_FLOAT_M1 vfmv_f_s_f64m1_f64 +#define VSETVL(n) __riscv_vsetvl_e64m8(n) +#define VSETVL_MAX __riscv_vsetvlmax_e64m8() +#define VSETVL_MAX_M1 __riscv_vsetvlmax_e64m1() +#define FLOAT_V_T vfloat64m8_t +#define FLOAT_V_T_M1 vfloat64m1_t +#define VLEV_FLOAT __riscv_vle64_v_f64m8 +#define VLSEV_FLOAT __riscv_vlse64_v_f64m8 +#define VFREDSUM_FLOAT __riscv_vfredusum_vs_f64m8_f64m1 +#define VFMACCVV_FLOAT __riscv_vfmacc_vv_f64m8 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m8 +#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f64m1 +#define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f64m1_f64 #endif int CNAME(BLASLONG m, BLASLONG n, BLASLONG dummy1, FLOAT alpha, FLOAT *a, BLASLONG lda, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y, FLOAT *buffer) @@ -63,7 +63,6 @@ int CNAME(BLASLONG m, BLASLONG n, BLASLONG dummy1, FLOAT alpha, FLOAT *a, BLASLO FLOAT_V_T va, vx, vr; FLOAT_V_T_M1 v_res, v_z0; size_t vlmax = VSETVL_MAX_M1; - v_res = VFMVVF_FLOAT_M1(0, vlmax); v_z0 = VFMVVF_FLOAT_M1(0, vlmax); vlmax = VSETVL_MAX; @@ -83,7 +82,7 @@ int CNAME(BLASLONG m, BLASLONG n, BLASLONG dummy1, FLOAT alpha, FLOAT *a, BLASLO vr = VFMACCVV_FLOAT(vr, va, vx, vl); } - v_res = VFREDSUM_FLOAT(v_res, vr, v_z0, vlmax); + v_res = VFREDSUM_FLOAT(vr, v_z0, vlmax); *y += alpha * VFMVFS_FLOAT_M1(v_res); y += inc_y; a += lda; @@ -107,7 +106,7 @@ int CNAME(BLASLONG m, BLASLONG n, BLASLONG dummy1, FLOAT alpha, FLOAT *a, BLASLO vr = VFMACCVV_FLOAT(vr, va, vx, vl); } - v_res = VFREDSUM_FLOAT(v_res, vr, v_z0, vlmax); + v_res = VFREDSUM_FLOAT(vr, v_z0, vlmax); *y += alpha * VFMVFS_FLOAT_M1(v_res); y += inc_y; a += lda; diff --git a/kernel/riscv64/iamax_rvv.c b/kernel/riscv64/iamax_rvv.c index 8b33b3bcb..ef7850a55 100644 --- a/kernel/riscv64/iamax_rvv.c +++ b/kernel/riscv64/iamax_rvv.c @@ -28,57 +28,57 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include "common.h" #if defined(DOUBLE) -#define VSETVL(n) vsetvl_e64m8(n) -#define VSETVL_MAX vsetvlmax_e64m8() -#define FLOAT_V_T vfloat64m8_t -#define FLOAT_V_T_M1 vfloat64m1_t -#define VLEV_FLOAT vle64_v_f64m8 -#define VLSEV_FLOAT vlse64_v_f64m8 -#define VFREDMAXVS_FLOAT vfredmax_vs_f64m8_f64m1 -#define MASK_T vbool8_t -#define VMFLTVF_FLOAT vmflt_vf_f64m8_b8 -#define VMFLTVV_FLOAT vmflt_vv_f64m8_b8 -#define VMFGEVF_FLOAT vmfge_vf_f64m8_b8 -#define VFMVVF_FLOAT vfmv_v_f_f64m8 -#define VFMVVF_FLOAT_M1 vfmv_v_f_f64m1 -#define VFABSV_FLOAT vfabs_v_f64m8 -#define VFMAXVV_FLOAT vfmax_vv_f64m8 -#define VFIRSTM vfirst_m_b8 -#define UINT_V_T vuint64m8_t -#define VIDV_MASK_UINT vid_v_u64m8_m -#define VIDV_UINT vid_v_u64m8 -#define VADDVX_MASK_UINT vadd_vx_u64m8_m -#define VADDVX_UINT vadd_vx_u64m8 -#define VMVVX_UINT vmv_v_x_u64m8 -#define VFMVFS_FLOAT_M1 vfmv_f_s_f64m1_f64 -#define VSLIDEDOWN_UINT vslidedown_vx_u64m8 -#define VMVVXS_UINT vmv_x_s_u64m8_u64 +#define VSETVL(n) __riscv_vsetvl_e64m8(n) +#define VSETVL_MAX __riscv_vsetvlmax_e64m8() +#define FLOAT_V_T vfloat64m8_t +#define FLOAT_V_T_M1 vfloat64m1_t +#define VLEV_FLOAT __riscv_vle64_v_f64m8 +#define VLSEV_FLOAT __riscv_vlse64_v_f64m8 +#define VFREDMAXVS_FLOAT __riscv_vfredmax_vs_f64m8_f64m1 +#define MASK_T vbool8_t +#define VMFLTVF_FLOAT __riscv_vmflt_vf_f64m8_b8 +#define VMFLTVV_FLOAT __riscv_vmflt_vv_f64m8_b8 +#define VMFGEVF_FLOAT __riscv_vmfge_vf_f64m8_b8 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m8 +#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f64m1 +#define VFABSV_FLOAT __riscv_vfabs_v_f64m8 +#define VFMAXVV_FLOAT __riscv_vfmax_vv_f64m8 +#define VFIRSTM __riscv_vfirst_m_b8 +#define UINT_V_T vuint64m8_t +#define VIDV_MASK_UINT __riscv_vid_v_u64m8_m +#define VIDV_UINT __riscv_vid_v_u64m8 +#define VADDVX_MASK_UINT __riscv_vadd_vx_u64m8_m +#define VADDVX_UINT __riscv_vadd_vx_u64m8 +#define VMVVX_UINT __riscv_vmv_v_x_u64m8 +#define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f64m1_f64 +#define VSLIDEDOWN_UINT __riscv_vslidedown_vx_u64m8 +#define VMVVXS_UINT __riscv_vmv_x_s_u64m8_u64 #else -#define VSETVL(n) vsetvl_e32m8(n) -#define VSETVL_MAX vsetvlmax_e32m8() -#define FLOAT_V_T vfloat32m8_t -#define FLOAT_V_T_M1 vfloat32m1_t -#define VLEV_FLOAT vle32_v_f32m8 -#define VLSEV_FLOAT vlse32_v_f32m8 -#define VFREDMAXVS_FLOAT vfredmax_vs_f32m8_f32m1 -#define MASK_T vbool4_t -#define VMFLTVF_FLOAT vmflt_vf_f32m8_b4 -#define VMFLTVV_FLOAT vmflt_vv_f32m8_b4 -#define VMFGEVF_FLOAT vmfge_vf_f32m8_b4 -#define VFMVVF_FLOAT vfmv_v_f_f32m8 -#define VFMVVF_FLOAT_M1 vfmv_v_f_f32m1 -#define VFABSV_FLOAT vfabs_v_f32m8 -#define VFMAXVV_FLOAT vfmax_vv_f32m8 -#define VFIRSTM vfirst_m_b4 -#define UINT_V_T vuint32m8_t -#define VIDV_MASK_UINT vid_v_u32m8_m -#define VIDV_UINT vid_v_u32m8 -#define VADDVX_MASK_UINT vadd_vx_u32m8_m -#define VADDVX_UINT vadd_vx_u32m8 -#define VMVVX_UINT vmv_v_x_u32m8 -#define VFMVFS_FLOAT_M1 vfmv_f_s_f32m1_f32 -#define VSLIDEDOWN_UINT vslidedown_vx_u32m8 -#define VMVVXS_UINT vmv_x_s_u32m8_u32 +#define VSETVL(n) __riscv_vsetvl_e32m8(n) +#define VSETVL_MAX __riscv_vsetvlmax_e32m8() +#define FLOAT_V_T vfloat32m8_t +#define FLOAT_V_T_M1 vfloat32m1_t +#define VLEV_FLOAT __riscv_vle32_v_f32m8 +#define VLSEV_FLOAT __riscv_vlse32_v_f32m8 +#define VFREDMAXVS_FLOAT __riscv_vfredmax_vs_f32m8_f32m1 +#define MASK_T vbool4_t +#define VMFLTVF_FLOAT __riscv_vmflt_vf_f32m8_b4 +#define VMFLTVV_FLOAT __riscv_vmflt_vv_f32m8_b4 +#define VMFGEVF_FLOAT __riscv_vmfge_vf_f32m8_b4 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m8 +#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f32m1 +#define VFABSV_FLOAT __riscv_vfabs_v_f32m8 +#define VFMAXVV_FLOAT __riscv_vfmax_vv_f32m8 +#define VFIRSTM __riscv_vfirst_m_b4 +#define UINT_V_T vuint32m8_t +#define VIDV_MASK_UINT __riscv_vid_v_u32m8_m +#define VIDV_UINT __riscv_vid_v_u32m8 +#define VADDVX_MASK_UINT __riscv_vadd_vx_u32m8_m +#define VADDVX_UINT __riscv_vadd_vx_u32m8 +#define VMVVX_UINT __riscv_vmv_v_x_u32m8 +#define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f32m1_f32 +#define VSLIDEDOWN_UINT __riscv_vslidedown_vx_u32m8 +#define VMVVXS_UINT __riscv_vmv_x_s_u32m8_u32 #endif BLASLONG CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) @@ -106,8 +106,8 @@ BLASLONG CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) //index where element greater than v_max mask = VMFLTVV_FLOAT(v_max, vx, vl); - v_max_index = VIDV_MASK_UINT(mask, v_max_index, vl); - v_max_index = VADDVX_MASK_UINT(mask, v_max_index, v_max_index, j, vl); + v_max_index = VIDV_MASK_UINT(mask, vl); + v_max_index = VADDVX_MASK_UINT(mask, v_max_index, j, vl); //update v_max v_max = VFMAXVV_FLOAT(v_max, vx, vl); @@ -125,8 +125,8 @@ BLASLONG CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) //index where element greater than v_max mask = VMFLTVV_FLOAT(v_max, vx, vl); - v_max_index = VIDV_MASK_UINT(mask, v_max_index, vl); - v_max_index = VADDVX_MASK_UINT(mask, v_max_index, v_max_index, j, vl); + v_max_index = VIDV_MASK_UINT(mask, vl); + v_max_index = VADDVX_MASK_UINT(mask, v_max_index, j, vl); //update v_max v_max = VFMAXVV_FLOAT(v_max, vx, vl); @@ -134,16 +134,15 @@ BLASLONG CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) } - FLOAT_V_T_M1 v_res, v_z0; + FLOAT_V_T_M1 v_res; v_res = VFMVVF_FLOAT_M1(0, vlmax); - v_z0 = VFMVVF_FLOAT_M1(0, vlmax); - v_res = VFREDMAXVS_FLOAT(v_res, v_max, v_z0, vlmax); + v_res = VFREDMAXVS_FLOAT(v_max, v_res, vlmax); maxf = VFMVFS_FLOAT_M1(v_res); mask = VMFGEVF_FLOAT(v_max, maxf, vlmax); max_index = VFIRSTM(mask, vlmax); - v_max_index = VSLIDEDOWN_UINT(v_max_index, v_max_index, max_index, vlmax); + v_max_index = VSLIDEDOWN_UINT(v_max_index, max_index, vlmax); max_index = VMVVXS_UINT(v_max_index); return(max_index+1); diff --git a/kernel/riscv64/iamin_rvv.c b/kernel/riscv64/iamin_rvv.c index 585b37186..56a086fed 100644 --- a/kernel/riscv64/iamin_rvv.c +++ b/kernel/riscv64/iamin_rvv.c @@ -29,57 +29,57 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include #if defined(DOUBLE) -#define VSETVL(n) vsetvl_e64m8(n) -#define VSETVL_MAX vsetvlmax_e64m8() -#define FLOAT_V_T vfloat64m8_t -#define FLOAT_V_T_M1 vfloat64m1_t -#define VLEV_FLOAT vle64_v_f64m8 -#define VLSEV_FLOAT vlse64_v_f64m8 -#define VFREDMINVS_FLOAT vfredmin_vs_f64m8_f64m1 -#define MASK_T vbool8_t -#define VMFLTVF_FLOAT vmflt_vf_f64m8_b8 -#define VMFLTVV_FLOAT vmflt_vv_f64m8_b8 -#define VMFLEVF_FLOAT vmfle_vf_f64m8_b8 -#define VFMVVF_FLOAT vfmv_v_f_f64m8 -#define VFMVVF_FLOAT_M1 vfmv_v_f_f64m1 -#define VFABSV_FLOAT vfabs_v_f64m8 -#define VFMINVV_FLOAT vfmin_vv_f64m8 -#define VFIRSTM vfirst_m_b8 -#define UINT_V_T vuint64m8_t -#define VIDV_MASK_UINT vid_v_u64m8_m -#define VIDV_UINT vid_v_u64m8 -#define VADDVX_MASK_UINT vadd_vx_u64m8_m -#define VADDVX_UINT vadd_vx_u64m8 -#define VMVVX_UINT vmv_v_x_u64m8 -#define VFMVFS_FLOAT_M1 vfmv_f_s_f64m1_f64 -#define VSLIDEDOWN_UINT vslidedown_vx_u64m8 -#define VMVVXS_UINT vmv_x_s_u64m8_u64 +#define VSETVL(n) __riscv_vsetvl_e64m8(n) +#define VSETVL_MAX __riscv_vsetvlmax_e64m8() +#define FLOAT_V_T vfloat64m8_t +#define FLOAT_V_T_M1 vfloat64m1_t +#define VLEV_FLOAT __riscv_vle64_v_f64m8 +#define VLSEV_FLOAT __riscv_vlse64_v_f64m8 +#define VFREDMINVS_FLOAT __riscv_vfredmin_vs_f64m8_f64m1 +#define MASK_T vbool8_t +#define VMFLTVF_FLOAT __riscv_vmflt_vf_f64m8_b8 +#define VMFLTVV_FLOAT __riscv_vmflt_vv_f64m8_b8 +#define VMFLEVF_FLOAT __riscv_vmfle_vf_f64m8_b8 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m8 +#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f64m1 +#define VFABSV_FLOAT __riscv_vfabs_v_f64m8 +#define VFMINVV_FLOAT __riscv_vfmin_vv_f64m8 +#define VFIRSTM __riscv_vfirst_m_b8 +#define UINT_V_T vuint64m8_t +#define VIDV_MASK_UINT __riscv_vid_v_u64m8_m +#define VIDV_UINT __riscv_vid_v_u64m8 +#define VADDVX_MASK_UINT __riscv_vadd_vx_u64m8_m +#define VADDVX_UINT __riscv_vadd_vx_u64m8 +#define VMVVX_UINT __riscv_vmv_v_x_u64m8 +#define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f64m1_f64 +#define VSLIDEDOWN_UINT __riscv_vslidedown_vx_u64m8 +#define VMVVXS_UINT __riscv_vmv_x_s_u64m8_u64 #else -#define VSETVL(n) vsetvl_e32m8(n) -#define VSETVL_MAX vsetvlmax_e32m8() -#define FLOAT_V_T vfloat32m8_t -#define FLOAT_V_T_M1 vfloat32m1_t -#define VLEV_FLOAT vle32_v_f32m8 -#define VLSEV_FLOAT vlse32_v_f32m8 -#define VFREDMINVS_FLOAT vfredmin_vs_f32m8_f32m1 -#define MASK_T vbool4_t -#define VMFLTVF_FLOAT vmflt_vf_f32m8_b4 -#define VMFLTVV_FLOAT vmflt_vv_f32m8_b4 -#define VMFLEVF_FLOAT vmfle_vf_f32m8_b4 -#define VFMVVF_FLOAT vfmv_v_f_f32m8 -#define VFMVVF_FLOAT_M1 vfmv_v_f_f32m1 -#define VFABSV_FLOAT vfabs_v_f32m8 -#define VFMINVV_FLOAT vfmin_vv_f32m8 -#define VFIRSTM vfirst_m_b4 -#define UINT_V_T vuint32m8_t -#define VIDV_MASK_UINT vid_v_u32m8_m -#define VIDV_UINT vid_v_u32m8 -#define VADDVX_MASK_UINT vadd_vx_u32m8_m -#define VADDVX_UINT vadd_vx_u32m8 -#define VMVVX_UINT vmv_v_x_u32m8 -#define VFMVFS_FLOAT_M1 vfmv_f_s_f32m1_f32 -#define VSLIDEDOWN_UINT vslidedown_vx_u32m8 -#define VMVVXS_UINT vmv_x_s_u32m8_u32 +#define VSETVL(n) __riscv_vsetvl_e32m8(n) +#define VSETVL_MAX __riscv_vsetvlmax_e32m8() +#define FLOAT_V_T vfloat32m8_t +#define FLOAT_V_T_M1 vfloat32m1_t +#define VLEV_FLOAT __riscv_vle32_v_f32m8 +#define VLSEV_FLOAT __riscv_vlse32_v_f32m8 +#define VFREDMINVS_FLOAT __riscv_vfredmin_vs_f32m8_f32m1 +#define MASK_T vbool4_t +#define VMFLTVF_FLOAT __riscv_vmflt_vf_f32m8_b4 +#define VMFLTVV_FLOAT __riscv_vmflt_vv_f32m8_b4 +#define VMFLEVF_FLOAT __riscv_vmfle_vf_f32m8_b4 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m8 +#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f32m1 +#define VFABSV_FLOAT __riscv_vfabs_v_f32m8 +#define VFMINVV_FLOAT __riscv_vfmin_vv_f32m8 +#define VFIRSTM __riscv_vfirst_m_b4 +#define UINT_V_T vuint32m8_t +#define VIDV_MASK_UINT __riscv_vid_v_u32m8_m +#define VIDV_UINT __riscv_vid_v_u32m8 +#define VADDVX_MASK_UINT __riscv_vadd_vx_u32m8_m +#define VADDVX_UINT __riscv_vadd_vx_u32m8 +#define VMVVX_UINT __riscv_vmv_v_x_u32m8 +#define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f32m1_f32 +#define VSLIDEDOWN_UINT __riscv_vslidedown_vx_u32m8 +#define VMVVXS_UINT __riscv_vmv_x_s_u32m8_u32 #endif BLASLONG CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) @@ -107,8 +107,8 @@ BLASLONG CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) // index where element less than v_min mask = VMFLTVV_FLOAT(vx, v_min, vl); - v_min_index = VIDV_MASK_UINT(mask, v_min_index, vl); - v_min_index = VADDVX_MASK_UINT(mask, v_min_index, v_min_index, j, vl); + v_min_index = VIDV_MASK_UINT(mask, vl); + v_min_index = VADDVX_MASK_UINT(mask, v_min_index, j, vl); //update v_min and start_index j v_min = VFMINVV_FLOAT(v_min, vx, vl); @@ -126,8 +126,8 @@ BLASLONG CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) // index where element less than v_min mask = VMFLTVV_FLOAT(vx, v_min, vl); - v_min_index = VIDV_MASK_UINT(mask, v_min_index, vl); - v_min_index = VADDVX_MASK_UINT(mask, v_min_index, v_min_index, j, vl); + v_min_index = VIDV_MASK_UINT(mask, vl); + v_min_index = VADDVX_MASK_UINT(mask, v_min_index, j, vl); //update v_min and start_index j v_min = VFMINVV_FLOAT(v_min, vx, vl); @@ -135,16 +135,15 @@ BLASLONG CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) } - FLOAT_V_T_M1 v_res, v_max; - v_res = VFMVVF_FLOAT_M1(0, vlmax); - v_max = VFMVVF_FLOAT_M1(FLT_MAX, vlmax); + FLOAT_V_T_M1 v_res; + v_res = VFMVVF_FLOAT_M1(FLT_MAX, vlmax); - v_res = VFREDMINVS_FLOAT(v_res, v_min, v_max, vlmax); + v_res = VFREDMINVS_FLOAT(v_min, v_res, vlmax); minf = VFMVFS_FLOAT_M1(v_res); mask = VMFLEVF_FLOAT(v_min, minf, vlmax); min_index = VFIRSTM(mask, vlmax); - v_min_index = VSLIDEDOWN_UINT(v_min_index, v_min_index, min_index, vlmax); + v_min_index = VSLIDEDOWN_UINT(v_min_index, min_index, vlmax); min_index = VMVVXS_UINT(v_min_index); return(min_index+1); diff --git a/kernel/riscv64/imax_rvv.c b/kernel/riscv64/imax_rvv.c index d84ad968e..5b60a56f7 100644 --- a/kernel/riscv64/imax_rvv.c +++ b/kernel/riscv64/imax_rvv.c @@ -29,55 +29,55 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include #if defined(DOUBLE) -#define VSETVL(n) vsetvl_e64m8(n) -#define VSETVL_MAX vsetvlmax_e64m8() -#define FLOAT_V_T vfloat64m8_t -#define FLOAT_V_T_M1 vfloat64m1_t -#define VLEV_FLOAT vle64_v_f64m8 -#define VLSEV_FLOAT vlse64_v_f64m8 -#define VFREDMAXVS_FLOAT vfredmax_vs_f64m8_f64m1 -#define MASK_T vbool8_t -#define VMFLTVF_FLOAT vmflt_vf_f64m8_b8 -#define VMFLTVV_FLOAT vmflt_vv_f64m8_b8 -#define VMFGEVF_FLOAT vmfge_vf_f64m8_b8 -#define VFMVVF_FLOAT vfmv_v_f_f64m8 -#define VFMVVF_FLOAT_M1 vfmv_v_f_f64m1 -#define VFMAXVV_FLOAT vfmax_vv_f64m8 -#define VFIRSTM vfirst_m_b8 -#define UINT_V_T vuint64m8_t -#define VIDV_MASK_UINT vid_v_u64m8_m -#define VIDV_UINT vid_v_u64m8 -#define VADDVX_MASK_UINT vadd_vx_u64m8_m -#define VADDVX_UINT vadd_vx_u64m8 -#define VMVVX_UINT vmv_v_x_u64m8 -#define VFMVFS_FLOAT_M1 vfmv_f_s_f64m1_f64 -#define VSLIDEDOWN_UINT vslidedown_vx_u64m8 -#define VMVVXS_UINT vmv_x_s_u64m8_u64 +#define VSETVL(n) __riscv_vsetvl_e64m8(n) +#define VSETVL_MAX __riscv_vsetvlmax_e64m8() +#define FLOAT_V_T vfloat64m8_t +#define FLOAT_V_T_M1 vfloat64m1_t +#define VLEV_FLOAT __riscv_vle64_v_f64m8 +#define VLSEV_FLOAT __riscv_vlse64_v_f64m8 +#define VFREDMAXVS_FLOAT __riscv_vfredmax_vs_f64m8_f64m1 +#define MASK_T vbool8_t +#define VMFLTVF_FLOAT __riscv_vmflt_vf_f64m8_b8 +#define VMFLTVV_FLOAT __riscv_vmflt_vv_f64m8_b8 +#define VMFGEVF_FLOAT __riscv_vmfge_vf_f64m8_b8 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m8 +#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f64m1 +#define VFMAXVV_FLOAT __riscv_vfmax_vv_f64m8 +#define VFIRSTM __riscv_vfirst_m_b8 +#define UINT_V_T vuint64m8_t +#define VIDV_MASK_UINT __riscv_vid_v_u64m8_m +#define VIDV_UINT __riscv_vid_v_u64m8 +#define VADDVX_MASK_UINT __riscv_vadd_vx_u64m8_m +#define VADDVX_UINT __riscv_vadd_vx_u64m8 +#define VMVVX_UINT __riscv_vmv_v_x_u64m8 +#define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f64m1_f64 +#define VSLIDEDOWN_UINT __riscv_vslidedown_vx_u64m8 +#define VMVVXS_UINT __riscv_vmv_x_s_u64m8_u64 #else -#define VSETVL(n) vsetvl_e32m8(n) -#define VSETVL_MAX vsetvlmax_e32m8() -#define FLOAT_V_T vfloat32m8_t -#define FLOAT_V_T_M1 vfloat32m1_t -#define VLEV_FLOAT vle32_v_f32m8 -#define VLSEV_FLOAT vlse32_v_f32m8 -#define VFREDMAXVS_FLOAT vfredmax_vs_f32m8_f32m1 -#define MASK_T vbool4_t -#define VMFLTVF_FLOAT vmflt_vf_f32m8_b4 -#define VMFLTVV_FLOAT vmflt_vv_f32m8_b4 -#define VMFGEVF_FLOAT vmfge_vf_f32m8_b4 -#define VFMVVF_FLOAT vfmv_v_f_f32m8 -#define VFMVVF_FLOAT_M1 vfmv_v_f_f32m1 -#define VFMAXVV_FLOAT vfmax_vv_f32m8 -#define VFIRSTM vfirst_m_b4 -#define UINT_V_T vuint32m8_t -#define VIDV_MASK_UINT vid_v_u32m8_m -#define VIDV_UINT vid_v_u32m8 -#define VADDVX_MASK_UINT vadd_vx_u32m8_m -#define VADDVX_UINT vadd_vx_u32m8 -#define VMVVX_UINT vmv_v_x_u32m8 -#define VFMVFS_FLOAT_M1 vfmv_f_s_f32m1_f32 -#define VSLIDEDOWN_UINT vslidedown_vx_u32m8 -#define VMVVXS_UINT vmv_x_s_u32m8_u32 +#define VSETVL(n) __riscv_vsetvl_e32m8(n) +#define VSETVL_MAX __riscv_vsetvlmax_e32m8() +#define FLOAT_V_T vfloat32m8_t +#define FLOAT_V_T_M1 vfloat32m1_t +#define VLEV_FLOAT __riscv_vle32_v_f32m8 +#define VLSEV_FLOAT __riscv_vlse32_v_f32m8 +#define VFREDMAXVS_FLOAT __riscv_vfredmax_vs_f32m8_f32m1 +#define MASK_T vbool4_t +#define VMFLTVF_FLOAT __riscv_vmflt_vf_f32m8_b4 +#define VMFLTVV_FLOAT __riscv_vmflt_vv_f32m8_b4 +#define VMFGEVF_FLOAT __riscv_vmfge_vf_f32m8_b4 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m8 +#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f32m1 +#define VFMAXVV_FLOAT __riscv_vfmax_vv_f32m8 +#define VFIRSTM __riscv_vfirst_m_b4 +#define UINT_V_T vuint32m8_t +#define VIDV_MASK_UINT __riscv_vid_v_u32m8_m +#define VIDV_UINT __riscv_vid_v_u32m8 +#define VADDVX_MASK_UINT __riscv_vadd_vx_u32m8_m +#define VADDVX_UINT __riscv_vadd_vx_u32m8 +#define VMVVX_UINT __riscv_vmv_v_x_u32m8 +#define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f32m1_f32 +#define VSLIDEDOWN_UINT __riscv_vslidedown_vx_u32m8 +#define VMVVXS_UINT __riscv_vmv_x_s_u32m8_u32 #endif BLASLONG CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) @@ -104,8 +104,8 @@ BLASLONG CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) //index where element greater than v_max mask = VMFLTVV_FLOAT(v_max, vx, vl); - v_max_index = VIDV_MASK_UINT(mask, v_max_index, vl); - v_max_index = VADDVX_MASK_UINT(mask, v_max_index, v_max_index, j, vl); + v_max_index = VIDV_MASK_UINT(mask, vl); + v_max_index = VADDVX_MASK_UINT(mask, v_max_index, j, vl); //update v_max and start_index j v_max = VFMAXVV_FLOAT(v_max, vx, vl); @@ -122,8 +122,8 @@ BLASLONG CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) //index where element greater than v_max mask = VMFLTVV_FLOAT(v_max, vx, vl); - v_max_index = VIDV_MASK_UINT(mask, v_max_index, vl); - v_max_index = VADDVX_MASK_UINT(mask, v_max_index, v_max_index, j, vl); + v_max_index = VIDV_MASK_UINT(mask, vl); + v_max_index = VADDVX_MASK_UINT(mask, v_max_index, j, vl); //update v_max and start_index j v_max = VFMAXVV_FLOAT(v_max, vx, vl); @@ -131,16 +131,15 @@ BLASLONG CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) } - FLOAT_V_T_M1 v_res, v_min; - v_res = VFMVVF_FLOAT_M1(0, vlmax); - v_min = VFMVVF_FLOAT_M1(-FLT_MAX, vlmax); + FLOAT_V_T_M1 v_res; + v_res = VFMVVF_FLOAT_M1(-FLT_MAX, vlmax); - v_res = VFREDMAXVS_FLOAT(v_res, v_max, v_min, vlmax); + v_res = VFREDMAXVS_FLOAT(v_max, v_res, vlmax); maxf = VFMVFS_FLOAT_M1(v_res); mask = VMFGEVF_FLOAT(v_max, maxf, vlmax); max_index = VFIRSTM(mask, vlmax); - v_max_index = VSLIDEDOWN_UINT(v_max_index, v_max_index, max_index, vlmax); + v_max_index = VSLIDEDOWN_UINT(v_max_index, max_index, vlmax); max_index = VMVVXS_UINT(v_max_index); return(max_index+1); diff --git a/kernel/riscv64/imin_rvv.c b/kernel/riscv64/imin_rvv.c index fb734f6f8..b49544a1b 100644 --- a/kernel/riscv64/imin_rvv.c +++ b/kernel/riscv64/imin_rvv.c @@ -29,55 +29,55 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include #if defined(DOUBLE) -#define VSETVL(n) vsetvl_e64m8(n) -#define VSETVL_MAX vsetvlmax_e64m8() -#define FLOAT_V_T vfloat64m8_t -#define FLOAT_V_T_M1 vfloat64m1_t -#define VLEV_FLOAT vle64_v_f64m8 -#define VLSEV_FLOAT vlse64_v_f64m8 -#define VFREDMINVS_FLOAT vfredmin_vs_f64m8_f64m1 -#define MASK_T vbool8_t -#define VMFLTVF_FLOAT vmflt_vf_f64m8_b8 -#define VMFLTVV_FLOAT vmflt_vv_f64m8_b8 -#define VMFLEVF_FLOAT vmfle_vf_f64m8_b8 -#define VFMVVF_FLOAT vfmv_v_f_f64m8 -#define VFMVVF_FLOAT_M1 vfmv_v_f_f64m1 -#define VFMINVV_FLOAT vfmin_vv_f64m8 -#define VFIRSTM vfirst_m_b8 -#define UINT_V_T vuint64m8_t -#define VIDV_MASK_UINT vid_v_u64m8_m -#define VIDV_UINT vid_v_u64m8 -#define VADDVX_MASK_UINT vadd_vx_u64m8_m -#define VADDVX_UINT vadd_vx_u64m8 -#define VMVVX_UINT vmv_v_x_u64m8 -#define VFMVFS_FLOAT_M1 vfmv_f_s_f64m1_f64 -#define VSLIDEDOWN_UINT vslidedown_vx_u64m8 -#define VMVVXS_UINT vmv_x_s_u64m8_u64 +#define VSETVL(n) __riscv_vsetvl_e64m8(n) +#define VSETVL_MAX __riscv_vsetvlmax_e64m8() +#define FLOAT_V_T vfloat64m8_t +#define FLOAT_V_T_M1 vfloat64m1_t +#define VLEV_FLOAT __riscv_vle64_v_f64m8 +#define VLSEV_FLOAT __riscv_vlse64_v_f64m8 +#define VFREDMINVS_FLOAT __riscv_vfredmin_vs_f64m8_f64m1 +#define MASK_T vbool8_t +#define VMFLTVF_FLOAT __riscv_vmflt_vf_f64m8_b8 +#define VMFLTVV_FLOAT __riscv_vmflt_vv_f64m8_b8 +#define VMFLEVF_FLOAT __riscv_vmfle_vf_f64m8_b8 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m8 +#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f64m1 +#define VFMINVV_FLOAT __riscv_vfmin_vv_f64m8 +#define VFIRSTM __riscv_vfirst_m_b8 +#define UINT_V_T vuint64m8_t +#define VIDV_MASK_UINT __riscv_vid_v_u64m8_m +#define VIDV_UINT __riscv_vid_v_u64m8 +#define VADDVX_MASK_UINT __riscv_vadd_vx_u64m8_m +#define VADDVX_UINT __riscv_vadd_vx_u64m8 +#define VMVVX_UINT __riscv_vmv_v_x_u64m8 +#define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f64m1_f64 +#define VSLIDEDOWN_UINT __riscv_vslidedown_vx_u64m8 +#define VMVVXS_UINT __riscv_vmv_x_s_u64m8_u64 #else -#define VSETVL(n) vsetvl_e32m8(n) -#define VSETVL_MAX vsetvlmax_e32m8() -#define FLOAT_V_T vfloat32m8_t -#define FLOAT_V_T_M1 vfloat32m1_t -#define VLEV_FLOAT vle32_v_f32m8 -#define VLSEV_FLOAT vlse32_v_f32m8 -#define VFREDMINVS_FLOAT vfredmin_vs_f32m8_f32m1 -#define MASK_T vbool4_t -#define VMFLTVF_FLOAT vmflt_vf_f32m8_b4 -#define VMFLTVV_FLOAT vmflt_vv_f32m8_b4 -#define VMFLEVF_FLOAT vmfle_vf_f32m8_b4 -#define VFMVVF_FLOAT vfmv_v_f_f32m8 -#define VFMVVF_FLOAT_M1 vfmv_v_f_f32m1 -#define VFMINVV_FLOAT vfmin_vv_f32m8 -#define VFIRSTM vfirst_m_b4 -#define UINT_V_T vuint32m8_t -#define VIDV_MASK_UINT vid_v_u32m8_m -#define VIDV_UINT vid_v_u32m8 -#define VADDVX_MASK_UINT vadd_vx_u32m8_m -#define VADDVX_UINT vadd_vx_u32m8 -#define VMVVX_UINT vmv_v_x_u32m8 -#define VFMVFS_FLOAT_M1 vfmv_f_s_f32m1_f32 -#define VSLIDEDOWN_UINT vslidedown_vx_u32m8 -#define VMVVXS_UINT vmv_x_s_u32m8_u32 +#define VSETVL(n) __riscv_vsetvl_e32m8(n) +#define VSETVL_MAX __riscv_vsetvlmax_e32m8() +#define FLOAT_V_T vfloat32m8_t +#define FLOAT_V_T_M1 vfloat32m1_t +#define VLEV_FLOAT __riscv_vle32_v_f32m8 +#define VLSEV_FLOAT __riscv_vlse32_v_f32m8 +#define VFREDMINVS_FLOAT __riscv_vfredmin_vs_f32m8_f32m1 +#define MASK_T vbool4_t +#define VMFLTVF_FLOAT __riscv_vmflt_vf_f32m8_b4 +#define VMFLTVV_FLOAT __riscv_vmflt_vv_f32m8_b4 +#define VMFLEVF_FLOAT __riscv_vmfle_vf_f32m8_b4 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m8 +#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f32m1 +#define VFMINVV_FLOAT __riscv_vfmin_vv_f32m8 +#define VFIRSTM __riscv_vfirst_m_b4 +#define UINT_V_T vuint32m8_t +#define VIDV_MASK_UINT __riscv_vid_v_u32m8_m +#define VIDV_UINT __riscv_vid_v_u32m8 +#define VADDVX_MASK_UINT __riscv_vadd_vx_u32m8_m +#define VADDVX_UINT __riscv_vadd_vx_u32m8 +#define VMVVX_UINT __riscv_vmv_v_x_u32m8 +#define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f32m1_f32 +#define VSLIDEDOWN_UINT __riscv_vslidedown_vx_u32m8 +#define VMVVXS_UINT __riscv_vmv_x_s_u32m8_u32 #endif BLASLONG CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) @@ -104,8 +104,8 @@ BLASLONG CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) // index where element less than v_min mask = VMFLTVV_FLOAT(vx, v_min, vl); - v_min_index = VIDV_MASK_UINT(mask, v_min_index, vl); - v_min_index = VADDVX_MASK_UINT(mask, v_min_index, v_min_index, j, vl); + v_min_index = VIDV_MASK_UINT(mask, vl); + v_min_index = VADDVX_MASK_UINT(mask, v_min_index, j, vl); //update v_min and start_index j v_min = VFMINVV_FLOAT(v_min, vx, vl); @@ -122,8 +122,8 @@ BLASLONG CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) // index where element less than v_min mask = VMFLTVV_FLOAT(vx, v_min, vl); - v_min_index = VIDV_MASK_UINT(mask, v_min_index, vl); - v_min_index = VADDVX_MASK_UINT(mask, v_min_index, v_min_index, j, vl); + v_min_index = VIDV_MASK_UINT(mask, vl); + v_min_index = VADDVX_MASK_UINT(mask, v_min_index, j, vl); //update v_min and start_index j v_min = VFMINVV_FLOAT(v_min, vx, vl); @@ -131,16 +131,15 @@ BLASLONG CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) } - FLOAT_V_T_M1 v_res, v_max; - v_res = VFMVVF_FLOAT_M1(0, vlmax); - v_max = VFMVVF_FLOAT_M1(FLT_MAX, vlmax); + FLOAT_V_T_M1 v_res; + v_res = VFMVVF_FLOAT_M1(FLT_MAX, vlmax); - v_res = VFREDMINVS_FLOAT(v_res, v_min, v_max, vlmax); + v_res = VFREDMINVS_FLOAT(v_min, v_res, vlmax); minf = VFMVFS_FLOAT_M1(v_res); mask = VMFLEVF_FLOAT(v_min, minf, vlmax); min_index = VFIRSTM(mask, vlmax); - v_min_index = VSLIDEDOWN_UINT(v_min_index, v_min_index, min_index, vlmax); + v_min_index = VSLIDEDOWN_UINT(v_min_index, min_index, vlmax); min_index = VMVVXS_UINT(v_min_index); return(min_index+1); diff --git a/kernel/riscv64/izamax_rvv.c b/kernel/riscv64/izamax_rvv.c index 9cb332cbb..e61d0cbec 100644 --- a/kernel/riscv64/izamax_rvv.c +++ b/kernel/riscv64/izamax_rvv.c @@ -28,63 +28,63 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include "common.h" #if defined(DOUBLE) -#define VSETVL(n) vsetvl_e64m4(n) -#define VSETVL_MAX vsetvlmax_e64m4() -#define FLOAT_V_T vfloat64m4_t -#define FLOAT_V_T_M1 vfloat64m1_t -#define VLEV_FLOAT vle64_v_f64m4 -#define VLSEV_FLOAT vlse64_v_f64m4 -#define VLSEG_FLOAT vlseg2e64_v_f64m4 -#define VLSSEG_FLOAT vlsseg2e64_v_f64m4 -#define VFREDMAXVS_FLOAT vfredmax_vs_f64m4_f64m1 -#define MASK_T vbool16_t -#define VMFLTVF_FLOAT vmflt_vf_f64m4_b16 -#define VMFLTVV_FLOAT vmflt_vv_f64m4_b16 -#define VMFGEVF_FLOAT vmfge_vf_f64m4_b16 -#define VFMVVF_FLOAT vfmv_v_f_f64m4 -#define VFMVVF_FLOAT_M1 vfmv_v_f_f64m1 -#define VFABSV_FLOAT vfabs_v_f64m4 -#define VFMAXVV_FLOAT vfmax_vv_f64m4 -#define VFADDVV_FLOAT vfadd_vv_f64m4 -#define VFIRSTM vfirst_m_b16 -#define UINT_V_T vuint64m4_t -#define VIDV_MASK_UINT vid_v_u64m4_m -#define VIDV_UINT vid_v_u64m4 -#define VADDVX_MASK_UINT vadd_vx_u64m4_m -#define VADDVX_UINT vadd_vx_u64m4 -#define VMVVX_UINT vmv_v_x_u64m4 -#define VFMVFS_FLOAT_M1 vfmv_f_s_f64m1_f64 -#define VSLIDEDOWN_UINT vslidedown_vx_u64m4 -#define VMVVXS_UINT vmv_x_s_u64m4_u64 +#define VSETVL(n) __riscv_vsetvl_e64m4(n) +#define VSETVL_MAX __riscv_vsetvlmax_e64m4() +#define FLOAT_V_T vfloat64m4_t +#define FLOAT_V_T_M1 vfloat64m1_t +#define VLEV_FLOAT __riscv_vle64_v_f64m4 +#define VLSEV_FLOAT __riscv_vlse64_v_f64m4 +#define VLSEG_FLOAT __riscv_vlseg2e64_v_f64m4 +#define VLSSEG_FLOAT __riscv_vlsseg2e64_v_f64m4 +#define VFREDMAXVS_FLOAT __riscv_vfredmax_vs_f64m4_f64m1 +#define MASK_T vbool16_t +#define VMFLTVF_FLOAT __riscv_vmflt_vf_f64m4_b16 +#define VMFLTVV_FLOAT __riscv_vmflt_vv_f64m4_b16 +#define VMFGEVF_FLOAT __riscv_vmfge_vf_f64m4_b16 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m4 +#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f64m1 +#define VFABSV_FLOAT __riscv_vfabs_v_f64m4 +#define VFMAXVV_FLOAT __riscv_vfmax_vv_f64m4 +#define VFADDVV_FLOAT __riscv_vfadd_vv_f64m4 +#define VFIRSTM __riscv_vfirst_m_b16 +#define UINT_V_T vuint64m4_t +#define VIDV_MASK_UINT __riscv_vid_v_u64m4_m +#define VIDV_UINT __riscv_vid_v_u64m4 +#define VADDVX_MASK_UINT __riscv_vadd_vx_u64m4_m +#define VADDVX_UINT __riscv_vadd_vx_u64m4 +#define VMVVX_UINT __riscv_vmv_v_x_u64m4 +#define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f64m1_f64 +#define VSLIDEDOWN_UINT __riscv_vslidedown_vx_u64m4 +#define VMVVXS_UINT __riscv_vmv_x_s_u64m4_u64 #else -#define VSETVL(n) vsetvl_e32m4(n) -#define VSETVL_MAX vsetvlmax_e32m4() -#define FLOAT_V_T vfloat32m4_t -#define FLOAT_V_T_M1 vfloat32m1_t -#define VLEV_FLOAT vle32_v_f32m4 -#define VLSEV_FLOAT vlse32_v_f32m4 -#define VLSEG_FLOAT vlseg2e32_v_f32m4 -#define VLSSEG_FLOAT vlsseg2e32_v_f32m4 -#define VFREDMAXVS_FLOAT vfredmax_vs_f32m4_f32m1 -#define MASK_T vbool8_t -#define VMFLTVF_FLOAT vmflt_vf_f32m4_b8 -#define VMFLTVV_FLOAT vmflt_vv_f32m4_b8 -#define VMFGEVF_FLOAT vmfge_vf_f32m4_b8 -#define VFMVVF_FLOAT vfmv_v_f_f32m4 -#define VFMVVF_FLOAT_M1 vfmv_v_f_f32m1 -#define VFABSV_FLOAT vfabs_v_f32m4 -#define VFMAXVV_FLOAT vfmax_vv_f32m4 -#define VFADDVV_FLOAT vfadd_vv_f32m4 -#define VFIRSTM vfirst_m_b8 -#define UINT_V_T vuint32m4_t -#define VIDV_MASK_UINT vid_v_u32m4_m -#define VIDV_UINT vid_v_u32m4 -#define VADDVX_MASK_UINT vadd_vx_u32m4_m -#define VADDVX_UINT vadd_vx_u32m4 -#define VMVVX_UINT vmv_v_x_u32m4 -#define VFMVFS_FLOAT_M1 vfmv_f_s_f32m1_f32 -#define VSLIDEDOWN_UINT vslidedown_vx_u32m4 -#define VMVVXS_UINT vmv_x_s_u32m4_u32 +#define VSETVL(n) __riscv_vsetvl_e32m4(n) +#define VSETVL_MAX __riscv_vsetvlmax_e32m4() +#define FLOAT_V_T vfloat32m4_t +#define FLOAT_V_T_M1 vfloat32m1_t +#define VLEV_FLOAT __riscv_vle32_v_f32m4 +#define VLSEV_FLOAT __riscv_vlse32_v_f32m4 +#define VLSEG_FLOAT __riscv_vlseg2e32_v_f32m4 +#define VLSSEG_FLOAT __riscv_vlsseg2e32_v_f32m4 +#define VFREDMAXVS_FLOAT __riscv_vfredmax_vs_f32m4_f32m1 +#define MASK_T vbool8_t +#define VMFLTVF_FLOAT __riscv_vmflt_vf_f32m4_b8 +#define VMFLTVV_FLOAT __riscv_vmflt_vv_f32m4_b8 +#define VMFGEVF_FLOAT __riscv_vmfge_vf_f32m4_b8 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m4 +#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f32m1 +#define VFABSV_FLOAT __riscv_vfabs_v_f32m4 +#define VFMAXVV_FLOAT __riscv_vfmax_vv_f32m4 +#define VFADDVV_FLOAT __riscv_vfadd_vv_f32m4 +#define VFIRSTM __riscv_vfirst_m_b8 +#define UINT_V_T vuint32m4_t +#define VIDV_MASK_UINT __riscv_vid_v_u32m4_m +#define VIDV_UINT __riscv_vid_v_u32m4 +#define VADDVX_MASK_UINT __riscv_vadd_vx_u32m4_m +#define VADDVX_UINT __riscv_vadd_vx_u32m4 +#define VMVVX_UINT __riscv_vmv_v_x_u32m4 +#define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f32m1_f32 +#define VSLIDEDOWN_UINT __riscv_vslidedown_vx_u32m4 +#define VMVVXS_UINT __riscv_vmv_x_s_u32m4_u32 #endif BLASLONG CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) @@ -116,8 +116,8 @@ BLASLONG CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) //index where element greater than v_max mask = VMFLTVV_FLOAT(v_max, vx0, vl); - v_max_index = VIDV_MASK_UINT(mask, v_max_index, vl); - v_max_index = VADDVX_MASK_UINT(mask, v_max_index, v_max_index, j, vl); + v_max_index = VIDV_MASK_UINT(mask, vl); + v_max_index = VADDVX_MASK_UINT(mask, v_max_index, j, vl); //update v_max and start_index j v_max = VFMAXVV_FLOAT(v_max, vx0, vl); @@ -138,24 +138,23 @@ BLASLONG CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) //index where element greater than v_max mask = VMFLTVV_FLOAT(v_max, vx0, vl); - v_max_index = VIDV_MASK_UINT(mask, v_max_index, vl); - v_max_index = VADDVX_MASK_UINT(mask, v_max_index, v_max_index, j, vl); + v_max_index = VIDV_MASK_UINT(mask, vl); + v_max_index = VADDVX_MASK_UINT(mask, v_max_index, j, vl); //update v_max and start_index j v_max = VFMAXVV_FLOAT(v_max, vx0, vl); } } - FLOAT_V_T_M1 v_res, v_z0; + FLOAT_V_T_M1 v_res; v_res = VFMVVF_FLOAT_M1(0, vlmax); - v_z0 = VFMVVF_FLOAT_M1(0, vlmax); - v_res = VFREDMAXVS_FLOAT(v_res, v_max, v_z0, vlmax); + v_res = VFREDMAXVS_FLOAT(v_max, v_res, vlmax); maxf = VFMVFS_FLOAT_M1(v_res); mask = VMFGEVF_FLOAT(v_max, maxf, vlmax); max_index = VFIRSTM(mask, vlmax); - v_max_index = VSLIDEDOWN_UINT(v_max_index, v_max_index, max_index, vlmax); + v_max_index = VSLIDEDOWN_UINT(v_max_index, max_index, vlmax); max_index = VMVVXS_UINT(v_max_index); return(max_index+1); diff --git a/kernel/riscv64/izamin_rvv.c b/kernel/riscv64/izamin_rvv.c index 69771e5aa..297b3c99a 100644 --- a/kernel/riscv64/izamin_rvv.c +++ b/kernel/riscv64/izamin_rvv.c @@ -29,59 +29,59 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include #if defined(DOUBLE) -#define VSETVL(n) vsetvl_e64m4(n) -#define VSETVL_MAX vsetvlmax_e64m4() -#define FLOAT_V_T vfloat64m4_t -#define FLOAT_V_T_M1 vfloat64m1_t -#define VLSEG_FLOAT vlseg2e64_v_f64m4 -#define VLSSEG_FLOAT vlsseg2e64_v_f64m4 -#define VFREDMINVS_FLOAT vfredmin_vs_f64m4_f64m1 -#define MASK_T vbool16_t -#define VMFLTVF_FLOAT vmflt_vf_f64m4_b16 -#define VMFLTVV_FLOAT vmflt_vv_f64m4_b16 -#define VMFLEVF_FLOAT vmfle_vf_f64m4_b16 -#define VFMVVF_FLOAT vfmv_v_f_f64m4 -#define VFMVVF_FLOAT_M1 vfmv_v_f_f64m1 -#define VFABSV_FLOAT vfabs_v_f64m4 -#define VFMINVV_FLOAT vfmin_vv_f64m4 -#define VFADDVV_FLOAT vfadd_vv_f64m4 -#define VFIRSTM vfirst_m_b16 -#define UINT_V_T vuint64m4_t -#define VIDV_MASK_UINT vid_v_u64m4_m -#define VIDV_UINT vid_v_u64m4 -#define VADDVX_MASK_UINT vadd_vx_u64m4_m -#define VADDVX_UINT vadd_vx_u64m4 -#define VMVVX_UINT vmv_v_x_u64m4 -#define VFMVFS_FLOAT_M1 vfmv_f_s_f64m1_f64 -#define VSLIDEDOWN_UINT vslidedown_vx_u64m4 -#define VMVVXS_UINT vmv_x_s_u64m4_u64 +#define VSETVL(n) __riscv_vsetvl_e64m4(n) +#define VSETVL_MAX __riscv_vsetvlmax_e64m4() +#define FLOAT_V_T vfloat64m4_t +#define FLOAT_V_T_M1 vfloat64m1_t +#define VLSEG_FLOAT __riscv_vlseg2e64_v_f64m4 +#define VLSSEG_FLOAT __riscv_vlsseg2e64_v_f64m4 +#define VFREDMINVS_FLOAT __riscv_vfredmin_vs_f64m4_f64m1 +#define MASK_T vbool16_t +#define VMFLTVF_FLOAT __riscv_vmflt_vf_f64m4_b16 +#define VMFLTVV_FLOAT __riscv_vmflt_vv_f64m4_b16 +#define VMFLEVF_FLOAT __riscv_vmfle_vf_f64m4_b16 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m4 +#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f64m1 +#define VFABSV_FLOAT __riscv_vfabs_v_f64m4 +#define VFMINVV_FLOAT __riscv_vfmin_vv_f64m4 +#define VFADDVV_FLOAT __riscv_vfadd_vv_f64m4 +#define VFIRSTM __riscv_vfirst_m_b16 +#define UINT_V_T vuint64m4_t +#define VIDV_MASK_UINT __riscv_vid_v_u64m4_m +#define VIDV_UINT __riscv_vid_v_u64m4 +#define VADDVX_MASK_UINT __riscv_vadd_vx_u64m4_m +#define VADDVX_UINT __riscv_vadd_vx_u64m4 +#define VMVVX_UINT __riscv_vmv_v_x_u64m4 +#define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f64m1_f64 +#define VSLIDEDOWN_UINT __riscv_vslidedown_vx_u64m4 +#define VMVVXS_UINT __riscv_vmv_x_s_u64m4_u64 #else -#define VSETVL(n) vsetvl_e32m4(n) -#define VSETVL_MAX vsetvlmax_e32m4() -#define FLOAT_V_T vfloat32m4_t -#define FLOAT_V_T_M1 vfloat32m1_t -#define VLSEG_FLOAT vlseg2e32_v_f32m4 -#define VLSSEG_FLOAT vlsseg2e32_v_f32m4 -#define VFREDMINVS_FLOAT vfredmin_vs_f32m4_f32m1 -#define MASK_T vbool8_t -#define VMFLTVF_FLOAT vmflt_vf_f32m4_b8 -#define VMFLTVV_FLOAT vmflt_vv_f32m4_b8 -#define VMFLEVF_FLOAT vmfle_vf_f32m4_b8 -#define VFMVVF_FLOAT vfmv_v_f_f32m4 -#define VFMVVF_FLOAT_M1 vfmv_v_f_f32m1 -#define VFABSV_FLOAT vfabs_v_f32m4 -#define VFMINVV_FLOAT vfmin_vv_f32m4 -#define VFADDVV_FLOAT vfadd_vv_f32m4 -#define VFIRSTM vfirst_m_b8 -#define UINT_V_T vuint32m4_t -#define VIDV_MASK_UINT vid_v_u32m4_m -#define VIDV_UINT vid_v_u32m4 -#define VADDVX_MASK_UINT vadd_vx_u32m4_m -#define VADDVX_UINT vadd_vx_u32m4 -#define VMVVX_UINT vmv_v_x_u32m4 -#define VFMVFS_FLOAT_M1 vfmv_f_s_f32m1_f32 -#define VSLIDEDOWN_UINT vslidedown_vx_u32m4 -#define VMVVXS_UINT vmv_x_s_u32m4_u32 +#define VSETVL(n) __riscv_vsetvl_e32m4(n) +#define VSETVL_MAX __riscv_vsetvlmax_e32m4() +#define FLOAT_V_T vfloat32m4_t +#define FLOAT_V_T_M1 vfloat32m1_t +#define VLSEG_FLOAT __riscv_vlseg2e32_v_f32m4 +#define VLSSEG_FLOAT __riscv_vlsseg2e32_v_f32m4 +#define VFREDMINVS_FLOAT __riscv_vfredmin_vs_f32m4_f32m1 +#define MASK_T vbool8_t +#define VMFLTVF_FLOAT __riscv_vmflt_vf_f32m4_b8 +#define VMFLTVV_FLOAT __riscv_vmflt_vv_f32m4_b8 +#define VMFLEVF_FLOAT __riscv_vmfle_vf_f32m4_b8 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m4 +#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f32m1 +#define VFABSV_FLOAT __riscv_vfabs_v_f32m4 +#define VFMINVV_FLOAT __riscv_vfmin_vv_f32m4 +#define VFADDVV_FLOAT __riscv_vfadd_vv_f32m4 +#define VFIRSTM __riscv_vfirst_m_b8 +#define UINT_V_T vuint32m4_t +#define VIDV_MASK_UINT __riscv_vid_v_u32m4_m +#define VIDV_UINT __riscv_vid_v_u32m4 +#define VADDVX_MASK_UINT __riscv_vadd_vx_u32m4_m +#define VADDVX_UINT __riscv_vadd_vx_u32m4 +#define VMVVX_UINT __riscv_vmv_v_x_u32m4 +#define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f32m1_f32 +#define VSLIDEDOWN_UINT __riscv_vslidedown_vx_u32m4 +#define VMVVXS_UINT __riscv_vmv_x_s_u32m4_u32 #endif BLASLONG CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) @@ -113,8 +113,8 @@ BLASLONG CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) // index where element less than v_min mask = VMFLTVV_FLOAT(vx0, v_min, vl); - v_min_index = VIDV_MASK_UINT(mask, v_min_index, vl); - v_min_index = VADDVX_MASK_UINT(mask, v_min_index, v_min_index, j, vl); + v_min_index = VIDV_MASK_UINT(mask, vl); + v_min_index = VADDVX_MASK_UINT(mask, v_min_index, j, vl); //update v_min and start_index j v_min = VFMINVV_FLOAT(v_min, vx0, vl); @@ -136,8 +136,8 @@ BLASLONG CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) // index where element less than v_min mask = VMFLTVV_FLOAT(vx0, v_min, vl); - v_min_index = VIDV_MASK_UINT(mask, v_min_index, vl); - v_min_index = VADDVX_MASK_UINT(mask, v_min_index, v_min_index, j, vl); + v_min_index = VIDV_MASK_UINT(mask, vl); + v_min_index = VADDVX_MASK_UINT(mask, v_min_index, j, vl); //update v_min and start_index j v_min = VFMINVV_FLOAT(v_min, vx0, vl); @@ -145,16 +145,15 @@ BLASLONG CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) } - FLOAT_V_T_M1 v_res, v_max; - v_res = VFMVVF_FLOAT_M1(0, vlmax); - v_max = VFMVVF_FLOAT_M1(FLT_MAX, vlmax); + FLOAT_V_T_M1 v_res; + v_res = VFMVVF_FLOAT_M1(FLT_MAX, vlmax); - v_res = VFREDMINVS_FLOAT(v_res, v_min, v_max, vlmax); + v_res = VFREDMINVS_FLOAT(v_min, v_res, vlmax); minf = VFMVFS_FLOAT_M1(v_res); mask = VMFLEVF_FLOAT(v_min, minf, vlmax); min_index = VFIRSTM(mask, vlmax); - v_min_index = VSLIDEDOWN_UINT(v_min_index, v_min_index, min_index, vlmax); + v_min_index = VSLIDEDOWN_UINT(v_min_index, min_index, vlmax); min_index = VMVVXS_UINT(v_min_index); return(min_index+1); diff --git a/kernel/riscv64/max_rvv.c b/kernel/riscv64/max_rvv.c index 5b1380d2b..9315321f4 100644 --- a/kernel/riscv64/max_rvv.c +++ b/kernel/riscv64/max_rvv.c @@ -29,31 +29,31 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include #if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m8(n) -#define VSETVL_MAX vsetvlmax_e32m8() -#define VSETVL_MAX_M1 vsetvlmax_e32m1() -#define FLOAT_V_T vfloat32m8_t -#define FLOAT_V_T_M1 vfloat32m1_t -#define VLEV_FLOAT vle32_v_f32m8 -#define VLSEV_FLOAT vlse32_v_f32m8 -#define VFREDMAXVS_FLOAT vfredmax_vs_f32m8_f32m1 -#define VFMVVF_FLOAT vfmv_v_f_f32m8 -#define VFMVVF_FLOAT_M1 vfmv_v_f_f32m1 -#define VFMAXVV_FLOAT vfmax_vv_f32m8 -#define VFMVFS_FLOAT_M1 vfmv_f_s_f32m1_f32 +#define VSETVL(n) __riscv_vsetvl_e32m8(n) +#define VSETVL_MAX __riscv_vsetvlmax_e32m8() +#define VSETVL_MAX_M1 __riscv_vsetvlmax_e32m1() +#define FLOAT_V_T vfloat32m8_t +#define FLOAT_V_T_M1 vfloat32m1_t +#define VLEV_FLOAT __riscv_vle32_v_f32m8 +#define VLSEV_FLOAT __riscv_vlse32_v_f32m8 +#define VFREDMAXVS_FLOAT __riscv_vfredmax_vs_f32m8_f32m1 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m8 +#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f32m1 +#define VFMAXVV_FLOAT __riscv_vfmax_vv_f32m8 +#define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f32m1_f32 #else -#define VSETVL(n) vsetvl_e64m8(n) -#define VSETVL_MAX vsetvlmax_e64m8() -#define VSETVL_MAX_M1 vsetvlmax_e64m1() -#define FLOAT_V_T vfloat64m8_t -#define FLOAT_V_T_M1 vfloat64m1_t -#define VLEV_FLOAT vle64_v_f64m8 -#define VLSEV_FLOAT vlse64_v_f64m8 -#define VFREDMAXVS_FLOAT vfredmax_vs_f64m8_f64m1 -#define VFMVVF_FLOAT vfmv_v_f_f64m8 -#define VFMVVF_FLOAT_M1 vfmv_v_f_f64m1 -#define VFMAXVV_FLOAT vfmax_vv_f64m8 -#define VFMVFS_FLOAT_M1 vfmv_f_s_f64m1_f64 +#define VSETVL(n) __riscv_vsetvl_e64m8(n) +#define VSETVL_MAX __riscv_vsetvlmax_e64m8() +#define VSETVL_MAX_M1 __riscv_vsetvlmax_e64m1() +#define FLOAT_V_T vfloat64m8_t +#define FLOAT_V_T_M1 vfloat64m1_t +#define VLEV_FLOAT __riscv_vle64_v_f64m8 +#define VLSEV_FLOAT __riscv_vlse64_v_f64m8 +#define VFREDMAXVS_FLOAT __riscv_vfredmax_vs_f64m8_f64m1 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m8 +#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f64m1 +#define VFMAXVV_FLOAT __riscv_vfmax_vv_f64m8 +#define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f64m1_f64 #endif FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) @@ -91,7 +91,7 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) } - v_res = VFREDMAXVS_FLOAT(v_res, vmax, v_res, vlmax); + v_res = VFREDMAXVS_FLOAT(vmax, v_res, vlmax); maxf = VFMVFS_FLOAT_M1(v_res); return(maxf); diff --git a/kernel/riscv64/min_rvv.c b/kernel/riscv64/min_rvv.c index bddcc0ba7..158b682fd 100644 --- a/kernel/riscv64/min_rvv.c +++ b/kernel/riscv64/min_rvv.c @@ -29,31 +29,31 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include #if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m8(n) -#define VSETVL_MAX vsetvlmax_e32m8() -#define VSETVL_MAX_M1 vsetvlmax_e32m1() -#define FLOAT_V_T vfloat32m8_t -#define FLOAT_V_T_M1 vfloat32m1_t -#define VLEV_FLOAT vle32_v_f32m8 -#define VLSEV_FLOAT vlse32_v_f32m8 -#define VFREDMINVS_FLOAT vfredmin_vs_f32m8_f32m1 -#define VFMVVF_FLOAT vfmv_v_f_f32m8 -#define VFMVVF_FLOAT_M1 vfmv_v_f_f32m1 -#define VFMINVV_FLOAT vfmin_vv_f32m8 -#define VFMVFS_FLOAT_M1 vfmv_f_s_f32m1_f32 +#define VSETVL(n) __riscv_vsetvl_e32m8(n) +#define VSETVL_MAX __riscv_vsetvlmax_e32m8() +#define VSETVL_MAX_M1 __riscv_vsetvlmax_e32m1() +#define FLOAT_V_T vfloat32m8_t +#define FLOAT_V_T_M1 vfloat32m1_t +#define VLEV_FLOAT __riscv_vle32_v_f32m8 +#define VLSEV_FLOAT __riscv_vlse32_v_f32m8 +#define VFREDMINVS_FLOAT __riscv_vfredmin_vs_f32m8_f32m1 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m8 +#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f32m1 +#define VFMINVV_FLOAT __riscv_vfmin_vv_f32m8 +#define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f32m1_f32 #else -#define VSETVL(n) vsetvl_e64m8(n) -#define VSETVL_MAX vsetvlmax_e64m8() -#define VSETVL_MAX_M1 vsetvlmax_e64m1() -#define FLOAT_V_T vfloat64m8_t -#define FLOAT_V_T_M1 vfloat64m1_t -#define VLEV_FLOAT vle64_v_f64m8 -#define VLSEV_FLOAT vlse64_v_f64m8 -#define VFREDMINVS_FLOAT vfredmin_vs_f64m8_f64m1 -#define VFMVVF_FLOAT vfmv_v_f_f64m8 -#define VFMVVF_FLOAT_M1 vfmv_v_f_f64m1 -#define VFMINVV_FLOAT vfmin_vv_f64m8 -#define VFMVFS_FLOAT_M1 vfmv_f_s_f64m1_f64 +#define VSETVL(n) __riscv_vsetvl_e64m8(n) +#define VSETVL_MAX __riscv_vsetvlmax_e64m8() +#define VSETVL_MAX_M1 __riscv_vsetvlmax_e64m1() +#define FLOAT_V_T vfloat64m8_t +#define FLOAT_V_T_M1 vfloat64m1_t +#define VLEV_FLOAT __riscv_vle64_v_f64m8 +#define VLSEV_FLOAT __riscv_vlse64_v_f64m8 +#define VFREDMINVS_FLOAT __riscv_vfredmin_vs_f64m8_f64m1 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m8 +#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f64m1 +#define VFMINVV_FLOAT __riscv_vfmin_vv_f64m8 +#define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f64m1_f64 #endif FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) @@ -91,7 +91,7 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) } - v_res = VFREDMINVS_FLOAT(v_res, vmin, v_res, vlmax); + v_res = VFREDMINVS_FLOAT(vmin, v_res, vlmax); minf = VFMVFS_FLOAT_M1(v_res); return(minf); diff --git a/kernel/riscv64/nrm2_rvv.c b/kernel/riscv64/nrm2_rvv.c index 979c31648..42abfa119 100644 --- a/kernel/riscv64/nrm2_rvv.c +++ b/kernel/riscv64/nrm2_rvv.c @@ -29,30 +29,30 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include #if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m8(n) -#define VSETVL_MAX vsetvlmax_e32m8() -#define FLOAT_V_T vfloat32m8_t -#define FLOAT_V_T_M1 vfloat32m1_t -#define VLEV_FLOAT vle32_v_f32m8 -#define VLSEV_FLOAT vlse32_v_f32m8 -#define VFREDSUM_FLOAT vfredusum_vs_f32m8_f32m1 -#define VFMACCVV_FLOAT vfmacc_vv_f32m8 -#define VFMVVF_FLOAT vfmv_v_f_f32m8 -#define VFMVVF_FLOAT_M1 vfmv_v_f_f32m1 -#define VFMVFS_FLOAT_M1 vfmv_f_s_f32m1_f32 +#define VSETVL(n) __riscv_vsetvl_e32m8(n) +#define VSETVL_MAX __riscv_vsetvlmax_e32m8() +#define FLOAT_V_T vfloat32m8_t +#define FLOAT_V_T_M1 vfloat32m1_t +#define VLEV_FLOAT __riscv_vle32_v_f32m8 +#define VLSEV_FLOAT __riscv_vlse32_v_f32m8 +#define VFREDSUM_FLOAT __riscv_vfredusum_vs_f32m8_f32m1 +#define VFMACCVV_FLOAT __riscv_vfmacc_vv_f32m8 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m8 +#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f32m1 +#define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f32m1_f32 #define ABS fabsf #else -#define VSETVL(n) vsetvl_e64m8(n) -#define VSETVL_MAX vsetvlmax_e64m8() -#define FLOAT_V_T vfloat64m8_t -#define FLOAT_V_T_M1 vfloat64m1_t -#define VLEV_FLOAT vle64_v_f64m8 -#define VLSEV_FLOAT vlse64_v_f64m8 -#define VFREDSUM_FLOAT vfredusum_vs_f64m8_f64m1 -#define VFMACCVV_FLOAT vfmacc_vv_f64m8 -#define VFMVVF_FLOAT vfmv_v_f_f64m8 -#define VFMVVF_FLOAT_M1 vfmv_v_f_f64m1 -#define VFMVFS_FLOAT_M1 vfmv_f_s_f64m1_f64 +#define VSETVL(n) __riscv_vsetvl_e64m8(n) +#define VSETVL_MAX __riscv_vsetvlmax_e64m8() +#define FLOAT_V_T vfloat64m8_t +#define FLOAT_V_T_M1 vfloat64m1_t +#define VLEV_FLOAT __riscv_vle64_v_f64m8 +#define VLSEV_FLOAT __riscv_vlse64_v_f64m8 +#define VFREDSUM_FLOAT __riscv_vfredusum_vs_f64m8_f64m1 +#define VFMACCVV_FLOAT __riscv_vfmacc_vv_f64m8 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m8 +#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f64m1 +#define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f64m1_f64 #define ABS fabs #endif @@ -95,7 +95,7 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) } } - v_res = VFREDSUM_FLOAT(v_res, vr, v_res, vlmax); + v_res = VFREDSUM_FLOAT(vr, v_res, vlmax); ssq = VFMVFS_FLOAT_M1(v_res); diff --git a/kernel/riscv64/rot_rvv.c b/kernel/riscv64/rot_rvv.c index 7bf5e4270..90f81d5e2 100644 --- a/kernel/riscv64/rot_rvv.c +++ b/kernel/riscv64/rot_rvv.c @@ -28,25 +28,25 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include "common.h" #if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m8(n) -#define FLOAT_V_T vfloat32m8_t -#define VLEV_FLOAT vle32_v_f32m8 -#define VLSEV_FLOAT vlse32_v_f32m8 -#define VSEV_FLOAT vse32_v_f32m8 -#define VSSEV_FLOAT vsse32_v_f32m8 -#define VFMACCVF_FLOAT vfmacc_vf_f32m8 -#define VFMULVF_FLOAT vfmul_vf_f32m8 -#define VFMSACVF_FLOAT vfmsac_vf_f32m8 +#define VSETVL(n) __riscv_vsetvl_e32m8(n) +#define FLOAT_V_T vfloat32m8_t +#define VLEV_FLOAT __riscv_vle32_v_f32m8 +#define VLSEV_FLOAT __riscv_vlse32_v_f32m8 +#define VSEV_FLOAT __riscv_vse32_v_f32m8 +#define VSSEV_FLOAT __riscv_vsse32_v_f32m8 +#define VFMACCVF_FLOAT __riscv_vfmacc_vf_f32m8 +#define VFMULVF_FLOAT __riscv_vfmul_vf_f32m8 +#define VFMSACVF_FLOAT __riscv_vfmsac_vf_f32m8 #else -#define VSETVL(n) vsetvl_e64m8(n) -#define FLOAT_V_T vfloat64m8_t -#define VLEV_FLOAT vle64_v_f64m8 -#define VLSEV_FLOAT vlse64_v_f64m8 -#define VSEV_FLOAT vse64_v_f64m8 -#define VSSEV_FLOAT vsse64_v_f64m8 -#define VFMACCVF_FLOAT vfmacc_vf_f64m8 -#define VFMULVF_FLOAT vfmul_vf_f64m8 -#define VFMSACVF_FLOAT vfmsac_vf_f64m8 +#define VSETVL(n) __riscv_vsetvl_e64m8(n) +#define FLOAT_V_T vfloat64m8_t +#define VLEV_FLOAT __riscv_vle64_v_f64m8 +#define VLSEV_FLOAT __riscv_vlse64_v_f64m8 +#define VSEV_FLOAT __riscv_vse64_v_f64m8 +#define VSSEV_FLOAT __riscv_vsse64_v_f64m8 +#define VFMACCVF_FLOAT __riscv_vfmacc_vf_f64m8 +#define VFMULVF_FLOAT __riscv_vfmul_vf_f64m8 +#define VFMSACVF_FLOAT __riscv_vfmsac_vf_f64m8 #endif int CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y, FLOAT c, FLOAT s) diff --git a/kernel/riscv64/scal_rvv.c b/kernel/riscv64/scal_rvv.c index d2c0378bf..2e2cfd31e 100644 --- a/kernel/riscv64/scal_rvv.c +++ b/kernel/riscv64/scal_rvv.c @@ -28,23 +28,23 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include "common.h" #if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m8(n) -#define FLOAT_V_T vfloat32m8_t -#define VLEV_FLOAT vle32_v_f32m8 -#define VLSEV_FLOAT vlse32_v_f32m8 -#define VSEV_FLOAT vse32_v_f32m8 -#define VSSEV_FLOAT vsse32_v_f32m8 -#define VFMULVF_FLOAT vfmul_vf_f32m8 -#define VFMVVF_FLOAT vfmv_v_f_f32m8 +#define VSETVL(n) __riscv_vsetvl_e32m8(n) +#define FLOAT_V_T vfloat32m8_t +#define VLEV_FLOAT __riscv_vle32_v_f32m8 +#define VLSEV_FLOAT __riscv_vlse32_v_f32m8 +#define VSEV_FLOAT __riscv_vse32_v_f32m8 +#define VSSEV_FLOAT __riscv_vsse32_v_f32m8 +#define VFMULVF_FLOAT __riscv_vfmul_vf_f32m8 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m8 #else -#define VSETVL(n) vsetvl_e64m8(n) -#define FLOAT_V_T vfloat64m8_t -#define VLEV_FLOAT vle64_v_f64m8 -#define VLSEV_FLOAT vlse64_v_f64m8 -#define VSEV_FLOAT vse64_v_f64m8 -#define VSSEV_FLOAT vsse64_v_f64m8 -#define VFMULVF_FLOAT vfmul_vf_f64m8 -#define VFMVVF_FLOAT vfmv_v_f_f64m8 +#define VSETVL(n) __riscv_vsetvl_e64m8(n) +#define FLOAT_V_T vfloat64m8_t +#define VLEV_FLOAT __riscv_vle64_v_f64m8 +#define VLSEV_FLOAT __riscv_vlse64_v_f64m8 +#define VSEV_FLOAT __riscv_vse64_v_f64m8 +#define VSSEV_FLOAT __riscv_vsse64_v_f64m8 +#define VFMULVF_FLOAT __riscv_vfmul_vf_f64m8 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m8 #endif int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT da, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y, FLOAT *dummy, BLASLONG dummy2) diff --git a/kernel/riscv64/sum_rvv.c b/kernel/riscv64/sum_rvv.c index 1db0d09dd..9715faf22 100644 --- a/kernel/riscv64/sum_rvv.c +++ b/kernel/riscv64/sum_rvv.c @@ -28,31 +28,31 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include "common.h" #if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m8(n) -#define VSETVL_MAX vsetvlmax_e32m8() -#define VSETVL_MAX_M1 vsetvlmax_e32m1() -#define FLOAT_V_T vfloat32m8_t -#define FLOAT_V_T_M1 vfloat32m1_t -#define VLEV_FLOAT vle32_v_f32m8 -#define VLSEV_FLOAT vlse32_v_f32m8 -#define VFMVVF_FLOAT vfmv_v_f_f32m8 -#define VFADDVV_FLOAT vfadd_vv_f32m8 -#define VFREDSUMVS_FLOAT vfredusum_vs_f32m8_f32m1 -#define VFMVVF_FLOAT_M1 vfmv_v_f_f32m1 -#define VFMVFS_FLOAT_M1 vfmv_f_s_f32m1_f32 +#define VSETVL(n) __riscv_vsetvl_e32m8(n) +#define VSETVL_MAX __riscv_vsetvlmax_e32m8() +#define VSETVL_MAX_M1 __riscv_vsetvlmax_e32m1() +#define FLOAT_V_T vfloat32m8_t +#define FLOAT_V_T_M1 vfloat32m1_t +#define VLEV_FLOAT __riscv_vle32_v_f32m8 +#define VLSEV_FLOAT __riscv_vlse32_v_f32m8 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m8 +#define VFADDVV_FLOAT __riscv_vfadd_vv_f32m8 +#define VFREDSUMVS_FLOAT __riscv_vfredusum_vs_f32m8_f32m1 +#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f32m1 +#define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f32m1_f32 #else -#define VSETVL(n) vsetvl_e64m8(n) -#define VSETVL_MAX vsetvlmax_e64m8() -#define VSETVL_MAX_M1 vsetvlmax_e64m1() -#define FLOAT_V_T vfloat64m8_t -#define FLOAT_V_T_M1 vfloat64m1_t -#define VLEV_FLOAT vle64_v_f64m8 -#define VLSEV_FLOAT vlse64_v_f64m8 -#define VFMVVF_FLOAT vfmv_v_f_f64m8 -#define VFADDVV_FLOAT vfadd_vv_f64m8 -#define VFREDSUMVS_FLOAT vfredusum_vs_f64m8_f64m1 -#define VFMVVF_FLOAT_M1 vfmv_v_f_f64m1 -#define VFMVFS_FLOAT_M1 vfmv_f_s_f64m1_f64 +#define VSETVL(n) __riscv_vsetvl_e64m8(n) +#define VSETVL_MAX __riscv_vsetvlmax_e64m8() +#define VSETVL_MAX_M1 __riscv_vsetvlmax_e64m1() +#define FLOAT_V_T vfloat64m8_t +#define FLOAT_V_T_M1 vfloat64m1_t +#define VLEV_FLOAT __riscv_vle64_v_f64m8 +#define VLSEV_FLOAT __riscv_vlse64_v_f64m8 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m8 +#define VFADDVV_FLOAT __riscv_vfadd_vv_f64m8 +#define VFREDSUMVS_FLOAT __riscv_vfredusum_vs_f64m8_f64m1 +#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f64m1 +#define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f64m1_f64 #endif FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) @@ -89,7 +89,7 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) } - v_res = VFREDSUMVS_FLOAT(v_res, vsum, v_res, vlmax); + v_res = VFREDSUMVS_FLOAT(vsum, v_res, vlmax); sumf = VFMVFS_FLOAT_M1(v_res); return(sumf); } diff --git a/kernel/riscv64/swap_rvv.c b/kernel/riscv64/swap_rvv.c index 2cf92f6ad..893d70554 100644 --- a/kernel/riscv64/swap_rvv.c +++ b/kernel/riscv64/swap_rvv.c @@ -28,23 +28,19 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include "common.h" #if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m8(n) -#define VSETVL_MAX vsetvlmax_e32m8() -#define FLOAT_V_T vfloat32m8_t -#define VLEV_FLOAT vle32_v_f32m8 -#define VLSEV_FLOAT vlse32_v_f32m8 -#define VSEV_FLOAT vse32_v_f32m8 -#define VSSEV_FLOAT vsse32_v_f32m8 -#define VFMVVF_FLOAT vfmv_v_f_f32m8 +#define VSETVL(n) __riscv_vsetvl_e32m8(n) +#define FLOAT_V_T vfloat32m8_t +#define VLEV_FLOAT __riscv_vle32_v_f32m8 +#define VLSEV_FLOAT __riscv_vlse32_v_f32m8 +#define VSEV_FLOAT __riscv_vse32_v_f32m8 +#define VSSEV_FLOAT __riscv_vsse32_v_f32m8 #else -#define VSETVL(n) vsetvl_e64m8(n) -#define VSETVL_MAX vsetvlmax_e64m8() -#define FLOAT_V_T vfloat64m8_t -#define VLEV_FLOAT vle64_v_f64m8 -#define VLSEV_FLOAT vlse64_v_f64m8 -#define VSEV_FLOAT vse64_v_f64m8 -#define VSSEV_FLOAT vsse64_v_f64m8 -#define VFMVVF_FLOAT vfmv_v_f_f64m8 +#define VSETVL(n) __riscv_vsetvl_e64m8(n) +#define FLOAT_V_T vfloat64m8_t +#define VLEV_FLOAT __riscv_vle64_v_f64m8 +#define VLSEV_FLOAT __riscv_vlse64_v_f64m8 +#define VSEV_FLOAT __riscv_vse64_v_f64m8 +#define VSSEV_FLOAT __riscv_vsse64_v_f64m8 #endif int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT dummy3, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y, FLOAT *dummy, BLASLONG dummy2) diff --git a/kernel/riscv64/symm_lcopy_rvv_v1.c b/kernel/riscv64/symm_lcopy_rvv_v1.c index f0def9617..a615db44d 100644 --- a/kernel/riscv64/symm_lcopy_rvv_v1.c +++ b/kernel/riscv64/symm_lcopy_rvv_v1.c @@ -28,31 +28,31 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include "common.h" #if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m2(n) -#define VSETVL_MAX vsetvlmax_e32m2() -#define FLOAT_V_T vfloat32m2_t -#define VLEV_FLOAT vle32_v_f32m2 -#define VSEV_FLOAT vse32_v_f32m2 -#define VLSEV_FLOAT vlse32_v_f32m2 -#define INT_V_T vint32m2_t -#define VID_V_INT vid_v_i32m2 -#define VADD_VX_INT vadd_vx_i32m2 -#define VMSGT_VX_INT vmsgt_vx_i32m2_b16 -#define VBOOL_T vbool16_t -#define VMERGE_VVM_FLOAT vmerge_vvm_f32m2 +#define VSETVL(n) __riscv_vsetvl_e32m2(n) +#define VSETVL_MAX __riscv_vsetvlmax_e32m2() +#define FLOAT_V_T vfloat32m2_t +#define VLEV_FLOAT __riscv_vle32_v_f32m2 +#define VSEV_FLOAT __riscv_vse32_v_f32m2 +#define VLSEV_FLOAT __riscv_vlse32_v_f32m2 +#define INT_V_T vint32m2_t +#define VID_V_INT __riscv_vid_v_i32m2 +#define VADD_VX_INT __riscv_vadd_vx_i32m2 +#define VMSGT_VX_INT __riscv_vmsgt_vx_i32m2_b16 +#define VBOOL_T vbool16_t +#define VMERGE_VVM_FLOAT __riscv_vmerge_vvm_f32m2 #else -#define VSETVL(n) vsetvl_e64m2(n) -#define VSETVL_MAX vsetvlmax_e64m2() -#define FLOAT_V_T vfloat64m2_t -#define VLEV_FLOAT vle64_v_f64m2 -#define VSEV_FLOAT vse64_v_f64m2 -#define VLSEV_FLOAT vlse64_v_f64m2 -#define INT_V_T vint64m2_t -#define VID_V_INT vid_v_i64m2 -#define VADD_VX_INT vadd_vx_i64m2 -#define VMSGT_VX_INT vmsgt_vx_i64m2_b32 -#define VBOOL_T vbool32_t -#define VMERGE_VVM_FLOAT vmerge_vvm_f64m2 +#define VSETVL(n) __riscv_vsetvl_e64m2(n) +#define VSETVL_MAX __riscv_vsetvlmax_e64m2() +#define FLOAT_V_T vfloat64m2_t +#define VLEV_FLOAT __riscv_vle64_v_f64m2 +#define VSEV_FLOAT __riscv_vse64_v_f64m2 +#define VLSEV_FLOAT __riscv_vlse64_v_f64m2 +#define INT_V_T vint64m2_t +#define VID_V_INT __riscv_vid_v_i64m2 +#define VADD_VX_INT __riscv_vadd_vx_i64m2 +#define VMSGT_VX_INT __riscv_vmsgt_vx_i64m2_b32 +#define VBOOL_T vbool32_t +#define VMERGE_VVM_FLOAT __riscv_vmerge_vvm_f64m2 #endif // Optimizes the implementation in ../generic/symm_lcopy_4.c @@ -87,7 +87,7 @@ int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG posX, BLASLON vindex = VADD_VX_INT(vindex_max, offset, vl); vbool = VMSGT_VX_INT(vindex, 0, vl); - vb = VMERGE_VVM_FLOAT(vbool, va2, va1, vl); + vb = VMERGE_VVM_FLOAT(va2, va1, vbool, vl); VSEV_FLOAT(b, vb, vl); b += vl; diff --git a/kernel/riscv64/symm_ucopy_rvv_v1.c b/kernel/riscv64/symm_ucopy_rvv_v1.c index 958506df3..464f97b3a 100644 --- a/kernel/riscv64/symm_ucopy_rvv_v1.c +++ b/kernel/riscv64/symm_ucopy_rvv_v1.c @@ -28,31 +28,31 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include "common.h" #if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m2(n) -#define VSETVL_MAX vsetvlmax_e32m2() -#define FLOAT_V_T vfloat32m2_t -#define VLEV_FLOAT vle32_v_f32m2 -#define VSEV_FLOAT vse32_v_f32m2 -#define VLSEV_FLOAT vlse32_v_f32m2 -#define INT_V_T vint32m2_t -#define VID_V_INT vid_v_i32m2 -#define VADD_VX_INT vadd_vx_i32m2 -#define VMSGT_VX_INT vmsgt_vx_i32m2_b16 -#define VBOOL_T vbool16_t -#define VMERGE_VVM_FLOAT vmerge_vvm_f32m2 +#define VSETVL(n) __riscv_vsetvl_e32m2(n) +#define VSETVL_MAX __riscv_vsetvlmax_e32m2() +#define FLOAT_V_T vfloat32m2_t +#define VLEV_FLOAT __riscv_vle32_v_f32m2 +#define VSEV_FLOAT __riscv_vse32_v_f32m2 +#define VLSEV_FLOAT __riscv_vlse32_v_f32m2 +#define INT_V_T vint32m2_t +#define VID_V_INT __riscv_vid_v_i32m2 +#define VADD_VX_INT __riscv_vadd_vx_i32m2 +#define VMSGT_VX_INT __riscv_vmsgt_vx_i32m2_b16 +#define VBOOL_T vbool16_t +#define VMERGE_VVM_FLOAT __riscv_vmerge_vvm_f32m2 #else -#define VSETVL(n) vsetvl_e64m2(n) -#define VSETVL_MAX vsetvlmax_e64m2() -#define FLOAT_V_T vfloat64m2_t -#define VLEV_FLOAT vle64_v_f64m2 -#define VSEV_FLOAT vse64_v_f64m2 -#define VLSEV_FLOAT vlse64_v_f64m2 -#define INT_V_T vint64m2_t -#define VID_V_INT vid_v_i64m2 -#define VADD_VX_INT vadd_vx_i64m2 -#define VMSGT_VX_INT vmsgt_vx_i64m2_b32 -#define VBOOL_T vbool32_t -#define VMERGE_VVM_FLOAT vmerge_vvm_f64m2 +#define VSETVL(n) __riscv_vsetvl_e64m2(n) +#define VSETVL_MAX __riscv_vsetvlmax_e64m2() +#define FLOAT_V_T vfloat64m2_t +#define VLEV_FLOAT __riscv_vle64_v_f64m2 +#define VSEV_FLOAT __riscv_vse64_v_f64m2 +#define VLSEV_FLOAT __riscv_vlse64_v_f64m2 +#define INT_V_T vint64m2_t +#define VID_V_INT __riscv_vid_v_i64m2 +#define VADD_VX_INT __riscv_vadd_vx_i64m2 +#define VMSGT_VX_INT __riscv_vmsgt_vx_i64m2_b32 +#define VBOOL_T vbool32_t +#define VMERGE_VVM_FLOAT __riscv_vmerge_vvm_f64m2 #endif // Optimizes the implementation in ../generic/symm_ucopy_4.c @@ -87,7 +87,7 @@ int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG posX, BLASLON vindex = VADD_VX_INT(vindex_max, offset, vl); vbool = VMSGT_VX_INT(vindex, 0, vl); - vb = VMERGE_VVM_FLOAT(vbool, va2, va1, vl); + vb = VMERGE_VVM_FLOAT(va2, va1, vbool, vl); VSEV_FLOAT(b, vb, vl); b += vl; diff --git a/kernel/riscv64/symv_L_rvv.c b/kernel/riscv64/symv_L_rvv.c index 737abaae3..e87ab22ae 100644 --- a/kernel/riscv64/symv_L_rvv.c +++ b/kernel/riscv64/symv_L_rvv.c @@ -28,43 +28,43 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include "common.h" #if !defined(DOUBLE) -#define VSETVL_MAX_M1 vsetvlmax_e32m1() -#define VSETVL(n) vsetvl_e32m8(n) -#define VSETVL_MAX vsetvlmax_e32m8() -#define FLOAT_V_T_M1 vfloat32m1_t -#define FLOAT_V_T vfloat32m8_t -#define VLEV_FLOAT vle32_v_f32m8 -#define VSEV_FLOAT vse32_v_f32m8 -#define VLSEV_FLOAT vlse32_v_f32m8 -#define VSSEV_FLOAT vsse32_v_f32m8 -#define VFMACCVV_FLOAT vfmacc_vv_f32m8 -#define VFMACCVF_FLOAT vfmacc_vf_f32m8 -#define VFNMSACVF_FLOAT vfnmsac_vf_f32m8 -#define VFMULVF_FLOAT vfmul_vf_f32m8 -#define VFMVVF_FLOAT vfmv_v_f_f32m8 -#define VFMSACVF_FLOAT vfmsac_vf_f32m8 -#define VFMVVF_FLOAT_M1 vfmv_v_f_f32m1 -#define VFREDSUM_FLOAT vfredusum_vs_f32m8_f32m1 -#define VFMVFS_FLOAT_M1 vfmv_f_s_f32m1_f32 +#define VSETVL_MAX_M1 __riscv_vsetvlmax_e32m1() +#define VSETVL(n) __riscv_vsetvl_e32m8(n) +#define VSETVL_MAX __riscv_vsetvlmax_e32m8() +#define FLOAT_V_T_M1 vfloat32m1_t +#define FLOAT_V_T vfloat32m8_t +#define VLEV_FLOAT __riscv_vle32_v_f32m8 +#define VSEV_FLOAT __riscv_vse32_v_f32m8 +#define VLSEV_FLOAT __riscv_vlse32_v_f32m8 +#define VSSEV_FLOAT __riscv_vsse32_v_f32m8 +#define VFMACCVV_FLOAT __riscv_vfmacc_vv_f32m8 +#define VFMACCVF_FLOAT __riscv_vfmacc_vf_f32m8 +#define VFNMSACVF_FLOAT __riscv_vfnmsac_vf_f32m8 +#define VFMULVF_FLOAT __riscv_vfmul_vf_f32m8 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m8 +#define VFMSACVF_FLOAT __riscv_vfmsac_vf_f32m8 +#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f32m1 +#define VFREDSUM_FLOAT __riscv_vfredusum_vs_f32m8_f32m1 +#define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f32m1_f32 #else -#define VSETVL_MAX_M1 vsetvlmax_e64m1() -#define VSETVL(n) vsetvl_e64m8(n) -#define VSETVL_MAX vsetvlmax_e64m8() -#define FLOAT_V_T_M1 vfloat64m1_t -#define FLOAT_V_T vfloat64m8_t -#define VLEV_FLOAT vle64_v_f64m8 -#define VSEV_FLOAT vse64_v_f64m8 -#define VLSEV_FLOAT vlse64_v_f64m8 -#define VSSEV_FLOAT vsse64_v_f64m8 -#define VFMACCVV_FLOAT vfmacc_vv_f64m8 -#define VFMACCVF_FLOAT vfmacc_vf_f64m8 -#define VFNMSACVF_FLOAT vfnmsac_vf_f64m8 -#define VFMULVF_FLOAT vfmul_vf_f64m8 -#define VFMVVF_FLOAT vfmv_v_f_f64m8 -#define VFMSACVF_FLOAT vfmsac_vf_f64m8 -#define VFMVVF_FLOAT_M1 vfmv_v_f_f64m1 -#define VFREDSUM_FLOAT vfredusum_vs_f64m8_f64m1 -#define VFMVFS_FLOAT_M1 vfmv_f_s_f64m1_f64 +#define VSETVL_MAX_M1 __riscv_vsetvlmax_e64m1() +#define VSETVL(n) __riscv_vsetvl_e64m8(n) +#define VSETVL_MAX __riscv_vsetvlmax_e64m8() +#define FLOAT_V_T_M1 vfloat64m1_t +#define FLOAT_V_T vfloat64m8_t +#define VLEV_FLOAT __riscv_vle64_v_f64m8 +#define VSEV_FLOAT __riscv_vse64_v_f64m8 +#define VLSEV_FLOAT __riscv_vlse64_v_f64m8 +#define VSSEV_FLOAT __riscv_vsse64_v_f64m8 +#define VFMACCVV_FLOAT __riscv_vfmacc_vv_f64m8 +#define VFMACCVF_FLOAT __riscv_vfmacc_vf_f64m8 +#define VFNMSACVF_FLOAT __riscv_vfnmsac_vf_f64m8 +#define VFMULVF_FLOAT __riscv_vfmul_vf_f64m8 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m8 +#define VFMSACVF_FLOAT __riscv_vfmsac_vf_f64m8 +#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f64m1 +#define VFREDSUM_FLOAT __riscv_vfredusum_vs_f64m8_f64m1 +#define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f64m1_f64 #endif int CNAME(BLASLONG m, BLASLONG offset, FLOAT alpha, FLOAT *a, BLASLONG lda, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y, FLOAT *buffer) @@ -77,7 +77,6 @@ int CNAME(BLASLONG m, BLASLONG offset, FLOAT alpha, FLOAT *a, BLASLONG lda, FLOA FLOAT_V_T_M1 v_res, v_z0; size_t vlmax = VSETVL_MAX_M1, vl; - v_res = VFMVVF_FLOAT_M1(0, vlmax); v_z0 = VFMVVF_FLOAT_M1(0, vlmax); vlmax = VSETVL_MAX; @@ -105,7 +104,7 @@ int CNAME(BLASLONG m, BLASLONG offset, FLOAT alpha, FLOAT *a, BLASLONG lda, FLOA vr = VFMACCVV_FLOAT(vr, vx, va, vl); } - v_res = VFREDSUM_FLOAT(v_res, vr, v_z0, vlmax); + v_res = VFREDSUM_FLOAT(vr, v_z0, vlmax); y[j] += alpha * VFMVFS_FLOAT_M1(v_res); a_ptr += lda; @@ -137,7 +136,7 @@ int CNAME(BLASLONG m, BLASLONG offset, FLOAT alpha, FLOAT *a, BLASLONG lda, FLOA iy += inc_yv; } - v_res = VFREDSUM_FLOAT(v_res, vr, v_z0, vlmax); + v_res = VFREDSUM_FLOAT(vr, v_z0, vlmax); y[jy] += alpha * VFMVFS_FLOAT_M1(v_res); jy += inc_y; @@ -172,7 +171,7 @@ int CNAME(BLASLONG m, BLASLONG offset, FLOAT alpha, FLOAT *a, BLASLONG lda, FLOA ix += inc_xv; } - v_res = VFREDSUM_FLOAT(v_res, vr, v_z0, vlmax); + v_res = VFREDSUM_FLOAT(vr, v_z0, vlmax); y[j] += alpha * VFMVFS_FLOAT_M1(v_res); jx += inc_x; @@ -211,7 +210,7 @@ int CNAME(BLASLONG m, BLASLONG offset, FLOAT alpha, FLOAT *a, BLASLONG lda, FLOA ix += inc_xv; iy += inc_yv; } - v_res = VFREDSUM_FLOAT(v_res, vr, v_z0, vlmax); + v_res = VFREDSUM_FLOAT(vr, v_z0, vlmax); y[jy] += alpha * VFMVFS_FLOAT_M1(v_res); jx += inc_x; diff --git a/kernel/riscv64/symv_U_rvv.c b/kernel/riscv64/symv_U_rvv.c index cb923be5d..3fbc33c89 100644 --- a/kernel/riscv64/symv_U_rvv.c +++ b/kernel/riscv64/symv_U_rvv.c @@ -29,43 +29,43 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include "common.h" #if !defined(DOUBLE) -#define VSETVL_MAX_M1 vsetvlmax_e32m1() -#define VSETVL(n) vsetvl_e32m8(n) -#define VSETVL_MAX vsetvlmax_e32m8() -#define FLOAT_V_T_M1 vfloat32m1_t -#define FLOAT_V_T vfloat32m8_t -#define VLEV_FLOAT vle32_v_f32m8 -#define VSEV_FLOAT vse32_v_f32m8 -#define VLSEV_FLOAT vlse32_v_f32m8 -#define VSSEV_FLOAT vsse32_v_f32m8 -#define VFMACCVV_FLOAT vfmacc_vv_f32m8 -#define VFMACCVF_FLOAT vfmacc_vf_f32m8 -#define VFNMSACVF_FLOAT vfnmsac_vf_f32m8 -#define VFMULVF_FLOAT vfmul_vf_f32m8 -#define VFMVVF_FLOAT vfmv_v_f_f32m8 -#define VFMSACVF_FLOAT vfmsac_vf_f32m8 -#define VFMVVF_FLOAT_M1 vfmv_v_f_f32m1 -#define VFREDSUM_FLOAT vfredusum_vs_f32m8_f32m1 -#define VFMVFS_FLOAT_M1 vfmv_f_s_f32m1_f32 +#define VSETVL_MAX_M1 __riscv_vsetvlmax_e32m1() +#define VSETVL(n) __riscv_vsetvl_e32m8(n) +#define VSETVL_MAX __riscv_vsetvlmax_e32m8() +#define FLOAT_V_T_M1 vfloat32m1_t +#define FLOAT_V_T vfloat32m8_t +#define VLEV_FLOAT __riscv_vle32_v_f32m8 +#define VSEV_FLOAT __riscv_vse32_v_f32m8 +#define VLSEV_FLOAT __riscv_vlse32_v_f32m8 +#define VSSEV_FLOAT __riscv_vsse32_v_f32m8 +#define VFMACCVV_FLOAT __riscv_vfmacc_vv_f32m8 +#define VFMACCVF_FLOAT __riscv_vfmacc_vf_f32m8 +#define VFNMSACVF_FLOAT __riscv_vfnmsac_vf_f32m8 +#define VFMULVF_FLOAT __riscv_vfmul_vf_f32m8 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m8 +#define VFMSACVF_FLOAT __riscv_vfmsac_vf_f32m8 +#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f32m1 +#define VFREDSUM_FLOAT __riscv_vfredusum_vs_f32m8_f32m1 +#define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f32m1_f32 #else -#define VSETVL_MAX_M1 vsetvlmax_e64m1() -#define VSETVL(n) vsetvl_e64m8(n) -#define VSETVL_MAX vsetvlmax_e64m8() -#define FLOAT_V_T_M1 vfloat64m1_t -#define FLOAT_V_T vfloat64m8_t -#define VLEV_FLOAT vle64_v_f64m8 -#define VSEV_FLOAT vse64_v_f64m8 -#define VLSEV_FLOAT vlse64_v_f64m8 -#define VSSEV_FLOAT vsse64_v_f64m8 -#define VFMACCVV_FLOAT vfmacc_vv_f64m8 -#define VFMACCVF_FLOAT vfmacc_vf_f64m8 -#define VFNMSACVF_FLOAT vfnmsac_vf_f64m8 -#define VFMULVF_FLOAT vfmul_vf_f64m8 -#define VFMVVF_FLOAT vfmv_v_f_f64m8 -#define VFMSACVF_FLOAT vfmsac_vf_f64m8 -#define VFMVVF_FLOAT_M1 vfmv_v_f_f64m1 -#define VFREDSUM_FLOAT vfredusum_vs_f64m8_f64m1 -#define VFMVFS_FLOAT_M1 vfmv_f_s_f64m1_f64 +#define VSETVL_MAX_M1 __riscv_vsetvlmax_e64m1() +#define VSETVL(n) __riscv_vsetvl_e64m8(n) +#define VSETVL_MAX __riscv_vsetvlmax_e64m8() +#define FLOAT_V_T_M1 vfloat64m1_t +#define FLOAT_V_T vfloat64m8_t +#define VLEV_FLOAT __riscv_vle64_v_f64m8 +#define VSEV_FLOAT __riscv_vse64_v_f64m8 +#define VLSEV_FLOAT __riscv_vlse64_v_f64m8 +#define VSSEV_FLOAT __riscv_vsse64_v_f64m8 +#define VFMACCVV_FLOAT __riscv_vfmacc_vv_f64m8 +#define VFMACCVF_FLOAT __riscv_vfmacc_vf_f64m8 +#define VFNMSACVF_FLOAT __riscv_vfnmsac_vf_f64m8 +#define VFMULVF_FLOAT __riscv_vfmul_vf_f64m8 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m8 +#define VFMSACVF_FLOAT __riscv_vfmsac_vf_f64m8 +#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f64m1 +#define VFREDSUM_FLOAT __riscv_vfredusum_vs_f64m8_f64m1 +#define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f64m1_f64 #endif int CNAME(BLASLONG m, BLASLONG offset, FLOAT alpha, FLOAT *a, BLASLONG lda, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y, FLOAT *buffer) @@ -77,7 +77,6 @@ int CNAME(BLASLONG m, BLASLONG offset, FLOAT alpha, FLOAT *a, BLASLONG lda, FLOA FLOAT *a_ptr = a; FLOAT_V_T_M1 v_res, v_z0; size_t vl_max = VSETVL_MAX_M1, vl; - v_res = VFMVVF_FLOAT_M1(0, vl_max); v_z0 = VFMVVF_FLOAT_M1(0, vl_max); vl_max = VSETVL_MAX; @@ -105,7 +104,7 @@ int CNAME(BLASLONG m, BLASLONG offset, FLOAT alpha, FLOAT *a, BLASLONG lda, FLOA vx = VLEV_FLOAT(&x[i], vl); vr = VFMACCVV_FLOAT(vr, vx, va, vl); } - v_res = VFREDSUM_FLOAT(v_res, vr, v_z0, vl_max); + v_res = VFREDSUM_FLOAT(vr, v_z0, vl_max); y[j] += temp1 * a_ptr[j] + alpha * VFMVFS_FLOAT_M1(v_res); a_ptr += lda; @@ -137,7 +136,7 @@ int CNAME(BLASLONG m, BLASLONG offset, FLOAT alpha, FLOAT *a, BLASLONG lda, FLOA iy += inc_yv; } - v_res = VFREDSUM_FLOAT(v_res, vr, v_z0, vl_max); + v_res = VFREDSUM_FLOAT(vr, v_z0, vl_max); y[jy] += temp1 * a_ptr[j] + alpha * VFMVFS_FLOAT_M1(v_res); a_ptr += lda; @@ -171,7 +170,7 @@ int CNAME(BLASLONG m, BLASLONG offset, FLOAT alpha, FLOAT *a, BLASLONG lda, FLOA ix += inc_xv; } - v_res = VFREDSUM_FLOAT(v_res, vr, v_z0, vl_max); + v_res = VFREDSUM_FLOAT(vr, v_z0, vl_max); y[j] += temp1 * a_ptr[j] + alpha * VFMVFS_FLOAT_M1(v_res); a_ptr += lda; @@ -209,7 +208,7 @@ int CNAME(BLASLONG m, BLASLONG offset, FLOAT alpha, FLOAT *a, BLASLONG lda, FLOA ix += inc_xv; iy += inc_yv; } - v_res = VFREDSUM_FLOAT(v_res, vr, v_z0, vl_max); + v_res = VFREDSUM_FLOAT(vr, v_z0, vl_max); y[jy] += temp1 * a_ptr[j] + alpha * VFMVFS_FLOAT_M1(v_res); a_ptr += lda; diff --git a/kernel/riscv64/trmm_lncopy_rvv_v1.c b/kernel/riscv64/trmm_lncopy_rvv_v1.c index 3457ca3e1..4135a9b62 100644 --- a/kernel/riscv64/trmm_lncopy_rvv_v1.c +++ b/kernel/riscv64/trmm_lncopy_rvv_v1.c @@ -30,29 +30,29 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include "common.h" #if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m2(n) -#define FLOAT_V_T vfloat32m2_t -#define VLEV_FLOAT vle32_v_f32m2 -#define VSEV_FLOAT vse32_v_f32m2 -#define VLSEV_FLOAT vlse32_v_f32m2 -#define VBOOL_T vbool16_t -#define UINT_V_T vuint32m2_t -#define VID_V_UINT vid_v_u32m2 -#define VMSGTU_VX_UINT vmsgtu_vx_u32m2_b16 -#define VMSEQ_VX_UINT vmseq_vx_u32m2_b16 -#define VFMERGE_VFM_FLOAT vfmerge_vfm_f32m2 +#define VSETVL(n) __riscv_vsetvl_e32m2(n) +#define FLOAT_V_T vfloat32m2_t +#define VLEV_FLOAT __riscv_vle32_v_f32m2 +#define VSEV_FLOAT __riscv_vse32_v_f32m2 +#define VLSEV_FLOAT __riscv_vlse32_v_f32m2 +#define VBOOL_T vbool16_t +#define UINT_V_T vuint32m2_t +#define VID_V_UINT __riscv_vid_v_u32m2 +#define VMSGTU_VX_UINT __riscv_vmsgtu_vx_u32m2_b16 +#define VMSEQ_VX_UINT __riscv_vmseq_vx_u32m2_b16 +#define VFMERGE_VFM_FLOAT __riscv_vfmerge_vfm_f32m2 #else -#define VSETVL(n) vsetvl_e64m2(n) -#define FLOAT_V_T vfloat64m2_t -#define VLEV_FLOAT vle64_v_f64m2 -#define VSEV_FLOAT vse64_v_f64m2 -#define VLSEV_FLOAT vlse64_v_f64m2 -#define VBOOL_T vbool32_t -#define UINT_V_T vuint64m2_t -#define VID_V_UINT vid_v_u64m2 -#define VMSGTU_VX_UINT vmsgtu_vx_u64m2_b32 -#define VMSEQ_VX_UINT vmseq_vx_u64m2_b32 -#define VFMERGE_VFM_FLOAT vfmerge_vfm_f64m2 +#define VSETVL(n) __riscv_vsetvl_e64m2(n) +#define FLOAT_V_T vfloat64m2_t +#define VLEV_FLOAT __riscv_vle64_v_f64m2 +#define VSEV_FLOAT __riscv_vse64_v_f64m2 +#define VLSEV_FLOAT __riscv_vlse64_v_f64m2 +#define VBOOL_T vbool32_t +#define UINT_V_T vuint64m2_t +#define VID_V_UINT __riscv_vid_v_u64m2 +#define VMSGTU_VX_UINT __riscv_vmsgtu_vx_u64m2_b32 +#define VMSEQ_VX_UINT __riscv_vmseq_vx_u64m2_b32 +#define VFMERGE_VFM_FLOAT __riscv_vfmerge_vfm_f64m2 #endif // Optimizes the implementation in ../arm64/tmmm_lncopy_sve_v1.c @@ -116,10 +116,10 @@ int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG posX, BLASLON { va1 = VLSEV_FLOAT(ao, stride_lda, vl); vbool_cmp = VMSGTU_VX_UINT(vindex, j, vl); - vb = VFMERGE_VFM_FLOAT(vbool_cmp, va1, ZERO, vl); + vb = VFMERGE_VFM_FLOAT(va1, ZERO, vbool_cmp, vl); #ifdef UNIT vbool_eq = VMSEQ_VX_UINT(vindex, j, vl); - vb = VFMERGE_VFM_FLOAT(vbool_eq, vb, ONE, vl); + vb = VFMERGE_VFM_FLOAT(vb, ONE, vbool_eq, vl); #endif VSEV_FLOAT(b, vb, vl); ao++; diff --git a/kernel/riscv64/trmm_ltcopy_rvv_v1.c b/kernel/riscv64/trmm_ltcopy_rvv_v1.c index 2fe8cf79e..580714fde 100644 --- a/kernel/riscv64/trmm_ltcopy_rvv_v1.c +++ b/kernel/riscv64/trmm_ltcopy_rvv_v1.c @@ -30,27 +30,27 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include "common.h" #if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m2(n) -#define FLOAT_V_T vfloat32m2_t -#define VLEV_FLOAT vle32_v_f32m2 -#define VSEV_FLOAT vse32_v_f32m2 -#define VBOOL_T vbool16_t -#define UINT_V_T vuint32m2_t -#define VID_V_UINT vid_v_u32m2 -#define VMSLTU_VX_UINT vmsltu_vx_u32m2_b16 -#define VMSEQ_VX_UINT vmseq_vx_u32m2_b16 -#define VFMERGE_VFM_FLOAT vfmerge_vfm_f32m2 +#define VSETVL(n) __riscv_vsetvl_e32m2(n) +#define FLOAT_V_T vfloat32m2_t +#define VLEV_FLOAT __riscv_vle32_v_f32m2 +#define VSEV_FLOAT __riscv_vse32_v_f32m2 +#define VBOOL_T vbool16_t +#define UINT_V_T vuint32m2_t +#define VID_V_UINT __riscv_vid_v_u32m2 +#define VMSLTU_VX_UINT __riscv_vmsltu_vx_u32m2_b16 +#define VMSEQ_VX_UINT __riscv_vmseq_vx_u32m2_b16 +#define VFMERGE_VFM_FLOAT __riscv_vfmerge_vfm_f32m2 #else -#define VSETVL(n) vsetvl_e64m2(n) -#define FLOAT_V_T vfloat64m2_t -#define VLEV_FLOAT vle64_v_f64m2 -#define VSEV_FLOAT vse64_v_f64m2 -#define VBOOL_T vbool32_t -#define UINT_V_T vuint64m2_t -#define VID_V_UINT vid_v_u64m2 -#define VMSLTU_VX_UINT vmsltu_vx_u64m2_b32 -#define VMSEQ_VX_UINT vmseq_vx_u64m2_b32 -#define VFMERGE_VFM_FLOAT vfmerge_vfm_f64m2 +#define VSETVL(n) __riscv_vsetvl_e64m2(n) +#define FLOAT_V_T vfloat64m2_t +#define VLEV_FLOAT __riscv_vle64_v_f64m2 +#define VSEV_FLOAT __riscv_vse64_v_f64m2 +#define VBOOL_T vbool32_t +#define UINT_V_T vuint64m2_t +#define VID_V_UINT __riscv_vid_v_u64m2 +#define VMSLTU_VX_UINT __riscv_vmsltu_vx_u64m2_b32 +#define VMSEQ_VX_UINT __riscv_vmseq_vx_u64m2_b32 +#define VFMERGE_VFM_FLOAT __riscv_vfmerge_vfm_f64m2 #endif // Optimizes the implementation in ../arm64/tmmm_ltcopy_sve_v1.c @@ -111,10 +111,10 @@ int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG posX, BLASLON { va1 = VLEV_FLOAT(ao, vl); vbool_cmp = VMSLTU_VX_UINT(vindex, j, vl); - vb = VFMERGE_VFM_FLOAT(vbool_cmp, va1, ZERO, vl); + vb = VFMERGE_VFM_FLOAT(va1, ZERO, vbool_cmp, vl); #ifdef UNIT vbool_eq = VMSEQ_VX_UINT(vindex, j, vl); - vb = VFMERGE_VFM_FLOAT(vbool_eq, vb, ONE, vl); + vb = VFMERGE_VFM_FLOAT(vb, ONE, vbool_eq, vl); #endif VSEV_FLOAT(b, vb, vl); ao += lda; diff --git a/kernel/riscv64/trmm_uncopy_rvv_v1.c b/kernel/riscv64/trmm_uncopy_rvv_v1.c index b64cd840d..852ab7f11 100644 --- a/kernel/riscv64/trmm_uncopy_rvv_v1.c +++ b/kernel/riscv64/trmm_uncopy_rvv_v1.c @@ -30,29 +30,29 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include "common.h" #if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m2(n) -#define FLOAT_V_T vfloat32m2_t -#define VLEV_FLOAT vle32_v_f32m2 -#define VLSEV_FLOAT vlse32_v_f32m2 -#define VSEV_FLOAT vse32_v_f32m2 -#define VBOOL_T vbool16_t -#define UINT_V_T vuint32m2_t -#define VID_V_UINT vid_v_u32m2 -#define VMSLTU_VX_UINT vmsltu_vx_u32m2_b16 -#define VMSEQ_VX_UINT vmseq_vx_u32m2_b16 -#define VFMERGE_VFM_FLOAT vfmerge_vfm_f32m2 +#define VSETVL(n) __riscv_vsetvl_e32m2(n) +#define FLOAT_V_T vfloat32m2_t +#define VLEV_FLOAT __riscv_vle32_v_f32m2 +#define VLSEV_FLOAT __riscv_vlse32_v_f32m2 +#define VSEV_FLOAT __riscv_vse32_v_f32m2 +#define VBOOL_T vbool16_t +#define UINT_V_T vuint32m2_t +#define VID_V_UINT __riscv_vid_v_u32m2 +#define VMSLTU_VX_UINT __riscv_vmsltu_vx_u32m2_b16 +#define VMSEQ_VX_UINT __riscv_vmseq_vx_u32m2_b16 +#define VFMERGE_VFM_FLOAT __riscv_vfmerge_vfm_f32m2 #else -#define VSETVL(n) vsetvl_e64m2(n) -#define FLOAT_V_T vfloat64m2_t -#define VLEV_FLOAT vle64_v_f64m2 -#define VLSEV_FLOAT vlse64_v_f64m2 -#define VSEV_FLOAT vse64_v_f64m2 -#define VBOOL_T vbool32_t -#define UINT_V_T vuint64m2_t -#define VID_V_UINT vid_v_u64m2 -#define VMSLTU_VX_UINT vmsltu_vx_u64m2_b32 -#define VMSEQ_VX_UINT vmseq_vx_u64m2_b32 -#define VFMERGE_VFM_FLOAT vfmerge_vfm_f64m2 +#define VSETVL(n) __riscv_vsetvl_e64m2(n) +#define FLOAT_V_T vfloat64m2_t +#define VLEV_FLOAT __riscv_vle64_v_f64m2 +#define VLSEV_FLOAT __riscv_vlse64_v_f64m2 +#define VSEV_FLOAT __riscv_vse64_v_f64m2 +#define VBOOL_T vbool32_t +#define UINT_V_T vuint64m2_t +#define VID_V_UINT __riscv_vid_v_u64m2 +#define VMSLTU_VX_UINT __riscv_vmsltu_vx_u64m2_b32 +#define VMSEQ_VX_UINT __riscv_vmseq_vx_u64m2_b32 +#define VFMERGE_VFM_FLOAT __riscv_vfmerge_vfm_f64m2 #endif // Optimizes the implementation in ../arm64/tmmm_uncopy_sve_v1.c @@ -114,10 +114,10 @@ int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG posX, BLASLON { va1 = VLSEV_FLOAT(ao, stride_lda, vl); vbool_cmp = VMSLTU_VX_UINT(vindex, j, vl); - vb = VFMERGE_VFM_FLOAT(vbool_cmp, va1, ZERO, vl); + vb = VFMERGE_VFM_FLOAT(va1, ZERO, vbool_cmp, vl); #ifdef UNIT vbool_eq = VMSEQ_VX_UINT(vindex, j, vl); - vb = VFMERGE_VFM_FLOAT(vbool_eq, vb, ONE, vl); + vb = VFMERGE_VFM_FLOAT(vb, ONE, vbool_eq, vl); #endif VSEV_FLOAT(b, vb, vl); ao++; diff --git a/kernel/riscv64/trmm_utcopy_rvv_v1.c b/kernel/riscv64/trmm_utcopy_rvv_v1.c index b96daae5b..e0b6d362d 100644 --- a/kernel/riscv64/trmm_utcopy_rvv_v1.c +++ b/kernel/riscv64/trmm_utcopy_rvv_v1.c @@ -32,27 +32,27 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include "common.h" #if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m2(n) -#define FLOAT_V_T vfloat32m2_t -#define VLEV_FLOAT vle32_v_f32m2 -#define VSEV_FLOAT vse32_v_f32m2 -#define VBOOL_T vbool16_t -#define UINT_V_T vuint32m2_t -#define VID_V_UINT vid_v_u32m2 -#define VMSGTU_VX_UINT vmsgtu_vx_u32m2_b16 -#define VMSEQ_VX_UINT vmseq_vx_u32m2_b16 -#define VFMERGE_VFM_FLOAT vfmerge_vfm_f32m2 +#define VSETVL(n) __riscv_vsetvl_e32m2(n) +#define FLOAT_V_T vfloat32m2_t +#define VLEV_FLOAT __riscv_vle32_v_f32m2 +#define VSEV_FLOAT __riscv_vse32_v_f32m2 +#define VBOOL_T vbool16_t +#define UINT_V_T vuint32m2_t +#define VID_V_UINT __riscv_vid_v_u32m2 +#define VMSGTU_VX_UINT __riscv_vmsgtu_vx_u32m2_b16 +#define VMSEQ_VX_UINT __riscv_vmseq_vx_u32m2_b16 +#define VFMERGE_VFM_FLOAT __riscv_vfmerge_vfm_f32m2 #else -#define VSETVL(n) vsetvl_e64m2(n) -#define FLOAT_V_T vfloat64m2_t -#define VLEV_FLOAT vle64_v_f64m2 -#define VSEV_FLOAT vse64_v_f64m2 -#define VBOOL_T vbool32_t -#define UINT_V_T vuint64m2_t -#define VID_V_UINT vid_v_u64m2 -#define VMSGTU_VX_UINT vmsgtu_vx_u64m2_b32 -#define VMSEQ_VX_UINT vmseq_vx_u64m2_b32 -#define VFMERGE_VFM_FLOAT vfmerge_vfm_f64m2 +#define VSETVL(n) __riscv_vsetvl_e64m2(n) +#define FLOAT_V_T vfloat64m2_t +#define VLEV_FLOAT __riscv_vle64_v_f64m2 +#define VSEV_FLOAT __riscv_vse64_v_f64m2 +#define VBOOL_T vbool32_t +#define UINT_V_T vuint64m2_t +#define VID_V_UINT __riscv_vid_v_u64m2 +#define VMSGTU_VX_UINT __riscv_vmsgtu_vx_u64m2_b32 +#define VMSEQ_VX_UINT __riscv_vmseq_vx_u64m2_b32 +#define VFMERGE_VFM_FLOAT __riscv_vfmerge_vfm_f64m2 #endif // Optimizes the implementation in ../arm64/tmmm_utcopy_sve_v1.c @@ -113,10 +113,10 @@ int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG posX, BLASLON { va1 = VLEV_FLOAT(ao, vl); vbool_cmp = VMSGTU_VX_UINT(vindex, j, vl); - vb = VFMERGE_VFM_FLOAT(vbool_cmp, va1, ZERO, vl); + vb = VFMERGE_VFM_FLOAT(va1, ZERO, vbool_cmp, vl); #ifdef UNIT vbool_eq = VMSEQ_VX_UINT(vindex, j, vl); - vb = VFMERGE_VFM_FLOAT(vbool_eq, vb, ONE, vl); + vb = VFMERGE_VFM_FLOAT(vb, ONE, vbool_eq, vl); #endif VSEV_FLOAT(b, vb, vl); ao += lda; diff --git a/kernel/riscv64/trmmkernel_rvv_v1x8.c b/kernel/riscv64/trmmkernel_rvv_v1x8.c index 97b14650c..393b24bce 100644 --- a/kernel/riscv64/trmmkernel_rvv_v1x8.c +++ b/kernel/riscv64/trmmkernel_rvv_v1x8.c @@ -28,21 +28,21 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include "common.h" #if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m2(n) -#define FLOAT_V_T vfloat32m2_t -#define VLEV_FLOAT vle32_v_f32m2 -#define VSEV_FLOAT vse32_v_f32m2 -#define VFMVVF_FLOAT vfmv_v_f_f32m2 -#define VFMACCVF_FLOAT vfmacc_vf_f32m2 -#define VFMULVF_FLOAT vfmul_vf_f32m2 +#define VSETVL(n) __riscv_vsetvl_e32m2(n) +#define FLOAT_V_T vfloat32m2_t +#define VLEV_FLOAT __riscv_vle32_v_f32m2 +#define VSEV_FLOAT __riscv_vse32_v_f32m2 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m2 +#define VFMACCVF_FLOAT __riscv_vfmacc_vf_f32m2 +#define VFMULVF_FLOAT __riscv_vfmul_vf_f32m2 #else -#define VSETVL(n) vsetvl_e64m2(n) -#define FLOAT_V_T vfloat64m2_t -#define VLEV_FLOAT vle64_v_f64m2 -#define VSEV_FLOAT vse64_v_f64m2 -#define VFMVVF_FLOAT vfmv_v_f_f64m2 -#define VFMACCVF_FLOAT vfmacc_vf_f64m2 -#define VFMULVF_FLOAT vfmul_vf_f64m2 +#define VSETVL(n) __riscv_vsetvl_e64m2(n) +#define FLOAT_V_T vfloat64m2_t +#define VLEV_FLOAT __riscv_vle64_v_f64m2 +#define VSEV_FLOAT __riscv_vse64_v_f64m2 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m2 +#define VFMACCVF_FLOAT __riscv_vfmacc_vf_f64m2 +#define VFMULVF_FLOAT __riscv_vfmul_vf_f64m2 #endif diff --git a/kernel/riscv64/trsm_kernel_LN_rvv_v1.c b/kernel/riscv64/trsm_kernel_LN_rvv_v1.c index 2cba06b38..886af0c3b 100644 --- a/kernel/riscv64/trsm_kernel_LN_rvv_v1.c +++ b/kernel/riscv64/trsm_kernel_LN_rvv_v1.c @@ -28,34 +28,34 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include "common.h" #if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m2(n) -#define VSETVL_MAX vsetvlmax_e32m2() -#define FLOAT_V_T vfloat32m2_t -#define VLSEV_FLOAT vlse32_v_f32m2 -#define VSSEV_FLOAT vsse32_v_f32m2 -#define VSEV_FLOAT vse32_v_f32m2 -#define VLSEG2_FLOAT vlseg2e32_v_f32m2 -#define VSSEG2_FLOAT vsseg2e32_v_f32m2 -#define VLSSEG2_FLOAT vlsseg2e32_v_f32m2 -#define VSSSEG2_FLOAT vssseg2e32_v_f32m2 -#define VFMACCVF_FLOAT vfmacc_vf_f32m2 -#define VFNMSACVF_FLOAT vfnmsac_vf_f32m2 -#define VFMULVF_FLOAT vfmul_vf_f32m2 +#define VSETVL(n) __riscv_vsetvl_e32m2(n) +#define VSETVL_MAX __riscv_vsetvlmax_e32m2() +#define FLOAT_V_T vfloat32m2_t +#define VLSEV_FLOAT __riscv_vlse32_v_f32m2 +#define VSSEV_FLOAT __riscv_vsse32_v_f32m2 +#define VSEV_FLOAT __riscv_vse32_v_f32m2 +#define VLSEG2_FLOAT __riscv_vlseg2e32_v_f32m2 +#define VSSEG2_FLOAT __riscv_vsseg2e32_v_f32m2 +#define VLSSEG2_FLOAT __riscv_vlsseg2e32_v_f32m2 +#define VSSSEG2_FLOAT __riscv_vssseg2e32_v_f32m2 +#define VFMACCVF_FLOAT __riscv_vfmacc_vf_f32m2 +#define VFNMSACVF_FLOAT __riscv_vfnmsac_vf_f32m2 +#define VFMULVF_FLOAT __riscv_vfmul_vf_f32m2 #else -#define VSETVL(n) vsetvl_e64m2(n) -#define VSETVL_MAX vsetvlmax_e64m2() -#define FLOAT_V_T vfloat64m2_t -#define VLSEV_FLOAT vlse64_v_f64m2 -#define VSSEV_FLOAT vsse64_v_f64m2 -#define VSEV_FLOAT vse64_v_f64m2 -#define VLSEG2_FLOAT vlseg2e64_v_f64m2 -#define VSSEG2_FLOAT vsseg2e64_v_f64m2 -#define VLSSEG2_FLOAT vlsseg2e64_v_f64m2 -#define VSSSEG2_FLOAT vssseg2e64_v_f64m2 -#define VFMVVF_FLOAT vfmv_v_f_f64m2 -#define VFMACCVF_FLOAT vfmacc_vf_f64m2 -#define VFNMSACVF_FLOAT vfnmsac_vf_f64m2 -#define VFMULVF_FLOAT vfmul_vf_f64m2 +#define VSETVL(n) __riscv_vsetvl_e64m2(n) +#define VSETVL_MAX __riscv_vsetvlmax_e64m2() +#define FLOAT_V_T vfloat64m2_t +#define VLSEV_FLOAT __riscv_vlse64_v_f64m2 +#define VSSEV_FLOAT __riscv_vsse64_v_f64m2 +#define VSEV_FLOAT __riscv_vse64_v_f64m2 +#define VLSEG2_FLOAT __riscv_vlseg2e64_v_f64m2 +#define VSSEG2_FLOAT __riscv_vsseg2e64_v_f64m2 +#define VLSSEG2_FLOAT __riscv_vlsseg2e64_v_f64m2 +#define VSSSEG2_FLOAT __riscv_vssseg2e64_v_f64m2 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m2 +#define VFMACCVF_FLOAT __riscv_vfmacc_vf_f64m2 +#define VFNMSACVF_FLOAT __riscv_vfnmsac_vf_f64m2 +#define VFMULVF_FLOAT __riscv_vfmul_vf_f64m2 #endif diff --git a/kernel/riscv64/trsm_kernel_LT_rvv_v1.c b/kernel/riscv64/trsm_kernel_LT_rvv_v1.c index 492a5631f..ddeef966c 100644 --- a/kernel/riscv64/trsm_kernel_LT_rvv_v1.c +++ b/kernel/riscv64/trsm_kernel_LT_rvv_v1.c @@ -28,34 +28,34 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include "common.h" #if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m2(n) -#define VSETVL_MAX vsetvlmax_e32m2() -#define FLOAT_V_T vfloat32m2_t -#define VLSEV_FLOAT vlse32_v_f32m2 -#define VSSEV_FLOAT vsse32_v_f32m2 -#define VSEV_FLOAT vse32_v_f32m2 -#define VLSEG2_FLOAT vlseg2e32_v_f32m2 -#define VSSEG2_FLOAT vsseg2e32_v_f32m2 -#define VLSSEG2_FLOAT vlsseg2e32_v_f32m2 -#define VSSSEG2_FLOAT vssseg2e32_v_f32m2 -#define VFMACCVF_FLOAT vfmacc_vf_f32m2 -#define VFNMSACVF_FLOAT vfnmsac_vf_f32m2 -#define VFMULVF_FLOAT vfmul_vf_f32m2 +#define VSETVL(n) __riscv_vsetvl_e32m2(n) +#define VSETVL_MAX __riscv_vsetvlmax_e32m2() +#define FLOAT_V_T vfloat32m2_t +#define VLSEV_FLOAT __riscv_vlse32_v_f32m2 +#define VSSEV_FLOAT __riscv_vsse32_v_f32m2 +#define VSEV_FLOAT __riscv_vse32_v_f32m2 +#define VLSEG2_FLOAT __riscv_vlseg2e32_v_f32m2 +#define VSSEG2_FLOAT __riscv_vsseg2e32_v_f32m2 +#define VLSSEG2_FLOAT __riscv_vlsseg2e32_v_f32m2 +#define VSSSEG2_FLOAT __riscv_vssseg2e32_v_f32m2 +#define VFMACCVF_FLOAT __riscv_vfmacc_vf_f32m2 +#define VFNMSACVF_FLOAT __riscv_vfnmsac_vf_f32m2 +#define VFMULVF_FLOAT __riscv_vfmul_vf_f32m2 #else -#define VSETVL(n) vsetvl_e64m2(n) -#define VSETVL_MAX vsetvlmax_e64m2() -#define FLOAT_V_T vfloat64m2_t -#define VLSEV_FLOAT vlse64_v_f64m2 -#define VSSEV_FLOAT vsse64_v_f64m2 -#define VSEV_FLOAT vse64_v_f64m2 -#define VLSEG2_FLOAT vlseg2e64_v_f64m2 -#define VSSEG2_FLOAT vsseg2e64_v_f64m2 -#define VLSSEG2_FLOAT vlsseg2e64_v_f64m2 -#define VSSSEG2_FLOAT vssseg2e64_v_f64m2 -#define VFMVVF_FLOAT vfmv_v_f_f64m2 -#define VFMACCVF_FLOAT vfmacc_vf_f64m2 -#define VFNMSACVF_FLOAT vfnmsac_vf_f64m2 -#define VFMULVF_FLOAT vfmul_vf_f64m2 +#define VSETVL(n) __riscv_vsetvl_e64m2(n) +#define VSETVL_MAX __riscv_vsetvlmax_e64m2() +#define FLOAT_V_T vfloat64m2_t +#define VLSEV_FLOAT __riscv_vlse64_v_f64m2 +#define VSSEV_FLOAT __riscv_vsse64_v_f64m2 +#define VSEV_FLOAT __riscv_vse64_v_f64m2 +#define VLSEG2_FLOAT __riscv_vlseg2e64_v_f64m2 +#define VSSEG2_FLOAT __riscv_vsseg2e64_v_f64m2 +#define VLSSEG2_FLOAT __riscv_vlsseg2e64_v_f64m2 +#define VSSSEG2_FLOAT __riscv_vssseg2e64_v_f64m2 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m2 +#define VFMACCVF_FLOAT __riscv_vfmacc_vf_f64m2 +#define VFNMSACVF_FLOAT __riscv_vfnmsac_vf_f64m2 +#define VFMULVF_FLOAT __riscv_vfmul_vf_f64m2 #endif diff --git a/kernel/riscv64/trsm_kernel_RN_rvv_v1.c b/kernel/riscv64/trsm_kernel_RN_rvv_v1.c index 4751ae012..4c83bbaa3 100644 --- a/kernel/riscv64/trsm_kernel_RN_rvv_v1.c +++ b/kernel/riscv64/trsm_kernel_RN_rvv_v1.c @@ -28,34 +28,34 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include "common.h" #if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m2(n) -#define VSETVL_MAX vsetvlmax_e32m2() -#define FLOAT_V_T vfloat32m2_t -#define VLEV_FLOAT vle32_v_f32m2 -#define VSSEV_FLOAT vsse32_v_f32m2 -#define VSEV_FLOAT vse32_v_f32m2 -#define VLSEG2_FLOAT vlseg2e32_v_f32m2 -#define VSSEG2_FLOAT vsseg2e32_v_f32m2 -#define VLSSEG2_FLOAT vlsseg2e32_v_f32m2 -#define VSSSEG2_FLOAT vssseg2e32_v_f32m2 -#define VFMACCVF_FLOAT vfmacc_vf_f32m2 -#define VFNMSACVF_FLOAT vfnmsac_vf_f32m2 -#define VFMULVF_FLOAT vfmul_vf_f32m2 +#define VSETVL(n) __riscv_vsetvl_e32m2(n) +#define VSETVL_MAX __riscv_vsetvlmax_e32m2() +#define FLOAT_V_T vfloat32m2_t +#define VLEV_FLOAT __riscv_vle32_v_f32m2 +#define VSSEV_FLOAT __riscv_vsse32_v_f32m2 +#define VSEV_FLOAT __riscv_vse32_v_f32m2 +#define VLSEG2_FLOAT __riscv_vlseg2e32_v_f32m2 +#define VSSEG2_FLOAT __riscv_vsseg2e32_v_f32m2 +#define VLSSEG2_FLOAT __riscv_vlsseg2e32_v_f32m2 +#define VSSSEG2_FLOAT __riscv_vssseg2e32_v_f32m2 +#define VFMACCVF_FLOAT __riscv_vfmacc_vf_f32m2 +#define VFNMSACVF_FLOAT __riscv_vfnmsac_vf_f32m2 +#define VFMULVF_FLOAT __riscv_vfmul_vf_f32m2 #else -#define VSETVL(n) vsetvl_e64m2(n) -#define VSETVL_MAX vsetvlmax_e64m2() -#define FLOAT_V_T vfloat64m2_t -#define VLEV_FLOAT vle64_v_f64m2 -#define VSSEV_FLOAT vsse64_v_f64m2 -#define VSEV_FLOAT vse64_v_f64m2 -#define VLSEG2_FLOAT vlseg2e64_v_f64m2 -#define VSSEG2_FLOAT vsseg2e64_v_f64m2 -#define VLSSEG2_FLOAT vlsseg2e64_v_f64m2 -#define VSSSEG2_FLOAT vssseg2e64_v_f64m2 -#define VFMVVF_FLOAT vfmv_v_f_f64m2 -#define VFMACCVF_FLOAT vfmacc_vf_f64m2 -#define VFNMSACVF_FLOAT vfnmsac_vf_f64m2 -#define VFMULVF_FLOAT vfmul_vf_f64m2 +#define VSETVL(n) __riscv_vsetvl_e64m2(n) +#define VSETVL_MAX __riscv_vsetvlmax_e64m2() +#define FLOAT_V_T vfloat64m2_t +#define VLEV_FLOAT __riscv_vle64_v_f64m2 +#define VSSEV_FLOAT __riscv_vsse64_v_f64m2 +#define VSEV_FLOAT __riscv_vse64_v_f64m2 +#define VLSEG2_FLOAT __riscv_vlseg2e64_v_f64m2 +#define VSSEG2_FLOAT __riscv_vsseg2e64_v_f64m2 +#define VLSSEG2_FLOAT __riscv_vlsseg2e64_v_f64m2 +#define VSSSEG2_FLOAT __riscv_vssseg2e64_v_f64m2 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m2 +#define VFMACCVF_FLOAT __riscv_vfmacc_vf_f64m2 +#define VFNMSACVF_FLOAT __riscv_vfnmsac_vf_f64m2 +#define VFMULVF_FLOAT __riscv_vfmul_vf_f64m2 #endif static FLOAT dm1 = -1.; diff --git a/kernel/riscv64/trsm_kernel_RT_rvv_v1.c b/kernel/riscv64/trsm_kernel_RT_rvv_v1.c index 93a9e6916..b368eefb9 100644 --- a/kernel/riscv64/trsm_kernel_RT_rvv_v1.c +++ b/kernel/riscv64/trsm_kernel_RT_rvv_v1.c @@ -28,28 +28,28 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include "common.h" #if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m2(n) -#define VSETVL_MAX vsetvlmax_e32m2() -#define FLOAT_V_T vfloat32m2_t -#define VLEV_FLOAT vle32_v_f32m2 -#define VSEV_FLOAT vse32_v_f32m2 -#define VLSEG2_FLOAT vlseg2e32_v_f32m2 -#define VSSEG2_FLOAT vsseg2e32_v_f32m2 -#define VFMACCVF_FLOAT vfmacc_vf_f32m2 -#define VFNMSACVF_FLOAT vfnmsac_vf_f32m2 -#define VFMULVF_FLOAT vfmul_vf_f32m2 +#define VSETVL(n) __riscv_vsetvl_e32m2(n) +#define VSETVL_MAX __riscv_vsetvlmax_e32m2() +#define FLOAT_V_T vfloat32m2_t +#define VLEV_FLOAT __riscv_vle32_v_f32m2 +#define VSEV_FLOAT __riscv_vse32_v_f32m2 +#define VLSEG2_FLOAT __riscv_vlseg2e32_v_f32m2 +#define VSSEG2_FLOAT __riscv_vsseg2e32_v_f32m2 +#define VFMACCVF_FLOAT __riscv_vfmacc_vf_f32m2 +#define VFNMSACVF_FLOAT __riscv_vfnmsac_vf_f32m2 +#define VFMULVF_FLOAT __riscv_vfmul_vf_f32m2 #else -#define VSETVL(n) vsetvl_e64m2(n) -#define VSETVL_MAX vsetvlmax_e64m2() -#define FLOAT_V_T vfloat64m2_t -#define VLEV_FLOAT vle64_v_f64m2 -#define VSEV_FLOAT vse64_v_f64m2 -#define VLSEG2_FLOAT vlseg2e64_v_f64m2 -#define VSSEG2_FLOAT vsseg2e64_v_f64m2 -#define VFMVVF_FLOAT vfmv_v_f_f64m2 -#define VFMACCVF_FLOAT vfmacc_vf_f64m2 -#define VFNMSACVF_FLOAT vfnmsac_vf_f64m2 -#define VFMULVF_FLOAT vfmul_vf_f64m2 +#define VSETVL(n) __riscv_vsetvl_e64m2(n) +#define VSETVL_MAX __riscv_vsetvlmax_e64m2() +#define FLOAT_V_T vfloat64m2_t +#define VLEV_FLOAT __riscv_vle64_v_f64m2 +#define VSEV_FLOAT __riscv_vse64_v_f64m2 +#define VLSEG2_FLOAT __riscv_vlseg2e64_v_f64m2 +#define VSSEG2_FLOAT __riscv_vsseg2e64_v_f64m2 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m2 +#define VFMACCVF_FLOAT __riscv_vfmacc_vf_f64m2 +#define VFNMSACVF_FLOAT __riscv_vfnmsac_vf_f64m2 +#define VFMULVF_FLOAT __riscv_vfmul_vf_f64m2 #endif diff --git a/kernel/riscv64/trsm_lncopy_rvv_v1.c b/kernel/riscv64/trsm_lncopy_rvv_v1.c index bacfb2b08..41c84be25 100644 --- a/kernel/riscv64/trsm_lncopy_rvv_v1.c +++ b/kernel/riscv64/trsm_lncopy_rvv_v1.c @@ -29,27 +29,27 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include "common.h" #if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m2(n) -#define FLOAT_V_T vfloat32m2_t -#define VLEV_FLOAT vle32_v_f32m2 -#define VSEV_FLOAT vse32_v_f32m2 -#define VSEV_FLOAT_M vse32_v_f32m2_m -#define VLSEV_FLOAT vlse32_v_f32m2 -#define VBOOL_T vbool16_t -#define UINT_V_T vuint32m2_t -#define VID_V_UINT vid_v_u32m2 -#define VMSLTU_VX_UINT vmsltu_vx_u32m2_b16 +#define VSETVL(n) __riscv_vsetvl_e32m2(n) +#define FLOAT_V_T vfloat32m2_t +#define VLEV_FLOAT __riscv_vle32_v_f32m2 +#define VSEV_FLOAT __riscv_vse32_v_f32m2 +#define VSEV_FLOAT_M __riscv_vse32_v_f32m2_m +#define VLSEV_FLOAT __riscv_vlse32_v_f32m2 +#define VBOOL_T vbool16_t +#define UINT_V_T vuint32m2_t +#define VID_V_UINT __riscv_vid_v_u32m2 +#define VMSLTU_VX_UINT __riscv_vmsltu_vx_u32m2_b16 #else -#define VSETVL(n) vsetvl_e64m2(n) -#define FLOAT_V_T vfloat64m2_t -#define VLEV_FLOAT vle64_v_f64m2 -#define VSEV_FLOAT vse64_v_f64m2 -#define VSEV_FLOAT_M vse64_v_f64m2_m -#define VLSEV_FLOAT vlse64_v_f64m2 -#define VBOOL_T vbool32_t -#define UINT_V_T vuint64m2_t -#define VID_V_UINT vid_v_u64m2 -#define VMSLTU_VX_UINT vmsltu_vx_u64m2_b32 +#define VSETVL(n) __riscv_vsetvl_e64m2(n) +#define FLOAT_V_T vfloat64m2_t +#define VLEV_FLOAT __riscv_vle64_v_f64m2 +#define VSEV_FLOAT __riscv_vse64_v_f64m2 +#define VSEV_FLOAT_M __riscv_vse64_v_f64m2_m +#define VLSEV_FLOAT __riscv_vlse64_v_f64m2 +#define VBOOL_T vbool32_t +#define UINT_V_T vuint64m2_t +#define VID_V_UINT __riscv_vid_v_u64m2 +#define VMSLTU_VX_UINT __riscv_vmsltu_vx_u64m2_b32 #endif diff --git a/kernel/riscv64/trsm_ltcopy_rvv_v1.c b/kernel/riscv64/trsm_ltcopy_rvv_v1.c index 0fc7c9f24..003bd3465 100644 --- a/kernel/riscv64/trsm_ltcopy_rvv_v1.c +++ b/kernel/riscv64/trsm_ltcopy_rvv_v1.c @@ -29,27 +29,27 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include "common.h" #if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m2(n) -#define FLOAT_V_T vfloat32m2_t -#define VLEV_FLOAT vle32_v_f32m2 -#define VSEV_FLOAT vse32_v_f32m2 -#define VSEV_FLOAT_M vse32_v_f32m2_m -#define VLSEV_FLOAT vlse32_v_f32m2 -#define VBOOL_T vbool16_t -#define UINT_V_T vuint32m2_t -#define VID_V_UINT vid_v_u32m2 -#define VMSGTU_VX_UINT vmsgtu_vx_u32m2_b16 +#define VSETVL(n) __riscv_vsetvl_e32m2(n) +#define FLOAT_V_T vfloat32m2_t +#define VLEV_FLOAT __riscv_vle32_v_f32m2 +#define VSEV_FLOAT __riscv_vse32_v_f32m2 +#define VSEV_FLOAT_M __riscv_vse32_v_f32m2_m +#define VLSEV_FLOAT __riscv_vlse32_v_f32m2 +#define VBOOL_T vbool16_t +#define UINT_V_T vuint32m2_t +#define VID_V_UINT __riscv_vid_v_u32m2 +#define VMSGTU_VX_UINT __riscv_vmsgtu_vx_u32m2_b16 #else -#define VSETVL(n) vsetvl_e64m2(n) -#define FLOAT_V_T vfloat64m2_t -#define VLEV_FLOAT vle64_v_f64m2 -#define VSEV_FLOAT vse64_v_f64m2 -#define VSEV_FLOAT_M vse64_v_f64m2_m -#define VLSEV_FLOAT vlse64_v_f64m2 -#define VBOOL_T vbool32_t -#define UINT_V_T vuint64m2_t -#define VID_V_UINT vid_v_u64m2 -#define VMSGTU_VX_UINT vmsgtu_vx_u64m2_b32 +#define VSETVL(n) __riscv_vsetvl_e64m2(n) +#define FLOAT_V_T vfloat64m2_t +#define VLEV_FLOAT __riscv_vle64_v_f64m2 +#define VSEV_FLOAT __riscv_vse64_v_f64m2 +#define VSEV_FLOAT_M __riscv_vse64_v_f64m2_m +#define VLSEV_FLOAT __riscv_vlse64_v_f64m2 +#define VBOOL_T vbool32_t +#define UINT_V_T vuint64m2_t +#define VID_V_UINT __riscv_vid_v_u64m2 +#define VMSGTU_VX_UINT __riscv_vmsgtu_vx_u64m2_b32 #endif #ifndef UNIT diff --git a/kernel/riscv64/trsm_uncopy_rvv_v1.c b/kernel/riscv64/trsm_uncopy_rvv_v1.c index ee869a795..6cca5d49c 100644 --- a/kernel/riscv64/trsm_uncopy_rvv_v1.c +++ b/kernel/riscv64/trsm_uncopy_rvv_v1.c @@ -30,27 +30,27 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include "common.h" #if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m2(n) -#define FLOAT_V_T vfloat32m2_t -#define VLEV_FLOAT vle32_v_f32m2 -#define VSEV_FLOAT vse32_v_f32m2 -#define VSEV_FLOAT_M vse32_v_f32m2_m -#define VLSEV_FLOAT vlse32_v_f32m2 -#define VBOOL_T vbool16_t -#define UINT_V_T vuint32m2_t -#define VID_V_UINT vid_v_u32m2 -#define VMSGTU_VX_UINT vmsgtu_vx_u32m2_b16 +#define VSETVL(n) __riscv_vsetvl_e32m2(n) +#define FLOAT_V_T vfloat32m2_t +#define VLEV_FLOAT __riscv_vle32_v_f32m2 +#define VSEV_FLOAT __riscv_vse32_v_f32m2 +#define VSEV_FLOAT_M __riscv_vse32_v_f32m2_m +#define VLSEV_FLOAT __riscv_vlse32_v_f32m2 +#define VBOOL_T vbool16_t +#define UINT_V_T vuint32m2_t +#define VID_V_UINT __riscv_vid_v_u32m2 +#define VMSGTU_VX_UINT __riscv_vmsgtu_vx_u32m2_b16 #else -#define VSETVL(n) vsetvl_e64m2(n) -#define FLOAT_V_T vfloat64m2_t -#define VLEV_FLOAT vle64_v_f64m2 -#define VSEV_FLOAT vse64_v_f64m2 -#define VSEV_FLOAT_M vse64_v_f64m2_m -#define VLSEV_FLOAT vlse64_v_f64m2 -#define VBOOL_T vbool32_t -#define UINT_V_T vuint64m2_t -#define VID_V_UINT vid_v_u64m2 -#define VMSGTU_VX_UINT vmsgtu_vx_u64m2_b32 +#define VSETVL(n) __riscv_vsetvl_e64m2(n) +#define FLOAT_V_T vfloat64m2_t +#define VLEV_FLOAT __riscv_vle64_v_f64m2 +#define VSEV_FLOAT __riscv_vse64_v_f64m2 +#define VSEV_FLOAT_M __riscv_vse64_v_f64m2_m +#define VLSEV_FLOAT __riscv_vlse64_v_f64m2 +#define VBOOL_T vbool32_t +#define UINT_V_T vuint64m2_t +#define VID_V_UINT __riscv_vid_v_u64m2 +#define VMSGTU_VX_UINT __riscv_vmsgtu_vx_u64m2_b32 #endif diff --git a/kernel/riscv64/trsm_utcopy_rvv_v1.c b/kernel/riscv64/trsm_utcopy_rvv_v1.c index a324b0fa6..bc058525f 100644 --- a/kernel/riscv64/trsm_utcopy_rvv_v1.c +++ b/kernel/riscv64/trsm_utcopy_rvv_v1.c @@ -29,27 +29,27 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include "common.h" #if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m2(n) -#define FLOAT_V_T vfloat32m2_t -#define VLEV_FLOAT vle32_v_f32m2 -#define VSEV_FLOAT vse32_v_f32m2 -#define VSEV_FLOAT_M vse32_v_f32m2_m -#define VLSEV_FLOAT vlse32_v_f32m2 -#define VBOOL_T vbool16_t -#define UINT_V_T vuint32m2_t -#define VID_V_UINT vid_v_u32m2 -#define VMSLTU_VX_UINT vmsltu_vx_u32m2_b16 +#define VSETVL(n) __riscv_vsetvl_e32m2(n) +#define FLOAT_V_T vfloat32m2_t +#define VLEV_FLOAT __riscv_vle32_v_f32m2 +#define VSEV_FLOAT __riscv_vse32_v_f32m2 +#define VSEV_FLOAT_M __riscv_vse32_v_f32m2_m +#define VLSEV_FLOAT __riscv_vlse32_v_f32m2 +#define VBOOL_T vbool16_t +#define UINT_V_T vuint32m2_t +#define VID_V_UINT __riscv_vid_v_u32m2 +#define VMSLTU_VX_UINT __riscv_vmsltu_vx_u32m2_b16 #else -#define VSETVL(n) vsetvl_e64m2(n) -#define FLOAT_V_T vfloat64m2_t -#define VLEV_FLOAT vle64_v_f64m2 -#define VSEV_FLOAT vse64_v_f64m2 -#define VSEV_FLOAT_M vse64_v_f64m2_m -#define VLSEV_FLOAT vlse64_v_f64m2 -#define VBOOL_T vbool32_t -#define UINT_V_T vuint64m2_t -#define VID_V_UINT vid_v_u64m2 -#define VMSLTU_VX_UINT vmsltu_vx_u64m2_b32 +#define VSETVL(n) __riscv_vsetvl_e64m2(n) +#define FLOAT_V_T vfloat64m2_t +#define VLEV_FLOAT __riscv_vle64_v_f64m2 +#define VSEV_FLOAT __riscv_vse64_v_f64m2 +#define VSEV_FLOAT_M __riscv_vse64_v_f64m2_m +#define VLSEV_FLOAT __riscv_vlse64_v_f64m2 +#define VBOOL_T vbool32_t +#define UINT_V_T vuint64m2_t +#define VID_V_UINT __riscv_vid_v_u64m2 +#define VMSLTU_VX_UINT __riscv_vmsltu_vx_u64m2_b32 #endif diff --git a/kernel/riscv64/zamax_rvv.c b/kernel/riscv64/zamax_rvv.c index 1917042be..615b7519c 100644 --- a/kernel/riscv64/zamax_rvv.c +++ b/kernel/riscv64/zamax_rvv.c @@ -29,35 +29,35 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include #if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m4(n) -#define VSETVL_MAX vsetvlmax_e32m4() -#define VSETVL_MAX_M1 vsetvlmax_e32m1() -#define FLOAT_V_T vfloat32m4_t -#define FLOAT_V_T_M1 vfloat32m1_t -#define VLSEG_FLOAT vlseg2e32_v_f32m4 -#define VLSSEG_FLOAT vlsseg2e32_v_f32m4 -#define VFREDMAXVS_FLOAT vfredmax_vs_f32m4_f32m1 -#define VFMVVF_FLOAT vfmv_v_f_f32m4 -#define VFMVVF_FLOAT_M1 vfmv_v_f_f32m1 -#define VFMAXVV_FLOAT vfmax_vv_f32m4 -#define VFADDVV_FLOAT vfadd_vv_f32m4 -#define VFABSV_FLOAT vfabs_v_f32m4 -#define VFMVFS_FLOAT_M1 vfmv_f_s_f32m1_f32 +#define VSETVL(n) __riscv_vsetvl_e32m4(n) +#define VSETVL_MAX __riscv_vsetvlmax_e32m4() +#define VSETVL_MAX_M1 __riscv_vsetvlmax_e32m1() +#define FLOAT_V_T vfloat32m4_t +#define FLOAT_V_T_M1 vfloat32m1_t +#define VLSEG_FLOAT __riscv_vlseg2e32_v_f32m4 +#define VLSSEG_FLOAT __riscv_vlsseg2e32_v_f32m4 +#define VFREDMAXVS_FLOAT __riscv_vfredmax_vs_f32m4_f32m1 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m4 +#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f32m1 +#define VFMAXVV_FLOAT __riscv_vfmax_vv_f32m4 +#define VFADDVV_FLOAT __riscv_vfadd_vv_f32m4 +#define VFABSV_FLOAT __riscv_vfabs_v_f32m4 +#define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f32m1_f32 #else -#define VSETVL(n) vsetvl_e64m4(n) -#define VSETVL_MAX vsetvlmax_e64m4() -#define VSETVL_MAX_M1 vsetvlmax_e64m1() -#define FLOAT_V_T vfloat64m4_t -#define FLOAT_V_T_M1 vfloat64m1_t -#define VLSEG_FLOAT vlseg2e64_v_f64m4 -#define VLSSEG_FLOAT vlsseg2e64_v_f64m4 -#define VFREDMAXVS_FLOAT vfredmax_vs_f64m4_f64m1 -#define VFMVVF_FLOAT vfmv_v_f_f64m4 -#define VFMVVF_FLOAT_M1 vfmv_v_f_f64m1 -#define VFMAXVV_FLOAT vfmax_vv_f64m4 -#define VFADDVV_FLOAT vfadd_vv_f64m4 -#define VFABSV_FLOAT vfabs_v_f64m4 -#define VFMVFS_FLOAT_M1 vfmv_f_s_f64m1_f64 +#define VSETVL(n) __riscv_vsetvl_e64m4(n) +#define VSETVL_MAX __riscv_vsetvlmax_e64m4() +#define VSETVL_MAX_M1 __riscv_vsetvlmax_e64m1() +#define FLOAT_V_T vfloat64m4_t +#define FLOAT_V_T_M1 vfloat64m1_t +#define VLSEG_FLOAT __riscv_vlseg2e64_v_f64m4 +#define VLSSEG_FLOAT __riscv_vlsseg2e64_v_f64m4 +#define VFREDMAXVS_FLOAT __riscv_vfredmax_vs_f64m4_f64m1 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m4 +#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f64m1 +#define VFMAXVV_FLOAT __riscv_vfmax_vv_f64m4 +#define VFADDVV_FLOAT __riscv_vfadd_vv_f64m4 +#define VFABSV_FLOAT __riscv_vfabs_v_f64m4 +#define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f64m1_f64 #endif FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) @@ -106,7 +106,7 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) } - v_res = VFREDMAXVS_FLOAT(v_res, vmax, v_res, vlmax); + v_res = VFREDMAXVS_FLOAT(vmax, v_res, vlmax); maxf = VFMVFS_FLOAT_M1(v_res); return(maxf); diff --git a/kernel/riscv64/zamin_rvv.c b/kernel/riscv64/zamin_rvv.c index 3f027383a..a0d36d46f 100644 --- a/kernel/riscv64/zamin_rvv.c +++ b/kernel/riscv64/zamin_rvv.c @@ -29,35 +29,35 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include #if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m4(n) -#define VSETVL_MAX vsetvlmax_e32m4() -#define VSETVL_MAX_M1 vsetvlmax_e32m1() -#define FLOAT_V_T vfloat32m4_t -#define FLOAT_V_T_M1 vfloat32m1_t -#define VLSEG_FLOAT vlseg2e32_v_f32m4 -#define VLSSEG_FLOAT vlsseg2e32_v_f32m4 -#define VFREDMINVS_FLOAT vfredmin_vs_f32m4_f32m1 -#define VFMVVF_FLOAT vfmv_v_f_f32m4 -#define VFMVVF_FLOAT_M1 vfmv_v_f_f32m1 -#define VFMINVV_FLOAT vfmin_vv_f32m4 -#define VFADDVV_FLOAT vfadd_vv_f32m4 -#define VFABSV_FLOAT vfabs_v_f32m4 -#define VFMVFS_FLOAT_M1 vfmv_f_s_f32m1_f32 +#define VSETVL(n) __riscv_vsetvl_e32m4(n) +#define VSETVL_MAX __riscv_vsetvlmax_e32m4() +#define VSETVL_MAX_M1 __riscv_vsetvlmax_e32m1() +#define FLOAT_V_T vfloat32m4_t +#define FLOAT_V_T_M1 vfloat32m1_t +#define VLSEG_FLOAT __riscv_vlseg2e32_v_f32m4 +#define VLSSEG_FLOAT __riscv_vlsseg2e32_v_f32m4 +#define VFREDMINVS_FLOAT __riscv_vfredmin_vs_f32m4_f32m1 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m4 +#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f32m1 +#define VFMINVV_FLOAT __riscv_vfmin_vv_f32m4 +#define VFADDVV_FLOAT __riscv_vfadd_vv_f32m4 +#define VFABSV_FLOAT __riscv_vfabs_v_f32m4 +#define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f32m1_f32 #else -#define VSETVL(n) vsetvl_e64m4(n) -#define VSETVL_MAX vsetvlmax_e64m4() -#define VSETVL_MAX_M1 vsetvlmax_e64m1() -#define FLOAT_V_T vfloat64m4_t -#define FLOAT_V_T_M1 vfloat64m1_t -#define VLSEG_FLOAT vlseg2e64_v_f64m4 -#define VLSSEG_FLOAT vlsseg2e64_v_f64m4 -#define VFREDMINVS_FLOAT vfredmin_vs_f64m4_f64m1 -#define VFMVVF_FLOAT vfmv_v_f_f64m4 -#define VFMVVF_FLOAT_M1 vfmv_v_f_f64m1 -#define VFMINVV_FLOAT vfmin_vv_f64m4 -#define VFADDVV_FLOAT vfadd_vv_f64m4 -#define VFABSV_FLOAT vfabs_v_f64m4 -#define VFMVFS_FLOAT_M1 vfmv_f_s_f64m1_f64 +#define VSETVL(n) __riscv_vsetvl_e64m4(n) +#define VSETVL_MAX __riscv_vsetvlmax_e64m4() +#define VSETVL_MAX_M1 __riscv_vsetvlmax_e64m1() +#define FLOAT_V_T vfloat64m4_t +#define FLOAT_V_T_M1 vfloat64m1_t +#define VLSEG_FLOAT __riscv_vlseg2e64_v_f64m4 +#define VLSSEG_FLOAT __riscv_vlsseg2e64_v_f64m4 +#define VFREDMINVS_FLOAT __riscv_vfredmin_vs_f64m4_f64m1 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m4 +#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f64m1 +#define VFMINVV_FLOAT __riscv_vfmin_vv_f64m4 +#define VFADDVV_FLOAT __riscv_vfadd_vv_f64m4 +#define VFABSV_FLOAT __riscv_vfabs_v_f64m4 +#define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f64m1_f64 #endif FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) @@ -105,7 +105,7 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) } - v_res = VFREDMINVS_FLOAT(v_res, vmin, v_res, vlmax); + v_res = VFREDMINVS_FLOAT(vmin, v_res, vlmax); minf = VFMVFS_FLOAT_M1(v_res); return(minf); diff --git a/kernel/riscv64/zasum_rvv.c b/kernel/riscv64/zasum_rvv.c index 7876646b3..1d2f0e1fe 100644 --- a/kernel/riscv64/zasum_rvv.c +++ b/kernel/riscv64/zasum_rvv.c @@ -28,31 +28,31 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include "common.h" #if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m8(n) -#define VSETVL_MAX vsetvlmax_e32m8() -#define FLOAT_V_T vfloat32m8_t -#define FLOAT_V_T_M1 vfloat32m1_t -#define VLEV_FLOAT vle32_v_f32m8 -#define VLSEV_FLOAT vlse32_v_f32m8 -#define VFREDSUMVS_FLOAT vfredusum_vs_f32m8_f32m1 -#define VFMVVF_FLOAT vfmv_v_f_f32m8 -#define VFMVVF_FLOAT_M1 vfmv_v_f_f32m1 -#define VFMVFS_FLOAT_M1 vfmv_f_s_f32m1_f32 -#define VFADDVV_FLOAT vfadd_vv_f32m8 -#define VFABSV_FLOAT vfabs_v_f32m8 +#define VSETVL(n) __riscv_vsetvl_e32m8(n) +#define VSETVL_MAX __riscv_vsetvlmax_e32m8() +#define FLOAT_V_T vfloat32m8_t +#define FLOAT_V_T_M1 vfloat32m1_t +#define VLEV_FLOAT __riscv_vle32_v_f32m8 +#define VLSEV_FLOAT __riscv_vlse32_v_f32m8 +#define VFREDSUMVS_FLOAT __riscv_vfredusum_vs_f32m8_f32m1 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m8 +#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f32m1 +#define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f32m1_f32 +#define VFADDVV_FLOAT __riscv_vfadd_vv_f32m8 +#define VFABSV_FLOAT __riscv_vfabs_v_f32m8 #else -#define VSETVL(n) vsetvl_e64m8(n) -#define VSETVL_MAX vsetvlmax_e64m8() -#define FLOAT_V_T vfloat64m8_t -#define FLOAT_V_T_M1 vfloat64m1_t -#define VLEV_FLOAT vle64_v_f64m8 -#define VLSEV_FLOAT vlse64_v_f64m8 -#define VFREDSUMVS_FLOAT vfredusum_vs_f64m8_f64m1 -#define VFMVVF_FLOAT vfmv_v_f_f64m8 -#define VFMVVF_FLOAT_M1 vfmv_v_f_f64m1 -#define VFMVFS_FLOAT_M1 vfmv_f_s_f64m1_f64 -#define VFADDVV_FLOAT vfadd_vv_f64m8 -#define VFABSV_FLOAT vfabs_v_f64m8 +#define VSETVL(n) __riscv_vsetvl_e64m8(n) +#define VSETVL_MAX __riscv_vsetvlmax_e64m8() +#define FLOAT_V_T vfloat64m8_t +#define FLOAT_V_T_M1 vfloat64m1_t +#define VLEV_FLOAT __riscv_vle64_v_f64m8 +#define VLSEV_FLOAT __riscv_vlse64_v_f64m8 +#define VFREDSUMVS_FLOAT __riscv_vfredusum_vs_f64m8_f64m1 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m8 +#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f64m1 +#define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f64m1_f64 +#define VFADDVV_FLOAT __riscv_vfadd_vv_f64m8 +#define VFABSV_FLOAT __riscv_vfabs_v_f64m8 #endif FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) @@ -99,9 +99,8 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) } - FLOAT_V_T_M1 v_z0 = VFMVVF_FLOAT_M1(0, vlmax); FLOAT_V_T_M1 v_res = VFMVVF_FLOAT_M1(0, vlmax); - v_res = VFREDSUMVS_FLOAT(v_res, v_sum, v_z0, vlmax); + v_res = VFREDSUMVS_FLOAT(v_sum, v_res, vlmax); asumf += VFMVFS_FLOAT_M1(v_res); return(asumf); diff --git a/kernel/riscv64/zaxpby_rvv.c b/kernel/riscv64/zaxpby_rvv.c index 66f52d9d0..e0da55311 100644 --- a/kernel/riscv64/zaxpby_rvv.c +++ b/kernel/riscv64/zaxpby_rvv.c @@ -33,33 +33,33 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include "common.h" #if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m4(n) -#define FLOAT_V_T vfloat32m4_t -#define VLSEV_FLOAT vlse32_v_f32m4 -#define VSSEV_FLOAT vsse32_v_f32m4 -#define VFMACCVF_FLOAT vfmacc_vf_f32m4 -#define VFNMSACVF_FLOAT vfnmsac_vf_f32m4 -#define VFMVVF_FLOAT vfmv_v_f_f32m4 -#define VFMULVF_FLOAT vfmul_vf_f32m4 -#define VFMSACVF_FLOAT vfmsac_vf_f32m4 -#define VLSEG_FLOAT vlseg2e32_v_f32m4 -#define VSSEG_FLOAT vsseg2e32_v_f32m4 -#define VLSSEG_FLOAT vlsseg2e32_v_f32m4 -#define VSSSEG_FLOAT vssseg2e32_v_f32m4 +#define VSETVL(n) __riscv_vsetvl_e32m4(n) +#define FLOAT_V_T vfloat32m4_t +#define VLSEV_FLOAT __riscv_vlse32_v_f32m4 +#define VSSEV_FLOAT __riscv_vsse32_v_f32m4 +#define VFMACCVF_FLOAT __riscv_vfmacc_vf_f32m4 +#define VFNMSACVF_FLOAT __riscv_vfnmsac_vf_f32m4 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m4 +#define VFMULVF_FLOAT __riscv_vfmul_vf_f32m4 +#define VFMSACVF_FLOAT __riscv_vfmsac_vf_f32m4 +#define VLSEG_FLOAT __riscv_vlseg2e32_v_f32m4 +#define VSSEG_FLOAT __riscv_vsseg2e32_v_f32m4 +#define VLSSEG_FLOAT __riscv_vlsseg2e32_v_f32m4 +#define VSSSEG_FLOAT __riscv_vssseg2e32_v_f32m4 #else -#define VSETVL(n) vsetvl_e64m4(n) -#define FLOAT_V_T vfloat64m4_t -#define VLSEV_FLOAT vlse64_v_f64m4 -#define VSSEV_FLOAT vsse64_v_f64m4 -#define VFMACCVF_FLOAT vfmacc_vf_f64m4 -#define VFNMSACVF_FLOAT vfnmsac_vf_f64m4 -#define VFMVVF_FLOAT vfmv_v_f_f64m4 -#define VFMULVF_FLOAT vfmul_vf_f64m4 -#define VFMSACVF_FLOAT vfmsac_vf_f64m4 -#define VLSEG_FLOAT vlseg2e64_v_f64m4 -#define VSSEG_FLOAT vsseg2e64_v_f64m4 -#define VLSSEG_FLOAT vlsseg2e64_v_f64m4 -#define VSSSEG_FLOAT vssseg2e64_v_f64m4 +#define VSETVL(n) __riscv_vsetvl_e64m4(n) +#define FLOAT_V_T vfloat64m4_t +#define VLSEV_FLOAT __riscv_vlse64_v_f64m4 +#define VSSEV_FLOAT __riscv_vsse64_v_f64m4 +#define VFMACCVF_FLOAT __riscv_vfmacc_vf_f64m4 +#define VFNMSACVF_FLOAT __riscv_vfnmsac_vf_f64m4 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m4 +#define VFMULVF_FLOAT __riscv_vfmul_vf_f64m4 +#define VFMSACVF_FLOAT __riscv_vfmsac_vf_f64m4 +#define VLSEG_FLOAT __riscv_vlseg2e64_v_f64m4 +#define VSSEG_FLOAT __riscv_vsseg2e64_v_f64m4 +#define VLSSEG_FLOAT __riscv_vlsseg2e64_v_f64m4 +#define VSSSEG_FLOAT __riscv_vssseg2e64_v_f64m4 #endif int CNAME(BLASLONG n, FLOAT alpha_r, FLOAT alpha_i, FLOAT *x, BLASLONG inc_x, FLOAT beta_r, FLOAT beta_i,FLOAT *y, BLASLONG inc_y) diff --git a/kernel/riscv64/zaxpy_rvv.c b/kernel/riscv64/zaxpy_rvv.c index 777bcb728..3f75898e0 100644 --- a/kernel/riscv64/zaxpy_rvv.c +++ b/kernel/riscv64/zaxpy_rvv.c @@ -28,23 +28,23 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include "common.h" #if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m4(n) -#define FLOAT_V_T vfloat32m4_t -#define VLSEG_FLOAT vlseg2e32_v_f32m4 -#define VLSSEG_FLOAT vlsseg2e32_v_f32m4 -#define VSSEG_FLOAT vsseg2e32_v_f32m4 -#define VSSSEG_FLOAT vssseg2e32_v_f32m4 -#define VFMACCVF_FLOAT vfmacc_vf_f32m4 -#define VFNMSACVF_FLOAT vfnmsac_vf_f32m4 +#define VSETVL(n) __riscv_vsetvl_e32m4(n) +#define FLOAT_V_T vfloat32m4_t +#define VLSEG_FLOAT __riscv_vlseg2e32_v_f32m4 +#define VLSSEG_FLOAT __riscv_vlsseg2e32_v_f32m4 +#define VSSEG_FLOAT __riscv_vsseg2e32_v_f32m4 +#define VSSSEG_FLOAT __riscv_vssseg2e32_v_f32m4 +#define VFMACCVF_FLOAT __riscv_vfmacc_vf_f32m4 +#define VFNMSACVF_FLOAT __riscv_vfnmsac_vf_f32m4 #else -#define VSETVL(n) vsetvl_e64m4(n) -#define FLOAT_V_T vfloat64m4_t -#define VLSEG_FLOAT vlseg2e64_v_f64m4 -#define VLSSEG_FLOAT vlsseg2e64_v_f64m4 -#define VSSEG_FLOAT vsseg2e64_v_f64m4 -#define VSSSEG_FLOAT vssseg2e64_v_f64m4 -#define VFMACCVF_FLOAT vfmacc_vf_f64m4 -#define VFNMSACVF_FLOAT vfnmsac_vf_f64m4 +#define VSETVL(n) __riscv_vsetvl_e64m4(n) +#define FLOAT_V_T vfloat64m4_t +#define VLSEG_FLOAT __riscv_vlseg2e64_v_f64m4 +#define VLSSEG_FLOAT __riscv_vlsseg2e64_v_f64m4 +#define VSSEG_FLOAT __riscv_vsseg2e64_v_f64m4 +#define VSSSEG_FLOAT __riscv_vssseg2e64_v_f64m4 +#define VFMACCVF_FLOAT __riscv_vfmacc_vf_f64m4 +#define VFNMSACVF_FLOAT __riscv_vfnmsac_vf_f64m4 #endif int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT da_r, FLOAT da_i, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y, FLOAT *dummy, BLASLONG dummy2) diff --git a/kernel/riscv64/zcopy_rvv.c b/kernel/riscv64/zcopy_rvv.c index 5d8322bbb..bd94810ce 100644 --- a/kernel/riscv64/zcopy_rvv.c +++ b/kernel/riscv64/zcopy_rvv.c @@ -28,29 +28,29 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include "common.h" #if !defined(DOUBLE) -#define VSETVL_M8(n) vsetvl_e32m8(n) -#define FLOAT_V_T_M8 vfloat32m8_t -#define VLEV_FLOAT_M8 vle32_v_f32m8 -#define VSEV_FLOAT_M8 vse32_v_f32m8 - -#define VSETVL_M4(n) vsetvl_e32m4(n) -#define FLOAT_V_T_M4 vfloat32m4_t -#define VLSEG_FLOAT_M4 vlseg2e32_v_f32m4 -#define VSSEG_FLOAT_M4 vsseg2e32_v_f32m4 -#define VLSSEG_FLOAT_M4 vlsseg2e32_v_f32m4 -#define VSSSEG_FLOAT_M4 vssseg2e32_v_f32m4 +#define VSETVL_M8(n) __riscv_vsetvl_e32m8(n) +#define FLOAT_V_T_M8 vfloat32m8_t +#define VLEV_FLOAT_M8 __riscv_vle32_v_f32m8 +#define VSEV_FLOAT_M8 __riscv_vse32_v_f32m8 + +#define VSETVL_M4(n) __riscv_vsetvl_e32m4(n) +#define FLOAT_V_T_M4 vfloat32m4_t +#define VLSEG_FLOAT_M4 __riscv_vlseg2e32_v_f32m4 +#define VSSEG_FLOAT_M4 __riscv_vsseg2e32_v_f32m4 +#define VLSSEG_FLOAT_M4 __riscv_vlsseg2e32_v_f32m4 +#define VSSSEG_FLOAT_M4 __riscv_vssseg2e32_v_f32m4 #else -#define VSETVL_M8(n) vsetvl_e64m8(n) -#define FLOAT_V_T_M8 vfloat64m8_t -#define VLEV_FLOAT_M8 vle64_v_f64m8 -#define VSEV_FLOAT_M8 vse64_v_f64m8 - -#define VSETVL_M4(n) vsetvl_e64m4(n) -#define FLOAT_V_T_M4 vfloat64m4_t -#define VLSEG_FLOAT_M4 vlseg2e64_v_f64m4 -#define VSSEG_FLOAT_M4 vsseg2e64_v_f64m4 -#define VLSSEG_FLOAT_M4 vlsseg2e64_v_f64m4 -#define VSSSEG_FLOAT_M4 vssseg2e64_v_f64m4 +#define VSETVL_M8(n) __riscv_vsetvl_e64m8(n) +#define FLOAT_V_T_M8 vfloat64m8_t +#define VLEV_FLOAT_M8 __riscv_vle64_v_f64m8 +#define VSEV_FLOAT_M8 __riscv_vse64_v_f64m8 + +#define VSETVL_M4(n) __riscv_vsetvl_e64m4(n) +#define FLOAT_V_T_M4 vfloat64m4_t +#define VLSEG_FLOAT_M4 __riscv_vlseg2e64_v_f64m4 +#define VSSEG_FLOAT_M4 __riscv_vsseg2e64_v_f64m4 +#define VLSSEG_FLOAT_M4 __riscv_vlsseg2e64_v_f64m4 +#define VSSSEG_FLOAT_M4 __riscv_vssseg2e64_v_f64m4 #endif int CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y) diff --git a/kernel/riscv64/zdot_rvv.c b/kernel/riscv64/zdot_rvv.c index 7eae6f608..1543c513d 100644 --- a/kernel/riscv64/zdot_rvv.c +++ b/kernel/riscv64/zdot_rvv.c @@ -28,37 +28,37 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include "common.h" #if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m4(n) -#define VSETVL_MAX vsetvlmax_e32m4() -#define VSETVL_MAX_M1 vsetvlmax_e32m1() -#define FLOAT_V_T vfloat32m4_t -#define FLOAT_V_T_M1 vfloat32m1_t -#define VLSEG_FLOAT vlseg2e32_v_f32m4 -#define VLSSEG_FLOAT vlsseg2e32_v_f32m4 -#define VFREDSUM_FLOAT vfredusum_vs_f32m4_f32m1 -#define VFMACCVV_FLOAT vfmacc_vv_f32m4 -#define VFMVVF_FLOAT vfmv_v_f_f32m4 -#define VFMVVF_FLOAT_M1 vfmv_v_f_f32m1 -#define VFMULVV_FLOAT vfmul_vv_f32m4 -#define VFMSACVV_FLOAT vfmsac_vv_f32m4 -#define VFNMSACVV_FLOAT vfnmsac_vv_f32m4 -#define VFMVFS_FLOAT_M1 vfmv_f_s_f32m1_f32 +#define VSETVL(n) __riscv_vsetvl_e32m4(n) +#define VSETVL_MAX __riscv_vsetvlmax_e32m4() +#define VSETVL_MAX_M1 __riscv_vsetvlmax_e32m1() +#define FLOAT_V_T vfloat32m4_t +#define FLOAT_V_T_M1 vfloat32m1_t +#define VLSEG_FLOAT __riscv_vlseg2e32_v_f32m4 +#define VLSSEG_FLOAT __riscv_vlsseg2e32_v_f32m4 +#define VFREDSUM_FLOAT __riscv_vfredusum_vs_f32m4_f32m1 +#define VFMACCVV_FLOAT __riscv_vfmacc_vv_f32m4 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m4 +#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f32m1 +#define VFMULVV_FLOAT __riscv_vfmul_vv_f32m4 +#define VFMSACVV_FLOAT __riscv_vfmsac_vv_f32m4 +#define VFNMSACVV_FLOAT __riscv_vfnmsac_vv_f32m4 +#define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f32m1_f32 #else -#define VSETVL(n) vsetvl_e64m4(n) -#define VSETVL_MAX vsetvlmax_e64m4() -#define VSETVL_MAX_M1 vsetvlmax_e64m1() -#define FLOAT_V_T vfloat64m4_t -#define FLOAT_V_T_M1 vfloat64m1_t -#define VLSEG_FLOAT vlseg2e64_v_f64m4 -#define VLSSEG_FLOAT vlsseg2e64_v_f64m4 -#define VFREDSUM_FLOAT vfredusum_vs_f64m4_f64m1 -#define VFMACCVV_FLOAT vfmacc_vv_f64m4 -#define VFMVVF_FLOAT vfmv_v_f_f64m4 -#define VFMVVF_FLOAT_M1 vfmv_v_f_f64m1 -#define VFMULVV_FLOAT vfmul_vv_f64m4 -#define VFMSACVV_FLOAT vfmsac_vv_f64m4 -#define VFNMSACVV_FLOAT vfnmsac_vv_f64m4 -#define VFMVFS_FLOAT_M1 vfmv_f_s_f64m1_f64 +#define VSETVL(n) __riscv_vsetvl_e64m4(n) +#define VSETVL_MAX __riscv_vsetvlmax_e64m4() +#define VSETVL_MAX_M1 __riscv_vsetvlmax_e64m1() +#define FLOAT_V_T vfloat64m4_t +#define FLOAT_V_T_M1 vfloat64m1_t +#define VLSEG_FLOAT __riscv_vlseg2e64_v_f64m4 +#define VLSSEG_FLOAT __riscv_vlsseg2e64_v_f64m4 +#define VFREDSUM_FLOAT __riscv_vfredusum_vs_f64m4_f64m1 +#define VFMACCVV_FLOAT __riscv_vfmacc_vv_f64m4 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m4 +#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f64m1 +#define VFMULVV_FLOAT __riscv_vfmul_vv_f64m4 +#define VFMSACVV_FLOAT __riscv_vfmsac_vv_f64m4 +#define VFNMSACVV_FLOAT __riscv_vfnmsac_vv_f64m4 +#define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f64m1_f64 #endif OPENBLAS_COMPLEX_FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y) @@ -72,7 +72,6 @@ OPENBLAS_COMPLEX_FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLA FLOAT_V_T vr0, vr1, vx0, vx1, vy0, vy1; FLOAT_V_T_M1 v_res, v_z0; size_t vlmax_m1 = VSETVL_MAX_M1; - v_res = VFMVVF_FLOAT_M1(0, vlmax_m1); v_z0 = VFMVVF_FLOAT_M1(0, vlmax_m1); size_t vlmax = VSETVL_MAX; @@ -161,9 +160,9 @@ OPENBLAS_COMPLEX_FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLA } } - v_res = VFREDSUM_FLOAT(v_res, vr0, v_z0, vlmax); + v_res = VFREDSUM_FLOAT(vr0, v_z0, vlmax); CREAL(result) = VFMVFS_FLOAT_M1(v_res); - v_res = VFREDSUM_FLOAT(v_res, vr1, v_z0, vlmax); + v_res = VFREDSUM_FLOAT(vr1, v_z0, vlmax); CIMAG(result) = VFMVFS_FLOAT_M1(v_res); return(result); diff --git a/kernel/riscv64/zgemm_beta_rvv.c b/kernel/riscv64/zgemm_beta_rvv.c index a89752d18..b94b5f4bf 100644 --- a/kernel/riscv64/zgemm_beta_rvv.c +++ b/kernel/riscv64/zgemm_beta_rvv.c @@ -39,23 +39,23 @@ #include "common.h" #if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m4(n) -#define FLOAT_V_T vfloat32m4_t -#define VLSEG_FLOAT vlseg2e32_v_f32m4 -#define VSSEG_FLOAT vsseg2e32_v_f32m4 -#define VFMVVF_FLOAT vfmv_v_f_f32m4 -#define VFMULVF_FLOAT vfmul_vf_f32m4 -#define VFADDVV_FLOAT vfadd_vv_f32m4 -#define VFSUBVV_FLOAT vfsub_vv_f32m4 +#define VSETVL(n) __riscv_vsetvl_e32m4(n) +#define FLOAT_V_T vfloat32m4_t +#define VLSEG_FLOAT __riscv_vlseg2e32_v_f32m4 +#define VSSEG_FLOAT __riscv_vsseg2e32_v_f32m4 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m4 +#define VFMULVF_FLOAT __riscv_vfmul_vf_f32m4 +#define VFADDVV_FLOAT __riscv_vfadd_vv_f32m4 +#define VFSUBVV_FLOAT __riscv_vfsub_vv_f32m4 #else -#define VSETVL(n) vsetvl_e64m4(n) -#define FLOAT_V_T vfloat64m4_t -#define VLSEG_FLOAT vlseg2e64_v_f64m4 -#define VSSEG_FLOAT vsseg2e64_v_f64m4 -#define VFMVVF_FLOAT vfmv_v_f_f64m4 -#define VFMULVF_FLOAT vfmul_vf_f64m4 -#define VFADDVV_FLOAT vfadd_vv_f64m4 -#define VFSUBVV_FLOAT vfsub_vv_f64m4 +#define VSETVL(n) __riscv_vsetvl_e64m4(n) +#define FLOAT_V_T vfloat64m4_t +#define VLSEG_FLOAT __riscv_vlseg2e64_v_f64m4 +#define VSSEG_FLOAT __riscv_vsseg2e64_v_f64m4 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m4 +#define VFMULVF_FLOAT __riscv_vfmul_vf_f64m4 +#define VFADDVV_FLOAT __riscv_vfadd_vv_f64m4 +#define VFSUBVV_FLOAT __riscv_vfsub_vv_f64m4 #endif int CNAME(BLASLONG m, BLASLONG n, BLASLONG dummy1, diff --git a/kernel/riscv64/zgemm_ncopy_4_rvv.c b/kernel/riscv64/zgemm_ncopy_4_rvv.c index 389ee5d57..d50a4b8d5 100644 --- a/kernel/riscv64/zgemm_ncopy_4_rvv.c +++ b/kernel/riscv64/zgemm_ncopy_4_rvv.c @@ -28,19 +28,19 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include "common.h" #if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m1(n) -#define FLOAT_V_T vfloat32m1_t -#define VLSEG2_FLOAT vlseg2e32_v_f32m1 -#define VSSEG2_FLOAT vsseg2e32_v_f32m1 -#define VSSEG4_FLOAT vsseg4e32_v_f32m1 -#define VSSEG8_FLOAT vsseg8e32_v_f32m1 +#define VSETVL(n) __riscv_vsetvl_e32m1(n) +#define FLOAT_V_T vfloat32m1_t +#define VLSEG2_FLOAT __riscv_vlseg2e32_v_f32m1 +#define VSSEG2_FLOAT __riscv_vsseg2e32_v_f32m1 +#define VSSEG4_FLOAT __riscv_vsseg4e32_v_f32m1 +#define VSSEG8_FLOAT __riscv_vsseg8e32_v_f32m1 #else -#define VSETVL(n) vsetvl_e64m1(n) -#define FLOAT_V_T vfloat64m1_t -#define VLSEG2_FLOAT vlseg2e64_v_f64m1 -#define VSSEG2_FLOAT vsseg2e64_v_f64m1 -#define VSSEG4_FLOAT vsseg4e64_v_f64m1 -#define VSSEG8_FLOAT vsseg8e64_v_f64m1 +#define VSETVL(n) __riscv_vsetvl_e64m1(n) +#define FLOAT_V_T vfloat64m1_t +#define VLSEG2_FLOAT __riscv_vlseg2e64_v_f64m1 +#define VSSEG2_FLOAT __riscv_vsseg2e64_v_f64m1 +#define VSSEG4_FLOAT __riscv_vsseg4e64_v_f64m1 +#define VSSEG8_FLOAT __riscv_vsseg8e64_v_f64m1 #endif // Optimizes the implementation in ../generic/zgemm_ncopy_4.c diff --git a/kernel/riscv64/zgemm_ncopy_rvv_v1.c b/kernel/riscv64/zgemm_ncopy_rvv_v1.c index df039bab6..1d3b8d3b7 100644 --- a/kernel/riscv64/zgemm_ncopy_rvv_v1.c +++ b/kernel/riscv64/zgemm_ncopy_rvv_v1.c @@ -29,15 +29,15 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include "common.h" #if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m2(n) -#define FLOAT_V_T vfloat32m2_t -#define VLSSEG2_FLOAT vlsseg2e32_v_f32m2 -#define VSSEG2_FLOAT vsseg2e32_v_f32m2 +#define VSETVL(n) __riscv_vsetvl_e32m2(n) +#define FLOAT_V_T vfloat32m2_t +#define VLSSEG2_FLOAT __riscv_vlsseg2e32_v_f32m2 +#define VSSEG2_FLOAT __riscv_vsseg2e32_v_f32m2 #else -#define VSETVL(n) vsetvl_e64m2(n) -#define FLOAT_V_T vfloat64m2_t -#define VLSSEG2_FLOAT vlsseg2e64_v_f64m2 -#define VSSEG2_FLOAT vsseg2e64_v_f64m2 +#define VSETVL(n) __riscv_vsetvl_e64m2(n) +#define FLOAT_V_T vfloat64m2_t +#define VLSSEG2_FLOAT __riscv_vlsseg2e64_v_f64m2 +#define VSSEG2_FLOAT __riscv_vsseg2e64_v_f64m2 #endif int CNAME(BLASLONG m, BLASLONG n, IFLOAT *a, BLASLONG lda, IFLOAT *b){ diff --git a/kernel/riscv64/zgemm_tcopy_4_rvv.c b/kernel/riscv64/zgemm_tcopy_4_rvv.c index 1b34039c8..8c35b5616 100644 --- a/kernel/riscv64/zgemm_tcopy_4_rvv.c +++ b/kernel/riscv64/zgemm_tcopy_4_rvv.c @@ -28,27 +28,27 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include "common.h" #if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m1(n) -#define FLOAT_V_T vfloat32m1_t -#define VLEV_FLOAT vle32_v_f32m1 -#define VSEV_FLOAT vse32_v_f32m1 -#define VLSSEG2_FLOAT vlsseg2e32_v_f32m1 -#define VLSSEG4_FLOAT vlsseg4e32_v_f32m1 -#define VLSSEG8_FLOAT vlsseg8e32_v_f32m1 -#define VSSEG2_FLOAT vsseg2e32_v_f32m1 -#define VSSEG4_FLOAT vsseg4e32_v_f32m1 -#define VSSEG8_FLOAT vsseg8e32_v_f32m1 +#define VSETVL(n) __riscv_vsetvl_e32m1(n) +#define FLOAT_V_T vfloat32m1_t +#define VLEV_FLOAT __riscv_vle32_v_f32m1 +#define VSEV_FLOAT __riscv_vse32_v_f32m1 +#define VLSSEG2_FLOAT __riscv_vlsseg2e32_v_f32m1 +#define VLSSEG4_FLOAT __riscv_vlsseg4e32_v_f32m1 +#define VLSSEG8_FLOAT __riscv_vlsseg8e32_v_f32m1 +#define VSSEG2_FLOAT __riscv_vsseg2e32_v_f32m1 +#define VSSEG4_FLOAT __riscv_vsseg4e32_v_f32m1 +#define VSSEG8_FLOAT __riscv_vsseg8e32_v_f32m1 #else -#define VSETVL(n) vsetvl_e64m1(n) -#define FLOAT_V_T vfloat64m1_t -#define VLEV_FLOAT vle64_v_f64m1 -#define VSEV_FLOAT vse64_v_f64m1 -#define VLSSEG2_FLOAT vlsseg2e64_v_f64m1 -#define VLSSEG4_FLOAT vlsseg4e64_v_f64m1 -#define VLSSEG8_FLOAT vlsseg8e64_v_f64m1 -#define VSSEG2_FLOAT vsseg2e64_v_f64m1 -#define VSSEG4_FLOAT vsseg4e64_v_f64m1 -#define VSSEG8_FLOAT vsseg8e64_v_f64m1 +#define VSETVL(n) __riscv_vsetvl_e64m1(n) +#define FLOAT_V_T vfloat64m1_t +#define VLEV_FLOAT __riscv_vle64_v_f64m1 +#define VSEV_FLOAT __riscv_vse64_v_f64m1 +#define VLSSEG2_FLOAT __riscv_vlsseg2e64_v_f64m1 +#define VLSSEG4_FLOAT __riscv_vlsseg4e64_v_f64m1 +#define VLSSEG8_FLOAT __riscv_vlsseg8e64_v_f64m1 +#define VSSEG2_FLOAT __riscv_vsseg2e64_v_f64m1 +#define VSSEG4_FLOAT __riscv_vsseg4e64_v_f64m1 +#define VSSEG8_FLOAT __riscv_vsseg8e64_v_f64m1 #endif int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, FLOAT *b){ diff --git a/kernel/riscv64/zgemm_tcopy_rvv_v1.c b/kernel/riscv64/zgemm_tcopy_rvv_v1.c index 7622fb810..7a085269c 100644 --- a/kernel/riscv64/zgemm_tcopy_rvv_v1.c +++ b/kernel/riscv64/zgemm_tcopy_rvv_v1.c @@ -28,15 +28,15 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include "common.h" #if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m2(n) -#define FLOAT_V_T vfloat32m2_t -#define VLSEG2_FLOAT vlseg2e32_v_f32m2 -#define VSSEG2_FLOAT vsseg2e32_v_f32m2 +#define VSETVL(n) __riscv_vsetvl_e32m2(n) +#define FLOAT_V_T vfloat32m2_t +#define VLSEG2_FLOAT __riscv_vlseg2e32_v_f32m2 +#define VSSEG2_FLOAT __riscv_vsseg2e32_v_f32m2 #else -#define VSETVL(n) vsetvl_e64m2(n) -#define FLOAT_V_T vfloat64m2_t -#define VLSEG2_FLOAT vlseg2e64_v_f64m2 -#define VSSEG2_FLOAT vsseg2e64_v_f64m2 +#define VSETVL(n) __riscv_vsetvl_e64m2(n) +#define FLOAT_V_T vfloat64m2_t +#define VLSEG2_FLOAT __riscv_vlseg2e64_v_f64m2 +#define VSSEG2_FLOAT __riscv_vsseg2e64_v_f64m2 #endif int CNAME(BLASLONG m, BLASLONG n, IFLOAT *a, BLASLONG lda, IFLOAT *b) diff --git a/kernel/riscv64/zgemmkernel_rvv_v1x4.c b/kernel/riscv64/zgemmkernel_rvv_v1x4.c index 50e29222f..41399cf79 100644 --- a/kernel/riscv64/zgemmkernel_rvv_v1x4.c +++ b/kernel/riscv64/zgemmkernel_rvv_v1x4.c @@ -28,25 +28,25 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include "common.h" #if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m2(n) -#define FLOAT_V_T vfloat32m2_t -#define VLEV_FLOAT vle32_v_f32m2 -#define VSEV_FLOAT vse32_v_f32m2 -#define VLSEG2_FLOAT vlseg2e32_v_f32m2 -#define VSSEG2_FLOAT vsseg2e32_v_f32m2 -#define VFMVVF_FLOAT vfmv_v_f_f32m2 -#define VFMACCVF_FLOAT vfmacc_vf_f32m2 -#define VFNMSACVF_FLOAT vfnmsac_vf_f32m2 +#define VSETVL(n) __riscv_vsetvl_e32m2(n) +#define FLOAT_V_T vfloat32m2_t +#define VLEV_FLOAT __riscv_vle32_v_f32m2 +#define VSEV_FLOAT __riscv_vse32_v_f32m2 +#define VLSEG2_FLOAT __riscv_vlseg2e32_v_f32m2 +#define VSSEG2_FLOAT __riscv_vsseg2e32_v_f32m2 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m2 +#define VFMACCVF_FLOAT __riscv_vfmacc_vf_f32m2 +#define VFNMSACVF_FLOAT __riscv_vfnmsac_vf_f32m2 #else -#define VSETVL(n) vsetvl_e64m2(n) -#define FLOAT_V_T vfloat64m2_t -#define VLEV_FLOAT vle64_v_f64m2 -#define VSEV_FLOAT vse64_v_f64m2 -#define VLSEG2_FLOAT vlseg2e64_v_f64m2 -#define VSSEG2_FLOAT vsseg2e64_v_f64m2 -#define VFMVVF_FLOAT vfmv_v_f_f64m2 -#define VFMACCVF_FLOAT vfmacc_vf_f64m2 -#define VFNMSACVF_FLOAT vfnmsac_vf_f64m2 +#define VSETVL(n) __riscv_vsetvl_e64m2(n) +#define FLOAT_V_T vfloat64m2_t +#define VLEV_FLOAT __riscv_vle64_v_f64m2 +#define VSEV_FLOAT __riscv_vse64_v_f64m2 +#define VLSEG2_FLOAT __riscv_vlseg2e64_v_f64m2 +#define VSSEG2_FLOAT __riscv_vsseg2e64_v_f64m2 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m2 +#define VFMACCVF_FLOAT __riscv_vfmacc_vf_f64m2 +#define VFNMSACVF_FLOAT __riscv_vfnmsac_vf_f64m2 #endif #if defined(NN) || defined(NT) || defined(TN) || defined(TT) diff --git a/kernel/riscv64/zgemv_n_rvv.c b/kernel/riscv64/zgemv_n_rvv.c index 2eeb61b45..4a40c30a7 100644 --- a/kernel/riscv64/zgemv_n_rvv.c +++ b/kernel/riscv64/zgemv_n_rvv.c @@ -28,31 +28,31 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include "common.h" #if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m4(n) -#define FLOAT_V_T vfloat32m4_t -#define VLEV_FLOAT vle32_v_f32m4 -#define VLSEV_FLOAT vlse32_v_f32m4 -#define VSEV_FLOAT vse32_v_f32m4 -#define VSSEV_FLOAT vsse32_v_f32m4 -#define VLSEG_FLOAT vlseg2e32_v_f32m4 -#define VSSEG_FLOAT vsseg2e32_v_f32m4 -#define VLSSEG_FLOAT vlsseg2e32_v_f32m4 -#define VSSSEG_FLOAT vssseg2e32_v_f32m4 -#define VFMACCVF_FLOAT vfmacc_vf_f32m4 -#define VFNMSACVF_FLOAT vfnmsac_vf_f32m4 +#define VSETVL(n) __riscv_vsetvl_e32m4(n) +#define FLOAT_V_T vfloat32m4_t +#define VLEV_FLOAT __riscv_vle32_v_f32m4 +#define VLSEV_FLOAT __riscv_vlse32_v_f32m4 +#define VSEV_FLOAT __riscv_vse32_v_f32m4 +#define VSSEV_FLOAT __riscv_vsse32_v_f32m4 +#define VLSEG_FLOAT __riscv_vlseg2e32_v_f32m4 +#define VSSEG_FLOAT __riscv_vsseg2e32_v_f32m4 +#define VLSSEG_FLOAT __riscv_vlsseg2e32_v_f32m4 +#define VSSSEG_FLOAT __riscv_vssseg2e32_v_f32m4 +#define VFMACCVF_FLOAT __riscv_vfmacc_vf_f32m4 +#define VFNMSACVF_FLOAT __riscv_vfnmsac_vf_f32m4 #else -#define VSETVL(n) vsetvl_e64m4(n) -#define FLOAT_V_T vfloat64m4_t -#define VLEV_FLOAT vle64_v_f64m4 -#define VLSEV_FLOAT vlse64_v_f64m4 -#define VSEV_FLOAT vse64_v_f64m4 -#define VSSEV_FLOAT vsse64_v_f64m4 -#define VLSEG_FLOAT vlseg2e64_v_f64m4 -#define VSSEG_FLOAT vsseg2e64_v_f64m4 -#define VLSSEG_FLOAT vlsseg2e64_v_f64m4 -#define VSSSEG_FLOAT vssseg2e64_v_f64m4 -#define VFMACCVF_FLOAT vfmacc_vf_f64m4 -#define VFNMSACVF_FLOAT vfnmsac_vf_f64m4 +#define VSETVL(n) __riscv_vsetvl_e64m4(n) +#define FLOAT_V_T vfloat64m4_t +#define VLEV_FLOAT __riscv_vle64_v_f64m4 +#define VLSEV_FLOAT __riscv_vlse64_v_f64m4 +#define VSEV_FLOAT __riscv_vse64_v_f64m4 +#define VSSEV_FLOAT __riscv_vsse64_v_f64m4 +#define VLSEG_FLOAT __riscv_vlseg2e64_v_f64m4 +#define VSSEG_FLOAT __riscv_vsseg2e64_v_f64m4 +#define VLSSEG_FLOAT __riscv_vlsseg2e64_v_f64m4 +#define VSSSEG_FLOAT __riscv_vssseg2e64_v_f64m4 +#define VFMACCVF_FLOAT __riscv_vfmacc_vf_f64m4 +#define VFNMSACVF_FLOAT __riscv_vfnmsac_vf_f64m4 #endif int CNAME(BLASLONG m, BLASLONG n, BLASLONG dummy1, FLOAT alpha_r, FLOAT alpha_i, FLOAT *a, BLASLONG lda, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y, FLOAT *buffer) diff --git a/kernel/riscv64/zgemv_t_rvv.c b/kernel/riscv64/zgemv_t_rvv.c index b682d5cd8..15795cc3a 100644 --- a/kernel/riscv64/zgemv_t_rvv.c +++ b/kernel/riscv64/zgemv_t_rvv.c @@ -28,33 +28,33 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include "common.h" #if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m4(n) -#define VSETVL_MAX_M1 vsetvlmax_e32m1() -#define FLOAT_V_T vfloat32m4_t -#define FLOAT_V_T_M1 vfloat32m1_t -#define VLSEG_FLOAT vlseg2e32_v_f32m4 -#define VLSSEG_FLOAT vlsseg2e32_v_f32m4 -#define VFREDSUM_FLOAT vfredusum_vs_f32m4_f32m1 -#define VFMACCVV_FLOAT vfmacc_vv_f32m4 -#define VFNMSACVV_FLOAT vfnmsac_vv_f32m4 -#define VFMVVF_FLOAT vfmv_v_f_f32m4 -#define VFMVVF_FLOAT_M1 vfmv_v_f_f32m1 -#define VFMULVV_FLOAT vfmul_vv_f32m4 -#define VFMVFS_FLOAT_M1 vfmv_f_s_f32m1_f32 +#define VSETVL(n) __riscv_vsetvl_e32m4(n) +#define VSETVL_MAX_M1 __riscv_vsetvlmax_e32m1() +#define FLOAT_V_T vfloat32m4_t +#define FLOAT_V_T_M1 vfloat32m1_t +#define VLSEG_FLOAT __riscv_vlseg2e32_v_f32m4 +#define VLSSEG_FLOAT __riscv_vlsseg2e32_v_f32m4 +#define VFREDSUM_FLOAT __riscv_vfredusum_vs_f32m4_f32m1 +#define VFMACCVV_FLOAT __riscv_vfmacc_vv_f32m4 +#define VFNMSACVV_FLOAT __riscv_vfnmsac_vv_f32m4 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m4 +#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f32m1 +#define VFMULVV_FLOAT __riscv_vfmul_vv_f32m4 +#define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f32m1_f32 #else -#define VSETVL(n) vsetvl_e64m4(n) -#define VSETVL_MAX_M1 vsetvlmax_e64m1() -#define FLOAT_V_T vfloat64m4_t -#define FLOAT_V_T_M1 vfloat64m1_t -#define VLSEG_FLOAT vlseg2e64_v_f64m4 -#define VLSSEG_FLOAT vlsseg2e64_v_f64m4 -#define VFREDSUM_FLOAT vfredusum_vs_f64m4_f64m1 -#define VFMACCVV_FLOAT vfmacc_vv_f64m4 -#define VFNMSACVV_FLOAT vfnmsac_vv_f64m4 -#define VFMVVF_FLOAT vfmv_v_f_f64m4 -#define VFMVVF_FLOAT_M1 vfmv_v_f_f64m1 -#define VFMULVV_FLOAT vfmul_vv_f64m4 -#define VFMVFS_FLOAT_M1 vfmv_f_s_f64m1_f64 +#define VSETVL(n) __riscv_vsetvl_e64m4(n) +#define VSETVL_MAX_M1 __riscv_vsetvlmax_e64m1() +#define FLOAT_V_T vfloat64m4_t +#define FLOAT_V_T_M1 vfloat64m1_t +#define VLSEG_FLOAT __riscv_vlseg2e64_v_f64m4 +#define VLSSEG_FLOAT __riscv_vlsseg2e64_v_f64m4 +#define VFREDSUM_FLOAT __riscv_vfredusum_vs_f64m4_f64m1 +#define VFMACCVV_FLOAT __riscv_vfmacc_vv_f64m4 +#define VFNMSACVV_FLOAT __riscv_vfnmsac_vv_f64m4 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m4 +#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f64m1 +#define VFMULVV_FLOAT __riscv_vfmul_vv_f64m4 +#define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f64m1_f64 #endif int CNAME(BLASLONG m, BLASLONG n, BLASLONG dummy1, FLOAT alpha_r, FLOAT alpha_i, FLOAT *a, BLASLONG lda, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y, FLOAT *buffer) @@ -73,7 +73,6 @@ int CNAME(BLASLONG m, BLASLONG n, BLASLONG dummy1, FLOAT alpha_r, FLOAT alpha_i, BLASLONG lda2 = lda * 2; size_t vlmax = VSETVL_MAX_M1; - v_res = VFMVVF_FLOAT_M1(0, vlmax); v_z0 = VFMVVF_FLOAT_M1(0, vlmax); vlmax = VSETVL(m); @@ -105,9 +104,9 @@ int CNAME(BLASLONG m, BLASLONG n, BLASLONG dummy1, FLOAT alpha_r, FLOAT alpha_i, ix += vl * inc_x * 2; } - v_res = VFREDSUM_FLOAT(v_res, vr, v_z0, vlmax); + v_res = VFREDSUM_FLOAT(vr, v_z0, vlmax); temp_r = VFMVFS_FLOAT_M1(v_res); - v_res = VFREDSUM_FLOAT(v_res, vi, v_z0, vlmax); + v_res = VFREDSUM_FLOAT(vi, v_z0, vlmax); temp_i = VFMVFS_FLOAT_M1(v_res); #if !defined(XCONJ) @@ -149,9 +148,9 @@ int CNAME(BLASLONG m, BLASLONG n, BLASLONG dummy1, FLOAT alpha_r, FLOAT alpha_i, ix += vl * inc_x * 2; } - v_res = VFREDSUM_FLOAT(v_res, vr, v_z0, vlmax); + v_res = VFREDSUM_FLOAT(vr, v_z0, vlmax); temp_r = VFMVFS_FLOAT_M1(v_res); - v_res = VFREDSUM_FLOAT(v_res, vi, v_z0, vlmax); + v_res = VFREDSUM_FLOAT(vi, v_z0, vlmax); temp_i = VFMVFS_FLOAT_M1(v_res); #if !defined(XCONJ) diff --git a/kernel/riscv64/zhemm_ltcopy_rvv_v1.c b/kernel/riscv64/zhemm_ltcopy_rvv_v1.c index cf466d3fa..79b20a646 100644 --- a/kernel/riscv64/zhemm_ltcopy_rvv_v1.c +++ b/kernel/riscv64/zhemm_ltcopy_rvv_v1.c @@ -28,45 +28,45 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include "common.h" #if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m2(n) -#define VSETVL_MAX vsetvlmax_e32m2() -#define FLOAT_V_T vfloat32m2_t -#define VLEV_FLOAT vle32_v_f32m2 -#define VSEV_FLOAT vse32_v_f32m2 -#define VLSEV_FLOAT vlse32_v_f32m2 -#define VLSEG2_FLOAT vlseg2e32_v_f32m2 -#define VLSSEG2_FLOAT vlsseg2e32_v_f32m2 -#define VSSEG2_FLOAT vsseg2e32_v_f32m2 -#define INT_V_T vint32m2_t -#define VID_V_INT vid_v_i32m2 -#define VADD_VX_INT vadd_vx_i32m2 -#define VFRSUB_VF_FLOAT vfrsub_vf_f32m2 -#define VMSGT_VX_INT vmsgt_vx_i32m2_b16 -#define VMSLT_VX_INT vmslt_vx_i32m2_b16 -#define VMSEQ_VX_INT vmseq_vx_i32m2_b16 -#define VBOOL_T vbool16_t -#define VMERGE_VVM_FLOAT vmerge_vvm_f32m2 -#define VFMVVF_FLOAT vfmv_v_f_f32m2 +#define VSETVL(n) __riscv_vsetvl_e32m2(n) +#define VSETVL_MAX __riscv_vsetvlmax_e32m2() +#define FLOAT_V_T vfloat32m2_t +#define VLEV_FLOAT __riscv_vle32_v_f32m2 +#define VSEV_FLOAT __riscv_vse32_v_f32m2 +#define VLSEV_FLOAT __riscv_vlse32_v_f32m2 +#define VLSEG2_FLOAT __riscv_vlseg2e32_v_f32m2 +#define VLSSEG2_FLOAT __riscv_vlsseg2e32_v_f32m2 +#define VSSEG2_FLOAT __riscv_vsseg2e32_v_f32m2 +#define INT_V_T vint32m2_t +#define VID_V_INT __riscv_vid_v_i32m2 +#define VADD_VX_INT __riscv_vadd_vx_i32m2 +#define VFRSUB_VF_FLOAT __riscv_vfrsub_vf_f32m2 +#define VMSGT_VX_INT __riscv_vmsgt_vx_i32m2_b16 +#define VMSLT_VX_INT __riscv_vmslt_vx_i32m2_b16 +#define VMSEQ_VX_INT __riscv_vmseq_vx_i32m2_b16 +#define VBOOL_T vbool16_t +#define VMERGE_VVM_FLOAT __riscv_vmerge_vvm_f32m2 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m2 #else -#define VSETVL(n) vsetvl_e64m2(n) -#define VSETVL_MAX vsetvlmax_e64m2() -#define FLOAT_V_T vfloat64m2_t -#define VLEV_FLOAT vle64_v_f64m2 -#define VSEV_FLOAT vse64_v_f64m2 -#define VLSEV_FLOAT vlse64_v_f64m2 -#define VLSEG2_FLOAT vlseg2e64_v_f64m2 -#define VLSSEG2_FLOAT vlsseg2e64_v_f64m2 -#define VSSEG2_FLOAT vsseg2e64_v_f64m2 -#define INT_V_T vint64m2_t -#define VID_V_INT vid_v_i64m2 -#define VADD_VX_INT vadd_vx_i64m2 -#define VFRSUB_VF_FLOAT vfrsub_vf_f64m2 -#define VMSGT_VX_INT vmsgt_vx_i64m2_b32 -#define VMSLT_VX_INT vmslt_vx_i64m2_b32 -#define VMSEQ_VX_INT vmseq_vx_i64m2_b32 -#define VBOOL_T vbool32_t -#define VMERGE_VVM_FLOAT vmerge_vvm_f64m2 -#define VFMVVF_FLOAT vfmv_v_f_f64m2 +#define VSETVL(n) __riscv_vsetvl_e64m2(n) +#define VSETVL_MAX __riscv_vsetvlmax_e64m2() +#define FLOAT_V_T vfloat64m2_t +#define VLEV_FLOAT __riscv_vle64_v_f64m2 +#define VSEV_FLOAT __riscv_vse64_v_f64m2 +#define VLSEV_FLOAT __riscv_vlse64_v_f64m2 +#define VLSEG2_FLOAT __riscv_vlseg2e64_v_f64m2 +#define VLSSEG2_FLOAT __riscv_vlsseg2e64_v_f64m2 +#define VSSEG2_FLOAT __riscv_vsseg2e64_v_f64m2 +#define INT_V_T vint64m2_t +#define VID_V_INT __riscv_vid_v_i64m2 +#define VADD_VX_INT __riscv_vadd_vx_i64m2 +#define VFRSUB_VF_FLOAT __riscv_vfrsub_vf_f64m2 +#define VMSGT_VX_INT __riscv_vmsgt_vx_i64m2_b32 +#define VMSLT_VX_INT __riscv_vmslt_vx_i64m2_b32 +#define VMSEQ_VX_INT __riscv_vmseq_vx_i64m2_b32 +#define VBOOL_T vbool32_t +#define VMERGE_VVM_FLOAT __riscv_vmerge_vvm_f64m2 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m2 #endif @@ -104,13 +104,13 @@ int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG posX, BLASLON vbool_lt0 = VMSLT_VX_INT(vindex, 0, vl); vbool_eq0 = VMSEQ_VX_INT(vindex, 0, vl); - vb0 = VMERGE_VVM_FLOAT(vbool_gt0, va20, va10, vl); - vb1 = VMERGE_VVM_FLOAT(vbool_gt0, va21, va11, vl); + vb0 = VMERGE_VVM_FLOAT(va20, va10, vbool_gt0, vl); + vb1 = VMERGE_VVM_FLOAT(va21, va11, vbool_gt0, vl); vb2 = VFRSUB_VF_FLOAT(vb1, ZERO, vl); - vb1 = VMERGE_VVM_FLOAT(vbool_lt0, vb1, vb2, vl); - vb1 = VMERGE_VVM_FLOAT(vbool_eq0, vb1, vzero, vl); + vb1 = VMERGE_VVM_FLOAT(vb1, vb2, vbool_lt0, vl); + vb1 = VMERGE_VVM_FLOAT(vb1, vzero, vbool_eq0, vl); VSSEG2_FLOAT(b, vb0, vb1, vl); b += vl * 2; diff --git a/kernel/riscv64/zhemm_utcopy_rvv_v1.c b/kernel/riscv64/zhemm_utcopy_rvv_v1.c index 6209f5417..a86815275 100644 --- a/kernel/riscv64/zhemm_utcopy_rvv_v1.c +++ b/kernel/riscv64/zhemm_utcopy_rvv_v1.c @@ -28,45 +28,45 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include "common.h" #if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m2(n) -#define VSETVL_MAX vsetvlmax_e32m2() -#define FLOAT_V_T vfloat32m2_t -#define VLEV_FLOAT vle32_v_f32m2 -#define VSEV_FLOAT vse32_v_f32m2 -#define VLSEV_FLOAT vlse32_v_f32m2 -#define VLSEG2_FLOAT vlseg2e32_v_f32m2 -#define VLSSEG2_FLOAT vlsseg2e32_v_f32m2 -#define VSSEG2_FLOAT vsseg2e32_v_f32m2 -#define INT_V_T vint32m2_t -#define VID_V_INT vid_v_i32m2 -#define VADD_VX_INT vadd_vx_i32m2 -#define VFRSUB_VF_FLOAT vfrsub_vf_f32m2 -#define VMSGT_VX_INT vmsgt_vx_i32m2_b16 -#define VMSLT_VX_INT vmslt_vx_i32m2_b16 -#define VMSEQ_VX_INT vmseq_vx_i32m2_b16 -#define VBOOL_T vbool16_t -#define VMERGE_VVM_FLOAT vmerge_vvm_f32m2 -#define VFMVVF_FLOAT vfmv_v_f_f32m2 +#define VSETVL(n) __riscv_vsetvl_e32m2(n) +#define VSETVL_MAX __riscv_vsetvlmax_e32m2() +#define FLOAT_V_T vfloat32m2_t +#define VLEV_FLOAT __riscv_vle32_v_f32m2 +#define VSEV_FLOAT __riscv_vse32_v_f32m2 +#define VLSEV_FLOAT __riscv_vlse32_v_f32m2 +#define VLSEG2_FLOAT __riscv_vlseg2e32_v_f32m2 +#define VLSSEG2_FLOAT __riscv_vlsseg2e32_v_f32m2 +#define VSSEG2_FLOAT __riscv_vsseg2e32_v_f32m2 +#define INT_V_T vint32m2_t +#define VID_V_INT __riscv_vid_v_i32m2 +#define VADD_VX_INT __riscv_vadd_vx_i32m2 +#define VFRSUB_VF_FLOAT __riscv_vfrsub_vf_f32m2 +#define VMSGT_VX_INT __riscv_vmsgt_vx_i32m2_b16 +#define VMSLT_VX_INT __riscv_vmslt_vx_i32m2_b16 +#define VMSEQ_VX_INT __riscv_vmseq_vx_i32m2_b16 +#define VBOOL_T vbool16_t +#define VMERGE_VVM_FLOAT __riscv_vmerge_vvm_f32m2 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m2 #else -#define VSETVL(n) vsetvl_e64m2(n) -#define VSETVL_MAX vsetvlmax_e64m2() -#define FLOAT_V_T vfloat64m2_t -#define VLEV_FLOAT vle64_v_f64m2 -#define VSEV_FLOAT vse64_v_f64m2 -#define VLSEV_FLOAT vlse64_v_f64m2 -#define VLSEG2_FLOAT vlseg2e64_v_f64m2 -#define VLSSEG2_FLOAT vlsseg2e64_v_f64m2 -#define VSSEG2_FLOAT vsseg2e64_v_f64m2 -#define INT_V_T vint64m2_t -#define VID_V_INT vid_v_i64m2 -#define VADD_VX_INT vadd_vx_i64m2 -#define VFRSUB_VF_FLOAT vfrsub_vf_f64m2 -#define VMSGT_VX_INT vmsgt_vx_i64m2_b32 -#define VMSLT_VX_INT vmslt_vx_i64m2_b32 -#define VMSEQ_VX_INT vmseq_vx_i64m2_b32 -#define VBOOL_T vbool32_t -#define VMERGE_VVM_FLOAT vmerge_vvm_f64m2 -#define VFMVVF_FLOAT vfmv_v_f_f64m2 +#define VSETVL(n) __riscv_vsetvl_e64m2(n) +#define VSETVL_MAX __riscv_vsetvlmax_e64m2() +#define FLOAT_V_T vfloat64m2_t +#define VLEV_FLOAT __riscv_vle64_v_f64m2 +#define VSEV_FLOAT __riscv_vse64_v_f64m2 +#define VLSEV_FLOAT __riscv_vlse64_v_f64m2 +#define VLSEG2_FLOAT __riscv_vlseg2e64_v_f64m2 +#define VLSSEG2_FLOAT __riscv_vlsseg2e64_v_f64m2 +#define VSSEG2_FLOAT __riscv_vsseg2e64_v_f64m2 +#define INT_V_T vint64m2_t +#define VID_V_INT __riscv_vid_v_i64m2 +#define VADD_VX_INT __riscv_vadd_vx_i64m2 +#define VFRSUB_VF_FLOAT __riscv_vfrsub_vf_f64m2 +#define VMSGT_VX_INT __riscv_vmsgt_vx_i64m2_b32 +#define VMSLT_VX_INT __riscv_vmslt_vx_i64m2_b32 +#define VMSEQ_VX_INT __riscv_vmseq_vx_i64m2_b32 +#define VBOOL_T vbool32_t +#define VMERGE_VVM_FLOAT __riscv_vmerge_vvm_f64m2 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m2 #endif @@ -101,13 +101,13 @@ int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG posX, BLASLON vbool_gt0 = VMSGT_VX_INT(vindex, 0, vl); vbool_eq0 = VMSEQ_VX_INT(vindex, 0, vl); - vb0 = VMERGE_VVM_FLOAT(vbool_gt0, va20, va10, vl); - vb1 = VMERGE_VVM_FLOAT(vbool_gt0, va21, va11, vl); + vb0 = VMERGE_VVM_FLOAT(va20, va10, vbool_gt0, vl); + vb1 = VMERGE_VVM_FLOAT(va21, va11, vbool_gt0, vl); vb2 = VFRSUB_VF_FLOAT(vb1, ZERO, vl); - vb1 = VMERGE_VVM_FLOAT(vbool_gt0, vb1, vb2, vl); - vb1 = VMERGE_VVM_FLOAT(vbool_eq0, vb1, vzero, vl); + vb1 = VMERGE_VVM_FLOAT(vb1, vb2, vbool_gt0, vl); + vb1 = VMERGE_VVM_FLOAT(vb1, vzero, vbool_eq0, vl); VSSEG2_FLOAT(b, vb0, vb1, vl); b += vl * 2; diff --git a/kernel/riscv64/znrm2_rvv.c b/kernel/riscv64/znrm2_rvv.c index 921ddb8cb..5f7873b5a 100644 --- a/kernel/riscv64/znrm2_rvv.c +++ b/kernel/riscv64/znrm2_rvv.c @@ -28,35 +28,35 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include "common.h" #if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m4(n) -#define VSETVL_MAX vsetvlmax_e32m4() -#define VSETVL_MAX_M1 vsetvlmax_e32m1() -#define FLOAT_V_T vfloat32m4_t -#define FLOAT_V_T_M1 vfloat32m1_t -#define VLSEG_FLOAT vlseg2e32_v_f32m4 -#define VLSSEG_FLOAT vlsseg2e32_v_f32m4 -#define VFREDSUM_FLOAT vfredusum_vs_f32m4_f32m1 -#define VFMACCVV_FLOAT vfmacc_vv_f32m4 -#define VFMVVF_FLOAT vfmv_v_f_f32m4 -#define VFMVVF_FLOAT_M1 vfmv_v_f_f32m1 -#define VFREDMAXVS_FLOAT vfredmax_vs_f32m4_f32m1 -#define VFMVFS_FLOAT_M1 vfmv_f_s_f32m1_f32 -#define VFABSV_FLOAT vfabs_v_f32m4 +#define VSETVL(n) __riscv_vsetvl_e32m4(n) +#define VSETVL_MAX __riscv_vsetvlmax_e32m4() +#define VSETVL_MAX_M1 __riscv_vsetvlmax_e32m1() +#define FLOAT_V_T vfloat32m4_t +#define FLOAT_V_T_M1 vfloat32m1_t +#define VLSEG_FLOAT __riscv_vlseg2e32_v_f32m4 +#define VLSSEG_FLOAT __riscv_vlsseg2e32_v_f32m4 +#define VFREDSUM_FLOAT __riscv_vfredusum_vs_f32m4_f32m1 +#define VFMACCVV_FLOAT __riscv_vfmacc_vv_f32m4 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m4 +#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f32m1 +#define VFREDMAXVS_FLOAT __riscv_vfredmax_vs_f32m4_f32m1 +#define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f32m1_f32 +#define VFABSV_FLOAT __riscv_vfabs_v_f32m4 #else -#define VSETVL(n) vsetvl_e64m4(n) -#define VSETVL_MAX vsetvlmax_e64m4() -#define VSETVL_MAX_M1 vsetvlmax_e64m1() -#define FLOAT_V_T vfloat64m4_t -#define FLOAT_V_T_M1 vfloat64m1_t -#define VLSEG_FLOAT vlseg2e64_v_f64m4 -#define VLSSEG_FLOAT vlsseg2e64_v_f64m4 -#define VFREDSUM_FLOAT vfredusum_vs_f64m4_f64m1 -#define VFMACCVV_FLOAT vfmacc_vv_f64m4 -#define VFMVVF_FLOAT vfmv_v_f_f64m4 -#define VFMVVF_FLOAT_M1 vfmv_v_f_f64m1 -#define VFREDMAXVS_FLOAT vfredmax_vs_f64m4_f64m1 -#define VFMVFS_FLOAT_M1 vfmv_f_s_f64m1_f64 -#define VFABSV_FLOAT vfabs_v_f64m4 +#define VSETVL(n) __riscv_vsetvl_e64m4(n) +#define VSETVL_MAX __riscv_vsetvlmax_e64m4() +#define VSETVL_MAX_M1 __riscv_vsetvlmax_e64m1() +#define FLOAT_V_T vfloat64m4_t +#define FLOAT_V_T_M1 vfloat64m1_t +#define VLSEG_FLOAT __riscv_vlseg2e64_v_f64m4 +#define VLSSEG_FLOAT __riscv_vlsseg2e64_v_f64m4 +#define VFREDSUM_FLOAT __riscv_vfredusum_vs_f64m4_f64m1 +#define VFMACCVV_FLOAT __riscv_vfmacc_vv_f64m4 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m4 +#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f64m1 +#define VFREDMAXVS_FLOAT __riscv_vfredmax_vs_f64m4_f64m1 +#define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f64m1_f64 +#define VFABSV_FLOAT __riscv_vfabs_v_f64m4 #endif // TODO: Should single precision use the widening MAC, or perhaps all should be double? @@ -85,10 +85,10 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) v0 = VFABSV_FLOAT(v0, vl); v1 = VFABSV_FLOAT(v1, vl); - v_max = VFREDMAXVS_FLOAT(v_max, v0, v_max, vl); + v_max = VFREDMAXVS_FLOAT(v0, v_max, vl); vr = VFMACCVV_FLOAT(vr, v0, v0, vl); - v_max = VFREDMAXVS_FLOAT(v_max, v1, v_max, vl); + v_max = VFREDMAXVS_FLOAT(v1, v_max, vl); vr = VFMACCVV_FLOAT(vr, v1, v1, vl); } @@ -103,16 +103,16 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) v0 = VFABSV_FLOAT(v0, vl); v1 = VFABSV_FLOAT(v1, vl); - v_max = VFREDMAXVS_FLOAT(v_max, v0, v_max, vl); + v_max = VFREDMAXVS_FLOAT(v0, v_max, vl); vr = VFMACCVV_FLOAT(vr, v0, v0, vl); - v_max = VFREDMAXVS_FLOAT(v_max, v1, v_max, vl); + v_max = VFREDMAXVS_FLOAT(v1, v_max, vl); vr = VFMACCVV_FLOAT(vr, v1, v1, vl); } } - v_res = VFREDSUM_FLOAT(v_res, vr, v_res, vlmax); + v_res = VFREDSUM_FLOAT(vr, v_res, vlmax); ssq = VFMVFS_FLOAT_M1(v_res); scale = VFMVFS_FLOAT_M1(v_max); diff --git a/kernel/riscv64/zrot_rvv.c b/kernel/riscv64/zrot_rvv.c index 68066a00b..ee81bfe91 100644 --- a/kernel/riscv64/zrot_rvv.c +++ b/kernel/riscv64/zrot_rvv.c @@ -28,33 +28,33 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include "common.h" #if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m4(n) -#define FLOAT_V_T vfloat32m4_t -#define VLEV_FLOAT vle32_v_f32m4 -#define VLSEV_FLOAT vlse32_v_f32m4 -#define VSEV_FLOAT vse32_v_f32m4 -#define VSSEV_FLOAT vsse32_v_f32m4 -#define VLSEG_FLOAT vlseg2e32_v_f32m4 -#define VSSEG_FLOAT vsseg2e32_v_f32m4 -#define VLSSEG_FLOAT vlsseg2e32_v_f32m4 -#define VSSSEG_FLOAT vssseg2e32_v_f32m4 -#define VFMACCVF_FLOAT vfmacc_vf_f32m4 -#define VFMULVF_FLOAT vfmul_vf_f32m4 -#define VFNMSACVF_FLOAT vfnmsac_vf_f32m4 +#define VSETVL(n) __riscv_vsetvl_e32m4(n) +#define FLOAT_V_T vfloat32m4_t +#define VLEV_FLOAT __riscv_vle32_v_f32m4 +#define VLSEV_FLOAT __riscv_vlse32_v_f32m4 +#define VSEV_FLOAT __riscv_vse32_v_f32m4 +#define VSSEV_FLOAT __riscv_vsse32_v_f32m4 +#define VLSEG_FLOAT __riscv_vlseg2e32_v_f32m4 +#define VSSEG_FLOAT __riscv_vsseg2e32_v_f32m4 +#define VLSSEG_FLOAT __riscv_vlsseg2e32_v_f32m4 +#define VSSSEG_FLOAT __riscv_vssseg2e32_v_f32m4 +#define VFMACCVF_FLOAT __riscv_vfmacc_vf_f32m4 +#define VFMULVF_FLOAT __riscv_vfmul_vf_f32m4 +#define VFNMSACVF_FLOAT __riscv_vfnmsac_vf_f32m4 #else -#define VSETVL(n) vsetvl_e64m4(n) -#define FLOAT_V_T vfloat64m4_t -#define VLEV_FLOAT vle64_v_f64m4 -#define VLSEV_FLOAT vlse64_v_f64m4 -#define VSEV_FLOAT vse64_v_f64m4 -#define VSSEV_FLOAT vsse64_v_f64m4 -#define VLSEG_FLOAT vlseg2e64_v_f64m4 -#define VSSEG_FLOAT vsseg2e64_v_f64m4 -#define VLSSEG_FLOAT vlsseg2e64_v_f64m4 -#define VSSSEG_FLOAT vssseg2e64_v_f64m4 -#define VFMACCVF_FLOAT vfmacc_vf_f64m4 -#define VFMULVF_FLOAT vfmul_vf_f64m4 -#define VFNMSACVF_FLOAT vfnmsac_vf_f64m4 +#define VSETVL(n) __riscv_vsetvl_e64m4(n) +#define FLOAT_V_T vfloat64m4_t +#define VLEV_FLOAT __riscv_vle64_v_f64m4 +#define VLSEV_FLOAT __riscv_vlse64_v_f64m4 +#define VSEV_FLOAT __riscv_vse64_v_f64m4 +#define VSSEV_FLOAT __riscv_vsse64_v_f64m4 +#define VLSEG_FLOAT __riscv_vlseg2e64_v_f64m4 +#define VSSEG_FLOAT __riscv_vsseg2e64_v_f64m4 +#define VLSSEG_FLOAT __riscv_vlsseg2e64_v_f64m4 +#define VSSSEG_FLOAT __riscv_vssseg2e64_v_f64m4 +#define VFMACCVF_FLOAT __riscv_vfmacc_vf_f64m4 +#define VFMULVF_FLOAT __riscv_vfmul_vf_f64m4 +#define VFNMSACVF_FLOAT __riscv_vfnmsac_vf_f64m4 #endif int CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y, FLOAT c, FLOAT s) diff --git a/kernel/riscv64/zscal_rvv.c b/kernel/riscv64/zscal_rvv.c index 079c36a2d..779fab68c 100644 --- a/kernel/riscv64/zscal_rvv.c +++ b/kernel/riscv64/zscal_rvv.c @@ -28,29 +28,29 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include "common.h" #if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m4(n) -#define VSETVL_MAX vsetvlmax_e32m4() -#define FLOAT_V_T vfloat32m4_t -#define VLSEG_FLOAT vlseg2e32_v_f32m4 -#define VLSSEG_FLOAT vlsseg2e32_v_f32m4 -#define VSSEG_FLOAT vsseg2e32_v_f32m4 -#define VSSSEG_FLOAT vssseg2e32_v_f32m4 -#define VFMACCVF_FLOAT vfmacc_vf_f32m4 -#define VFMULVF_FLOAT vfmul_vf_f32m4 -#define VFNMSACVF_FLOAT vfnmsac_vf_f32m4 -#define VFMVVF_FLOAT vfmv_v_f_f32m4 +#define VSETVL(n) __riscv_vsetvl_e32m4(n) +#define VSETVL_MAX __riscv_vsetvlmax_e32m4() +#define FLOAT_V_T vfloat32m4_t +#define VLSEG_FLOAT __riscv_vlseg2e32_v_f32m4 +#define VLSSEG_FLOAT __riscv_vlsseg2e32_v_f32m4 +#define VSSEG_FLOAT __riscv_vsseg2e32_v_f32m4 +#define VSSSEG_FLOAT __riscv_vssseg2e32_v_f32m4 +#define VFMACCVF_FLOAT __riscv_vfmacc_vf_f32m4 +#define VFMULVF_FLOAT __riscv_vfmul_vf_f32m4 +#define VFNMSACVF_FLOAT __riscv_vfnmsac_vf_f32m4 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m4 #else -#define VSETVL(n) vsetvl_e64m4(n) -#define VSETVL_MAX vsetvlmax_e64m4() -#define FLOAT_V_T vfloat64m4_t -#define VLSEG_FLOAT vlseg2e64_v_f64m4 -#define VLSSEG_FLOAT vlsseg2e64_v_f64m4 -#define VSSEG_FLOAT vsseg2e64_v_f64m4 -#define VSSSEG_FLOAT vssseg2e64_v_f64m4 -#define VFMACCVF_FLOAT vfmacc_vf_f64m4 -#define VFMULVF_FLOAT vfmul_vf_f64m4 -#define VFNMSACVF_FLOAT vfnmsac_vf_f64m4 -#define VFMVVF_FLOAT vfmv_v_f_f64m4 +#define VSETVL(n) __riscv_vsetvl_e64m4(n) +#define VSETVL_MAX __riscv_vsetvlmax_e64m4() +#define FLOAT_V_T vfloat64m4_t +#define VLSEG_FLOAT __riscv_vlseg2e64_v_f64m4 +#define VLSSEG_FLOAT __riscv_vlsseg2e64_v_f64m4 +#define VSSEG_FLOAT __riscv_vsseg2e64_v_f64m4 +#define VSSSEG_FLOAT __riscv_vssseg2e64_v_f64m4 +#define VFMACCVF_FLOAT __riscv_vfmacc_vf_f64m4 +#define VFMULVF_FLOAT __riscv_vfmul_vf_f64m4 +#define VFNMSACVF_FLOAT __riscv_vfnmsac_vf_f64m4 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m4 #endif int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT da_r,FLOAT da_i, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y, FLOAT *dummy, BLASLONG dummy2) diff --git a/kernel/riscv64/zsum_rvv.c b/kernel/riscv64/zsum_rvv.c index 3928fbe27..44df112c6 100644 --- a/kernel/riscv64/zsum_rvv.c +++ b/kernel/riscv64/zsum_rvv.c @@ -28,29 +28,29 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include "common.h" #if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m4(n) -#define VSETVL_MAX vsetvlmax_e32m4() -#define FLOAT_V_T vfloat32m4_t -#define FLOAT_V_T_M1 vfloat32m1_t -#define VLSEG_FLOAT vlseg2e32_v_f32m4 -#define VLSSEG_FLOAT vlsseg2e32_v_f32m4 -#define VFREDSUMVS_FLOAT vfredusum_vs_f32m4_f32m1 -#define VFMVVF_FLOAT vfmv_v_f_f32m4 -#define VFMVVF_FLOAT_M1 vfmv_v_f_f32m1 -#define VFMVFS_FLOAT_M1 vfmv_f_s_f32m1_f32 -#define VFADDVV_FLOAT vfadd_vv_f32m4 +#define VSETVL(n) __riscv_vsetvl_e32m4(n) +#define VSETVL_MAX __riscv_vsetvlmax_e32m4() +#define FLOAT_V_T vfloat32m4_t +#define FLOAT_V_T_M1 vfloat32m1_t +#define VLSEG_FLOAT __riscv_vlseg2e32_v_f32m4 +#define VLSSEG_FLOAT __riscv_vlsseg2e32_v_f32m4 +#define VFREDSUMVS_FLOAT __riscv_vfredusum_vs_f32m4_f32m1 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m4 +#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f32m1 +#define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f32m1_f32 +#define VFADDVV_FLOAT __riscv_vfadd_vv_f32m4 #else -#define VSETVL(n) vsetvl_e64m4(n) -#define VSETVL_MAX vsetvlmax_e64m4() -#define FLOAT_V_T vfloat64m4_t -#define FLOAT_V_T_M1 vfloat64m1_t -#define VLSEG_FLOAT vlseg2e64_v_f64m4 -#define VLSSEG_FLOAT vlsseg2e64_v_f64m4 -#define VFREDSUMVS_FLOAT vfredusum_vs_f64m4_f64m1 -#define VFMVVF_FLOAT vfmv_v_f_f64m4 -#define VFMVVF_FLOAT_M1 vfmv_v_f_f64m1 -#define VFMVFS_FLOAT_M1 vfmv_f_s_f64m1_f64 -#define VFADDVV_FLOAT vfadd_vv_f64m4 +#define VSETVL(n) __riscv_vsetvl_e64m4(n) +#define VSETVL_MAX __riscv_vsetvlmax_e64m4() +#define FLOAT_V_T vfloat64m4_t +#define FLOAT_V_T_M1 vfloat64m1_t +#define VLSEG_FLOAT __riscv_vlseg2e64_v_f64m4 +#define VLSSEG_FLOAT __riscv_vlsseg2e64_v_f64m4 +#define VFREDSUMVS_FLOAT __riscv_vfredusum_vs_f64m4_f64m1 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m4 +#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f64m1 +#define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f64m1_f64 +#define VFADDVV_FLOAT __riscv_vfadd_vv_f64m4 #endif FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) @@ -88,9 +88,8 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) } - FLOAT_V_T_M1 v_z0 = VFMVVF_FLOAT_M1(0, vlmax); FLOAT_V_T_M1 v_res = VFMVVF_FLOAT_M1(0, vlmax); - v_res = VFREDSUMVS_FLOAT(v_res, v_sum, v_z0, vlmax); + v_res = VFREDSUMVS_FLOAT(v_sum, v_res, vlmax); sumf += VFMVFS_FLOAT_M1(v_res); return(sumf); diff --git a/kernel/riscv64/zswap_rvv.c b/kernel/riscv64/zswap_rvv.c index 86f9103d3..17b7b9f43 100644 --- a/kernel/riscv64/zswap_rvv.c +++ b/kernel/riscv64/zswap_rvv.c @@ -28,19 +28,19 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include "common.h" #if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m4(n) -#define FLOAT_V_T vfloat32m4_t -#define VLSEG_FLOAT vlseg2e32_v_f32m4 -#define VLSSEG_FLOAT vlsseg2e32_v_f32m4 -#define VSSEG_FLOAT vsseg2e32_v_f32m4 -#define VSSSEG_FLOAT vssseg2e32_v_f32m4 +#define VSETVL(n) __riscv_vsetvl_e32m4(n) +#define FLOAT_V_T vfloat32m4_t +#define VLSEG_FLOAT __riscv_vlseg2e32_v_f32m4 +#define VLSSEG_FLOAT __riscv_vlsseg2e32_v_f32m4 +#define VSSEG_FLOAT __riscv_vsseg2e32_v_f32m4 +#define VSSSEG_FLOAT __riscv_vssseg2e32_v_f32m4 #else -#define VSETVL(n) vsetvl_e64m4(n) -#define FLOAT_V_T vfloat64m4_t -#define VLSEG_FLOAT vlseg2e64_v_f64m4 -#define VLSSEG_FLOAT vlsseg2e64_v_f64m4 -#define VSSEG_FLOAT vsseg2e64_v_f64m4 -#define VSSSEG_FLOAT vssseg2e64_v_f64m4 +#define VSETVL(n) __riscv_vsetvl_e64m4(n) +#define FLOAT_V_T vfloat64m4_t +#define VLSEG_FLOAT __riscv_vlseg2e64_v_f64m4 +#define VLSSEG_FLOAT __riscv_vlsseg2e64_v_f64m4 +#define VSSEG_FLOAT __riscv_vsseg2e64_v_f64m4 +#define VSSSEG_FLOAT __riscv_vssseg2e64_v_f64m4 #endif int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT dummy3, FLOAT dummy4, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y, FLOAT *dummy, BLASLONG dummy2) diff --git a/kernel/riscv64/zsymm_lcopy_rvv_v1.c b/kernel/riscv64/zsymm_lcopy_rvv_v1.c index df5c916a5..0f9e04869 100644 --- a/kernel/riscv64/zsymm_lcopy_rvv_v1.c +++ b/kernel/riscv64/zsymm_lcopy_rvv_v1.c @@ -28,37 +28,37 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include "common.h" #if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m2(n) -#define VSETVL_MAX vsetvlmax_e32m2() -#define FLOAT_V_T vfloat32m2_t -#define VLEV_FLOAT vle32_v_f32m2 -#define VSEV_FLOAT vse32_v_f32m2 -#define VLSEV_FLOAT vlse32_v_f32m2 -#define VLSEG2_FLOAT vlseg2e32_v_f32m2 -#define VLSSEG2_FLOAT vlsseg2e32_v_f32m2 -#define VSSEG2_FLOAT vsseg2e32_v_f32m2 -#define INT_V_T vint32m2_t -#define VID_V_INT vid_v_i32m2 -#define VADD_VX_INT vadd_vx_i32m2 -#define VMSGT_VX_INT vmsgt_vx_i32m2_b16 -#define VBOOL_T vbool16_t -#define VMERGE_VVM_FLOAT vmerge_vvm_f32m2 +#define VSETVL(n) __riscv_vsetvl_e32m2(n) +#define VSETVL_MAX __riscv_vsetvlmax_e32m2() +#define FLOAT_V_T vfloat32m2_t +#define VLEV_FLOAT __riscv_vle32_v_f32m2 +#define VSEV_FLOAT __riscv_vse32_v_f32m2 +#define VLSEV_FLOAT __riscv_vlse32_v_f32m2 +#define VLSEG2_FLOAT __riscv_vlseg2e32_v_f32m2 +#define VLSSEG2_FLOAT __riscv_vlsseg2e32_v_f32m2 +#define VSSEG2_FLOAT __riscv_vsseg2e32_v_f32m2 +#define INT_V_T vint32m2_t +#define VID_V_INT __riscv_vid_v_i32m2 +#define VADD_VX_INT __riscv_vadd_vx_i32m2 +#define VMSGT_VX_INT __riscv_vmsgt_vx_i32m2_b16 +#define VBOOL_T vbool16_t +#define VMERGE_VVM_FLOAT __riscv_vmerge_vvm_f32m2 #else -#define VSETVL(n) vsetvl_e64m2(n) -#define VSETVL_MAX vsetvlmax_e64m2() -#define FLOAT_V_T vfloat64m2_t -#define VLEV_FLOAT vle64_v_f64m2 -#define VSEV_FLOAT vse64_v_f64m2 -#define VLSEV_FLOAT vlse64_v_f64m2 -#define VLSEG2_FLOAT vlseg2e64_v_f64m2 -#define VLSSEG2_FLOAT vlsseg2e64_v_f64m2 -#define VSSEG2_FLOAT vsseg2e64_v_f64m2 -#define INT_V_T vint64m2_t -#define VID_V_INT vid_v_i64m2 -#define VADD_VX_INT vadd_vx_i64m2 -#define VMSGT_VX_INT vmsgt_vx_i64m2_b32 -#define VBOOL_T vbool32_t -#define VMERGE_VVM_FLOAT vmerge_vvm_f64m2 +#define VSETVL(n) __riscv_vsetvl_e64m2(n) +#define VSETVL_MAX __riscv_vsetvlmax_e64m2() +#define FLOAT_V_T vfloat64m2_t +#define VLEV_FLOAT __riscv_vle64_v_f64m2 +#define VSEV_FLOAT __riscv_vse64_v_f64m2 +#define VLSEV_FLOAT __riscv_vlse64_v_f64m2 +#define VLSEG2_FLOAT __riscv_vlseg2e64_v_f64m2 +#define VLSSEG2_FLOAT __riscv_vlsseg2e64_v_f64m2 +#define VSSEG2_FLOAT __riscv_vsseg2e64_v_f64m2 +#define INT_V_T vint64m2_t +#define VID_V_INT __riscv_vid_v_i64m2 +#define VADD_VX_INT __riscv_vadd_vx_i64m2 +#define VMSGT_VX_INT __riscv_vmsgt_vx_i64m2_b32 +#define VBOOL_T vbool32_t +#define VMERGE_VVM_FLOAT __riscv_vmerge_vvm_f64m2 #endif int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG posX, BLASLONG posY, FLOAT *b) @@ -91,8 +91,8 @@ int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG posX, BLASLON vindex = VADD_VX_INT(vindex_max, offset, vl); vbool = VMSGT_VX_INT(vindex, 0, vl); - vb0 = VMERGE_VVM_FLOAT(vbool, va20, va10, vl); - vb1 = VMERGE_VVM_FLOAT(vbool, va21, va11, vl); + vb0 = VMERGE_VVM_FLOAT(va20, va10, vbool, vl); + vb1 = VMERGE_VVM_FLOAT(va21, va11, vbool, vl); VSSEG2_FLOAT(b, vb0, vb1, vl); b += vl * 2; diff --git a/kernel/riscv64/zsymm_ucopy_rvv_v1.c b/kernel/riscv64/zsymm_ucopy_rvv_v1.c index dcf2b081a..fdc693700 100644 --- a/kernel/riscv64/zsymm_ucopy_rvv_v1.c +++ b/kernel/riscv64/zsymm_ucopy_rvv_v1.c @@ -28,37 +28,37 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include "common.h" #if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m2(n) -#define VSETVL_MAX vsetvlmax_e32m2() -#define FLOAT_V_T vfloat32m2_t -#define VLEV_FLOAT vle32_v_f32m2 -#define VSEV_FLOAT vse32_v_f32m2 -#define VLSEV_FLOAT vlse32_v_f32m2 -#define VLSEG2_FLOAT vlseg2e32_v_f32m2 -#define VLSSEG2_FLOAT vlsseg2e32_v_f32m2 -#define VSSEG2_FLOAT vsseg2e32_v_f32m2 -#define INT_V_T vint32m2_t -#define VID_V_INT vid_v_i32m2 -#define VADD_VX_INT vadd_vx_i32m2 -#define VMSGT_VX_INT vmsgt_vx_i32m2_b16 -#define VBOOL_T vbool16_t -#define VMERGE_VVM_FLOAT vmerge_vvm_f32m2 +#define VSETVL(n) __riscv_vsetvl_e32m2(n) +#define VSETVL_MAX __riscv_vsetvlmax_e32m2() +#define FLOAT_V_T vfloat32m2_t +#define VLEV_FLOAT __riscv_vle32_v_f32m2 +#define VSEV_FLOAT __riscv_vse32_v_f32m2 +#define VLSEV_FLOAT __riscv_vlse32_v_f32m2 +#define VLSEG2_FLOAT __riscv_vlseg2e32_v_f32m2 +#define VLSSEG2_FLOAT __riscv_vlsseg2e32_v_f32m2 +#define VSSEG2_FLOAT __riscv_vsseg2e32_v_f32m2 +#define INT_V_T vint32m2_t +#define VID_V_INT __riscv_vid_v_i32m2 +#define VADD_VX_INT __riscv_vadd_vx_i32m2 +#define VMSGT_VX_INT __riscv_vmsgt_vx_i32m2_b16 +#define VBOOL_T vbool16_t +#define VMERGE_VVM_FLOAT __riscv_vmerge_vvm_f32m2 #else -#define VSETVL(n) vsetvl_e64m2(n) -#define VSETVL_MAX vsetvlmax_e64m2() -#define FLOAT_V_T vfloat64m2_t -#define VLEV_FLOAT vle64_v_f64m2 -#define VSEV_FLOAT vse64_v_f64m2 -#define VLSEV_FLOAT vlse64_v_f64m2 -#define VLSEG2_FLOAT vlseg2e64_v_f64m2 -#define VLSSEG2_FLOAT vlsseg2e64_v_f64m2 -#define VSSEG2_FLOAT vsseg2e64_v_f64m2 -#define INT_V_T vint64m2_t -#define VID_V_INT vid_v_i64m2 -#define VADD_VX_INT vadd_vx_i64m2 -#define VMSGT_VX_INT vmsgt_vx_i64m2_b32 -#define VBOOL_T vbool32_t -#define VMERGE_VVM_FLOAT vmerge_vvm_f64m2 +#define VSETVL(n) __riscv_vsetvl_e64m2(n) +#define VSETVL_MAX __riscv_vsetvlmax_e64m2() +#define FLOAT_V_T vfloat64m2_t +#define VLEV_FLOAT __riscv_vle64_v_f64m2 +#define VSEV_FLOAT __riscv_vse64_v_f64m2 +#define VLSEV_FLOAT __riscv_vlse64_v_f64m2 +#define VLSEG2_FLOAT __riscv_vlseg2e64_v_f64m2 +#define VLSSEG2_FLOAT __riscv_vlsseg2e64_v_f64m2 +#define VSSEG2_FLOAT __riscv_vsseg2e64_v_f64m2 +#define INT_V_T vint64m2_t +#define VID_V_INT __riscv_vid_v_i64m2 +#define VADD_VX_INT __riscv_vadd_vx_i64m2 +#define VMSGT_VX_INT __riscv_vmsgt_vx_i64m2_b32 +#define VBOOL_T vbool32_t +#define VMERGE_VVM_FLOAT __riscv_vmerge_vvm_f64m2 #endif @@ -92,8 +92,8 @@ int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG posX, BLASLON vindex = VADD_VX_INT(vindex_max, offset, vl); vbool = VMSGT_VX_INT(vindex, 0, vl); - vb0 = VMERGE_VVM_FLOAT(vbool, va20, va10, vl); - vb1 = VMERGE_VVM_FLOAT(vbool, va21, va11, vl); + vb0 = VMERGE_VVM_FLOAT(va20, va10, vbool, vl); + vb1 = VMERGE_VVM_FLOAT(va21, va11, vbool, vl); VSSEG2_FLOAT(b, vb0, vb1, vl); b += vl * 2; diff --git a/kernel/riscv64/ztrmm_lncopy_rvv_v1.c b/kernel/riscv64/ztrmm_lncopy_rvv_v1.c index afd694408..7276618c5 100644 --- a/kernel/riscv64/ztrmm_lncopy_rvv_v1.c +++ b/kernel/riscv64/ztrmm_lncopy_rvv_v1.c @@ -30,35 +30,35 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include "common.h" #if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m2(n) -#define FLOAT_V_T vfloat32m2_t -#define VLEV_FLOAT vle32_v_f32m2 -#define VSEV_FLOAT vse32_v_f32m2 -#define VLSEV_FLOAT vlse32_v_f32m2 -#define VLSEG2_FLOAT vlseg2e32_v_f32m2 -#define VLSSEG2_FLOAT vlsseg2e32_v_f32m2 -#define VSSEG2_FLOAT vsseg2e32_v_f32m2 -#define VBOOL_T vbool16_t -#define UINT_V_T vint32m2_t -#define VID_V_UINT vid_v_i32m2 -#define VMSGTU_VX_UINT vmsgt_vx_i32m2_b16 -#define VMSEQ_VX_UINT vmseq_vx_i32m2_b16 -#define VFMERGE_VFM_FLOAT vfmerge_vfm_f32m2 +#define VSETVL(n) __riscv_vsetvl_e32m2(n) +#define FLOAT_V_T vfloat32m2_t +#define VLEV_FLOAT __riscv_vle32_v_f32m2 +#define VSEV_FLOAT __riscv_vse32_v_f32m2 +#define VLSEV_FLOAT __riscv_vlse32_v_f32m2 +#define VLSEG2_FLOAT __riscv_vlseg2e32_v_f32m2 +#define VLSSEG2_FLOAT __riscv_vlsseg2e32_v_f32m2 +#define VSSEG2_FLOAT __riscv_vsseg2e32_v_f32m2 +#define VBOOL_T vbool16_t +#define UINT_V_T vint32m2_t +#define VID_V_UINT __riscv_vid_v_i32m2 +#define VMSGTU_VX_UINT __riscv_vmsgt_vx_i32m2_b16 +#define VMSEQ_VX_UINT __riscv_vmseq_vx_i32m2_b16 +#define VFMERGE_VFM_FLOAT __riscv_vfmerge_vfm_f32m2 #else -#define VSETVL(n) vsetvl_e64m2(n) -#define FLOAT_V_T vfloat64m2_t -#define VLEV_FLOAT vle64_v_f64m2 -#define VSEV_FLOAT vse64_v_f64m2 -#define VLSEV_FLOAT vlse64_v_f64m2 -#define VLSEG2_FLOAT vlseg2e64_v_f64m2 -#define VLSSEG2_FLOAT vlsseg2e64_v_f64m2 -#define VSSEG2_FLOAT vsseg2e64_v_f64m2 -#define VBOOL_T vbool32_t -#define UINT_V_T vuint64m2_t -#define VID_V_UINT vid_v_u64m2 -#define VMSGTU_VX_UINT vmsgtu_vx_u64m2_b32 -#define VMSEQ_VX_UINT vmseq_vx_u64m2_b32 -#define VFMERGE_VFM_FLOAT vfmerge_vfm_f64m2 +#define VSETVL(n) __riscv_vsetvl_e64m2(n) +#define FLOAT_V_T vfloat64m2_t +#define VLEV_FLOAT __riscv_vle64_v_f64m2 +#define VSEV_FLOAT __riscv_vse64_v_f64m2 +#define VLSEV_FLOAT __riscv_vlse64_v_f64m2 +#define VLSEG2_FLOAT __riscv_vlseg2e64_v_f64m2 +#define VLSSEG2_FLOAT __riscv_vlsseg2e64_v_f64m2 +#define VSSEG2_FLOAT __riscv_vsseg2e64_v_f64m2 +#define VBOOL_T vbool32_t +#define UINT_V_T vuint64m2_t +#define VID_V_UINT __riscv_vid_v_u64m2 +#define VMSGTU_VX_UINT __riscv_vmsgtu_vx_u64m2_b32 +#define VMSEQ_VX_UINT __riscv_vmseq_vx_u64m2_b32 +#define VFMERGE_VFM_FLOAT __riscv_vfmerge_vfm_f64m2 #endif int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG posX, BLASLONG posY, FLOAT *b){ @@ -121,12 +121,12 @@ int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG posX, BLASLON { VLSSEG2_FLOAT(&va0, &va1, ao, stride_lda, vl); vbool_cmp = VMSGTU_VX_UINT(vindex, j, vl); - va0 = VFMERGE_VFM_FLOAT(vbool_cmp, va0, ZERO, vl); - va1 = VFMERGE_VFM_FLOAT(vbool_cmp, va1, ZERO, vl); + va0 = VFMERGE_VFM_FLOAT(va0, ZERO, vbool_cmp, vl); + va1 = VFMERGE_VFM_FLOAT(va1, ZERO, vbool_cmp, vl); #ifdef UNIT vbool_eq = VMSEQ_VX_UINT(vindex, j, vl); - va0 = VFMERGE_VFM_FLOAT(vbool_eq, va0, ONE, vl); - va1 = VFMERGE_VFM_FLOAT(vbool_eq, va1, ZERO, vl); + va0 = VFMERGE_VFM_FLOAT(va0, ONE, vbool_eq, vl); + va1 = VFMERGE_VFM_FLOAT(va1, ZERO, vbool_eq, vl); #endif VSSEG2_FLOAT(b, va0, va1, vl); ao += 2; diff --git a/kernel/riscv64/ztrmm_ltcopy_rvv_v1.c b/kernel/riscv64/ztrmm_ltcopy_rvv_v1.c index c7d593949..72e8f2ce2 100644 --- a/kernel/riscv64/ztrmm_ltcopy_rvv_v1.c +++ b/kernel/riscv64/ztrmm_ltcopy_rvv_v1.c @@ -30,33 +30,33 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include "common.h" #if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m2(n) -#define FLOAT_V_T vfloat32m2_t -#define VLEV_FLOAT vle32_v_f32m2 -#define VSEV_FLOAT vse32_v_f32m2 -#define VLSEG2_FLOAT vlseg2e32_v_f32m2 -#define VLSSEG2_FLOAT vlsseg2e32_v_f32m2 -#define VSSEG2_FLOAT vsseg2e32_v_f32m2 -#define VBOOL_T vbool16_t -#define UINT_V_T vuint32m2_t -#define VID_V_UINT vid_v_u32m2 -#define VMSLTU_VX_UINT vmsltu_vx_u32m2_b16 -#define VMSEQ_VX_UINT vmseq_vx_u32m2_b16 -#define VFMERGE_VFM_FLOAT vfmerge_vfm_f32m2 +#define VSETVL(n) __riscv_vsetvl_e32m2(n) +#define FLOAT_V_T vfloat32m2_t +#define VLEV_FLOAT __riscv_vle32_v_f32m2 +#define VSEV_FLOAT __riscv_vse32_v_f32m2 +#define VLSEG2_FLOAT __riscv_vlseg2e32_v_f32m2 +#define VLSSEG2_FLOAT __riscv_vlsseg2e32_v_f32m2 +#define VSSEG2_FLOAT __riscv_vsseg2e32_v_f32m2 +#define VBOOL_T vbool16_t +#define UINT_V_T vuint32m2_t +#define VID_V_UINT __riscv_vid_v_u32m2 +#define VMSLTU_VX_UINT __riscv_vmsltu_vx_u32m2_b16 +#define VMSEQ_VX_UINT __riscv_vmseq_vx_u32m2_b16 +#define VFMERGE_VFM_FLOAT __riscv_vfmerge_vfm_f32m2 #else -#define VSETVL(n) vsetvl_e64m2(n) -#define FLOAT_V_T vfloat64m2_t -#define VLEV_FLOAT vle64_v_f64m2 -#define VSEV_FLOAT vse64_v_f64m2 -#define VLSEG2_FLOAT vlseg2e64_v_f64m2 -#define VLSSEG2_FLOAT vlsseg2e64_v_f64m2 -#define VSSEG2_FLOAT vsseg2e64_v_f64m2 -#define VBOOL_T vbool32_t -#define UINT_V_T vuint64m2_t -#define VID_V_UINT vid_v_u64m2 -#define VMSLTU_VX_UINT vmsltu_vx_u64m2_b32 -#define VMSEQ_VX_UINT vmseq_vx_u64m2_b32 -#define VFMERGE_VFM_FLOAT vfmerge_vfm_f64m2 +#define VSETVL(n) __riscv_vsetvl_e64m2(n) +#define FLOAT_V_T vfloat64m2_t +#define VLEV_FLOAT __riscv_vle64_v_f64m2 +#define VSEV_FLOAT __riscv_vse64_v_f64m2 +#define VLSEG2_FLOAT __riscv_vlseg2e64_v_f64m2 +#define VLSSEG2_FLOAT __riscv_vlsseg2e64_v_f64m2 +#define VSSEG2_FLOAT __riscv_vsseg2e64_v_f64m2 +#define VBOOL_T vbool32_t +#define UINT_V_T vuint64m2_t +#define VID_V_UINT __riscv_vid_v_u64m2 +#define VMSLTU_VX_UINT __riscv_vmsltu_vx_u64m2_b32 +#define VMSEQ_VX_UINT __riscv_vmseq_vx_u64m2_b32 +#define VFMERGE_VFM_FLOAT __riscv_vfmerge_vfm_f64m2 #endif int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG posX, BLASLONG posY, FLOAT *b){ @@ -117,14 +117,13 @@ int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG posX, BLASLON //va1 = VLEV_FLOAT(ao, vl); VLSEG2_FLOAT(&va0, &va1, ao, vl); vbool_cmp = VMSLTU_VX_UINT(vindex, j, vl); - va0 = VFMERGE_VFM_FLOAT(vbool_cmp, va0, ZERO, vl); - va1 = VFMERGE_VFM_FLOAT(vbool_cmp, va1, ZERO, vl); + va0 = VFMERGE_VFM_FLOAT(va0, ZERO, vbool_cmp, vl); + va1 = VFMERGE_VFM_FLOAT(va1, ZERO, vbool_cmp, vl); #ifdef UNIT vbool_eq = VMSEQ_VX_UINT(vindex, j, vl); - va0 = VFMERGE_VFM_FLOAT(vbool_eq, va0, ONE, vl); - va1 = VFMERGE_VFM_FLOAT(vbool_eq, va1, ZERO, vl); + va0 = VFMERGE_VFM_FLOAT(va0, ONE, vbool_eq, vl); + va1 = VFMERGE_VFM_FLOAT(va1, ZERO, vbool_eq, vl); #endif - //VSEV_FLOAT(b, vb, vl); VSSEG2_FLOAT(b, va0, va1, vl); ao += lda * 2; b += vl * 2; diff --git a/kernel/riscv64/ztrmm_uncopy_rvv_v1.c b/kernel/riscv64/ztrmm_uncopy_rvv_v1.c index 3c70b6385..e6d36c86d 100644 --- a/kernel/riscv64/ztrmm_uncopy_rvv_v1.c +++ b/kernel/riscv64/ztrmm_uncopy_rvv_v1.c @@ -30,35 +30,35 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include "common.h" #if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m2(n) -#define FLOAT_V_T vfloat32m2_t -#define VLEV_FLOAT vle32_v_f32m2 -#define VLSEV_FLOAT vlse32_v_f32m2 -#define VSEV_FLOAT vse32_v_f32m2 -#define VLSEG2_FLOAT vlseg2e32_v_f32m2 -#define VLSSEG2_FLOAT vlsseg2e32_v_f32m2 -#define VSSEG2_FLOAT vsseg2e32_v_f32m2 -#define VBOOL_T vbool16_t -#define UINT_V_T vuint32m2_t -#define VID_V_UINT vid_v_u32m2 -#define VMSLTU_VX_UINT vmsltu_vx_u32m2_b16 -#define VMSEQ_VX_UINT vmseq_vx_u32m2_b16 -#define VFMERGE_VFM_FLOAT vfmerge_vfm_f32m2 +#define VSETVL(n) __riscv_vsetvl_e32m2(n) +#define FLOAT_V_T vfloat32m2_t +#define VLEV_FLOAT __riscv_vle32_v_f32m2 +#define VLSEV_FLOAT __riscv_vlse32_v_f32m2 +#define VSEV_FLOAT __riscv_vse32_v_f32m2 +#define VLSEG2_FLOAT __riscv_vlseg2e32_v_f32m2 +#define VLSSEG2_FLOAT __riscv_vlsseg2e32_v_f32m2 +#define VSSEG2_FLOAT __riscv_vsseg2e32_v_f32m2 +#define VBOOL_T vbool16_t +#define UINT_V_T vuint32m2_t +#define VID_V_UINT __riscv_vid_v_u32m2 +#define VMSLTU_VX_UINT __riscv_vmsltu_vx_u32m2_b16 +#define VMSEQ_VX_UINT __riscv_vmseq_vx_u32m2_b16 +#define VFMERGE_VFM_FLOAT __riscv_vfmerge_vfm_f32m2 #else -#define VSETVL(n) vsetvl_e64m2(n) -#define FLOAT_V_T vfloat64m2_t -#define VLEV_FLOAT vle64_v_f64m2 -#define VLSEV_FLOAT vlse64_v_f64m2 -#define VSEV_FLOAT vse64_v_f64m2 -#define VLSEG2_FLOAT vlseg2e64_v_f64m2 -#define VLSSEG2_FLOAT vlsseg2e64_v_f64m2 -#define VSSEG2_FLOAT vsseg2e64_v_f64m2 -#define VBOOL_T vbool32_t -#define UINT_V_T vuint64m2_t -#define VID_V_UINT vid_v_u64m2 -#define VMSLTU_VX_UINT vmsltu_vx_u64m2_b32 -#define VMSEQ_VX_UINT vmseq_vx_u64m2_b32 -#define VFMERGE_VFM_FLOAT vfmerge_vfm_f64m2 +#define VSETVL(n) __riscv_vsetvl_e64m2(n) +#define FLOAT_V_T vfloat64m2_t +#define VLEV_FLOAT __riscv_vle64_v_f64m2 +#define VLSEV_FLOAT __riscv_vlse64_v_f64m2 +#define VSEV_FLOAT __riscv_vse64_v_f64m2 +#define VLSEG2_FLOAT __riscv_vlseg2e64_v_f64m2 +#define VLSSEG2_FLOAT __riscv_vlsseg2e64_v_f64m2 +#define VSSEG2_FLOAT __riscv_vsseg2e64_v_f64m2 +#define VBOOL_T vbool32_t +#define UINT_V_T vuint64m2_t +#define VID_V_UINT __riscv_vid_v_u64m2 +#define VMSLTU_VX_UINT __riscv_vmsltu_vx_u64m2_b32 +#define VMSEQ_VX_UINT __riscv_vmseq_vx_u64m2_b32 +#define VFMERGE_VFM_FLOAT __riscv_vfmerge_vfm_f64m2 #endif int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG posX, BLASLONG posY, FLOAT *b){ @@ -120,12 +120,12 @@ int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG posX, BLASLON { VLSSEG2_FLOAT(&va0, &va1, ao, stride_lda, vl); vbool_cmp = VMSLTU_VX_UINT(vindex, j, vl); - va0 = VFMERGE_VFM_FLOAT(vbool_cmp, va0, ZERO, vl); - va1 = VFMERGE_VFM_FLOAT(vbool_cmp, va1, ZERO, vl); + va0 = VFMERGE_VFM_FLOAT(va0, ZERO, vbool_cmp, vl); + va1 = VFMERGE_VFM_FLOAT(va1, ZERO, vbool_cmp, vl); #ifdef UNIT vbool_eq = VMSEQ_VX_UINT(vindex, j, vl); - va0 = VFMERGE_VFM_FLOAT(vbool_eq, va0, ONE, vl); - va1 = VFMERGE_VFM_FLOAT(vbool_eq, va1, ZERO, vl); + va0 = VFMERGE_VFM_FLOAT(va0, ONE, vbool_eq, vl); + va1 = VFMERGE_VFM_FLOAT(va1, ZERO, vbool_eq, vl); #endif VSSEG2_FLOAT(b, va0, va1, vl); ao += 2; diff --git a/kernel/riscv64/ztrmm_utcopy_rvv_v1.c b/kernel/riscv64/ztrmm_utcopy_rvv_v1.c index 706782cf0..7085cfc37 100644 --- a/kernel/riscv64/ztrmm_utcopy_rvv_v1.c +++ b/kernel/riscv64/ztrmm_utcopy_rvv_v1.c @@ -32,33 +32,33 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include "common.h" #if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m2(n) -#define FLOAT_V_T vfloat32m2_t -#define VLEV_FLOAT vle32_v_f32m2 -#define VSEV_FLOAT vse32_v_f32m2 -#define VLSEG2_FLOAT vlseg2e32_v_f32m2 -#define VLSSEG2_FLOAT vlsseg2e32_v_f32m2 -#define VSSEG2_FLOAT vsseg2e32_v_f32m2 -#define VBOOL_T vbool16_t -#define UINT_V_T vuint32m2_t -#define VID_V_UINT vid_v_u32m2 -#define VMSGTU_VX_UINT vmsgtu_vx_u32m2_b16 -#define VMSEQ_VX_UINT vmseq_vx_u32m2_b16 -#define VFMERGE_VFM_FLOAT vfmerge_vfm_f32m2 +#define VSETVL(n) __riscv_vsetvl_e32m2(n) +#define FLOAT_V_T vfloat32m2_t +#define VLEV_FLOAT __riscv_vle32_v_f32m2 +#define VSEV_FLOAT __riscv_vse32_v_f32m2 +#define VLSEG2_FLOAT __riscv_vlseg2e32_v_f32m2 +#define VLSSEG2_FLOAT __riscv_vlsseg2e32_v_f32m2 +#define VSSEG2_FLOAT __riscv_vsseg2e32_v_f32m2 +#define VBOOL_T vbool16_t +#define UINT_V_T vuint32m2_t +#define VID_V_UINT __riscv_vid_v_u32m2 +#define VMSGTU_VX_UINT __riscv_vmsgtu_vx_u32m2_b16 +#define VMSEQ_VX_UINT __riscv_vmseq_vx_u32m2_b16 +#define VFMERGE_VFM_FLOAT __riscv_vfmerge_vfm_f32m2 #else -#define VSETVL(n) vsetvl_e64m2(n) -#define FLOAT_V_T vfloat64m2_t -#define VLEV_FLOAT vle64_v_f64m2 -#define VSEV_FLOAT vse64_v_f64m2 -#define VLSEG2_FLOAT vlseg2e64_v_f64m2 -#define VLSSEG2_FLOAT vlsseg2e64_v_f64m2 -#define VSSEG2_FLOAT vsseg2e64_v_f64m2 -#define VBOOL_T vbool32_t -#define UINT_V_T vuint64m2_t -#define VID_V_UINT vid_v_u64m2 -#define VMSGTU_VX_UINT vmsgtu_vx_u64m2_b32 -#define VMSEQ_VX_UINT vmseq_vx_u64m2_b32 -#define VFMERGE_VFM_FLOAT vfmerge_vfm_f64m2 +#define VSETVL(n) __riscv_vsetvl_e64m2(n) +#define FLOAT_V_T vfloat64m2_t +#define VLEV_FLOAT __riscv_vle64_v_f64m2 +#define VSEV_FLOAT __riscv_vse64_v_f64m2 +#define VLSEG2_FLOAT __riscv_vlseg2e64_v_f64m2 +#define VLSSEG2_FLOAT __riscv_vlsseg2e64_v_f64m2 +#define VSSEG2_FLOAT __riscv_vsseg2e64_v_f64m2 +#define VBOOL_T vbool32_t +#define UINT_V_T vuint64m2_t +#define VID_V_UINT __riscv_vid_v_u64m2 +#define VMSGTU_VX_UINT __riscv_vmsgtu_vx_u64m2_b32 +#define VMSEQ_VX_UINT __riscv_vmseq_vx_u64m2_b32 +#define VFMERGE_VFM_FLOAT __riscv_vfmerge_vfm_f64m2 #endif int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG posX, BLASLONG posY, FLOAT *b){ @@ -117,12 +117,12 @@ int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG posX, BLASLON { VLSEG2_FLOAT(&va0, &va1, ao, vl); vbool_cmp = VMSGTU_VX_UINT(vindex, j, vl); - va0 = VFMERGE_VFM_FLOAT(vbool_cmp, va0, ZERO, vl); - va1 = VFMERGE_VFM_FLOAT(vbool_cmp, va1, ZERO, vl); + va0 = VFMERGE_VFM_FLOAT(va0, ZERO, vbool_cmp, vl); + va1 = VFMERGE_VFM_FLOAT(va1, ZERO, vbool_cmp, vl); #ifdef UNIT vbool_eq = VMSEQ_VX_UINT(vindex, j, vl); - va0 = VFMERGE_VFM_FLOAT(vbool_eq, va0, ONE, vl); - va1 = VFMERGE_VFM_FLOAT(vbool_eq, va1, ZERO, vl); + va0 = VFMERGE_VFM_FLOAT(va0, ONE, vbool_eq, vl); + va1 = VFMERGE_VFM_FLOAT(va1, ZERO, vbool_eq, vl); #endif VSSEG2_FLOAT(b, va0, va1, vl); ao += lda * 2; diff --git a/kernel/riscv64/ztrmmkernel_2x2_rvv.c b/kernel/riscv64/ztrmmkernel_2x2_rvv.c index 3486a4648..399124d2e 100644 --- a/kernel/riscv64/ztrmmkernel_2x2_rvv.c +++ b/kernel/riscv64/ztrmmkernel_2x2_rvv.c @@ -28,37 +28,37 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include "common.h" #if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m2(n) -#define VSETVL_MAX vsetvlmax_e32m2() -#define VSETVL_MAX_M1 vsetvlmax_e32m1() -#define FLOAT_V_T vfloat32m2_t -#define FLOAT_V_T_M1 vfloat32m1_t -#define VLEV_FLOAT vle32_v_f32m2 -#define VLSEG4_FLOAT vlseg4e32_v_f32m2 -#define VLSEG2_FLOAT vlseg2e32_v_f32m2 -#define VFMVVF_FLOAT vfmv_v_f_f32m2 -#define VFMACCVF_FLOAT vfmacc_vf_f32m2 -#define VFMACCVV_FLOAT vfmacc_vv_f32m2 -#define VFNMSACVV_FLOAT vfnmsac_vv_f32m2 -#define VFREDSUMVS_FLOAT vfredusum_vs_f32m2_f32m1 -#define VFMVVF_FLOAT_M1 vfmv_v_f_f32m1 -#define VFMVFS_FLOAT_M1 vfmv_f_s_f32m1_f32 +#define VSETVL(n) __riscv_vsetvl_e32m2(n) +#define VSETVL_MAX __riscv_vsetvlmax_e32m2() +#define VSETVL_MAX_M1 __riscv_vsetvlmax_e32m1() +#define FLOAT_V_T vfloat32m2_t +#define FLOAT_V_T_M1 vfloat32m1_t +#define VLEV_FLOAT __riscv_vle32_v_f32m2 +#define VLSEG4_FLOAT __riscv_vlseg4e32_v_f32m2 +#define VLSEG2_FLOAT __riscv_vlseg2e32_v_f32m2 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m2 +#define VFMACCVF_FLOAT __riscv_vfmacc_vf_f32m2 +#define VFMACCVV_FLOAT __riscv_vfmacc_vv_f32m2 +#define VFNMSACVV_FLOAT __riscv_vfnmsac_vv_f32m2 +#define VFREDSUMVS_FLOAT __riscv_vfredusum_vs_f32m2_f32m1 +#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f32m1 +#define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f32m1_f32 #else -#define VSETVL(n) vsetvl_e64m2(n) -#define VSETVL_MAX vsetvlmax_e64m2() -#define VSETVL_MAX_M1 vsetvlmax_e64m1() -#define FLOAT_V_T vfloat64m2_t -#define FLOAT_V_T_M1 vfloat64m1_t -#define VLEV_FLOAT vle64_v_f64m2 -#define VLSEG4_FLOAT vlseg4e64_v_f64m2 -#define VLSEG2_FLOAT vlseg2e64_v_f64m2 -#define VFMVVF_FLOAT vfmv_v_f_f64m2 -#define VFMACCVF_FLOAT vfmacc_vf_f64m2 -#define VFMACCVV_FLOAT vfmacc_vv_f64m2 -#define VFNMSACVV_FLOAT vfnmsac_vv_f64m2 -#define VFREDSUMVS_FLOAT vfredusum_vs_f64m2_f64m1 -#define VFMVVF_FLOAT_M1 vfmv_v_f_f64m1 -#define VFMVFS_FLOAT_M1 vfmv_f_s_f64m1_f64 +#define VSETVL(n) __riscv_vsetvl_e64m2(n) +#define VSETVL_MAX __riscv_vsetvlmax_e64m2() +#define VSETVL_MAX_M1 __riscv_vsetvlmax_e64m1() +#define FLOAT_V_T vfloat64m2_t +#define FLOAT_V_T_M1 vfloat64m1_t +#define VLEV_FLOAT __riscv_vle64_v_f64m2 +#define VLSEG4_FLOAT __riscv_vlseg4e64_v_f64m2 +#define VLSEG2_FLOAT __riscv_vlseg2e64_v_f64m2 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m2 +#define VFMACCVF_FLOAT __riscv_vfmacc_vf_f64m2 +#define VFMACCVV_FLOAT __riscv_vfmacc_vv_f64m2 +#define VFNMSACVV_FLOAT __riscv_vfnmsac_vv_f64m2 +#define VFREDSUMVS_FLOAT __riscv_vfredusum_vs_f64m2_f64m1 +#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f64m1 +#define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f64m1_f64 #endif // Optimizes the implementation in ../generic/ztrmmkernel_2x2.c diff --git a/kernel/riscv64/ztrmmkernel_rvv_v1x4.c b/kernel/riscv64/ztrmmkernel_rvv_v1x4.c index 27409ec25..92b4b855b 100644 --- a/kernel/riscv64/ztrmmkernel_rvv_v1x4.c +++ b/kernel/riscv64/ztrmmkernel_rvv_v1x4.c @@ -28,27 +28,27 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include "common.h" #if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m2(n) -#define FLOAT_V_T vfloat32m2_t -#define VLEV_FLOAT vle32_v_f32m2 -#define VSEV_FLOAT vse32_v_f32m2 -#define VLSEG2_FLOAT vlseg2e32_v_f32m2 -#define VSSEG2_FLOAT vsseg2e32_v_f32m2 -#define VFMVVF_FLOAT vfmv_v_f_f32m2 -#define VFMACCVF_FLOAT vfmacc_vf_f32m2 -#define VFNMSACVF_FLOAT vfnmsac_vf_f32m2 -#define VFMULVF_FLOAT vfmul_vf_f32m2 +#define VSETVL(n) __riscv_vsetvl_e32m2(n) +#define FLOAT_V_T vfloat32m2_t +#define VLEV_FLOAT __riscv_vle32_v_f32m2 +#define VSEV_FLOAT __riscv_vse32_v_f32m2 +#define VLSEG2_FLOAT __riscv_vlseg2e32_v_f32m2 +#define VSSEG2_FLOAT __riscv_vsseg2e32_v_f32m2 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m2 +#define VFMACCVF_FLOAT __riscv_vfmacc_vf_f32m2 +#define VFNMSACVF_FLOAT __riscv_vfnmsac_vf_f32m2 +#define VFMULVF_FLOAT __riscv_vfmul_vf_f32m2 #else -#define VSETVL(n) vsetvl_e64m2(n) -#define FLOAT_V_T vfloat64m2_t -#define VLEV_FLOAT vle64_v_f64m2 -#define VSEV_FLOAT vse64_v_f64m2 -#define VLSEG2_FLOAT vlseg2e64_v_f64m2 -#define VSSEG2_FLOAT vsseg2e64_v_f64m2 -#define VFMVVF_FLOAT vfmv_v_f_f64m2 -#define VFMACCVF_FLOAT vfmacc_vf_f64m2 -#define VFNMSACVF_FLOAT vfnmsac_vf_f64m2 -#define VFMULVF_FLOAT vfmul_vf_f64m2 +#define VSETVL(n) __riscv_vsetvl_e64m2(n) +#define FLOAT_V_T vfloat64m2_t +#define VLEV_FLOAT __riscv_vle64_v_f64m2 +#define VSEV_FLOAT __riscv_vse64_v_f64m2 +#define VLSEG2_FLOAT __riscv_vlseg2e64_v_f64m2 +#define VSSEG2_FLOAT __riscv_vsseg2e64_v_f64m2 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m2 +#define VFMACCVF_FLOAT __riscv_vfmacc_vf_f64m2 +#define VFNMSACVF_FLOAT __riscv_vfnmsac_vf_f64m2 +#define VFMULVF_FLOAT __riscv_vfmul_vf_f64m2 #endif #if defined(NN) || defined(NT) || defined(TN) || defined(TT) diff --git a/kernel/riscv64/ztrsm_lncopy_rvv_v1.c b/kernel/riscv64/ztrsm_lncopy_rvv_v1.c index b7ccb1eb3..383cb883f 100644 --- a/kernel/riscv64/ztrsm_lncopy_rvv_v1.c +++ b/kernel/riscv64/ztrsm_lncopy_rvv_v1.c @@ -29,25 +29,25 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include "common.h" #if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m2(n) -#define FLOAT_V_T vfloat32m2_t -#define VLSSEG2_FLOAT vlsseg2e32_v_f32m2 -#define VSSEG2_FLOAT vsseg2e32_v_f32m2 -#define VSSEG2_FLOAT_M vsseg2e32_v_f32m2_m -#define VBOOL_T vbool16_t -#define UINT_V_T vuint32m2_t -#define VID_V_UINT vid_v_u32m2 -#define VMSLTU_VX_UINT vmsltu_vx_u32m2_b16 +#define VSETVL(n) __riscv_vsetvl_e32m2(n) +#define FLOAT_V_T vfloat32m2_t +#define VLSSEG2_FLOAT __riscv_vlsseg2e32_v_f32m2 +#define VSSEG2_FLOAT __riscv_vsseg2e32_v_f32m2 +#define VSSEG2_FLOAT_M __riscv_vsseg2e32_v_f32m2_m +#define VBOOL_T vbool16_t +#define UINT_V_T vuint32m2_t +#define VID_V_UINT __riscv_vid_v_u32m2 +#define VMSLTU_VX_UINT __riscv_vmsltu_vx_u32m2_b16 #else -#define VSETVL(n) vsetvl_e64m2(n) -#define FLOAT_V_T vfloat64m2_t -#define VLSSEG2_FLOAT vlsseg2e64_v_f64m2 -#define VSSEG2_FLOAT vsseg2e64_v_f64m2 -#define VSSEG2_FLOAT_M vsseg2e64_v_f64m2_m -#define VBOOL_T vbool32_t -#define UINT_V_T vuint64m2_t -#define VID_V_UINT vid_v_u64m2 -#define VMSLTU_VX_UINT vmsltu_vx_u64m2_b32 +#define VSETVL(n) __riscv_vsetvl_e64m2(n) +#define FLOAT_V_T vfloat64m2_t +#define VLSSEG2_FLOAT __riscv_vlsseg2e64_v_f64m2 +#define VSSEG2_FLOAT __riscv_vsseg2e64_v_f64m2 +#define VSSEG2_FLOAT_M __riscv_vsseg2e64_v_f64m2_m +#define VBOOL_T vbool32_t +#define UINT_V_T vuint64m2_t +#define VID_V_UINT __riscv_vid_v_u64m2 +#define VMSLTU_VX_UINT __riscv_vmsltu_vx_u64m2_b32 #endif diff --git a/kernel/riscv64/ztrsm_ltcopy_rvv_v1.c b/kernel/riscv64/ztrsm_ltcopy_rvv_v1.c index 911b81de5..f57e9f1de 100644 --- a/kernel/riscv64/ztrsm_ltcopy_rvv_v1.c +++ b/kernel/riscv64/ztrsm_ltcopy_rvv_v1.c @@ -29,25 +29,25 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include "common.h" #if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m2(n) -#define FLOAT_V_T vfloat32m2_t -#define VLSEG2_FLOAT vlseg2e32_v_f32m2 -#define VSSEG2_FLOAT vsseg2e32_v_f32m2 -#define VSSEG2_FLOAT_M vsseg2e32_v_f32m2_m -#define VBOOL_T vbool16_t -#define UINT_V_T vuint32m2_t -#define VID_V_UINT vid_v_u32m2 -#define VMSGTU_VX_UINT vmsgtu_vx_u32m2_b16 +#define VSETVL(n) __riscv_vsetvl_e32m2(n) +#define FLOAT_V_T vfloat32m2_t +#define VLSEG2_FLOAT __riscv_vlseg2e32_v_f32m2 +#define VSSEG2_FLOAT __riscv_vsseg2e32_v_f32m2 +#define VSSEG2_FLOAT_M __riscv_vsseg2e32_v_f32m2_m +#define VBOOL_T vbool16_t +#define UINT_V_T vuint32m2_t +#define VID_V_UINT __riscv_vid_v_u32m2 +#define VMSGTU_VX_UINT __riscv_vmsgtu_vx_u32m2_b16 #else -#define VSETVL(n) vsetvl_e64m2(n) -#define FLOAT_V_T vfloat64m2_t -#define VLSEG2_FLOAT vlseg2e64_v_f64m2 -#define VSSEG2_FLOAT vsseg2e64_v_f64m2 -#define VSSEG2_FLOAT_M vsseg2e64_v_f64m2_m -#define VBOOL_T vbool32_t -#define UINT_V_T vuint64m2_t -#define VID_V_UINT vid_v_u64m2 -#define VMSGTU_VX_UINT vmsgtu_vx_u64m2_b32 +#define VSETVL(n) __riscv_vsetvl_e64m2(n) +#define FLOAT_V_T vfloat64m2_t +#define VLSEG2_FLOAT __riscv_vlseg2e64_v_f64m2 +#define VSSEG2_FLOAT __riscv_vsseg2e64_v_f64m2 +#define VSSEG2_FLOAT_M __riscv_vsseg2e64_v_f64m2_m +#define VBOOL_T vbool32_t +#define UINT_V_T vuint64m2_t +#define VID_V_UINT __riscv_vid_v_u64m2 +#define VMSGTU_VX_UINT __riscv_vmsgtu_vx_u64m2_b32 #endif int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG offset, FLOAT *b){ diff --git a/kernel/riscv64/ztrsm_uncopy_rvv_v1.c b/kernel/riscv64/ztrsm_uncopy_rvv_v1.c index db075c29b..be3613429 100644 --- a/kernel/riscv64/ztrsm_uncopy_rvv_v1.c +++ b/kernel/riscv64/ztrsm_uncopy_rvv_v1.c @@ -30,25 +30,25 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include "common.h" #if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m2(n) -#define FLOAT_V_T vfloat32m2_t -#define VLSSEG2_FLOAT vlsseg2e32_v_f32m2 -#define VSSEG2_FLOAT vsseg2e32_v_f32m2 -#define VSSEG2_FLOAT_M vsseg2e32_v_f32m2_m -#define VBOOL_T vbool16_t -#define UINT_V_T vuint32m2_t -#define VID_V_UINT vid_v_u32m2 -#define VMSGTU_VX_UINT vmsgtu_vx_u32m2_b16 +#define VSETVL(n) __riscv_vsetvl_e32m2(n) +#define FLOAT_V_T vfloat32m2_t +#define VLSSEG2_FLOAT __riscv_vlsseg2e32_v_f32m2 +#define VSSEG2_FLOAT __riscv_vsseg2e32_v_f32m2 +#define VSSEG2_FLOAT_M __riscv_vsseg2e32_v_f32m2_m +#define VBOOL_T vbool16_t +#define UINT_V_T vuint32m2_t +#define VID_V_UINT __riscv_vid_v_u32m2 +#define VMSGTU_VX_UINT __riscv_vmsgtu_vx_u32m2_b16 #else -#define VSETVL(n) vsetvl_e64m2(n) -#define FLOAT_V_T vfloat64m2_t -#define VLSSEG2_FLOAT vlsseg2e64_v_f64m2 -#define VSSEG2_FLOAT vsseg2e64_v_f64m2 -#define VSSEG2_FLOAT_M vsseg2e64_v_f64m2_m -#define VBOOL_T vbool32_t -#define UINT_V_T vuint64m2_t -#define VID_V_UINT vid_v_u64m2 -#define VMSGTU_VX_UINT vmsgtu_vx_u64m2_b32 +#define VSETVL(n) __riscv_vsetvl_e64m2(n) +#define FLOAT_V_T vfloat64m2_t +#define VLSSEG2_FLOAT __riscv_vlsseg2e64_v_f64m2 +#define VSSEG2_FLOAT __riscv_vsseg2e64_v_f64m2 +#define VSSEG2_FLOAT_M __riscv_vsseg2e64_v_f64m2_m +#define VBOOL_T vbool32_t +#define UINT_V_T vuint64m2_t +#define VID_V_UINT __riscv_vid_v_u64m2 +#define VMSGTU_VX_UINT __riscv_vmsgtu_vx_u64m2_b32 #endif diff --git a/kernel/riscv64/ztrsm_utcopy_rvv_v1.c b/kernel/riscv64/ztrsm_utcopy_rvv_v1.c index e121c6273..b1f5ef8f0 100644 --- a/kernel/riscv64/ztrsm_utcopy_rvv_v1.c +++ b/kernel/riscv64/ztrsm_utcopy_rvv_v1.c @@ -29,25 +29,25 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include "common.h" #if !defined(DOUBLE) -#define VSETVL(n) vsetvl_e32m2(n) -#define FLOAT_V_T vfloat32m2_t -#define VLSEG2_FLOAT vlseg2e32_v_f32m2 -#define VSSEG2_FLOAT vsseg2e32_v_f32m2 -#define VSSEG2_FLOAT_M vsseg2e32_v_f32m2_m -#define VBOOL_T vbool16_t -#define UINT_V_T vuint32m2_t -#define VID_V_UINT vid_v_u32m2 -#define VMSLTU_VX_UINT vmsltu_vx_u32m2_b16 +#define VSETVL(n) __riscv_vsetvl_e32m2(n) +#define FLOAT_V_T vfloat32m2_t +#define VLSEG2_FLOAT __riscv_vlseg2e32_v_f32m2 +#define VSSEG2_FLOAT __riscv_vsseg2e32_v_f32m2 +#define VSSEG2_FLOAT_M __riscv_vsseg2e32_v_f32m2_m +#define VBOOL_T vbool16_t +#define UINT_V_T vuint32m2_t +#define VID_V_UINT __riscv_vid_v_u32m2 +#define VMSLTU_VX_UINT __riscv_vmsltu_vx_u32m2_b16 #else -#define VSETVL(n) vsetvl_e64m2(n) -#define FLOAT_V_T vfloat64m2_t -#define VLSEG2_FLOAT vlseg2e64_v_f64m2 -#define VSSEG2_FLOAT vsseg2e64_v_f64m2 -#define VSSEG2_FLOAT_M vsseg2e64_v_f64m2_m -#define VBOOL_T vbool32_t -#define UINT_V_T vuint64m2_t -#define VID_V_UINT vid_v_u64m2 -#define VMSLTU_VX_UINT vmsltu_vx_u64m2_b32 +#define VSETVL(n) __riscv_vsetvl_e64m2(n) +#define FLOAT_V_T vfloat64m2_t +#define VLSEG2_FLOAT __riscv_vlseg2e64_v_f64m2 +#define VSSEG2_FLOAT __riscv_vsseg2e64_v_f64m2 +#define VSSEG2_FLOAT_M __riscv_vsseg2e64_v_f64m2_m +#define VBOOL_T vbool32_t +#define UINT_V_T vuint64m2_t +#define VID_V_UINT __riscv_vid_v_u64m2 +#define VMSLTU_VX_UINT __riscv_vmsltu_vx_u64m2_b32 #endif From 6b74bee2f9d7272f1932a9ba9bbd1bda6c122fbf Mon Sep 17 00:00:00 2001 From: Heller Zheng Date: Mon, 27 Mar 2023 18:59:24 -0700 Subject: [PATCH 013/311] Update TARGET=x280 description. --- README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.md b/README.md index 6ecb46178..1f1c0f3ed 100644 --- a/README.md +++ b/README.md @@ -186,7 +186,7 @@ Please read `GotoBLAS_01Readme.txt` for older CPU models already supported by th ``` (also known to work on C906) -- **x280**: LLVM auto-vectorization using RISC-V Vector extension 1.0. +- **x280**: Level-3 BLAS and Level-1,2 are optimized by RISC-V Vector extension 1.0. ```sh make HOSTCC=gcc TARGET=x280 NUM_THREADS=8 CC=riscv64-unknown-linux-gnu-clang FC=riscv64-unknown-linux-gnu-gfortran ``` From 18d7afe69daa196902cd68b63cc381aaafc9d26e Mon Sep 17 00:00:00 2001 From: sh-zheng <2294474733@qq.com> Date: Sat, 20 May 2023 01:19:44 +0800 Subject: [PATCH 014/311] Add rvv support for zsymv and active rvv support for zhemv --- kernel/riscv64/KERNEL.x280 | 17 ++- kernel/riscv64/zhemv_LM_rvv.c | 198 +++++++++++++++++++++++++++++++++ kernel/riscv64/zhemv_UV_rvv.c | 199 ++++++++++++++++++++++++++++++++++ kernel/riscv64/zsymv_L_rvv.c | 179 ++++++++++++++++++++++++++++++ kernel/riscv64/zsymv_U_rvv.c | 177 ++++++++++++++++++++++++++++++ 5 files changed, 766 insertions(+), 4 deletions(-) create mode 100644 kernel/riscv64/zhemv_LM_rvv.c create mode 100644 kernel/riscv64/zhemv_UV_rvv.c create mode 100644 kernel/riscv64/zsymv_L_rvv.c create mode 100644 kernel/riscv64/zsymv_U_rvv.c diff --git a/kernel/riscv64/KERNEL.x280 b/kernel/riscv64/KERNEL.x280 index 217d8534e..86708fe01 100644 --- a/kernel/riscv64/KERNEL.x280 +++ b/kernel/riscv64/KERNEL.x280 @@ -225,10 +225,19 @@ SSYMV_U_KERNEL = symv_U_rvv.c SSYMV_L_KERNEL = symv_L_rvv.c DSYMV_U_KERNEL = symv_U_rvv.c DSYMV_L_KERNEL = symv_L_rvv.c -CSYMV_U_KERNEL = ../generic/zsymv_k.c -CSYMV_L_KERNEL = ../generic/zsymv_k.c -ZSYMV_U_KERNEL = ../generic/zsymv_k.c -ZSYMV_L_KERNEL = ../generic/zsymv_k.c +CSYMV_U_KERNEL = zsymv_U_rvv.c +CSYMV_L_KERNEL = zsymv_L_rvv.c +ZSYMV_U_KERNEL = zsymv_U_rvv.c +ZSYMV_L_KERNEL = zsymv_L_rvv.c + +CHEMV_L_KERNEL = zhemv_LM_rvv.c +CHEMV_M_KERNEL = zhemv_LM_rvv.c +CHEMV_U_KERNEL = zhemv_UV_rvv.c +CHEMV_V_KERNEL = zhemv_UV_rvv.c +ZHEMV_L_KERNEL = zhemv_LM_rvv.c +ZHEMV_M_KERNEL = zhemv_LM_rvv.c +ZHEMV_U_KERNEL = zhemv_UV_rvv.c +ZHEMV_V_KERNEL = zhemv_UV_rvv.c ZHEMMLTCOPY_M = zhemm_ltcopy_rvv_v1.c ZHEMMUTCOPY_M = zhemm_utcopy_rvv_v1.c diff --git a/kernel/riscv64/zhemv_LM_rvv.c b/kernel/riscv64/zhemv_LM_rvv.c new file mode 100644 index 000000000..e025120e5 --- /dev/null +++ b/kernel/riscv64/zhemv_LM_rvv.c @@ -0,0 +1,198 @@ +/*************************************************************************** +Copyright (c) 2013, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" +#if !defined(DOUBLE) +#define VSETVL(n) __riscv_vsetvl_e32m4(n) +#define VSETVL_MAX __riscv_vsetvlmax_e32m1() +#define FLOAT_V_T vfloat32m4_t +#define FLOAT_V_T_M1 vfloat32m1_t +#define VFMVFS_FLOAT __riscv_vfmv_f_s_f32m1_f32 +#define VLSEV_FLOAT __riscv_vlse32_v_f32m4 +#define VSSEV_FLOAT __riscv_vsse32_v_f32m4 +#define VFREDSUM_FLOAT __riscv_vfredusum_vs_f32m4_f32m1 +#define VFMACCVV_FLOAT __riscv_vfmacc_vv_f32m4 +#define VFMACCVF_FLOAT __riscv_vfmacc_vf_f32m4 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m4 +#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f32m1 +#define VFMULVV_FLOAT __riscv_vfmul_vv_f32m4 +#define VFNMSACVF_FLOAT __riscv_vfnmsac_vf_f32m4 +#define VFNMSACVV_FLOAT __riscv_vfnmsac_vv_f32m4 +#else +#define VSETVL(n) __riscv_vsetvl_e64m4(n) +#define VSETVL_MAX __riscv_vsetvlmax_e64m1() +#define FLOAT_V_T vfloat64m4_t +#define FLOAT_V_T_M1 vfloat64m1_t +#define VFMVFS_FLOAT __riscv_vfmv_f_s_f64m1_f64 +#define VLSEV_FLOAT __riscv_vlse64_v_f64m4 +#define VSSEV_FLOAT __riscv_vsse64_v_f64m4 +#define VFREDSUM_FLOAT __riscv_vfredusum_vs_f64m4_f64m1 +#define VFMACCVV_FLOAT __riscv_vfmacc_vv_f64m4 +#define VFMACCVF_FLOAT __riscv_vfmacc_vf_f64m4 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m4 +#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f64m1 +#define VFMULVV_FLOAT __riscv_vfmul_vv_f64m4 +#define VFNMSACVF_FLOAT __riscv_vfnmsac_vf_f64m4 +#define VFNMSACVV_FLOAT __riscv_vfnmsac_vv_f64m4 +#endif + +int CNAME(BLASLONG m, BLASLONG offset, FLOAT alpha_r, FLOAT alpha_i, FLOAT *a, BLASLONG lda, FLOAT *x, BLASLONG incx, FLOAT *y, BLASLONG incy, FLOAT *buffer){ + BLASLONG i, j, k; + BLASLONG ix, iy, ia; + BLASLONG jx, jy, ja; + FLOAT temp_r1, temp_i1; + FLOAT temp_r2, temp_i2; + FLOAT *a_ptr = a; + unsigned int gvl = 0; + FLOAT_V_T_M1 v_res, v_z0; + gvl = VSETVL_MAX; + v_res = VFMVVF_FLOAT_M1(0, gvl); + v_z0 = VFMVVF_FLOAT_M1(0, gvl); + + FLOAT_V_T va0, va1, vx0, vx1, vy0, vy1, vr0, vr1; + BLASLONG stride_x, stride_y, stride_a, inc_xv, inc_yv, inc_av, len, lda2; + + BLASLONG inc_x2 = incx * 2; + BLASLONG inc_y2 = incy * 2; + stride_x = inc_x2 * sizeof(FLOAT); + stride_y = inc_y2 * sizeof(FLOAT); + stride_a = 2 * sizeof(FLOAT); + lda2 = lda * 2; + + jx = 0; + jy = 0; + ja = 0; + for(j = 0; j < offset; j++){ + temp_r1 = alpha_r * x[jx] - alpha_i * x[jx+1];; + temp_i1 = alpha_r * x[jx+1] + alpha_i * x[jx]; + temp_r2 = 0; + temp_i2 = 0; + y[jy] += temp_r1 * a_ptr[ja]; + y[jy+1] += temp_i1 * a_ptr[ja]; + ix = jx + inc_x2; + iy = jy + inc_y2; + ia = ja + 2; + i = j + 1; + len = m - i; + if(len > 0){ + gvl = VSETVL(len); + inc_xv = incx * gvl * 2; + inc_yv = incy * gvl * 2; + inc_av = gvl * 2; + vr0 = VFMVVF_FLOAT(0, gvl); + vr1 = VFMVVF_FLOAT(0, gvl); + for(k = 0; k < len / gvl; k++){ + va0 = VLSEV_FLOAT(&a_ptr[ia], stride_a, gvl); + va1 = VLSEV_FLOAT(&a_ptr[ia+1], stride_a, gvl); + vy0 = VLSEV_FLOAT(&y[iy], stride_y, gvl); + vy1 = VLSEV_FLOAT(&y[iy+1], stride_y, gvl); +#ifndef HEMVREV + vy0 = VFMACCVF_FLOAT(vy0, temp_r1, va0, gvl); + vy0 = VFNMSACVF_FLOAT(vy0, temp_i1, va1, gvl); + vy1 = VFMACCVF_FLOAT(vy1, temp_r1, va1, gvl); + vy1 = VFMACCVF_FLOAT(vy1, temp_i1, va0, gvl); +#else + vy0 = VFMACCVF_FLOAT(vy0, temp_r1, va0, gvl); + vy0 = VFMACCVF_FLOAT(vy0, temp_i1, va1, gvl); + vy1 = VFNMSACVF_FLOAT(vy1, temp_r1, va1, gvl); + vy1 = VFMACCVF_FLOAT(vy1, temp_i1, va0, gvl); +#endif + VSSEV_FLOAT(&y[iy], stride_y, vy0, gvl); + VSSEV_FLOAT(&y[iy+1], stride_y, vy1, gvl); + + vx0 = VLSEV_FLOAT(&x[ix], stride_x, gvl); + vx1 = VLSEV_FLOAT(&x[ix+1], stride_x, gvl); +#ifndef HEMVREV + vr0 = VFMACCVV_FLOAT(vr0, vx0, va0, gvl); + vr0 = VFMACCVV_FLOAT(vr0, vx1, va1, gvl); + vr1 = VFMACCVV_FLOAT(vr1, vx1, va0, gvl); + vr1 = VFNMSACVV_FLOAT(vr1, vx0, va1, gvl); +#else + vr0 = VFMACCVV_FLOAT(vr0, vx0, va0, gvl); + vr0 = VFNMSACVV_FLOAT(vr0, vx1, va1, gvl); + vr1 = VFMACCVV_FLOAT(vr1, vx1, va0, gvl); + vr1 = VFMACCVV_FLOAT(vr1, vx0, va1, gvl); + +#endif + i += gvl; + ix += inc_xv; + iy += inc_yv; + ia += inc_av; + } + v_res = VFREDSUM_FLOAT(vr0, v_z0, gvl); + temp_r2 = VFMVFS_FLOAT(v_res); + v_res = VFREDSUM_FLOAT(vr1, v_z0, gvl); + temp_i2 = VFMVFS_FLOAT(v_res); + if(i < m){ + gvl = VSETVL(m-i); + va0 = VLSEV_FLOAT(&a_ptr[ia], stride_a, gvl); + va1 = VLSEV_FLOAT(&a_ptr[ia+1], stride_a, gvl); + vy0 = VLSEV_FLOAT(&y[iy], stride_y, gvl); + vy1 = VLSEV_FLOAT(&y[iy+1], stride_y, gvl); +#ifndef HEMVREV + vy0 = VFMACCVF_FLOAT(vy0, temp_r1, va0, gvl); + vy0 = VFNMSACVF_FLOAT(vy0, temp_i1, va1, gvl); + vy1 = VFMACCVF_FLOAT(vy1, temp_r1, va1, gvl); + vy1 = VFMACCVF_FLOAT(vy1, temp_i1, va0, gvl); +#else + vy0 = VFMACCVF_FLOAT(vy0, temp_r1, va0, gvl); + vy0 = VFMACCVF_FLOAT(vy0, temp_i1, va1, gvl); + vy1 = VFNMSACVF_FLOAT(vy1, temp_r1, va1, gvl); + vy1 = VFMACCVF_FLOAT(vy1, temp_i1, va0, gvl); +#endif + VSSEV_FLOAT(&y[iy], stride_y, vy0, gvl); + VSSEV_FLOAT(&y[iy+1], stride_y, vy1, gvl); + + vx0 = VLSEV_FLOAT(&x[ix], stride_x, gvl); + vx1 = VLSEV_FLOAT(&x[ix+1], stride_x, gvl); +#ifndef HEMVREV + vr0 = VFMULVV_FLOAT(vx0, va0, gvl); + vr0 = VFMACCVV_FLOAT(vr0, vx1, va1, gvl); + vr1 = VFMULVV_FLOAT(vx1, va0, gvl); + vr1 = VFNMSACVV_FLOAT(vr1, vx0, va1, gvl); +#else + vr0 = VFMULVV_FLOAT(vx0, va0, gvl); + vr0 = VFNMSACVV_FLOAT(vr0, vx1, va1, gvl); + vr1 = VFMULVV_FLOAT(vx1, va0, gvl); + vr1 = VFMACCVV_FLOAT(vr1, vx0, va1, gvl); +#endif + + v_res = VFREDSUM_FLOAT(vr0, v_z0, gvl); + temp_r2 += VFMVFS_FLOAT(v_res); + v_res = VFREDSUM_FLOAT(vr1, v_z0, gvl); + temp_i2 += VFMVFS_FLOAT(v_res); + } + } + y[jy] += alpha_r * temp_r2 - alpha_i * temp_i2; + y[jy+1] += alpha_r * temp_i2 + alpha_i * temp_r2; + jx += inc_x2; + jy += inc_y2; + ja += 2; + a_ptr += lda2; + } + return(0); +} diff --git a/kernel/riscv64/zhemv_UV_rvv.c b/kernel/riscv64/zhemv_UV_rvv.c new file mode 100644 index 000000000..0e1ea5436 --- /dev/null +++ b/kernel/riscv64/zhemv_UV_rvv.c @@ -0,0 +1,199 @@ +/*************************************************************************** +Copyright (c) 2013, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" +#if !defined(DOUBLE) +#define VSETVL(n) __riscv_vsetvl_e32m4(n) +#define VSETVL_MAX __riscv_vsetvlmax_e32m1() +#define FLOAT_V_T vfloat32m4_t +#define FLOAT_V_T_M1 vfloat32m1_t +#define VFMVFS_FLOAT __riscv_vfmv_f_s_f32m1_f32 +#define VLSEV_FLOAT __riscv_vlse32_v_f32m4 +#define VSSEV_FLOAT __riscv_vsse32_v_f32m4 +#define VFREDSUM_FLOAT __riscv_vfredusum_vs_f32m4_f32m1 +#define VFMACCVV_FLOAT __riscv_vfmacc_vv_f32m4 +#define VFMACCVF_FLOAT __riscv_vfmacc_vf_f32m4 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m4 +#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f32m1 +#define VFMULVV_FLOAT __riscv_vfmul_vv_f32m4 +#define VFNMSACVF_FLOAT __riscv_vfnmsac_vf_f32m4 +#define VFNMSACVV_FLOAT __riscv_vfnmsac_vv_f32m4 +#else +#define VSETVL(n) __riscv_vsetvl_e64m4(n) +#define VSETVL_MAX __riscv_vsetvlmax_e64m1() +#define FLOAT_V_T vfloat64m4_t +#define FLOAT_V_T_M1 vfloat64m1_t +#define VFMVFS_FLOAT __riscv_vfmv_f_s_f64m1_f64 +#define VLSEV_FLOAT __riscv_vlse64_v_f64m4 +#define VSSEV_FLOAT __riscv_vsse64_v_f64m4 +#define VFREDSUM_FLOAT __riscv_vfredusum_vs_f64m4_f64m1 +#define VFMACCVV_FLOAT __riscv_vfmacc_vv_f64m4 +#define VFMACCVF_FLOAT __riscv_vfmacc_vf_f64m4 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m4 +#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f64m1 +#define VFMULVV_FLOAT __riscv_vfmul_vv_f64m4 +#define VFNMSACVF_FLOAT __riscv_vfnmsac_vf_f64m4 +#define VFNMSACVV_FLOAT __riscv_vfnmsac_vv_f64m4 +#endif + +int CNAME(BLASLONG m, BLASLONG offset, FLOAT alpha_r, FLOAT alpha_i, FLOAT *a, BLASLONG lda, FLOAT *x, BLASLONG incx, FLOAT *y, BLASLONG incy, FLOAT *buffer){ + BLASLONG i, j, k; + BLASLONG ix, iy, ia; + BLASLONG jx, jy, ja; + FLOAT temp_r1, temp_i1; + FLOAT temp_r2, temp_i2; + FLOAT *a_ptr = a; + unsigned int gvl = 0; + FLOAT_V_T_M1 v_res, v_z0; + gvl = VSETVL_MAX; + v_res = VFMVVF_FLOAT_M1(0, gvl); + v_z0 = VFMVVF_FLOAT_M1(0, gvl); + + FLOAT_V_T va0, va1, vx0, vx1, vy0, vy1, vr0, vr1; + BLASLONG stride_x, stride_y, stride_a, inc_xv, inc_yv, inc_av, lda2; + + BLASLONG inc_x2 = incx * 2; + BLASLONG inc_y2 = incy * 2; + stride_x = inc_x2 * sizeof(FLOAT); + stride_y = inc_y2 * sizeof(FLOAT); + stride_a = 2 * sizeof(FLOAT); + lda2 = lda * 2; + + BLASLONG m1 = m - offset; + a_ptr = a + m1 * lda2; + jx = m1 * inc_x2; + jy = m1 * inc_y2; + ja = m1 * 2; + for(j = m1; j < m; j++){ + temp_r1 = alpha_r * x[jx] - alpha_i * x[jx+1];; + temp_i1 = alpha_r * x[jx+1] + alpha_i * x[jx]; + temp_r2 = 0; + temp_i2 = 0; + ix = 0; + iy = 0; + ia = 0; + i = 0; + if(j > 0){ + gvl = VSETVL(j); + inc_xv = incx * gvl * 2; + inc_yv = incy * gvl * 2; + inc_av = gvl * 2; + vr0 = VFMVVF_FLOAT(0, gvl); + vr1 = VFMVVF_FLOAT(0, gvl); + for(k = 0; k < j / gvl; k++){ + va0 = VLSEV_FLOAT(&a_ptr[ia], stride_a, gvl); + va1 = VLSEV_FLOAT(&a_ptr[ia+1], stride_a, gvl); + vy0 = VLSEV_FLOAT(&y[iy], stride_y, gvl); + vy1 = VLSEV_FLOAT(&y[iy+1], stride_y, gvl); +#ifndef HEMVREV + vy0 = VFMACCVF_FLOAT(vy0, temp_r1, va0, gvl); + vy0 = VFNMSACVF_FLOAT(vy0, temp_i1, va1, gvl); + vy1 = VFMACCVF_FLOAT(vy1, temp_r1, va1, gvl); + vy1 = VFMACCVF_FLOAT(vy1, temp_i1, va0, gvl); +#else + vy0 = VFMACCVF_FLOAT(vy0, temp_r1, va0, gvl); + vy0 = VFMACCVF_FLOAT(vy0, temp_i1, va1, gvl); + vy1 = VFNMSACVF_FLOAT(vy1, temp_r1, va1, gvl); + vy1 = VFMACCVF_FLOAT(vy1, temp_i1, va0, gvl); +#endif + VSSEV_FLOAT(&y[iy], stride_y, vy0, gvl); + VSSEV_FLOAT(&y[iy+1], stride_y, vy1, gvl); + + vx0 = VLSEV_FLOAT(&x[ix], stride_x, gvl); + vx1 = VLSEV_FLOAT(&x[ix+1], stride_x, gvl); +#ifndef HEMVREV + vr0 = VFMACCVV_FLOAT(vr0, vx0, va0, gvl); + vr0 = VFMACCVV_FLOAT(vr0, vx1, va1, gvl); + vr1 = VFMACCVV_FLOAT(vr1, vx1, va0, gvl); + vr1 = VFNMSACVV_FLOAT(vr1, vx0, va1, gvl); +#else + vr0 = VFMACCVV_FLOAT(vr0, vx0, va0, gvl); + vr0 = VFNMSACVV_FLOAT(vr0, vx1, va1, gvl); + vr1 = VFMACCVV_FLOAT(vr1, vx1, va0, gvl); + vr1 = VFMACCVV_FLOAT(vr1, vx0, va1, gvl); + +#endif + i += gvl; + ix += inc_xv; + iy += inc_yv; + ia += inc_av; + } + v_res = VFREDSUM_FLOAT(vr0, v_z0, gvl); + temp_r2 = VFMVFS_FLOAT(v_res); + v_res = VFREDSUM_FLOAT(vr1, v_z0, gvl); + temp_i2 = VFMVFS_FLOAT(v_res); + if(i < j){ + gvl = VSETVL(j-i); + va0 = VLSEV_FLOAT(&a_ptr[ia], stride_a, gvl); + va1 = VLSEV_FLOAT(&a_ptr[ia+1], stride_a, gvl); + vy0 = VLSEV_FLOAT(&y[iy], stride_y, gvl); + vy1 = VLSEV_FLOAT(&y[iy+1], stride_y, gvl); +#ifndef HEMVREV + vy0 = VFMACCVF_FLOAT(vy0, temp_r1, va0, gvl); + vy0 = VFNMSACVF_FLOAT(vy0, temp_i1, va1, gvl); + vy1 = VFMACCVF_FLOAT(vy1, temp_r1, va1, gvl); + vy1 = VFMACCVF_FLOAT(vy1, temp_i1, va0, gvl); +#else + vy0 = VFMACCVF_FLOAT(vy0, temp_r1, va0, gvl); + vy0 = VFMACCVF_FLOAT(vy0, temp_i1, va1, gvl); + vy1 = VFNMSACVF_FLOAT(vy1, temp_r1, va1, gvl); + vy1 = VFMACCVF_FLOAT(vy1, temp_i1, va0, gvl); +#endif + VSSEV_FLOAT(&y[iy], stride_y, vy0, gvl); + VSSEV_FLOAT(&y[iy+1], stride_y, vy1, gvl); + + vx0 = VLSEV_FLOAT(&x[ix], stride_x, gvl); + vx1 = VLSEV_FLOAT(&x[ix+1], stride_x, gvl); +#ifndef HEMVREV + vr0 = VFMULVV_FLOAT(vx0, va0, gvl); + vr0 = VFMACCVV_FLOAT(vr0, vx1, va1, gvl); + vr1 = VFMULVV_FLOAT(vx1, va0, gvl); + vr1 = VFNMSACVV_FLOAT(vr1, vx0, va1, gvl); +#else + vr0 = VFMULVV_FLOAT(vx0, va0, gvl); + vr0 = VFNMSACVV_FLOAT(vr0, vx1, va1, gvl); + vr1 = VFMULVV_FLOAT(vx1, va0, gvl); + vr1 = VFMACCVV_FLOAT(vr1, vx0, va1, gvl); +#endif + + v_res = VFREDSUM_FLOAT(vr0, v_z0, gvl); + temp_r2 += VFMVFS_FLOAT(v_res); + v_res = VFREDSUM_FLOAT(vr1, v_z0, gvl); + temp_i2 += VFMVFS_FLOAT(v_res); + } + } + y[jy] += temp_r1 * a_ptr[ja]; + y[jy+1] += temp_i1 * a_ptr[ja]; + y[jy] += alpha_r * temp_r2 - alpha_i * temp_i2; + y[jy+1] += alpha_r * temp_i2 + alpha_i * temp_r2; + jx += inc_x2; + jy += inc_y2; + ja += 2; + a_ptr += lda2; + } + return(0); +} diff --git a/kernel/riscv64/zsymv_L_rvv.c b/kernel/riscv64/zsymv_L_rvv.c new file mode 100644 index 000000000..3bf621094 --- /dev/null +++ b/kernel/riscv64/zsymv_L_rvv.c @@ -0,0 +1,179 @@ +/*************************************************************************** +Copyright (c) 2020, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" +#if !defined(DOUBLE) +#define VSETVL(n) __riscv_vsetvl_e32m4(n) +#define VSETVL_MAX __riscv_vsetvlmax_e32m1() +#define FLOAT_V_T vfloat32m4_t +#define FLOAT_V_T_M1 vfloat32m1_t +#define VLEV_FLOAT __riscv_vle32_v_f32m4 +#define VLSEV_FLOAT __riscv_vlse32_v_f32m4 +#define VSEV_FLOAT __riscv_vse32_v_f32m4 +#define VSSEV_FLOAT __riscv_vsse32_v_f32m4 +#define VFREDSUM_FLOAT __riscv_vfredusum_vs_f32m4_f32m1 +#define VFMACCVV_FLOAT __riscv_vfmacc_vv_f32m4 +#define VFNMSACVV_FLOAT __riscv_vfnmsac_vv_f32m4 +#define VFMACCVF_FLOAT __riscv_vfmacc_vf_f32m4 +#define VFNMSACVF_FLOAT __riscv_vfnmsac_vf_f32m4 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m4 +#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f32m1 +#define VFMULVV_FLOAT __riscv_vfmul_vv_f32m4 +#define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f32m1_f32 +#define VFNEGV_FLOAT __riscv_vfneg_v_f32mf4 +#else +#define VSETVL(n) __riscv_vsetvl_e64m4(n) +#define VSETVL_MAX __riscv_vsetvlmax_e64m1() +#define FLOAT_V_T vfloat64m4_t +#define FLOAT_V_T_M1 vfloat64m1_t +#define VLEV_FLOAT __riscv_vle64_v_f64m4 +#define VLSEV_FLOAT __riscv_vlse64_v_f64m4 +#define VSEV_FLOAT __riscv_vse64_v_f64m4 +#define VSSEV_FLOAT __riscv_vsse64_v_f64m4 +#define VFREDSUM_FLOAT __riscv_vfredusum_vs_f64m4_f64m1 +#define VFMACCVV_FLOAT __riscv_vfmacc_vv_f64m4 +#define VFNMSACVV_FLOAT __riscv_vfnmsac_vv_f64m4 +#define VFMACCVF_FLOAT __riscv_vfmacc_vf_f64m4 +#define VFNMSACVF_FLOAT __riscv_vfnmsac_vf_f64m4 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m4 +#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f64m1 +#define VFMULVV_FLOAT __riscv_vfmul_vv_f64m4 +#define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f64m1_f64 +#define VFNEGV_FLOAT __riscv_vfneg_v_f64mf4 +#endif + +int CNAME(BLASLONG m, BLASLONG offset, FLOAT alpha_r, FLOAT alpha_i, + FLOAT *a, BLASLONG lda, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y, FLOAT *buffer) +{ + BLASLONG i, j, k; + BLASLONG ix,iy; + BLASLONG jx,jy; + FLOAT temp1[2]; + FLOAT temp2[2]; + FLOAT *a_ptr = a; + BLASLONG gvl = VSETVL_MAX; + FLOAT_V_T_M1 v_res, v_z0; + v_res = VFMVVF_FLOAT_M1(0, gvl); + v_z0 = VFMVVF_FLOAT_M1(0, gvl); + + FLOAT_V_T va_r, va_i, vx_r, vx_i, vy_r, vy_i, vr_r, vr_i; + BLASLONG stride_x, stride_y, inc_xv, inc_yv, len; + + stride_x = 2 * inc_x * sizeof(FLOAT); + stride_y = 2 * inc_y * sizeof(FLOAT); + jx = 0; + jy = 0; + for (j=0; j 0){ + gvl = VSETVL(len); + inc_xv = inc_x * gvl; + inc_yv = inc_y * gvl; + vr_r = VFMVVF_FLOAT(0, gvl); + vr_i = VFMVVF_FLOAT(0, gvl); + for(k = 0; k < len / gvl; k++){ + va_r = VLSEV_FLOAT(&a_ptr[2 * i], 2 * sizeof(FLOAT), gvl); + va_i = VLSEV_FLOAT(&a_ptr[2 * i + 1], 2 * sizeof(FLOAT), gvl); + + vy_r = VLSEV_FLOAT(&y[2 * iy], stride_y, gvl); + vy_i = VLSEV_FLOAT(&y[2 * iy + 1], stride_y, gvl); + + vy_r = VFMACCVF_FLOAT(vy_r, temp1[0], va_r, gvl); + vy_r = VFNMSACVF_FLOAT(vy_r, temp1[1], va_i, gvl); + vy_i = VFMACCVF_FLOAT(vy_i, temp1[0], va_i, gvl); + vy_i = VFMACCVF_FLOAT(vy_i, temp1[1], va_r, gvl); + + VSSEV_FLOAT(&y[2 * iy], stride_y, vy_r, gvl); + VSSEV_FLOAT(&y[2 * iy + 1], stride_y, vy_i, gvl); + + vx_r = VLSEV_FLOAT(&x[2 * ix], stride_x, gvl); + vx_i = VLSEV_FLOAT(&x[2 * ix + 1], stride_x, gvl); + vr_r = VFMACCVV_FLOAT(vr_r, vx_r, va_r, gvl); + vr_r = VFNMSACVV_FLOAT(vr_r, vx_i, va_i, gvl); + vr_i = VFMACCVV_FLOAT(vr_i, vx_r, va_i, gvl); + vr_i = VFMACCVV_FLOAT(vr_i, vx_i, va_r, gvl); + + i += gvl; + ix += inc_xv; + iy += inc_yv; + } + v_res = VFREDSUM_FLOAT(vr_r, v_z0, gvl); + temp2[0] = VFMVFS_FLOAT_M1(v_res); + v_res = VFREDSUM_FLOAT(vr_i, v_z0, gvl); + temp2[1] = VFMVFS_FLOAT_M1(v_res); + + if(i < m){ + gvl = VSETVL(m-i); + vy_r = VLSEV_FLOAT(&y[2 * iy], stride_y, gvl); + vy_i = VLSEV_FLOAT(&y[2 * iy + 1], stride_y, gvl); + va_r = VLSEV_FLOAT(&a_ptr[2 * i], 2 * sizeof(FLOAT), gvl); + va_i = VLSEV_FLOAT(&a_ptr[2 * i + 1], 2 * sizeof(FLOAT), gvl); + + vy_r = VFMACCVF_FLOAT(vy_r, temp1[0], va_r, gvl); + vy_r = VFNMSACVF_FLOAT(vy_r, temp1[1], va_i, gvl); + vy_i = VFMACCVF_FLOAT(vy_i, temp1[0], va_i, gvl); + vy_i = VFMACCVF_FLOAT(vy_i, temp1[1], va_r, gvl); + + VSSEV_FLOAT(&y[2 * iy], stride_y, vy_r, gvl); + VSSEV_FLOAT(&y[2 * iy + 1], stride_y, vy_i, gvl); + + vx_r = VLSEV_FLOAT(&x[2 * ix], stride_x, gvl); + vx_i = VLSEV_FLOAT(&x[2 * ix + 1], stride_x, gvl); + vr_r = VFMULVV_FLOAT(vx_r, va_r, gvl); + vr_r = VFNMSACVV_FLOAT(vr_r, vx_i, va_i, gvl); + vr_i = VFMULVV_FLOAT(vx_r, va_i, gvl); + vr_i = VFMACCVV_FLOAT(vr_i, vx_i, va_r, gvl); + + v_res = VFREDSUM_FLOAT(vr_r, v_z0, gvl); + temp2[0] += VFMVFS_FLOAT_M1(v_res); + v_res = VFREDSUM_FLOAT(vr_i, v_z0, gvl); + temp2[1] += VFMVFS_FLOAT_M1(v_res); + } + } + y[2 * jy] += alpha_r * temp2[0] - alpha_i * temp2[1]; + y[2 * jy + 1] += alpha_r * temp2[1] + alpha_i * temp2[0]; + + jx += inc_x; + jy += inc_y; + a_ptr += 2 * lda; + } + + return(0); +} + diff --git a/kernel/riscv64/zsymv_U_rvv.c b/kernel/riscv64/zsymv_U_rvv.c new file mode 100644 index 000000000..de1564f75 --- /dev/null +++ b/kernel/riscv64/zsymv_U_rvv.c @@ -0,0 +1,177 @@ +/*************************************************************************** +Copyright (c) 2020, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" +#if !defined(DOUBLE) +#define VSETVL(n) __riscv_vsetvl_e32m4(n) +#define VSETVL_MAX __riscv_vsetvlmax_e32m1() +#define FLOAT_V_T vfloat32m4_t +#define FLOAT_V_T_M1 vfloat32m1_t +#define VLEV_FLOAT __riscv_vle32_v_f32m4 +#define VLSEV_FLOAT __riscv_vlse32_v_f32m4 +#define VSEV_FLOAT __riscv_vse32_v_f32m4 +#define VSSEV_FLOAT __riscv_vsse32_v_f32m4 +#define VFREDSUM_FLOAT __riscv_vfredusum_vs_f32m4_f32m1 +#define VFMACCVV_FLOAT __riscv_vfmacc_vv_f32m4 +#define VFNMSACVV_FLOAT __riscv_vfnmsac_vv_f32m4 +#define VFMACCVF_FLOAT __riscv_vfmacc_vf_f32m4 +#define VFNMSACVF_FLOAT __riscv_vfnmsac_vf_f32m4 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m4 +#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f32m1 +#define VFMULVV_FLOAT __riscv_vfmul_vv_f32m4 +#define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f32m1_f32 +#else +#define VSETVL(n) __riscv_vsetvl_e64m4(n) +#define VSETVL_MAX __riscv_vsetvlmax_e64m1() +#define FLOAT_V_T vfloat64m4_t +#define FLOAT_V_T_M1 vfloat64m1_t +#define VLEV_FLOAT __riscv_vle64_v_f64m4 +#define VLSEV_FLOAT __riscv_vlse64_v_f64m4 +#define VSEV_FLOAT __riscv_vse64_v_f64m4 +#define VSSEV_FLOAT __riscv_vsse64_v_f64m4 +#define VFREDSUM_FLOAT __riscv_vfredusum_vs_f64m4_f64m1 +#define VFMACCVV_FLOAT __riscv_vfmacc_vv_f64m4 +#define VFNMSACVV_FLOAT __riscv_vfnmsac_vv_f64m4 +#define VFMACCVF_FLOAT __riscv_vfmacc_vf_f64m4 +#define VFNMSACVF_FLOAT __riscv_vfnmsac_vf_f64m4 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m4 +#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f64m1 +#define VFMULVV_FLOAT __riscv_vfmul_vv_f64m4 +#define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f64m1_f64 +#endif + +int CNAME(BLASLONG m, BLASLONG offset, FLOAT alpha_r, FLOAT alpha_i, + FLOAT *a, BLASLONG lda, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y, FLOAT *buffer) +{ + BLASLONG i, j, k; + BLASLONG ix,iy; + BLASLONG jx,jy; + FLOAT temp1[2]; + FLOAT temp2[2]; + FLOAT *a_ptr = a; + BLASLONG gvl = VSETVL_MAX; + FLOAT_V_T_M1 v_res, v_z0; + v_res = VFMVVF_FLOAT_M1(0, gvl); + v_z0 = VFMVVF_FLOAT_M1(0, gvl); + + + FLOAT_V_T va_r, va_i, vx_r, vx_i, vy_r, vy_i, vr_r, vr_i; + BLASLONG stride_x, stride_y, inc_xv, inc_yv; + + BLASLONG m1 = m - offset; + jx = m1 * inc_x; + jy = m1 * inc_y; + a_ptr += m1 * lda; + stride_x = 2 * inc_x * sizeof(FLOAT); + stride_y = 2 * inc_y * sizeof(FLOAT); + for (j=m1; j 0){ + ix = 0; + iy = 0; + i = 0; + gvl = VSETVL(j); + inc_xv = inc_x * gvl; + inc_yv = inc_y * gvl; + vr_r = VFMVVF_FLOAT(0, gvl); + vr_i = VFMVVF_FLOAT(0, gvl); + for(k = 0; k < j / gvl; k++){ + va_r = VLSEV_FLOAT(&a_ptr[2 * i], 2 * sizeof(FLOAT), gvl); + va_i = VLSEV_FLOAT(&a_ptr[2 * i + 1], 2 * sizeof(FLOAT), gvl); + + vy_r = VLSEV_FLOAT(&y[2 * iy], stride_y, gvl); + vy_i = VLSEV_FLOAT(&y[2 * iy + 1], stride_y, gvl); + + vy_r = VFMACCVF_FLOAT(vy_r, temp1[0], va_r, gvl); + vy_r = VFNMSACVF_FLOAT(vy_r, temp1[1], va_i, gvl); + vy_i = VFMACCVF_FLOAT(vy_i, temp1[0], va_i, gvl); + vy_i = VFMACCVF_FLOAT(vy_i, temp1[1], va_r, gvl); + + VSSEV_FLOAT(&y[2 * iy], stride_y, vy_r, gvl); + VSSEV_FLOAT(&y[2 * iy + 1], stride_y, vy_i, gvl); + + vx_r = VLSEV_FLOAT(&x[2 * ix], stride_x, gvl); + vx_i = VLSEV_FLOAT(&x[2 * ix + 1], stride_x, gvl); + vr_r = VFMACCVV_FLOAT(vr_r, vx_r, va_r, gvl); + vr_r = VFNMSACVV_FLOAT(vr_r, vx_i, va_i, gvl); + vr_i = VFMACCVV_FLOAT(vr_i, vx_r, va_i, gvl); + vr_i = VFMACCVV_FLOAT(vr_i, vx_i, va_r, gvl); + + i += gvl; + ix += inc_xv; + iy += inc_yv; + } + v_res = VFREDSUM_FLOAT(vr_r, v_z0, gvl); + temp2[0] = VFMVFS_FLOAT_M1(v_res); + v_res = VFREDSUM_FLOAT(vr_i, v_z0, gvl); + temp2[1] = VFMVFS_FLOAT_M1(v_res); + + if(i < j){ + gvl = VSETVL(j-i); + vy_r = VLSEV_FLOAT(&y[2 * iy], stride_y, gvl); + vy_i = VLSEV_FLOAT(&y[2 * iy + 1], stride_y, gvl); + + va_r = VLSEV_FLOAT(&a_ptr[2 * i], 2 * sizeof(FLOAT), gvl); + va_i = VLSEV_FLOAT(&a_ptr[2 * i + 1], 2 * sizeof(FLOAT), gvl); + + vy_r = VFMACCVF_FLOAT(vy_r, temp1[0], va_r, gvl); + vy_r = VFNMSACVF_FLOAT(vy_r, temp1[1], va_i, gvl); + vy_i = VFMACCVF_FLOAT(vy_i, temp1[0], va_i, gvl); + vy_i = VFMACCVF_FLOAT(vy_i, temp1[1], va_r, gvl); + + VSSEV_FLOAT(&y[2 * iy], stride_y, vy_r, gvl); + VSSEV_FLOAT(&y[2 * iy + 1], stride_y, vy_i, gvl); + + vx_r = VLSEV_FLOAT(&x[2 * ix], stride_x, gvl); + vx_i = VLSEV_FLOAT(&x[2 * ix + 1], stride_x, gvl); + vr_r = VFMULVV_FLOAT(vx_r, va_r, gvl); + vr_r = VFNMSACVV_FLOAT(vr_r, vx_i, va_i, gvl); + vr_i = VFMULVV_FLOAT(vx_r, va_i, gvl); + vr_i = VFMACCVV_FLOAT(vr_i, vx_i, va_r, gvl); + + v_res = VFREDSUM_FLOAT(vr_r, v_z0, gvl); + temp2[0] += VFMVFS_FLOAT_M1(v_res); + v_res = VFREDSUM_FLOAT(vr_i, v_z0, gvl); + temp2[1] += VFMVFS_FLOAT_M1(v_res); + } + } + + y[2 * jy] += temp1[0] * a_ptr[j * 2] - temp1[1] * a_ptr[j * 2 + 1] + alpha_r * temp2[0] - alpha_i * temp2[1]; + y[2 * jy + 1] += temp1[1] * a_ptr[j * 2] + temp1[0] * a_ptr[j * 2 + 1] + alpha_r * temp2[1] + alpha_i * temp2[0]; + + a_ptr += 2 * lda; + jx += inc_x; + jy += inc_y; + } + + return(0); +} + From d3bf5a5401e623e107a23fb70151c7102cbd14c7 Mon Sep 17 00:00:00 2001 From: sh-zheng <2294474733@qq.com> Date: Mon, 22 May 2023 22:39:45 +0800 Subject: [PATCH 015/311] Combine two reduction operations of zhe/symv into one, with tail undisturbed setted. --- kernel/riscv64/zhemv_LM_rvv.c | 68 +++++++++++++++++------------------ kernel/riscv64/zhemv_UV_rvv.c | 68 +++++++++++++++++------------------ kernel/riscv64/zsymv_L_rvv.c | 50 +++++++++++++------------- kernel/riscv64/zsymv_U_rvv.c | 52 +++++++++++++-------------- 4 files changed, 119 insertions(+), 119 deletions(-) diff --git a/kernel/riscv64/zhemv_LM_rvv.c b/kernel/riscv64/zhemv_LM_rvv.c index e025120e5..95c6a377c 100644 --- a/kernel/riscv64/zhemv_LM_rvv.c +++ b/kernel/riscv64/zhemv_LM_rvv.c @@ -36,12 +36,14 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VSSEV_FLOAT __riscv_vsse32_v_f32m4 #define VFREDSUM_FLOAT __riscv_vfredusum_vs_f32m4_f32m1 #define VFMACCVV_FLOAT __riscv_vfmacc_vv_f32m4 +#define VFMACCVV_FLOAT_TU __riscv_vfmacc_vv_f32m4_tu #define VFMACCVF_FLOAT __riscv_vfmacc_vf_f32m4 #define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m4 #define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f32m1 #define VFMULVV_FLOAT __riscv_vfmul_vv_f32m4 #define VFNMSACVF_FLOAT __riscv_vfnmsac_vf_f32m4 #define VFNMSACVV_FLOAT __riscv_vfnmsac_vv_f32m4 +#define VFNMSACVV_FLOAT_TU __riscv_vfnmsac_vv_f32m4_tu #else #define VSETVL(n) __riscv_vsetvl_e64m4(n) #define VSETVL_MAX __riscv_vsetvlmax_e64m1() @@ -52,12 +54,14 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VSSEV_FLOAT __riscv_vsse64_v_f64m4 #define VFREDSUM_FLOAT __riscv_vfredusum_vs_f64m4_f64m1 #define VFMACCVV_FLOAT __riscv_vfmacc_vv_f64m4 +#define VFMACCVV_FLOAT_TU __riscv_vfmacc_vv_f64m4_tu #define VFMACCVF_FLOAT __riscv_vfmacc_vf_f64m4 #define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m4 #define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f64m1 #define VFMULVV_FLOAT __riscv_vfmul_vv_f64m4 #define VFNMSACVF_FLOAT __riscv_vfnmsac_vf_f64m4 #define VFNMSACVV_FLOAT __riscv_vfnmsac_vv_f64m4 +#define VFNMSACVV_FLOAT_TU __riscv_vfnmsac_vv_f64m4_tu #endif int CNAME(BLASLONG m, BLASLONG offset, FLOAT alpha_r, FLOAT alpha_i, FLOAT *a, BLASLONG lda, FLOAT *x, BLASLONG incx, FLOAT *y, BLASLONG incy, FLOAT *buffer){ @@ -143,49 +147,45 @@ int CNAME(BLASLONG m, BLASLONG offset, FLOAT alpha_r, FLOAT alpha_i, FLOAT *a, B iy += inc_yv; ia += inc_av; } - v_res = VFREDSUM_FLOAT(vr0, v_z0, gvl); - temp_r2 = VFMVFS_FLOAT(v_res); - v_res = VFREDSUM_FLOAT(vr1, v_z0, gvl); - temp_i2 = VFMVFS_FLOAT(v_res); + if(i < m){ - gvl = VSETVL(m-i); - va0 = VLSEV_FLOAT(&a_ptr[ia], stride_a, gvl); - va1 = VLSEV_FLOAT(&a_ptr[ia+1], stride_a, gvl); - vy0 = VLSEV_FLOAT(&y[iy], stride_y, gvl); - vy1 = VLSEV_FLOAT(&y[iy+1], stride_y, gvl); + unsigned int gvl_rem = VSETVL(m-i); + va0 = VLSEV_FLOAT(&a_ptr[ia], stride_a, gvl_rem); + va1 = VLSEV_FLOAT(&a_ptr[ia+1], stride_a, gvl_rem); + vy0 = VLSEV_FLOAT(&y[iy], stride_y, gvl_rem); + vy1 = VLSEV_FLOAT(&y[iy+1], stride_y, gvl_rem); #ifndef HEMVREV - vy0 = VFMACCVF_FLOAT(vy0, temp_r1, va0, gvl); - vy0 = VFNMSACVF_FLOAT(vy0, temp_i1, va1, gvl); - vy1 = VFMACCVF_FLOAT(vy1, temp_r1, va1, gvl); - vy1 = VFMACCVF_FLOAT(vy1, temp_i1, va0, gvl); + vy0 = VFMACCVF_FLOAT(vy0, temp_r1, va0, gvl_rem); + vy0 = VFNMSACVF_FLOAT(vy0, temp_i1, va1, gvl_rem); + vy1 = VFMACCVF_FLOAT(vy1, temp_r1, va1, gvl_rem); + vy1 = VFMACCVF_FLOAT(vy1, temp_i1, va0, gvl_rem); #else - vy0 = VFMACCVF_FLOAT(vy0, temp_r1, va0, gvl); - vy0 = VFMACCVF_FLOAT(vy0, temp_i1, va1, gvl); - vy1 = VFNMSACVF_FLOAT(vy1, temp_r1, va1, gvl); - vy1 = VFMACCVF_FLOAT(vy1, temp_i1, va0, gvl); + vy0 = VFMACCVF_FLOAT(vy0, temp_r1, va0, gvl_rem); + vy0 = VFMACCVF_FLOAT(vy0, temp_i1, va1, gvl_rem); + vy1 = VFNMSACVF_FLOAT(vy1, temp_r1, va1, gvl_rem); + vy1 = VFMACCVF_FLOAT(vy1, temp_i1, va0, gvl_rem); #endif - VSSEV_FLOAT(&y[iy], stride_y, vy0, gvl); - VSSEV_FLOAT(&y[iy+1], stride_y, vy1, gvl); + VSSEV_FLOAT(&y[iy], stride_y, vy0, gvl_rem); + VSSEV_FLOAT(&y[iy+1], stride_y, vy1, gvl_rem); - vx0 = VLSEV_FLOAT(&x[ix], stride_x, gvl); - vx1 = VLSEV_FLOAT(&x[ix+1], stride_x, gvl); + vx0 = VLSEV_FLOAT(&x[ix], stride_x, gvl_rem); + vx1 = VLSEV_FLOAT(&x[ix+1], stride_x, gvl_rem); #ifndef HEMVREV - vr0 = VFMULVV_FLOAT(vx0, va0, gvl); - vr0 = VFMACCVV_FLOAT(vr0, vx1, va1, gvl); - vr1 = VFMULVV_FLOAT(vx1, va0, gvl); - vr1 = VFNMSACVV_FLOAT(vr1, vx0, va1, gvl); + vr0 = VFMACCVV_FLOAT_TU(vr0, vx0, va0, gvl_rem); + vr0 = VFMACCVV_FLOAT_TU(vr0, vx1, va1, gvl_rem); + vr1 = VFMACCVV_FLOAT_TU(vr1, vx1, va0, gvl_rem); + vr1 = VFNMSACVV_FLOAT_TU(vr1, vx0, va1, gvl_rem); #else - vr0 = VFMULVV_FLOAT(vx0, va0, gvl); - vr0 = VFNMSACVV_FLOAT(vr0, vx1, va1, gvl); - vr1 = VFMULVV_FLOAT(vx1, va0, gvl); - vr1 = VFMACCVV_FLOAT(vr1, vx0, va1, gvl); + vr0 = VFMACCVV_FLOAT_TU(vr0, vx0, va0, gvl_rem); + vr0 = VFNMSACVV_FLOAT_TU(vr0, vx1, va1, gvl_rem); + vr1 = VFMACCVV_FLOAT_TU(vr1, vx1, va0, gvl_rem); + vr1 = VFMACCVV_FLOAT_TU(vr1, vx0, va1, gvl_rem); #endif - - v_res = VFREDSUM_FLOAT(vr0, v_z0, gvl); - temp_r2 += VFMVFS_FLOAT(v_res); - v_res = VFREDSUM_FLOAT(vr1, v_z0, gvl); - temp_i2 += VFMVFS_FLOAT(v_res); } + v_res = VFREDSUM_FLOAT(vr0, v_z0, gvl); + temp_r2 = VFMVFS_FLOAT(v_res); + v_res = VFREDSUM_FLOAT(vr1, v_z0, gvl); + temp_i2 = VFMVFS_FLOAT(v_res); } y[jy] += alpha_r * temp_r2 - alpha_i * temp_i2; y[jy+1] += alpha_r * temp_i2 + alpha_i * temp_r2; diff --git a/kernel/riscv64/zhemv_UV_rvv.c b/kernel/riscv64/zhemv_UV_rvv.c index 0e1ea5436..ec06622fc 100644 --- a/kernel/riscv64/zhemv_UV_rvv.c +++ b/kernel/riscv64/zhemv_UV_rvv.c @@ -36,12 +36,14 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VSSEV_FLOAT __riscv_vsse32_v_f32m4 #define VFREDSUM_FLOAT __riscv_vfredusum_vs_f32m4_f32m1 #define VFMACCVV_FLOAT __riscv_vfmacc_vv_f32m4 +#define VFMACCVV_FLOAT_TU __riscv_vfmacc_vv_f32m4_tu #define VFMACCVF_FLOAT __riscv_vfmacc_vf_f32m4 #define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m4 #define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f32m1 #define VFMULVV_FLOAT __riscv_vfmul_vv_f32m4 #define VFNMSACVF_FLOAT __riscv_vfnmsac_vf_f32m4 #define VFNMSACVV_FLOAT __riscv_vfnmsac_vv_f32m4 +#define VFNMSACVV_FLOAT_TU __riscv_vfnmsac_vv_f32m4_tu #else #define VSETVL(n) __riscv_vsetvl_e64m4(n) #define VSETVL_MAX __riscv_vsetvlmax_e64m1() @@ -52,12 +54,14 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VSSEV_FLOAT __riscv_vsse64_v_f64m4 #define VFREDSUM_FLOAT __riscv_vfredusum_vs_f64m4_f64m1 #define VFMACCVV_FLOAT __riscv_vfmacc_vv_f64m4 +#define VFMACCVV_FLOAT_TU __riscv_vfmacc_vv_f64m4_tu #define VFMACCVF_FLOAT __riscv_vfmacc_vf_f64m4 #define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m4 #define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f64m1 #define VFMULVV_FLOAT __riscv_vfmul_vv_f64m4 #define VFNMSACVF_FLOAT __riscv_vfnmsac_vf_f64m4 #define VFNMSACVV_FLOAT __riscv_vfnmsac_vv_f64m4 +#define VFNMSACVV_FLOAT_TU __riscv_vfnmsac_vv_f64m4_tu #endif int CNAME(BLASLONG m, BLASLONG offset, FLOAT alpha_r, FLOAT alpha_i, FLOAT *a, BLASLONG lda, FLOAT *x, BLASLONG incx, FLOAT *y, BLASLONG incy, FLOAT *buffer){ @@ -142,49 +146,45 @@ int CNAME(BLASLONG m, BLASLONG offset, FLOAT alpha_r, FLOAT alpha_i, FLOAT *a, B iy += inc_yv; ia += inc_av; } - v_res = VFREDSUM_FLOAT(vr0, v_z0, gvl); - temp_r2 = VFMVFS_FLOAT(v_res); - v_res = VFREDSUM_FLOAT(vr1, v_z0, gvl); - temp_i2 = VFMVFS_FLOAT(v_res); + if(i < j){ - gvl = VSETVL(j-i); - va0 = VLSEV_FLOAT(&a_ptr[ia], stride_a, gvl); - va1 = VLSEV_FLOAT(&a_ptr[ia+1], stride_a, gvl); - vy0 = VLSEV_FLOAT(&y[iy], stride_y, gvl); - vy1 = VLSEV_FLOAT(&y[iy+1], stride_y, gvl); + unsigned int gvl_rem = VSETVL(j-i); + va0 = VLSEV_FLOAT(&a_ptr[ia], stride_a, gvl_rem); + va1 = VLSEV_FLOAT(&a_ptr[ia+1], stride_a, gvl_rem); + vy0 = VLSEV_FLOAT(&y[iy], stride_y, gvl_rem); + vy1 = VLSEV_FLOAT(&y[iy+1], stride_y, gvl_rem); #ifndef HEMVREV - vy0 = VFMACCVF_FLOAT(vy0, temp_r1, va0, gvl); - vy0 = VFNMSACVF_FLOAT(vy0, temp_i1, va1, gvl); - vy1 = VFMACCVF_FLOAT(vy1, temp_r1, va1, gvl); - vy1 = VFMACCVF_FLOAT(vy1, temp_i1, va0, gvl); + vy0 = VFMACCVF_FLOAT(vy0, temp_r1, va0, gvl_rem); + vy0 = VFNMSACVF_FLOAT(vy0, temp_i1, va1, gvl_rem); + vy1 = VFMACCVF_FLOAT(vy1, temp_r1, va1, gvl_rem); + vy1 = VFMACCVF_FLOAT(vy1, temp_i1, va0, gvl_rem); #else - vy0 = VFMACCVF_FLOAT(vy0, temp_r1, va0, gvl); - vy0 = VFMACCVF_FLOAT(vy0, temp_i1, va1, gvl); - vy1 = VFNMSACVF_FLOAT(vy1, temp_r1, va1, gvl); - vy1 = VFMACCVF_FLOAT(vy1, temp_i1, va0, gvl); + vy0 = VFMACCVF_FLOAT(vy0, temp_r1, va0, gvl_rem); + vy0 = VFMACCVF_FLOAT(vy0, temp_i1, va1, gvl_rem); + vy1 = VFNMSACVF_FLOAT(vy1, temp_r1, va1, gvl_rem); + vy1 = VFMACCVF_FLOAT(vy1, temp_i1, va0, gvl_rem); #endif - VSSEV_FLOAT(&y[iy], stride_y, vy0, gvl); - VSSEV_FLOAT(&y[iy+1], stride_y, vy1, gvl); + VSSEV_FLOAT(&y[iy], stride_y, vy0, gvl_rem); + VSSEV_FLOAT(&y[iy+1], stride_y, vy1, gvl_rem); - vx0 = VLSEV_FLOAT(&x[ix], stride_x, gvl); - vx1 = VLSEV_FLOAT(&x[ix+1], stride_x, gvl); + vx0 = VLSEV_FLOAT(&x[ix], stride_x, gvl_rem); + vx1 = VLSEV_FLOAT(&x[ix+1], stride_x, gvl_rem); #ifndef HEMVREV - vr0 = VFMULVV_FLOAT(vx0, va0, gvl); - vr0 = VFMACCVV_FLOAT(vr0, vx1, va1, gvl); - vr1 = VFMULVV_FLOAT(vx1, va0, gvl); - vr1 = VFNMSACVV_FLOAT(vr1, vx0, va1, gvl); + vr0 = VFMACCVV_FLOAT_TU(vr0, vx0, va0, gvl_rem); + vr0 = VFMACCVV_FLOAT_TU(vr0, vx1, va1, gvl_rem); + vr1 = VFMACCVV_FLOAT_TU(vr1, vx1, va0, gvl_rem); + vr1 = VFNMSACVV_FLOAT_TU(vr1, vx0, va1, gvl_rem); #else - vr0 = VFMULVV_FLOAT(vx0, va0, gvl); - vr0 = VFNMSACVV_FLOAT(vr0, vx1, va1, gvl); - vr1 = VFMULVV_FLOAT(vx1, va0, gvl); - vr1 = VFMACCVV_FLOAT(vr1, vx0, va1, gvl); + vr0 = VFMACCVV_FLOAT_TU(vr0, vx0, va0, gvl_rem); + vr0 = VFNMSACVV_FLOAT_TU(vr0, vx1, va1, gvl_rem); + vr1 = VFMACCVV_FLOAT_TU(vr1, vx1, va0, gvl_rem); + vr1 = VFMACCVV_FLOAT_TU(vr1, vx0, va1, gvl_rem); #endif - - v_res = VFREDSUM_FLOAT(vr0, v_z0, gvl); - temp_r2 += VFMVFS_FLOAT(v_res); - v_res = VFREDSUM_FLOAT(vr1, v_z0, gvl); - temp_i2 += VFMVFS_FLOAT(v_res); } + v_res = VFREDSUM_FLOAT(vr0, v_z0, gvl); + temp_r2 = VFMVFS_FLOAT(v_res); + v_res = VFREDSUM_FLOAT(vr1, v_z0, gvl); + temp_i2 = VFMVFS_FLOAT(v_res); } y[jy] += temp_r1 * a_ptr[ja]; y[jy+1] += temp_i1 * a_ptr[ja]; diff --git a/kernel/riscv64/zsymv_L_rvv.c b/kernel/riscv64/zsymv_L_rvv.c index 3bf621094..cefdea7f6 100644 --- a/kernel/riscv64/zsymv_L_rvv.c +++ b/kernel/riscv64/zsymv_L_rvv.c @@ -38,6 +38,8 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VFREDSUM_FLOAT __riscv_vfredusum_vs_f32m4_f32m1 #define VFMACCVV_FLOAT __riscv_vfmacc_vv_f32m4 #define VFNMSACVV_FLOAT __riscv_vfnmsac_vv_f32m4 +#define VFMACCVV_FLOAT_TU __riscv_vfmacc_vv_f32m4_tu +#define VFNMSACVV_FLOAT_TU __riscv_vfnmsac_vv_f32m4_tu #define VFMACCVF_FLOAT __riscv_vfmacc_vf_f32m4 #define VFNMSACVF_FLOAT __riscv_vfnmsac_vf_f32m4 #define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m4 @@ -57,6 +59,8 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VFREDSUM_FLOAT __riscv_vfredusum_vs_f64m4_f64m1 #define VFMACCVV_FLOAT __riscv_vfmacc_vv_f64m4 #define VFNMSACVV_FLOAT __riscv_vfnmsac_vv_f64m4 +#define VFMACCVV_FLOAT_TU __riscv_vfmacc_vv_f64m4_tu +#define VFNMSACVV_FLOAT_TU __riscv_vfnmsac_vv_f64m4_tu #define VFMACCVF_FLOAT __riscv_vfmacc_vf_f64m4 #define VFNMSACVF_FLOAT __riscv_vfnmsac_vf_f64m4 #define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m4 @@ -133,38 +137,34 @@ int CNAME(BLASLONG m, BLASLONG offset, FLOAT alpha_r, FLOAT alpha_i, ix += inc_xv; iy += inc_yv; } - v_res = VFREDSUM_FLOAT(vr_r, v_z0, gvl); - temp2[0] = VFMVFS_FLOAT_M1(v_res); - v_res = VFREDSUM_FLOAT(vr_i, v_z0, gvl); - temp2[1] = VFMVFS_FLOAT_M1(v_res); if(i < m){ - gvl = VSETVL(m-i); - vy_r = VLSEV_FLOAT(&y[2 * iy], stride_y, gvl); - vy_i = VLSEV_FLOAT(&y[2 * iy + 1], stride_y, gvl); - va_r = VLSEV_FLOAT(&a_ptr[2 * i], 2 * sizeof(FLOAT), gvl); - va_i = VLSEV_FLOAT(&a_ptr[2 * i + 1], 2 * sizeof(FLOAT), gvl); + unsigned int gvl_rem = VSETVL(m-i); + vy_r = VLSEV_FLOAT(&y[2 * iy], stride_y, gvl_rem); + vy_i = VLSEV_FLOAT(&y[2 * iy + 1], stride_y, gvl_rem); + va_r = VLSEV_FLOAT(&a_ptr[2 * i], 2 * sizeof(FLOAT), gvl_rem); + va_i = VLSEV_FLOAT(&a_ptr[2 * i + 1], 2 * sizeof(FLOAT), gvl_rem); - vy_r = VFMACCVF_FLOAT(vy_r, temp1[0], va_r, gvl); - vy_r = VFNMSACVF_FLOAT(vy_r, temp1[1], va_i, gvl); - vy_i = VFMACCVF_FLOAT(vy_i, temp1[0], va_i, gvl); - vy_i = VFMACCVF_FLOAT(vy_i, temp1[1], va_r, gvl); + vy_r = VFMACCVF_FLOAT(vy_r, temp1[0], va_r, gvl_rem); + vy_r = VFNMSACVF_FLOAT(vy_r, temp1[1], va_i, gvl_rem); + vy_i = VFMACCVF_FLOAT(vy_i, temp1[0], va_i, gvl_rem); + vy_i = VFMACCVF_FLOAT(vy_i, temp1[1], va_r, gvl_rem); - VSSEV_FLOAT(&y[2 * iy], stride_y, vy_r, gvl); - VSSEV_FLOAT(&y[2 * iy + 1], stride_y, vy_i, gvl); + VSSEV_FLOAT(&y[2 * iy], stride_y, vy_r, gvl_rem); + VSSEV_FLOAT(&y[2 * iy + 1], stride_y, vy_i, gvl_rem); - vx_r = VLSEV_FLOAT(&x[2 * ix], stride_x, gvl); - vx_i = VLSEV_FLOAT(&x[2 * ix + 1], stride_x, gvl); - vr_r = VFMULVV_FLOAT(vx_r, va_r, gvl); - vr_r = VFNMSACVV_FLOAT(vr_r, vx_i, va_i, gvl); - vr_i = VFMULVV_FLOAT(vx_r, va_i, gvl); - vr_i = VFMACCVV_FLOAT(vr_i, vx_i, va_r, gvl); + vx_r = VLSEV_FLOAT(&x[2 * ix], stride_x, gvl_rem); + vx_i = VLSEV_FLOAT(&x[2 * ix + 1], stride_x, gvl_rem); + vr_r = VFMACCVV_FLOAT_TU(vr_r, vx_r, va_r, gvl_rem); + vr_r = VFNMSACVV_FLOAT_TU(vr_r, vx_i, va_i, gvl_rem); + vr_i = VFMACCVV_FLOAT_TU(vr_i, vx_r, va_i, gvl_rem); + vr_i = VFMACCVV_FLOAT_TU(vr_i, vx_i, va_r, gvl_rem); - v_res = VFREDSUM_FLOAT(vr_r, v_z0, gvl); - temp2[0] += VFMVFS_FLOAT_M1(v_res); - v_res = VFREDSUM_FLOAT(vr_i, v_z0, gvl); - temp2[1] += VFMVFS_FLOAT_M1(v_res); } + v_res = VFREDSUM_FLOAT(vr_r, v_z0, gvl); + temp2[0] = VFMVFS_FLOAT_M1(v_res); + v_res = VFREDSUM_FLOAT(vr_i, v_z0, gvl); + temp2[1] = VFMVFS_FLOAT_M1(v_res); } y[2 * jy] += alpha_r * temp2[0] - alpha_i * temp2[1]; y[2 * jy + 1] += alpha_r * temp2[1] + alpha_i * temp2[0]; diff --git a/kernel/riscv64/zsymv_U_rvv.c b/kernel/riscv64/zsymv_U_rvv.c index de1564f75..67b5a649c 100644 --- a/kernel/riscv64/zsymv_U_rvv.c +++ b/kernel/riscv64/zsymv_U_rvv.c @@ -38,6 +38,8 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VFREDSUM_FLOAT __riscv_vfredusum_vs_f32m4_f32m1 #define VFMACCVV_FLOAT __riscv_vfmacc_vv_f32m4 #define VFNMSACVV_FLOAT __riscv_vfnmsac_vv_f32m4 +#define VFMACCVV_FLOAT_TU __riscv_vfmacc_vv_f32m4_tu +#define VFNMSACVV_FLOAT_TU __riscv_vfnmsac_vv_f32m4_tu #define VFMACCVF_FLOAT __riscv_vfmacc_vf_f32m4 #define VFNMSACVF_FLOAT __riscv_vfnmsac_vf_f32m4 #define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m4 @@ -56,6 +58,8 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VFREDSUM_FLOAT __riscv_vfredusum_vs_f64m4_f64m1 #define VFMACCVV_FLOAT __riscv_vfmacc_vv_f64m4 #define VFNMSACVV_FLOAT __riscv_vfnmsac_vv_f64m4 +#define VFMACCVV_FLOAT_TU __riscv_vfmacc_vv_f64m4_tu +#define VFNMSACVV_FLOAT_TU __riscv_vfnmsac_vv_f64m4_tu #define VFMACCVF_FLOAT __riscv_vfmacc_vf_f64m4 #define VFNMSACVF_FLOAT __riscv_vfnmsac_vf_f64m4 #define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m4 @@ -129,39 +133,35 @@ int CNAME(BLASLONG m, BLASLONG offset, FLOAT alpha_r, FLOAT alpha_i, ix += inc_xv; iy += inc_yv; } - v_res = VFREDSUM_FLOAT(vr_r, v_z0, gvl); - temp2[0] = VFMVFS_FLOAT_M1(v_res); - v_res = VFREDSUM_FLOAT(vr_i, v_z0, gvl); - temp2[1] = VFMVFS_FLOAT_M1(v_res); if(i < j){ - gvl = VSETVL(j-i); - vy_r = VLSEV_FLOAT(&y[2 * iy], stride_y, gvl); - vy_i = VLSEV_FLOAT(&y[2 * iy + 1], stride_y, gvl); + unsigned int gvl_rem = VSETVL(j-i); + vy_r = VLSEV_FLOAT(&y[2 * iy], stride_y, gvl_rem); + vy_i = VLSEV_FLOAT(&y[2 * iy + 1], stride_y, gvl_rem); - va_r = VLSEV_FLOAT(&a_ptr[2 * i], 2 * sizeof(FLOAT), gvl); - va_i = VLSEV_FLOAT(&a_ptr[2 * i + 1], 2 * sizeof(FLOAT), gvl); + va_r = VLSEV_FLOAT(&a_ptr[2 * i], 2 * sizeof(FLOAT), gvl_rem); + va_i = VLSEV_FLOAT(&a_ptr[2 * i + 1], 2 * sizeof(FLOAT), gvl_rem); - vy_r = VFMACCVF_FLOAT(vy_r, temp1[0], va_r, gvl); - vy_r = VFNMSACVF_FLOAT(vy_r, temp1[1], va_i, gvl); - vy_i = VFMACCVF_FLOAT(vy_i, temp1[0], va_i, gvl); - vy_i = VFMACCVF_FLOAT(vy_i, temp1[1], va_r, gvl); + vy_r = VFMACCVF_FLOAT(vy_r, temp1[0], va_r, gvl_rem); + vy_r = VFNMSACVF_FLOAT(vy_r, temp1[1], va_i, gvl_rem); + vy_i = VFMACCVF_FLOAT(vy_i, temp1[0], va_i, gvl_rem); + vy_i = VFMACCVF_FLOAT(vy_i, temp1[1], va_r, gvl_rem); - VSSEV_FLOAT(&y[2 * iy], stride_y, vy_r, gvl); - VSSEV_FLOAT(&y[2 * iy + 1], stride_y, vy_i, gvl); + VSSEV_FLOAT(&y[2 * iy], stride_y, vy_r, gvl_rem); + VSSEV_FLOAT(&y[2 * iy + 1], stride_y, vy_i, gvl_rem); - vx_r = VLSEV_FLOAT(&x[2 * ix], stride_x, gvl); - vx_i = VLSEV_FLOAT(&x[2 * ix + 1], stride_x, gvl); - vr_r = VFMULVV_FLOAT(vx_r, va_r, gvl); - vr_r = VFNMSACVV_FLOAT(vr_r, vx_i, va_i, gvl); - vr_i = VFMULVV_FLOAT(vx_r, va_i, gvl); - vr_i = VFMACCVV_FLOAT(vr_i, vx_i, va_r, gvl); + vx_r = VLSEV_FLOAT(&x[2 * ix], stride_x, gvl_rem); + vx_i = VLSEV_FLOAT(&x[2 * ix + 1], stride_x, gvl_rem); + vr_r = VFMACCVV_FLOAT_TU(vr_r, vx_r, va_r, gvl_rem); + vr_r = VFNMSACVV_FLOAT_TU(vr_r, vx_i, va_i, gvl_rem); + vr_i = VFMACCVV_FLOAT_TU(vr_i, vx_r, va_i, gvl_rem); + vr_i = VFMACCVV_FLOAT_TU(vr_i, vx_i, va_r, gvl_rem); - v_res = VFREDSUM_FLOAT(vr_r, v_z0, gvl); - temp2[0] += VFMVFS_FLOAT_M1(v_res); - v_res = VFREDSUM_FLOAT(vr_i, v_z0, gvl); - temp2[1] += VFMVFS_FLOAT_M1(v_res); - } + } + v_res = VFREDSUM_FLOAT(vr_r, v_z0, gvl); + temp2[0] = VFMVFS_FLOAT_M1(v_res); + v_res = VFREDSUM_FLOAT(vr_i, v_z0, gvl); + temp2[1] = VFMVFS_FLOAT_M1(v_res); } y[2 * jy] += temp1[0] * a_ptr[j * 2] - temp1[1] * a_ptr[j * 2 + 1] + alpha_r * temp2[0] - alpha_i * temp2[1]; From 0954746380a54c4f5c45f892dabef6b7c9aa93c3 Mon Sep 17 00:00:00 2001 From: Heller Zheng Date: Sun, 4 Jun 2023 20:06:58 -0700 Subject: [PATCH 016/311] remove argument unused during compilation. fix wrong vr = VFMVVF_FLOAT(0, vl); --- Makefile.riscv64 | 2 +- kernel/riscv64/symv_L_rvv.c | 4 ---- kernel/riscv64/symv_U_rvv.c | 4 ---- 3 files changed, 1 insertion(+), 9 deletions(-) diff --git a/Makefile.riscv64 b/Makefile.riscv64 index d091984a6..ce7a27141 100644 --- a/Makefile.riscv64 +++ b/Makefile.riscv64 @@ -3,7 +3,7 @@ CCOMMON_OPT += -march=rv64imafdcv0p7_zfh_xtheadc -mabi=lp64d -mtune=c920 FCOMMON_OPT += -march=rv64imafdcv0p7_zfh_xtheadc -mabi=lp64d -mtune=c920 -static endif ifeq ($(CORE), x280) -CCOMMON_OPT += -march=rv64imafdcv_zba_zbb_zfh -mabi=lp64d -mllvm --riscv-v-vector-bits-min=512 -ffast-math +CCOMMON_OPT += -march=rv64imafdcv_zba_zbb_zfh_zvl512b -mabi=lp64d -ffast-math FCOMMON_OPT += -march=rv64imafdcv_zba_zbb_zfh -mabi=lp64d -static endif ifeq ($(CORE), RISCV64_GENERIC) diff --git a/kernel/riscv64/symv_L_rvv.c b/kernel/riscv64/symv_L_rvv.c index e87ab22ae..b27db2e37 100644 --- a/kernel/riscv64/symv_L_rvv.c +++ b/kernel/riscv64/symv_L_rvv.c @@ -94,7 +94,6 @@ int CNAME(BLASLONG m, BLASLONG offset, FLOAT alpha, FLOAT *a, BLASLONG lda, FLOA for (k = (m-i); k > 0; k -= vl, i += vl) { vl = VSETVL(k); - vr = VFMVVF_FLOAT(0, vl); va = VLEV_FLOAT(&a_ptr[i], vl); vy = VLEV_FLOAT(&y[i], vl); vy = VFMACCVF_FLOAT(vy, temp1, va, vl); @@ -125,7 +124,6 @@ int CNAME(BLASLONG m, BLASLONG offset, FLOAT alpha, FLOAT *a, BLASLONG lda, FLOA { vl = VSETVL(k); inc_yv = inc_y * vl; - vr = VFMVVF_FLOAT(0, vl); va = VLEV_FLOAT(&a_ptr[i], vl); vy = VLSEV_FLOAT(&y[iy], stride_y, vl); vy = VFMACCVF_FLOAT(vy, temp1, va, vl); @@ -157,7 +155,6 @@ int CNAME(BLASLONG m, BLASLONG offset, FLOAT alpha, FLOAT *a, BLASLONG lda, FLOA for (k = (m-i); k > 0; k -= vl, i += vl) { vl = VSETVL(k); - vr = VFMVVF_FLOAT(0, vl); inc_xv = inc_x * vl; va = VLEV_FLOAT(&a_ptr[i], vl); @@ -197,7 +194,6 @@ int CNAME(BLASLONG m, BLASLONG offset, FLOAT alpha, FLOAT *a, BLASLONG lda, FLOA vl = VSETVL(k); inc_xv = inc_x * vl; inc_yv = inc_y * vl; - vr = VFMVVF_FLOAT(0, vl); va = VLEV_FLOAT(&a_ptr[i], vl); vy = VLSEV_FLOAT(&y[iy], stride_y, vl); diff --git a/kernel/riscv64/symv_U_rvv.c b/kernel/riscv64/symv_U_rvv.c index 3fbc33c89..7e45b1a01 100644 --- a/kernel/riscv64/symv_U_rvv.c +++ b/kernel/riscv64/symv_U_rvv.c @@ -95,7 +95,6 @@ int CNAME(BLASLONG m, BLASLONG offset, FLOAT alpha, FLOAT *a, BLASLONG lda, FLOA for (k = j; k > 0; k -= vl, i += vl) { vl = VSETVL(k); - vr = VFMVVF_FLOAT(0, vl); vy = VLEV_FLOAT(&y[i], vl); va = VLEV_FLOAT(&a_ptr[i], vl); vy = VFMACCVF_FLOAT(vy, temp1, va, vl); @@ -125,7 +124,6 @@ int CNAME(BLASLONG m, BLASLONG offset, FLOAT alpha, FLOAT *a, BLASLONG lda, FLOA { vl = VSETVL(k); inc_yv = inc_y * vl; - vr = VFMVVF_FLOAT(0, vl); vy = VLSEV_FLOAT(&y[iy], stride_y, vl); va = VLEV_FLOAT(&a_ptr[i], vl); vy = VFMACCVF_FLOAT(vy, temp1, va, vl); @@ -158,7 +156,6 @@ int CNAME(BLASLONG m, BLASLONG offset, FLOAT alpha, FLOAT *a, BLASLONG lda, FLOA { vl = VSETVL(k); inc_xv = inc_x * vl; - vr = VFMVVF_FLOAT(0, vl); vy = VLEV_FLOAT(&y[i], vl); va = VLEV_FLOAT(&a_ptr[i], vl); @@ -197,7 +194,6 @@ int CNAME(BLASLONG m, BLASLONG offset, FLOAT alpha, FLOAT *a, BLASLONG lda, FLOA vl = VSETVL(k); inc_xv = inc_x * vl; inc_yv = inc_y * vl; - vr = VFMVVF_FLOAT(0, vl); vy = VLSEV_FLOAT(&y[iy], stride_y, vl); va = VLEV_FLOAT(&a_ptr[i], vl); vy = VFMACCVF_FLOAT(vy, temp1, va, vl); From e1958eb70529c36d7dc4f3baf9e7bf37524053ab Mon Sep 17 00:00:00 2001 From: Octavian Maghiar Date: Wed, 5 Jul 2023 11:34:00 +0100 Subject: [PATCH 017/311] Fixes RVV masked intrinsics for iamax/iamin/imax/imin kernels Changes masked intrinsics from _m to _mu and reintroduces maskedoff argument. --- kernel/riscv64/iamax_rvv.c | 16 ++++++++-------- kernel/riscv64/iamin_rvv.c | 16 ++++++++-------- kernel/riscv64/imax_rvv.c | 16 ++++++++-------- kernel/riscv64/imin_rvv.c | 16 ++++++++-------- 4 files changed, 32 insertions(+), 32 deletions(-) diff --git a/kernel/riscv64/iamax_rvv.c b/kernel/riscv64/iamax_rvv.c index ef7850a55..d3508a91d 100644 --- a/kernel/riscv64/iamax_rvv.c +++ b/kernel/riscv64/iamax_rvv.c @@ -45,9 +45,9 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VFMAXVV_FLOAT __riscv_vfmax_vv_f64m8 #define VFIRSTM __riscv_vfirst_m_b8 #define UINT_V_T vuint64m8_t -#define VIDV_MASK_UINT __riscv_vid_v_u64m8_m +#define VIDV_MASK_UINT __riscv_vid_v_u64m8_mu #define VIDV_UINT __riscv_vid_v_u64m8 -#define VADDVX_MASK_UINT __riscv_vadd_vx_u64m8_m +#define VADDVX_MASK_UINT __riscv_vadd_vx_u64m8_mu #define VADDVX_UINT __riscv_vadd_vx_u64m8 #define VMVVX_UINT __riscv_vmv_v_x_u64m8 #define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f64m1_f64 @@ -71,9 +71,9 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VFMAXVV_FLOAT __riscv_vfmax_vv_f32m8 #define VFIRSTM __riscv_vfirst_m_b4 #define UINT_V_T vuint32m8_t -#define VIDV_MASK_UINT __riscv_vid_v_u32m8_m +#define VIDV_MASK_UINT __riscv_vid_v_u32m8_mu #define VIDV_UINT __riscv_vid_v_u32m8 -#define VADDVX_MASK_UINT __riscv_vadd_vx_u32m8_m +#define VADDVX_MASK_UINT __riscv_vadd_vx_u32m8_mu #define VADDVX_UINT __riscv_vadd_vx_u32m8 #define VMVVX_UINT __riscv_vmv_v_x_u32m8 #define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f32m1_f32 @@ -106,8 +106,8 @@ BLASLONG CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) //index where element greater than v_max mask = VMFLTVV_FLOAT(v_max, vx, vl); - v_max_index = VIDV_MASK_UINT(mask, vl); - v_max_index = VADDVX_MASK_UINT(mask, v_max_index, j, vl); + v_max_index = VIDV_MASK_UINT(mask, v_max_index, vl); + v_max_index = VADDVX_MASK_UINT(mask, v_max_index, v_max_index, j, vl); //update v_max v_max = VFMAXVV_FLOAT(v_max, vx, vl); @@ -125,8 +125,8 @@ BLASLONG CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) //index where element greater than v_max mask = VMFLTVV_FLOAT(v_max, vx, vl); - v_max_index = VIDV_MASK_UINT(mask, vl); - v_max_index = VADDVX_MASK_UINT(mask, v_max_index, j, vl); + v_max_index = VIDV_MASK_UINT(mask, v_max_index, vl); + v_max_index = VADDVX_MASK_UINT(mask, v_max_index, v_max_index, j, vl); //update v_max v_max = VFMAXVV_FLOAT(v_max, vx, vl); diff --git a/kernel/riscv64/iamin_rvv.c b/kernel/riscv64/iamin_rvv.c index 56a086fed..ae1d4f726 100644 --- a/kernel/riscv64/iamin_rvv.c +++ b/kernel/riscv64/iamin_rvv.c @@ -46,9 +46,9 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VFMINVV_FLOAT __riscv_vfmin_vv_f64m8 #define VFIRSTM __riscv_vfirst_m_b8 #define UINT_V_T vuint64m8_t -#define VIDV_MASK_UINT __riscv_vid_v_u64m8_m +#define VIDV_MASK_UINT __riscv_vid_v_u64m8_mu #define VIDV_UINT __riscv_vid_v_u64m8 -#define VADDVX_MASK_UINT __riscv_vadd_vx_u64m8_m +#define VADDVX_MASK_UINT __riscv_vadd_vx_u64m8_mu #define VADDVX_UINT __riscv_vadd_vx_u64m8 #define VMVVX_UINT __riscv_vmv_v_x_u64m8 #define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f64m1_f64 @@ -72,9 +72,9 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VFMINVV_FLOAT __riscv_vfmin_vv_f32m8 #define VFIRSTM __riscv_vfirst_m_b4 #define UINT_V_T vuint32m8_t -#define VIDV_MASK_UINT __riscv_vid_v_u32m8_m +#define VIDV_MASK_UINT __riscv_vid_v_u32m8_mu #define VIDV_UINT __riscv_vid_v_u32m8 -#define VADDVX_MASK_UINT __riscv_vadd_vx_u32m8_m +#define VADDVX_MASK_UINT __riscv_vadd_vx_u32m8_mu #define VADDVX_UINT __riscv_vadd_vx_u32m8 #define VMVVX_UINT __riscv_vmv_v_x_u32m8 #define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f32m1_f32 @@ -107,8 +107,8 @@ BLASLONG CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) // index where element less than v_min mask = VMFLTVV_FLOAT(vx, v_min, vl); - v_min_index = VIDV_MASK_UINT(mask, vl); - v_min_index = VADDVX_MASK_UINT(mask, v_min_index, j, vl); + v_min_index = VIDV_MASK_UINT(mask, v_min_index, vl); + v_min_index = VADDVX_MASK_UINT(mask, v_min_index, v_min_index, j, vl); //update v_min and start_index j v_min = VFMINVV_FLOAT(v_min, vx, vl); @@ -126,8 +126,8 @@ BLASLONG CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) // index where element less than v_min mask = VMFLTVV_FLOAT(vx, v_min, vl); - v_min_index = VIDV_MASK_UINT(mask, vl); - v_min_index = VADDVX_MASK_UINT(mask, v_min_index, j, vl); + v_min_index = VIDV_MASK_UINT(mask, v_min_index, vl); + v_min_index = VADDVX_MASK_UINT(mask, v_min_index, v_min_index, j, vl); //update v_min and start_index j v_min = VFMINVV_FLOAT(v_min, vx, vl); diff --git a/kernel/riscv64/imax_rvv.c b/kernel/riscv64/imax_rvv.c index 5b60a56f7..33250568d 100644 --- a/kernel/riscv64/imax_rvv.c +++ b/kernel/riscv64/imax_rvv.c @@ -45,9 +45,9 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VFMAXVV_FLOAT __riscv_vfmax_vv_f64m8 #define VFIRSTM __riscv_vfirst_m_b8 #define UINT_V_T vuint64m8_t -#define VIDV_MASK_UINT __riscv_vid_v_u64m8_m +#define VIDV_MASK_UINT __riscv_vid_v_u64m8_mu #define VIDV_UINT __riscv_vid_v_u64m8 -#define VADDVX_MASK_UINT __riscv_vadd_vx_u64m8_m +#define VADDVX_MASK_UINT __riscv_vadd_vx_u64m8_mu #define VADDVX_UINT __riscv_vadd_vx_u64m8 #define VMVVX_UINT __riscv_vmv_v_x_u64m8 #define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f64m1_f64 @@ -70,9 +70,9 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VFMAXVV_FLOAT __riscv_vfmax_vv_f32m8 #define VFIRSTM __riscv_vfirst_m_b4 #define UINT_V_T vuint32m8_t -#define VIDV_MASK_UINT __riscv_vid_v_u32m8_m +#define VIDV_MASK_UINT __riscv_vid_v_u32m8_mu #define VIDV_UINT __riscv_vid_v_u32m8 -#define VADDVX_MASK_UINT __riscv_vadd_vx_u32m8_m +#define VADDVX_MASK_UINT __riscv_vadd_vx_u32m8_mu #define VADDVX_UINT __riscv_vadd_vx_u32m8 #define VMVVX_UINT __riscv_vmv_v_x_u32m8 #define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f32m1_f32 @@ -104,8 +104,8 @@ BLASLONG CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) //index where element greater than v_max mask = VMFLTVV_FLOAT(v_max, vx, vl); - v_max_index = VIDV_MASK_UINT(mask, vl); - v_max_index = VADDVX_MASK_UINT(mask, v_max_index, j, vl); + v_max_index = VIDV_MASK_UINT(mask, v_max_index, vl); + v_max_index = VADDVX_MASK_UINT(mask, v_max_index, v_max_index, j, vl); //update v_max and start_index j v_max = VFMAXVV_FLOAT(v_max, vx, vl); @@ -122,8 +122,8 @@ BLASLONG CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) //index where element greater than v_max mask = VMFLTVV_FLOAT(v_max, vx, vl); - v_max_index = VIDV_MASK_UINT(mask, vl); - v_max_index = VADDVX_MASK_UINT(mask, v_max_index, j, vl); + v_max_index = VIDV_MASK_UINT(mask, v_max_index, vl); + v_max_index = VADDVX_MASK_UINT(mask, v_max_index, v_max_index, j, vl); //update v_max and start_index j v_max = VFMAXVV_FLOAT(v_max, vx, vl); diff --git a/kernel/riscv64/imin_rvv.c b/kernel/riscv64/imin_rvv.c index b49544a1b..4ce49c3af 100644 --- a/kernel/riscv64/imin_rvv.c +++ b/kernel/riscv64/imin_rvv.c @@ -45,9 +45,9 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VFMINVV_FLOAT __riscv_vfmin_vv_f64m8 #define VFIRSTM __riscv_vfirst_m_b8 #define UINT_V_T vuint64m8_t -#define VIDV_MASK_UINT __riscv_vid_v_u64m8_m +#define VIDV_MASK_UINT __riscv_vid_v_u64m8_mu #define VIDV_UINT __riscv_vid_v_u64m8 -#define VADDVX_MASK_UINT __riscv_vadd_vx_u64m8_m +#define VADDVX_MASK_UINT __riscv_vadd_vx_u64m8_mu #define VADDVX_UINT __riscv_vadd_vx_u64m8 #define VMVVX_UINT __riscv_vmv_v_x_u64m8 #define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f64m1_f64 @@ -70,9 +70,9 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VFMINVV_FLOAT __riscv_vfmin_vv_f32m8 #define VFIRSTM __riscv_vfirst_m_b4 #define UINT_V_T vuint32m8_t -#define VIDV_MASK_UINT __riscv_vid_v_u32m8_m +#define VIDV_MASK_UINT __riscv_vid_v_u32m8_mu #define VIDV_UINT __riscv_vid_v_u32m8 -#define VADDVX_MASK_UINT __riscv_vadd_vx_u32m8_m +#define VADDVX_MASK_UINT __riscv_vadd_vx_u32m8_mu #define VADDVX_UINT __riscv_vadd_vx_u32m8 #define VMVVX_UINT __riscv_vmv_v_x_u32m8 #define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f32m1_f32 @@ -104,8 +104,8 @@ BLASLONG CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) // index where element less than v_min mask = VMFLTVV_FLOAT(vx, v_min, vl); - v_min_index = VIDV_MASK_UINT(mask, vl); - v_min_index = VADDVX_MASK_UINT(mask, v_min_index, j, vl); + v_min_index = VIDV_MASK_UINT(mask, v_min_index, vl); + v_min_index = VADDVX_MASK_UINT(mask, v_min_index, v_min_index, j, vl); //update v_min and start_index j v_min = VFMINVV_FLOAT(v_min, vx, vl); @@ -122,8 +122,8 @@ BLASLONG CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) // index where element less than v_min mask = VMFLTVV_FLOAT(vx, v_min, vl); - v_min_index = VIDV_MASK_UINT(mask, vl); - v_min_index = VADDVX_MASK_UINT(mask, v_min_index, j, vl); + v_min_index = VIDV_MASK_UINT(mask, v_min_index, vl); + v_min_index = VADDVX_MASK_UINT(mask, v_min_index, v_min_index, j, vl); //update v_min and start_index j v_min = VFMINVV_FLOAT(v_min, vx, vl); From 1e4a3a2b5e111a6a94eb53946fa92c1715c5dd5e Mon Sep 17 00:00:00 2001 From: Octavian Maghiar Date: Wed, 12 Jul 2023 12:55:50 +0100 Subject: [PATCH 018/311] Fixes RVV masked intrinsics for izamax/izamin kernels --- kernel/riscv64/izamax_rvv.c | 18 +++++++++--------- kernel/riscv64/izamin_rvv.c | 16 ++++++++-------- 2 files changed, 17 insertions(+), 17 deletions(-) diff --git a/kernel/riscv64/izamax_rvv.c b/kernel/riscv64/izamax_rvv.c index e61d0cbec..e43ded820 100644 --- a/kernel/riscv64/izamax_rvv.c +++ b/kernel/riscv64/izamax_rvv.c @@ -48,9 +48,9 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VFADDVV_FLOAT __riscv_vfadd_vv_f64m4 #define VFIRSTM __riscv_vfirst_m_b16 #define UINT_V_T vuint64m4_t -#define VIDV_MASK_UINT __riscv_vid_v_u64m4_m +#define VIDV_MASK_UINT __riscv_vid_v_u64m4_mu #define VIDV_UINT __riscv_vid_v_u64m4 -#define VADDVX_MASK_UINT __riscv_vadd_vx_u64m4_m +#define VADDVX_MASK_UINT __riscv_vadd_vx_u64m4_mu #define VADDVX_UINT __riscv_vadd_vx_u64m4 #define VMVVX_UINT __riscv_vmv_v_x_u64m4 #define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f64m1_f64 @@ -77,9 +77,9 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VFADDVV_FLOAT __riscv_vfadd_vv_f32m4 #define VFIRSTM __riscv_vfirst_m_b8 #define UINT_V_T vuint32m4_t -#define VIDV_MASK_UINT __riscv_vid_v_u32m4_m +#define VIDV_MASK_UINT __riscv_vid_v_u32m4_mu #define VIDV_UINT __riscv_vid_v_u32m4 -#define VADDVX_MASK_UINT __riscv_vadd_vx_u32m4_m +#define VADDVX_MASK_UINT __riscv_vadd_vx_u32m4_mu #define VADDVX_UINT __riscv_vadd_vx_u32m4 #define VMVVX_UINT __riscv_vmv_v_x_u32m4 #define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f32m1_f32 @@ -116,8 +116,8 @@ BLASLONG CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) //index where element greater than v_max mask = VMFLTVV_FLOAT(v_max, vx0, vl); - v_max_index = VIDV_MASK_UINT(mask, vl); - v_max_index = VADDVX_MASK_UINT(mask, v_max_index, j, vl); + v_max_index = VIDV_MASK_UINT(mask, v_max_index, vl); + v_max_index = VADDVX_MASK_UINT(mask, v_max_index, v_max_index, j, vl); //update v_max and start_index j v_max = VFMAXVV_FLOAT(v_max, vx0, vl); @@ -138,9 +138,9 @@ BLASLONG CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) //index where element greater than v_max mask = VMFLTVV_FLOAT(v_max, vx0, vl); - v_max_index = VIDV_MASK_UINT(mask, vl); - v_max_index = VADDVX_MASK_UINT(mask, v_max_index, j, vl); - + v_max_index = VIDV_MASK_UINT(mask, v_max_index, vl); + v_max_index = VADDVX_MASK_UINT(mask, v_max_index, v_max_index, j, vl); + //update v_max and start_index j v_max = VFMAXVV_FLOAT(v_max, vx0, vl); } diff --git a/kernel/riscv64/izamin_rvv.c b/kernel/riscv64/izamin_rvv.c index 297b3c99a..cc3c37c8e 100644 --- a/kernel/riscv64/izamin_rvv.c +++ b/kernel/riscv64/izamin_rvv.c @@ -47,9 +47,9 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VFADDVV_FLOAT __riscv_vfadd_vv_f64m4 #define VFIRSTM __riscv_vfirst_m_b16 #define UINT_V_T vuint64m4_t -#define VIDV_MASK_UINT __riscv_vid_v_u64m4_m +#define VIDV_MASK_UINT __riscv_vid_v_u64m4_mu #define VIDV_UINT __riscv_vid_v_u64m4 -#define VADDVX_MASK_UINT __riscv_vadd_vx_u64m4_m +#define VADDVX_MASK_UINT __riscv_vadd_vx_u64m4_mu #define VADDVX_UINT __riscv_vadd_vx_u64m4 #define VMVVX_UINT __riscv_vmv_v_x_u64m4 #define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f64m1_f64 @@ -74,9 +74,9 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VFADDVV_FLOAT __riscv_vfadd_vv_f32m4 #define VFIRSTM __riscv_vfirst_m_b8 #define UINT_V_T vuint32m4_t -#define VIDV_MASK_UINT __riscv_vid_v_u32m4_m +#define VIDV_MASK_UINT __riscv_vid_v_u32m4_mu #define VIDV_UINT __riscv_vid_v_u32m4 -#define VADDVX_MASK_UINT __riscv_vadd_vx_u32m4_m +#define VADDVX_MASK_UINT __riscv_vadd_vx_u32m4_mu #define VADDVX_UINT __riscv_vadd_vx_u32m4 #define VMVVX_UINT __riscv_vmv_v_x_u32m4 #define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f32m1_f32 @@ -113,8 +113,8 @@ BLASLONG CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) // index where element less than v_min mask = VMFLTVV_FLOAT(vx0, v_min, vl); - v_min_index = VIDV_MASK_UINT(mask, vl); - v_min_index = VADDVX_MASK_UINT(mask, v_min_index, j, vl); + v_min_index = VIDV_MASK_UINT(mask, v_min_index, vl); + v_min_index = VADDVX_MASK_UINT(mask, v_min_index, v_min_index, j, vl); //update v_min and start_index j v_min = VFMINVV_FLOAT(v_min, vx0, vl); @@ -136,8 +136,8 @@ BLASLONG CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) // index where element less than v_min mask = VMFLTVV_FLOAT(vx0, v_min, vl); - v_min_index = VIDV_MASK_UINT(mask, vl); - v_min_index = VADDVX_MASK_UINT(mask, v_min_index, j, vl); + v_min_index = VIDV_MASK_UINT(mask, v_min_index, vl); + v_min_index = VADDVX_MASK_UINT(mask, v_min_index, v_min_index, j, vl); //update v_min and start_index j v_min = VFMINVV_FLOAT(v_min, vx0, vl); From 8df0289db61ea5a3e461c94c51a5798e2dd18b86 Mon Sep 17 00:00:00 2001 From: Octavian Maghiar Date: Thu, 20 Jul 2023 15:28:35 +0100 Subject: [PATCH 019/311] Adds tail undisturbed for RVV Level 1 operations During the last iteration of some RVV operations, accumulators can get overwritten when VL < VLMAX and tail policy is agnostic. Commit changes intrinsics tail policy to undistrubed. --- kernel/riscv64/amax_rvv.c | 8 +++--- kernel/riscv64/amin_rvv.c | 8 +++--- kernel/riscv64/asum_rvv.c | 8 +++--- kernel/riscv64/dot_rvv.c | 16 +++++------ kernel/riscv64/iamax_rvv.c | 24 ++++++++-------- kernel/riscv64/iamin_rvv.c | 24 ++++++++-------- kernel/riscv64/imax_rvv.c | 24 ++++++++-------- kernel/riscv64/imin_rvv.c | 24 ++++++++-------- kernel/riscv64/izamax_rvv.c | 24 ++++++++-------- kernel/riscv64/izamin_rvv.c | 24 ++++++++-------- kernel/riscv64/max_rvv.c | 8 +++--- kernel/riscv64/min_rvv.c | 8 +++--- kernel/riscv64/nrm2_rvv.c | 8 +++--- kernel/riscv64/sum_rvv.c | 8 +++--- kernel/riscv64/zamax_rvv.c | 8 +++--- kernel/riscv64/zamin_rvv.c | 8 +++--- kernel/riscv64/zasum_rvv.c | 12 ++++---- kernel/riscv64/zdot_rvv.c | 56 ++++++++++++++++++------------------- kernel/riscv64/znrm2_rvv.c | 24 ++++++++-------- kernel/riscv64/zsum_rvv.c | 12 ++++---- 20 files changed, 168 insertions(+), 168 deletions(-) diff --git a/kernel/riscv64/amax_rvv.c b/kernel/riscv64/amax_rvv.c index be0bdbea0..451fbc834 100644 --- a/kernel/riscv64/amax_rvv.c +++ b/kernel/riscv64/amax_rvv.c @@ -39,7 +39,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VFREDMAXVS_FLOAT __riscv_vfredmax_vs_f32m8_f32m1 #define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m8 #define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f32m1 -#define VFMAXVV_FLOAT __riscv_vfmax_vv_f32m8 +#define VFMAXVV_FLOAT_TU __riscv_vfmax_vv_f32m8_tu #define VFABSV_FLOAT __riscv_vfabs_v_f32m8 #define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f32m1_f32 #else @@ -53,7 +53,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VFREDMAXVS_FLOAT __riscv_vfredmax_vs_f64m8_f64m1 #define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m8 #define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f64m1 -#define VFMAXVV_FLOAT __riscv_vfmax_vv_f64m8 +#define VFMAXVV_FLOAT_TU __riscv_vfmax_vv_f64m8_tu #define VFABSV_FLOAT __riscv_vfabs_v_f64m8 #define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f64m1_f64 #endif @@ -78,7 +78,7 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) vx = VLEV_FLOAT(x, vl); vx = VFABSV_FLOAT(vx, vl); - vmax = VFMAXVV_FLOAT(vmax, vx, vl); + vmax = VFMAXVV_FLOAT_TU(vmax, vmax, vx, vl); } } else { @@ -90,7 +90,7 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) vx = VLSEV_FLOAT(x, stride_x, vl); vx = VFABSV_FLOAT(vx, vl); - vmax = VFMAXVV_FLOAT(vmax, vx, vl); + vmax = VFMAXVV_FLOAT_TU(vmax, vmax, vx, vl); } } diff --git a/kernel/riscv64/amin_rvv.c b/kernel/riscv64/amin_rvv.c index d4926084b..5186d7b12 100644 --- a/kernel/riscv64/amin_rvv.c +++ b/kernel/riscv64/amin_rvv.c @@ -39,7 +39,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VFREDMINVS_FLOAT __riscv_vfredmin_vs_f32m8_f32m1 #define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m8 #define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f32m1 -#define VFMINVV_FLOAT __riscv_vfmin_vv_f32m8 +#define VFMINVV_FLOAT_TU __riscv_vfmin_vv_f32m8_tu #define VFABSV_FLOAT __riscv_vfabs_v_f32m8 #define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f32m1_f32 #else @@ -53,7 +53,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VFREDMINVS_FLOAT __riscv_vfredmin_vs_f64m8_f64m1 #define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m8 #define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f64m1 -#define VFMINVV_FLOAT __riscv_vfmin_vv_f64m8 +#define VFMINVV_FLOAT_TU __riscv_vfmin_vv_f64m8_tu #define VFABSV_FLOAT __riscv_vfabs_v_f64m8 #define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f64m1_f64 #endif @@ -78,7 +78,7 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) vx = VLEV_FLOAT(x, vl); vx = VFABSV_FLOAT(vx, vl); - vmin = VFMINVV_FLOAT(vmin, vx, vl); + vmin = VFMINVV_FLOAT_TU(vmin, vmin, vx, vl); } } else { @@ -90,7 +90,7 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) vx = VLSEV_FLOAT(x, stride_x, vl); vx = VFABSV_FLOAT(vx, vl); - vmin = VFMINVV_FLOAT(vmin, vx, vl); + vmin = VFMINVV_FLOAT_TU(vmin, vmin, vx, vl); } } diff --git a/kernel/riscv64/asum_rvv.c b/kernel/riscv64/asum_rvv.c index 691591e22..0ea610cbb 100644 --- a/kernel/riscv64/asum_rvv.c +++ b/kernel/riscv64/asum_rvv.c @@ -36,7 +36,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VLEV_FLOAT __riscv_vle32_v_f32m8 #define VLSEV_FLOAT __riscv_vlse32_v_f32m8 #define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m8 -#define VFADDVV_FLOAT __riscv_vfadd_vv_f32m8 +#define VFADDVV_FLOAT_TU __riscv_vfadd_vv_f32m8_tu #define VFABSV_FLOAT __riscv_vfabs_v_f32m8 #define VFREDSUMVS_FLOAT __riscv_vfredusum_vs_f32m8_f32m1 #define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f32m1 @@ -50,7 +50,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VLEV_FLOAT __riscv_vle64_v_f64m8 #define VLSEV_FLOAT __riscv_vlse64_v_f64m8 #define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m8 -#define VFADDVV_FLOAT __riscv_vfadd_vv_f64m8 +#define VFADDVV_FLOAT_TU __riscv_vfadd_vv_f64m8_tu #define VFABSV_FLOAT __riscv_vfabs_v_f64m8 #define VFREDSUMVS_FLOAT __riscv_vfredusum_vs_f64m8_f64m1 #define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f64m1 @@ -76,7 +76,7 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) vx = VLEV_FLOAT(x, vl); vx = VFABSV_FLOAT(vx, vl); - vsum = VFADDVV_FLOAT(vsum, vx, vl); + vsum = VFADDVV_FLOAT_TU(vsum, vsum, vx, vl); } } else { @@ -88,7 +88,7 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) vx = VLSEV_FLOAT(x, stride_x, vl); vx = VFABSV_FLOAT(vx, vl); - vsum = VFADDVV_FLOAT(vsum, vx, vl); + vsum = VFADDVV_FLOAT_TU(vsum, vsum, vx, vl); } } diff --git a/kernel/riscv64/dot_rvv.c b/kernel/riscv64/dot_rvv.c index 3276695b6..837badf41 100644 --- a/kernel/riscv64/dot_rvv.c +++ b/kernel/riscv64/dot_rvv.c @@ -49,12 +49,12 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y) vfloat32m4_t vx = __riscv_vle32_v_f32m4(x, vl); vfloat32m4_t vy = __riscv_vle32_v_f32m4(y, vl); - vr = __riscv_vfwmacc_vv_f64m8(vr, vx, vy, vl); + vr = __riscv_vfwmacc_vv_f64m8_tu(vr, vx, vy, vl); #else vfloat64m8_t vx = __riscv_vle64_v_f64m8(x, vl); vfloat64m8_t vy = __riscv_vle64_v_f64m8(y, vl); - vr = __riscv_vfmacc_vv_f64m8(vr, vx, vy, vl); + vr = __riscv_vfmacc_vv_f64m8_tu(vr, vx, vy, vl); #endif } @@ -69,12 +69,12 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y) vfloat32m4_t vx = __riscv_vle32_v_f32m4(x, vl); vfloat32m4_t vy = __riscv_vlse32_v_f32m4(y, stride_y, vl); - vr = __riscv_vfwmacc_vv_f64m8(vr, vx, vy, vl); + vr = __riscv_vfwmacc_vv_f64m8_tu(vr, vx, vy, vl); #else vfloat64m8_t vx = __riscv_vle64_v_f64m8(x, vl); vfloat64m8_t vy = __riscv_vlse64_v_f64m8(y, stride_y, vl); - vr = __riscv_vfmacc_vv_f64m8(vr, vx, vy, vl); + vr = __riscv_vfmacc_vv_f64m8_tu(vr, vx, vy, vl); #endif } } else if (1 == inc_y) { @@ -88,12 +88,12 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y) vfloat32m4_t vx = __riscv_vlse32_v_f32m4(x, stride_x, vl); vfloat32m4_t vy = __riscv_vle32_v_f32m4(y, vl); - vr = __riscv_vfwmacc_vv_f64m8(vr, vx, vy, vl); + vr = __riscv_vfwmacc_vv_f64m8_tu(vr, vx, vy, vl); #else vfloat64m8_t vx = __riscv_vlse64_v_f64m8(x, stride_x, vl); vfloat64m8_t vy = __riscv_vle64_v_f64m8(y, vl); - vr = __riscv_vfmacc_vv_f64m8(vr, vx, vy, vl); + vr = __riscv_vfmacc_vv_f64m8_tu(vr, vx, vy, vl); #endif } } else { @@ -108,12 +108,12 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y) vfloat32m4_t vx = __riscv_vlse32_v_f32m4(x, stride_x, vl); vfloat32m4_t vy = __riscv_vlse32_v_f32m4(y, stride_y, vl); - vr = __riscv_vfwmacc_vv_f64m8(vr, vx, vy, vl); + vr = __riscv_vfwmacc_vv_f64m8_tu(vr, vx, vy, vl); #else vfloat64m8_t vx = __riscv_vlse64_v_f64m8(x, stride_x, vl); vfloat64m8_t vy = __riscv_vlse64_v_f64m8(y, stride_y, vl); - vr = __riscv_vfmacc_vv_f64m8(vr, vx, vy, vl); + vr = __riscv_vfmacc_vv_f64m8_tu(vr, vx, vy, vl); #endif } } diff --git a/kernel/riscv64/iamax_rvv.c b/kernel/riscv64/iamax_rvv.c index d3508a91d..8362d7cef 100644 --- a/kernel/riscv64/iamax_rvv.c +++ b/kernel/riscv64/iamax_rvv.c @@ -42,12 +42,12 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m8 #define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f64m1 #define VFABSV_FLOAT __riscv_vfabs_v_f64m8 -#define VFMAXVV_FLOAT __riscv_vfmax_vv_f64m8 +#define VFMAXVV_FLOAT_TU __riscv_vfmax_vv_f64m8_tu #define VFIRSTM __riscv_vfirst_m_b8 #define UINT_V_T vuint64m8_t -#define VIDV_MASK_UINT __riscv_vid_v_u64m8_mu +#define VIDV_MASK_UINT_TU __riscv_vid_v_u64m8_tumu #define VIDV_UINT __riscv_vid_v_u64m8 -#define VADDVX_MASK_UINT __riscv_vadd_vx_u64m8_mu +#define VADDVX_MASK_UINT_TU __riscv_vadd_vx_u64m8_tumu #define VADDVX_UINT __riscv_vadd_vx_u64m8 #define VMVVX_UINT __riscv_vmv_v_x_u64m8 #define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f64m1_f64 @@ -68,12 +68,12 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m8 #define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f32m1 #define VFABSV_FLOAT __riscv_vfabs_v_f32m8 -#define VFMAXVV_FLOAT __riscv_vfmax_vv_f32m8 +#define VFMAXVV_FLOAT_TU __riscv_vfmax_vv_f32m8_tu #define VFIRSTM __riscv_vfirst_m_b4 #define UINT_V_T vuint32m8_t -#define VIDV_MASK_UINT __riscv_vid_v_u32m8_mu +#define VIDV_MASK_UINT_TU __riscv_vid_v_u32m8_tumu #define VIDV_UINT __riscv_vid_v_u32m8 -#define VADDVX_MASK_UINT __riscv_vadd_vx_u32m8_mu +#define VADDVX_MASK_UINT_TU __riscv_vadd_vx_u32m8_tumu #define VADDVX_UINT __riscv_vadd_vx_u32m8 #define VMVVX_UINT __riscv_vmv_v_x_u32m8 #define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f32m1_f32 @@ -106,11 +106,11 @@ BLASLONG CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) //index where element greater than v_max mask = VMFLTVV_FLOAT(v_max, vx, vl); - v_max_index = VIDV_MASK_UINT(mask, v_max_index, vl); - v_max_index = VADDVX_MASK_UINT(mask, v_max_index, v_max_index, j, vl); + v_max_index = VIDV_MASK_UINT_TU(mask, v_max_index, vl); + v_max_index = VADDVX_MASK_UINT_TU(mask, v_max_index, v_max_index, j, vl); //update v_max - v_max = VFMAXVV_FLOAT(v_max, vx, vl); + v_max = VFMAXVV_FLOAT_TU(v_max, v_max, vx, vl); } } else { @@ -125,11 +125,11 @@ BLASLONG CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) //index where element greater than v_max mask = VMFLTVV_FLOAT(v_max, vx, vl); - v_max_index = VIDV_MASK_UINT(mask, v_max_index, vl); - v_max_index = VADDVX_MASK_UINT(mask, v_max_index, v_max_index, j, vl); + v_max_index = VIDV_MASK_UINT_TU(mask, v_max_index, vl); + v_max_index = VADDVX_MASK_UINT_TU(mask, v_max_index, v_max_index, j, vl); //update v_max - v_max = VFMAXVV_FLOAT(v_max, vx, vl); + v_max = VFMAXVV_FLOAT_TU(v_max, v_max, vx, vl); } } diff --git a/kernel/riscv64/iamin_rvv.c b/kernel/riscv64/iamin_rvv.c index ae1d4f726..f90dbb545 100644 --- a/kernel/riscv64/iamin_rvv.c +++ b/kernel/riscv64/iamin_rvv.c @@ -43,12 +43,12 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m8 #define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f64m1 #define VFABSV_FLOAT __riscv_vfabs_v_f64m8 -#define VFMINVV_FLOAT __riscv_vfmin_vv_f64m8 +#define VFMINVV_FLOAT_TU __riscv_vfmin_vv_f64m8_tu #define VFIRSTM __riscv_vfirst_m_b8 #define UINT_V_T vuint64m8_t -#define VIDV_MASK_UINT __riscv_vid_v_u64m8_mu +#define VIDV_MASK_UINT_TU __riscv_vid_v_u64m8_tumu #define VIDV_UINT __riscv_vid_v_u64m8 -#define VADDVX_MASK_UINT __riscv_vadd_vx_u64m8_mu +#define VADDVX_MASK_UINT_TU __riscv_vadd_vx_u64m8_tumu #define VADDVX_UINT __riscv_vadd_vx_u64m8 #define VMVVX_UINT __riscv_vmv_v_x_u64m8 #define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f64m1_f64 @@ -69,12 +69,12 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m8 #define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f32m1 #define VFABSV_FLOAT __riscv_vfabs_v_f32m8 -#define VFMINVV_FLOAT __riscv_vfmin_vv_f32m8 +#define VFMINVV_FLOAT_TU __riscv_vfmin_vv_f32m8_tu #define VFIRSTM __riscv_vfirst_m_b4 #define UINT_V_T vuint32m8_t -#define VIDV_MASK_UINT __riscv_vid_v_u32m8_mu +#define VIDV_MASK_UINT_TU __riscv_vid_v_u32m8_tumu #define VIDV_UINT __riscv_vid_v_u32m8 -#define VADDVX_MASK_UINT __riscv_vadd_vx_u32m8_mu +#define VADDVX_MASK_UINT_TU __riscv_vadd_vx_u32m8_tumu #define VADDVX_UINT __riscv_vadd_vx_u32m8 #define VMVVX_UINT __riscv_vmv_v_x_u32m8 #define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f32m1_f32 @@ -107,11 +107,11 @@ BLASLONG CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) // index where element less than v_min mask = VMFLTVV_FLOAT(vx, v_min, vl); - v_min_index = VIDV_MASK_UINT(mask, v_min_index, vl); - v_min_index = VADDVX_MASK_UINT(mask, v_min_index, v_min_index, j, vl); + v_min_index = VIDV_MASK_UINT_TU(mask, v_min_index, vl); + v_min_index = VADDVX_MASK_UINT_TU(mask, v_min_index, v_min_index, j, vl); //update v_min and start_index j - v_min = VFMINVV_FLOAT(v_min, vx, vl); + v_min = VFMINVV_FLOAT_TU(v_min, v_min, vx, vl); } } else { @@ -126,11 +126,11 @@ BLASLONG CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) // index where element less than v_min mask = VMFLTVV_FLOAT(vx, v_min, vl); - v_min_index = VIDV_MASK_UINT(mask, v_min_index, vl); - v_min_index = VADDVX_MASK_UINT(mask, v_min_index, v_min_index, j, vl); + v_min_index = VIDV_MASK_UINT_TU(mask, v_min_index, vl); + v_min_index = VADDVX_MASK_UINT_TU(mask, v_min_index, v_min_index, j, vl); //update v_min and start_index j - v_min = VFMINVV_FLOAT(v_min, vx, vl); + v_min = VFMINVV_FLOAT_TU(v_min, v_min, vx, vl); } } diff --git a/kernel/riscv64/imax_rvv.c b/kernel/riscv64/imax_rvv.c index 33250568d..b1a77b178 100644 --- a/kernel/riscv64/imax_rvv.c +++ b/kernel/riscv64/imax_rvv.c @@ -42,12 +42,12 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VMFGEVF_FLOAT __riscv_vmfge_vf_f64m8_b8 #define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m8 #define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f64m1 -#define VFMAXVV_FLOAT __riscv_vfmax_vv_f64m8 +#define VFMAXVV_FLOAT_TU __riscv_vfmax_vv_f64m8_tu #define VFIRSTM __riscv_vfirst_m_b8 #define UINT_V_T vuint64m8_t -#define VIDV_MASK_UINT __riscv_vid_v_u64m8_mu +#define VIDV_MASK_UINT_TU __riscv_vid_v_u64m8_tumu #define VIDV_UINT __riscv_vid_v_u64m8 -#define VADDVX_MASK_UINT __riscv_vadd_vx_u64m8_mu +#define VADDVX_MASK_UINT_TU __riscv_vadd_vx_u64m8_tumu #define VADDVX_UINT __riscv_vadd_vx_u64m8 #define VMVVX_UINT __riscv_vmv_v_x_u64m8 #define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f64m1_f64 @@ -67,12 +67,12 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VMFGEVF_FLOAT __riscv_vmfge_vf_f32m8_b4 #define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m8 #define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f32m1 -#define VFMAXVV_FLOAT __riscv_vfmax_vv_f32m8 +#define VFMAXVV_FLOAT_TU __riscv_vfmax_vv_f32m8_tu #define VFIRSTM __riscv_vfirst_m_b4 #define UINT_V_T vuint32m8_t -#define VIDV_MASK_UINT __riscv_vid_v_u32m8_mu +#define VIDV_MASK_UINT_TU __riscv_vid_v_u32m8_tumu #define VIDV_UINT __riscv_vid_v_u32m8 -#define VADDVX_MASK_UINT __riscv_vadd_vx_u32m8_mu +#define VADDVX_MASK_UINT_TU __riscv_vadd_vx_u32m8_tumu #define VADDVX_UINT __riscv_vadd_vx_u32m8 #define VMVVX_UINT __riscv_vmv_v_x_u32m8 #define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f32m1_f32 @@ -104,11 +104,11 @@ BLASLONG CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) //index where element greater than v_max mask = VMFLTVV_FLOAT(v_max, vx, vl); - v_max_index = VIDV_MASK_UINT(mask, v_max_index, vl); - v_max_index = VADDVX_MASK_UINT(mask, v_max_index, v_max_index, j, vl); + v_max_index = VIDV_MASK_UINT_TU(mask, v_max_index, vl); + v_max_index = VADDVX_MASK_UINT_TU(mask, v_max_index, v_max_index, j, vl); //update v_max and start_index j - v_max = VFMAXVV_FLOAT(v_max, vx, vl); + v_max = VFMAXVV_FLOAT_TU(v_max, v_max, vx, vl); } } else { @@ -122,11 +122,11 @@ BLASLONG CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) //index where element greater than v_max mask = VMFLTVV_FLOAT(v_max, vx, vl); - v_max_index = VIDV_MASK_UINT(mask, v_max_index, vl); - v_max_index = VADDVX_MASK_UINT(mask, v_max_index, v_max_index, j, vl); + v_max_index = VIDV_MASK_UINT_TU(mask, v_max_index, vl); + v_max_index = VADDVX_MASK_UINT_TU(mask, v_max_index, v_max_index, j, vl); //update v_max and start_index j - v_max = VFMAXVV_FLOAT(v_max, vx, vl); + v_max = VFMAXVV_FLOAT_TU(v_max, v_max, vx, vl); } } diff --git a/kernel/riscv64/imin_rvv.c b/kernel/riscv64/imin_rvv.c index 4ce49c3af..1de7f3233 100644 --- a/kernel/riscv64/imin_rvv.c +++ b/kernel/riscv64/imin_rvv.c @@ -42,12 +42,12 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VMFLEVF_FLOAT __riscv_vmfle_vf_f64m8_b8 #define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m8 #define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f64m1 -#define VFMINVV_FLOAT __riscv_vfmin_vv_f64m8 +#define VFMINVV_FLOAT_TU __riscv_vfmin_vv_f64m8_tu #define VFIRSTM __riscv_vfirst_m_b8 #define UINT_V_T vuint64m8_t -#define VIDV_MASK_UINT __riscv_vid_v_u64m8_mu +#define VIDV_MASK_UINT_TU __riscv_vid_v_u64m8_tumu #define VIDV_UINT __riscv_vid_v_u64m8 -#define VADDVX_MASK_UINT __riscv_vadd_vx_u64m8_mu +#define VADDVX_MASK_UINT_TU __riscv_vadd_vx_u64m8_tumu #define VADDVX_UINT __riscv_vadd_vx_u64m8 #define VMVVX_UINT __riscv_vmv_v_x_u64m8 #define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f64m1_f64 @@ -67,12 +67,12 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VMFLEVF_FLOAT __riscv_vmfle_vf_f32m8_b4 #define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m8 #define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f32m1 -#define VFMINVV_FLOAT __riscv_vfmin_vv_f32m8 +#define VFMINVV_FLOAT_TU __riscv_vfmin_vv_f32m8_tu #define VFIRSTM __riscv_vfirst_m_b4 #define UINT_V_T vuint32m8_t -#define VIDV_MASK_UINT __riscv_vid_v_u32m8_mu +#define VIDV_MASK_UINT_TU __riscv_vid_v_u32m8_tumu #define VIDV_UINT __riscv_vid_v_u32m8 -#define VADDVX_MASK_UINT __riscv_vadd_vx_u32m8_mu +#define VADDVX_MASK_UINT_TU __riscv_vadd_vx_u32m8_tumu #define VADDVX_UINT __riscv_vadd_vx_u32m8 #define VMVVX_UINT __riscv_vmv_v_x_u32m8 #define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f32m1_f32 @@ -104,11 +104,11 @@ BLASLONG CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) // index where element less than v_min mask = VMFLTVV_FLOAT(vx, v_min, vl); - v_min_index = VIDV_MASK_UINT(mask, v_min_index, vl); - v_min_index = VADDVX_MASK_UINT(mask, v_min_index, v_min_index, j, vl); + v_min_index = VIDV_MASK_UINT_TU(mask, v_min_index, vl); + v_min_index = VADDVX_MASK_UINT_TU(mask, v_min_index, v_min_index, j, vl); //update v_min and start_index j - v_min = VFMINVV_FLOAT(v_min, vx, vl); + v_min = VFMINVV_FLOAT_TU(v_min, v_min, vx, vl); } } else { @@ -122,11 +122,11 @@ BLASLONG CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) // index where element less than v_min mask = VMFLTVV_FLOAT(vx, v_min, vl); - v_min_index = VIDV_MASK_UINT(mask, v_min_index, vl); - v_min_index = VADDVX_MASK_UINT(mask, v_min_index, v_min_index, j, vl); + v_min_index = VIDV_MASK_UINT_TU(mask, v_min_index, vl); + v_min_index = VADDVX_MASK_UINT_TU(mask, v_min_index, v_min_index, j, vl); //update v_min and start_index j - v_min = VFMINVV_FLOAT(v_min, vx, vl); + v_min = VFMINVV_FLOAT_TU(v_min, v_min, vx, vl); } } diff --git a/kernel/riscv64/izamax_rvv.c b/kernel/riscv64/izamax_rvv.c index e43ded820..e93f0056c 100644 --- a/kernel/riscv64/izamax_rvv.c +++ b/kernel/riscv64/izamax_rvv.c @@ -44,13 +44,13 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m4 #define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f64m1 #define VFABSV_FLOAT __riscv_vfabs_v_f64m4 -#define VFMAXVV_FLOAT __riscv_vfmax_vv_f64m4 +#define VFMAXVV_FLOAT_TU __riscv_vfmax_vv_f64m4_tu #define VFADDVV_FLOAT __riscv_vfadd_vv_f64m4 #define VFIRSTM __riscv_vfirst_m_b16 #define UINT_V_T vuint64m4_t -#define VIDV_MASK_UINT __riscv_vid_v_u64m4_mu +#define VIDV_MASK_UINT_TU __riscv_vid_v_u64m4_tumu #define VIDV_UINT __riscv_vid_v_u64m4 -#define VADDVX_MASK_UINT __riscv_vadd_vx_u64m4_mu +#define VADDVX_MASK_UINT_TU __riscv_vadd_vx_u64m4_tumu #define VADDVX_UINT __riscv_vadd_vx_u64m4 #define VMVVX_UINT __riscv_vmv_v_x_u64m4 #define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f64m1_f64 @@ -73,13 +73,13 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m4 #define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f32m1 #define VFABSV_FLOAT __riscv_vfabs_v_f32m4 -#define VFMAXVV_FLOAT __riscv_vfmax_vv_f32m4 +#define VFMAXVV_FLOAT_TU __riscv_vfmax_vv_f32m4_tu #define VFADDVV_FLOAT __riscv_vfadd_vv_f32m4 #define VFIRSTM __riscv_vfirst_m_b8 #define UINT_V_T vuint32m4_t -#define VIDV_MASK_UINT __riscv_vid_v_u32m4_mu +#define VIDV_MASK_UINT_TU __riscv_vid_v_u32m4_tumu #define VIDV_UINT __riscv_vid_v_u32m4 -#define VADDVX_MASK_UINT __riscv_vadd_vx_u32m4_mu +#define VADDVX_MASK_UINT_TU __riscv_vadd_vx_u32m4_tumu #define VADDVX_UINT __riscv_vadd_vx_u32m4 #define VMVVX_UINT __riscv_vmv_v_x_u32m4 #define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f32m1_f32 @@ -116,11 +116,11 @@ BLASLONG CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) //index where element greater than v_max mask = VMFLTVV_FLOAT(v_max, vx0, vl); - v_max_index = VIDV_MASK_UINT(mask, v_max_index, vl); - v_max_index = VADDVX_MASK_UINT(mask, v_max_index, v_max_index, j, vl); + v_max_index = VIDV_MASK_UINT_TU(mask, v_max_index, vl); + v_max_index = VADDVX_MASK_UINT_TU(mask, v_max_index, v_max_index, j, vl); //update v_max and start_index j - v_max = VFMAXVV_FLOAT(v_max, vx0, vl); + v_max = VFMAXVV_FLOAT_TU(v_max, v_max, vx0, vl); } } else { @@ -138,11 +138,11 @@ BLASLONG CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) //index where element greater than v_max mask = VMFLTVV_FLOAT(v_max, vx0, vl); - v_max_index = VIDV_MASK_UINT(mask, v_max_index, vl); - v_max_index = VADDVX_MASK_UINT(mask, v_max_index, v_max_index, j, vl); + v_max_index = VIDV_MASK_UINT_TU(mask, v_max_index, vl); + v_max_index = VADDVX_MASK_UINT_TU(mask, v_max_index, v_max_index, j, vl); //update v_max and start_index j - v_max = VFMAXVV_FLOAT(v_max, vx0, vl); + v_max = VFMAXVV_FLOAT_TU(v_max, v_max, vx0, vl); } } diff --git a/kernel/riscv64/izamin_rvv.c b/kernel/riscv64/izamin_rvv.c index cc3c37c8e..b5bc27404 100644 --- a/kernel/riscv64/izamin_rvv.c +++ b/kernel/riscv64/izamin_rvv.c @@ -43,13 +43,13 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m4 #define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f64m1 #define VFABSV_FLOAT __riscv_vfabs_v_f64m4 -#define VFMINVV_FLOAT __riscv_vfmin_vv_f64m4 +#define VFMINVV_FLOAT_TU __riscv_vfmin_vv_f64m4_tu #define VFADDVV_FLOAT __riscv_vfadd_vv_f64m4 #define VFIRSTM __riscv_vfirst_m_b16 #define UINT_V_T vuint64m4_t -#define VIDV_MASK_UINT __riscv_vid_v_u64m4_mu +#define VIDV_MASK_UINT_TU __riscv_vid_v_u64m4_tumu #define VIDV_UINT __riscv_vid_v_u64m4 -#define VADDVX_MASK_UINT __riscv_vadd_vx_u64m4_mu +#define VADDVX_MASK_UINT_TU __riscv_vadd_vx_u64m4_tumu #define VADDVX_UINT __riscv_vadd_vx_u64m4 #define VMVVX_UINT __riscv_vmv_v_x_u64m4 #define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f64m1_f64 @@ -70,13 +70,13 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m4 #define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f32m1 #define VFABSV_FLOAT __riscv_vfabs_v_f32m4 -#define VFMINVV_FLOAT __riscv_vfmin_vv_f32m4 +#define VFMINVV_FLOAT_TU __riscv_vfmin_vv_f32m4_tu #define VFADDVV_FLOAT __riscv_vfadd_vv_f32m4 #define VFIRSTM __riscv_vfirst_m_b8 #define UINT_V_T vuint32m4_t -#define VIDV_MASK_UINT __riscv_vid_v_u32m4_mu +#define VIDV_MASK_UINT_TU __riscv_vid_v_u32m4_tumu #define VIDV_UINT __riscv_vid_v_u32m4 -#define VADDVX_MASK_UINT __riscv_vadd_vx_u32m4_mu +#define VADDVX_MASK_UINT_TU __riscv_vadd_vx_u32m4_tumu #define VADDVX_UINT __riscv_vadd_vx_u32m4 #define VMVVX_UINT __riscv_vmv_v_x_u32m4 #define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f32m1_f32 @@ -113,11 +113,11 @@ BLASLONG CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) // index where element less than v_min mask = VMFLTVV_FLOAT(vx0, v_min, vl); - v_min_index = VIDV_MASK_UINT(mask, v_min_index, vl); - v_min_index = VADDVX_MASK_UINT(mask, v_min_index, v_min_index, j, vl); + v_min_index = VIDV_MASK_UINT_TU(mask, v_min_index, vl); + v_min_index = VADDVX_MASK_UINT_TU(mask, v_min_index, v_min_index, j, vl); //update v_min and start_index j - v_min = VFMINVV_FLOAT(v_min, vx0, vl); + v_min = VFMINVV_FLOAT_TU(v_min, v_min, vx0, vl); } } else { @@ -136,11 +136,11 @@ BLASLONG CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) // index where element less than v_min mask = VMFLTVV_FLOAT(vx0, v_min, vl); - v_min_index = VIDV_MASK_UINT(mask, v_min_index, vl); - v_min_index = VADDVX_MASK_UINT(mask, v_min_index, v_min_index, j, vl); + v_min_index = VIDV_MASK_UINT_TU(mask, v_min_index, vl); + v_min_index = VADDVX_MASK_UINT_TU(mask, v_min_index, v_min_index, j, vl); //update v_min and start_index j - v_min = VFMINVV_FLOAT(v_min, vx0, vl); + v_min = VFMINVV_FLOAT_TU(v_min, v_min, vx0, vl); } } diff --git a/kernel/riscv64/max_rvv.c b/kernel/riscv64/max_rvv.c index 9315321f4..745c27bf4 100644 --- a/kernel/riscv64/max_rvv.c +++ b/kernel/riscv64/max_rvv.c @@ -39,7 +39,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VFREDMAXVS_FLOAT __riscv_vfredmax_vs_f32m8_f32m1 #define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m8 #define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f32m1 -#define VFMAXVV_FLOAT __riscv_vfmax_vv_f32m8 +#define VFMAXVV_FLOAT_TU __riscv_vfmax_vv_f32m8_tu #define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f32m1_f32 #else #define VSETVL(n) __riscv_vsetvl_e64m8(n) @@ -52,7 +52,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VFREDMAXVS_FLOAT __riscv_vfredmax_vs_f64m8_f64m1 #define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m8 #define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f64m1 -#define VFMAXVV_FLOAT __riscv_vfmax_vv_f64m8 +#define VFMAXVV_FLOAT_TU __riscv_vfmax_vv_f64m8_tu #define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f64m1_f64 #endif @@ -75,7 +75,7 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) vl = VSETVL(n); vx = VLEV_FLOAT(x, vl); - vmax = VFMAXVV_FLOAT(vmax, vx, vl); + vmax = VFMAXVV_FLOAT_TU(vmax, vmax, vx, vl); } } else { @@ -86,7 +86,7 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) vl = VSETVL(n); vx = VLSEV_FLOAT(x, stride_x, vl); - vmax = VFMAXVV_FLOAT(vmax, vx, vl); + vmax = VFMAXVV_FLOAT_TU(vmax, vmax, vx, vl); } } diff --git a/kernel/riscv64/min_rvv.c b/kernel/riscv64/min_rvv.c index 158b682fd..78528fef9 100644 --- a/kernel/riscv64/min_rvv.c +++ b/kernel/riscv64/min_rvv.c @@ -39,7 +39,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VFREDMINVS_FLOAT __riscv_vfredmin_vs_f32m8_f32m1 #define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m8 #define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f32m1 -#define VFMINVV_FLOAT __riscv_vfmin_vv_f32m8 +#define VFMINVV_FLOAT_TU __riscv_vfmin_vv_f32m8_tu #define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f32m1_f32 #else #define VSETVL(n) __riscv_vsetvl_e64m8(n) @@ -52,7 +52,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VFREDMINVS_FLOAT __riscv_vfredmin_vs_f64m8_f64m1 #define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m8 #define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f64m1 -#define VFMINVV_FLOAT __riscv_vfmin_vv_f64m8 +#define VFMINVV_FLOAT_TU __riscv_vfmin_vv_f64m8_tu #define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f64m1_f64 #endif @@ -75,7 +75,7 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) vl = VSETVL(n); vx = VLEV_FLOAT(x, vl); - vmin = VFMINVV_FLOAT(vmin, vx, vl); + vmin = VFMINVV_FLOAT_TU(vmin, vmin, vx, vl); } } else { @@ -86,7 +86,7 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) vl = VSETVL(n); vx = VLSEV_FLOAT(x, stride_x, vl); - vmin = VFMINVV_FLOAT(vmin, vx, vl); + vmin = VFMINVV_FLOAT_TU(vmin, vmin, vx, vl); } } diff --git a/kernel/riscv64/nrm2_rvv.c b/kernel/riscv64/nrm2_rvv.c index 42abfa119..994fadb70 100644 --- a/kernel/riscv64/nrm2_rvv.c +++ b/kernel/riscv64/nrm2_rvv.c @@ -36,7 +36,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VLEV_FLOAT __riscv_vle32_v_f32m8 #define VLSEV_FLOAT __riscv_vlse32_v_f32m8 #define VFREDSUM_FLOAT __riscv_vfredusum_vs_f32m8_f32m1 -#define VFMACCVV_FLOAT __riscv_vfmacc_vv_f32m8 +#define VFMACCVV_FLOAT_TU __riscv_vfmacc_vv_f32m8_tu #define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m8 #define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f32m1 #define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f32m1_f32 @@ -49,7 +49,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VLEV_FLOAT __riscv_vle64_v_f64m8 #define VLSEV_FLOAT __riscv_vlse64_v_f64m8 #define VFREDSUM_FLOAT __riscv_vfredusum_vs_f64m8_f64m1 -#define VFMACCVV_FLOAT __riscv_vfmacc_vv_f64m8 +#define VFMACCVV_FLOAT_TU __riscv_vfmacc_vv_f64m8_tu #define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m8 #define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f64m1 #define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f64m1_f64 @@ -79,7 +79,7 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) v0 = VLEV_FLOAT(x, vl); - vr = VFMACCVV_FLOAT(vr, v0, v0, vl); + vr = VFMACCVV_FLOAT_TU(vr, v0, v0, vl); } } else { @@ -91,7 +91,7 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) v0 = VLSEV_FLOAT(x, stride_x, vl); - vr = VFMACCVV_FLOAT(vr, v0, v0, vl); + vr = VFMACCVV_FLOAT_TU(vr, v0, v0, vl); } } diff --git a/kernel/riscv64/sum_rvv.c b/kernel/riscv64/sum_rvv.c index 9715faf22..c5629197f 100644 --- a/kernel/riscv64/sum_rvv.c +++ b/kernel/riscv64/sum_rvv.c @@ -36,7 +36,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VLEV_FLOAT __riscv_vle32_v_f32m8 #define VLSEV_FLOAT __riscv_vlse32_v_f32m8 #define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m8 -#define VFADDVV_FLOAT __riscv_vfadd_vv_f32m8 +#define VFADDVV_FLOAT_TU __riscv_vfadd_vv_f32m8_tu #define VFREDSUMVS_FLOAT __riscv_vfredusum_vs_f32m8_f32m1 #define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f32m1 #define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f32m1_f32 @@ -49,7 +49,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VLEV_FLOAT __riscv_vle64_v_f64m8 #define VLSEV_FLOAT __riscv_vlse64_v_f64m8 #define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m8 -#define VFADDVV_FLOAT __riscv_vfadd_vv_f64m8 +#define VFADDVV_FLOAT_TU __riscv_vfadd_vv_f64m8_tu #define VFREDSUMVS_FLOAT __riscv_vfredusum_vs_f64m8_f64m1 #define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f64m1 #define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f64m1_f64 @@ -73,7 +73,7 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) vl = VSETVL(n); vx = VLEV_FLOAT(x, vl); - vsum = VFADDVV_FLOAT(vsum, vx, vl); + vsum = VFADDVV_FLOAT_TU(vsum, vsum, vx, vl); } } else { @@ -84,7 +84,7 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) vl = VSETVL(n); vx = VLSEV_FLOAT(x, stride_x, vl); - vsum = VFADDVV_FLOAT(vsum, vx, vl); + vsum = VFADDVV_FLOAT_TU(vsum, vsum, vx, vl); } } diff --git a/kernel/riscv64/zamax_rvv.c b/kernel/riscv64/zamax_rvv.c index 615b7519c..bbb1e876b 100644 --- a/kernel/riscv64/zamax_rvv.c +++ b/kernel/riscv64/zamax_rvv.c @@ -39,7 +39,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VFREDMAXVS_FLOAT __riscv_vfredmax_vs_f32m4_f32m1 #define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m4 #define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f32m1 -#define VFMAXVV_FLOAT __riscv_vfmax_vv_f32m4 +#define VFMAXVV_FLOAT_TU __riscv_vfmax_vv_f32m4_tu #define VFADDVV_FLOAT __riscv_vfadd_vv_f32m4 #define VFABSV_FLOAT __riscv_vfabs_v_f32m4 #define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f32m1_f32 @@ -54,7 +54,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VFREDMAXVS_FLOAT __riscv_vfredmax_vs_f64m4_f64m1 #define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m4 #define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f64m1 -#define VFMAXVV_FLOAT __riscv_vfmax_vv_f64m4 +#define VFMAXVV_FLOAT_TU __riscv_vfmax_vv_f64m4_tu #define VFADDVV_FLOAT __riscv_vfadd_vv_f64m4 #define VFABSV_FLOAT __riscv_vfabs_v_f64m4 #define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f64m1_f64 @@ -84,7 +84,7 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) v1 = VFABSV_FLOAT(v1, vl); v0 = VFADDVV_FLOAT(v0, v1, vl); - vmax = VFMAXVV_FLOAT(vmax, v0, vl); + vmax = VFMAXVV_FLOAT_TU(vmax, vmax, v0, vl); } @@ -101,7 +101,7 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) v1 = VFABSV_FLOAT(v1, vl); v0 = VFADDVV_FLOAT(v0, v1, vl); - vmax = VFMAXVV_FLOAT(vmax, v0, vl); + vmax = VFMAXVV_FLOAT_TU(vmax, vmax, v0, vl); } } diff --git a/kernel/riscv64/zamin_rvv.c b/kernel/riscv64/zamin_rvv.c index a0d36d46f..c5453121b 100644 --- a/kernel/riscv64/zamin_rvv.c +++ b/kernel/riscv64/zamin_rvv.c @@ -39,7 +39,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VFREDMINVS_FLOAT __riscv_vfredmin_vs_f32m4_f32m1 #define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m4 #define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f32m1 -#define VFMINVV_FLOAT __riscv_vfmin_vv_f32m4 +#define VFMINVV_FLOAT_TU __riscv_vfmin_vv_f32m4_tu #define VFADDVV_FLOAT __riscv_vfadd_vv_f32m4 #define VFABSV_FLOAT __riscv_vfabs_v_f32m4 #define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f32m1_f32 @@ -54,7 +54,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VFREDMINVS_FLOAT __riscv_vfredmin_vs_f64m4_f64m1 #define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m4 #define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f64m1 -#define VFMINVV_FLOAT __riscv_vfmin_vv_f64m4 +#define VFMINVV_FLOAT_TU __riscv_vfmin_vv_f64m4_tu #define VFADDVV_FLOAT __riscv_vfadd_vv_f64m4 #define VFABSV_FLOAT __riscv_vfabs_v_f64m4 #define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f64m1_f64 @@ -84,7 +84,7 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) v1 = VFABSV_FLOAT(v1, vl); v0 = VFADDVV_FLOAT(v0, v1, vl); - vmin = VFMINVV_FLOAT(vmin, v0, vl); + vmin = VFMINVV_FLOAT_TU(vmin, vmin, v0, vl); } } else { @@ -100,7 +100,7 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) v1 = VFABSV_FLOAT(v1, vl); v0 = VFADDVV_FLOAT(v0, v1, vl); - vmin = VFMINVV_FLOAT(vmin, v0, vl); + vmin = VFMINVV_FLOAT_TU(vmin, vmin, v0, vl); } } diff --git a/kernel/riscv64/zasum_rvv.c b/kernel/riscv64/zasum_rvv.c index 1d2f0e1fe..ebec1b19c 100644 --- a/kernel/riscv64/zasum_rvv.c +++ b/kernel/riscv64/zasum_rvv.c @@ -38,7 +38,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m8 #define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f32m1 #define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f32m1_f32 -#define VFADDVV_FLOAT __riscv_vfadd_vv_f32m8 +#define VFADDVV_FLOAT_TU __riscv_vfadd_vv_f32m8_tu #define VFABSV_FLOAT __riscv_vfabs_v_f32m8 #else #define VSETVL(n) __riscv_vsetvl_e64m8(n) @@ -51,7 +51,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m8 #define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f64m1 #define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f64m1_f64 -#define VFADDVV_FLOAT __riscv_vfadd_vv_f64m8 +#define VFADDVV_FLOAT_TU __riscv_vfadd_vv_f64m8_tu #define VFABSV_FLOAT __riscv_vfabs_v_f64m8 #endif @@ -75,8 +75,8 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) v0 = VFABSV_FLOAT(v0, vl); v1 = VFABSV_FLOAT(v1, vl); - v_sum = VFADDVV_FLOAT(v_sum, v0, vl); - v_sum = VFADDVV_FLOAT(v_sum, v1, vl); + v_sum = VFADDVV_FLOAT_TU(v_sum, v_sum, v0, vl); + v_sum = VFADDVV_FLOAT_TU(v_sum, v_sum, v1, vl); } } @@ -93,8 +93,8 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) v0 = VFABSV_FLOAT(v0, vl); v1 = VFABSV_FLOAT(v1, vl); - v_sum = VFADDVV_FLOAT(v_sum, v0, vl); - v_sum = VFADDVV_FLOAT(v_sum, v1, vl); + v_sum = VFADDVV_FLOAT_TU(v_sum, v_sum, v0, vl); + v_sum = VFADDVV_FLOAT_TU(v_sum, v_sum, v1, vl); } } diff --git a/kernel/riscv64/zdot_rvv.c b/kernel/riscv64/zdot_rvv.c index 1543c513d..fa0e89353 100644 --- a/kernel/riscv64/zdot_rvv.c +++ b/kernel/riscv64/zdot_rvv.c @@ -36,12 +36,12 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VLSEG_FLOAT __riscv_vlseg2e32_v_f32m4 #define VLSSEG_FLOAT __riscv_vlsseg2e32_v_f32m4 #define VFREDSUM_FLOAT __riscv_vfredusum_vs_f32m4_f32m1 -#define VFMACCVV_FLOAT __riscv_vfmacc_vv_f32m4 +#define VFMACCVV_FLOAT_TU __riscv_vfmacc_vv_f32m4_tu #define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m4 #define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f32m1 #define VFMULVV_FLOAT __riscv_vfmul_vv_f32m4 #define VFMSACVV_FLOAT __riscv_vfmsac_vv_f32m4 -#define VFNMSACVV_FLOAT __riscv_vfnmsac_vv_f32m4 +#define VFNMSACVV_FLOAT_TU __riscv_vfnmsac_vv_f32m4_tu #define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f32m1_f32 #else #define VSETVL(n) __riscv_vsetvl_e64m4(n) @@ -52,12 +52,12 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VLSEG_FLOAT __riscv_vlseg2e64_v_f64m4 #define VLSSEG_FLOAT __riscv_vlsseg2e64_v_f64m4 #define VFREDSUM_FLOAT __riscv_vfredusum_vs_f64m4_f64m1 -#define VFMACCVV_FLOAT __riscv_vfmacc_vv_f64m4 +#define VFMACCVV_FLOAT_TU __riscv_vfmacc_vv_f64m4_tu #define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m4 #define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f64m1 #define VFMULVV_FLOAT __riscv_vfmul_vv_f64m4 #define VFMSACVV_FLOAT __riscv_vfmsac_vv_f64m4 -#define VFNMSACVV_FLOAT __riscv_vfnmsac_vv_f64m4 +#define VFNMSACVV_FLOAT_TU __riscv_vfnmsac_vv_f64m4_tu #define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f64m1_f64 #endif @@ -86,14 +86,14 @@ OPENBLAS_COMPLEX_FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLA VLSEG_FLOAT(&vx0, &vx1, x, vl); VLSEG_FLOAT(&vy0, &vy1, y, vl); - vr0 = VFMACCVV_FLOAT(vr0, vx0, vy0, vl); - vr1 = VFMACCVV_FLOAT(vr1, vx0, vy1, vl); + vr0 = VFMACCVV_FLOAT_TU(vr0, vx0, vy0, vl); + vr1 = VFMACCVV_FLOAT_TU(vr1, vx0, vy1, vl); #if !defined(CONJ) - vr0 = VFNMSACVV_FLOAT(vr0, vx1, vy1, vl); - vr1 = VFMACCVV_FLOAT(vr1, vx1, vy0, vl); + vr0 = VFNMSACVV_FLOAT_TU(vr0, vx1, vy1, vl); + vr1 = VFMACCVV_FLOAT_TU(vr1, vx1, vy0, vl); #else - vr0 = VFMACCVV_FLOAT(vr0, vx1, vy1, vl); - vr1 = VFNMSACVV_FLOAT(vr1, vx1, vy0, vl); + vr0 = VFMACCVV_FLOAT_TU(vr0, vx1, vy1, vl); + vr1 = VFNMSACVV_FLOAT_TU(vr1, vx1, vy0, vl); #endif } @@ -107,14 +107,14 @@ OPENBLAS_COMPLEX_FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLA VLSEG_FLOAT(&vx0, &vx1, x, vl); VLSSEG_FLOAT(&vy0, &vy1, y, stride_y, vl); - vr0 = VFMACCVV_FLOAT(vr0, vx0, vy0, vl); - vr1 = VFMACCVV_FLOAT(vr1, vx0, vy1, vl); + vr0 = VFMACCVV_FLOAT_TU(vr0, vx0, vy0, vl); + vr1 = VFMACCVV_FLOAT_TU(vr1, vx0, vy1, vl); #if !defined(CONJ) - vr0 = VFNMSACVV_FLOAT(vr0, vx1, vy1, vl); - vr1 = VFMACCVV_FLOAT(vr1, vx1, vy0, vl); + vr0 = VFNMSACVV_FLOAT_TU(vr0, vx1, vy1, vl); + vr1 = VFMACCVV_FLOAT_TU(vr1, vx1, vy0, vl); #else - vr0 = VFMACCVV_FLOAT(vr0, vx1, vy1, vl); - vr1 = VFNMSACVV_FLOAT(vr1, vx1, vy0, vl); + vr0 = VFMACCVV_FLOAT_TU(vr0, vx1, vy1, vl); + vr1 = VFNMSACVV_FLOAT_TU(vr1, vx1, vy0, vl); #endif } } else if (inc_y == 1){ @@ -127,14 +127,14 @@ OPENBLAS_COMPLEX_FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLA VLSSEG_FLOAT(&vx0, &vx1, x, stride_x, vl); VLSEG_FLOAT(&vy0, &vy1, y, vl); - vr0 = VFMACCVV_FLOAT(vr0, vx0, vy0, vl); - vr1 = VFMACCVV_FLOAT(vr1, vx0, vy1, vl); + vr0 = VFMACCVV_FLOAT_TU(vr0, vx0, vy0, vl); + vr1 = VFMACCVV_FLOAT_TU(vr1, vx0, vy1, vl); #if !defined(CONJ) - vr0 = VFNMSACVV_FLOAT(vr0, vx1, vy1, vl); - vr1 = VFMACCVV_FLOAT(vr1, vx1, vy0, vl); + vr0 = VFNMSACVV_FLOAT_TU(vr0, vx1, vy1, vl); + vr1 = VFMACCVV_FLOAT_TU(vr1, vx1, vy0, vl); #else - vr0 = VFMACCVV_FLOAT(vr0, vx1, vy1, vl); - vr1 = VFNMSACVV_FLOAT(vr1, vx1, vy0, vl); + vr0 = VFMACCVV_FLOAT_TU(vr0, vx1, vy1, vl); + vr1 = VFNMSACVV_FLOAT_TU(vr1, vx1, vy0, vl); #endif } }else { @@ -148,14 +148,14 @@ OPENBLAS_COMPLEX_FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLA VLSSEG_FLOAT(&vx0, &vx1, x, stride_x, vl); VLSSEG_FLOAT(&vy0, &vy1, y, stride_y, vl); - vr0 = VFMACCVV_FLOAT(vr0, vx0, vy0, vl); - vr1 = VFMACCVV_FLOAT(vr1, vx0, vy1, vl); + vr0 = VFMACCVV_FLOAT_TU(vr0, vx0, vy0, vl); + vr1 = VFMACCVV_FLOAT_TU(vr1, vx0, vy1, vl); #if !defined(CONJ) - vr0 = VFNMSACVV_FLOAT(vr0, vx1, vy1, vl); - vr1 = VFMACCVV_FLOAT(vr1, vx1, vy0, vl); + vr0 = VFNMSACVV_FLOAT_TU(vr0, vx1, vy1, vl); + vr1 = VFMACCVV_FLOAT_TU(vr1, vx1, vy0, vl); #else - vr0 = VFMACCVV_FLOAT(vr0, vx1, vy1, vl); - vr1 = VFNMSACVV_FLOAT(vr1, vx1, vy0, vl); + vr0 = VFMACCVV_FLOAT_TU(vr0, vx1, vy1, vl); + vr1 = VFNMSACVV_FLOAT_TU(vr1, vx1, vy0, vl); #endif } } diff --git a/kernel/riscv64/znrm2_rvv.c b/kernel/riscv64/znrm2_rvv.c index 5f7873b5a..d2b27aa8d 100644 --- a/kernel/riscv64/znrm2_rvv.c +++ b/kernel/riscv64/znrm2_rvv.c @@ -36,10 +36,10 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VLSEG_FLOAT __riscv_vlseg2e32_v_f32m4 #define VLSSEG_FLOAT __riscv_vlsseg2e32_v_f32m4 #define VFREDSUM_FLOAT __riscv_vfredusum_vs_f32m4_f32m1 -#define VFMACCVV_FLOAT __riscv_vfmacc_vv_f32m4 +#define VFMACCVV_FLOAT_TU __riscv_vfmacc_vv_f32m4_tu #define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m4 #define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f32m1 -#define VFREDMAXVS_FLOAT __riscv_vfredmax_vs_f32m4_f32m1 +#define VFREDMAXVS_FLOAT_TU __riscv_vfredmax_vs_f32m4_f32m1_tu #define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f32m1_f32 #define VFABSV_FLOAT __riscv_vfabs_v_f32m4 #else @@ -51,10 +51,10 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VLSEG_FLOAT __riscv_vlseg2e64_v_f64m4 #define VLSSEG_FLOAT __riscv_vlsseg2e64_v_f64m4 #define VFREDSUM_FLOAT __riscv_vfredusum_vs_f64m4_f64m1 -#define VFMACCVV_FLOAT __riscv_vfmacc_vv_f64m4 +#define VFMACCVV_FLOAT_TU __riscv_vfmacc_vv_f64m4_tu #define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m4 #define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f64m1 -#define VFREDMAXVS_FLOAT __riscv_vfredmax_vs_f64m4_f64m1 +#define VFREDMAXVS_FLOAT_TU __riscv_vfredmax_vs_f64m4_f64m1_tu #define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f64m1_f64 #define VFABSV_FLOAT __riscv_vfabs_v_f64m4 #endif @@ -85,11 +85,11 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) v0 = VFABSV_FLOAT(v0, vl); v1 = VFABSV_FLOAT(v1, vl); - v_max = VFREDMAXVS_FLOAT(v0, v_max, vl); - vr = VFMACCVV_FLOAT(vr, v0, v0, vl); + v_max = VFREDMAXVS_FLOAT_TU(v_max, v0, v_max, vl); + vr = VFMACCVV_FLOAT_TU(vr, v0, v0, vl); - v_max = VFREDMAXVS_FLOAT(v1, v_max, vl); - vr = VFMACCVV_FLOAT(vr, v1, v1, vl); + v_max = VFREDMAXVS_FLOAT_TU(v_max, v1, v_max, vl); + vr = VFMACCVV_FLOAT_TU(vr, v1, v1, vl); } } else { @@ -103,11 +103,11 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) v0 = VFABSV_FLOAT(v0, vl); v1 = VFABSV_FLOAT(v1, vl); - v_max = VFREDMAXVS_FLOAT(v0, v_max, vl); - vr = VFMACCVV_FLOAT(vr, v0, v0, vl); + v_max = VFREDMAXVS_FLOAT_TU(v_max, v0, v_max, vl); + vr = VFMACCVV_FLOAT_TU(vr, v0, v0, vl); - v_max = VFREDMAXVS_FLOAT(v1, v_max, vl); - vr = VFMACCVV_FLOAT(vr, v1, v1, vl); + v_max = VFREDMAXVS_FLOAT_TU(v_max, v1, v_max, vl); + vr = VFMACCVV_FLOAT_TU(vr, v1, v1, vl); } } diff --git a/kernel/riscv64/zsum_rvv.c b/kernel/riscv64/zsum_rvv.c index 44df112c6..b41f70eb5 100644 --- a/kernel/riscv64/zsum_rvv.c +++ b/kernel/riscv64/zsum_rvv.c @@ -38,7 +38,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m4 #define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f32m1 #define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f32m1_f32 -#define VFADDVV_FLOAT __riscv_vfadd_vv_f32m4 +#define VFADDVV_FLOAT_TU __riscv_vfadd_vv_f32m4_tu #else #define VSETVL(n) __riscv_vsetvl_e64m4(n) #define VSETVL_MAX __riscv_vsetvlmax_e64m4() @@ -50,7 +50,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m4 #define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f64m1 #define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f64m1_f64 -#define VFADDVV_FLOAT __riscv_vfadd_vv_f64m4 +#define VFADDVV_FLOAT_TU __riscv_vfadd_vv_f64m4_tu #endif FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) @@ -69,8 +69,8 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) VLSEG_FLOAT(&v0, &v1, x, vl); - v_sum = VFADDVV_FLOAT(v_sum, v0, vl); - v_sum = VFADDVV_FLOAT(v_sum, v1, vl); + v_sum = VFADDVV_FLOAT_TU(v_sum, v_sum, v0, vl); + v_sum = VFADDVV_FLOAT_TU(v_sum, v_sum, v1, vl); } } else { @@ -82,8 +82,8 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) VLSSEG_FLOAT(&v0, &v1, x, stride_x, vl); - v_sum = VFADDVV_FLOAT(v_sum, v0, vl); - v_sum = VFADDVV_FLOAT(v_sum, v1, vl); + v_sum = VFADDVV_FLOAT_TU(v_sum, v_sum, v0, vl); + v_sum = VFADDVV_FLOAT_TU(v_sum, v_sum, v1, vl); } } From 826a9d5fa47f20f23f42c97385e72e121a2efb4f Mon Sep 17 00:00:00 2001 From: Octavian Maghiar Date: Tue, 25 Jul 2023 11:36:23 +0100 Subject: [PATCH 020/311] Adds tail undisturbed for RVV Level 2 operations During the last iteration of some RVV operations, accumulators can get overwritten when VL < VLMAX and tail policy is agnostic. Commit changes intrinsics tail policy to undistrubed. --- kernel/riscv64/gemv_t_rvv.c | 8 ++++---- kernel/riscv64/symv_L_rvv.c | 12 +++++------ kernel/riscv64/symv_U_rvv.c | 12 +++++------ kernel/riscv64/zgemv_t_rvv.c | 40 ++++++++++++++++++------------------ 4 files changed, 36 insertions(+), 36 deletions(-) diff --git a/kernel/riscv64/gemv_t_rvv.c b/kernel/riscv64/gemv_t_rvv.c index f0c834866..9c859aa50 100644 --- a/kernel/riscv64/gemv_t_rvv.c +++ b/kernel/riscv64/gemv_t_rvv.c @@ -36,7 +36,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VLEV_FLOAT __riscv_vle32_v_f32m8 #define VLSEV_FLOAT __riscv_vlse32_v_f32m8 #define VFREDSUM_FLOAT __riscv_vfredusum_vs_f32m8_f32m1 -#define VFMACCVV_FLOAT __riscv_vfmacc_vv_f32m8 +#define VFMACCVV_FLOAT_TU __riscv_vfmacc_vv_f32m8_tu #define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m8 #define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f32m1 #define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f32m1_f32 @@ -49,7 +49,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VLEV_FLOAT __riscv_vle64_v_f64m8 #define VLSEV_FLOAT __riscv_vlse64_v_f64m8 #define VFREDSUM_FLOAT __riscv_vfredusum_vs_f64m8_f64m1 -#define VFMACCVV_FLOAT __riscv_vfmacc_vv_f64m8 +#define VFMACCVV_FLOAT_TU __riscv_vfmacc_vv_f64m8_tu #define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m8 #define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f64m1 #define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f64m1_f64 @@ -79,7 +79,7 @@ int CNAME(BLASLONG m, BLASLONG n, BLASLONG dummy1, FLOAT alpha, FLOAT *a, BLASLO va = VLEV_FLOAT(a_ptr, vl); vx = VLEV_FLOAT(x_ptr, vl); - vr = VFMACCVV_FLOAT(vr, va, vx, vl); + vr = VFMACCVV_FLOAT_TU(vr, va, vx, vl); } v_res = VFREDSUM_FLOAT(vr, v_z0, vlmax); @@ -103,7 +103,7 @@ int CNAME(BLASLONG m, BLASLONG n, BLASLONG dummy1, FLOAT alpha, FLOAT *a, BLASLO va = VLEV_FLOAT(a_ptr, vl); vx = VLSEV_FLOAT(x_ptr, stride_x, vl); - vr = VFMACCVV_FLOAT(vr, va, vx, vl); + vr = VFMACCVV_FLOAT_TU(vr, va, vx, vl); } v_res = VFREDSUM_FLOAT(vr, v_z0, vlmax); diff --git a/kernel/riscv64/symv_L_rvv.c b/kernel/riscv64/symv_L_rvv.c index b27db2e37..888d628a5 100644 --- a/kernel/riscv64/symv_L_rvv.c +++ b/kernel/riscv64/symv_L_rvv.c @@ -37,7 +37,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VSEV_FLOAT __riscv_vse32_v_f32m8 #define VLSEV_FLOAT __riscv_vlse32_v_f32m8 #define VSSEV_FLOAT __riscv_vsse32_v_f32m8 -#define VFMACCVV_FLOAT __riscv_vfmacc_vv_f32m8 +#define VFMACCVV_FLOAT_TU __riscv_vfmacc_vv_f32m8_tu #define VFMACCVF_FLOAT __riscv_vfmacc_vf_f32m8 #define VFNMSACVF_FLOAT __riscv_vfnmsac_vf_f32m8 #define VFMULVF_FLOAT __riscv_vfmul_vf_f32m8 @@ -56,7 +56,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VSEV_FLOAT __riscv_vse64_v_f64m8 #define VLSEV_FLOAT __riscv_vlse64_v_f64m8 #define VSSEV_FLOAT __riscv_vsse64_v_f64m8 -#define VFMACCVV_FLOAT __riscv_vfmacc_vv_f64m8 +#define VFMACCVV_FLOAT_TU __riscv_vfmacc_vv_f64m8_tu #define VFMACCVF_FLOAT __riscv_vfmacc_vf_f64m8 #define VFNMSACVF_FLOAT __riscv_vfnmsac_vf_f64m8 #define VFMULVF_FLOAT __riscv_vfmul_vf_f64m8 @@ -100,7 +100,7 @@ int CNAME(BLASLONG m, BLASLONG offset, FLOAT alpha, FLOAT *a, BLASLONG lda, FLOA VSEV_FLOAT(&y[i], vy, vl); vx = VLEV_FLOAT(&x[i], vl); - vr = VFMACCVV_FLOAT(vr, vx, va, vl); + vr = VFMACCVV_FLOAT_TU(vr, vx, va, vl); } v_res = VFREDSUM_FLOAT(vr, v_z0, vlmax); @@ -130,7 +130,7 @@ int CNAME(BLASLONG m, BLASLONG offset, FLOAT alpha, FLOAT *a, BLASLONG lda, FLOA VSSEV_FLOAT(&y[iy], stride_y, vy, vl); vx = VLEV_FLOAT(&x[i], vl); - vr = VFMACCVV_FLOAT(vr, vx, va, vl); + vr = VFMACCVV_FLOAT_TU(vr, vx, va, vl); iy += inc_yv; } @@ -163,7 +163,7 @@ int CNAME(BLASLONG m, BLASLONG offset, FLOAT alpha, FLOAT *a, BLASLONG lda, FLOA VSEV_FLOAT(&y[i], vy, vl); vx = VLSEV_FLOAT(&x[ix], stride_x, vl); - vr = VFMACCVV_FLOAT(vr, vx, va, vl); + vr = VFMACCVV_FLOAT_TU(vr, vx, va, vl); ix += inc_xv; } @@ -201,7 +201,7 @@ int CNAME(BLASLONG m, BLASLONG offset, FLOAT alpha, FLOAT *a, BLASLONG lda, FLOA VSSEV_FLOAT(&y[iy], stride_y, vy, vl); vx = VLSEV_FLOAT(&x[ix], stride_x, vl); - vr = VFMACCVV_FLOAT(vr, vx, va, vl); + vr = VFMACCVV_FLOAT_TU(vr, vx, va, vl); ix += inc_xv; iy += inc_yv; diff --git a/kernel/riscv64/symv_U_rvv.c b/kernel/riscv64/symv_U_rvv.c index 7e45b1a01..3cfd3ee4c 100644 --- a/kernel/riscv64/symv_U_rvv.c +++ b/kernel/riscv64/symv_U_rvv.c @@ -38,7 +38,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VSEV_FLOAT __riscv_vse32_v_f32m8 #define VLSEV_FLOAT __riscv_vlse32_v_f32m8 #define VSSEV_FLOAT __riscv_vsse32_v_f32m8 -#define VFMACCVV_FLOAT __riscv_vfmacc_vv_f32m8 +#define VFMACCVV_FLOAT_TU __riscv_vfmacc_vv_f32m8_tu #define VFMACCVF_FLOAT __riscv_vfmacc_vf_f32m8 #define VFNMSACVF_FLOAT __riscv_vfnmsac_vf_f32m8 #define VFMULVF_FLOAT __riscv_vfmul_vf_f32m8 @@ -57,7 +57,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VSEV_FLOAT __riscv_vse64_v_f64m8 #define VLSEV_FLOAT __riscv_vlse64_v_f64m8 #define VSSEV_FLOAT __riscv_vsse64_v_f64m8 -#define VFMACCVV_FLOAT __riscv_vfmacc_vv_f64m8 +#define VFMACCVV_FLOAT_TU __riscv_vfmacc_vv_f64m8_tu #define VFMACCVF_FLOAT __riscv_vfmacc_vf_f64m8 #define VFNMSACVF_FLOAT __riscv_vfnmsac_vf_f64m8 #define VFMULVF_FLOAT __riscv_vfmul_vf_f64m8 @@ -101,7 +101,7 @@ int CNAME(BLASLONG m, BLASLONG offset, FLOAT alpha, FLOAT *a, BLASLONG lda, FLOA VSEV_FLOAT(&y[i], vy, vl); vx = VLEV_FLOAT(&x[i], vl); - vr = VFMACCVV_FLOAT(vr, vx, va, vl); + vr = VFMACCVV_FLOAT_TU(vr, vx, va, vl); } v_res = VFREDSUM_FLOAT(vr, v_z0, vl_max); @@ -130,7 +130,7 @@ int CNAME(BLASLONG m, BLASLONG offset, FLOAT alpha, FLOAT *a, BLASLONG lda, FLOA VSSEV_FLOAT(&y[iy], stride_y, vy, vl); vx = VLEV_FLOAT(&x[i], vl); - vr = VFMACCVV_FLOAT(vr, vx, va, vl); + vr = VFMACCVV_FLOAT_TU(vr, vx, va, vl); iy += inc_yv; } @@ -163,7 +163,7 @@ int CNAME(BLASLONG m, BLASLONG offset, FLOAT alpha, FLOAT *a, BLASLONG lda, FLOA VSEV_FLOAT(&y[i], vy, vl); vx = VLSEV_FLOAT(&x[ix], stride_x, vl); - vr = VFMACCVV_FLOAT(vr, vx, va, vl); + vr = VFMACCVV_FLOAT_TU(vr, vx, va, vl); ix += inc_xv; } @@ -200,7 +200,7 @@ int CNAME(BLASLONG m, BLASLONG offset, FLOAT alpha, FLOAT *a, BLASLONG lda, FLOA VSSEV_FLOAT(&y[iy], stride_y, vy, vl); vx = VLSEV_FLOAT(&x[ix], stride_x, vl); - vr = VFMACCVV_FLOAT(vr, vx, va, vl); + vr = VFMACCVV_FLOAT_TU(vr, vx, va, vl); ix += inc_xv; iy += inc_yv; } diff --git a/kernel/riscv64/zgemv_t_rvv.c b/kernel/riscv64/zgemv_t_rvv.c index 15795cc3a..2f0380530 100644 --- a/kernel/riscv64/zgemv_t_rvv.c +++ b/kernel/riscv64/zgemv_t_rvv.c @@ -35,8 +35,8 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VLSEG_FLOAT __riscv_vlseg2e32_v_f32m4 #define VLSSEG_FLOAT __riscv_vlsseg2e32_v_f32m4 #define VFREDSUM_FLOAT __riscv_vfredusum_vs_f32m4_f32m1 -#define VFMACCVV_FLOAT __riscv_vfmacc_vv_f32m4 -#define VFNMSACVV_FLOAT __riscv_vfnmsac_vv_f32m4 +#define VFMACCVV_FLOAT_TU __riscv_vfmacc_vv_f32m4_tu +#define VFNMSACVV_FLOAT_TU __riscv_vfnmsac_vv_f32m4_tu #define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m4 #define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f32m1 #define VFMULVV_FLOAT __riscv_vfmul_vv_f32m4 @@ -49,8 +49,8 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VLSEG_FLOAT __riscv_vlseg2e64_v_f64m4 #define VLSSEG_FLOAT __riscv_vlsseg2e64_v_f64m4 #define VFREDSUM_FLOAT __riscv_vfredusum_vs_f64m4_f64m1 -#define VFMACCVV_FLOAT __riscv_vfmacc_vv_f64m4 -#define VFNMSACVV_FLOAT __riscv_vfnmsac_vv_f64m4 +#define VFMACCVV_FLOAT_TU __riscv_vfmacc_vv_f64m4_tu +#define VFNMSACVV_FLOAT_TU __riscv_vfnmsac_vv_f64m4_tu #define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m4 #define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f64m1 #define VFMULVV_FLOAT __riscv_vfmul_vv_f64m4 @@ -90,15 +90,15 @@ int CNAME(BLASLONG m, BLASLONG n, BLASLONG dummy1, FLOAT alpha_r, FLOAT alpha_i, VLSEG_FLOAT(&vx0, &vx1, &x[ix], vl); #if ( !defined(CONJ) && !defined(XCONJ) ) || ( defined(CONJ) && defined(XCONJ) ) - vr = VFMACCVV_FLOAT(vr, va0, vx0, vl); - vr = VFNMSACVV_FLOAT(vr, va1, vx1, vl); - vi = VFMACCVV_FLOAT(vi, va0, vx1, vl); - vi = VFMACCVV_FLOAT(vi, va1, vx0, vl); + vr = VFMACCVV_FLOAT_TU(vr, va0, vx0, vl); + vr = VFNMSACVV_FLOAT_TU(vr, va1, vx1, vl); + vi = VFMACCVV_FLOAT_TU(vi, va0, vx1, vl); + vi = VFMACCVV_FLOAT_TU(vi, va1, vx0, vl); #else - vr = VFMACCVV_FLOAT(vr, va0, vx0, vl); - vr = VFMACCVV_FLOAT(vr, va1, vx1, vl); - vi = VFMACCVV_FLOAT(vi, va0, vx1, vl); - vi = VFNMSACVV_FLOAT(vi, va1, vx0, vl); + vr = VFMACCVV_FLOAT_TU(vr, va0, vx0, vl); + vr = VFMACCVV_FLOAT_TU(vr, va1, vx1, vl); + vi = VFMACCVV_FLOAT_TU(vi, va0, vx1, vl); + vi = VFNMSACVV_FLOAT_TU(vi, va1, vx0, vl); #endif j += vl * 2; ix += vl * inc_x * 2; @@ -134,15 +134,15 @@ int CNAME(BLASLONG m, BLASLONG n, BLASLONG dummy1, FLOAT alpha_r, FLOAT alpha_i, VLSSEG_FLOAT(&vx0, &vx1, &x[ix], stride_x, vl); #if ( !defined(CONJ) && !defined(XCONJ) ) || ( defined(CONJ) && defined(XCONJ) ) - vr = VFMACCVV_FLOAT(vr, va0, vx0, vl); - vr = VFNMSACVV_FLOAT(vr, va1, vx1, vl); - vi = VFMACCVV_FLOAT(vi, va0, vx1, vl); - vi = VFMACCVV_FLOAT(vi, va1, vx0, vl); + vr = VFMACCVV_FLOAT_TU(vr, va0, vx0, vl); + vr = VFNMSACVV_FLOAT_TU(vr, va1, vx1, vl); + vi = VFMACCVV_FLOAT_TU(vi, va0, vx1, vl); + vi = VFMACCVV_FLOAT_TU(vi, va1, vx0, vl); #else - vr = VFMACCVV_FLOAT(vr, va0, vx0, vl); - vr = VFMACCVV_FLOAT(vr, va1, vx1, vl); - vi = VFMACCVV_FLOAT(vi, va0, vx1, vl); - vi = VFNMSACVV_FLOAT(vi, va1, vx0, vl); + vr = VFMACCVV_FLOAT_TU(vr, va0, vx0, vl); + vr = VFMACCVV_FLOAT_TU(vr, va1, vx1, vl); + vi = VFMACCVV_FLOAT_TU(vi, va0, vx1, vl); + vi = VFNMSACVV_FLOAT_TU(vi, va1, vx0, vl); #endif j += vl * 2; ix += vl * inc_x * 2; From 4d0f000db63fedbe62ca318bb7bcd5d3152fc4a2 Mon Sep 17 00:00:00 2001 From: gxw Date: Mon, 7 Aug 2023 16:55:59 +0800 Subject: [PATCH 021/311] MIPS: Enable MSA --- kernel/mips/KERNEL.P5600 | 34 ++++++++++----------- kernel/mips64/KERNEL.LOONGSON3R4 | 32 ++++++++++---------- param.h | 52 ++++++++++++++++---------------- 3 files changed, 59 insertions(+), 59 deletions(-) diff --git a/kernel/mips/KERNEL.P5600 b/kernel/mips/KERNEL.P5600 index 9a6e06d67..2e1e3390d 100644 --- a/kernel/mips/KERNEL.P5600 +++ b/kernel/mips/KERNEL.P5600 @@ -35,7 +35,7 @@ DSUMKERNEL = ../mips/sum.c CSUMKERNEL = ../mips/zsum.c ZSUMKERNEL = ../mips/zsum.c -ifdef HAVE_MSA +ifndef NO_MSA SASUMKERNEL = ../mips/sasum_msa.c DASUMKERNEL = ../mips/dasum_msa.c CASUMKERNEL = ../mips/casum_msa.c @@ -47,7 +47,7 @@ CASUMKERNEL = ../mips/zasum.c ZASUMKERNEL = ../mips/zasum.c endif -ifdef HAVE_MSA +ifndef NO_MSA SAXPYKERNEL = ../mips/saxpy_msa.c DAXPYKERNEL = ../mips/daxpy_msa.c CAXPYKERNEL = ../mips/caxpy_msa.c @@ -59,7 +59,7 @@ CAXPYKERNEL = ../mips/zaxpy.c ZAXPYKERNEL = ../mips/zaxpy.c endif -ifdef HAVE_MSA +ifndef NO_MSA SCOPYKERNEL = ../mips/scopy_msa.c DCOPYKERNEL = ../mips/dcopy_msa.c CCOPYKERNEL = ../mips/ccopy_msa.c @@ -71,7 +71,7 @@ CCOPYKERNEL = ../mips/zcopy.c ZCOPYKERNEL = ../mips/zcopy.c endif -ifdef HAVE_MSA +ifndef NO_MSA SDOTKERNEL = ../mips/sdot_msa.c DDOTKERNEL = ../mips/ddot_msa.c CDOTKERNEL = ../mips/cdot_msa.c @@ -88,7 +88,7 @@ DNRM2KERNEL = ../mips/nrm2.c CNRM2KERNEL = ../mips/znrm2.c ZNRM2KERNEL = ../mips/znrm2.c -ifdef HAVE_MSA +ifndef NO_MSA SROTKERNEL = ../mips/srot_msa.c DROTKERNEL = ../mips/drot_msa.c CROTKERNEL = ../mips/crot_msa.c @@ -100,7 +100,7 @@ CROTKERNEL = ../mips/zrot.c ZROTKERNEL = ../mips/zrot.c endif -ifdef HAVE_MSA +ifndef NO_MSA SSCALKERNEL = ../mips/sscal_msa.c DSCALKERNEL = ../mips/dscal_msa.c CSCALKERNEL = ../mips/cscal_msa.c @@ -112,7 +112,7 @@ CSCALKERNEL = ../mips/zscal.c ZSCALKERNEL = ../mips/zscal.c endif -ifdef HAVE_MSA +ifndef NO_MSA SSWAPKERNEL = ../mips/sswap_msa.c DSWAPKERNEL = ../mips/dswap_msa.c CSWAPKERNEL = ../mips/cswap_msa.c @@ -124,7 +124,7 @@ CSWAPKERNEL = ../mips/zswap.c ZSWAPKERNEL = ../mips/zswap.c endif -ifdef HAVE_MSA +ifndef NO_MSA SGEMVNKERNEL = ../mips/sgemv_n_msa.c DGEMVNKERNEL = ../mips/dgemv_n_msa.c CGEMVNKERNEL = ../mips/cgemv_n_msa.c @@ -136,7 +136,7 @@ CGEMVNKERNEL = ../mips/zgemv_n.c ZGEMVNKERNEL = ../mips/zgemv_n.c endif -ifdef HAVE_MSA +ifndef NO_MSA SGEMVTKERNEL = ../mips/sgemv_t_msa.c DGEMVTKERNEL = ../mips/dgemv_t_msa.c CGEMVTKERNEL = ../mips/cgemv_t_msa.c @@ -148,7 +148,7 @@ CGEMVTKERNEL = ../mips/zgemv_t.c ZGEMVTKERNEL = ../mips/zgemv_t.c endif -ifdef HAVE_MSA +ifndef NO_MSA SGEMMKERNEL = ../mips/sgemm_kernel_8x8_msa.c SGEMMONCOPY = ../mips/sgemm_ncopy_8_msa.c SGEMMOTCOPY = ../mips/sgemm_tcopy_8_msa.c @@ -162,7 +162,7 @@ SGEMMONCOPYOBJ = sgemm_oncopy.o SGEMMOTCOPYOBJ = sgemm_otcopy.o endif -ifdef HAVE_MSA +ifndef NO_MSA DGEMMKERNEL = ../mips/dgemm_kernel_8x4_msa.c DGEMMINCOPY = ../mips/dgemm_ncopy_8_msa.c DGEMMITCOPY = ../mips/dgemm_tcopy_8_msa.c @@ -180,7 +180,7 @@ DGEMMONCOPYOBJ = dgemm_oncopy.o DGEMMOTCOPYOBJ = dgemm_otcopy.o endif -ifdef HAVE_MSA +ifndef NO_MSA CGEMMKERNEL = ../mips/cgemm_kernel_8x4_msa.c CGEMMINCOPY = ../mips/cgemm_ncopy_8_msa.c CGEMMITCOPY = ../mips/cgemm_tcopy_8_msa.c @@ -198,7 +198,7 @@ CGEMMONCOPYOBJ = cgemm_oncopy.o CGEMMOTCOPYOBJ = cgemm_otcopy.o endif -ifdef HAVE_MSA +ifndef NO_MSA ZGEMMKERNEL = ../mips/zgemm_kernel_4x4_msa.c ZGEMMONCOPY = ../mips/zgemm_ncopy_4_msa.c ZGEMMOTCOPY = ../mips/zgemm_tcopy_4_msa.c @@ -212,7 +212,7 @@ ZGEMMONCOPYOBJ = zgemm_oncopy.o ZGEMMOTCOPYOBJ = zgemm_otcopy.o endif -ifdef HAVE_MSA +ifndef NO_MSA STRSMKERNEL_LN = ../mips/strsm_kernel_LN_8x8_msa.c STRSMKERNEL_LT = ../mips/strsm_kernel_LT_8x8_msa.c STRSMKERNEL_RN = ../mips/strsm_kernel_RN_8x8_msa.c @@ -224,7 +224,7 @@ STRSMKERNEL_RN = ../generic/trsm_kernel_RN.c STRSMKERNEL_RT = ../generic/trsm_kernel_RT.c endif -ifdef HAVE_MSA +ifndef NO_MSA DTRSMKERNEL_LN = ../mips/dtrsm_kernel_LN_8x4_msa.c DTRSMKERNEL_LT = ../mips/dtrsm_kernel_LT_8x4_msa.c DTRSMKERNEL_RN = ../mips/dtrsm_kernel_RN_8x4_msa.c @@ -236,7 +236,7 @@ DTRSMKERNEL_RN = ../generic/trsm_kernel_RN.c DTRSMKERNEL_RT = ../generic/trsm_kernel_RT.c endif -ifdef HAVE_MSA +ifndef NO_MSA CTRSMKERNEL_LN = ../generic/trsm_kernel_LN.c CTRSMKERNEL_LT = ../generic/trsm_kernel_LT.c CTRSMKERNEL_RN = ../generic/trsm_kernel_RN.c @@ -248,7 +248,7 @@ CTRSMKERNEL_RN = ../generic/trsm_kernel_RN.c CTRSMKERNEL_RT = ../generic/trsm_kernel_RT.c endif -ifdef HAVE_MSA +ifndef NO_MSA ZTRSMKERNEL_LN = ../generic/trsm_kernel_LN.c ZTRSMKERNEL_LT = ../generic/trsm_kernel_LT.c ZTRSMKERNEL_RN = ../generic/trsm_kernel_RN.c diff --git a/kernel/mips64/KERNEL.LOONGSON3R4 b/kernel/mips64/KERNEL.LOONGSON3R4 index b81e5441d..1149d97f1 100644 --- a/kernel/mips64/KERNEL.LOONGSON3R4 +++ b/kernel/mips64/KERNEL.LOONGSON3R4 @@ -1,4 +1,4 @@ -ifdef HAVE_MSA +ifndef NO_MSA SAXPYKERNEL = ../mips/saxpy_msa.c DAXPYKERNEL = ../mips/daxpy_msa.c CAXPYKERNEL = ../mips/caxpy_msa.c @@ -8,14 +8,14 @@ SAXPYKERNEL = axpy_loongson3a.S DAXPYKERNEL = daxpy_loongson3a_simd.S endif -ifdef HAVE_MSA +ifndef NO_MSA SCOPYKERNEL = ../mips/scopy_msa.c DCOPYKERNEL = ../mips/dcopy_msa.c CCOPYKERNEL = ../mips/ccopy_msa.c ZCOPYKERNEL = ../mips/zcopy_msa.c endif -ifdef HAVE_MSA +ifndef NO_MSA SDOTKERNEL = ../mips/sdot_msa.c DDOTKERNEL = ../mips/ddot_msa.c CDOTKERNEL = ../mips/cdot_msa.c @@ -23,21 +23,21 @@ ZDOTKERNEL = ../mips/zdot_msa.c endif DSDOTKERNEL = ../mips/dot.c -ifdef HAVE_MSA +ifndef NO_MSA SROTKERNEL = ../mips/srot_msa.c DROTKERNEL = ../mips/drot_msa.c CROTKERNEL = ../mips/crot_msa.c ZROTKERNEL = ../mips/zrot_msa.c endif -ifdef HAVE_MSA +ifndef NO_MSA SSCALKERNEL = ../mips/sscal_msa.c DSCALKERNEL = ../mips/dscal_msa.c CSCALKERNEL = ../mips/cscal_msa.c ZSCALKERNEL = ../mips/zscal_msa.c endif -ifdef HAVE_MSA +ifndef NO_MSA SGEMVNKERNEL = ../mips/sgemv_n_msa.c DGEMVNKERNEL = ../mips/dgemv_n_msa.c SGEMVTKERNEL = ../mips/sgemv_t_msa.c @@ -57,21 +57,21 @@ ZGEMVNKERNEL = zgemv_n_loongson3a.c ZGEMVTKERNEL = zgemv_t_loongson3a.c endif -ifdef HAVE_MSA +ifndef NO_MSA SASUMKERNEL = ../mips/sasum_msa.c DASUMKERNEL = ../mips/dasum_msa.c CASUMKERNEL = ../mips/casum_msa.c ZASUMKERNEL = ../mips/zasum_msa.c endif -ifdef HAVE_MSA +ifndef NO_MSA SSWAPKERNEL = ../mips/sswap_msa.c DSWAPKERNEL = ../mips/dswap_msa.c CSWAPKERNEL = ../mips/cswap_msa.c ZSWAPKERNEL = ../mips/zswap_msa.c endif -ifdef HAVE_MSA +ifndef NO_MSA SGEMMKERNEL = ../mips/sgemm_kernel_8x8_msa.c SGEMMONCOPY = ../mips/sgemm_ncopy_8_msa.c SGEMMOTCOPY = ../mips/sgemm_tcopy_8_msa.c @@ -89,7 +89,7 @@ SGEMMONCOPYOBJ = sgemm_oncopy$(TSUFFIX).$(SUFFIX) SGEMMOTCOPYOBJ = sgemm_otcopy$(TSUFFIX).$(SUFFIX) endif -ifdef HAVE_MSA +ifndef NO_MSA DGEMMKERNEL = ../mips/dgemm_kernel_8x4_msa.c DGEMMINCOPY = ../mips/dgemm_ncopy_8_msa.c DGEMMITCOPY = ../mips/dgemm_tcopy_8_msa.c @@ -107,7 +107,7 @@ DGEMMONCOPYOBJ = dgemm_oncopy$(TSUFFIX).$(SUFFIX) DGEMMOTCOPYOBJ = dgemm_otcopy$(TSUFFIX).$(SUFFIX) endif -ifdef HAVE_MSA +ifndef NO_MSA CGEMMKERNEL = ../mips/cgemm_kernel_8x4_msa.c CGEMMINCOPY = ../mips/cgemm_ncopy_8_msa.c CGEMMITCOPY = ../mips/cgemm_tcopy_8_msa.c @@ -129,7 +129,7 @@ CGEMMONCOPYOBJ = cgemm_oncopy$(TSUFFIX).$(SUFFIX) CGEMMOTCOPYOBJ = cgemm_otcopy$(TSUFFIX).$(SUFFIX) endif -ifdef HAVE_MSA +ifndef NO_MSA ZGEMMKERNEL = ../mips/zgemm_kernel_4x4_msa.c ZGEMMONCOPY = ../mips/zgemm_ncopy_4_msa.c ZGEMMOTCOPY = ../mips/zgemm_tcopy_4_msa.c @@ -143,7 +143,7 @@ ZGEMMONCOPYOBJ = zgemm_oncopy$(TSUFFIX).$(SUFFIX) ZGEMMOTCOPYOBJ = zgemm_otcopy$(TSUFFIX).$(SUFFIX) endif -ifdef HAVE_MSA +ifndef NO_MSA STRSMKERNEL_LN = ../mips/strsm_kernel_LN_8x8_msa.c STRSMKERNEL_LT = ../mips/strsm_kernel_LT_8x8_msa.c STRSMKERNEL_RN = ../mips/strsm_kernel_RN_8x8_msa.c @@ -155,7 +155,7 @@ STRSMKERNEL_RN = ../generic/trsm_kernel_RN.c STRSMKERNEL_RT = ../generic/trsm_kernel_RT.c endif -ifdef HAVE_MSA +ifndef NO_MSA DTRSMKERNEL_LN = ../mips/dtrsm_kernel_LN_8x4_msa.c DTRSMKERNEL_LT = ../mips/dtrsm_kernel_LT_8x4_msa.c DTRSMKERNEL_RN = ../mips/dtrsm_kernel_RN_8x4_msa.c @@ -167,7 +167,7 @@ DTRSMKERNEL_RN = ../generic/trsm_kernel_RN.c DTRSMKERNEL_RT = ../generic/trsm_kernel_RT.c endif -ifdef HAVE_MSA +ifndef NO_MSA CTRSMKERNEL_LN = ../generic/trsm_kernel_LN.c CTRSMKERNEL_LT = ../generic/trsm_kernel_LT.c CTRSMKERNEL_RN = ../generic/trsm_kernel_RN.c @@ -179,7 +179,7 @@ CTRSMKERNEL_RN = ../generic/trsm_kernel_RN.c CTRSMKERNEL_RT = ../generic/trsm_kernel_RT.c endif -ifdef HAVE_MSA +ifndef NO_MSA ZTRSMKERNEL_LN = ../generic/trsm_kernel_LN.c ZTRSMKERNEL_LT = ../generic/trsm_kernel_LT.c ZTRSMKERNEL_RN = ../generic/trsm_kernel_RN.c diff --git a/param.h b/param.h index 547463b2f..a4672ce07 100644 --- a/param.h +++ b/param.h @@ -2748,19 +2748,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define GEMM_DEFAULT_OFFSET_B 0 #define GEMM_DEFAULT_ALIGN (BLASLONG)0x03fffUL -#ifdef HAVE_MSA -#define SGEMM_DEFAULT_UNROLL_M 8 -#define SGEMM_DEFAULT_UNROLL_N 8 - -#define DGEMM_DEFAULT_UNROLL_M 8 -#define DGEMM_DEFAULT_UNROLL_N 4 - -#define CGEMM_DEFAULT_UNROLL_M 8 -#define CGEMM_DEFAULT_UNROLL_N 4 - -#define ZGEMM_DEFAULT_UNROLL_M 4 -#define ZGEMM_DEFAULT_UNROLL_N 4 -#else +#if defined(NO_MSA) #define SGEMM_DEFAULT_UNROLL_M 8 #define SGEMM_DEFAULT_UNROLL_N 4 @@ -2772,6 +2760,18 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define ZGEMM_DEFAULT_UNROLL_M 2 #define ZGEMM_DEFAULT_UNROLL_N 2 +#else +#define SGEMM_DEFAULT_UNROLL_M 8 +#define SGEMM_DEFAULT_UNROLL_N 8 + +#define DGEMM_DEFAULT_UNROLL_M 8 +#define DGEMM_DEFAULT_UNROLL_N 4 + +#define CGEMM_DEFAULT_UNROLL_M 8 +#define CGEMM_DEFAULT_UNROLL_N 4 + +#define ZGEMM_DEFAULT_UNROLL_M 4 +#define ZGEMM_DEFAULT_UNROLL_N 4 #endif #define SGEMM_DEFAULT_P 64 @@ -2961,19 +2961,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define GEMM_DEFAULT_OFFSET_B 0 #define GEMM_DEFAULT_ALIGN (BLASLONG) 0x03fffUL -#if defined(HAVE_MSA) -#define SGEMM_DEFAULT_UNROLL_M 8 -#define SGEMM_DEFAULT_UNROLL_N 8 - -#define DGEMM_DEFAULT_UNROLL_M 8 -#define DGEMM_DEFAULT_UNROLL_N 4 - -#define CGEMM_DEFAULT_UNROLL_M 8 -#define CGEMM_DEFAULT_UNROLL_N 4 - -#define ZGEMM_DEFAULT_UNROLL_M 4 -#define ZGEMM_DEFAULT_UNROLL_N 4 -#else +#if defined(NO_MSA) #define SGEMM_DEFAULT_UNROLL_M 2 #define SGEMM_DEFAULT_UNROLL_N 2 @@ -2985,6 +2973,18 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define ZGEMM_DEFAULT_UNROLL_M 2 #define ZGEMM_DEFAULT_UNROLL_N 2 +#else +#define SGEMM_DEFAULT_UNROLL_M 8 +#define SGEMM_DEFAULT_UNROLL_N 8 + +#define DGEMM_DEFAULT_UNROLL_M 8 +#define DGEMM_DEFAULT_UNROLL_N 4 + +#define CGEMM_DEFAULT_UNROLL_M 8 +#define CGEMM_DEFAULT_UNROLL_N 4 + +#define ZGEMM_DEFAULT_UNROLL_M 4 +#define ZGEMM_DEFAULT_UNROLL_N 4 #endif #define SGEMM_DEFAULT_P 128 From e4586e81b896b85b600c50f9670e59989cbdabf7 Mon Sep 17 00:00:00 2001 From: Octavian Maghiar Date: Mon, 4 Dec 2023 11:02:18 +0000 Subject: [PATCH 022/311] [RISC-V] Add RISC-V Vector 128-bit target Current RVV x280 target depends on vlen=512-bits for Level 3 operations. Commit adds generic target that supports vlen=128-bits. New target uses the same scalable kernels as x280 for Level 1&2 operations, and autogenerated kernels for Level 3 operations. Functional correctness of Level 3 operations tested on vlen=128-bits using QEMU v8.1.1 for ctests and BLAS-Tester. --- Makefile.prebuild | 4 + Makefile.riscv64 | 4 + TargetList.txt | 1 + cpuid_riscv64.c | 4 +- getarch.c | 13 +- kernel/riscv64/KERNEL.RISCV64_ZVL128B | 243 +++++ kernel/riscv64/cgemm_kernel_8x4_zvl128b.c | 996 +++++++++++++++++++ kernel/riscv64/ctrmm_kernel_8x4_zvl128b.c | 1102 +++++++++++++++++++++ kernel/riscv64/dgemm_kernel_8x4_zvl128b.c | 492 +++++++++ kernel/riscv64/dtrmm_kernel_8x4_zvl128b.c | 660 ++++++++++++ kernel/riscv64/sgemm_kernel_8x8_zvl128b.c | 791 +++++++++++++++ kernel/riscv64/strmm_kernel_8x8_zvl128b.c | 991 ++++++++++++++++++ kernel/riscv64/zgemm_kernel_4x4_zvl128b.c | 720 ++++++++++++++ kernel/riscv64/ztrmm_kernel_4x4_zvl128b.c | 805 +++++++++++++++ param.h | 39 + 15 files changed, 6863 insertions(+), 2 deletions(-) create mode 100644 kernel/riscv64/KERNEL.RISCV64_ZVL128B create mode 100644 kernel/riscv64/cgemm_kernel_8x4_zvl128b.c create mode 100644 kernel/riscv64/ctrmm_kernel_8x4_zvl128b.c create mode 100644 kernel/riscv64/dgemm_kernel_8x4_zvl128b.c create mode 100644 kernel/riscv64/dtrmm_kernel_8x4_zvl128b.c create mode 100644 kernel/riscv64/sgemm_kernel_8x8_zvl128b.c create mode 100644 kernel/riscv64/strmm_kernel_8x8_zvl128b.c create mode 100644 kernel/riscv64/zgemm_kernel_4x4_zvl128b.c create mode 100644 kernel/riscv64/ztrmm_kernel_4x4_zvl128b.c diff --git a/Makefile.prebuild b/Makefile.prebuild index c4f4a2602..b56169da0 100644 --- a/Makefile.prebuild +++ b/Makefile.prebuild @@ -59,6 +59,10 @@ ifeq ($(TARGET), x280) TARGET_FLAGS = -march=rv64imafdcv_zba_zbb_zfh -mabi=lp64d endif +ifeq ($(TARGET), RISCV64_ZVL128B) +TARGET_FLAGS = -march=rv64imafdcv -mabi=lp64d +endif + ifeq ($(TARGET), RISCV64_GENERIC) TARGET_FLAGS = -march=rv64imafdc -mabi=lp64d endif diff --git a/Makefile.riscv64 b/Makefile.riscv64 index ce7a27141..93e270bde 100644 --- a/Makefile.riscv64 +++ b/Makefile.riscv64 @@ -6,6 +6,10 @@ ifeq ($(CORE), x280) CCOMMON_OPT += -march=rv64imafdcv_zba_zbb_zfh_zvl512b -mabi=lp64d -ffast-math FCOMMON_OPT += -march=rv64imafdcv_zba_zbb_zfh -mabi=lp64d -static endif +ifeq ($(CORE), RISCV64_ZVL128B) +CCOMMON_OPT += -march=rv64imafdcv -mabi=lp64d +FCOMMON_OPT += -march=rv64imafdcv -mabi=lp64d -static +endif ifeq ($(CORE), RISCV64_GENERIC) CCOMMON_OPT += -march=rv64imafdc -mabi=lp64d FCOMMON_OPT += -march=rv64imafdc -mabi=lp64d -static diff --git a/TargetList.txt b/TargetList.txt index f76f605cc..5b7a63831 100644 --- a/TargetList.txt +++ b/TargetList.txt @@ -119,6 +119,7 @@ Z14 10.RISC-V 64: RISCV64_GENERIC (e.g. PolarFire Soc/SiFive U54) +RISCV64_ZVL128B C910V x280 diff --git a/cpuid_riscv64.c b/cpuid_riscv64.c index 1b6b62f21..15a539c20 100644 --- a/cpuid_riscv64.c +++ b/cpuid_riscv64.c @@ -73,11 +73,13 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define CPU_GENERIC 0 #define CPU_C910V 1 #define CPU_RISCV64_ZVL256B 2 +#define CPU_RISCV64_ZVL128B 3 static char *cpuname[] = { "RISCV64_GENERIC", "C910V", - "CPU_RISCV64_ZVL256B" + "CPU_RISCV64_ZVL256B", + "CPU_RISCV64_ZVL128B" }; int detect(void){ diff --git a/getarch.c b/getarch.c index 772836347..b8b7ef7e0 100644 --- a/getarch.c +++ b/getarch.c @@ -1691,7 +1691,18 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define CORENAME "x280" #else #endif - +#ifdef FORCE_RISCV64_ZVL128B +#define FORCE +#define ARCHITECTURE "RISCV64" +#define SUBARCHITECTURE "RISCV64_ZVL128B" +#define SUBDIRNAME "riscv64" +#define ARCHCONFIG "-DRISCV64_ZVL128B " \ + "-DL1_DATA_SIZE=32768 -DL1_DATA_LINESIZE=32 " \ + "-DL2_SIZE=1048576 -DL2_LINESIZE=32 " \ + "-DDTB_DEFAULT_ENTRIES=128 -DDTB_SIZE=4096 -DL2_ASSOCIATIVE=4 " +#define LIBNAME "riscv64_zvl128b" +#define CORENAME "RISCV64_ZVL128B" +#endif #if defined(FORCE_E2K) || defined(__e2k__) #define FORCE diff --git a/kernel/riscv64/KERNEL.RISCV64_ZVL128B b/kernel/riscv64/KERNEL.RISCV64_ZVL128B new file mode 100644 index 000000000..fec69ee09 --- /dev/null +++ b/kernel/riscv64/KERNEL.RISCV64_ZVL128B @@ -0,0 +1,243 @@ +SAMAXKERNEL = amax_rvv.c +DAMAXKERNEL = amax_rvv.c +CAMAXKERNEL = zamax_rvv.c +ZAMAXKERNEL = zamax_rvv.c + +SAMINKERNEL = amin_rvv.c +DAMINKERNEL = amin_rvv.c +CAMINKERNEL = zamin_rvv.c +ZAMINKERNEL = zamin_rvv.c + +SMAXKERNEL = max_rvv.c +DMAXKERNEL = max_rvv.c + +SMINKERNEL = min_rvv.c +DMINKERNEL = min_rvv.c + +ISAMAXKERNEL = iamax_rvv.c +IDAMAXKERNEL = iamax_rvv.c +ICAMAXKERNEL = izamax_rvv.c +IZAMAXKERNEL = izamax_rvv.c + +ISAMINKERNEL = iamin_rvv.c +IDAMINKERNEL = iamin_rvv.c +ICAMINKERNEL = izamin_rvv.c +IZAMINKERNEL = izamin_rvv.c + +ISMAXKERNEL = imax_rvv.c +IDMAXKERNEL = imax_rvv.c + +ISMINKERNEL = imin_rvv.c +IDMINKERNEL = imin_rvv.c + +SASUMKERNEL = asum_rvv.c +DASUMKERNEL = asum_rvv.c +CASUMKERNEL = zasum_rvv.c +ZASUMKERNEL = zasum_rvv.c + +SSUMKERNEL = sum_rvv.c +DSUMKERNEL = sum_rvv.c +CSUMKERNEL = zsum_rvv.c +ZSUMKERNEL = zsum_rvv.c + +SAXPYKERNEL = axpy_rvv.c +DAXPYKERNEL = axpy_rvv.c +CAXPYKERNEL = zaxpy_rvv.c +ZAXPYKERNEL = zaxpy_rvv.c + +SAXPBYKERNEL = axpby_rvv.c +DAXPBYKERNEL = axpby_rvv.c +CAXPBYKERNEL = zaxpby_rvv.c +ZAXPBYKERNEL = zaxpby_rvv.c + +SCOPYKERNEL = copy_rvv.c +DCOPYKERNEL = copy_rvv.c +CCOPYKERNEL = zcopy_rvv.c +ZCOPYKERNEL = zcopy_rvv.c + +SDOTKERNEL = dot_rvv.c +DDOTKERNEL = dot_rvv.c +CDOTKERNEL = zdot_rvv.c +ZDOTKERNEL = zdot_rvv.c +DSDOTKERNEL = dot_rvv.c + +SNRM2KERNEL = nrm2_rvv.c +DNRM2KERNEL = nrm2_rvv.c +CNRM2KERNEL = znrm2_rvv.c +ZNRM2KERNEL = znrm2_rvv.c + +SROTKERNEL = rot_rvv.c +DROTKERNEL = rot_rvv.c +CROTKERNEL = zrot_rvv.c +ZROTKERNEL = zrot_rvv.c + +SSCALKERNEL = scal_rvv.c +DSCALKERNEL = scal_rvv.c +CSCALKERNEL = zscal_rvv.c +ZSCALKERNEL = zscal_rvv.c + +SSWAPKERNEL = swap_rvv.c +DSWAPKERNEL = swap_rvv.c +CSWAPKERNEL = zswap_rvv.c +ZSWAPKERNEL = zswap_rvv.c + +SGEMVNKERNEL = gemv_n_rvv.c +DGEMVNKERNEL = gemv_n_rvv.c +CGEMVNKERNEL = zgemv_n_rvv.c +ZGEMVNKERNEL = zgemv_n_rvv.c + +SGEMVTKERNEL = gemv_t_rvv.c +DGEMVTKERNEL = gemv_t_rvv.c +CGEMVTKERNEL = zgemv_t_rvv.c +ZGEMVTKERNEL = zgemv_t_rvv.c + +SGEMMKERNEL = sgemm_kernel_$(SGEMM_UNROLL_M)x$(SGEMM_UNROLL_N)_zvl128b.c +SGEMMONCOPY = ../generic/gemm_ncopy_$(SGEMM_UNROLL_N).c +SGEMMOTCOPY = ../generic/gemm_tcopy_$(SGEMM_UNROLL_N).c +SGEMMONCOPYOBJ = sgemm_oncopy$(TSUFFIX).$(SUFFIX) +SGEMMOTCOPYOBJ = sgemm_otcopy$(TSUFFIX).$(SUFFIX) + +ifneq ($(SGEMM_UNROLL_M), $(SGEMM_UNROLL_N)) +SGEMMINCOPY = ../generic/gemm_ncopy_$(SGEMM_UNROLL_M).c +SGEMMITCOPY = ../generic/gemm_tcopy_$(SGEMM_UNROLL_M).c +SGEMMINCOPYOBJ = sgemm_incopy$(TSUFFIX).$(SUFFIX) +SGEMMITCOPYOBJ = sgemm_itcopy$(TSUFFIX).$(SUFFIX) +endif + +DGEMMKERNEL = dgemm_kernel_$(DGEMM_UNROLL_M)x$(DGEMM_UNROLL_N)_zvl128b.c +DGEMMONCOPY = ../generic/gemm_ncopy_$(DGEMM_UNROLL_N).c +DGEMMOTCOPY = ../generic/gemm_tcopy_$(DGEMM_UNROLL_N).c +DGEMMONCOPYOBJ = dgemm_oncopy$(TSUFFIX).$(SUFFIX) +DGEMMOTCOPYOBJ = dgemm_otcopy$(TSUFFIX).$(SUFFIX) + +ifneq ($(DGEMM_UNROLL_M), $(DGEMM_UNROLL_N)) +DGEMMINCOPY = ../generic/gemm_ncopy_$(DGEMM_UNROLL_M).c +DGEMMITCOPY = ../generic/gemm_tcopy_$(DGEMM_UNROLL_M).c +DGEMMINCOPYOBJ = dgemm_incopy$(TSUFFIX).$(SUFFIX) +DGEMMITCOPYOBJ = dgemm_itcopy$(TSUFFIX).$(SUFFIX) +endif + +CGEMMKERNEL = cgemm_kernel_$(CGEMM_UNROLL_M)x$(CGEMM_UNROLL_N)_zvl128b.c +CGEMMONCOPY = ../generic/zgemm_ncopy_$(CGEMM_UNROLL_N).c +CGEMMOTCOPY = ../generic/zgemm_tcopy_$(CGEMM_UNROLL_N).c +CGEMMONCOPYOBJ = cgemm_oncopy$(TSUFFIX).$(SUFFIX) +CGEMMOTCOPYOBJ = cgemm_otcopy$(TSUFFIX).$(SUFFIX) + +ifneq ($(CGEMM_UNROLL_M), $(CGEMM_UNROLL_N)) +CGEMMINCOPY = ../generic/zgemm_ncopy_$(CGEMM_UNROLL_M).c +CGEMMITCOPY = ../generic/zgemm_tcopy_$(CGEMM_UNROLL_M).c +CGEMMINCOPYOBJ = cgemm_incopy$(TSUFFIX).$(SUFFIX) +CGEMMITCOPYOBJ = cgemm_itcopy$(TSUFFIX).$(SUFFIX) +endif + +ZGEMMKERNEL = zgemm_kernel_$(ZGEMM_UNROLL_M)x$(ZGEMM_UNROLL_N)_zvl128b.c +ZGEMMONCOPY = ../generic/zgemm_ncopy_$(ZGEMM_UNROLL_N).c +ZGEMMOTCOPY = ../generic/zgemm_tcopy_$(ZGEMM_UNROLL_N).c +ZGEMMONCOPYOBJ = zgemm_oncopy$(TSUFFIX).$(SUFFIX) +ZGEMMOTCOPYOBJ = zgemm_otcopy$(TSUFFIX).$(SUFFIX) + +ifneq ($(ZGEMM_UNROLL_M), $(ZGEMM_UNROLL_N)) +ZGEMMINCOPY = ../generic/zgemm_ncopy_$(ZGEMM_UNROLL_M).c +ZGEMMITCOPY = ../generic/zgemm_tcopy_$(ZGEMM_UNROLL_M).c +ZGEMMINCOPYOBJ = zgemm_incopy$(TSUFFIX).$(SUFFIX) +ZGEMMITCOPYOBJ = zgemm_itcopy$(TSUFFIX).$(SUFFIX) +endif + +STRMMKERNEL = strmm_kernel_$(SGEMM_UNROLL_M)x$(SGEMM_UNROLL_N)_zvl128b.c +STRMMUNCOPY_M = ../generic/trmm_uncopy_$(SGEMM_UNROLL_M).c +STRMMLNCOPY_M = ../generic/trmm_lncopy_$(SGEMM_UNROLL_M).c +STRMMUTCOPY_M = ../generic/trmm_utcopy_$(SGEMM_UNROLL_M).c +STRMMLTCOPY_M = ../generic/trmm_ltcopy_$(SGEMM_UNROLL_M).c + +DTRMMKERNEL = dtrmm_kernel_$(DGEMM_UNROLL_M)x$(DGEMM_UNROLL_N)_zvl128b.c +DTRMMUNCOPY_M = ../generic/trmm_uncopy_$(DGEMM_UNROLL_M).c +DTRMMLNCOPY_M = ../generic/trmm_lncopy_$(DGEMM_UNROLL_M).c +DTRMMUTCOPY_M = ../generic/trmm_utcopy_$(DGEMM_UNROLL_M).c +DTRMMLTCOPY_M = ../generic/trmm_ltcopy_$(DGEMM_UNROLL_M).c + +CTRMMKERNEL = ctrmm_kernel_$(CGEMM_UNROLL_M)x$(CGEMM_UNROLL_N)_zvl128b.c +CTRMMUNCOPY_M = ../generic/ztrmm_uncopy_$(CGEMM_UNROLL_M).c +CTRMMLNCOPY_M = ../generic/ztrmm_lncopy_$(CGEMM_UNROLL_M).c +CTRMMUTCOPY_M = ../generic/ztrmm_utcopy_$(CGEMM_UNROLL_M).c +CTRMMLTCOPY_M = ../generic/ztrmm_ltcopy_$(CGEMM_UNROLL_M).c + +ZTRMMKERNEL = ztrmm_kernel_$(ZGEMM_UNROLL_M)x$(ZGEMM_UNROLL_N)_zvl128b.c +ZTRMMUNCOPY_M = ../generic/ztrmm_uncopy_$(ZGEMM_UNROLL_M).c +ZTRMMLNCOPY_M = ../generic/ztrmm_lncopy_$(ZGEMM_UNROLL_M).c +ZTRMMUTCOPY_M = ../generic/ztrmm_utcopy_$(ZGEMM_UNROLL_M).c +ZTRMMLTCOPY_M = ../generic/ztrmm_ltcopy_$(ZGEMM_UNROLL_M).c + +STRSMKERNEL_LN = ../generic/trsm_kernel_LN.c +STRSMKERNEL_LT = ../generic/trsm_kernel_LT.c +STRSMKERNEL_RN = ../generic/trsm_kernel_RN.c +STRSMKERNEL_RT = ../generic/trsm_kernel_RT.c + +DTRSMKERNEL_LN = ../generic/trsm_kernel_LN.c +DTRSMKERNEL_LT = ../generic/trsm_kernel_LT.c +DTRSMKERNEL_RN = ../generic/trsm_kernel_RN.c +DTRSMKERNEL_RT = ../generic/trsm_kernel_RT.c + +CTRSMKERNEL_LN = ../generic/trsm_kernel_LN.c +CTRSMKERNEL_LT = ../generic/trsm_kernel_LT.c +CTRSMKERNEL_RN = ../generic/trsm_kernel_RN.c +CTRSMKERNEL_RT = ../generic/trsm_kernel_RT.c + +ZTRSMKERNEL_LN = ../generic/trsm_kernel_LN.c +ZTRSMKERNEL_LT = ../generic/trsm_kernel_LT.c +ZTRSMKERNEL_RN = ../generic/trsm_kernel_RN.c +ZTRSMKERNEL_RT = ../generic/trsm_kernel_RT.c + +SSYMV_U_KERNEL = symv_U_rvv.c +SSYMV_L_KERNEL = symv_L_rvv.c +DSYMV_U_KERNEL = symv_U_rvv.c +DSYMV_L_KERNEL = symv_L_rvv.c +CSYMV_U_KERNEL = zsymv_U_rvv.c +CSYMV_L_KERNEL = zsymv_L_rvv.c +ZSYMV_U_KERNEL = zsymv_U_rvv.c +ZSYMV_L_KERNEL = zsymv_L_rvv.c + +CHEMV_L_KERNEL = zhemv_LM_rvv.c +CHEMV_M_KERNEL = zhemv_LM_rvv.c +CHEMV_U_KERNEL = zhemv_UV_rvv.c +CHEMV_V_KERNEL = zhemv_UV_rvv.c +ZHEMV_L_KERNEL = zhemv_LM_rvv.c +ZHEMV_M_KERNEL = zhemv_LM_rvv.c +ZHEMV_U_KERNEL = zhemv_UV_rvv.c +ZHEMV_V_KERNEL = zhemv_UV_rvv.c + +SSYMMUCOPY_M = ../generic/symm_ucopy_$(SGEMM_UNROLL_M).c +SSYMMLCOPY_M = ../generic/symm_lcopy_$(SGEMM_UNROLL_M).c + +DSYMMUCOPY_M = ../generic/symm_ucopy_$(DGEMM_UNROLL_M).c +DSYMMLCOPY_M = ../generic/symm_lcopy_$(DGEMM_UNROLL_M).c + +CSYMMUCOPY_M = ../generic/zsymm_ucopy_$(CGEMM_UNROLL_M).c +CSYMMLCOPY_M = ../generic/zsymm_lcopy_$(CGEMM_UNROLL_M).c + +ZSYMMUCOPY_M = ../generic/zsymm_ucopy_$(ZGEMM_UNROLL_M).c +ZSYMMLCOPY_M = ../generic/zsymm_lcopy_$(ZGEMM_UNROLL_M).c + +CHEMMLTCOPY_M = ../generic/zhemm_ltcopy_$(CGEMM_UNROLL_M).c +CHEMMUTCOPY_M = ../generic/zhemm_utcopy_$(CGEMM_UNROLL_M).c + +ZHEMMLTCOPY_M = ../generic/zhemm_ltcopy_$(ZGEMM_UNROLL_M).c +ZHEMMUTCOPY_M = ../generic/zhemm_utcopy_$(ZGEMM_UNROLL_M).c + +LSAME_KERNEL = ../generic/lsame.c + +SCABS_KERNEL = ../generic/cabs.c +DCABS_KERNEL = ../generic/cabs.c +QCABS_KERNEL = ../generic/cabs.c + +ifndef SGEMM_BETA +SGEMM_BETA = gemm_beta_rvv.c +endif +ifndef DGEMM_BETA +DGEMM_BETA = gemm_beta_rvv.c +endif +ifndef CGEMM_BETA +CGEMM_BETA = zgemm_beta_rvv.c +endif +ifndef ZGEMM_BETA +ZGEMM_BETA = zgemm_beta_rvv.c +endif diff --git a/kernel/riscv64/cgemm_kernel_8x4_zvl128b.c b/kernel/riscv64/cgemm_kernel_8x4_zvl128b.c new file mode 100644 index 000000000..bd615389c --- /dev/null +++ b/kernel/riscv64/cgemm_kernel_8x4_zvl128b.c @@ -0,0 +1,996 @@ +/* + +AUTOGENERATED KERNEL +Script: ./kernel/riscv64/generate_kernel.py +Settings: + LMUL=2 + M=8 + M_tail_scalar_from=2 + N=4 + __riscv_='__riscv_' + complex=True + conjugate=False + cpu='zvl128b' + force_acc_double=False + index_type='BLASLONG' + op='gemm' + param_precision='float' + reg_width_bits=128 + tail_policy='' + trace=False + +Derived: + ELEN_ACC=32 + ELEN_PARAM=32 + LMUL_ACC=2 + VFMACC='__riscv_vfmacc_vf_f32m2' + VFMUL='__riscv_vfmul_vf_f32m2' + VLEV='__riscv_vle32_v_f32m2' + VLSEV='__riscv_vlse32_v_f32m2' + VMACC_TO_ACC='__riscv_vfmacc_vf_f32m2' + VMUL_TO_ACC='__riscv_vfmul_vf_f32m2' + VSETVL='__riscv_vsetvl_e32m2' + VSEV='__riscv_vse32_v_f32m2' + VSSEV='__riscv_vsse32_v_f32m2' + acc_vector_t='vfloat32m2_t' + output='cgemm_kernel_8x4_zvl128b.c' + param_scalar_t='float' + param_vector_t='vfloat32m2_t' + +*/ + +#include "common.h" + +#if defined(NN) || defined(NT) || defined(TN) || defined(TT) +#define S0 1 +#define S1 -1 +#define S2 1 +#define S3 1 +#define VFMACC_RR __riscv_vfmsac +#define VFMACC_RI __riscv_vfmacc +#endif +#if defined(NR) || defined(NC) || defined(TR) || defined(TC) +#define S0 1 +#define S1 1 +#define S2 1 +#define S3 -1 +#define VFMACC_RR __riscv_vfmacc +#define VFMACC_RI __riscv_vfmsac +#endif +#if defined(RN) || defined(RT) || defined(CN) || defined(CT) +#define S0 1 +#define S1 1 +#define S2 -1 +#define S3 1 +#define VFMACC_RR __riscv_vfmacc +#define VFMACC_RI __riscv_vfnmsac +#endif +#if defined(RR) || defined(RC) || defined(CR) || defined(CC) +#define S0 1 +#define S1 -1 +#define S2 -1 +#define S3 -1 +#define VFMACC_RR __riscv_vfmsac +#define VFMACC_RI __riscv_vfnmacc +#endif + +int CNAME(BLASLONG M, BLASLONG N, BLASLONG K, FLOAT alphar, FLOAT alphai, FLOAT *A, FLOAT *B, FLOAT *C, BLASLONG ldc) + +{ + BLASLONG gvl = 0; + BLASLONG m_top = 0; + BLASLONG n_top = 0; + + // -- MAIN PASS + + for (BLASLONG j = 0; j < N / 4; j += 1) { + m_top = 0; + BLASLONG gvl = __riscv_vsetvl_e32m2(8); + + for (BLASLONG i = 0; i < M / 8; i += 1) { + BLASLONG ai = m_top * K * 2; + BLASLONG bi = n_top * K * 2; + float B0r = B[bi + 0 * 2 + 0]; + float B0i = B[bi + 0 * 2 + 1]; + float B1r = B[bi + 1 * 2 + 0]; + float B1i = B[bi + 1 * 2 + 1]; + float B2r = B[bi + 2 * 2 + 0]; + float B2i = B[bi + 2 * 2 + 1]; + float B3r = B[bi + 3 * 2 + 0]; + float B3i = B[bi + 3 * 2 + 1]; + bi += 4 * 2; + + vfloat32m2_t A0r = __riscv_vlse32_v_f32m2(&A[ai + 0 * gvl * 2], sizeof(FLOAT) * 2, gvl); + vfloat32m2_t A0i = __riscv_vlse32_v_f32m2(&A[ai + 0 * gvl * 2 + 1], sizeof(FLOAT) * 2, gvl); + ai += 8 * 2; + + // 2 vector regs to hold A array contents, 8 regs to hold values accumulated over k + // leaving 6 vector registers for temporaries + // performing 2 operations between reuses of temporaries + vfloat32m2_t tmp0r = __riscv_vfmul_vf_f32m2(A0i, B0i, gvl); + vfloat32m2_t tmp0i = __riscv_vfmul_vf_f32m2(A0r, B0i, gvl); + vfloat32m2_t tmp1r = __riscv_vfmul_vf_f32m2(A0i, B1i, gvl); + vfloat32m2_t tmp1i = __riscv_vfmul_vf_f32m2(A0r, B1i, gvl); + tmp0r = VFMACC_RR(tmp0r, B0r, A0r, gvl); + tmp0i = VFMACC_RI(tmp0i, B0r, A0i, gvl); + tmp1r = VFMACC_RR(tmp1r, B1r, A0r, gvl); + tmp1i = VFMACC_RI(tmp1i, B1r, A0i, gvl); + vfloat32m2_t ACC0r = tmp0r; + vfloat32m2_t ACC0i = tmp0i; + vfloat32m2_t ACC1r = tmp1r; + vfloat32m2_t ACC1i = tmp1i; + tmp0r = __riscv_vfmul_vf_f32m2(A0i, B2i, gvl); + tmp0i = __riscv_vfmul_vf_f32m2(A0r, B2i, gvl); + tmp1r = __riscv_vfmul_vf_f32m2(A0i, B3i, gvl); + tmp1i = __riscv_vfmul_vf_f32m2(A0r, B3i, gvl); + tmp0r = VFMACC_RR(tmp0r, B2r, A0r, gvl); + tmp0i = VFMACC_RI(tmp0i, B2r, A0i, gvl); + tmp1r = VFMACC_RR(tmp1r, B3r, A0r, gvl); + tmp1i = VFMACC_RI(tmp1i, B3r, A0i, gvl); + vfloat32m2_t ACC2r = tmp0r; + vfloat32m2_t ACC2i = tmp0i; + vfloat32m2_t ACC3r = tmp1r; + vfloat32m2_t ACC3i = tmp1i; + + for (BLASLONG k = 1; k < K; k++) { + B0r = B[bi + 0 * 2 + 0]; + B0i = B[bi + 0 * 2 + 1]; + B1r = B[bi + 1 * 2 + 0]; + B1i = B[bi + 1 * 2 + 1]; + B2r = B[bi + 2 * 2 + 0]; + B2i = B[bi + 2 * 2 + 1]; + B3r = B[bi + 3 * 2 + 0]; + B3i = B[bi + 3 * 2 + 1]; + bi += 4 * 2; + + A0r = __riscv_vlse32_v_f32m2(&A[ai + 0 * gvl * 2], sizeof(FLOAT) * 2, gvl); + A0i = __riscv_vlse32_v_f32m2(&A[ai + 0 * gvl * 2 + 1], sizeof(FLOAT) * 2, gvl); + ai += 8 * 2; + + tmp0r = __riscv_vfmul_vf_f32m2(A0i, B0i, gvl); + tmp0i = __riscv_vfmul_vf_f32m2(A0r, B0i, gvl); + tmp1r = __riscv_vfmul_vf_f32m2(A0i, B1i, gvl); + tmp1i = __riscv_vfmul_vf_f32m2(A0r, B1i, gvl); + tmp0r = VFMACC_RR(tmp0r, B0r, A0r, gvl); + tmp0i = VFMACC_RI(tmp0i, B0r, A0i, gvl); + tmp1r = VFMACC_RR(tmp1r, B1r, A0r, gvl); + tmp1i = VFMACC_RI(tmp1i, B1r, A0i, gvl); + ACC0r = __riscv_vfadd(ACC0r, tmp0r, gvl); + ACC0i = __riscv_vfadd(ACC0i, tmp0i, gvl); + ACC1r = __riscv_vfadd(ACC1r, tmp1r, gvl); + ACC1i = __riscv_vfadd(ACC1i, tmp1i, gvl); + tmp0r = __riscv_vfmul_vf_f32m2(A0i, B2i, gvl); + tmp0i = __riscv_vfmul_vf_f32m2(A0r, B2i, gvl); + tmp1r = __riscv_vfmul_vf_f32m2(A0i, B3i, gvl); + tmp1i = __riscv_vfmul_vf_f32m2(A0r, B3i, gvl); + tmp0r = VFMACC_RR(tmp0r, B2r, A0r, gvl); + tmp0i = VFMACC_RI(tmp0i, B2r, A0i, gvl); + tmp1r = VFMACC_RR(tmp1r, B3r, A0r, gvl); + tmp1i = VFMACC_RI(tmp1i, B3r, A0i, gvl); + ACC2r = __riscv_vfadd(ACC2r, tmp0r, gvl); + ACC2i = __riscv_vfadd(ACC2i, tmp0i, gvl); + ACC3r = __riscv_vfadd(ACC3r, tmp1r, gvl); + ACC3i = __riscv_vfadd(ACC3i, tmp1i, gvl); + } + + BLASLONG ci = n_top * ldc + m_top; + + vfloat32m2_t C0r = __riscv_vlse32_v_f32m2(&C[ci * 2 + 0], sizeof(FLOAT) * 2, gvl); + vfloat32m2_t C0i = __riscv_vlse32_v_f32m2(&C[ci * 2 + 1], sizeof(FLOAT) * 2, gvl); + ci += ldc - gvl * 0; + vfloat32m2_t C1r = __riscv_vlse32_v_f32m2(&C[ci * 2 + 0], sizeof(FLOAT) * 2, gvl); + vfloat32m2_t C1i = __riscv_vlse32_v_f32m2(&C[ci * 2 + 1], sizeof(FLOAT) * 2, gvl); + ci += ldc - gvl * 0; + vfloat32m2_t C2r = __riscv_vlse32_v_f32m2(&C[ci * 2 + 0], sizeof(FLOAT) * 2, gvl); + vfloat32m2_t C2i = __riscv_vlse32_v_f32m2(&C[ci * 2 + 1], sizeof(FLOAT) * 2, gvl); + ci += ldc - gvl * 0; + vfloat32m2_t C3r = __riscv_vlse32_v_f32m2(&C[ci * 2 + 0], sizeof(FLOAT) * 2, gvl); + vfloat32m2_t C3i = __riscv_vlse32_v_f32m2(&C[ci * 2 + 1], sizeof(FLOAT) * 2, gvl); + + C0r = __riscv_vfmacc(C0r, alphar, ACC0r, gvl); + C0i = __riscv_vfmacc(C0i, alphar, ACC0i, gvl); + C1r = __riscv_vfmacc(C1r, alphar, ACC1r, gvl); + C1i = __riscv_vfmacc(C1i, alphar, ACC1i, gvl); + C2r = __riscv_vfmacc(C2r, alphar, ACC2r, gvl); + C2i = __riscv_vfmacc(C2i, alphar, ACC2i, gvl); + C3r = __riscv_vfmacc(C3r, alphar, ACC3r, gvl); + C3i = __riscv_vfmacc(C3i, alphar, ACC3i, gvl); + C0r = __riscv_vfnmsac(C0r, alphai, ACC0i, gvl); + C0i = __riscv_vfmacc(C0i, alphai, ACC0r, gvl); + C1r = __riscv_vfnmsac(C1r, alphai, ACC1i, gvl); + C1i = __riscv_vfmacc(C1i, alphai, ACC1r, gvl); + C2r = __riscv_vfnmsac(C2r, alphai, ACC2i, gvl); + C2i = __riscv_vfmacc(C2i, alphai, ACC2r, gvl); + C3r = __riscv_vfnmsac(C3r, alphai, ACC3i, gvl); + C3i = __riscv_vfmacc(C3i, alphai, ACC3r, gvl); + + ci = n_top * ldc + m_top; + + __riscv_vsse32_v_f32m2(&C[ci * 2 + 0], sizeof(FLOAT) * 2, C0r, gvl); + __riscv_vsse32_v_f32m2(&C[ci * 2 + 1], sizeof(FLOAT) * 2, C0i, gvl); + ci += ldc - gvl * 0; + __riscv_vsse32_v_f32m2(&C[ci * 2 + 0], sizeof(FLOAT) * 2, C1r, gvl); + __riscv_vsse32_v_f32m2(&C[ci * 2 + 1], sizeof(FLOAT) * 2, C1i, gvl); + ci += ldc - gvl * 0; + __riscv_vsse32_v_f32m2(&C[ci * 2 + 0], sizeof(FLOAT) * 2, C2r, gvl); + __riscv_vsse32_v_f32m2(&C[ci * 2 + 1], sizeof(FLOAT) * 2, C2i, gvl); + ci += ldc - gvl * 0; + __riscv_vsse32_v_f32m2(&C[ci * 2 + 0], sizeof(FLOAT) * 2, C3r, gvl); + __riscv_vsse32_v_f32m2(&C[ci * 2 + 1], sizeof(FLOAT) * 2, C3i, gvl); + + m_top += 8; + } + + // -- tails for main pass + + if (M & 4) { + gvl = __riscv_vsetvl_e32m2(4); + + BLASLONG ai = m_top * K * 2; + BLASLONG bi = n_top * K * 2; + float B0r = B[bi + 0 * 2 + 0]; + float B0i = B[bi + 0 * 2 + 1]; + float B1r = B[bi + 1 * 2 + 0]; + float B1i = B[bi + 1 * 2 + 1]; + float B2r = B[bi + 2 * 2 + 0]; + float B2i = B[bi + 2 * 2 + 1]; + float B3r = B[bi + 3 * 2 + 0]; + float B3i = B[bi + 3 * 2 + 1]; + bi += 4 * 2; + + vfloat32m2_t A0r = __riscv_vlse32_v_f32m2(&A[ai + 0 * gvl * 2], sizeof(FLOAT) * 2, gvl); + vfloat32m2_t A0i = __riscv_vlse32_v_f32m2(&A[ai + 0 * gvl * 2 + 1], sizeof(FLOAT) * 2, gvl); + ai += 4 * 2; + + // 2 vector regs to hold A array contents, 8 regs to hold values accumulated over k + // leaving 6 vector registers for temporaries + // performing 2 operations between reuses of temporaries + vfloat32m2_t tmp0r = __riscv_vfmul_vf_f32m2(A0i, B0i, gvl); + vfloat32m2_t tmp0i = __riscv_vfmul_vf_f32m2(A0r, B0i, gvl); + vfloat32m2_t tmp1r = __riscv_vfmul_vf_f32m2(A0i, B1i, gvl); + vfloat32m2_t tmp1i = __riscv_vfmul_vf_f32m2(A0r, B1i, gvl); + tmp0r = VFMACC_RR(tmp0r, B0r, A0r, gvl); + tmp0i = VFMACC_RI(tmp0i, B0r, A0i, gvl); + tmp1r = VFMACC_RR(tmp1r, B1r, A0r, gvl); + tmp1i = VFMACC_RI(tmp1i, B1r, A0i, gvl); + vfloat32m2_t ACC0r = tmp0r; + vfloat32m2_t ACC0i = tmp0i; + vfloat32m2_t ACC1r = tmp1r; + vfloat32m2_t ACC1i = tmp1i; + tmp0r = __riscv_vfmul_vf_f32m2(A0i, B2i, gvl); + tmp0i = __riscv_vfmul_vf_f32m2(A0r, B2i, gvl); + tmp1r = __riscv_vfmul_vf_f32m2(A0i, B3i, gvl); + tmp1i = __riscv_vfmul_vf_f32m2(A0r, B3i, gvl); + tmp0r = VFMACC_RR(tmp0r, B2r, A0r, gvl); + tmp0i = VFMACC_RI(tmp0i, B2r, A0i, gvl); + tmp1r = VFMACC_RR(tmp1r, B3r, A0r, gvl); + tmp1i = VFMACC_RI(tmp1i, B3r, A0i, gvl); + vfloat32m2_t ACC2r = tmp0r; + vfloat32m2_t ACC2i = tmp0i; + vfloat32m2_t ACC3r = tmp1r; + vfloat32m2_t ACC3i = tmp1i; + + for (BLASLONG k = 1; k < K; k++) { + B0r = B[bi + 0 * 2 + 0]; + B0i = B[bi + 0 * 2 + 1]; + B1r = B[bi + 1 * 2 + 0]; + B1i = B[bi + 1 * 2 + 1]; + B2r = B[bi + 2 * 2 + 0]; + B2i = B[bi + 2 * 2 + 1]; + B3r = B[bi + 3 * 2 + 0]; + B3i = B[bi + 3 * 2 + 1]; + bi += 4 * 2; + + A0r = __riscv_vlse32_v_f32m2(&A[ai + 0 * gvl * 2], sizeof(FLOAT) * 2, gvl); + A0i = __riscv_vlse32_v_f32m2(&A[ai + 0 * gvl * 2 + 1], sizeof(FLOAT) * 2, gvl); + ai += 4 * 2; + + tmp0r = __riscv_vfmul_vf_f32m2(A0i, B0i, gvl); + tmp0i = __riscv_vfmul_vf_f32m2(A0r, B0i, gvl); + tmp1r = __riscv_vfmul_vf_f32m2(A0i, B1i, gvl); + tmp1i = __riscv_vfmul_vf_f32m2(A0r, B1i, gvl); + tmp0r = VFMACC_RR(tmp0r, B0r, A0r, gvl); + tmp0i = VFMACC_RI(tmp0i, B0r, A0i, gvl); + tmp1r = VFMACC_RR(tmp1r, B1r, A0r, gvl); + tmp1i = VFMACC_RI(tmp1i, B1r, A0i, gvl); + ACC0r = __riscv_vfadd(ACC0r, tmp0r, gvl); + ACC0i = __riscv_vfadd(ACC0i, tmp0i, gvl); + ACC1r = __riscv_vfadd(ACC1r, tmp1r, gvl); + ACC1i = __riscv_vfadd(ACC1i, tmp1i, gvl); + tmp0r = __riscv_vfmul_vf_f32m2(A0i, B2i, gvl); + tmp0i = __riscv_vfmul_vf_f32m2(A0r, B2i, gvl); + tmp1r = __riscv_vfmul_vf_f32m2(A0i, B3i, gvl); + tmp1i = __riscv_vfmul_vf_f32m2(A0r, B3i, gvl); + tmp0r = VFMACC_RR(tmp0r, B2r, A0r, gvl); + tmp0i = VFMACC_RI(tmp0i, B2r, A0i, gvl); + tmp1r = VFMACC_RR(tmp1r, B3r, A0r, gvl); + tmp1i = VFMACC_RI(tmp1i, B3r, A0i, gvl); + ACC2r = __riscv_vfadd(ACC2r, tmp0r, gvl); + ACC2i = __riscv_vfadd(ACC2i, tmp0i, gvl); + ACC3r = __riscv_vfadd(ACC3r, tmp1r, gvl); + ACC3i = __riscv_vfadd(ACC3i, tmp1i, gvl); + } + + BLASLONG ci = n_top * ldc + m_top; + + vfloat32m2_t C0r = __riscv_vlse32_v_f32m2(&C[ci * 2 + 0], sizeof(FLOAT) * 2, gvl); + vfloat32m2_t C0i = __riscv_vlse32_v_f32m2(&C[ci * 2 + 1], sizeof(FLOAT) * 2, gvl); + ci += ldc - gvl * 0; + vfloat32m2_t C1r = __riscv_vlse32_v_f32m2(&C[ci * 2 + 0], sizeof(FLOAT) * 2, gvl); + vfloat32m2_t C1i = __riscv_vlse32_v_f32m2(&C[ci * 2 + 1], sizeof(FLOAT) * 2, gvl); + ci += ldc - gvl * 0; + vfloat32m2_t C2r = __riscv_vlse32_v_f32m2(&C[ci * 2 + 0], sizeof(FLOAT) * 2, gvl); + vfloat32m2_t C2i = __riscv_vlse32_v_f32m2(&C[ci * 2 + 1], sizeof(FLOAT) * 2, gvl); + ci += ldc - gvl * 0; + vfloat32m2_t C3r = __riscv_vlse32_v_f32m2(&C[ci * 2 + 0], sizeof(FLOAT) * 2, gvl); + vfloat32m2_t C3i = __riscv_vlse32_v_f32m2(&C[ci * 2 + 1], sizeof(FLOAT) * 2, gvl); + + C0r = __riscv_vfmacc(C0r, alphar, ACC0r, gvl); + C0i = __riscv_vfmacc(C0i, alphar, ACC0i, gvl); + C1r = __riscv_vfmacc(C1r, alphar, ACC1r, gvl); + C1i = __riscv_vfmacc(C1i, alphar, ACC1i, gvl); + C2r = __riscv_vfmacc(C2r, alphar, ACC2r, gvl); + C2i = __riscv_vfmacc(C2i, alphar, ACC2i, gvl); + C3r = __riscv_vfmacc(C3r, alphar, ACC3r, gvl); + C3i = __riscv_vfmacc(C3i, alphar, ACC3i, gvl); + C0r = __riscv_vfnmsac(C0r, alphai, ACC0i, gvl); + C0i = __riscv_vfmacc(C0i, alphai, ACC0r, gvl); + C1r = __riscv_vfnmsac(C1r, alphai, ACC1i, gvl); + C1i = __riscv_vfmacc(C1i, alphai, ACC1r, gvl); + C2r = __riscv_vfnmsac(C2r, alphai, ACC2i, gvl); + C2i = __riscv_vfmacc(C2i, alphai, ACC2r, gvl); + C3r = __riscv_vfnmsac(C3r, alphai, ACC3i, gvl); + C3i = __riscv_vfmacc(C3i, alphai, ACC3r, gvl); + + ci = n_top * ldc + m_top; + + __riscv_vsse32_v_f32m2(&C[ci * 2 + 0], sizeof(FLOAT) * 2, C0r, gvl); + __riscv_vsse32_v_f32m2(&C[ci * 2 + 1], sizeof(FLOAT) * 2, C0i, gvl); + ci += ldc - gvl * 0; + __riscv_vsse32_v_f32m2(&C[ci * 2 + 0], sizeof(FLOAT) * 2, C1r, gvl); + __riscv_vsse32_v_f32m2(&C[ci * 2 + 1], sizeof(FLOAT) * 2, C1i, gvl); + ci += ldc - gvl * 0; + __riscv_vsse32_v_f32m2(&C[ci * 2 + 0], sizeof(FLOAT) * 2, C2r, gvl); + __riscv_vsse32_v_f32m2(&C[ci * 2 + 1], sizeof(FLOAT) * 2, C2i, gvl); + ci += ldc - gvl * 0; + __riscv_vsse32_v_f32m2(&C[ci * 2 + 0], sizeof(FLOAT) * 2, C3r, gvl); + __riscv_vsse32_v_f32m2(&C[ci * 2 + 1], sizeof(FLOAT) * 2, C3i, gvl); + + m_top += 4; + } + + if (M & 2) { + float result0 = 0; + float result1 = 0; + float result2 = 0; + float result3 = 0; + float result4 = 0; + float result5 = 0; + float result6 = 0; + float result7 = 0; + float result8 = 0; + float result9 = 0; + float result10 = 0; + float result11 = 0; + float result12 = 0; + float result13 = 0; + float result14 = 0; + float result15 = 0; + BLASLONG ai = m_top * K * 2; + BLASLONG bi = n_top * K * 2; + + for (BLASLONG k = 0; k < K; k++) { + result0 += S0 * A[ai + 0 + 0] * B[bi + 0 + 0] + S1 * A[ai + 0 + 1] * B[bi + 0 + 1]; + result1 += S2 * A[ai + 0 + 1] * B[bi + 0 + 0] + S3 * A[ai + 0 + 0] * B[bi + 0 + 1]; + result2 += S0 * A[ai + 2 + 0] * B[bi + 0 + 0] + S1 * A[ai + 2 + 1] * B[bi + 0 + 1]; + result3 += S2 * A[ai + 2 + 1] * B[bi + 0 + 0] + S3 * A[ai + 2 + 0] * B[bi + 0 + 1]; + result4 += S0 * A[ai + 0 + 0] * B[bi + 2 + 0] + S1 * A[ai + 0 + 1] * B[bi + 2 + 1]; + result5 += S2 * A[ai + 0 + 1] * B[bi + 2 + 0] + S3 * A[ai + 0 + 0] * B[bi + 2 + 1]; + result6 += S0 * A[ai + 2 + 0] * B[bi + 2 + 0] + S1 * A[ai + 2 + 1] * B[bi + 2 + 1]; + result7 += S2 * A[ai + 2 + 1] * B[bi + 2 + 0] + S3 * A[ai + 2 + 0] * B[bi + 2 + 1]; + result8 += S0 * A[ai + 0 + 0] * B[bi + 4 + 0] + S1 * A[ai + 0 + 1] * B[bi + 4 + 1]; + result9 += S2 * A[ai + 0 + 1] * B[bi + 4 + 0] + S3 * A[ai + 0 + 0] * B[bi + 4 + 1]; + result10 += S0 * A[ai + 2 + 0] * B[bi + 4 + 0] + S1 * A[ai + 2 + 1] * B[bi + 4 + 1]; + result11 += S2 * A[ai + 2 + 1] * B[bi + 4 + 0] + S3 * A[ai + 2 + 0] * B[bi + 4 + 1]; + result12 += S0 * A[ai + 0 + 0] * B[bi + 6 + 0] + S1 * A[ai + 0 + 1] * B[bi + 6 + 1]; + result13 += S2 * A[ai + 0 + 1] * B[bi + 6 + 0] + S3 * A[ai + 0 + 0] * B[bi + 6 + 1]; + result14 += S0 * A[ai + 2 + 0] * B[bi + 6 + 0] + S1 * A[ai + 2 + 1] * B[bi + 6 + 1]; + result15 += S2 * A[ai + 2 + 1] * B[bi + 6 + 0] + S3 * A[ai + 2 + 0] * B[bi + 6 + 1]; + ai += 2 * 2; + bi += 4 * 2; + } + + BLASLONG ci = n_top * ldc + m_top; + float Cr, Ci; + Cr = C[(ci + 0 * ldc + 0) * 2 + 0]; + Ci = C[(ci + 0 * ldc + 0) * 2 + 1]; + Cr += result0 * alphar; + Ci += result1 * alphar; + Cr -= result1 * alphai; + Ci += result0 * alphai; + C[(ci + 0 * ldc + 0) * 2 + 0] = Cr; + C[(ci + 0 * ldc + 0) * 2 + 1] = Ci; + Cr = C[(ci + 0 * ldc + 1) * 2 + 0]; + Ci = C[(ci + 0 * ldc + 1) * 2 + 1]; + Cr += result2 * alphar; + Ci += result3 * alphar; + Cr -= result3 * alphai; + Ci += result2 * alphai; + C[(ci + 0 * ldc + 1) * 2 + 0] = Cr; + C[(ci + 0 * ldc + 1) * 2 + 1] = Ci; + Cr = C[(ci + 1 * ldc + 0) * 2 + 0]; + Ci = C[(ci + 1 * ldc + 0) * 2 + 1]; + Cr += result4 * alphar; + Ci += result5 * alphar; + Cr -= result5 * alphai; + Ci += result4 * alphai; + C[(ci + 1 * ldc + 0) * 2 + 0] = Cr; + C[(ci + 1 * ldc + 0) * 2 + 1] = Ci; + Cr = C[(ci + 1 * ldc + 1) * 2 + 0]; + Ci = C[(ci + 1 * ldc + 1) * 2 + 1]; + Cr += result6 * alphar; + Ci += result7 * alphar; + Cr -= result7 * alphai; + Ci += result6 * alphai; + C[(ci + 1 * ldc + 1) * 2 + 0] = Cr; + C[(ci + 1 * ldc + 1) * 2 + 1] = Ci; + Cr = C[(ci + 2 * ldc + 0) * 2 + 0]; + Ci = C[(ci + 2 * ldc + 0) * 2 + 1]; + Cr += result8 * alphar; + Ci += result9 * alphar; + Cr -= result9 * alphai; + Ci += result8 * alphai; + C[(ci + 2 * ldc + 0) * 2 + 0] = Cr; + C[(ci + 2 * ldc + 0) * 2 + 1] = Ci; + Cr = C[(ci + 2 * ldc + 1) * 2 + 0]; + Ci = C[(ci + 2 * ldc + 1) * 2 + 1]; + Cr += result10 * alphar; + Ci += result11 * alphar; + Cr -= result11 * alphai; + Ci += result10 * alphai; + C[(ci + 2 * ldc + 1) * 2 + 0] = Cr; + C[(ci + 2 * ldc + 1) * 2 + 1] = Ci; + Cr = C[(ci + 3 * ldc + 0) * 2 + 0]; + Ci = C[(ci + 3 * ldc + 0) * 2 + 1]; + Cr += result12 * alphar; + Ci += result13 * alphar; + Cr -= result13 * alphai; + Ci += result12 * alphai; + C[(ci + 3 * ldc + 0) * 2 + 0] = Cr; + C[(ci + 3 * ldc + 0) * 2 + 1] = Ci; + Cr = C[(ci + 3 * ldc + 1) * 2 + 0]; + Ci = C[(ci + 3 * ldc + 1) * 2 + 1]; + Cr += result14 * alphar; + Ci += result15 * alphar; + Cr -= result15 * alphai; + Ci += result14 * alphai; + C[(ci + 3 * ldc + 1) * 2 + 0] = Cr; + C[(ci + 3 * ldc + 1) * 2 + 1] = Ci; + m_top += 2; + } + + if (M & 1) { + float result0 = 0; + float result1 = 0; + float result2 = 0; + float result3 = 0; + float result4 = 0; + float result5 = 0; + float result6 = 0; + float result7 = 0; + BLASLONG ai = m_top * K * 2; + BLASLONG bi = n_top * K * 2; + + for (BLASLONG k = 0; k < K; k++) { + result0 += S0 * A[ai + 0 + 0] * B[bi + 0 + 0] + S1 * A[ai + 0 + 1] * B[bi + 0 + 1]; + result1 += S2 * A[ai + 0 + 1] * B[bi + 0 + 0] + S3 * A[ai + 0 + 0] * B[bi + 0 + 1]; + result2 += S0 * A[ai + 0 + 0] * B[bi + 2 + 0] + S1 * A[ai + 0 + 1] * B[bi + 2 + 1]; + result3 += S2 * A[ai + 0 + 1] * B[bi + 2 + 0] + S3 * A[ai + 0 + 0] * B[bi + 2 + 1]; + result4 += S0 * A[ai + 0 + 0] * B[bi + 4 + 0] + S1 * A[ai + 0 + 1] * B[bi + 4 + 1]; + result5 += S2 * A[ai + 0 + 1] * B[bi + 4 + 0] + S3 * A[ai + 0 + 0] * B[bi + 4 + 1]; + result6 += S0 * A[ai + 0 + 0] * B[bi + 6 + 0] + S1 * A[ai + 0 + 1] * B[bi + 6 + 1]; + result7 += S2 * A[ai + 0 + 1] * B[bi + 6 + 0] + S3 * A[ai + 0 + 0] * B[bi + 6 + 1]; + ai += 1 * 2; + bi += 4 * 2; + } + + BLASLONG ci = n_top * ldc + m_top; + float Cr, Ci; + Cr = C[(ci + 0 * ldc + 0) * 2 + 0]; + Ci = C[(ci + 0 * ldc + 0) * 2 + 1]; + Cr += result0 * alphar; + Ci += result1 * alphar; + Cr -= result1 * alphai; + Ci += result0 * alphai; + C[(ci + 0 * ldc + 0) * 2 + 0] = Cr; + C[(ci + 0 * ldc + 0) * 2 + 1] = Ci; + Cr = C[(ci + 1 * ldc + 0) * 2 + 0]; + Ci = C[(ci + 1 * ldc + 0) * 2 + 1]; + Cr += result2 * alphar; + Ci += result3 * alphar; + Cr -= result3 * alphai; + Ci += result2 * alphai; + C[(ci + 1 * ldc + 0) * 2 + 0] = Cr; + C[(ci + 1 * ldc + 0) * 2 + 1] = Ci; + Cr = C[(ci + 2 * ldc + 0) * 2 + 0]; + Ci = C[(ci + 2 * ldc + 0) * 2 + 1]; + Cr += result4 * alphar; + Ci += result5 * alphar; + Cr -= result5 * alphai; + Ci += result4 * alphai; + C[(ci + 2 * ldc + 0) * 2 + 0] = Cr; + C[(ci + 2 * ldc + 0) * 2 + 1] = Ci; + Cr = C[(ci + 3 * ldc + 0) * 2 + 0]; + Ci = C[(ci + 3 * ldc + 0) * 2 + 1]; + Cr += result6 * alphar; + Ci += result7 * alphar; + Cr -= result7 * alphai; + Ci += result6 * alphai; + C[(ci + 3 * ldc + 0) * 2 + 0] = Cr; + C[(ci + 3 * ldc + 0) * 2 + 1] = Ci; + m_top += 1; + } + + n_top += 4; + } + + // -- tails for N=2 + + if (N & 2) { + gvl = __riscv_vsetvl_e32m2(8); + m_top = 0; + + for (BLASLONG i = 0; i < M / 8; i += 1) { + BLASLONG ai = m_top * K * 2; + BLASLONG bi = n_top * K * 2; + float B0r = B[bi + 0 * 2 + 0]; + float B0i = B[bi + 0 * 2 + 1]; + float B1r = B[bi + 1 * 2 + 0]; + float B1i = B[bi + 1 * 2 + 1]; + bi += 2 * 2; + + vfloat32m2_t A0r = __riscv_vlse32_v_f32m2(&A[ai + 0 * gvl * 2], sizeof(FLOAT) * 2, gvl); + vfloat32m2_t A0i = __riscv_vlse32_v_f32m2(&A[ai + 0 * gvl * 2 + 1], sizeof(FLOAT) * 2, gvl); + ai += 8 * 2; + + // 2 vector regs to hold A array contents, 4 regs to hold values accumulated over k + // leaving 10 vector registers for temporaries + vfloat32m2_t tmp0r = __riscv_vfmul_vf_f32m2(A0i, B0i, gvl); + vfloat32m2_t tmp0i = __riscv_vfmul_vf_f32m2(A0r, B0i, gvl); + vfloat32m2_t tmp1r = __riscv_vfmul_vf_f32m2(A0i, B1i, gvl); + vfloat32m2_t tmp1i = __riscv_vfmul_vf_f32m2(A0r, B1i, gvl); + tmp0r = VFMACC_RR(tmp0r, B0r, A0r, gvl); + tmp0i = VFMACC_RI(tmp0i, B0r, A0i, gvl); + tmp1r = VFMACC_RR(tmp1r, B1r, A0r, gvl); + tmp1i = VFMACC_RI(tmp1i, B1r, A0i, gvl); + vfloat32m2_t ACC0r = tmp0r; + vfloat32m2_t ACC0i = tmp0i; + vfloat32m2_t ACC1r = tmp1r; + vfloat32m2_t ACC1i = tmp1i; + + for (BLASLONG k = 1; k < K; k++) { + B0r = B[bi + 0 * 2 + 0]; + B0i = B[bi + 0 * 2 + 1]; + B1r = B[bi + 1 * 2 + 0]; + B1i = B[bi + 1 * 2 + 1]; + bi += 2 * 2; + + A0r = __riscv_vlse32_v_f32m2(&A[ai + 0 * gvl * 2], sizeof(FLOAT) * 2, gvl); + A0i = __riscv_vlse32_v_f32m2(&A[ai + 0 * gvl * 2 + 1], sizeof(FLOAT) * 2, gvl); + ai += 8 * 2; + + tmp0r = __riscv_vfmul_vf_f32m2(A0i, B0i, gvl); + tmp0i = __riscv_vfmul_vf_f32m2(A0r, B0i, gvl); + tmp1r = __riscv_vfmul_vf_f32m2(A0i, B1i, gvl); + tmp1i = __riscv_vfmul_vf_f32m2(A0r, B1i, gvl); + tmp0r = VFMACC_RR(tmp0r, B0r, A0r, gvl); + tmp0i = VFMACC_RI(tmp0i, B0r, A0i, gvl); + tmp1r = VFMACC_RR(tmp1r, B1r, A0r, gvl); + tmp1i = VFMACC_RI(tmp1i, B1r, A0i, gvl); + ACC0r = __riscv_vfadd(ACC0r, tmp0r, gvl); + ACC0i = __riscv_vfadd(ACC0i, tmp0i, gvl); + ACC1r = __riscv_vfadd(ACC1r, tmp1r, gvl); + ACC1i = __riscv_vfadd(ACC1i, tmp1i, gvl); + } + + BLASLONG ci = n_top * ldc + m_top; + + vfloat32m2_t C0r = __riscv_vlse32_v_f32m2(&C[ci * 2 + 0], sizeof(FLOAT) * 2, gvl); + vfloat32m2_t C0i = __riscv_vlse32_v_f32m2(&C[ci * 2 + 1], sizeof(FLOAT) * 2, gvl); + ci += ldc - gvl * 0; + vfloat32m2_t C1r = __riscv_vlse32_v_f32m2(&C[ci * 2 + 0], sizeof(FLOAT) * 2, gvl); + vfloat32m2_t C1i = __riscv_vlse32_v_f32m2(&C[ci * 2 + 1], sizeof(FLOAT) * 2, gvl); + + C0r = __riscv_vfmacc(C0r, alphar, ACC0r, gvl); + C0i = __riscv_vfmacc(C0i, alphar, ACC0i, gvl); + C1r = __riscv_vfmacc(C1r, alphar, ACC1r, gvl); + C1i = __riscv_vfmacc(C1i, alphar, ACC1i, gvl); + C0r = __riscv_vfnmsac(C0r, alphai, ACC0i, gvl); + C0i = __riscv_vfmacc(C0i, alphai, ACC0r, gvl); + C1r = __riscv_vfnmsac(C1r, alphai, ACC1i, gvl); + C1i = __riscv_vfmacc(C1i, alphai, ACC1r, gvl); + + ci = n_top * ldc + m_top; + + __riscv_vsse32_v_f32m2(&C[ci * 2 + 0], sizeof(FLOAT) * 2, C0r, gvl); + __riscv_vsse32_v_f32m2(&C[ci * 2 + 1], sizeof(FLOAT) * 2, C0i, gvl); + ci += ldc - gvl * 0; + __riscv_vsse32_v_f32m2(&C[ci * 2 + 0], sizeof(FLOAT) * 2, C1r, gvl); + __riscv_vsse32_v_f32m2(&C[ci * 2 + 1], sizeof(FLOAT) * 2, C1i, gvl); + + m_top += 8; + } + + if (M & 4) { + gvl = __riscv_vsetvl_e32m2(4); + + BLASLONG ai = m_top * K * 2; + BLASLONG bi = n_top * K * 2; + float B0r = B[bi + 0 * 2 + 0]; + float B0i = B[bi + 0 * 2 + 1]; + float B1r = B[bi + 1 * 2 + 0]; + float B1i = B[bi + 1 * 2 + 1]; + bi += 2 * 2; + + vfloat32m2_t A0r = __riscv_vlse32_v_f32m2(&A[ai + 0 * gvl * 2], sizeof(FLOAT) * 2, gvl); + vfloat32m2_t A0i = __riscv_vlse32_v_f32m2(&A[ai + 0 * gvl * 2 + 1], sizeof(FLOAT) * 2, gvl); + ai += 4 * 2; + + // 2 vector regs to hold A array contents, 4 regs to hold values accumulated over k + // leaving 10 vector registers for temporaries + vfloat32m2_t tmp0r = __riscv_vfmul_vf_f32m2(A0i, B0i, gvl); + vfloat32m2_t tmp0i = __riscv_vfmul_vf_f32m2(A0r, B0i, gvl); + vfloat32m2_t tmp1r = __riscv_vfmul_vf_f32m2(A0i, B1i, gvl); + vfloat32m2_t tmp1i = __riscv_vfmul_vf_f32m2(A0r, B1i, gvl); + tmp0r = VFMACC_RR(tmp0r, B0r, A0r, gvl); + tmp0i = VFMACC_RI(tmp0i, B0r, A0i, gvl); + tmp1r = VFMACC_RR(tmp1r, B1r, A0r, gvl); + tmp1i = VFMACC_RI(tmp1i, B1r, A0i, gvl); + vfloat32m2_t ACC0r = tmp0r; + vfloat32m2_t ACC0i = tmp0i; + vfloat32m2_t ACC1r = tmp1r; + vfloat32m2_t ACC1i = tmp1i; + + for (BLASLONG k = 1; k < K; k++) { + B0r = B[bi + 0 * 2 + 0]; + B0i = B[bi + 0 * 2 + 1]; + B1r = B[bi + 1 * 2 + 0]; + B1i = B[bi + 1 * 2 + 1]; + bi += 2 * 2; + + A0r = __riscv_vlse32_v_f32m2(&A[ai + 0 * gvl * 2], sizeof(FLOAT) * 2, gvl); + A0i = __riscv_vlse32_v_f32m2(&A[ai + 0 * gvl * 2 + 1], sizeof(FLOAT) * 2, gvl); + ai += 4 * 2; + + tmp0r = __riscv_vfmul_vf_f32m2(A0i, B0i, gvl); + tmp0i = __riscv_vfmul_vf_f32m2(A0r, B0i, gvl); + tmp1r = __riscv_vfmul_vf_f32m2(A0i, B1i, gvl); + tmp1i = __riscv_vfmul_vf_f32m2(A0r, B1i, gvl); + tmp0r = VFMACC_RR(tmp0r, B0r, A0r, gvl); + tmp0i = VFMACC_RI(tmp0i, B0r, A0i, gvl); + tmp1r = VFMACC_RR(tmp1r, B1r, A0r, gvl); + tmp1i = VFMACC_RI(tmp1i, B1r, A0i, gvl); + ACC0r = __riscv_vfadd(ACC0r, tmp0r, gvl); + ACC0i = __riscv_vfadd(ACC0i, tmp0i, gvl); + ACC1r = __riscv_vfadd(ACC1r, tmp1r, gvl); + ACC1i = __riscv_vfadd(ACC1i, tmp1i, gvl); + } + + BLASLONG ci = n_top * ldc + m_top; + + vfloat32m2_t C0r = __riscv_vlse32_v_f32m2(&C[ci * 2 + 0], sizeof(FLOAT) * 2, gvl); + vfloat32m2_t C0i = __riscv_vlse32_v_f32m2(&C[ci * 2 + 1], sizeof(FLOAT) * 2, gvl); + ci += ldc - gvl * 0; + vfloat32m2_t C1r = __riscv_vlse32_v_f32m2(&C[ci * 2 + 0], sizeof(FLOAT) * 2, gvl); + vfloat32m2_t C1i = __riscv_vlse32_v_f32m2(&C[ci * 2 + 1], sizeof(FLOAT) * 2, gvl); + + C0r = __riscv_vfmacc(C0r, alphar, ACC0r, gvl); + C0i = __riscv_vfmacc(C0i, alphar, ACC0i, gvl); + C1r = __riscv_vfmacc(C1r, alphar, ACC1r, gvl); + C1i = __riscv_vfmacc(C1i, alphar, ACC1i, gvl); + C0r = __riscv_vfnmsac(C0r, alphai, ACC0i, gvl); + C0i = __riscv_vfmacc(C0i, alphai, ACC0r, gvl); + C1r = __riscv_vfnmsac(C1r, alphai, ACC1i, gvl); + C1i = __riscv_vfmacc(C1i, alphai, ACC1r, gvl); + + ci = n_top * ldc + m_top; + + __riscv_vsse32_v_f32m2(&C[ci * 2 + 0], sizeof(FLOAT) * 2, C0r, gvl); + __riscv_vsse32_v_f32m2(&C[ci * 2 + 1], sizeof(FLOAT) * 2, C0i, gvl); + ci += ldc - gvl * 0; + __riscv_vsse32_v_f32m2(&C[ci * 2 + 0], sizeof(FLOAT) * 2, C1r, gvl); + __riscv_vsse32_v_f32m2(&C[ci * 2 + 1], sizeof(FLOAT) * 2, C1i, gvl); + + m_top += 4; + } + + if (M & 2) { + float result0 = 0; + float result1 = 0; + float result2 = 0; + float result3 = 0; + float result4 = 0; + float result5 = 0; + float result6 = 0; + float result7 = 0; + BLASLONG ai = m_top * K * 2; + BLASLONG bi = n_top * K * 2; + + for (BLASLONG k = 0; k < K; k++) { + result0 += S0 * A[ai + 0 + 0] * B[bi + 0 + 0] + S1 * A[ai + 0 + 1] * B[bi + 0 + 1]; + result1 += S2 * A[ai + 0 + 1] * B[bi + 0 + 0] + S3 * A[ai + 0 + 0] * B[bi + 0 + 1]; + result2 += S0 * A[ai + 2 + 0] * B[bi + 0 + 0] + S1 * A[ai + 2 + 1] * B[bi + 0 + 1]; + result3 += S2 * A[ai + 2 + 1] * B[bi + 0 + 0] + S3 * A[ai + 2 + 0] * B[bi + 0 + 1]; + result4 += S0 * A[ai + 0 + 0] * B[bi + 2 + 0] + S1 * A[ai + 0 + 1] * B[bi + 2 + 1]; + result5 += S2 * A[ai + 0 + 1] * B[bi + 2 + 0] + S3 * A[ai + 0 + 0] * B[bi + 2 + 1]; + result6 += S0 * A[ai + 2 + 0] * B[bi + 2 + 0] + S1 * A[ai + 2 + 1] * B[bi + 2 + 1]; + result7 += S2 * A[ai + 2 + 1] * B[bi + 2 + 0] + S3 * A[ai + 2 + 0] * B[bi + 2 + 1]; + ai += 2 * 2; + bi += 2 * 2; + } + + BLASLONG ci = n_top * ldc + m_top; + float Cr, Ci; + Cr = C[(ci + 0 * ldc + 0) * 2 + 0]; + Ci = C[(ci + 0 * ldc + 0) * 2 + 1]; + Cr += result0 * alphar; + Ci += result1 * alphar; + Cr -= result1 * alphai; + Ci += result0 * alphai; + C[(ci + 0 * ldc + 0) * 2 + 0] = Cr; + C[(ci + 0 * ldc + 0) * 2 + 1] = Ci; + Cr = C[(ci + 0 * ldc + 1) * 2 + 0]; + Ci = C[(ci + 0 * ldc + 1) * 2 + 1]; + Cr += result2 * alphar; + Ci += result3 * alphar; + Cr -= result3 * alphai; + Ci += result2 * alphai; + C[(ci + 0 * ldc + 1) * 2 + 0] = Cr; + C[(ci + 0 * ldc + 1) * 2 + 1] = Ci; + Cr = C[(ci + 1 * ldc + 0) * 2 + 0]; + Ci = C[(ci + 1 * ldc + 0) * 2 + 1]; + Cr += result4 * alphar; + Ci += result5 * alphar; + Cr -= result5 * alphai; + Ci += result4 * alphai; + C[(ci + 1 * ldc + 0) * 2 + 0] = Cr; + C[(ci + 1 * ldc + 0) * 2 + 1] = Ci; + Cr = C[(ci + 1 * ldc + 1) * 2 + 0]; + Ci = C[(ci + 1 * ldc + 1) * 2 + 1]; + Cr += result6 * alphar; + Ci += result7 * alphar; + Cr -= result7 * alphai; + Ci += result6 * alphai; + C[(ci + 1 * ldc + 1) * 2 + 0] = Cr; + C[(ci + 1 * ldc + 1) * 2 + 1] = Ci; + m_top += 2; + } + + if (M & 1) { + float result0 = 0; + float result1 = 0; + float result2 = 0; + float result3 = 0; + BLASLONG ai = m_top * K * 2; + BLASLONG bi = n_top * K * 2; + + for (BLASLONG k = 0; k < K; k++) { + result0 += S0 * A[ai + 0 + 0] * B[bi + 0 + 0] + S1 * A[ai + 0 + 1] * B[bi + 0 + 1]; + result1 += S2 * A[ai + 0 + 1] * B[bi + 0 + 0] + S3 * A[ai + 0 + 0] * B[bi + 0 + 1]; + result2 += S0 * A[ai + 0 + 0] * B[bi + 2 + 0] + S1 * A[ai + 0 + 1] * B[bi + 2 + 1]; + result3 += S2 * A[ai + 0 + 1] * B[bi + 2 + 0] + S3 * A[ai + 0 + 0] * B[bi + 2 + 1]; + ai += 1 * 2; + bi += 2 * 2; + } + + BLASLONG ci = n_top * ldc + m_top; + float Cr, Ci; + Cr = C[(ci + 0 * ldc + 0) * 2 + 0]; + Ci = C[(ci + 0 * ldc + 0) * 2 + 1]; + Cr += result0 * alphar; + Ci += result1 * alphar; + Cr -= result1 * alphai; + Ci += result0 * alphai; + C[(ci + 0 * ldc + 0) * 2 + 0] = Cr; + C[(ci + 0 * ldc + 0) * 2 + 1] = Ci; + Cr = C[(ci + 1 * ldc + 0) * 2 + 0]; + Ci = C[(ci + 1 * ldc + 0) * 2 + 1]; + Cr += result2 * alphar; + Ci += result3 * alphar; + Cr -= result3 * alphai; + Ci += result2 * alphai; + C[(ci + 1 * ldc + 0) * 2 + 0] = Cr; + C[(ci + 1 * ldc + 0) * 2 + 1] = Ci; + m_top += 1; + } + + n_top += 2; + } + + // -- tails for N=1 + + if (N & 1) { + gvl = __riscv_vsetvl_e32m2(8); + m_top = 0; + + for (BLASLONG i = 0; i < M / 8; i += 1) { + BLASLONG ai = m_top * K * 2; + BLASLONG bi = n_top * K * 2; + float B0r = B[bi + 0 * 2 + 0]; + float B0i = B[bi + 0 * 2 + 1]; + bi += 1 * 2; + + vfloat32m2_t A0r = __riscv_vlse32_v_f32m2(&A[ai + 0 * gvl * 2], sizeof(FLOAT) * 2, gvl); + vfloat32m2_t A0i = __riscv_vlse32_v_f32m2(&A[ai + 0 * gvl * 2 + 1], sizeof(FLOAT) * 2, gvl); + ai += 8 * 2; + + // 2 vector regs to hold A array contents, 2 regs to hold values accumulated over k + // leaving 12 vector registers for temporaries + vfloat32m2_t tmp0r = __riscv_vfmul_vf_f32m2(A0i, B0i, gvl); + vfloat32m2_t tmp0i = __riscv_vfmul_vf_f32m2(A0r, B0i, gvl); + tmp0r = VFMACC_RR(tmp0r, B0r, A0r, gvl); + tmp0i = VFMACC_RI(tmp0i, B0r, A0i, gvl); + vfloat32m2_t ACC0r = tmp0r; + vfloat32m2_t ACC0i = tmp0i; + + for (BLASLONG k = 1; k < K; k++) { + B0r = B[bi + 0 * 2 + 0]; + B0i = B[bi + 0 * 2 + 1]; + bi += 1 * 2; + + A0r = __riscv_vlse32_v_f32m2(&A[ai + 0 * gvl * 2], sizeof(FLOAT) * 2, gvl); + A0i = __riscv_vlse32_v_f32m2(&A[ai + 0 * gvl * 2 + 1], sizeof(FLOAT) * 2, gvl); + ai += 8 * 2; + + tmp0r = __riscv_vfmul_vf_f32m2(A0i, B0i, gvl); + tmp0i = __riscv_vfmul_vf_f32m2(A0r, B0i, gvl); + tmp0r = VFMACC_RR(tmp0r, B0r, A0r, gvl); + tmp0i = VFMACC_RI(tmp0i, B0r, A0i, gvl); + ACC0r = __riscv_vfadd(ACC0r, tmp0r, gvl); + ACC0i = __riscv_vfadd(ACC0i, tmp0i, gvl); + } + + BLASLONG ci = n_top * ldc + m_top; + + vfloat32m2_t C0r = __riscv_vlse32_v_f32m2(&C[ci * 2 + 0], sizeof(FLOAT) * 2, gvl); + vfloat32m2_t C0i = __riscv_vlse32_v_f32m2(&C[ci * 2 + 1], sizeof(FLOAT) * 2, gvl); + + C0r = __riscv_vfmacc(C0r, alphar, ACC0r, gvl); + C0i = __riscv_vfmacc(C0i, alphar, ACC0i, gvl); + C0r = __riscv_vfnmsac(C0r, alphai, ACC0i, gvl); + C0i = __riscv_vfmacc(C0i, alphai, ACC0r, gvl); + + ci = n_top * ldc + m_top; + + __riscv_vsse32_v_f32m2(&C[ci * 2 + 0], sizeof(FLOAT) * 2, C0r, gvl); + __riscv_vsse32_v_f32m2(&C[ci * 2 + 1], sizeof(FLOAT) * 2, C0i, gvl); + + m_top += 8; + } + + if (M & 4) { + gvl = __riscv_vsetvl_e32m2(4); + + BLASLONG ai = m_top * K * 2; + BLASLONG bi = n_top * K * 2; + float B0r = B[bi + 0 * 2 + 0]; + float B0i = B[bi + 0 * 2 + 1]; + bi += 1 * 2; + + vfloat32m2_t A0r = __riscv_vlse32_v_f32m2(&A[ai + 0 * gvl * 2], sizeof(FLOAT) * 2, gvl); + vfloat32m2_t A0i = __riscv_vlse32_v_f32m2(&A[ai + 0 * gvl * 2 + 1], sizeof(FLOAT) * 2, gvl); + ai += 4 * 2; + + // 2 vector regs to hold A array contents, 2 regs to hold values accumulated over k + // leaving 12 vector registers for temporaries + vfloat32m2_t tmp0r = __riscv_vfmul_vf_f32m2(A0i, B0i, gvl); + vfloat32m2_t tmp0i = __riscv_vfmul_vf_f32m2(A0r, B0i, gvl); + tmp0r = VFMACC_RR(tmp0r, B0r, A0r, gvl); + tmp0i = VFMACC_RI(tmp0i, B0r, A0i, gvl); + vfloat32m2_t ACC0r = tmp0r; + vfloat32m2_t ACC0i = tmp0i; + + for (BLASLONG k = 1; k < K; k++) { + B0r = B[bi + 0 * 2 + 0]; + B0i = B[bi + 0 * 2 + 1]; + bi += 1 * 2; + + A0r = __riscv_vlse32_v_f32m2(&A[ai + 0 * gvl * 2], sizeof(FLOAT) * 2, gvl); + A0i = __riscv_vlse32_v_f32m2(&A[ai + 0 * gvl * 2 + 1], sizeof(FLOAT) * 2, gvl); + ai += 4 * 2; + + tmp0r = __riscv_vfmul_vf_f32m2(A0i, B0i, gvl); + tmp0i = __riscv_vfmul_vf_f32m2(A0r, B0i, gvl); + tmp0r = VFMACC_RR(tmp0r, B0r, A0r, gvl); + tmp0i = VFMACC_RI(tmp0i, B0r, A0i, gvl); + ACC0r = __riscv_vfadd(ACC0r, tmp0r, gvl); + ACC0i = __riscv_vfadd(ACC0i, tmp0i, gvl); + } + + BLASLONG ci = n_top * ldc + m_top; + + vfloat32m2_t C0r = __riscv_vlse32_v_f32m2(&C[ci * 2 + 0], sizeof(FLOAT) * 2, gvl); + vfloat32m2_t C0i = __riscv_vlse32_v_f32m2(&C[ci * 2 + 1], sizeof(FLOAT) * 2, gvl); + + C0r = __riscv_vfmacc(C0r, alphar, ACC0r, gvl); + C0i = __riscv_vfmacc(C0i, alphar, ACC0i, gvl); + C0r = __riscv_vfnmsac(C0r, alphai, ACC0i, gvl); + C0i = __riscv_vfmacc(C0i, alphai, ACC0r, gvl); + + ci = n_top * ldc + m_top; + + __riscv_vsse32_v_f32m2(&C[ci * 2 + 0], sizeof(FLOAT) * 2, C0r, gvl); + __riscv_vsse32_v_f32m2(&C[ci * 2 + 1], sizeof(FLOAT) * 2, C0i, gvl); + + m_top += 4; + } + + if (M & 2) { + float result0 = 0; + float result1 = 0; + float result2 = 0; + float result3 = 0; + BLASLONG ai = m_top * K * 2; + BLASLONG bi = n_top * K * 2; + + for (BLASLONG k = 0; k < K; k++) { + result0 += S0 * A[ai + 0 + 0] * B[bi + 0 + 0] + S1 * A[ai + 0 + 1] * B[bi + 0 + 1]; + result1 += S2 * A[ai + 0 + 1] * B[bi + 0 + 0] + S3 * A[ai + 0 + 0] * B[bi + 0 + 1]; + result2 += S0 * A[ai + 2 + 0] * B[bi + 0 + 0] + S1 * A[ai + 2 + 1] * B[bi + 0 + 1]; + result3 += S2 * A[ai + 2 + 1] * B[bi + 0 + 0] + S3 * A[ai + 2 + 0] * B[bi + 0 + 1]; + ai += 2 * 2; + bi += 1 * 2; + } + + BLASLONG ci = n_top * ldc + m_top; + float Cr, Ci; + Cr = C[(ci + 0 * ldc + 0) * 2 + 0]; + Ci = C[(ci + 0 * ldc + 0) * 2 + 1]; + Cr += result0 * alphar; + Ci += result1 * alphar; + Cr -= result1 * alphai; + Ci += result0 * alphai; + C[(ci + 0 * ldc + 0) * 2 + 0] = Cr; + C[(ci + 0 * ldc + 0) * 2 + 1] = Ci; + Cr = C[(ci + 0 * ldc + 1) * 2 + 0]; + Ci = C[(ci + 0 * ldc + 1) * 2 + 1]; + Cr += result2 * alphar; + Ci += result3 * alphar; + Cr -= result3 * alphai; + Ci += result2 * alphai; + C[(ci + 0 * ldc + 1) * 2 + 0] = Cr; + C[(ci + 0 * ldc + 1) * 2 + 1] = Ci; + m_top += 2; + } + + if (M & 1) { + float result0 = 0; + float result1 = 0; + BLASLONG ai = m_top * K * 2; + BLASLONG bi = n_top * K * 2; + + for (BLASLONG k = 0; k < K; k++) { + result0 += S0 * A[ai + 0 + 0] * B[bi + 0 + 0] + S1 * A[ai + 0 + 1] * B[bi + 0 + 1]; + result1 += S2 * A[ai + 0 + 1] * B[bi + 0 + 0] + S3 * A[ai + 0 + 0] * B[bi + 0 + 1]; + ai += 1 * 2; + bi += 1 * 2; + } + + BLASLONG ci = n_top * ldc + m_top; + float Cr, Ci; + Cr = C[(ci + 0 * ldc + 0) * 2 + 0]; + Ci = C[(ci + 0 * ldc + 0) * 2 + 1]; + Cr += result0 * alphar; + Ci += result1 * alphar; + Cr -= result1 * alphai; + Ci += result0 * alphai; + C[(ci + 0 * ldc + 0) * 2 + 0] = Cr; + C[(ci + 0 * ldc + 0) * 2 + 1] = Ci; + m_top += 1; + } + + n_top += 1; + } + + return 0; +} diff --git a/kernel/riscv64/ctrmm_kernel_8x4_zvl128b.c b/kernel/riscv64/ctrmm_kernel_8x4_zvl128b.c new file mode 100644 index 000000000..3268cb810 --- /dev/null +++ b/kernel/riscv64/ctrmm_kernel_8x4_zvl128b.c @@ -0,0 +1,1102 @@ +/* + +AUTOGENERATED KERNEL +Script: ./kernel/riscv64/generate_kernel.py +Settings: + LMUL=2 + M=8 + M_tail_scalar_from=2 + N=4 + __riscv_='__riscv_' + complex=True + conjugate=False + cpu='zvl128b' + force_acc_double=False + index_type='BLASLONG' + op='trmm' + param_precision='float' + reg_width_bits=128 + tail_policy='' + trace=False + +Derived: + ELEN_ACC=32 + ELEN_PARAM=32 + LMUL_ACC=2 + VFMACC='__riscv_vfmacc_vf_f32m2' + VFMUL='__riscv_vfmul_vf_f32m2' + VLEV='__riscv_vle32_v_f32m2' + VLSEV='__riscv_vlse32_v_f32m2' + VMACC_TO_ACC='__riscv_vfmacc_vf_f32m2' + VMUL_TO_ACC='__riscv_vfmul_vf_f32m2' + VSETVL='__riscv_vsetvl_e32m2' + VSEV='__riscv_vse32_v_f32m2' + VSSEV='__riscv_vsse32_v_f32m2' + acc_vector_t='vfloat32m2_t' + output='ctrmm_kernel_8x4_zvl128b.c' + param_scalar_t='float' + param_vector_t='vfloat32m2_t' + +*/ + +#include "common.h" + +#if defined(NN) || defined(NT) || defined(TN) || defined(TT) +#define S0 1 +#define S1 -1 +#define S2 1 +#define S3 1 +#define VFMACC_RR __riscv_vfmsac +#define VFMACC_RI __riscv_vfmacc +#endif +#if defined(NR) || defined(NC) || defined(TR) || defined(TC) +#define S0 1 +#define S1 1 +#define S2 1 +#define S3 -1 +#define VFMACC_RR __riscv_vfmacc +#define VFMACC_RI __riscv_vfmsac +#endif +#if defined(RN) || defined(RT) || defined(CN) || defined(CT) +#define S0 1 +#define S1 1 +#define S2 -1 +#define S3 1 +#define VFMACC_RR __riscv_vfmacc +#define VFMACC_RI __riscv_vfnmsac +#endif +#if defined(RR) || defined(RC) || defined(CR) || defined(CC) +#define S0 1 +#define S1 -1 +#define S2 -1 +#define S3 -1 +#define VFMACC_RR __riscv_vfmsac +#define VFMACC_RI __riscv_vfnmacc +#endif + +#if defined(LEFT) != defined(TRANSA) +#define BACKWARDS +#endif + +int CNAME(BLASLONG M, BLASLONG N, BLASLONG K, FLOAT alphar, FLOAT alphai, FLOAT *A, FLOAT *B, FLOAT *C, BLASLONG ldc, BLASLONG offset) + +{ + BLASLONG gvl = 0; + BLASLONG m_top = 0; + BLASLONG n_top = 0; + + // -- MAIN PASS + + for (BLASLONG j = 0; j < N / 4; j += 1) { + m_top = 0; + BLASLONG gvl = __riscv_vsetvl_e32m2(8); + + for (BLASLONG i = 0; i < M / 8; i += 1) { + BLASLONG ai = m_top * K * 2; + BLASLONG bi = n_top * K * 2; + BLASLONG pass_K = K; +#ifdef LEFT + BLASLONG off = offset + m_top; +#else + BLASLONG off = -offset + n_top; +#endif +#ifdef BACKWARDS + ai += off * 8 * 2; + bi += off * 4 * 2; + pass_K -= off; +#else +#ifdef LEFT + pass_K = off + 8; +#else + pass_K = off + 4; +#endif +#endif + float B0r = B[bi + 0 * 2 + 0]; + float B0i = B[bi + 0 * 2 + 1]; + float B1r = B[bi + 1 * 2 + 0]; + float B1i = B[bi + 1 * 2 + 1]; + float B2r = B[bi + 2 * 2 + 0]; + float B2i = B[bi + 2 * 2 + 1]; + float B3r = B[bi + 3 * 2 + 0]; + float B3i = B[bi + 3 * 2 + 1]; + bi += 4 * 2; + + vfloat32m2_t A0r = __riscv_vlse32_v_f32m2(&A[ai + 0 * gvl * 2], sizeof(FLOAT) * 2, gvl); + vfloat32m2_t A0i = __riscv_vlse32_v_f32m2(&A[ai + 0 * gvl * 2 + 1], sizeof(FLOAT) * 2, gvl); + ai += 8 * 2; + + // 2 vector regs to hold A array contents, 8 regs to hold values accumulated over k + // leaving 6 vector registers for temporaries + // performing 2 operations between reuses of temporaries + vfloat32m2_t tmp0r = __riscv_vfmul_vf_f32m2(A0i, B0i, gvl); + vfloat32m2_t tmp0i = __riscv_vfmul_vf_f32m2(A0r, B0i, gvl); + vfloat32m2_t tmp1r = __riscv_vfmul_vf_f32m2(A0i, B1i, gvl); + vfloat32m2_t tmp1i = __riscv_vfmul_vf_f32m2(A0r, B1i, gvl); + tmp0r = VFMACC_RR(tmp0r, B0r, A0r, gvl); + tmp0i = VFMACC_RI(tmp0i, B0r, A0i, gvl); + tmp1r = VFMACC_RR(tmp1r, B1r, A0r, gvl); + tmp1i = VFMACC_RI(tmp1i, B1r, A0i, gvl); + vfloat32m2_t ACC0r = tmp0r; + vfloat32m2_t ACC0i = tmp0i; + vfloat32m2_t ACC1r = tmp1r; + vfloat32m2_t ACC1i = tmp1i; + tmp0r = __riscv_vfmul_vf_f32m2(A0i, B2i, gvl); + tmp0i = __riscv_vfmul_vf_f32m2(A0r, B2i, gvl); + tmp1r = __riscv_vfmul_vf_f32m2(A0i, B3i, gvl); + tmp1i = __riscv_vfmul_vf_f32m2(A0r, B3i, gvl); + tmp0r = VFMACC_RR(tmp0r, B2r, A0r, gvl); + tmp0i = VFMACC_RI(tmp0i, B2r, A0i, gvl); + tmp1r = VFMACC_RR(tmp1r, B3r, A0r, gvl); + tmp1i = VFMACC_RI(tmp1i, B3r, A0i, gvl); + vfloat32m2_t ACC2r = tmp0r; + vfloat32m2_t ACC2i = tmp0i; + vfloat32m2_t ACC3r = tmp1r; + vfloat32m2_t ACC3i = tmp1i; + + for (BLASLONG k = 1; k < pass_K; k++) { + B0r = B[bi + 0 * 2 + 0]; + B0i = B[bi + 0 * 2 + 1]; + B1r = B[bi + 1 * 2 + 0]; + B1i = B[bi + 1 * 2 + 1]; + B2r = B[bi + 2 * 2 + 0]; + B2i = B[bi + 2 * 2 + 1]; + B3r = B[bi + 3 * 2 + 0]; + B3i = B[bi + 3 * 2 + 1]; + bi += 4 * 2; + + A0r = __riscv_vlse32_v_f32m2(&A[ai + 0 * gvl * 2], sizeof(FLOAT) * 2, gvl); + A0i = __riscv_vlse32_v_f32m2(&A[ai + 0 * gvl * 2 + 1], sizeof(FLOAT) * 2, gvl); + ai += 8 * 2; + + tmp0r = __riscv_vfmul_vf_f32m2(A0i, B0i, gvl); + tmp0i = __riscv_vfmul_vf_f32m2(A0r, B0i, gvl); + tmp1r = __riscv_vfmul_vf_f32m2(A0i, B1i, gvl); + tmp1i = __riscv_vfmul_vf_f32m2(A0r, B1i, gvl); + tmp0r = VFMACC_RR(tmp0r, B0r, A0r, gvl); + tmp0i = VFMACC_RI(tmp0i, B0r, A0i, gvl); + tmp1r = VFMACC_RR(tmp1r, B1r, A0r, gvl); + tmp1i = VFMACC_RI(tmp1i, B1r, A0i, gvl); + ACC0r = __riscv_vfadd(ACC0r, tmp0r, gvl); + ACC0i = __riscv_vfadd(ACC0i, tmp0i, gvl); + ACC1r = __riscv_vfadd(ACC1r, tmp1r, gvl); + ACC1i = __riscv_vfadd(ACC1i, tmp1i, gvl); + tmp0r = __riscv_vfmul_vf_f32m2(A0i, B2i, gvl); + tmp0i = __riscv_vfmul_vf_f32m2(A0r, B2i, gvl); + tmp1r = __riscv_vfmul_vf_f32m2(A0i, B3i, gvl); + tmp1i = __riscv_vfmul_vf_f32m2(A0r, B3i, gvl); + tmp0r = VFMACC_RR(tmp0r, B2r, A0r, gvl); + tmp0i = VFMACC_RI(tmp0i, B2r, A0i, gvl); + tmp1r = VFMACC_RR(tmp1r, B3r, A0r, gvl); + tmp1i = VFMACC_RI(tmp1i, B3r, A0i, gvl); + ACC2r = __riscv_vfadd(ACC2r, tmp0r, gvl); + ACC2i = __riscv_vfadd(ACC2i, tmp0i, gvl); + ACC3r = __riscv_vfadd(ACC3r, tmp1r, gvl); + ACC3i = __riscv_vfadd(ACC3i, tmp1i, gvl); + } + + BLASLONG ci = n_top * ldc + m_top; + + vfloat32m2_t C0r = __riscv_vfmul(ACC0r, alphar, gvl); + vfloat32m2_t C0i = __riscv_vfmul(ACC0i, alphar, gvl); + vfloat32m2_t C1r = __riscv_vfmul(ACC1r, alphar, gvl); + vfloat32m2_t C1i = __riscv_vfmul(ACC1i, alphar, gvl); + vfloat32m2_t C2r = __riscv_vfmul(ACC2r, alphar, gvl); + vfloat32m2_t C2i = __riscv_vfmul(ACC2i, alphar, gvl); + vfloat32m2_t C3r = __riscv_vfmul(ACC3r, alphar, gvl); + vfloat32m2_t C3i = __riscv_vfmul(ACC3i, alphar, gvl); + C0r = __riscv_vfnmsac(C0r, alphai, ACC0i, gvl); + C0i = __riscv_vfmacc(C0i, alphai, ACC0r, gvl); + C1r = __riscv_vfnmsac(C1r, alphai, ACC1i, gvl); + C1i = __riscv_vfmacc(C1i, alphai, ACC1r, gvl); + C2r = __riscv_vfnmsac(C2r, alphai, ACC2i, gvl); + C2i = __riscv_vfmacc(C2i, alphai, ACC2r, gvl); + C3r = __riscv_vfnmsac(C3r, alphai, ACC3i, gvl); + C3i = __riscv_vfmacc(C3i, alphai, ACC3r, gvl); + __riscv_vsse32_v_f32m2(&C[ci * 2 + 0], sizeof(FLOAT) * 2, C0r, gvl); + __riscv_vsse32_v_f32m2(&C[ci * 2 + 1], sizeof(FLOAT) * 2, C0i, gvl); + ci += ldc - gvl * 0; + __riscv_vsse32_v_f32m2(&C[ci * 2 + 0], sizeof(FLOAT) * 2, C1r, gvl); + __riscv_vsse32_v_f32m2(&C[ci * 2 + 1], sizeof(FLOAT) * 2, C1i, gvl); + ci += ldc - gvl * 0; + __riscv_vsse32_v_f32m2(&C[ci * 2 + 0], sizeof(FLOAT) * 2, C2r, gvl); + __riscv_vsse32_v_f32m2(&C[ci * 2 + 1], sizeof(FLOAT) * 2, C2i, gvl); + ci += ldc - gvl * 0; + __riscv_vsse32_v_f32m2(&C[ci * 2 + 0], sizeof(FLOAT) * 2, C3r, gvl); + __riscv_vsse32_v_f32m2(&C[ci * 2 + 1], sizeof(FLOAT) * 2, C3i, gvl); + + m_top += 8; + } + + // -- tails for main pass + + if (M & 4) { + gvl = __riscv_vsetvl_e32m2(4); + + BLASLONG ai = m_top * K * 2; + BLASLONG bi = n_top * K * 2; + BLASLONG pass_K = K; +#ifdef LEFT + BLASLONG off = offset + m_top; +#else + BLASLONG off = -offset + n_top; +#endif +#ifdef BACKWARDS + ai += off * 4 * 2; + bi += off * 4 * 2; + pass_K -= off; +#else +#ifdef LEFT + pass_K = off + 4; +#else + pass_K = off + 4; +#endif +#endif + float B0r = B[bi + 0 * 2 + 0]; + float B0i = B[bi + 0 * 2 + 1]; + float B1r = B[bi + 1 * 2 + 0]; + float B1i = B[bi + 1 * 2 + 1]; + float B2r = B[bi + 2 * 2 + 0]; + float B2i = B[bi + 2 * 2 + 1]; + float B3r = B[bi + 3 * 2 + 0]; + float B3i = B[bi + 3 * 2 + 1]; + bi += 4 * 2; + + vfloat32m2_t A0r = __riscv_vlse32_v_f32m2(&A[ai + 0 * gvl * 2], sizeof(FLOAT) * 2, gvl); + vfloat32m2_t A0i = __riscv_vlse32_v_f32m2(&A[ai + 0 * gvl * 2 + 1], sizeof(FLOAT) * 2, gvl); + ai += 4 * 2; + + // 2 vector regs to hold A array contents, 8 regs to hold values accumulated over k + // leaving 6 vector registers for temporaries + // performing 2 operations between reuses of temporaries + vfloat32m2_t tmp0r = __riscv_vfmul_vf_f32m2(A0i, B0i, gvl); + vfloat32m2_t tmp0i = __riscv_vfmul_vf_f32m2(A0r, B0i, gvl); + vfloat32m2_t tmp1r = __riscv_vfmul_vf_f32m2(A0i, B1i, gvl); + vfloat32m2_t tmp1i = __riscv_vfmul_vf_f32m2(A0r, B1i, gvl); + tmp0r = VFMACC_RR(tmp0r, B0r, A0r, gvl); + tmp0i = VFMACC_RI(tmp0i, B0r, A0i, gvl); + tmp1r = VFMACC_RR(tmp1r, B1r, A0r, gvl); + tmp1i = VFMACC_RI(tmp1i, B1r, A0i, gvl); + vfloat32m2_t ACC0r = tmp0r; + vfloat32m2_t ACC0i = tmp0i; + vfloat32m2_t ACC1r = tmp1r; + vfloat32m2_t ACC1i = tmp1i; + tmp0r = __riscv_vfmul_vf_f32m2(A0i, B2i, gvl); + tmp0i = __riscv_vfmul_vf_f32m2(A0r, B2i, gvl); + tmp1r = __riscv_vfmul_vf_f32m2(A0i, B3i, gvl); + tmp1i = __riscv_vfmul_vf_f32m2(A0r, B3i, gvl); + tmp0r = VFMACC_RR(tmp0r, B2r, A0r, gvl); + tmp0i = VFMACC_RI(tmp0i, B2r, A0i, gvl); + tmp1r = VFMACC_RR(tmp1r, B3r, A0r, gvl); + tmp1i = VFMACC_RI(tmp1i, B3r, A0i, gvl); + vfloat32m2_t ACC2r = tmp0r; + vfloat32m2_t ACC2i = tmp0i; + vfloat32m2_t ACC3r = tmp1r; + vfloat32m2_t ACC3i = tmp1i; + + for (BLASLONG k = 1; k < pass_K; k++) { + B0r = B[bi + 0 * 2 + 0]; + B0i = B[bi + 0 * 2 + 1]; + B1r = B[bi + 1 * 2 + 0]; + B1i = B[bi + 1 * 2 + 1]; + B2r = B[bi + 2 * 2 + 0]; + B2i = B[bi + 2 * 2 + 1]; + B3r = B[bi + 3 * 2 + 0]; + B3i = B[bi + 3 * 2 + 1]; + bi += 4 * 2; + + A0r = __riscv_vlse32_v_f32m2(&A[ai + 0 * gvl * 2], sizeof(FLOAT) * 2, gvl); + A0i = __riscv_vlse32_v_f32m2(&A[ai + 0 * gvl * 2 + 1], sizeof(FLOAT) * 2, gvl); + ai += 4 * 2; + + tmp0r = __riscv_vfmul_vf_f32m2(A0i, B0i, gvl); + tmp0i = __riscv_vfmul_vf_f32m2(A0r, B0i, gvl); + tmp1r = __riscv_vfmul_vf_f32m2(A0i, B1i, gvl); + tmp1i = __riscv_vfmul_vf_f32m2(A0r, B1i, gvl); + tmp0r = VFMACC_RR(tmp0r, B0r, A0r, gvl); + tmp0i = VFMACC_RI(tmp0i, B0r, A0i, gvl); + tmp1r = VFMACC_RR(tmp1r, B1r, A0r, gvl); + tmp1i = VFMACC_RI(tmp1i, B1r, A0i, gvl); + ACC0r = __riscv_vfadd(ACC0r, tmp0r, gvl); + ACC0i = __riscv_vfadd(ACC0i, tmp0i, gvl); + ACC1r = __riscv_vfadd(ACC1r, tmp1r, gvl); + ACC1i = __riscv_vfadd(ACC1i, tmp1i, gvl); + tmp0r = __riscv_vfmul_vf_f32m2(A0i, B2i, gvl); + tmp0i = __riscv_vfmul_vf_f32m2(A0r, B2i, gvl); + tmp1r = __riscv_vfmul_vf_f32m2(A0i, B3i, gvl); + tmp1i = __riscv_vfmul_vf_f32m2(A0r, B3i, gvl); + tmp0r = VFMACC_RR(tmp0r, B2r, A0r, gvl); + tmp0i = VFMACC_RI(tmp0i, B2r, A0i, gvl); + tmp1r = VFMACC_RR(tmp1r, B3r, A0r, gvl); + tmp1i = VFMACC_RI(tmp1i, B3r, A0i, gvl); + ACC2r = __riscv_vfadd(ACC2r, tmp0r, gvl); + ACC2i = __riscv_vfadd(ACC2i, tmp0i, gvl); + ACC3r = __riscv_vfadd(ACC3r, tmp1r, gvl); + ACC3i = __riscv_vfadd(ACC3i, tmp1i, gvl); + } + + BLASLONG ci = n_top * ldc + m_top; + + vfloat32m2_t C0r = __riscv_vfmul(ACC0r, alphar, gvl); + vfloat32m2_t C0i = __riscv_vfmul(ACC0i, alphar, gvl); + vfloat32m2_t C1r = __riscv_vfmul(ACC1r, alphar, gvl); + vfloat32m2_t C1i = __riscv_vfmul(ACC1i, alphar, gvl); + vfloat32m2_t C2r = __riscv_vfmul(ACC2r, alphar, gvl); + vfloat32m2_t C2i = __riscv_vfmul(ACC2i, alphar, gvl); + vfloat32m2_t C3r = __riscv_vfmul(ACC3r, alphar, gvl); + vfloat32m2_t C3i = __riscv_vfmul(ACC3i, alphar, gvl); + C0r = __riscv_vfnmsac(C0r, alphai, ACC0i, gvl); + C0i = __riscv_vfmacc(C0i, alphai, ACC0r, gvl); + C1r = __riscv_vfnmsac(C1r, alphai, ACC1i, gvl); + C1i = __riscv_vfmacc(C1i, alphai, ACC1r, gvl); + C2r = __riscv_vfnmsac(C2r, alphai, ACC2i, gvl); + C2i = __riscv_vfmacc(C2i, alphai, ACC2r, gvl); + C3r = __riscv_vfnmsac(C3r, alphai, ACC3i, gvl); + C3i = __riscv_vfmacc(C3i, alphai, ACC3r, gvl); + __riscv_vsse32_v_f32m2(&C[ci * 2 + 0], sizeof(FLOAT) * 2, C0r, gvl); + __riscv_vsse32_v_f32m2(&C[ci * 2 + 1], sizeof(FLOAT) * 2, C0i, gvl); + ci += ldc - gvl * 0; + __riscv_vsse32_v_f32m2(&C[ci * 2 + 0], sizeof(FLOAT) * 2, C1r, gvl); + __riscv_vsse32_v_f32m2(&C[ci * 2 + 1], sizeof(FLOAT) * 2, C1i, gvl); + ci += ldc - gvl * 0; + __riscv_vsse32_v_f32m2(&C[ci * 2 + 0], sizeof(FLOAT) * 2, C2r, gvl); + __riscv_vsse32_v_f32m2(&C[ci * 2 + 1], sizeof(FLOAT) * 2, C2i, gvl); + ci += ldc - gvl * 0; + __riscv_vsse32_v_f32m2(&C[ci * 2 + 0], sizeof(FLOAT) * 2, C3r, gvl); + __riscv_vsse32_v_f32m2(&C[ci * 2 + 1], sizeof(FLOAT) * 2, C3i, gvl); + + m_top += 4; + } + + if (M & 2) { + float result0 = 0; + float result1 = 0; + float result2 = 0; + float result3 = 0; + float result4 = 0; + float result5 = 0; + float result6 = 0; + float result7 = 0; + float result8 = 0; + float result9 = 0; + float result10 = 0; + float result11 = 0; + float result12 = 0; + float result13 = 0; + float result14 = 0; + float result15 = 0; + BLASLONG ai = m_top * K * 2; + BLASLONG bi = n_top * K * 2; + BLASLONG pass_K = K; +#ifdef LEFT + BLASLONG off = offset + m_top; +#else + BLASLONG off = -offset + n_top; +#endif +#ifdef BACKWARDS + ai += off * 2 * 2; + bi += off * 4 * 2; + pass_K -= off; +#else +#ifdef LEFT + pass_K = off + 2; +#else + pass_K = off + 4; +#endif +#endif + + for (BLASLONG k = 0; k < pass_K; k++) { + result0 += S0 * A[ai + 0 + 0] * B[bi + 0 + 0] + S1 * A[ai + 0 + 1] * B[bi + 0 + 1]; + result1 += S2 * A[ai + 0 + 1] * B[bi + 0 + 0] + S3 * A[ai + 0 + 0] * B[bi + 0 + 1]; + result2 += S0 * A[ai + 2 + 0] * B[bi + 0 + 0] + S1 * A[ai + 2 + 1] * B[bi + 0 + 1]; + result3 += S2 * A[ai + 2 + 1] * B[bi + 0 + 0] + S3 * A[ai + 2 + 0] * B[bi + 0 + 1]; + result4 += S0 * A[ai + 0 + 0] * B[bi + 2 + 0] + S1 * A[ai + 0 + 1] * B[bi + 2 + 1]; + result5 += S2 * A[ai + 0 + 1] * B[bi + 2 + 0] + S3 * A[ai + 0 + 0] * B[bi + 2 + 1]; + result6 += S0 * A[ai + 2 + 0] * B[bi + 2 + 0] + S1 * A[ai + 2 + 1] * B[bi + 2 + 1]; + result7 += S2 * A[ai + 2 + 1] * B[bi + 2 + 0] + S3 * A[ai + 2 + 0] * B[bi + 2 + 1]; + result8 += S0 * A[ai + 0 + 0] * B[bi + 4 + 0] + S1 * A[ai + 0 + 1] * B[bi + 4 + 1]; + result9 += S2 * A[ai + 0 + 1] * B[bi + 4 + 0] + S3 * A[ai + 0 + 0] * B[bi + 4 + 1]; + result10 += S0 * A[ai + 2 + 0] * B[bi + 4 + 0] + S1 * A[ai + 2 + 1] * B[bi + 4 + 1]; + result11 += S2 * A[ai + 2 + 1] * B[bi + 4 + 0] + S3 * A[ai + 2 + 0] * B[bi + 4 + 1]; + result12 += S0 * A[ai + 0 + 0] * B[bi + 6 + 0] + S1 * A[ai + 0 + 1] * B[bi + 6 + 1]; + result13 += S2 * A[ai + 0 + 1] * B[bi + 6 + 0] + S3 * A[ai + 0 + 0] * B[bi + 6 + 1]; + result14 += S0 * A[ai + 2 + 0] * B[bi + 6 + 0] + S1 * A[ai + 2 + 1] * B[bi + 6 + 1]; + result15 += S2 * A[ai + 2 + 1] * B[bi + 6 + 0] + S3 * A[ai + 2 + 0] * B[bi + 6 + 1]; + ai += 2 * 2; + bi += 4 * 2; + } + + BLASLONG ci = n_top * ldc + m_top; + float Cr, Ci; + Cr = result0 * alphar; + Ci = result1 * alphar; + Cr -= result1 * alphai; + Ci += result0 * alphai; + C[(ci + 0 * ldc + 0) * 2 + 0] = Cr; + C[(ci + 0 * ldc + 0) * 2 + 1] = Ci; + Cr = result2 * alphar; + Ci = result3 * alphar; + Cr -= result3 * alphai; + Ci += result2 * alphai; + C[(ci + 0 * ldc + 1) * 2 + 0] = Cr; + C[(ci + 0 * ldc + 1) * 2 + 1] = Ci; + Cr = result4 * alphar; + Ci = result5 * alphar; + Cr -= result5 * alphai; + Ci += result4 * alphai; + C[(ci + 1 * ldc + 0) * 2 + 0] = Cr; + C[(ci + 1 * ldc + 0) * 2 + 1] = Ci; + Cr = result6 * alphar; + Ci = result7 * alphar; + Cr -= result7 * alphai; + Ci += result6 * alphai; + C[(ci + 1 * ldc + 1) * 2 + 0] = Cr; + C[(ci + 1 * ldc + 1) * 2 + 1] = Ci; + Cr = result8 * alphar; + Ci = result9 * alphar; + Cr -= result9 * alphai; + Ci += result8 * alphai; + C[(ci + 2 * ldc + 0) * 2 + 0] = Cr; + C[(ci + 2 * ldc + 0) * 2 + 1] = Ci; + Cr = result10 * alphar; + Ci = result11 * alphar; + Cr -= result11 * alphai; + Ci += result10 * alphai; + C[(ci + 2 * ldc + 1) * 2 + 0] = Cr; + C[(ci + 2 * ldc + 1) * 2 + 1] = Ci; + Cr = result12 * alphar; + Ci = result13 * alphar; + Cr -= result13 * alphai; + Ci += result12 * alphai; + C[(ci + 3 * ldc + 0) * 2 + 0] = Cr; + C[(ci + 3 * ldc + 0) * 2 + 1] = Ci; + Cr = result14 * alphar; + Ci = result15 * alphar; + Cr -= result15 * alphai; + Ci += result14 * alphai; + C[(ci + 3 * ldc + 1) * 2 + 0] = Cr; + C[(ci + 3 * ldc + 1) * 2 + 1] = Ci; + m_top += 2; + } + + if (M & 1) { + float result0 = 0; + float result1 = 0; + float result2 = 0; + float result3 = 0; + float result4 = 0; + float result5 = 0; + float result6 = 0; + float result7 = 0; + BLASLONG ai = m_top * K * 2; + BLASLONG bi = n_top * K * 2; + BLASLONG pass_K = K; +#ifdef LEFT + BLASLONG off = offset + m_top; +#else + BLASLONG off = -offset + n_top; +#endif +#ifdef BACKWARDS + ai += off * 1 * 2; + bi += off * 4 * 2; + pass_K -= off; +#else +#ifdef LEFT + pass_K = off + 1; +#else + pass_K = off + 4; +#endif +#endif + + for (BLASLONG k = 0; k < pass_K; k++) { + result0 += S0 * A[ai + 0 + 0] * B[bi + 0 + 0] + S1 * A[ai + 0 + 1] * B[bi + 0 + 1]; + result1 += S2 * A[ai + 0 + 1] * B[bi + 0 + 0] + S3 * A[ai + 0 + 0] * B[bi + 0 + 1]; + result2 += S0 * A[ai + 0 + 0] * B[bi + 2 + 0] + S1 * A[ai + 0 + 1] * B[bi + 2 + 1]; + result3 += S2 * A[ai + 0 + 1] * B[bi + 2 + 0] + S3 * A[ai + 0 + 0] * B[bi + 2 + 1]; + result4 += S0 * A[ai + 0 + 0] * B[bi + 4 + 0] + S1 * A[ai + 0 + 1] * B[bi + 4 + 1]; + result5 += S2 * A[ai + 0 + 1] * B[bi + 4 + 0] + S3 * A[ai + 0 + 0] * B[bi + 4 + 1]; + result6 += S0 * A[ai + 0 + 0] * B[bi + 6 + 0] + S1 * A[ai + 0 + 1] * B[bi + 6 + 1]; + result7 += S2 * A[ai + 0 + 1] * B[bi + 6 + 0] + S3 * A[ai + 0 + 0] * B[bi + 6 + 1]; + ai += 1 * 2; + bi += 4 * 2; + } + + BLASLONG ci = n_top * ldc + m_top; + float Cr, Ci; + Cr = result0 * alphar; + Ci = result1 * alphar; + Cr -= result1 * alphai; + Ci += result0 * alphai; + C[(ci + 0 * ldc + 0) * 2 + 0] = Cr; + C[(ci + 0 * ldc + 0) * 2 + 1] = Ci; + Cr = result2 * alphar; + Ci = result3 * alphar; + Cr -= result3 * alphai; + Ci += result2 * alphai; + C[(ci + 1 * ldc + 0) * 2 + 0] = Cr; + C[(ci + 1 * ldc + 0) * 2 + 1] = Ci; + Cr = result4 * alphar; + Ci = result5 * alphar; + Cr -= result5 * alphai; + Ci += result4 * alphai; + C[(ci + 2 * ldc + 0) * 2 + 0] = Cr; + C[(ci + 2 * ldc + 0) * 2 + 1] = Ci; + Cr = result6 * alphar; + Ci = result7 * alphar; + Cr -= result7 * alphai; + Ci += result6 * alphai; + C[(ci + 3 * ldc + 0) * 2 + 0] = Cr; + C[(ci + 3 * ldc + 0) * 2 + 1] = Ci; + m_top += 1; + } + + n_top += 4; + } + + // -- tails for N=2 + + if (N & 2) { + gvl = __riscv_vsetvl_e32m2(8); + m_top = 0; + + for (BLASLONG i = 0; i < M / 8; i += 1) { + BLASLONG ai = m_top * K * 2; + BLASLONG bi = n_top * K * 2; + BLASLONG pass_K = K; +#ifdef LEFT + BLASLONG off = offset + m_top; +#else + BLASLONG off = -offset + n_top; +#endif +#ifdef BACKWARDS + ai += off * 8 * 2; + bi += off * 2 * 2; + pass_K -= off; +#else +#ifdef LEFT + pass_K = off + 8; +#else + pass_K = off + 2; +#endif +#endif + float B0r = B[bi + 0 * 2 + 0]; + float B0i = B[bi + 0 * 2 + 1]; + float B1r = B[bi + 1 * 2 + 0]; + float B1i = B[bi + 1 * 2 + 1]; + bi += 2 * 2; + + vfloat32m2_t A0r = __riscv_vlse32_v_f32m2(&A[ai + 0 * gvl * 2], sizeof(FLOAT) * 2, gvl); + vfloat32m2_t A0i = __riscv_vlse32_v_f32m2(&A[ai + 0 * gvl * 2 + 1], sizeof(FLOAT) * 2, gvl); + ai += 8 * 2; + + // 2 vector regs to hold A array contents, 4 regs to hold values accumulated over k + // leaving 10 vector registers for temporaries + vfloat32m2_t tmp0r = __riscv_vfmul_vf_f32m2(A0i, B0i, gvl); + vfloat32m2_t tmp0i = __riscv_vfmul_vf_f32m2(A0r, B0i, gvl); + vfloat32m2_t tmp1r = __riscv_vfmul_vf_f32m2(A0i, B1i, gvl); + vfloat32m2_t tmp1i = __riscv_vfmul_vf_f32m2(A0r, B1i, gvl); + tmp0r = VFMACC_RR(tmp0r, B0r, A0r, gvl); + tmp0i = VFMACC_RI(tmp0i, B0r, A0i, gvl); + tmp1r = VFMACC_RR(tmp1r, B1r, A0r, gvl); + tmp1i = VFMACC_RI(tmp1i, B1r, A0i, gvl); + vfloat32m2_t ACC0r = tmp0r; + vfloat32m2_t ACC0i = tmp0i; + vfloat32m2_t ACC1r = tmp1r; + vfloat32m2_t ACC1i = tmp1i; + + for (BLASLONG k = 1; k < pass_K; k++) { + B0r = B[bi + 0 * 2 + 0]; + B0i = B[bi + 0 * 2 + 1]; + B1r = B[bi + 1 * 2 + 0]; + B1i = B[bi + 1 * 2 + 1]; + bi += 2 * 2; + + A0r = __riscv_vlse32_v_f32m2(&A[ai + 0 * gvl * 2], sizeof(FLOAT) * 2, gvl); + A0i = __riscv_vlse32_v_f32m2(&A[ai + 0 * gvl * 2 + 1], sizeof(FLOAT) * 2, gvl); + ai += 8 * 2; + + tmp0r = __riscv_vfmul_vf_f32m2(A0i, B0i, gvl); + tmp0i = __riscv_vfmul_vf_f32m2(A0r, B0i, gvl); + tmp1r = __riscv_vfmul_vf_f32m2(A0i, B1i, gvl); + tmp1i = __riscv_vfmul_vf_f32m2(A0r, B1i, gvl); + tmp0r = VFMACC_RR(tmp0r, B0r, A0r, gvl); + tmp0i = VFMACC_RI(tmp0i, B0r, A0i, gvl); + tmp1r = VFMACC_RR(tmp1r, B1r, A0r, gvl); + tmp1i = VFMACC_RI(tmp1i, B1r, A0i, gvl); + ACC0r = __riscv_vfadd(ACC0r, tmp0r, gvl); + ACC0i = __riscv_vfadd(ACC0i, tmp0i, gvl); + ACC1r = __riscv_vfadd(ACC1r, tmp1r, gvl); + ACC1i = __riscv_vfadd(ACC1i, tmp1i, gvl); + } + + BLASLONG ci = n_top * ldc + m_top; + + vfloat32m2_t C0r = __riscv_vfmul(ACC0r, alphar, gvl); + vfloat32m2_t C0i = __riscv_vfmul(ACC0i, alphar, gvl); + vfloat32m2_t C1r = __riscv_vfmul(ACC1r, alphar, gvl); + vfloat32m2_t C1i = __riscv_vfmul(ACC1i, alphar, gvl); + C0r = __riscv_vfnmsac(C0r, alphai, ACC0i, gvl); + C0i = __riscv_vfmacc(C0i, alphai, ACC0r, gvl); + C1r = __riscv_vfnmsac(C1r, alphai, ACC1i, gvl); + C1i = __riscv_vfmacc(C1i, alphai, ACC1r, gvl); + __riscv_vsse32_v_f32m2(&C[ci * 2 + 0], sizeof(FLOAT) * 2, C0r, gvl); + __riscv_vsse32_v_f32m2(&C[ci * 2 + 1], sizeof(FLOAT) * 2, C0i, gvl); + ci += ldc - gvl * 0; + __riscv_vsse32_v_f32m2(&C[ci * 2 + 0], sizeof(FLOAT) * 2, C1r, gvl); + __riscv_vsse32_v_f32m2(&C[ci * 2 + 1], sizeof(FLOAT) * 2, C1i, gvl); + + m_top += 8; + } + + if (M & 4) { + gvl = __riscv_vsetvl_e32m2(4); + + BLASLONG ai = m_top * K * 2; + BLASLONG bi = n_top * K * 2; + BLASLONG pass_K = K; +#ifdef LEFT + BLASLONG off = offset + m_top; +#else + BLASLONG off = -offset + n_top; +#endif +#ifdef BACKWARDS + ai += off * 4 * 2; + bi += off * 2 * 2; + pass_K -= off; +#else +#ifdef LEFT + pass_K = off + 4; +#else + pass_K = off + 2; +#endif +#endif + float B0r = B[bi + 0 * 2 + 0]; + float B0i = B[bi + 0 * 2 + 1]; + float B1r = B[bi + 1 * 2 + 0]; + float B1i = B[bi + 1 * 2 + 1]; + bi += 2 * 2; + + vfloat32m2_t A0r = __riscv_vlse32_v_f32m2(&A[ai + 0 * gvl * 2], sizeof(FLOAT) * 2, gvl); + vfloat32m2_t A0i = __riscv_vlse32_v_f32m2(&A[ai + 0 * gvl * 2 + 1], sizeof(FLOAT) * 2, gvl); + ai += 4 * 2; + + // 2 vector regs to hold A array contents, 4 regs to hold values accumulated over k + // leaving 10 vector registers for temporaries + vfloat32m2_t tmp0r = __riscv_vfmul_vf_f32m2(A0i, B0i, gvl); + vfloat32m2_t tmp0i = __riscv_vfmul_vf_f32m2(A0r, B0i, gvl); + vfloat32m2_t tmp1r = __riscv_vfmul_vf_f32m2(A0i, B1i, gvl); + vfloat32m2_t tmp1i = __riscv_vfmul_vf_f32m2(A0r, B1i, gvl); + tmp0r = VFMACC_RR(tmp0r, B0r, A0r, gvl); + tmp0i = VFMACC_RI(tmp0i, B0r, A0i, gvl); + tmp1r = VFMACC_RR(tmp1r, B1r, A0r, gvl); + tmp1i = VFMACC_RI(tmp1i, B1r, A0i, gvl); + vfloat32m2_t ACC0r = tmp0r; + vfloat32m2_t ACC0i = tmp0i; + vfloat32m2_t ACC1r = tmp1r; + vfloat32m2_t ACC1i = tmp1i; + + for (BLASLONG k = 1; k < pass_K; k++) { + B0r = B[bi + 0 * 2 + 0]; + B0i = B[bi + 0 * 2 + 1]; + B1r = B[bi + 1 * 2 + 0]; + B1i = B[bi + 1 * 2 + 1]; + bi += 2 * 2; + + A0r = __riscv_vlse32_v_f32m2(&A[ai + 0 * gvl * 2], sizeof(FLOAT) * 2, gvl); + A0i = __riscv_vlse32_v_f32m2(&A[ai + 0 * gvl * 2 + 1], sizeof(FLOAT) * 2, gvl); + ai += 4 * 2; + + tmp0r = __riscv_vfmul_vf_f32m2(A0i, B0i, gvl); + tmp0i = __riscv_vfmul_vf_f32m2(A0r, B0i, gvl); + tmp1r = __riscv_vfmul_vf_f32m2(A0i, B1i, gvl); + tmp1i = __riscv_vfmul_vf_f32m2(A0r, B1i, gvl); + tmp0r = VFMACC_RR(tmp0r, B0r, A0r, gvl); + tmp0i = VFMACC_RI(tmp0i, B0r, A0i, gvl); + tmp1r = VFMACC_RR(tmp1r, B1r, A0r, gvl); + tmp1i = VFMACC_RI(tmp1i, B1r, A0i, gvl); + ACC0r = __riscv_vfadd(ACC0r, tmp0r, gvl); + ACC0i = __riscv_vfadd(ACC0i, tmp0i, gvl); + ACC1r = __riscv_vfadd(ACC1r, tmp1r, gvl); + ACC1i = __riscv_vfadd(ACC1i, tmp1i, gvl); + } + + BLASLONG ci = n_top * ldc + m_top; + + vfloat32m2_t C0r = __riscv_vfmul(ACC0r, alphar, gvl); + vfloat32m2_t C0i = __riscv_vfmul(ACC0i, alphar, gvl); + vfloat32m2_t C1r = __riscv_vfmul(ACC1r, alphar, gvl); + vfloat32m2_t C1i = __riscv_vfmul(ACC1i, alphar, gvl); + C0r = __riscv_vfnmsac(C0r, alphai, ACC0i, gvl); + C0i = __riscv_vfmacc(C0i, alphai, ACC0r, gvl); + C1r = __riscv_vfnmsac(C1r, alphai, ACC1i, gvl); + C1i = __riscv_vfmacc(C1i, alphai, ACC1r, gvl); + __riscv_vsse32_v_f32m2(&C[ci * 2 + 0], sizeof(FLOAT) * 2, C0r, gvl); + __riscv_vsse32_v_f32m2(&C[ci * 2 + 1], sizeof(FLOAT) * 2, C0i, gvl); + ci += ldc - gvl * 0; + __riscv_vsse32_v_f32m2(&C[ci * 2 + 0], sizeof(FLOAT) * 2, C1r, gvl); + __riscv_vsse32_v_f32m2(&C[ci * 2 + 1], sizeof(FLOAT) * 2, C1i, gvl); + + m_top += 4; + } + + if (M & 2) { + float result0 = 0; + float result1 = 0; + float result2 = 0; + float result3 = 0; + float result4 = 0; + float result5 = 0; + float result6 = 0; + float result7 = 0; + BLASLONG ai = m_top * K * 2; + BLASLONG bi = n_top * K * 2; + BLASLONG pass_K = K; +#ifdef LEFT + BLASLONG off = offset + m_top; +#else + BLASLONG off = -offset + n_top; +#endif +#ifdef BACKWARDS + ai += off * 2 * 2; + bi += off * 2 * 2; + pass_K -= off; +#else +#ifdef LEFT + pass_K = off + 2; +#else + pass_K = off + 2; +#endif +#endif + + for (BLASLONG k = 0; k < pass_K; k++) { + result0 += S0 * A[ai + 0 + 0] * B[bi + 0 + 0] + S1 * A[ai + 0 + 1] * B[bi + 0 + 1]; + result1 += S2 * A[ai + 0 + 1] * B[bi + 0 + 0] + S3 * A[ai + 0 + 0] * B[bi + 0 + 1]; + result2 += S0 * A[ai + 2 + 0] * B[bi + 0 + 0] + S1 * A[ai + 2 + 1] * B[bi + 0 + 1]; + result3 += S2 * A[ai + 2 + 1] * B[bi + 0 + 0] + S3 * A[ai + 2 + 0] * B[bi + 0 + 1]; + result4 += S0 * A[ai + 0 + 0] * B[bi + 2 + 0] + S1 * A[ai + 0 + 1] * B[bi + 2 + 1]; + result5 += S2 * A[ai + 0 + 1] * B[bi + 2 + 0] + S3 * A[ai + 0 + 0] * B[bi + 2 + 1]; + result6 += S0 * A[ai + 2 + 0] * B[bi + 2 + 0] + S1 * A[ai + 2 + 1] * B[bi + 2 + 1]; + result7 += S2 * A[ai + 2 + 1] * B[bi + 2 + 0] + S3 * A[ai + 2 + 0] * B[bi + 2 + 1]; + ai += 2 * 2; + bi += 2 * 2; + } + + BLASLONG ci = n_top * ldc + m_top; + float Cr, Ci; + Cr = result0 * alphar; + Ci = result1 * alphar; + Cr -= result1 * alphai; + Ci += result0 * alphai; + C[(ci + 0 * ldc + 0) * 2 + 0] = Cr; + C[(ci + 0 * ldc + 0) * 2 + 1] = Ci; + Cr = result2 * alphar; + Ci = result3 * alphar; + Cr -= result3 * alphai; + Ci += result2 * alphai; + C[(ci + 0 * ldc + 1) * 2 + 0] = Cr; + C[(ci + 0 * ldc + 1) * 2 + 1] = Ci; + Cr = result4 * alphar; + Ci = result5 * alphar; + Cr -= result5 * alphai; + Ci += result4 * alphai; + C[(ci + 1 * ldc + 0) * 2 + 0] = Cr; + C[(ci + 1 * ldc + 0) * 2 + 1] = Ci; + Cr = result6 * alphar; + Ci = result7 * alphar; + Cr -= result7 * alphai; + Ci += result6 * alphai; + C[(ci + 1 * ldc + 1) * 2 + 0] = Cr; + C[(ci + 1 * ldc + 1) * 2 + 1] = Ci; + m_top += 2; + } + + if (M & 1) { + float result0 = 0; + float result1 = 0; + float result2 = 0; + float result3 = 0; + BLASLONG ai = m_top * K * 2; + BLASLONG bi = n_top * K * 2; + BLASLONG pass_K = K; +#ifdef LEFT + BLASLONG off = offset + m_top; +#else + BLASLONG off = -offset + n_top; +#endif +#ifdef BACKWARDS + ai += off * 1 * 2; + bi += off * 2 * 2; + pass_K -= off; +#else +#ifdef LEFT + pass_K = off + 1; +#else + pass_K = off + 2; +#endif +#endif + + for (BLASLONG k = 0; k < pass_K; k++) { + result0 += S0 * A[ai + 0 + 0] * B[bi + 0 + 0] + S1 * A[ai + 0 + 1] * B[bi + 0 + 1]; + result1 += S2 * A[ai + 0 + 1] * B[bi + 0 + 0] + S3 * A[ai + 0 + 0] * B[bi + 0 + 1]; + result2 += S0 * A[ai + 0 + 0] * B[bi + 2 + 0] + S1 * A[ai + 0 + 1] * B[bi + 2 + 1]; + result3 += S2 * A[ai + 0 + 1] * B[bi + 2 + 0] + S3 * A[ai + 0 + 0] * B[bi + 2 + 1]; + ai += 1 * 2; + bi += 2 * 2; + } + + BLASLONG ci = n_top * ldc + m_top; + float Cr, Ci; + Cr = result0 * alphar; + Ci = result1 * alphar; + Cr -= result1 * alphai; + Ci += result0 * alphai; + C[(ci + 0 * ldc + 0) * 2 + 0] = Cr; + C[(ci + 0 * ldc + 0) * 2 + 1] = Ci; + Cr = result2 * alphar; + Ci = result3 * alphar; + Cr -= result3 * alphai; + Ci += result2 * alphai; + C[(ci + 1 * ldc + 0) * 2 + 0] = Cr; + C[(ci + 1 * ldc + 0) * 2 + 1] = Ci; + m_top += 1; + } + + n_top += 2; + } + + // -- tails for N=1 + + if (N & 1) { + gvl = __riscv_vsetvl_e32m2(8); + m_top = 0; + + for (BLASLONG i = 0; i < M / 8; i += 1) { + BLASLONG ai = m_top * K * 2; + BLASLONG bi = n_top * K * 2; + BLASLONG pass_K = K; +#ifdef LEFT + BLASLONG off = offset + m_top; +#else + BLASLONG off = -offset + n_top; +#endif +#ifdef BACKWARDS + ai += off * 8 * 2; + bi += off * 1 * 2; + pass_K -= off; +#else +#ifdef LEFT + pass_K = off + 8; +#else + pass_K = off + 1; +#endif +#endif + float B0r = B[bi + 0 * 2 + 0]; + float B0i = B[bi + 0 * 2 + 1]; + bi += 1 * 2; + + vfloat32m2_t A0r = __riscv_vlse32_v_f32m2(&A[ai + 0 * gvl * 2], sizeof(FLOAT) * 2, gvl); + vfloat32m2_t A0i = __riscv_vlse32_v_f32m2(&A[ai + 0 * gvl * 2 + 1], sizeof(FLOAT) * 2, gvl); + ai += 8 * 2; + + // 2 vector regs to hold A array contents, 2 regs to hold values accumulated over k + // leaving 12 vector registers for temporaries + vfloat32m2_t tmp0r = __riscv_vfmul_vf_f32m2(A0i, B0i, gvl); + vfloat32m2_t tmp0i = __riscv_vfmul_vf_f32m2(A0r, B0i, gvl); + tmp0r = VFMACC_RR(tmp0r, B0r, A0r, gvl); + tmp0i = VFMACC_RI(tmp0i, B0r, A0i, gvl); + vfloat32m2_t ACC0r = tmp0r; + vfloat32m2_t ACC0i = tmp0i; + + for (BLASLONG k = 1; k < pass_K; k++) { + B0r = B[bi + 0 * 2 + 0]; + B0i = B[bi + 0 * 2 + 1]; + bi += 1 * 2; + + A0r = __riscv_vlse32_v_f32m2(&A[ai + 0 * gvl * 2], sizeof(FLOAT) * 2, gvl); + A0i = __riscv_vlse32_v_f32m2(&A[ai + 0 * gvl * 2 + 1], sizeof(FLOAT) * 2, gvl); + ai += 8 * 2; + + tmp0r = __riscv_vfmul_vf_f32m2(A0i, B0i, gvl); + tmp0i = __riscv_vfmul_vf_f32m2(A0r, B0i, gvl); + tmp0r = VFMACC_RR(tmp0r, B0r, A0r, gvl); + tmp0i = VFMACC_RI(tmp0i, B0r, A0i, gvl); + ACC0r = __riscv_vfadd(ACC0r, tmp0r, gvl); + ACC0i = __riscv_vfadd(ACC0i, tmp0i, gvl); + } + + BLASLONG ci = n_top * ldc + m_top; + + vfloat32m2_t C0r = __riscv_vfmul(ACC0r, alphar, gvl); + vfloat32m2_t C0i = __riscv_vfmul(ACC0i, alphar, gvl); + C0r = __riscv_vfnmsac(C0r, alphai, ACC0i, gvl); + C0i = __riscv_vfmacc(C0i, alphai, ACC0r, gvl); + __riscv_vsse32_v_f32m2(&C[ci * 2 + 0], sizeof(FLOAT) * 2, C0r, gvl); + __riscv_vsse32_v_f32m2(&C[ci * 2 + 1], sizeof(FLOAT) * 2, C0i, gvl); + + m_top += 8; + } + + if (M & 4) { + gvl = __riscv_vsetvl_e32m2(4); + + BLASLONG ai = m_top * K * 2; + BLASLONG bi = n_top * K * 2; + BLASLONG pass_K = K; +#ifdef LEFT + BLASLONG off = offset + m_top; +#else + BLASLONG off = -offset + n_top; +#endif +#ifdef BACKWARDS + ai += off * 4 * 2; + bi += off * 1 * 2; + pass_K -= off; +#else +#ifdef LEFT + pass_K = off + 4; +#else + pass_K = off + 1; +#endif +#endif + float B0r = B[bi + 0 * 2 + 0]; + float B0i = B[bi + 0 * 2 + 1]; + bi += 1 * 2; + + vfloat32m2_t A0r = __riscv_vlse32_v_f32m2(&A[ai + 0 * gvl * 2], sizeof(FLOAT) * 2, gvl); + vfloat32m2_t A0i = __riscv_vlse32_v_f32m2(&A[ai + 0 * gvl * 2 + 1], sizeof(FLOAT) * 2, gvl); + ai += 4 * 2; + + // 2 vector regs to hold A array contents, 2 regs to hold values accumulated over k + // leaving 12 vector registers for temporaries + vfloat32m2_t tmp0r = __riscv_vfmul_vf_f32m2(A0i, B0i, gvl); + vfloat32m2_t tmp0i = __riscv_vfmul_vf_f32m2(A0r, B0i, gvl); + tmp0r = VFMACC_RR(tmp0r, B0r, A0r, gvl); + tmp0i = VFMACC_RI(tmp0i, B0r, A0i, gvl); + vfloat32m2_t ACC0r = tmp0r; + vfloat32m2_t ACC0i = tmp0i; + + for (BLASLONG k = 1; k < pass_K; k++) { + B0r = B[bi + 0 * 2 + 0]; + B0i = B[bi + 0 * 2 + 1]; + bi += 1 * 2; + + A0r = __riscv_vlse32_v_f32m2(&A[ai + 0 * gvl * 2], sizeof(FLOAT) * 2, gvl); + A0i = __riscv_vlse32_v_f32m2(&A[ai + 0 * gvl * 2 + 1], sizeof(FLOAT) * 2, gvl); + ai += 4 * 2; + + tmp0r = __riscv_vfmul_vf_f32m2(A0i, B0i, gvl); + tmp0i = __riscv_vfmul_vf_f32m2(A0r, B0i, gvl); + tmp0r = VFMACC_RR(tmp0r, B0r, A0r, gvl); + tmp0i = VFMACC_RI(tmp0i, B0r, A0i, gvl); + ACC0r = __riscv_vfadd(ACC0r, tmp0r, gvl); + ACC0i = __riscv_vfadd(ACC0i, tmp0i, gvl); + } + + BLASLONG ci = n_top * ldc + m_top; + + vfloat32m2_t C0r = __riscv_vfmul(ACC0r, alphar, gvl); + vfloat32m2_t C0i = __riscv_vfmul(ACC0i, alphar, gvl); + C0r = __riscv_vfnmsac(C0r, alphai, ACC0i, gvl); + C0i = __riscv_vfmacc(C0i, alphai, ACC0r, gvl); + __riscv_vsse32_v_f32m2(&C[ci * 2 + 0], sizeof(FLOAT) * 2, C0r, gvl); + __riscv_vsse32_v_f32m2(&C[ci * 2 + 1], sizeof(FLOAT) * 2, C0i, gvl); + + m_top += 4; + } + + if (M & 2) { + float result0 = 0; + float result1 = 0; + float result2 = 0; + float result3 = 0; + BLASLONG ai = m_top * K * 2; + BLASLONG bi = n_top * K * 2; + BLASLONG pass_K = K; +#ifdef LEFT + BLASLONG off = offset + m_top; +#else + BLASLONG off = -offset + n_top; +#endif +#ifdef BACKWARDS + ai += off * 2 * 2; + bi += off * 1 * 2; + pass_K -= off; +#else +#ifdef LEFT + pass_K = off + 2; +#else + pass_K = off + 1; +#endif +#endif + + for (BLASLONG k = 0; k < pass_K; k++) { + result0 += S0 * A[ai + 0 + 0] * B[bi + 0 + 0] + S1 * A[ai + 0 + 1] * B[bi + 0 + 1]; + result1 += S2 * A[ai + 0 + 1] * B[bi + 0 + 0] + S3 * A[ai + 0 + 0] * B[bi + 0 + 1]; + result2 += S0 * A[ai + 2 + 0] * B[bi + 0 + 0] + S1 * A[ai + 2 + 1] * B[bi + 0 + 1]; + result3 += S2 * A[ai + 2 + 1] * B[bi + 0 + 0] + S3 * A[ai + 2 + 0] * B[bi + 0 + 1]; + ai += 2 * 2; + bi += 1 * 2; + } + + BLASLONG ci = n_top * ldc + m_top; + float Cr, Ci; + Cr = result0 * alphar; + Ci = result1 * alphar; + Cr -= result1 * alphai; + Ci += result0 * alphai; + C[(ci + 0 * ldc + 0) * 2 + 0] = Cr; + C[(ci + 0 * ldc + 0) * 2 + 1] = Ci; + Cr = result2 * alphar; + Ci = result3 * alphar; + Cr -= result3 * alphai; + Ci += result2 * alphai; + C[(ci + 0 * ldc + 1) * 2 + 0] = Cr; + C[(ci + 0 * ldc + 1) * 2 + 1] = Ci; + m_top += 2; + } + + if (M & 1) { + float result0 = 0; + float result1 = 0; + BLASLONG ai = m_top * K * 2; + BLASLONG bi = n_top * K * 2; + BLASLONG pass_K = K; +#ifdef LEFT + BLASLONG off = offset + m_top; +#else + BLASLONG off = -offset + n_top; +#endif +#ifdef BACKWARDS + ai += off * 1 * 2; + bi += off * 1 * 2; + pass_K -= off; +#else +#ifdef LEFT + pass_K = off + 1; +#else + pass_K = off + 1; +#endif +#endif + + for (BLASLONG k = 0; k < pass_K; k++) { + result0 += S0 * A[ai + 0 + 0] * B[bi + 0 + 0] + S1 * A[ai + 0 + 1] * B[bi + 0 + 1]; + result1 += S2 * A[ai + 0 + 1] * B[bi + 0 + 0] + S3 * A[ai + 0 + 0] * B[bi + 0 + 1]; + ai += 1 * 2; + bi += 1 * 2; + } + + BLASLONG ci = n_top * ldc + m_top; + float Cr, Ci; + Cr = result0 * alphar; + Ci = result1 * alphar; + Cr -= result1 * alphai; + Ci += result0 * alphai; + C[(ci + 0 * ldc + 0) * 2 + 0] = Cr; + C[(ci + 0 * ldc + 0) * 2 + 1] = Ci; + m_top += 1; + } + + n_top += 1; + } + + return 0; +} diff --git a/kernel/riscv64/dgemm_kernel_8x4_zvl128b.c b/kernel/riscv64/dgemm_kernel_8x4_zvl128b.c new file mode 100644 index 000000000..a613f0bce --- /dev/null +++ b/kernel/riscv64/dgemm_kernel_8x4_zvl128b.c @@ -0,0 +1,492 @@ +/* + +AUTOGENERATED KERNEL +Script: ./kernel/riscv64/generate_kernel.py +Settings: + LMUL=4 + M=8 + M_tail_scalar_from=2 + N=4 + __riscv_='__riscv_' + complex=False + conjugate=False + cpu='zvl128b' + force_acc_double=False + index_type='BLASLONG' + op='gemm' + param_precision='double' + reg_width_bits=128 + tail_policy='' + trace=False + +Derived: + ELEN_ACC=64 + ELEN_PARAM=64 + LMUL_ACC=4 + VFMACC='__riscv_vfmacc_vf_f64m4' + VFMUL='__riscv_vfmul_vf_f64m4' + VLEV='__riscv_vle64_v_f64m4' + VLSEV='__riscv_vlse64_v_f64m4' + VMACC_TO_ACC='__riscv_vfmacc_vf_f64m4' + VMUL_TO_ACC='__riscv_vfmul_vf_f64m4' + VSETVL='__riscv_vsetvl_e64m4' + VSEV='__riscv_vse64_v_f64m4' + VSSEV='__riscv_vsse64_v_f64m4' + acc_vector_t='vfloat64m4_t' + output='dgemm_kernel_8x4_zvl128b.c' + param_scalar_t='double' + param_vector_t='vfloat64m4_t' + +*/ + +#include "common.h" + +int CNAME(BLASLONG M, BLASLONG N, BLASLONG K, FLOAT alpha, FLOAT *A, FLOAT *B, FLOAT *C, BLASLONG ldc) + +{ + BLASLONG gvl = 0; + BLASLONG m_top = 0; + BLASLONG n_top = 0; + + // -- MAIN PASS + + for (BLASLONG j = 0; j < N / 4; j += 1) { + m_top = 0; + BLASLONG gvl = __riscv_vsetvl_e64m4(8); + + for (BLASLONG i = 0; i < M / 8; i += 1) { + BLASLONG ai = m_top * K; + BLASLONG bi = n_top * K; + double B0 = B[bi + 0]; + double B1 = B[bi + 1]; + double B2 = B[bi + 2]; + double B3 = B[bi + 3]; + bi += 4; + + vfloat64m4_t A0 = __riscv_vle64_v_f64m4(&A[ai + 0 * gvl], gvl); + ai += 8; + + vfloat64m4_t result0 = __riscv_vfmul_vf_f64m4(A0, B0, gvl); + vfloat64m4_t result1 = __riscv_vfmul_vf_f64m4(A0, B1, gvl); + vfloat64m4_t result2 = __riscv_vfmul_vf_f64m4(A0, B2, gvl); + vfloat64m4_t result3 = __riscv_vfmul_vf_f64m4(A0, B3, gvl); + + for (BLASLONG k = 1; k < K; k++) { + B0 = B[bi + 0]; + B1 = B[bi + 1]; + B2 = B[bi + 2]; + B3 = B[bi + 3]; + bi += 4; + + A0 = __riscv_vle64_v_f64m4(&A[ai + 0 * gvl], gvl); + ai += 8; + + result0 = __riscv_vfmacc_vf_f64m4(result0, B0, A0, gvl); + result1 = __riscv_vfmacc_vf_f64m4(result1, B1, A0, gvl); + result2 = __riscv_vfmacc_vf_f64m4(result2, B2, A0, gvl); + result3 = __riscv_vfmacc_vf_f64m4(result3, B3, A0, gvl); + } + + BLASLONG ci = n_top * ldc + m_top; + + vfloat64m4_t c0 = __riscv_vle64_v_f64m4(&C[ci], gvl); + ci += ldc - gvl * 0; + vfloat64m4_t c1 = __riscv_vle64_v_f64m4(&C[ci], gvl); + ci += ldc - gvl * 0; + vfloat64m4_t c2 = __riscv_vle64_v_f64m4(&C[ci], gvl); + ci += ldc - gvl * 0; + vfloat64m4_t c3 = __riscv_vle64_v_f64m4(&C[ci], gvl); + c0 = __riscv_vfmacc_vf_f64m4(c0, alpha, result0, gvl); + c1 = __riscv_vfmacc_vf_f64m4(c1, alpha, result1, gvl); + c2 = __riscv_vfmacc_vf_f64m4(c2, alpha, result2, gvl); + c3 = __riscv_vfmacc_vf_f64m4(c3, alpha, result3, gvl); + + ci = n_top * ldc + m_top; + + __riscv_vse64_v_f64m4(&C[ci], c0, gvl); + ci += ldc - gvl * 0; + __riscv_vse64_v_f64m4(&C[ci], c1, gvl); + ci += ldc - gvl * 0; + __riscv_vse64_v_f64m4(&C[ci], c2, gvl); + ci += ldc - gvl * 0; + __riscv_vse64_v_f64m4(&C[ci], c3, gvl); + m_top += 8; + } + + // -- tails for main pass + + if (M & 4) { + gvl = __riscv_vsetvl_e64m4(4); + + BLASLONG ai = m_top * K; + BLASLONG bi = n_top * K; + double B0 = B[bi + 0]; + double B1 = B[bi + 1]; + double B2 = B[bi + 2]; + double B3 = B[bi + 3]; + bi += 4; + + vfloat64m4_t A0 = __riscv_vle64_v_f64m4(&A[ai + 0 * gvl], gvl); + ai += 4; + + vfloat64m4_t result0 = __riscv_vfmul_vf_f64m4(A0, B0, gvl); + vfloat64m4_t result1 = __riscv_vfmul_vf_f64m4(A0, B1, gvl); + vfloat64m4_t result2 = __riscv_vfmul_vf_f64m4(A0, B2, gvl); + vfloat64m4_t result3 = __riscv_vfmul_vf_f64m4(A0, B3, gvl); + + for (BLASLONG k = 1; k < K; k++) { + B0 = B[bi + 0]; + B1 = B[bi + 1]; + B2 = B[bi + 2]; + B3 = B[bi + 3]; + bi += 4; + + A0 = __riscv_vle64_v_f64m4(&A[ai + 0 * gvl], gvl); + ai += 4; + + result0 = __riscv_vfmacc_vf_f64m4(result0, B0, A0, gvl); + result1 = __riscv_vfmacc_vf_f64m4(result1, B1, A0, gvl); + result2 = __riscv_vfmacc_vf_f64m4(result2, B2, A0, gvl); + result3 = __riscv_vfmacc_vf_f64m4(result3, B3, A0, gvl); + } + + BLASLONG ci = n_top * ldc + m_top; + + vfloat64m4_t c0 = __riscv_vle64_v_f64m4(&C[ci], gvl); + ci += ldc - gvl * 0; + vfloat64m4_t c1 = __riscv_vle64_v_f64m4(&C[ci], gvl); + ci += ldc - gvl * 0; + vfloat64m4_t c2 = __riscv_vle64_v_f64m4(&C[ci], gvl); + ci += ldc - gvl * 0; + vfloat64m4_t c3 = __riscv_vle64_v_f64m4(&C[ci], gvl); + c0 = __riscv_vfmacc_vf_f64m4(c0, alpha, result0, gvl); + c1 = __riscv_vfmacc_vf_f64m4(c1, alpha, result1, gvl); + c2 = __riscv_vfmacc_vf_f64m4(c2, alpha, result2, gvl); + c3 = __riscv_vfmacc_vf_f64m4(c3, alpha, result3, gvl); + + ci = n_top * ldc + m_top; + + __riscv_vse64_v_f64m4(&C[ci], c0, gvl); + ci += ldc - gvl * 0; + __riscv_vse64_v_f64m4(&C[ci], c1, gvl); + ci += ldc - gvl * 0; + __riscv_vse64_v_f64m4(&C[ci], c2, gvl); + ci += ldc - gvl * 0; + __riscv_vse64_v_f64m4(&C[ci], c3, gvl); + m_top += 4; + } + + if (M & 2) { + double result0 = 0; + double result1 = 0; + double result2 = 0; + double result3 = 0; + double result4 = 0; + double result5 = 0; + double result6 = 0; + double result7 = 0; + BLASLONG ai = m_top * K; + BLASLONG bi = n_top * K; + + for (BLASLONG k = 0; k < K; k++) { + result0 += A[ai + 0] * B[bi + 0]; + result1 += A[ai + 1] * B[bi + 0]; + result2 += A[ai + 0] * B[bi + 1]; + result3 += A[ai + 1] * B[bi + 1]; + result4 += A[ai + 0] * B[bi + 2]; + result5 += A[ai + 1] * B[bi + 2]; + result6 += A[ai + 0] * B[bi + 3]; + result7 += A[ai + 1] * B[bi + 3]; + ai += 2; + bi += 4; + } + + BLASLONG ci = n_top * ldc + m_top; + C[ci + 0 * ldc + 0] += alpha * result0; + C[ci + 0 * ldc + 1] += alpha * result1; + C[ci + 1 * ldc + 0] += alpha * result2; + C[ci + 1 * ldc + 1] += alpha * result3; + C[ci + 2 * ldc + 0] += alpha * result4; + C[ci + 2 * ldc + 1] += alpha * result5; + C[ci + 3 * ldc + 0] += alpha * result6; + C[ci + 3 * ldc + 1] += alpha * result7; + m_top += 2; + } + + if (M & 1) { + double result0 = 0; + double result1 = 0; + double result2 = 0; + double result3 = 0; + BLASLONG ai = m_top * K; + BLASLONG bi = n_top * K; + + for (BLASLONG k = 0; k < K; k++) { + result0 += A[ai + 0] * B[bi + 0]; + result1 += A[ai + 0] * B[bi + 1]; + result2 += A[ai + 0] * B[bi + 2]; + result3 += A[ai + 0] * B[bi + 3]; + ai += 1; + bi += 4; + } + + BLASLONG ci = n_top * ldc + m_top; + C[ci + 0 * ldc + 0] += alpha * result0; + C[ci + 1 * ldc + 0] += alpha * result1; + C[ci + 2 * ldc + 0] += alpha * result2; + C[ci + 3 * ldc + 0] += alpha * result3; + m_top += 1; + } + + n_top += 4; + } + + // -- tails for N=2 + + if (N & 2) { + gvl = __riscv_vsetvl_e64m4(8); + m_top = 0; + + for (BLASLONG i = 0; i < M / 8; i += 1) { + BLASLONG ai = m_top * K; + BLASLONG bi = n_top * K; + double B0 = B[bi + 0]; + double B1 = B[bi + 1]; + bi += 2; + + vfloat64m4_t A0 = __riscv_vle64_v_f64m4(&A[ai + 0 * gvl], gvl); + ai += 8; + + vfloat64m4_t result0 = __riscv_vfmul_vf_f64m4(A0, B0, gvl); + vfloat64m4_t result1 = __riscv_vfmul_vf_f64m4(A0, B1, gvl); + + for (BLASLONG k = 1; k < K; k++) { + B0 = B[bi + 0]; + B1 = B[bi + 1]; + bi += 2; + + A0 = __riscv_vle64_v_f64m4(&A[ai + 0 * gvl], gvl); + ai += 8; + + result0 = __riscv_vfmacc_vf_f64m4(result0, B0, A0, gvl); + result1 = __riscv_vfmacc_vf_f64m4(result1, B1, A0, gvl); + } + + BLASLONG ci = n_top * ldc + m_top; + + vfloat64m4_t c0 = __riscv_vle64_v_f64m4(&C[ci], gvl); + ci += ldc - gvl * 0; + vfloat64m4_t c1 = __riscv_vle64_v_f64m4(&C[ci], gvl); + c0 = __riscv_vfmacc_vf_f64m4(c0, alpha, result0, gvl); + c1 = __riscv_vfmacc_vf_f64m4(c1, alpha, result1, gvl); + + ci = n_top * ldc + m_top; + + __riscv_vse64_v_f64m4(&C[ci], c0, gvl); + ci += ldc - gvl * 0; + __riscv_vse64_v_f64m4(&C[ci], c1, gvl); + m_top += 8; + } + + if (M & 4) { + gvl = __riscv_vsetvl_e64m4(4); + + BLASLONG ai = m_top * K; + BLASLONG bi = n_top * K; + double B0 = B[bi + 0]; + double B1 = B[bi + 1]; + bi += 2; + + vfloat64m4_t A0 = __riscv_vle64_v_f64m4(&A[ai + 0 * gvl], gvl); + ai += 4; + + vfloat64m4_t result0 = __riscv_vfmul_vf_f64m4(A0, B0, gvl); + vfloat64m4_t result1 = __riscv_vfmul_vf_f64m4(A0, B1, gvl); + + for (BLASLONG k = 1; k < K; k++) { + B0 = B[bi + 0]; + B1 = B[bi + 1]; + bi += 2; + + A0 = __riscv_vle64_v_f64m4(&A[ai + 0 * gvl], gvl); + ai += 4; + + result0 = __riscv_vfmacc_vf_f64m4(result0, B0, A0, gvl); + result1 = __riscv_vfmacc_vf_f64m4(result1, B1, A0, gvl); + } + + BLASLONG ci = n_top * ldc + m_top; + + vfloat64m4_t c0 = __riscv_vle64_v_f64m4(&C[ci], gvl); + ci += ldc - gvl * 0; + vfloat64m4_t c1 = __riscv_vle64_v_f64m4(&C[ci], gvl); + c0 = __riscv_vfmacc_vf_f64m4(c0, alpha, result0, gvl); + c1 = __riscv_vfmacc_vf_f64m4(c1, alpha, result1, gvl); + + ci = n_top * ldc + m_top; + + __riscv_vse64_v_f64m4(&C[ci], c0, gvl); + ci += ldc - gvl * 0; + __riscv_vse64_v_f64m4(&C[ci], c1, gvl); + m_top += 4; + } + + if (M & 2) { + double result0 = 0; + double result1 = 0; + double result2 = 0; + double result3 = 0; + BLASLONG ai = m_top * K; + BLASLONG bi = n_top * K; + + for (BLASLONG k = 0; k < K; k++) { + result0 += A[ai + 0] * B[bi + 0]; + result1 += A[ai + 1] * B[bi + 0]; + result2 += A[ai + 0] * B[bi + 1]; + result3 += A[ai + 1] * B[bi + 1]; + ai += 2; + bi += 2; + } + + BLASLONG ci = n_top * ldc + m_top; + C[ci + 0 * ldc + 0] += alpha * result0; + C[ci + 0 * ldc + 1] += alpha * result1; + C[ci + 1 * ldc + 0] += alpha * result2; + C[ci + 1 * ldc + 1] += alpha * result3; + m_top += 2; + } + + if (M & 1) { + double result0 = 0; + double result1 = 0; + BLASLONG ai = m_top * K; + BLASLONG bi = n_top * K; + + for (BLASLONG k = 0; k < K; k++) { + result0 += A[ai + 0] * B[bi + 0]; + result1 += A[ai + 0] * B[bi + 1]; + ai += 1; + bi += 2; + } + + BLASLONG ci = n_top * ldc + m_top; + C[ci + 0 * ldc + 0] += alpha * result0; + C[ci + 1 * ldc + 0] += alpha * result1; + m_top += 1; + } + + n_top += 2; + } + + // -- tails for N=1 + + if (N & 1) { + gvl = __riscv_vsetvl_e64m4(8); + m_top = 0; + + for (BLASLONG i = 0; i < M / 8; i += 1) { + BLASLONG ai = m_top * K; + BLASLONG bi = n_top * K; + double B0 = B[bi + 0]; + bi += 1; + + vfloat64m4_t A0 = __riscv_vle64_v_f64m4(&A[ai + 0 * gvl], gvl); + ai += 8; + + vfloat64m4_t result0 = __riscv_vfmul_vf_f64m4(A0, B0, gvl); + + for (BLASLONG k = 1; k < K; k++) { + B0 = B[bi + 0]; + bi += 1; + + A0 = __riscv_vle64_v_f64m4(&A[ai + 0 * gvl], gvl); + ai += 8; + + result0 = __riscv_vfmacc_vf_f64m4(result0, B0, A0, gvl); + } + + BLASLONG ci = n_top * ldc + m_top; + + vfloat64m4_t c0 = __riscv_vle64_v_f64m4(&C[ci], gvl); + c0 = __riscv_vfmacc_vf_f64m4(c0, alpha, result0, gvl); + + ci = n_top * ldc + m_top; + + __riscv_vse64_v_f64m4(&C[ci], c0, gvl); + m_top += 8; + } + + if (M & 4) { + gvl = __riscv_vsetvl_e64m4(4); + + BLASLONG ai = m_top * K; + BLASLONG bi = n_top * K; + double B0 = B[bi + 0]; + bi += 1; + + vfloat64m4_t A0 = __riscv_vle64_v_f64m4(&A[ai + 0 * gvl], gvl); + ai += 4; + + vfloat64m4_t result0 = __riscv_vfmul_vf_f64m4(A0, B0, gvl); + + for (BLASLONG k = 1; k < K; k++) { + B0 = B[bi + 0]; + bi += 1; + + A0 = __riscv_vle64_v_f64m4(&A[ai + 0 * gvl], gvl); + ai += 4; + + result0 = __riscv_vfmacc_vf_f64m4(result0, B0, A0, gvl); + } + + BLASLONG ci = n_top * ldc + m_top; + + vfloat64m4_t c0 = __riscv_vle64_v_f64m4(&C[ci], gvl); + c0 = __riscv_vfmacc_vf_f64m4(c0, alpha, result0, gvl); + + ci = n_top * ldc + m_top; + + __riscv_vse64_v_f64m4(&C[ci], c0, gvl); + m_top += 4; + } + + if (M & 2) { + double result0 = 0; + double result1 = 0; + BLASLONG ai = m_top * K; + BLASLONG bi = n_top * K; + + for (BLASLONG k = 0; k < K; k++) { + result0 += A[ai + 0] * B[bi + 0]; + result1 += A[ai + 1] * B[bi + 0]; + ai += 2; + bi += 1; + } + + BLASLONG ci = n_top * ldc + m_top; + C[ci + 0 * ldc + 0] += alpha * result0; + C[ci + 0 * ldc + 1] += alpha * result1; + m_top += 2; + } + + if (M & 1) { + double result0 = 0; + BLASLONG ai = m_top * K; + BLASLONG bi = n_top * K; + + for (BLASLONG k = 0; k < K; k++) { + result0 += A[ai + 0] * B[bi + 0]; + ai += 1; + bi += 1; + } + + BLASLONG ci = n_top * ldc + m_top; + C[ci + 0 * ldc + 0] += alpha * result0; + m_top += 1; + } + + n_top += 1; + } + + return 0; +} diff --git a/kernel/riscv64/dtrmm_kernel_8x4_zvl128b.c b/kernel/riscv64/dtrmm_kernel_8x4_zvl128b.c new file mode 100644 index 000000000..c1e0da86e --- /dev/null +++ b/kernel/riscv64/dtrmm_kernel_8x4_zvl128b.c @@ -0,0 +1,660 @@ +/* + +AUTOGENERATED KERNEL +Script: ./kernel/riscv64/generate_kernel.py +Settings: + LMUL=4 + M=8 + M_tail_scalar_from=2 + N=4 + __riscv_='__riscv_' + complex=False + conjugate=False + cpu='zvl128b' + force_acc_double=False + index_type='BLASLONG' + op='trmm' + param_precision='double' + reg_width_bits=128 + tail_policy='' + trace=False + +Derived: + ELEN_ACC=64 + ELEN_PARAM=64 + LMUL_ACC=4 + VFMACC='__riscv_vfmacc_vf_f64m4' + VFMUL='__riscv_vfmul_vf_f64m4' + VLEV='__riscv_vle64_v_f64m4' + VLSEV='__riscv_vlse64_v_f64m4' + VMACC_TO_ACC='__riscv_vfmacc_vf_f64m4' + VMUL_TO_ACC='__riscv_vfmul_vf_f64m4' + VSETVL='__riscv_vsetvl_e64m4' + VSEV='__riscv_vse64_v_f64m4' + VSSEV='__riscv_vsse64_v_f64m4' + acc_vector_t='vfloat64m4_t' + output='dtrmm_kernel_8x4_zvl128b.c' + param_scalar_t='double' + param_vector_t='vfloat64m4_t' + +*/ + +#include "common.h" + +#if defined(LEFT) != defined(TRANSA) +#define BACKWARDS +#endif + +int CNAME(BLASLONG M, BLASLONG N, BLASLONG K, FLOAT alpha, FLOAT *A, FLOAT *B, FLOAT *C, BLASLONG ldc, BLASLONG offset) + +{ + BLASLONG gvl = 0; + BLASLONG m_top = 0; + BLASLONG n_top = 0; + + // -- MAIN PASS + + for (BLASLONG j = 0; j < N / 4; j += 1) { + m_top = 0; + BLASLONG gvl = __riscv_vsetvl_e64m4(8); + + for (BLASLONG i = 0; i < M / 8; i += 1) { + BLASLONG ai = m_top * K; + BLASLONG bi = n_top * K; + BLASLONG pass_K = K; +#ifdef LEFT + BLASLONG off = offset + m_top; +#else + BLASLONG off = -offset + n_top; +#endif +#ifdef BACKWARDS + ai += off * 8; + bi += off * 4; + pass_K -= off; +#else +#ifdef LEFT + pass_K = off + 8; +#else + pass_K = off + 4; +#endif +#endif + double B0 = B[bi + 0]; + double B1 = B[bi + 1]; + double B2 = B[bi + 2]; + double B3 = B[bi + 3]; + bi += 4; + + vfloat64m4_t A0 = __riscv_vle64_v_f64m4(&A[ai + 0 * gvl], gvl); + ai += 8; + + vfloat64m4_t result0 = __riscv_vfmul_vf_f64m4(A0, B0, gvl); + vfloat64m4_t result1 = __riscv_vfmul_vf_f64m4(A0, B1, gvl); + vfloat64m4_t result2 = __riscv_vfmul_vf_f64m4(A0, B2, gvl); + vfloat64m4_t result3 = __riscv_vfmul_vf_f64m4(A0, B3, gvl); + + for (BLASLONG k = 1; k < pass_K; k++) { + B0 = B[bi + 0]; + B1 = B[bi + 1]; + B2 = B[bi + 2]; + B3 = B[bi + 3]; + bi += 4; + + A0 = __riscv_vle64_v_f64m4(&A[ai + 0 * gvl], gvl); + ai += 8; + + result0 = __riscv_vfmacc_vf_f64m4(result0, B0, A0, gvl); + result1 = __riscv_vfmacc_vf_f64m4(result1, B1, A0, gvl); + result2 = __riscv_vfmacc_vf_f64m4(result2, B2, A0, gvl); + result3 = __riscv_vfmacc_vf_f64m4(result3, B3, A0, gvl); + } + + BLASLONG ci = n_top * ldc + m_top; + + vfloat64m4_t c0 = __riscv_vfmul_vf_f64m4(result0, alpha, gvl); + vfloat64m4_t c1 = __riscv_vfmul_vf_f64m4(result1, alpha, gvl); + vfloat64m4_t c2 = __riscv_vfmul_vf_f64m4(result2, alpha, gvl); + vfloat64m4_t c3 = __riscv_vfmul_vf_f64m4(result3, alpha, gvl); + __riscv_vse64_v_f64m4(&C[ci], c0, gvl); + ci += ldc - gvl * 0; + __riscv_vse64_v_f64m4(&C[ci], c1, gvl); + ci += ldc - gvl * 0; + __riscv_vse64_v_f64m4(&C[ci], c2, gvl); + ci += ldc - gvl * 0; + __riscv_vse64_v_f64m4(&C[ci], c3, gvl); + m_top += 8; + } + + // -- tails for main pass + + if (M & 4) { + gvl = __riscv_vsetvl_e64m4(4); + + BLASLONG ai = m_top * K; + BLASLONG bi = n_top * K; + BLASLONG pass_K = K; +#ifdef LEFT + BLASLONG off = offset + m_top; +#else + BLASLONG off = -offset + n_top; +#endif +#ifdef BACKWARDS + ai += off * 4; + bi += off * 4; + pass_K -= off; +#else +#ifdef LEFT + pass_K = off + 4; +#else + pass_K = off + 4; +#endif +#endif + double B0 = B[bi + 0]; + double B1 = B[bi + 1]; + double B2 = B[bi + 2]; + double B3 = B[bi + 3]; + bi += 4; + + vfloat64m4_t A0 = __riscv_vle64_v_f64m4(&A[ai + 0 * gvl], gvl); + ai += 4; + + vfloat64m4_t result0 = __riscv_vfmul_vf_f64m4(A0, B0, gvl); + vfloat64m4_t result1 = __riscv_vfmul_vf_f64m4(A0, B1, gvl); + vfloat64m4_t result2 = __riscv_vfmul_vf_f64m4(A0, B2, gvl); + vfloat64m4_t result3 = __riscv_vfmul_vf_f64m4(A0, B3, gvl); + + for (BLASLONG k = 1; k < pass_K; k++) { + B0 = B[bi + 0]; + B1 = B[bi + 1]; + B2 = B[bi + 2]; + B3 = B[bi + 3]; + bi += 4; + + A0 = __riscv_vle64_v_f64m4(&A[ai + 0 * gvl], gvl); + ai += 4; + + result0 = __riscv_vfmacc_vf_f64m4(result0, B0, A0, gvl); + result1 = __riscv_vfmacc_vf_f64m4(result1, B1, A0, gvl); + result2 = __riscv_vfmacc_vf_f64m4(result2, B2, A0, gvl); + result3 = __riscv_vfmacc_vf_f64m4(result3, B3, A0, gvl); + } + + BLASLONG ci = n_top * ldc + m_top; + + vfloat64m4_t c0 = __riscv_vfmul_vf_f64m4(result0, alpha, gvl); + vfloat64m4_t c1 = __riscv_vfmul_vf_f64m4(result1, alpha, gvl); + vfloat64m4_t c2 = __riscv_vfmul_vf_f64m4(result2, alpha, gvl); + vfloat64m4_t c3 = __riscv_vfmul_vf_f64m4(result3, alpha, gvl); + __riscv_vse64_v_f64m4(&C[ci], c0, gvl); + ci += ldc - gvl * 0; + __riscv_vse64_v_f64m4(&C[ci], c1, gvl); + ci += ldc - gvl * 0; + __riscv_vse64_v_f64m4(&C[ci], c2, gvl); + ci += ldc - gvl * 0; + __riscv_vse64_v_f64m4(&C[ci], c3, gvl); + m_top += 4; + } + + if (M & 2) { + double result0 = 0; + double result1 = 0; + double result2 = 0; + double result3 = 0; + double result4 = 0; + double result5 = 0; + double result6 = 0; + double result7 = 0; + BLASLONG ai = m_top * K; + BLASLONG bi = n_top * K; + BLASLONG pass_K = K; +#ifdef LEFT + BLASLONG off = offset + m_top; +#else + BLASLONG off = -offset + n_top; +#endif +#ifdef BACKWARDS + ai += off * 2; + bi += off * 4; + pass_K -= off; +#else +#ifdef LEFT + pass_K = off + 2; +#else + pass_K = off + 4; +#endif +#endif + + for (BLASLONG k = 0; k < pass_K; k++) { + result0 += A[ai + 0] * B[bi + 0]; + result1 += A[ai + 1] * B[bi + 0]; + result2 += A[ai + 0] * B[bi + 1]; + result3 += A[ai + 1] * B[bi + 1]; + result4 += A[ai + 0] * B[bi + 2]; + result5 += A[ai + 1] * B[bi + 2]; + result6 += A[ai + 0] * B[bi + 3]; + result7 += A[ai + 1] * B[bi + 3]; + ai += 2; + bi += 4; + } + + BLASLONG ci = n_top * ldc + m_top; + C[ci + 0 * ldc + 0] = alpha * result0; + C[ci + 0 * ldc + 1] = alpha * result1; + C[ci + 1 * ldc + 0] = alpha * result2; + C[ci + 1 * ldc + 1] = alpha * result3; + C[ci + 2 * ldc + 0] = alpha * result4; + C[ci + 2 * ldc + 1] = alpha * result5; + C[ci + 3 * ldc + 0] = alpha * result6; + C[ci + 3 * ldc + 1] = alpha * result7; + m_top += 2; + } + + if (M & 1) { + double result0 = 0; + double result1 = 0; + double result2 = 0; + double result3 = 0; + BLASLONG ai = m_top * K; + BLASLONG bi = n_top * K; + BLASLONG pass_K = K; +#ifdef LEFT + BLASLONG off = offset + m_top; +#else + BLASLONG off = -offset + n_top; +#endif +#ifdef BACKWARDS + ai += off * 1; + bi += off * 4; + pass_K -= off; +#else +#ifdef LEFT + pass_K = off + 1; +#else + pass_K = off + 4; +#endif +#endif + + for (BLASLONG k = 0; k < pass_K; k++) { + result0 += A[ai + 0] * B[bi + 0]; + result1 += A[ai + 0] * B[bi + 1]; + result2 += A[ai + 0] * B[bi + 2]; + result3 += A[ai + 0] * B[bi + 3]; + ai += 1; + bi += 4; + } + + BLASLONG ci = n_top * ldc + m_top; + C[ci + 0 * ldc + 0] = alpha * result0; + C[ci + 1 * ldc + 0] = alpha * result1; + C[ci + 2 * ldc + 0] = alpha * result2; + C[ci + 3 * ldc + 0] = alpha * result3; + m_top += 1; + } + + n_top += 4; + } + + // -- tails for N=2 + + if (N & 2) { + gvl = __riscv_vsetvl_e64m4(8); + m_top = 0; + + for (BLASLONG i = 0; i < M / 8; i += 1) { + BLASLONG ai = m_top * K; + BLASLONG bi = n_top * K; + BLASLONG pass_K = K; +#ifdef LEFT + BLASLONG off = offset + m_top; +#else + BLASLONG off = -offset + n_top; +#endif +#ifdef BACKWARDS + ai += off * 8; + bi += off * 2; + pass_K -= off; +#else +#ifdef LEFT + pass_K = off + 8; +#else + pass_K = off + 2; +#endif +#endif + double B0 = B[bi + 0]; + double B1 = B[bi + 1]; + bi += 2; + + vfloat64m4_t A0 = __riscv_vle64_v_f64m4(&A[ai + 0 * gvl], gvl); + ai += 8; + + vfloat64m4_t result0 = __riscv_vfmul_vf_f64m4(A0, B0, gvl); + vfloat64m4_t result1 = __riscv_vfmul_vf_f64m4(A0, B1, gvl); + + for (BLASLONG k = 1; k < pass_K; k++) { + B0 = B[bi + 0]; + B1 = B[bi + 1]; + bi += 2; + + A0 = __riscv_vle64_v_f64m4(&A[ai + 0 * gvl], gvl); + ai += 8; + + result0 = __riscv_vfmacc_vf_f64m4(result0, B0, A0, gvl); + result1 = __riscv_vfmacc_vf_f64m4(result1, B1, A0, gvl); + } + + BLASLONG ci = n_top * ldc + m_top; + + vfloat64m4_t c0 = __riscv_vfmul_vf_f64m4(result0, alpha, gvl); + vfloat64m4_t c1 = __riscv_vfmul_vf_f64m4(result1, alpha, gvl); + __riscv_vse64_v_f64m4(&C[ci], c0, gvl); + ci += ldc - gvl * 0; + __riscv_vse64_v_f64m4(&C[ci], c1, gvl); + m_top += 8; + } + + if (M & 4) { + gvl = __riscv_vsetvl_e64m4(4); + + BLASLONG ai = m_top * K; + BLASLONG bi = n_top * K; + BLASLONG pass_K = K; +#ifdef LEFT + BLASLONG off = offset + m_top; +#else + BLASLONG off = -offset + n_top; +#endif +#ifdef BACKWARDS + ai += off * 4; + bi += off * 2; + pass_K -= off; +#else +#ifdef LEFT + pass_K = off + 4; +#else + pass_K = off + 2; +#endif +#endif + double B0 = B[bi + 0]; + double B1 = B[bi + 1]; + bi += 2; + + vfloat64m4_t A0 = __riscv_vle64_v_f64m4(&A[ai + 0 * gvl], gvl); + ai += 4; + + vfloat64m4_t result0 = __riscv_vfmul_vf_f64m4(A0, B0, gvl); + vfloat64m4_t result1 = __riscv_vfmul_vf_f64m4(A0, B1, gvl); + + for (BLASLONG k = 1; k < pass_K; k++) { + B0 = B[bi + 0]; + B1 = B[bi + 1]; + bi += 2; + + A0 = __riscv_vle64_v_f64m4(&A[ai + 0 * gvl], gvl); + ai += 4; + + result0 = __riscv_vfmacc_vf_f64m4(result0, B0, A0, gvl); + result1 = __riscv_vfmacc_vf_f64m4(result1, B1, A0, gvl); + } + + BLASLONG ci = n_top * ldc + m_top; + + vfloat64m4_t c0 = __riscv_vfmul_vf_f64m4(result0, alpha, gvl); + vfloat64m4_t c1 = __riscv_vfmul_vf_f64m4(result1, alpha, gvl); + __riscv_vse64_v_f64m4(&C[ci], c0, gvl); + ci += ldc - gvl * 0; + __riscv_vse64_v_f64m4(&C[ci], c1, gvl); + m_top += 4; + } + + if (M & 2) { + double result0 = 0; + double result1 = 0; + double result2 = 0; + double result3 = 0; + BLASLONG ai = m_top * K; + BLASLONG bi = n_top * K; + BLASLONG pass_K = K; +#ifdef LEFT + BLASLONG off = offset + m_top; +#else + BLASLONG off = -offset + n_top; +#endif +#ifdef BACKWARDS + ai += off * 2; + bi += off * 2; + pass_K -= off; +#else +#ifdef LEFT + pass_K = off + 2; +#else + pass_K = off + 2; +#endif +#endif + + for (BLASLONG k = 0; k < pass_K; k++) { + result0 += A[ai + 0] * B[bi + 0]; + result1 += A[ai + 1] * B[bi + 0]; + result2 += A[ai + 0] * B[bi + 1]; + result3 += A[ai + 1] * B[bi + 1]; + ai += 2; + bi += 2; + } + + BLASLONG ci = n_top * ldc + m_top; + C[ci + 0 * ldc + 0] = alpha * result0; + C[ci + 0 * ldc + 1] = alpha * result1; + C[ci + 1 * ldc + 0] = alpha * result2; + C[ci + 1 * ldc + 1] = alpha * result3; + m_top += 2; + } + + if (M & 1) { + double result0 = 0; + double result1 = 0; + BLASLONG ai = m_top * K; + BLASLONG bi = n_top * K; + BLASLONG pass_K = K; +#ifdef LEFT + BLASLONG off = offset + m_top; +#else + BLASLONG off = -offset + n_top; +#endif +#ifdef BACKWARDS + ai += off * 1; + bi += off * 2; + pass_K -= off; +#else +#ifdef LEFT + pass_K = off + 1; +#else + pass_K = off + 2; +#endif +#endif + + for (BLASLONG k = 0; k < pass_K; k++) { + result0 += A[ai + 0] * B[bi + 0]; + result1 += A[ai + 0] * B[bi + 1]; + ai += 1; + bi += 2; + } + + BLASLONG ci = n_top * ldc + m_top; + C[ci + 0 * ldc + 0] = alpha * result0; + C[ci + 1 * ldc + 0] = alpha * result1; + m_top += 1; + } + + n_top += 2; + } + + // -- tails for N=1 + + if (N & 1) { + gvl = __riscv_vsetvl_e64m4(8); + m_top = 0; + + for (BLASLONG i = 0; i < M / 8; i += 1) { + BLASLONG ai = m_top * K; + BLASLONG bi = n_top * K; + BLASLONG pass_K = K; +#ifdef LEFT + BLASLONG off = offset + m_top; +#else + BLASLONG off = -offset + n_top; +#endif +#ifdef BACKWARDS + ai += off * 8; + bi += off * 1; + pass_K -= off; +#else +#ifdef LEFT + pass_K = off + 8; +#else + pass_K = off + 1; +#endif +#endif + double B0 = B[bi + 0]; + bi += 1; + + vfloat64m4_t A0 = __riscv_vle64_v_f64m4(&A[ai + 0 * gvl], gvl); + ai += 8; + + vfloat64m4_t result0 = __riscv_vfmul_vf_f64m4(A0, B0, gvl); + + for (BLASLONG k = 1; k < pass_K; k++) { + B0 = B[bi + 0]; + bi += 1; + + A0 = __riscv_vle64_v_f64m4(&A[ai + 0 * gvl], gvl); + ai += 8; + + result0 = __riscv_vfmacc_vf_f64m4(result0, B0, A0, gvl); + } + + BLASLONG ci = n_top * ldc + m_top; + + vfloat64m4_t c0 = __riscv_vfmul_vf_f64m4(result0, alpha, gvl); + __riscv_vse64_v_f64m4(&C[ci], c0, gvl); + m_top += 8; + } + + if (M & 4) { + gvl = __riscv_vsetvl_e64m4(4); + + BLASLONG ai = m_top * K; + BLASLONG bi = n_top * K; + BLASLONG pass_K = K; +#ifdef LEFT + BLASLONG off = offset + m_top; +#else + BLASLONG off = -offset + n_top; +#endif +#ifdef BACKWARDS + ai += off * 4; + bi += off * 1; + pass_K -= off; +#else +#ifdef LEFT + pass_K = off + 4; +#else + pass_K = off + 1; +#endif +#endif + double B0 = B[bi + 0]; + bi += 1; + + vfloat64m4_t A0 = __riscv_vle64_v_f64m4(&A[ai + 0 * gvl], gvl); + ai += 4; + + vfloat64m4_t result0 = __riscv_vfmul_vf_f64m4(A0, B0, gvl); + + for (BLASLONG k = 1; k < pass_K; k++) { + B0 = B[bi + 0]; + bi += 1; + + A0 = __riscv_vle64_v_f64m4(&A[ai + 0 * gvl], gvl); + ai += 4; + + result0 = __riscv_vfmacc_vf_f64m4(result0, B0, A0, gvl); + } + + BLASLONG ci = n_top * ldc + m_top; + + vfloat64m4_t c0 = __riscv_vfmul_vf_f64m4(result0, alpha, gvl); + __riscv_vse64_v_f64m4(&C[ci], c0, gvl); + m_top += 4; + } + + if (M & 2) { + double result0 = 0; + double result1 = 0; + BLASLONG ai = m_top * K; + BLASLONG bi = n_top * K; + BLASLONG pass_K = K; +#ifdef LEFT + BLASLONG off = offset + m_top; +#else + BLASLONG off = -offset + n_top; +#endif +#ifdef BACKWARDS + ai += off * 2; + bi += off * 1; + pass_K -= off; +#else +#ifdef LEFT + pass_K = off + 2; +#else + pass_K = off + 1; +#endif +#endif + + for (BLASLONG k = 0; k < pass_K; k++) { + result0 += A[ai + 0] * B[bi + 0]; + result1 += A[ai + 1] * B[bi + 0]; + ai += 2; + bi += 1; + } + + BLASLONG ci = n_top * ldc + m_top; + C[ci + 0 * ldc + 0] = alpha * result0; + C[ci + 0 * ldc + 1] = alpha * result1; + m_top += 2; + } + + if (M & 1) { + double result0 = 0; + BLASLONG ai = m_top * K; + BLASLONG bi = n_top * K; + BLASLONG pass_K = K; +#ifdef LEFT + BLASLONG off = offset + m_top; +#else + BLASLONG off = -offset + n_top; +#endif +#ifdef BACKWARDS + ai += off * 1; + bi += off * 1; + pass_K -= off; +#else +#ifdef LEFT + pass_K = off + 1; +#else + pass_K = off + 1; +#endif +#endif + + for (BLASLONG k = 0; k < pass_K; k++) { + result0 += A[ai + 0] * B[bi + 0]; + ai += 1; + bi += 1; + } + + BLASLONG ci = n_top * ldc + m_top; + C[ci + 0 * ldc + 0] = alpha * result0; + m_top += 1; + } + + n_top += 1; + } + + return 0; +} diff --git a/kernel/riscv64/sgemm_kernel_8x8_zvl128b.c b/kernel/riscv64/sgemm_kernel_8x8_zvl128b.c new file mode 100644 index 000000000..ad720e694 --- /dev/null +++ b/kernel/riscv64/sgemm_kernel_8x8_zvl128b.c @@ -0,0 +1,791 @@ +/* + +AUTOGENERATED KERNEL +Script: ./kernel/riscv64/generate_kernel.py +Settings: + LMUL=2 + M=8 + M_tail_scalar_from=2 + N=8 + __riscv_='__riscv_' + complex=False + conjugate=False + cpu='zvl128b' + force_acc_double=False + index_type='BLASLONG' + op='gemm' + param_precision='float' + reg_width_bits=128 + tail_policy='' + trace=False + +Derived: + ELEN_ACC=32 + ELEN_PARAM=32 + LMUL_ACC=2 + VFMACC='__riscv_vfmacc_vf_f32m2' + VFMUL='__riscv_vfmul_vf_f32m2' + VLEV='__riscv_vle32_v_f32m2' + VLSEV='__riscv_vlse32_v_f32m2' + VMACC_TO_ACC='__riscv_vfmacc_vf_f32m2' + VMUL_TO_ACC='__riscv_vfmul_vf_f32m2' + VSETVL='__riscv_vsetvl_e32m2' + VSEV='__riscv_vse32_v_f32m2' + VSSEV='__riscv_vsse32_v_f32m2' + acc_vector_t='vfloat32m2_t' + output='sgemm_kernel_8x8_zvl128b.c' + param_scalar_t='float' + param_vector_t='vfloat32m2_t' + +*/ + +#include "common.h" + +int CNAME(BLASLONG M, BLASLONG N, BLASLONG K, FLOAT alpha, FLOAT *A, FLOAT *B, FLOAT *C, BLASLONG ldc) + +{ + BLASLONG gvl = 0; + BLASLONG m_top = 0; + BLASLONG n_top = 0; + + // -- MAIN PASS + + for (BLASLONG j = 0; j < N / 8; j += 1) { + m_top = 0; + BLASLONG gvl = __riscv_vsetvl_e32m2(8); + + for (BLASLONG i = 0; i < M / 8; i += 1) { + BLASLONG ai = m_top * K; + BLASLONG bi = n_top * K; + float B0 = B[bi + 0]; + float B1 = B[bi + 1]; + float B2 = B[bi + 2]; + float B3 = B[bi + 3]; + float B4 = B[bi + 4]; + float B5 = B[bi + 5]; + float B6 = B[bi + 6]; + float B7 = B[bi + 7]; + bi += 8; + + vfloat32m2_t A0 = __riscv_vle32_v_f32m2(&A[ai + 0 * gvl], gvl); + ai += 8; + + vfloat32m2_t result0 = __riscv_vfmul_vf_f32m2(A0, B0, gvl); + vfloat32m2_t result1 = __riscv_vfmul_vf_f32m2(A0, B1, gvl); + vfloat32m2_t result2 = __riscv_vfmul_vf_f32m2(A0, B2, gvl); + vfloat32m2_t result3 = __riscv_vfmul_vf_f32m2(A0, B3, gvl); + vfloat32m2_t result4 = __riscv_vfmul_vf_f32m2(A0, B4, gvl); + vfloat32m2_t result5 = __riscv_vfmul_vf_f32m2(A0, B5, gvl); + vfloat32m2_t result6 = __riscv_vfmul_vf_f32m2(A0, B6, gvl); + vfloat32m2_t result7 = __riscv_vfmul_vf_f32m2(A0, B7, gvl); + + for (BLASLONG k = 1; k < K; k++) { + B0 = B[bi + 0]; + B1 = B[bi + 1]; + B2 = B[bi + 2]; + B3 = B[bi + 3]; + B4 = B[bi + 4]; + B5 = B[bi + 5]; + B6 = B[bi + 6]; + B7 = B[bi + 7]; + bi += 8; + + A0 = __riscv_vle32_v_f32m2(&A[ai + 0 * gvl], gvl); + ai += 8; + + result0 = __riscv_vfmacc_vf_f32m2(result0, B0, A0, gvl); + result1 = __riscv_vfmacc_vf_f32m2(result1, B1, A0, gvl); + result2 = __riscv_vfmacc_vf_f32m2(result2, B2, A0, gvl); + result3 = __riscv_vfmacc_vf_f32m2(result3, B3, A0, gvl); + result4 = __riscv_vfmacc_vf_f32m2(result4, B4, A0, gvl); + result5 = __riscv_vfmacc_vf_f32m2(result5, B5, A0, gvl); + result6 = __riscv_vfmacc_vf_f32m2(result6, B6, A0, gvl); + result7 = __riscv_vfmacc_vf_f32m2(result7, B7, A0, gvl); + } + + BLASLONG ci = n_top * ldc + m_top; + + vfloat32m2_t c0 = __riscv_vle32_v_f32m2(&C[ci], gvl); + ci += ldc - gvl * 0; + vfloat32m2_t c1 = __riscv_vle32_v_f32m2(&C[ci], gvl); + ci += ldc - gvl * 0; + vfloat32m2_t c2 = __riscv_vle32_v_f32m2(&C[ci], gvl); + ci += ldc - gvl * 0; + vfloat32m2_t c3 = __riscv_vle32_v_f32m2(&C[ci], gvl); + ci += ldc - gvl * 0; + vfloat32m2_t c4 = __riscv_vle32_v_f32m2(&C[ci], gvl); + ci += ldc - gvl * 0; + vfloat32m2_t c5 = __riscv_vle32_v_f32m2(&C[ci], gvl); + ci += ldc - gvl * 0; + vfloat32m2_t c6 = __riscv_vle32_v_f32m2(&C[ci], gvl); + ci += ldc - gvl * 0; + vfloat32m2_t c7 = __riscv_vle32_v_f32m2(&C[ci], gvl); + c0 = __riscv_vfmacc_vf_f32m2(c0, alpha, result0, gvl); + c1 = __riscv_vfmacc_vf_f32m2(c1, alpha, result1, gvl); + c2 = __riscv_vfmacc_vf_f32m2(c2, alpha, result2, gvl); + c3 = __riscv_vfmacc_vf_f32m2(c3, alpha, result3, gvl); + c4 = __riscv_vfmacc_vf_f32m2(c4, alpha, result4, gvl); + c5 = __riscv_vfmacc_vf_f32m2(c5, alpha, result5, gvl); + c6 = __riscv_vfmacc_vf_f32m2(c6, alpha, result6, gvl); + c7 = __riscv_vfmacc_vf_f32m2(c7, alpha, result7, gvl); + + ci = n_top * ldc + m_top; + + __riscv_vse32_v_f32m2(&C[ci], c0, gvl); + ci += ldc - gvl * 0; + __riscv_vse32_v_f32m2(&C[ci], c1, gvl); + ci += ldc - gvl * 0; + __riscv_vse32_v_f32m2(&C[ci], c2, gvl); + ci += ldc - gvl * 0; + __riscv_vse32_v_f32m2(&C[ci], c3, gvl); + ci += ldc - gvl * 0; + __riscv_vse32_v_f32m2(&C[ci], c4, gvl); + ci += ldc - gvl * 0; + __riscv_vse32_v_f32m2(&C[ci], c5, gvl); + ci += ldc - gvl * 0; + __riscv_vse32_v_f32m2(&C[ci], c6, gvl); + ci += ldc - gvl * 0; + __riscv_vse32_v_f32m2(&C[ci], c7, gvl); + m_top += 8; + } + + // -- tails for main pass + + if (M & 4) { + gvl = __riscv_vsetvl_e32m2(4); + + BLASLONG ai = m_top * K; + BLASLONG bi = n_top * K; + float B0 = B[bi + 0]; + float B1 = B[bi + 1]; + float B2 = B[bi + 2]; + float B3 = B[bi + 3]; + float B4 = B[bi + 4]; + float B5 = B[bi + 5]; + float B6 = B[bi + 6]; + float B7 = B[bi + 7]; + bi += 8; + + vfloat32m2_t A0 = __riscv_vle32_v_f32m2(&A[ai + 0 * gvl], gvl); + ai += 4; + + vfloat32m2_t result0 = __riscv_vfmul_vf_f32m2(A0, B0, gvl); + vfloat32m2_t result1 = __riscv_vfmul_vf_f32m2(A0, B1, gvl); + vfloat32m2_t result2 = __riscv_vfmul_vf_f32m2(A0, B2, gvl); + vfloat32m2_t result3 = __riscv_vfmul_vf_f32m2(A0, B3, gvl); + vfloat32m2_t result4 = __riscv_vfmul_vf_f32m2(A0, B4, gvl); + vfloat32m2_t result5 = __riscv_vfmul_vf_f32m2(A0, B5, gvl); + vfloat32m2_t result6 = __riscv_vfmul_vf_f32m2(A0, B6, gvl); + vfloat32m2_t result7 = __riscv_vfmul_vf_f32m2(A0, B7, gvl); + + for (BLASLONG k = 1; k < K; k++) { + B0 = B[bi + 0]; + B1 = B[bi + 1]; + B2 = B[bi + 2]; + B3 = B[bi + 3]; + B4 = B[bi + 4]; + B5 = B[bi + 5]; + B6 = B[bi + 6]; + B7 = B[bi + 7]; + bi += 8; + + A0 = __riscv_vle32_v_f32m2(&A[ai + 0 * gvl], gvl); + ai += 4; + + result0 = __riscv_vfmacc_vf_f32m2(result0, B0, A0, gvl); + result1 = __riscv_vfmacc_vf_f32m2(result1, B1, A0, gvl); + result2 = __riscv_vfmacc_vf_f32m2(result2, B2, A0, gvl); + result3 = __riscv_vfmacc_vf_f32m2(result3, B3, A0, gvl); + result4 = __riscv_vfmacc_vf_f32m2(result4, B4, A0, gvl); + result5 = __riscv_vfmacc_vf_f32m2(result5, B5, A0, gvl); + result6 = __riscv_vfmacc_vf_f32m2(result6, B6, A0, gvl); + result7 = __riscv_vfmacc_vf_f32m2(result7, B7, A0, gvl); + } + + BLASLONG ci = n_top * ldc + m_top; + + vfloat32m2_t c0 = __riscv_vle32_v_f32m2(&C[ci], gvl); + ci += ldc - gvl * 0; + vfloat32m2_t c1 = __riscv_vle32_v_f32m2(&C[ci], gvl); + ci += ldc - gvl * 0; + vfloat32m2_t c2 = __riscv_vle32_v_f32m2(&C[ci], gvl); + ci += ldc - gvl * 0; + vfloat32m2_t c3 = __riscv_vle32_v_f32m2(&C[ci], gvl); + ci += ldc - gvl * 0; + vfloat32m2_t c4 = __riscv_vle32_v_f32m2(&C[ci], gvl); + ci += ldc - gvl * 0; + vfloat32m2_t c5 = __riscv_vle32_v_f32m2(&C[ci], gvl); + ci += ldc - gvl * 0; + vfloat32m2_t c6 = __riscv_vle32_v_f32m2(&C[ci], gvl); + ci += ldc - gvl * 0; + vfloat32m2_t c7 = __riscv_vle32_v_f32m2(&C[ci], gvl); + c0 = __riscv_vfmacc_vf_f32m2(c0, alpha, result0, gvl); + c1 = __riscv_vfmacc_vf_f32m2(c1, alpha, result1, gvl); + c2 = __riscv_vfmacc_vf_f32m2(c2, alpha, result2, gvl); + c3 = __riscv_vfmacc_vf_f32m2(c3, alpha, result3, gvl); + c4 = __riscv_vfmacc_vf_f32m2(c4, alpha, result4, gvl); + c5 = __riscv_vfmacc_vf_f32m2(c5, alpha, result5, gvl); + c6 = __riscv_vfmacc_vf_f32m2(c6, alpha, result6, gvl); + c7 = __riscv_vfmacc_vf_f32m2(c7, alpha, result7, gvl); + + ci = n_top * ldc + m_top; + + __riscv_vse32_v_f32m2(&C[ci], c0, gvl); + ci += ldc - gvl * 0; + __riscv_vse32_v_f32m2(&C[ci], c1, gvl); + ci += ldc - gvl * 0; + __riscv_vse32_v_f32m2(&C[ci], c2, gvl); + ci += ldc - gvl * 0; + __riscv_vse32_v_f32m2(&C[ci], c3, gvl); + ci += ldc - gvl * 0; + __riscv_vse32_v_f32m2(&C[ci], c4, gvl); + ci += ldc - gvl * 0; + __riscv_vse32_v_f32m2(&C[ci], c5, gvl); + ci += ldc - gvl * 0; + __riscv_vse32_v_f32m2(&C[ci], c6, gvl); + ci += ldc - gvl * 0; + __riscv_vse32_v_f32m2(&C[ci], c7, gvl); + m_top += 4; + } + + if (M & 2) { + float result0 = 0; + float result1 = 0; + float result2 = 0; + float result3 = 0; + float result4 = 0; + float result5 = 0; + float result6 = 0; + float result7 = 0; + float result8 = 0; + float result9 = 0; + float result10 = 0; + float result11 = 0; + float result12 = 0; + float result13 = 0; + float result14 = 0; + float result15 = 0; + BLASLONG ai = m_top * K; + BLASLONG bi = n_top * K; + + for (BLASLONG k = 0; k < K; k++) { + result0 += A[ai + 0] * B[bi + 0]; + result1 += A[ai + 1] * B[bi + 0]; + result2 += A[ai + 0] * B[bi + 1]; + result3 += A[ai + 1] * B[bi + 1]; + result4 += A[ai + 0] * B[bi + 2]; + result5 += A[ai + 1] * B[bi + 2]; + result6 += A[ai + 0] * B[bi + 3]; + result7 += A[ai + 1] * B[bi + 3]; + result8 += A[ai + 0] * B[bi + 4]; + result9 += A[ai + 1] * B[bi + 4]; + result10 += A[ai + 0] * B[bi + 5]; + result11 += A[ai + 1] * B[bi + 5]; + result12 += A[ai + 0] * B[bi + 6]; + result13 += A[ai + 1] * B[bi + 6]; + result14 += A[ai + 0] * B[bi + 7]; + result15 += A[ai + 1] * B[bi + 7]; + ai += 2; + bi += 8; + } + + BLASLONG ci = n_top * ldc + m_top; + C[ci + 0 * ldc + 0] += alpha * result0; + C[ci + 0 * ldc + 1] += alpha * result1; + C[ci + 1 * ldc + 0] += alpha * result2; + C[ci + 1 * ldc + 1] += alpha * result3; + C[ci + 2 * ldc + 0] += alpha * result4; + C[ci + 2 * ldc + 1] += alpha * result5; + C[ci + 3 * ldc + 0] += alpha * result6; + C[ci + 3 * ldc + 1] += alpha * result7; + C[ci + 4 * ldc + 0] += alpha * result8; + C[ci + 4 * ldc + 1] += alpha * result9; + C[ci + 5 * ldc + 0] += alpha * result10; + C[ci + 5 * ldc + 1] += alpha * result11; + C[ci + 6 * ldc + 0] += alpha * result12; + C[ci + 6 * ldc + 1] += alpha * result13; + C[ci + 7 * ldc + 0] += alpha * result14; + C[ci + 7 * ldc + 1] += alpha * result15; + m_top += 2; + } + + if (M & 1) { + float result0 = 0; + float result1 = 0; + float result2 = 0; + float result3 = 0; + float result4 = 0; + float result5 = 0; + float result6 = 0; + float result7 = 0; + BLASLONG ai = m_top * K; + BLASLONG bi = n_top * K; + + for (BLASLONG k = 0; k < K; k++) { + result0 += A[ai + 0] * B[bi + 0]; + result1 += A[ai + 0] * B[bi + 1]; + result2 += A[ai + 0] * B[bi + 2]; + result3 += A[ai + 0] * B[bi + 3]; + result4 += A[ai + 0] * B[bi + 4]; + result5 += A[ai + 0] * B[bi + 5]; + result6 += A[ai + 0] * B[bi + 6]; + result7 += A[ai + 0] * B[bi + 7]; + ai += 1; + bi += 8; + } + + BLASLONG ci = n_top * ldc + m_top; + C[ci + 0 * ldc + 0] += alpha * result0; + C[ci + 1 * ldc + 0] += alpha * result1; + C[ci + 2 * ldc + 0] += alpha * result2; + C[ci + 3 * ldc + 0] += alpha * result3; + C[ci + 4 * ldc + 0] += alpha * result4; + C[ci + 5 * ldc + 0] += alpha * result5; + C[ci + 6 * ldc + 0] += alpha * result6; + C[ci + 7 * ldc + 0] += alpha * result7; + m_top += 1; + } + + n_top += 8; + } + + // -- tails for N=4 + + if (N & 4) { + gvl = __riscv_vsetvl_e32m2(8); + m_top = 0; + + for (BLASLONG i = 0; i < M / 8; i += 1) { + BLASLONG ai = m_top * K; + BLASLONG bi = n_top * K; + float B0 = B[bi + 0]; + float B1 = B[bi + 1]; + float B2 = B[bi + 2]; + float B3 = B[bi + 3]; + bi += 4; + + vfloat32m2_t A0 = __riscv_vle32_v_f32m2(&A[ai + 0 * gvl], gvl); + ai += 8; + + vfloat32m2_t result0 = __riscv_vfmul_vf_f32m2(A0, B0, gvl); + vfloat32m2_t result1 = __riscv_vfmul_vf_f32m2(A0, B1, gvl); + vfloat32m2_t result2 = __riscv_vfmul_vf_f32m2(A0, B2, gvl); + vfloat32m2_t result3 = __riscv_vfmul_vf_f32m2(A0, B3, gvl); + + for (BLASLONG k = 1; k < K; k++) { + B0 = B[bi + 0]; + B1 = B[bi + 1]; + B2 = B[bi + 2]; + B3 = B[bi + 3]; + bi += 4; + + A0 = __riscv_vle32_v_f32m2(&A[ai + 0 * gvl], gvl); + ai += 8; + + result0 = __riscv_vfmacc_vf_f32m2(result0, B0, A0, gvl); + result1 = __riscv_vfmacc_vf_f32m2(result1, B1, A0, gvl); + result2 = __riscv_vfmacc_vf_f32m2(result2, B2, A0, gvl); + result3 = __riscv_vfmacc_vf_f32m2(result3, B3, A0, gvl); + } + + BLASLONG ci = n_top * ldc + m_top; + + vfloat32m2_t c0 = __riscv_vle32_v_f32m2(&C[ci], gvl); + ci += ldc - gvl * 0; + vfloat32m2_t c1 = __riscv_vle32_v_f32m2(&C[ci], gvl); + ci += ldc - gvl * 0; + vfloat32m2_t c2 = __riscv_vle32_v_f32m2(&C[ci], gvl); + ci += ldc - gvl * 0; + vfloat32m2_t c3 = __riscv_vle32_v_f32m2(&C[ci], gvl); + c0 = __riscv_vfmacc_vf_f32m2(c0, alpha, result0, gvl); + c1 = __riscv_vfmacc_vf_f32m2(c1, alpha, result1, gvl); + c2 = __riscv_vfmacc_vf_f32m2(c2, alpha, result2, gvl); + c3 = __riscv_vfmacc_vf_f32m2(c3, alpha, result3, gvl); + + ci = n_top * ldc + m_top; + + __riscv_vse32_v_f32m2(&C[ci], c0, gvl); + ci += ldc - gvl * 0; + __riscv_vse32_v_f32m2(&C[ci], c1, gvl); + ci += ldc - gvl * 0; + __riscv_vse32_v_f32m2(&C[ci], c2, gvl); + ci += ldc - gvl * 0; + __riscv_vse32_v_f32m2(&C[ci], c3, gvl); + m_top += 8; + } + + if (M & 4) { + gvl = __riscv_vsetvl_e32m2(4); + + BLASLONG ai = m_top * K; + BLASLONG bi = n_top * K; + float B0 = B[bi + 0]; + float B1 = B[bi + 1]; + float B2 = B[bi + 2]; + float B3 = B[bi + 3]; + bi += 4; + + vfloat32m2_t A0 = __riscv_vle32_v_f32m2(&A[ai + 0 * gvl], gvl); + ai += 4; + + vfloat32m2_t result0 = __riscv_vfmul_vf_f32m2(A0, B0, gvl); + vfloat32m2_t result1 = __riscv_vfmul_vf_f32m2(A0, B1, gvl); + vfloat32m2_t result2 = __riscv_vfmul_vf_f32m2(A0, B2, gvl); + vfloat32m2_t result3 = __riscv_vfmul_vf_f32m2(A0, B3, gvl); + + for (BLASLONG k = 1; k < K; k++) { + B0 = B[bi + 0]; + B1 = B[bi + 1]; + B2 = B[bi + 2]; + B3 = B[bi + 3]; + bi += 4; + + A0 = __riscv_vle32_v_f32m2(&A[ai + 0 * gvl], gvl); + ai += 4; + + result0 = __riscv_vfmacc_vf_f32m2(result0, B0, A0, gvl); + result1 = __riscv_vfmacc_vf_f32m2(result1, B1, A0, gvl); + result2 = __riscv_vfmacc_vf_f32m2(result2, B2, A0, gvl); + result3 = __riscv_vfmacc_vf_f32m2(result3, B3, A0, gvl); + } + + BLASLONG ci = n_top * ldc + m_top; + + vfloat32m2_t c0 = __riscv_vle32_v_f32m2(&C[ci], gvl); + ci += ldc - gvl * 0; + vfloat32m2_t c1 = __riscv_vle32_v_f32m2(&C[ci], gvl); + ci += ldc - gvl * 0; + vfloat32m2_t c2 = __riscv_vle32_v_f32m2(&C[ci], gvl); + ci += ldc - gvl * 0; + vfloat32m2_t c3 = __riscv_vle32_v_f32m2(&C[ci], gvl); + c0 = __riscv_vfmacc_vf_f32m2(c0, alpha, result0, gvl); + c1 = __riscv_vfmacc_vf_f32m2(c1, alpha, result1, gvl); + c2 = __riscv_vfmacc_vf_f32m2(c2, alpha, result2, gvl); + c3 = __riscv_vfmacc_vf_f32m2(c3, alpha, result3, gvl); + + ci = n_top * ldc + m_top; + + __riscv_vse32_v_f32m2(&C[ci], c0, gvl); + ci += ldc - gvl * 0; + __riscv_vse32_v_f32m2(&C[ci], c1, gvl); + ci += ldc - gvl * 0; + __riscv_vse32_v_f32m2(&C[ci], c2, gvl); + ci += ldc - gvl * 0; + __riscv_vse32_v_f32m2(&C[ci], c3, gvl); + m_top += 4; + } + + if (M & 2) { + float result0 = 0; + float result1 = 0; + float result2 = 0; + float result3 = 0; + float result4 = 0; + float result5 = 0; + float result6 = 0; + float result7 = 0; + BLASLONG ai = m_top * K; + BLASLONG bi = n_top * K; + + for (BLASLONG k = 0; k < K; k++) { + result0 += A[ai + 0] * B[bi + 0]; + result1 += A[ai + 1] * B[bi + 0]; + result2 += A[ai + 0] * B[bi + 1]; + result3 += A[ai + 1] * B[bi + 1]; + result4 += A[ai + 0] * B[bi + 2]; + result5 += A[ai + 1] * B[bi + 2]; + result6 += A[ai + 0] * B[bi + 3]; + result7 += A[ai + 1] * B[bi + 3]; + ai += 2; + bi += 4; + } + + BLASLONG ci = n_top * ldc + m_top; + C[ci + 0 * ldc + 0] += alpha * result0; + C[ci + 0 * ldc + 1] += alpha * result1; + C[ci + 1 * ldc + 0] += alpha * result2; + C[ci + 1 * ldc + 1] += alpha * result3; + C[ci + 2 * ldc + 0] += alpha * result4; + C[ci + 2 * ldc + 1] += alpha * result5; + C[ci + 3 * ldc + 0] += alpha * result6; + C[ci + 3 * ldc + 1] += alpha * result7; + m_top += 2; + } + + if (M & 1) { + float result0 = 0; + float result1 = 0; + float result2 = 0; + float result3 = 0; + BLASLONG ai = m_top * K; + BLASLONG bi = n_top * K; + + for (BLASLONG k = 0; k < K; k++) { + result0 += A[ai + 0] * B[bi + 0]; + result1 += A[ai + 0] * B[bi + 1]; + result2 += A[ai + 0] * B[bi + 2]; + result3 += A[ai + 0] * B[bi + 3]; + ai += 1; + bi += 4; + } + + BLASLONG ci = n_top * ldc + m_top; + C[ci + 0 * ldc + 0] += alpha * result0; + C[ci + 1 * ldc + 0] += alpha * result1; + C[ci + 2 * ldc + 0] += alpha * result2; + C[ci + 3 * ldc + 0] += alpha * result3; + m_top += 1; + } + + n_top += 4; + } + + // -- tails for N=2 + + if (N & 2) { + gvl = __riscv_vsetvl_e32m2(8); + m_top = 0; + + for (BLASLONG i = 0; i < M / 8; i += 1) { + BLASLONG ai = m_top * K; + BLASLONG bi = n_top * K; + float B0 = B[bi + 0]; + float B1 = B[bi + 1]; + bi += 2; + + vfloat32m2_t A0 = __riscv_vle32_v_f32m2(&A[ai + 0 * gvl], gvl); + ai += 8; + + vfloat32m2_t result0 = __riscv_vfmul_vf_f32m2(A0, B0, gvl); + vfloat32m2_t result1 = __riscv_vfmul_vf_f32m2(A0, B1, gvl); + + for (BLASLONG k = 1; k < K; k++) { + B0 = B[bi + 0]; + B1 = B[bi + 1]; + bi += 2; + + A0 = __riscv_vle32_v_f32m2(&A[ai + 0 * gvl], gvl); + ai += 8; + + result0 = __riscv_vfmacc_vf_f32m2(result0, B0, A0, gvl); + result1 = __riscv_vfmacc_vf_f32m2(result1, B1, A0, gvl); + } + + BLASLONG ci = n_top * ldc + m_top; + + vfloat32m2_t c0 = __riscv_vle32_v_f32m2(&C[ci], gvl); + ci += ldc - gvl * 0; + vfloat32m2_t c1 = __riscv_vle32_v_f32m2(&C[ci], gvl); + c0 = __riscv_vfmacc_vf_f32m2(c0, alpha, result0, gvl); + c1 = __riscv_vfmacc_vf_f32m2(c1, alpha, result1, gvl); + + ci = n_top * ldc + m_top; + + __riscv_vse32_v_f32m2(&C[ci], c0, gvl); + ci += ldc - gvl * 0; + __riscv_vse32_v_f32m2(&C[ci], c1, gvl); + m_top += 8; + } + + if (M & 4) { + gvl = __riscv_vsetvl_e32m2(4); + + BLASLONG ai = m_top * K; + BLASLONG bi = n_top * K; + float B0 = B[bi + 0]; + float B1 = B[bi + 1]; + bi += 2; + + vfloat32m2_t A0 = __riscv_vle32_v_f32m2(&A[ai + 0 * gvl], gvl); + ai += 4; + + vfloat32m2_t result0 = __riscv_vfmul_vf_f32m2(A0, B0, gvl); + vfloat32m2_t result1 = __riscv_vfmul_vf_f32m2(A0, B1, gvl); + + for (BLASLONG k = 1; k < K; k++) { + B0 = B[bi + 0]; + B1 = B[bi + 1]; + bi += 2; + + A0 = __riscv_vle32_v_f32m2(&A[ai + 0 * gvl], gvl); + ai += 4; + + result0 = __riscv_vfmacc_vf_f32m2(result0, B0, A0, gvl); + result1 = __riscv_vfmacc_vf_f32m2(result1, B1, A0, gvl); + } + + BLASLONG ci = n_top * ldc + m_top; + + vfloat32m2_t c0 = __riscv_vle32_v_f32m2(&C[ci], gvl); + ci += ldc - gvl * 0; + vfloat32m2_t c1 = __riscv_vle32_v_f32m2(&C[ci], gvl); + c0 = __riscv_vfmacc_vf_f32m2(c0, alpha, result0, gvl); + c1 = __riscv_vfmacc_vf_f32m2(c1, alpha, result1, gvl); + + ci = n_top * ldc + m_top; + + __riscv_vse32_v_f32m2(&C[ci], c0, gvl); + ci += ldc - gvl * 0; + __riscv_vse32_v_f32m2(&C[ci], c1, gvl); + m_top += 4; + } + + if (M & 2) { + float result0 = 0; + float result1 = 0; + float result2 = 0; + float result3 = 0; + BLASLONG ai = m_top * K; + BLASLONG bi = n_top * K; + + for (BLASLONG k = 0; k < K; k++) { + result0 += A[ai + 0] * B[bi + 0]; + result1 += A[ai + 1] * B[bi + 0]; + result2 += A[ai + 0] * B[bi + 1]; + result3 += A[ai + 1] * B[bi + 1]; + ai += 2; + bi += 2; + } + + BLASLONG ci = n_top * ldc + m_top; + C[ci + 0 * ldc + 0] += alpha * result0; + C[ci + 0 * ldc + 1] += alpha * result1; + C[ci + 1 * ldc + 0] += alpha * result2; + C[ci + 1 * ldc + 1] += alpha * result3; + m_top += 2; + } + + if (M & 1) { + float result0 = 0; + float result1 = 0; + BLASLONG ai = m_top * K; + BLASLONG bi = n_top * K; + + for (BLASLONG k = 0; k < K; k++) { + result0 += A[ai + 0] * B[bi + 0]; + result1 += A[ai + 0] * B[bi + 1]; + ai += 1; + bi += 2; + } + + BLASLONG ci = n_top * ldc + m_top; + C[ci + 0 * ldc + 0] += alpha * result0; + C[ci + 1 * ldc + 0] += alpha * result1; + m_top += 1; + } + + n_top += 2; + } + + // -- tails for N=1 + + if (N & 1) { + gvl = __riscv_vsetvl_e32m2(8); + m_top = 0; + + for (BLASLONG i = 0; i < M / 8; i += 1) { + BLASLONG ai = m_top * K; + BLASLONG bi = n_top * K; + float B0 = B[bi + 0]; + bi += 1; + + vfloat32m2_t A0 = __riscv_vle32_v_f32m2(&A[ai + 0 * gvl], gvl); + ai += 8; + + vfloat32m2_t result0 = __riscv_vfmul_vf_f32m2(A0, B0, gvl); + + for (BLASLONG k = 1; k < K; k++) { + B0 = B[bi + 0]; + bi += 1; + + A0 = __riscv_vle32_v_f32m2(&A[ai + 0 * gvl], gvl); + ai += 8; + + result0 = __riscv_vfmacc_vf_f32m2(result0, B0, A0, gvl); + } + + BLASLONG ci = n_top * ldc + m_top; + + vfloat32m2_t c0 = __riscv_vle32_v_f32m2(&C[ci], gvl); + c0 = __riscv_vfmacc_vf_f32m2(c0, alpha, result0, gvl); + + ci = n_top * ldc + m_top; + + __riscv_vse32_v_f32m2(&C[ci], c0, gvl); + m_top += 8; + } + + if (M & 4) { + gvl = __riscv_vsetvl_e32m2(4); + + BLASLONG ai = m_top * K; + BLASLONG bi = n_top * K; + float B0 = B[bi + 0]; + bi += 1; + + vfloat32m2_t A0 = __riscv_vle32_v_f32m2(&A[ai + 0 * gvl], gvl); + ai += 4; + + vfloat32m2_t result0 = __riscv_vfmul_vf_f32m2(A0, B0, gvl); + + for (BLASLONG k = 1; k < K; k++) { + B0 = B[bi + 0]; + bi += 1; + + A0 = __riscv_vle32_v_f32m2(&A[ai + 0 * gvl], gvl); + ai += 4; + + result0 = __riscv_vfmacc_vf_f32m2(result0, B0, A0, gvl); + } + + BLASLONG ci = n_top * ldc + m_top; + + vfloat32m2_t c0 = __riscv_vle32_v_f32m2(&C[ci], gvl); + c0 = __riscv_vfmacc_vf_f32m2(c0, alpha, result0, gvl); + + ci = n_top * ldc + m_top; + + __riscv_vse32_v_f32m2(&C[ci], c0, gvl); + m_top += 4; + } + + if (M & 2) { + float result0 = 0; + float result1 = 0; + BLASLONG ai = m_top * K; + BLASLONG bi = n_top * K; + + for (BLASLONG k = 0; k < K; k++) { + result0 += A[ai + 0] * B[bi + 0]; + result1 += A[ai + 1] * B[bi + 0]; + ai += 2; + bi += 1; + } + + BLASLONG ci = n_top * ldc + m_top; + C[ci + 0 * ldc + 0] += alpha * result0; + C[ci + 0 * ldc + 1] += alpha * result1; + m_top += 2; + } + + if (M & 1) { + float result0 = 0; + BLASLONG ai = m_top * K; + BLASLONG bi = n_top * K; + + for (BLASLONG k = 0; k < K; k++) { + result0 += A[ai + 0] * B[bi + 0]; + ai += 1; + bi += 1; + } + + BLASLONG ci = n_top * ldc + m_top; + C[ci + 0 * ldc + 0] += alpha * result0; + m_top += 1; + } + + n_top += 1; + } + + return 0; +} diff --git a/kernel/riscv64/strmm_kernel_8x8_zvl128b.c b/kernel/riscv64/strmm_kernel_8x8_zvl128b.c new file mode 100644 index 000000000..ef18f036c --- /dev/null +++ b/kernel/riscv64/strmm_kernel_8x8_zvl128b.c @@ -0,0 +1,991 @@ +/* + +AUTOGENERATED KERNEL +Script: ./kernel/riscv64/generate_kernel.py +Settings: + LMUL=2 + M=8 + M_tail_scalar_from=2 + N=8 + __riscv_='__riscv_' + complex=False + conjugate=False + cpu='zvl128b' + force_acc_double=False + index_type='BLASLONG' + op='trmm' + param_precision='float' + reg_width_bits=128 + tail_policy='' + trace=False + +Derived: + ELEN_ACC=32 + ELEN_PARAM=32 + LMUL_ACC=2 + VFMACC='__riscv_vfmacc_vf_f32m2' + VFMUL='__riscv_vfmul_vf_f32m2' + VLEV='__riscv_vle32_v_f32m2' + VLSEV='__riscv_vlse32_v_f32m2' + VMACC_TO_ACC='__riscv_vfmacc_vf_f32m2' + VMUL_TO_ACC='__riscv_vfmul_vf_f32m2' + VSETVL='__riscv_vsetvl_e32m2' + VSEV='__riscv_vse32_v_f32m2' + VSSEV='__riscv_vsse32_v_f32m2' + acc_vector_t='vfloat32m2_t' + output='strmm_kernel_8x8_zvl128b.c' + param_scalar_t='float' + param_vector_t='vfloat32m2_t' + +*/ + +#include "common.h" + +#if defined(LEFT) != defined(TRANSA) +#define BACKWARDS +#endif + +int CNAME(BLASLONG M, BLASLONG N, BLASLONG K, FLOAT alpha, FLOAT *A, FLOAT *B, FLOAT *C, BLASLONG ldc, BLASLONG offset) + +{ + BLASLONG gvl = 0; + BLASLONG m_top = 0; + BLASLONG n_top = 0; + + // -- MAIN PASS + + for (BLASLONG j = 0; j < N / 8; j += 1) { + m_top = 0; + BLASLONG gvl = __riscv_vsetvl_e32m2(8); + + for (BLASLONG i = 0; i < M / 8; i += 1) { + BLASLONG ai = m_top * K; + BLASLONG bi = n_top * K; + BLASLONG pass_K = K; +#ifdef LEFT + BLASLONG off = offset + m_top; +#else + BLASLONG off = -offset + n_top; +#endif +#ifdef BACKWARDS + ai += off * 8; + bi += off * 8; + pass_K -= off; +#else +#ifdef LEFT + pass_K = off + 8; +#else + pass_K = off + 8; +#endif +#endif + float B0 = B[bi + 0]; + float B1 = B[bi + 1]; + float B2 = B[bi + 2]; + float B3 = B[bi + 3]; + float B4 = B[bi + 4]; + float B5 = B[bi + 5]; + float B6 = B[bi + 6]; + float B7 = B[bi + 7]; + bi += 8; + + vfloat32m2_t A0 = __riscv_vle32_v_f32m2(&A[ai + 0 * gvl], gvl); + ai += 8; + + vfloat32m2_t result0 = __riscv_vfmul_vf_f32m2(A0, B0, gvl); + vfloat32m2_t result1 = __riscv_vfmul_vf_f32m2(A0, B1, gvl); + vfloat32m2_t result2 = __riscv_vfmul_vf_f32m2(A0, B2, gvl); + vfloat32m2_t result3 = __riscv_vfmul_vf_f32m2(A0, B3, gvl); + vfloat32m2_t result4 = __riscv_vfmul_vf_f32m2(A0, B4, gvl); + vfloat32m2_t result5 = __riscv_vfmul_vf_f32m2(A0, B5, gvl); + vfloat32m2_t result6 = __riscv_vfmul_vf_f32m2(A0, B6, gvl); + vfloat32m2_t result7 = __riscv_vfmul_vf_f32m2(A0, B7, gvl); + + for (BLASLONG k = 1; k < pass_K; k++) { + B0 = B[bi + 0]; + B1 = B[bi + 1]; + B2 = B[bi + 2]; + B3 = B[bi + 3]; + B4 = B[bi + 4]; + B5 = B[bi + 5]; + B6 = B[bi + 6]; + B7 = B[bi + 7]; + bi += 8; + + A0 = __riscv_vle32_v_f32m2(&A[ai + 0 * gvl], gvl); + ai += 8; + + result0 = __riscv_vfmacc_vf_f32m2(result0, B0, A0, gvl); + result1 = __riscv_vfmacc_vf_f32m2(result1, B1, A0, gvl); + result2 = __riscv_vfmacc_vf_f32m2(result2, B2, A0, gvl); + result3 = __riscv_vfmacc_vf_f32m2(result3, B3, A0, gvl); + result4 = __riscv_vfmacc_vf_f32m2(result4, B4, A0, gvl); + result5 = __riscv_vfmacc_vf_f32m2(result5, B5, A0, gvl); + result6 = __riscv_vfmacc_vf_f32m2(result6, B6, A0, gvl); + result7 = __riscv_vfmacc_vf_f32m2(result7, B7, A0, gvl); + } + + BLASLONG ci = n_top * ldc + m_top; + + vfloat32m2_t c0 = __riscv_vfmul_vf_f32m2(result0, alpha, gvl); + vfloat32m2_t c1 = __riscv_vfmul_vf_f32m2(result1, alpha, gvl); + vfloat32m2_t c2 = __riscv_vfmul_vf_f32m2(result2, alpha, gvl); + vfloat32m2_t c3 = __riscv_vfmul_vf_f32m2(result3, alpha, gvl); + vfloat32m2_t c4 = __riscv_vfmul_vf_f32m2(result4, alpha, gvl); + vfloat32m2_t c5 = __riscv_vfmul_vf_f32m2(result5, alpha, gvl); + vfloat32m2_t c6 = __riscv_vfmul_vf_f32m2(result6, alpha, gvl); + vfloat32m2_t c7 = __riscv_vfmul_vf_f32m2(result7, alpha, gvl); + __riscv_vse32_v_f32m2(&C[ci], c0, gvl); + ci += ldc - gvl * 0; + __riscv_vse32_v_f32m2(&C[ci], c1, gvl); + ci += ldc - gvl * 0; + __riscv_vse32_v_f32m2(&C[ci], c2, gvl); + ci += ldc - gvl * 0; + __riscv_vse32_v_f32m2(&C[ci], c3, gvl); + ci += ldc - gvl * 0; + __riscv_vse32_v_f32m2(&C[ci], c4, gvl); + ci += ldc - gvl * 0; + __riscv_vse32_v_f32m2(&C[ci], c5, gvl); + ci += ldc - gvl * 0; + __riscv_vse32_v_f32m2(&C[ci], c6, gvl); + ci += ldc - gvl * 0; + __riscv_vse32_v_f32m2(&C[ci], c7, gvl); + m_top += 8; + } + + // -- tails for main pass + + if (M & 4) { + gvl = __riscv_vsetvl_e32m2(4); + + BLASLONG ai = m_top * K; + BLASLONG bi = n_top * K; + BLASLONG pass_K = K; +#ifdef LEFT + BLASLONG off = offset + m_top; +#else + BLASLONG off = -offset + n_top; +#endif +#ifdef BACKWARDS + ai += off * 4; + bi += off * 8; + pass_K -= off; +#else +#ifdef LEFT + pass_K = off + 4; +#else + pass_K = off + 8; +#endif +#endif + float B0 = B[bi + 0]; + float B1 = B[bi + 1]; + float B2 = B[bi + 2]; + float B3 = B[bi + 3]; + float B4 = B[bi + 4]; + float B5 = B[bi + 5]; + float B6 = B[bi + 6]; + float B7 = B[bi + 7]; + bi += 8; + + vfloat32m2_t A0 = __riscv_vle32_v_f32m2(&A[ai + 0 * gvl], gvl); + ai += 4; + + vfloat32m2_t result0 = __riscv_vfmul_vf_f32m2(A0, B0, gvl); + vfloat32m2_t result1 = __riscv_vfmul_vf_f32m2(A0, B1, gvl); + vfloat32m2_t result2 = __riscv_vfmul_vf_f32m2(A0, B2, gvl); + vfloat32m2_t result3 = __riscv_vfmul_vf_f32m2(A0, B3, gvl); + vfloat32m2_t result4 = __riscv_vfmul_vf_f32m2(A0, B4, gvl); + vfloat32m2_t result5 = __riscv_vfmul_vf_f32m2(A0, B5, gvl); + vfloat32m2_t result6 = __riscv_vfmul_vf_f32m2(A0, B6, gvl); + vfloat32m2_t result7 = __riscv_vfmul_vf_f32m2(A0, B7, gvl); + + for (BLASLONG k = 1; k < pass_K; k++) { + B0 = B[bi + 0]; + B1 = B[bi + 1]; + B2 = B[bi + 2]; + B3 = B[bi + 3]; + B4 = B[bi + 4]; + B5 = B[bi + 5]; + B6 = B[bi + 6]; + B7 = B[bi + 7]; + bi += 8; + + A0 = __riscv_vle32_v_f32m2(&A[ai + 0 * gvl], gvl); + ai += 4; + + result0 = __riscv_vfmacc_vf_f32m2(result0, B0, A0, gvl); + result1 = __riscv_vfmacc_vf_f32m2(result1, B1, A0, gvl); + result2 = __riscv_vfmacc_vf_f32m2(result2, B2, A0, gvl); + result3 = __riscv_vfmacc_vf_f32m2(result3, B3, A0, gvl); + result4 = __riscv_vfmacc_vf_f32m2(result4, B4, A0, gvl); + result5 = __riscv_vfmacc_vf_f32m2(result5, B5, A0, gvl); + result6 = __riscv_vfmacc_vf_f32m2(result6, B6, A0, gvl); + result7 = __riscv_vfmacc_vf_f32m2(result7, B7, A0, gvl); + } + + BLASLONG ci = n_top * ldc + m_top; + + vfloat32m2_t c0 = __riscv_vfmul_vf_f32m2(result0, alpha, gvl); + vfloat32m2_t c1 = __riscv_vfmul_vf_f32m2(result1, alpha, gvl); + vfloat32m2_t c2 = __riscv_vfmul_vf_f32m2(result2, alpha, gvl); + vfloat32m2_t c3 = __riscv_vfmul_vf_f32m2(result3, alpha, gvl); + vfloat32m2_t c4 = __riscv_vfmul_vf_f32m2(result4, alpha, gvl); + vfloat32m2_t c5 = __riscv_vfmul_vf_f32m2(result5, alpha, gvl); + vfloat32m2_t c6 = __riscv_vfmul_vf_f32m2(result6, alpha, gvl); + vfloat32m2_t c7 = __riscv_vfmul_vf_f32m2(result7, alpha, gvl); + __riscv_vse32_v_f32m2(&C[ci], c0, gvl); + ci += ldc - gvl * 0; + __riscv_vse32_v_f32m2(&C[ci], c1, gvl); + ci += ldc - gvl * 0; + __riscv_vse32_v_f32m2(&C[ci], c2, gvl); + ci += ldc - gvl * 0; + __riscv_vse32_v_f32m2(&C[ci], c3, gvl); + ci += ldc - gvl * 0; + __riscv_vse32_v_f32m2(&C[ci], c4, gvl); + ci += ldc - gvl * 0; + __riscv_vse32_v_f32m2(&C[ci], c5, gvl); + ci += ldc - gvl * 0; + __riscv_vse32_v_f32m2(&C[ci], c6, gvl); + ci += ldc - gvl * 0; + __riscv_vse32_v_f32m2(&C[ci], c7, gvl); + m_top += 4; + } + + if (M & 2) { + float result0 = 0; + float result1 = 0; + float result2 = 0; + float result3 = 0; + float result4 = 0; + float result5 = 0; + float result6 = 0; + float result7 = 0; + float result8 = 0; + float result9 = 0; + float result10 = 0; + float result11 = 0; + float result12 = 0; + float result13 = 0; + float result14 = 0; + float result15 = 0; + BLASLONG ai = m_top * K; + BLASLONG bi = n_top * K; + BLASLONG pass_K = K; +#ifdef LEFT + BLASLONG off = offset + m_top; +#else + BLASLONG off = -offset + n_top; +#endif +#ifdef BACKWARDS + ai += off * 2; + bi += off * 8; + pass_K -= off; +#else +#ifdef LEFT + pass_K = off + 2; +#else + pass_K = off + 8; +#endif +#endif + + for (BLASLONG k = 0; k < pass_K; k++) { + result0 += A[ai + 0] * B[bi + 0]; + result1 += A[ai + 1] * B[bi + 0]; + result2 += A[ai + 0] * B[bi + 1]; + result3 += A[ai + 1] * B[bi + 1]; + result4 += A[ai + 0] * B[bi + 2]; + result5 += A[ai + 1] * B[bi + 2]; + result6 += A[ai + 0] * B[bi + 3]; + result7 += A[ai + 1] * B[bi + 3]; + result8 += A[ai + 0] * B[bi + 4]; + result9 += A[ai + 1] * B[bi + 4]; + result10 += A[ai + 0] * B[bi + 5]; + result11 += A[ai + 1] * B[bi + 5]; + result12 += A[ai + 0] * B[bi + 6]; + result13 += A[ai + 1] * B[bi + 6]; + result14 += A[ai + 0] * B[bi + 7]; + result15 += A[ai + 1] * B[bi + 7]; + ai += 2; + bi += 8; + } + + BLASLONG ci = n_top * ldc + m_top; + C[ci + 0 * ldc + 0] = alpha * result0; + C[ci + 0 * ldc + 1] = alpha * result1; + C[ci + 1 * ldc + 0] = alpha * result2; + C[ci + 1 * ldc + 1] = alpha * result3; + C[ci + 2 * ldc + 0] = alpha * result4; + C[ci + 2 * ldc + 1] = alpha * result5; + C[ci + 3 * ldc + 0] = alpha * result6; + C[ci + 3 * ldc + 1] = alpha * result7; + C[ci + 4 * ldc + 0] = alpha * result8; + C[ci + 4 * ldc + 1] = alpha * result9; + C[ci + 5 * ldc + 0] = alpha * result10; + C[ci + 5 * ldc + 1] = alpha * result11; + C[ci + 6 * ldc + 0] = alpha * result12; + C[ci + 6 * ldc + 1] = alpha * result13; + C[ci + 7 * ldc + 0] = alpha * result14; + C[ci + 7 * ldc + 1] = alpha * result15; + m_top += 2; + } + + if (M & 1) { + float result0 = 0; + float result1 = 0; + float result2 = 0; + float result3 = 0; + float result4 = 0; + float result5 = 0; + float result6 = 0; + float result7 = 0; + BLASLONG ai = m_top * K; + BLASLONG bi = n_top * K; + BLASLONG pass_K = K; +#ifdef LEFT + BLASLONG off = offset + m_top; +#else + BLASLONG off = -offset + n_top; +#endif +#ifdef BACKWARDS + ai += off * 1; + bi += off * 8; + pass_K -= off; +#else +#ifdef LEFT + pass_K = off + 1; +#else + pass_K = off + 8; +#endif +#endif + + for (BLASLONG k = 0; k < pass_K; k++) { + result0 += A[ai + 0] * B[bi + 0]; + result1 += A[ai + 0] * B[bi + 1]; + result2 += A[ai + 0] * B[bi + 2]; + result3 += A[ai + 0] * B[bi + 3]; + result4 += A[ai + 0] * B[bi + 4]; + result5 += A[ai + 0] * B[bi + 5]; + result6 += A[ai + 0] * B[bi + 6]; + result7 += A[ai + 0] * B[bi + 7]; + ai += 1; + bi += 8; + } + + BLASLONG ci = n_top * ldc + m_top; + C[ci + 0 * ldc + 0] = alpha * result0; + C[ci + 1 * ldc + 0] = alpha * result1; + C[ci + 2 * ldc + 0] = alpha * result2; + C[ci + 3 * ldc + 0] = alpha * result3; + C[ci + 4 * ldc + 0] = alpha * result4; + C[ci + 5 * ldc + 0] = alpha * result5; + C[ci + 6 * ldc + 0] = alpha * result6; + C[ci + 7 * ldc + 0] = alpha * result7; + m_top += 1; + } + + n_top += 8; + } + + // -- tails for N=4 + + if (N & 4) { + gvl = __riscv_vsetvl_e32m2(8); + m_top = 0; + + for (BLASLONG i = 0; i < M / 8; i += 1) { + BLASLONG ai = m_top * K; + BLASLONG bi = n_top * K; + BLASLONG pass_K = K; +#ifdef LEFT + BLASLONG off = offset + m_top; +#else + BLASLONG off = -offset + n_top; +#endif +#ifdef BACKWARDS + ai += off * 8; + bi += off * 4; + pass_K -= off; +#else +#ifdef LEFT + pass_K = off + 8; +#else + pass_K = off + 4; +#endif +#endif + float B0 = B[bi + 0]; + float B1 = B[bi + 1]; + float B2 = B[bi + 2]; + float B3 = B[bi + 3]; + bi += 4; + + vfloat32m2_t A0 = __riscv_vle32_v_f32m2(&A[ai + 0 * gvl], gvl); + ai += 8; + + vfloat32m2_t result0 = __riscv_vfmul_vf_f32m2(A0, B0, gvl); + vfloat32m2_t result1 = __riscv_vfmul_vf_f32m2(A0, B1, gvl); + vfloat32m2_t result2 = __riscv_vfmul_vf_f32m2(A0, B2, gvl); + vfloat32m2_t result3 = __riscv_vfmul_vf_f32m2(A0, B3, gvl); + + for (BLASLONG k = 1; k < pass_K; k++) { + B0 = B[bi + 0]; + B1 = B[bi + 1]; + B2 = B[bi + 2]; + B3 = B[bi + 3]; + bi += 4; + + A0 = __riscv_vle32_v_f32m2(&A[ai + 0 * gvl], gvl); + ai += 8; + + result0 = __riscv_vfmacc_vf_f32m2(result0, B0, A0, gvl); + result1 = __riscv_vfmacc_vf_f32m2(result1, B1, A0, gvl); + result2 = __riscv_vfmacc_vf_f32m2(result2, B2, A0, gvl); + result3 = __riscv_vfmacc_vf_f32m2(result3, B3, A0, gvl); + } + + BLASLONG ci = n_top * ldc + m_top; + + vfloat32m2_t c0 = __riscv_vfmul_vf_f32m2(result0, alpha, gvl); + vfloat32m2_t c1 = __riscv_vfmul_vf_f32m2(result1, alpha, gvl); + vfloat32m2_t c2 = __riscv_vfmul_vf_f32m2(result2, alpha, gvl); + vfloat32m2_t c3 = __riscv_vfmul_vf_f32m2(result3, alpha, gvl); + __riscv_vse32_v_f32m2(&C[ci], c0, gvl); + ci += ldc - gvl * 0; + __riscv_vse32_v_f32m2(&C[ci], c1, gvl); + ci += ldc - gvl * 0; + __riscv_vse32_v_f32m2(&C[ci], c2, gvl); + ci += ldc - gvl * 0; + __riscv_vse32_v_f32m2(&C[ci], c3, gvl); + m_top += 8; + } + + if (M & 4) { + gvl = __riscv_vsetvl_e32m2(4); + + BLASLONG ai = m_top * K; + BLASLONG bi = n_top * K; + BLASLONG pass_K = K; +#ifdef LEFT + BLASLONG off = offset + m_top; +#else + BLASLONG off = -offset + n_top; +#endif +#ifdef BACKWARDS + ai += off * 4; + bi += off * 4; + pass_K -= off; +#else +#ifdef LEFT + pass_K = off + 4; +#else + pass_K = off + 4; +#endif +#endif + float B0 = B[bi + 0]; + float B1 = B[bi + 1]; + float B2 = B[bi + 2]; + float B3 = B[bi + 3]; + bi += 4; + + vfloat32m2_t A0 = __riscv_vle32_v_f32m2(&A[ai + 0 * gvl], gvl); + ai += 4; + + vfloat32m2_t result0 = __riscv_vfmul_vf_f32m2(A0, B0, gvl); + vfloat32m2_t result1 = __riscv_vfmul_vf_f32m2(A0, B1, gvl); + vfloat32m2_t result2 = __riscv_vfmul_vf_f32m2(A0, B2, gvl); + vfloat32m2_t result3 = __riscv_vfmul_vf_f32m2(A0, B3, gvl); + + for (BLASLONG k = 1; k < pass_K; k++) { + B0 = B[bi + 0]; + B1 = B[bi + 1]; + B2 = B[bi + 2]; + B3 = B[bi + 3]; + bi += 4; + + A0 = __riscv_vle32_v_f32m2(&A[ai + 0 * gvl], gvl); + ai += 4; + + result0 = __riscv_vfmacc_vf_f32m2(result0, B0, A0, gvl); + result1 = __riscv_vfmacc_vf_f32m2(result1, B1, A0, gvl); + result2 = __riscv_vfmacc_vf_f32m2(result2, B2, A0, gvl); + result3 = __riscv_vfmacc_vf_f32m2(result3, B3, A0, gvl); + } + + BLASLONG ci = n_top * ldc + m_top; + + vfloat32m2_t c0 = __riscv_vfmul_vf_f32m2(result0, alpha, gvl); + vfloat32m2_t c1 = __riscv_vfmul_vf_f32m2(result1, alpha, gvl); + vfloat32m2_t c2 = __riscv_vfmul_vf_f32m2(result2, alpha, gvl); + vfloat32m2_t c3 = __riscv_vfmul_vf_f32m2(result3, alpha, gvl); + __riscv_vse32_v_f32m2(&C[ci], c0, gvl); + ci += ldc - gvl * 0; + __riscv_vse32_v_f32m2(&C[ci], c1, gvl); + ci += ldc - gvl * 0; + __riscv_vse32_v_f32m2(&C[ci], c2, gvl); + ci += ldc - gvl * 0; + __riscv_vse32_v_f32m2(&C[ci], c3, gvl); + m_top += 4; + } + + if (M & 2) { + float result0 = 0; + float result1 = 0; + float result2 = 0; + float result3 = 0; + float result4 = 0; + float result5 = 0; + float result6 = 0; + float result7 = 0; + BLASLONG ai = m_top * K; + BLASLONG bi = n_top * K; + BLASLONG pass_K = K; +#ifdef LEFT + BLASLONG off = offset + m_top; +#else + BLASLONG off = -offset + n_top; +#endif +#ifdef BACKWARDS + ai += off * 2; + bi += off * 4; + pass_K -= off; +#else +#ifdef LEFT + pass_K = off + 2; +#else + pass_K = off + 4; +#endif +#endif + + for (BLASLONG k = 0; k < pass_K; k++) { + result0 += A[ai + 0] * B[bi + 0]; + result1 += A[ai + 1] * B[bi + 0]; + result2 += A[ai + 0] * B[bi + 1]; + result3 += A[ai + 1] * B[bi + 1]; + result4 += A[ai + 0] * B[bi + 2]; + result5 += A[ai + 1] * B[bi + 2]; + result6 += A[ai + 0] * B[bi + 3]; + result7 += A[ai + 1] * B[bi + 3]; + ai += 2; + bi += 4; + } + + BLASLONG ci = n_top * ldc + m_top; + C[ci + 0 * ldc + 0] = alpha * result0; + C[ci + 0 * ldc + 1] = alpha * result1; + C[ci + 1 * ldc + 0] = alpha * result2; + C[ci + 1 * ldc + 1] = alpha * result3; + C[ci + 2 * ldc + 0] = alpha * result4; + C[ci + 2 * ldc + 1] = alpha * result5; + C[ci + 3 * ldc + 0] = alpha * result6; + C[ci + 3 * ldc + 1] = alpha * result7; + m_top += 2; + } + + if (M & 1) { + float result0 = 0; + float result1 = 0; + float result2 = 0; + float result3 = 0; + BLASLONG ai = m_top * K; + BLASLONG bi = n_top * K; + BLASLONG pass_K = K; +#ifdef LEFT + BLASLONG off = offset + m_top; +#else + BLASLONG off = -offset + n_top; +#endif +#ifdef BACKWARDS + ai += off * 1; + bi += off * 4; + pass_K -= off; +#else +#ifdef LEFT + pass_K = off + 1; +#else + pass_K = off + 4; +#endif +#endif + + for (BLASLONG k = 0; k < pass_K; k++) { + result0 += A[ai + 0] * B[bi + 0]; + result1 += A[ai + 0] * B[bi + 1]; + result2 += A[ai + 0] * B[bi + 2]; + result3 += A[ai + 0] * B[bi + 3]; + ai += 1; + bi += 4; + } + + BLASLONG ci = n_top * ldc + m_top; + C[ci + 0 * ldc + 0] = alpha * result0; + C[ci + 1 * ldc + 0] = alpha * result1; + C[ci + 2 * ldc + 0] = alpha * result2; + C[ci + 3 * ldc + 0] = alpha * result3; + m_top += 1; + } + + n_top += 4; + } + + // -- tails for N=2 + + if (N & 2) { + gvl = __riscv_vsetvl_e32m2(8); + m_top = 0; + + for (BLASLONG i = 0; i < M / 8; i += 1) { + BLASLONG ai = m_top * K; + BLASLONG bi = n_top * K; + BLASLONG pass_K = K; +#ifdef LEFT + BLASLONG off = offset + m_top; +#else + BLASLONG off = -offset + n_top; +#endif +#ifdef BACKWARDS + ai += off * 8; + bi += off * 2; + pass_K -= off; +#else +#ifdef LEFT + pass_K = off + 8; +#else + pass_K = off + 2; +#endif +#endif + float B0 = B[bi + 0]; + float B1 = B[bi + 1]; + bi += 2; + + vfloat32m2_t A0 = __riscv_vle32_v_f32m2(&A[ai + 0 * gvl], gvl); + ai += 8; + + vfloat32m2_t result0 = __riscv_vfmul_vf_f32m2(A0, B0, gvl); + vfloat32m2_t result1 = __riscv_vfmul_vf_f32m2(A0, B1, gvl); + + for (BLASLONG k = 1; k < pass_K; k++) { + B0 = B[bi + 0]; + B1 = B[bi + 1]; + bi += 2; + + A0 = __riscv_vle32_v_f32m2(&A[ai + 0 * gvl], gvl); + ai += 8; + + result0 = __riscv_vfmacc_vf_f32m2(result0, B0, A0, gvl); + result1 = __riscv_vfmacc_vf_f32m2(result1, B1, A0, gvl); + } + + BLASLONG ci = n_top * ldc + m_top; + + vfloat32m2_t c0 = __riscv_vfmul_vf_f32m2(result0, alpha, gvl); + vfloat32m2_t c1 = __riscv_vfmul_vf_f32m2(result1, alpha, gvl); + __riscv_vse32_v_f32m2(&C[ci], c0, gvl); + ci += ldc - gvl * 0; + __riscv_vse32_v_f32m2(&C[ci], c1, gvl); + m_top += 8; + } + + if (M & 4) { + gvl = __riscv_vsetvl_e32m2(4); + + BLASLONG ai = m_top * K; + BLASLONG bi = n_top * K; + BLASLONG pass_K = K; +#ifdef LEFT + BLASLONG off = offset + m_top; +#else + BLASLONG off = -offset + n_top; +#endif +#ifdef BACKWARDS + ai += off * 4; + bi += off * 2; + pass_K -= off; +#else +#ifdef LEFT + pass_K = off + 4; +#else + pass_K = off + 2; +#endif +#endif + float B0 = B[bi + 0]; + float B1 = B[bi + 1]; + bi += 2; + + vfloat32m2_t A0 = __riscv_vle32_v_f32m2(&A[ai + 0 * gvl], gvl); + ai += 4; + + vfloat32m2_t result0 = __riscv_vfmul_vf_f32m2(A0, B0, gvl); + vfloat32m2_t result1 = __riscv_vfmul_vf_f32m2(A0, B1, gvl); + + for (BLASLONG k = 1; k < pass_K; k++) { + B0 = B[bi + 0]; + B1 = B[bi + 1]; + bi += 2; + + A0 = __riscv_vle32_v_f32m2(&A[ai + 0 * gvl], gvl); + ai += 4; + + result0 = __riscv_vfmacc_vf_f32m2(result0, B0, A0, gvl); + result1 = __riscv_vfmacc_vf_f32m2(result1, B1, A0, gvl); + } + + BLASLONG ci = n_top * ldc + m_top; + + vfloat32m2_t c0 = __riscv_vfmul_vf_f32m2(result0, alpha, gvl); + vfloat32m2_t c1 = __riscv_vfmul_vf_f32m2(result1, alpha, gvl); + __riscv_vse32_v_f32m2(&C[ci], c0, gvl); + ci += ldc - gvl * 0; + __riscv_vse32_v_f32m2(&C[ci], c1, gvl); + m_top += 4; + } + + if (M & 2) { + float result0 = 0; + float result1 = 0; + float result2 = 0; + float result3 = 0; + BLASLONG ai = m_top * K; + BLASLONG bi = n_top * K; + BLASLONG pass_K = K; +#ifdef LEFT + BLASLONG off = offset + m_top; +#else + BLASLONG off = -offset + n_top; +#endif +#ifdef BACKWARDS + ai += off * 2; + bi += off * 2; + pass_K -= off; +#else +#ifdef LEFT + pass_K = off + 2; +#else + pass_K = off + 2; +#endif +#endif + + for (BLASLONG k = 0; k < pass_K; k++) { + result0 += A[ai + 0] * B[bi + 0]; + result1 += A[ai + 1] * B[bi + 0]; + result2 += A[ai + 0] * B[bi + 1]; + result3 += A[ai + 1] * B[bi + 1]; + ai += 2; + bi += 2; + } + + BLASLONG ci = n_top * ldc + m_top; + C[ci + 0 * ldc + 0] = alpha * result0; + C[ci + 0 * ldc + 1] = alpha * result1; + C[ci + 1 * ldc + 0] = alpha * result2; + C[ci + 1 * ldc + 1] = alpha * result3; + m_top += 2; + } + + if (M & 1) { + float result0 = 0; + float result1 = 0; + BLASLONG ai = m_top * K; + BLASLONG bi = n_top * K; + BLASLONG pass_K = K; +#ifdef LEFT + BLASLONG off = offset + m_top; +#else + BLASLONG off = -offset + n_top; +#endif +#ifdef BACKWARDS + ai += off * 1; + bi += off * 2; + pass_K -= off; +#else +#ifdef LEFT + pass_K = off + 1; +#else + pass_K = off + 2; +#endif +#endif + + for (BLASLONG k = 0; k < pass_K; k++) { + result0 += A[ai + 0] * B[bi + 0]; + result1 += A[ai + 0] * B[bi + 1]; + ai += 1; + bi += 2; + } + + BLASLONG ci = n_top * ldc + m_top; + C[ci + 0 * ldc + 0] = alpha * result0; + C[ci + 1 * ldc + 0] = alpha * result1; + m_top += 1; + } + + n_top += 2; + } + + // -- tails for N=1 + + if (N & 1) { + gvl = __riscv_vsetvl_e32m2(8); + m_top = 0; + + for (BLASLONG i = 0; i < M / 8; i += 1) { + BLASLONG ai = m_top * K; + BLASLONG bi = n_top * K; + BLASLONG pass_K = K; +#ifdef LEFT + BLASLONG off = offset + m_top; +#else + BLASLONG off = -offset + n_top; +#endif +#ifdef BACKWARDS + ai += off * 8; + bi += off * 1; + pass_K -= off; +#else +#ifdef LEFT + pass_K = off + 8; +#else + pass_K = off + 1; +#endif +#endif + float B0 = B[bi + 0]; + bi += 1; + + vfloat32m2_t A0 = __riscv_vle32_v_f32m2(&A[ai + 0 * gvl], gvl); + ai += 8; + + vfloat32m2_t result0 = __riscv_vfmul_vf_f32m2(A0, B0, gvl); + + for (BLASLONG k = 1; k < pass_K; k++) { + B0 = B[bi + 0]; + bi += 1; + + A0 = __riscv_vle32_v_f32m2(&A[ai + 0 * gvl], gvl); + ai += 8; + + result0 = __riscv_vfmacc_vf_f32m2(result0, B0, A0, gvl); + } + + BLASLONG ci = n_top * ldc + m_top; + + vfloat32m2_t c0 = __riscv_vfmul_vf_f32m2(result0, alpha, gvl); + __riscv_vse32_v_f32m2(&C[ci], c0, gvl); + m_top += 8; + } + + if (M & 4) { + gvl = __riscv_vsetvl_e32m2(4); + + BLASLONG ai = m_top * K; + BLASLONG bi = n_top * K; + BLASLONG pass_K = K; +#ifdef LEFT + BLASLONG off = offset + m_top; +#else + BLASLONG off = -offset + n_top; +#endif +#ifdef BACKWARDS + ai += off * 4; + bi += off * 1; + pass_K -= off; +#else +#ifdef LEFT + pass_K = off + 4; +#else + pass_K = off + 1; +#endif +#endif + float B0 = B[bi + 0]; + bi += 1; + + vfloat32m2_t A0 = __riscv_vle32_v_f32m2(&A[ai + 0 * gvl], gvl); + ai += 4; + + vfloat32m2_t result0 = __riscv_vfmul_vf_f32m2(A0, B0, gvl); + + for (BLASLONG k = 1; k < pass_K; k++) { + B0 = B[bi + 0]; + bi += 1; + + A0 = __riscv_vle32_v_f32m2(&A[ai + 0 * gvl], gvl); + ai += 4; + + result0 = __riscv_vfmacc_vf_f32m2(result0, B0, A0, gvl); + } + + BLASLONG ci = n_top * ldc + m_top; + + vfloat32m2_t c0 = __riscv_vfmul_vf_f32m2(result0, alpha, gvl); + __riscv_vse32_v_f32m2(&C[ci], c0, gvl); + m_top += 4; + } + + if (M & 2) { + float result0 = 0; + float result1 = 0; + BLASLONG ai = m_top * K; + BLASLONG bi = n_top * K; + BLASLONG pass_K = K; +#ifdef LEFT + BLASLONG off = offset + m_top; +#else + BLASLONG off = -offset + n_top; +#endif +#ifdef BACKWARDS + ai += off * 2; + bi += off * 1; + pass_K -= off; +#else +#ifdef LEFT + pass_K = off + 2; +#else + pass_K = off + 1; +#endif +#endif + + for (BLASLONG k = 0; k < pass_K; k++) { + result0 += A[ai + 0] * B[bi + 0]; + result1 += A[ai + 1] * B[bi + 0]; + ai += 2; + bi += 1; + } + + BLASLONG ci = n_top * ldc + m_top; + C[ci + 0 * ldc + 0] = alpha * result0; + C[ci + 0 * ldc + 1] = alpha * result1; + m_top += 2; + } + + if (M & 1) { + float result0 = 0; + BLASLONG ai = m_top * K; + BLASLONG bi = n_top * K; + BLASLONG pass_K = K; +#ifdef LEFT + BLASLONG off = offset + m_top; +#else + BLASLONG off = -offset + n_top; +#endif +#ifdef BACKWARDS + ai += off * 1; + bi += off * 1; + pass_K -= off; +#else +#ifdef LEFT + pass_K = off + 1; +#else + pass_K = off + 1; +#endif +#endif + + for (BLASLONG k = 0; k < pass_K; k++) { + result0 += A[ai + 0] * B[bi + 0]; + ai += 1; + bi += 1; + } + + BLASLONG ci = n_top * ldc + m_top; + C[ci + 0 * ldc + 0] = alpha * result0; + m_top += 1; + } + + n_top += 1; + } + + return 0; +} diff --git a/kernel/riscv64/zgemm_kernel_4x4_zvl128b.c b/kernel/riscv64/zgemm_kernel_4x4_zvl128b.c new file mode 100644 index 000000000..0776f03fd --- /dev/null +++ b/kernel/riscv64/zgemm_kernel_4x4_zvl128b.c @@ -0,0 +1,720 @@ +/* + +AUTOGENERATED KERNEL +Script: ./kernel/riscv64/generate_kernel.py +Settings: + LMUL=2 + M=4 + M_tail_scalar_from=2 + N=4 + __riscv_='__riscv_' + complex=True + conjugate=False + cpu='zvl128b' + force_acc_double=False + index_type='BLASLONG' + op='gemm' + param_precision='double' + reg_width_bits=128 + tail_policy='' + trace=False + +Derived: + ELEN_ACC=64 + ELEN_PARAM=64 + LMUL_ACC=2 + VFMACC='__riscv_vfmacc_vf_f64m2' + VFMUL='__riscv_vfmul_vf_f64m2' + VLEV='__riscv_vle64_v_f64m2' + VLSEV='__riscv_vlse64_v_f64m2' + VMACC_TO_ACC='__riscv_vfmacc_vf_f64m2' + VMUL_TO_ACC='__riscv_vfmul_vf_f64m2' + VSETVL='__riscv_vsetvl_e64m2' + VSEV='__riscv_vse64_v_f64m2' + VSSEV='__riscv_vsse64_v_f64m2' + acc_vector_t='vfloat64m2_t' + output='zgemm_kernel_4x4_zvl128b.c' + param_scalar_t='double' + param_vector_t='vfloat64m2_t' + +*/ + +#include "common.h" + +#if defined(NN) || defined(NT) || defined(TN) || defined(TT) +#define S0 1 +#define S1 -1 +#define S2 1 +#define S3 1 +#define VFMACC_RR __riscv_vfmsac +#define VFMACC_RI __riscv_vfmacc +#endif +#if defined(NR) || defined(NC) || defined(TR) || defined(TC) +#define S0 1 +#define S1 1 +#define S2 1 +#define S3 -1 +#define VFMACC_RR __riscv_vfmacc +#define VFMACC_RI __riscv_vfmsac +#endif +#if defined(RN) || defined(RT) || defined(CN) || defined(CT) +#define S0 1 +#define S1 1 +#define S2 -1 +#define S3 1 +#define VFMACC_RR __riscv_vfmacc +#define VFMACC_RI __riscv_vfnmsac +#endif +#if defined(RR) || defined(RC) || defined(CR) || defined(CC) +#define S0 1 +#define S1 -1 +#define S2 -1 +#define S3 -1 +#define VFMACC_RR __riscv_vfmsac +#define VFMACC_RI __riscv_vfnmacc +#endif + +int CNAME(BLASLONG M, BLASLONG N, BLASLONG K, FLOAT alphar, FLOAT alphai, FLOAT *A, FLOAT *B, FLOAT *C, BLASLONG ldc) + +{ + BLASLONG gvl = 0; + BLASLONG m_top = 0; + BLASLONG n_top = 0; + + // -- MAIN PASS + + for (BLASLONG j = 0; j < N / 4; j += 1) { + m_top = 0; + BLASLONG gvl = __riscv_vsetvl_e64m2(4); + + for (BLASLONG i = 0; i < M / 4; i += 1) { + BLASLONG ai = m_top * K * 2; + BLASLONG bi = n_top * K * 2; + double B0r = B[bi + 0 * 2 + 0]; + double B0i = B[bi + 0 * 2 + 1]; + double B1r = B[bi + 1 * 2 + 0]; + double B1i = B[bi + 1 * 2 + 1]; + double B2r = B[bi + 2 * 2 + 0]; + double B2i = B[bi + 2 * 2 + 1]; + double B3r = B[bi + 3 * 2 + 0]; + double B3i = B[bi + 3 * 2 + 1]; + bi += 4 * 2; + + vfloat64m2_t A0r = __riscv_vlse64_v_f64m2(&A[ai + 0 * gvl * 2], sizeof(FLOAT) * 2, gvl); + vfloat64m2_t A0i = __riscv_vlse64_v_f64m2(&A[ai + 0 * gvl * 2 + 1], sizeof(FLOAT) * 2, gvl); + ai += 4 * 2; + + // 2 vector regs to hold A array contents, 8 regs to hold values accumulated over k + // leaving 6 vector registers for temporaries + // performing 2 operations between reuses of temporaries + vfloat64m2_t tmp0r = __riscv_vfmul_vf_f64m2(A0i, B0i, gvl); + vfloat64m2_t tmp0i = __riscv_vfmul_vf_f64m2(A0r, B0i, gvl); + vfloat64m2_t tmp1r = __riscv_vfmul_vf_f64m2(A0i, B1i, gvl); + vfloat64m2_t tmp1i = __riscv_vfmul_vf_f64m2(A0r, B1i, gvl); + tmp0r = VFMACC_RR(tmp0r, B0r, A0r, gvl); + tmp0i = VFMACC_RI(tmp0i, B0r, A0i, gvl); + tmp1r = VFMACC_RR(tmp1r, B1r, A0r, gvl); + tmp1i = VFMACC_RI(tmp1i, B1r, A0i, gvl); + vfloat64m2_t ACC0r = tmp0r; + vfloat64m2_t ACC0i = tmp0i; + vfloat64m2_t ACC1r = tmp1r; + vfloat64m2_t ACC1i = tmp1i; + tmp0r = __riscv_vfmul_vf_f64m2(A0i, B2i, gvl); + tmp0i = __riscv_vfmul_vf_f64m2(A0r, B2i, gvl); + tmp1r = __riscv_vfmul_vf_f64m2(A0i, B3i, gvl); + tmp1i = __riscv_vfmul_vf_f64m2(A0r, B3i, gvl); + tmp0r = VFMACC_RR(tmp0r, B2r, A0r, gvl); + tmp0i = VFMACC_RI(tmp0i, B2r, A0i, gvl); + tmp1r = VFMACC_RR(tmp1r, B3r, A0r, gvl); + tmp1i = VFMACC_RI(tmp1i, B3r, A0i, gvl); + vfloat64m2_t ACC2r = tmp0r; + vfloat64m2_t ACC2i = tmp0i; + vfloat64m2_t ACC3r = tmp1r; + vfloat64m2_t ACC3i = tmp1i; + + for (BLASLONG k = 1; k < K; k++) { + B0r = B[bi + 0 * 2 + 0]; + B0i = B[bi + 0 * 2 + 1]; + B1r = B[bi + 1 * 2 + 0]; + B1i = B[bi + 1 * 2 + 1]; + B2r = B[bi + 2 * 2 + 0]; + B2i = B[bi + 2 * 2 + 1]; + B3r = B[bi + 3 * 2 + 0]; + B3i = B[bi + 3 * 2 + 1]; + bi += 4 * 2; + + A0r = __riscv_vlse64_v_f64m2(&A[ai + 0 * gvl * 2], sizeof(FLOAT) * 2, gvl); + A0i = __riscv_vlse64_v_f64m2(&A[ai + 0 * gvl * 2 + 1], sizeof(FLOAT) * 2, gvl); + ai += 4 * 2; + + tmp0r = __riscv_vfmul_vf_f64m2(A0i, B0i, gvl); + tmp0i = __riscv_vfmul_vf_f64m2(A0r, B0i, gvl); + tmp1r = __riscv_vfmul_vf_f64m2(A0i, B1i, gvl); + tmp1i = __riscv_vfmul_vf_f64m2(A0r, B1i, gvl); + tmp0r = VFMACC_RR(tmp0r, B0r, A0r, gvl); + tmp0i = VFMACC_RI(tmp0i, B0r, A0i, gvl); + tmp1r = VFMACC_RR(tmp1r, B1r, A0r, gvl); + tmp1i = VFMACC_RI(tmp1i, B1r, A0i, gvl); + ACC0r = __riscv_vfadd(ACC0r, tmp0r, gvl); + ACC0i = __riscv_vfadd(ACC0i, tmp0i, gvl); + ACC1r = __riscv_vfadd(ACC1r, tmp1r, gvl); + ACC1i = __riscv_vfadd(ACC1i, tmp1i, gvl); + tmp0r = __riscv_vfmul_vf_f64m2(A0i, B2i, gvl); + tmp0i = __riscv_vfmul_vf_f64m2(A0r, B2i, gvl); + tmp1r = __riscv_vfmul_vf_f64m2(A0i, B3i, gvl); + tmp1i = __riscv_vfmul_vf_f64m2(A0r, B3i, gvl); + tmp0r = VFMACC_RR(tmp0r, B2r, A0r, gvl); + tmp0i = VFMACC_RI(tmp0i, B2r, A0i, gvl); + tmp1r = VFMACC_RR(tmp1r, B3r, A0r, gvl); + tmp1i = VFMACC_RI(tmp1i, B3r, A0i, gvl); + ACC2r = __riscv_vfadd(ACC2r, tmp0r, gvl); + ACC2i = __riscv_vfadd(ACC2i, tmp0i, gvl); + ACC3r = __riscv_vfadd(ACC3r, tmp1r, gvl); + ACC3i = __riscv_vfadd(ACC3i, tmp1i, gvl); + } + + BLASLONG ci = n_top * ldc + m_top; + + vfloat64m2_t C0r = __riscv_vlse64_v_f64m2(&C[ci * 2 + 0], sizeof(FLOAT) * 2, gvl); + vfloat64m2_t C0i = __riscv_vlse64_v_f64m2(&C[ci * 2 + 1], sizeof(FLOAT) * 2, gvl); + ci += ldc - gvl * 0; + vfloat64m2_t C1r = __riscv_vlse64_v_f64m2(&C[ci * 2 + 0], sizeof(FLOAT) * 2, gvl); + vfloat64m2_t C1i = __riscv_vlse64_v_f64m2(&C[ci * 2 + 1], sizeof(FLOAT) * 2, gvl); + ci += ldc - gvl * 0; + vfloat64m2_t C2r = __riscv_vlse64_v_f64m2(&C[ci * 2 + 0], sizeof(FLOAT) * 2, gvl); + vfloat64m2_t C2i = __riscv_vlse64_v_f64m2(&C[ci * 2 + 1], sizeof(FLOAT) * 2, gvl); + ci += ldc - gvl * 0; + vfloat64m2_t C3r = __riscv_vlse64_v_f64m2(&C[ci * 2 + 0], sizeof(FLOAT) * 2, gvl); + vfloat64m2_t C3i = __riscv_vlse64_v_f64m2(&C[ci * 2 + 1], sizeof(FLOAT) * 2, gvl); + + C0r = __riscv_vfmacc(C0r, alphar, ACC0r, gvl); + C0i = __riscv_vfmacc(C0i, alphar, ACC0i, gvl); + C1r = __riscv_vfmacc(C1r, alphar, ACC1r, gvl); + C1i = __riscv_vfmacc(C1i, alphar, ACC1i, gvl); + C2r = __riscv_vfmacc(C2r, alphar, ACC2r, gvl); + C2i = __riscv_vfmacc(C2i, alphar, ACC2i, gvl); + C3r = __riscv_vfmacc(C3r, alphar, ACC3r, gvl); + C3i = __riscv_vfmacc(C3i, alphar, ACC3i, gvl); + C0r = __riscv_vfnmsac(C0r, alphai, ACC0i, gvl); + C0i = __riscv_vfmacc(C0i, alphai, ACC0r, gvl); + C1r = __riscv_vfnmsac(C1r, alphai, ACC1i, gvl); + C1i = __riscv_vfmacc(C1i, alphai, ACC1r, gvl); + C2r = __riscv_vfnmsac(C2r, alphai, ACC2i, gvl); + C2i = __riscv_vfmacc(C2i, alphai, ACC2r, gvl); + C3r = __riscv_vfnmsac(C3r, alphai, ACC3i, gvl); + C3i = __riscv_vfmacc(C3i, alphai, ACC3r, gvl); + + ci = n_top * ldc + m_top; + + __riscv_vsse64_v_f64m2(&C[ci * 2 + 0], sizeof(FLOAT) * 2, C0r, gvl); + __riscv_vsse64_v_f64m2(&C[ci * 2 + 1], sizeof(FLOAT) * 2, C0i, gvl); + ci += ldc - gvl * 0; + __riscv_vsse64_v_f64m2(&C[ci * 2 + 0], sizeof(FLOAT) * 2, C1r, gvl); + __riscv_vsse64_v_f64m2(&C[ci * 2 + 1], sizeof(FLOAT) * 2, C1i, gvl); + ci += ldc - gvl * 0; + __riscv_vsse64_v_f64m2(&C[ci * 2 + 0], sizeof(FLOAT) * 2, C2r, gvl); + __riscv_vsse64_v_f64m2(&C[ci * 2 + 1], sizeof(FLOAT) * 2, C2i, gvl); + ci += ldc - gvl * 0; + __riscv_vsse64_v_f64m2(&C[ci * 2 + 0], sizeof(FLOAT) * 2, C3r, gvl); + __riscv_vsse64_v_f64m2(&C[ci * 2 + 1], sizeof(FLOAT) * 2, C3i, gvl); + + m_top += 4; + } + + // -- tails for main pass + + if (M & 2) { + double result0 = 0; + double result1 = 0; + double result2 = 0; + double result3 = 0; + double result4 = 0; + double result5 = 0; + double result6 = 0; + double result7 = 0; + double result8 = 0; + double result9 = 0; + double result10 = 0; + double result11 = 0; + double result12 = 0; + double result13 = 0; + double result14 = 0; + double result15 = 0; + BLASLONG ai = m_top * K * 2; + BLASLONG bi = n_top * K * 2; + + for (BLASLONG k = 0; k < K; k++) { + result0 += S0 * A[ai + 0 + 0] * B[bi + 0 + 0] + S1 * A[ai + 0 + 1] * B[bi + 0 + 1]; + result1 += S2 * A[ai + 0 + 1] * B[bi + 0 + 0] + S3 * A[ai + 0 + 0] * B[bi + 0 + 1]; + result2 += S0 * A[ai + 2 + 0] * B[bi + 0 + 0] + S1 * A[ai + 2 + 1] * B[bi + 0 + 1]; + result3 += S2 * A[ai + 2 + 1] * B[bi + 0 + 0] + S3 * A[ai + 2 + 0] * B[bi + 0 + 1]; + result4 += S0 * A[ai + 0 + 0] * B[bi + 2 + 0] + S1 * A[ai + 0 + 1] * B[bi + 2 + 1]; + result5 += S2 * A[ai + 0 + 1] * B[bi + 2 + 0] + S3 * A[ai + 0 + 0] * B[bi + 2 + 1]; + result6 += S0 * A[ai + 2 + 0] * B[bi + 2 + 0] + S1 * A[ai + 2 + 1] * B[bi + 2 + 1]; + result7 += S2 * A[ai + 2 + 1] * B[bi + 2 + 0] + S3 * A[ai + 2 + 0] * B[bi + 2 + 1]; + result8 += S0 * A[ai + 0 + 0] * B[bi + 4 + 0] + S1 * A[ai + 0 + 1] * B[bi + 4 + 1]; + result9 += S2 * A[ai + 0 + 1] * B[bi + 4 + 0] + S3 * A[ai + 0 + 0] * B[bi + 4 + 1]; + result10 += S0 * A[ai + 2 + 0] * B[bi + 4 + 0] + S1 * A[ai + 2 + 1] * B[bi + 4 + 1]; + result11 += S2 * A[ai + 2 + 1] * B[bi + 4 + 0] + S3 * A[ai + 2 + 0] * B[bi + 4 + 1]; + result12 += S0 * A[ai + 0 + 0] * B[bi + 6 + 0] + S1 * A[ai + 0 + 1] * B[bi + 6 + 1]; + result13 += S2 * A[ai + 0 + 1] * B[bi + 6 + 0] + S3 * A[ai + 0 + 0] * B[bi + 6 + 1]; + result14 += S0 * A[ai + 2 + 0] * B[bi + 6 + 0] + S1 * A[ai + 2 + 1] * B[bi + 6 + 1]; + result15 += S2 * A[ai + 2 + 1] * B[bi + 6 + 0] + S3 * A[ai + 2 + 0] * B[bi + 6 + 1]; + ai += 2 * 2; + bi += 4 * 2; + } + + BLASLONG ci = n_top * ldc + m_top; + double Cr, Ci; + Cr = C[(ci + 0 * ldc + 0) * 2 + 0]; + Ci = C[(ci + 0 * ldc + 0) * 2 + 1]; + Cr += result0 * alphar; + Ci += result1 * alphar; + Cr -= result1 * alphai; + Ci += result0 * alphai; + C[(ci + 0 * ldc + 0) * 2 + 0] = Cr; + C[(ci + 0 * ldc + 0) * 2 + 1] = Ci; + Cr = C[(ci + 0 * ldc + 1) * 2 + 0]; + Ci = C[(ci + 0 * ldc + 1) * 2 + 1]; + Cr += result2 * alphar; + Ci += result3 * alphar; + Cr -= result3 * alphai; + Ci += result2 * alphai; + C[(ci + 0 * ldc + 1) * 2 + 0] = Cr; + C[(ci + 0 * ldc + 1) * 2 + 1] = Ci; + Cr = C[(ci + 1 * ldc + 0) * 2 + 0]; + Ci = C[(ci + 1 * ldc + 0) * 2 + 1]; + Cr += result4 * alphar; + Ci += result5 * alphar; + Cr -= result5 * alphai; + Ci += result4 * alphai; + C[(ci + 1 * ldc + 0) * 2 + 0] = Cr; + C[(ci + 1 * ldc + 0) * 2 + 1] = Ci; + Cr = C[(ci + 1 * ldc + 1) * 2 + 0]; + Ci = C[(ci + 1 * ldc + 1) * 2 + 1]; + Cr += result6 * alphar; + Ci += result7 * alphar; + Cr -= result7 * alphai; + Ci += result6 * alphai; + C[(ci + 1 * ldc + 1) * 2 + 0] = Cr; + C[(ci + 1 * ldc + 1) * 2 + 1] = Ci; + Cr = C[(ci + 2 * ldc + 0) * 2 + 0]; + Ci = C[(ci + 2 * ldc + 0) * 2 + 1]; + Cr += result8 * alphar; + Ci += result9 * alphar; + Cr -= result9 * alphai; + Ci += result8 * alphai; + C[(ci + 2 * ldc + 0) * 2 + 0] = Cr; + C[(ci + 2 * ldc + 0) * 2 + 1] = Ci; + Cr = C[(ci + 2 * ldc + 1) * 2 + 0]; + Ci = C[(ci + 2 * ldc + 1) * 2 + 1]; + Cr += result10 * alphar; + Ci += result11 * alphar; + Cr -= result11 * alphai; + Ci += result10 * alphai; + C[(ci + 2 * ldc + 1) * 2 + 0] = Cr; + C[(ci + 2 * ldc + 1) * 2 + 1] = Ci; + Cr = C[(ci + 3 * ldc + 0) * 2 + 0]; + Ci = C[(ci + 3 * ldc + 0) * 2 + 1]; + Cr += result12 * alphar; + Ci += result13 * alphar; + Cr -= result13 * alphai; + Ci += result12 * alphai; + C[(ci + 3 * ldc + 0) * 2 + 0] = Cr; + C[(ci + 3 * ldc + 0) * 2 + 1] = Ci; + Cr = C[(ci + 3 * ldc + 1) * 2 + 0]; + Ci = C[(ci + 3 * ldc + 1) * 2 + 1]; + Cr += result14 * alphar; + Ci += result15 * alphar; + Cr -= result15 * alphai; + Ci += result14 * alphai; + C[(ci + 3 * ldc + 1) * 2 + 0] = Cr; + C[(ci + 3 * ldc + 1) * 2 + 1] = Ci; + m_top += 2; + } + + if (M & 1) { + double result0 = 0; + double result1 = 0; + double result2 = 0; + double result3 = 0; + double result4 = 0; + double result5 = 0; + double result6 = 0; + double result7 = 0; + BLASLONG ai = m_top * K * 2; + BLASLONG bi = n_top * K * 2; + + for (BLASLONG k = 0; k < K; k++) { + result0 += S0 * A[ai + 0 + 0] * B[bi + 0 + 0] + S1 * A[ai + 0 + 1] * B[bi + 0 + 1]; + result1 += S2 * A[ai + 0 + 1] * B[bi + 0 + 0] + S3 * A[ai + 0 + 0] * B[bi + 0 + 1]; + result2 += S0 * A[ai + 0 + 0] * B[bi + 2 + 0] + S1 * A[ai + 0 + 1] * B[bi + 2 + 1]; + result3 += S2 * A[ai + 0 + 1] * B[bi + 2 + 0] + S3 * A[ai + 0 + 0] * B[bi + 2 + 1]; + result4 += S0 * A[ai + 0 + 0] * B[bi + 4 + 0] + S1 * A[ai + 0 + 1] * B[bi + 4 + 1]; + result5 += S2 * A[ai + 0 + 1] * B[bi + 4 + 0] + S3 * A[ai + 0 + 0] * B[bi + 4 + 1]; + result6 += S0 * A[ai + 0 + 0] * B[bi + 6 + 0] + S1 * A[ai + 0 + 1] * B[bi + 6 + 1]; + result7 += S2 * A[ai + 0 + 1] * B[bi + 6 + 0] + S3 * A[ai + 0 + 0] * B[bi + 6 + 1]; + ai += 1 * 2; + bi += 4 * 2; + } + + BLASLONG ci = n_top * ldc + m_top; + double Cr, Ci; + Cr = C[(ci + 0 * ldc + 0) * 2 + 0]; + Ci = C[(ci + 0 * ldc + 0) * 2 + 1]; + Cr += result0 * alphar; + Ci += result1 * alphar; + Cr -= result1 * alphai; + Ci += result0 * alphai; + C[(ci + 0 * ldc + 0) * 2 + 0] = Cr; + C[(ci + 0 * ldc + 0) * 2 + 1] = Ci; + Cr = C[(ci + 1 * ldc + 0) * 2 + 0]; + Ci = C[(ci + 1 * ldc + 0) * 2 + 1]; + Cr += result2 * alphar; + Ci += result3 * alphar; + Cr -= result3 * alphai; + Ci += result2 * alphai; + C[(ci + 1 * ldc + 0) * 2 + 0] = Cr; + C[(ci + 1 * ldc + 0) * 2 + 1] = Ci; + Cr = C[(ci + 2 * ldc + 0) * 2 + 0]; + Ci = C[(ci + 2 * ldc + 0) * 2 + 1]; + Cr += result4 * alphar; + Ci += result5 * alphar; + Cr -= result5 * alphai; + Ci += result4 * alphai; + C[(ci + 2 * ldc + 0) * 2 + 0] = Cr; + C[(ci + 2 * ldc + 0) * 2 + 1] = Ci; + Cr = C[(ci + 3 * ldc + 0) * 2 + 0]; + Ci = C[(ci + 3 * ldc + 0) * 2 + 1]; + Cr += result6 * alphar; + Ci += result7 * alphar; + Cr -= result7 * alphai; + Ci += result6 * alphai; + C[(ci + 3 * ldc + 0) * 2 + 0] = Cr; + C[(ci + 3 * ldc + 0) * 2 + 1] = Ci; + m_top += 1; + } + + n_top += 4; + } + + // -- tails for N=2 + + if (N & 2) { + gvl = __riscv_vsetvl_e64m2(4); + m_top = 0; + + for (BLASLONG i = 0; i < M / 4; i += 1) { + BLASLONG ai = m_top * K * 2; + BLASLONG bi = n_top * K * 2; + double B0r = B[bi + 0 * 2 + 0]; + double B0i = B[bi + 0 * 2 + 1]; + double B1r = B[bi + 1 * 2 + 0]; + double B1i = B[bi + 1 * 2 + 1]; + bi += 2 * 2; + + vfloat64m2_t A0r = __riscv_vlse64_v_f64m2(&A[ai + 0 * gvl * 2], sizeof(FLOAT) * 2, gvl); + vfloat64m2_t A0i = __riscv_vlse64_v_f64m2(&A[ai + 0 * gvl * 2 + 1], sizeof(FLOAT) * 2, gvl); + ai += 4 * 2; + + // 2 vector regs to hold A array contents, 4 regs to hold values accumulated over k + // leaving 10 vector registers for temporaries + vfloat64m2_t tmp0r = __riscv_vfmul_vf_f64m2(A0i, B0i, gvl); + vfloat64m2_t tmp0i = __riscv_vfmul_vf_f64m2(A0r, B0i, gvl); + vfloat64m2_t tmp1r = __riscv_vfmul_vf_f64m2(A0i, B1i, gvl); + vfloat64m2_t tmp1i = __riscv_vfmul_vf_f64m2(A0r, B1i, gvl); + tmp0r = VFMACC_RR(tmp0r, B0r, A0r, gvl); + tmp0i = VFMACC_RI(tmp0i, B0r, A0i, gvl); + tmp1r = VFMACC_RR(tmp1r, B1r, A0r, gvl); + tmp1i = VFMACC_RI(tmp1i, B1r, A0i, gvl); + vfloat64m2_t ACC0r = tmp0r; + vfloat64m2_t ACC0i = tmp0i; + vfloat64m2_t ACC1r = tmp1r; + vfloat64m2_t ACC1i = tmp1i; + + for (BLASLONG k = 1; k < K; k++) { + B0r = B[bi + 0 * 2 + 0]; + B0i = B[bi + 0 * 2 + 1]; + B1r = B[bi + 1 * 2 + 0]; + B1i = B[bi + 1 * 2 + 1]; + bi += 2 * 2; + + A0r = __riscv_vlse64_v_f64m2(&A[ai + 0 * gvl * 2], sizeof(FLOAT) * 2, gvl); + A0i = __riscv_vlse64_v_f64m2(&A[ai + 0 * gvl * 2 + 1], sizeof(FLOAT) * 2, gvl); + ai += 4 * 2; + + tmp0r = __riscv_vfmul_vf_f64m2(A0i, B0i, gvl); + tmp0i = __riscv_vfmul_vf_f64m2(A0r, B0i, gvl); + tmp1r = __riscv_vfmul_vf_f64m2(A0i, B1i, gvl); + tmp1i = __riscv_vfmul_vf_f64m2(A0r, B1i, gvl); + tmp0r = VFMACC_RR(tmp0r, B0r, A0r, gvl); + tmp0i = VFMACC_RI(tmp0i, B0r, A0i, gvl); + tmp1r = VFMACC_RR(tmp1r, B1r, A0r, gvl); + tmp1i = VFMACC_RI(tmp1i, B1r, A0i, gvl); + ACC0r = __riscv_vfadd(ACC0r, tmp0r, gvl); + ACC0i = __riscv_vfadd(ACC0i, tmp0i, gvl); + ACC1r = __riscv_vfadd(ACC1r, tmp1r, gvl); + ACC1i = __riscv_vfadd(ACC1i, tmp1i, gvl); + } + + BLASLONG ci = n_top * ldc + m_top; + + vfloat64m2_t C0r = __riscv_vlse64_v_f64m2(&C[ci * 2 + 0], sizeof(FLOAT) * 2, gvl); + vfloat64m2_t C0i = __riscv_vlse64_v_f64m2(&C[ci * 2 + 1], sizeof(FLOAT) * 2, gvl); + ci += ldc - gvl * 0; + vfloat64m2_t C1r = __riscv_vlse64_v_f64m2(&C[ci * 2 + 0], sizeof(FLOAT) * 2, gvl); + vfloat64m2_t C1i = __riscv_vlse64_v_f64m2(&C[ci * 2 + 1], sizeof(FLOAT) * 2, gvl); + + C0r = __riscv_vfmacc(C0r, alphar, ACC0r, gvl); + C0i = __riscv_vfmacc(C0i, alphar, ACC0i, gvl); + C1r = __riscv_vfmacc(C1r, alphar, ACC1r, gvl); + C1i = __riscv_vfmacc(C1i, alphar, ACC1i, gvl); + C0r = __riscv_vfnmsac(C0r, alphai, ACC0i, gvl); + C0i = __riscv_vfmacc(C0i, alphai, ACC0r, gvl); + C1r = __riscv_vfnmsac(C1r, alphai, ACC1i, gvl); + C1i = __riscv_vfmacc(C1i, alphai, ACC1r, gvl); + + ci = n_top * ldc + m_top; + + __riscv_vsse64_v_f64m2(&C[ci * 2 + 0], sizeof(FLOAT) * 2, C0r, gvl); + __riscv_vsse64_v_f64m2(&C[ci * 2 + 1], sizeof(FLOAT) * 2, C0i, gvl); + ci += ldc - gvl * 0; + __riscv_vsse64_v_f64m2(&C[ci * 2 + 0], sizeof(FLOAT) * 2, C1r, gvl); + __riscv_vsse64_v_f64m2(&C[ci * 2 + 1], sizeof(FLOAT) * 2, C1i, gvl); + + m_top += 4; + } + + if (M & 2) { + double result0 = 0; + double result1 = 0; + double result2 = 0; + double result3 = 0; + double result4 = 0; + double result5 = 0; + double result6 = 0; + double result7 = 0; + BLASLONG ai = m_top * K * 2; + BLASLONG bi = n_top * K * 2; + + for (BLASLONG k = 0; k < K; k++) { + result0 += S0 * A[ai + 0 + 0] * B[bi + 0 + 0] + S1 * A[ai + 0 + 1] * B[bi + 0 + 1]; + result1 += S2 * A[ai + 0 + 1] * B[bi + 0 + 0] + S3 * A[ai + 0 + 0] * B[bi + 0 + 1]; + result2 += S0 * A[ai + 2 + 0] * B[bi + 0 + 0] + S1 * A[ai + 2 + 1] * B[bi + 0 + 1]; + result3 += S2 * A[ai + 2 + 1] * B[bi + 0 + 0] + S3 * A[ai + 2 + 0] * B[bi + 0 + 1]; + result4 += S0 * A[ai + 0 + 0] * B[bi + 2 + 0] + S1 * A[ai + 0 + 1] * B[bi + 2 + 1]; + result5 += S2 * A[ai + 0 + 1] * B[bi + 2 + 0] + S3 * A[ai + 0 + 0] * B[bi + 2 + 1]; + result6 += S0 * A[ai + 2 + 0] * B[bi + 2 + 0] + S1 * A[ai + 2 + 1] * B[bi + 2 + 1]; + result7 += S2 * A[ai + 2 + 1] * B[bi + 2 + 0] + S3 * A[ai + 2 + 0] * B[bi + 2 + 1]; + ai += 2 * 2; + bi += 2 * 2; + } + + BLASLONG ci = n_top * ldc + m_top; + double Cr, Ci; + Cr = C[(ci + 0 * ldc + 0) * 2 + 0]; + Ci = C[(ci + 0 * ldc + 0) * 2 + 1]; + Cr += result0 * alphar; + Ci += result1 * alphar; + Cr -= result1 * alphai; + Ci += result0 * alphai; + C[(ci + 0 * ldc + 0) * 2 + 0] = Cr; + C[(ci + 0 * ldc + 0) * 2 + 1] = Ci; + Cr = C[(ci + 0 * ldc + 1) * 2 + 0]; + Ci = C[(ci + 0 * ldc + 1) * 2 + 1]; + Cr += result2 * alphar; + Ci += result3 * alphar; + Cr -= result3 * alphai; + Ci += result2 * alphai; + C[(ci + 0 * ldc + 1) * 2 + 0] = Cr; + C[(ci + 0 * ldc + 1) * 2 + 1] = Ci; + Cr = C[(ci + 1 * ldc + 0) * 2 + 0]; + Ci = C[(ci + 1 * ldc + 0) * 2 + 1]; + Cr += result4 * alphar; + Ci += result5 * alphar; + Cr -= result5 * alphai; + Ci += result4 * alphai; + C[(ci + 1 * ldc + 0) * 2 + 0] = Cr; + C[(ci + 1 * ldc + 0) * 2 + 1] = Ci; + Cr = C[(ci + 1 * ldc + 1) * 2 + 0]; + Ci = C[(ci + 1 * ldc + 1) * 2 + 1]; + Cr += result6 * alphar; + Ci += result7 * alphar; + Cr -= result7 * alphai; + Ci += result6 * alphai; + C[(ci + 1 * ldc + 1) * 2 + 0] = Cr; + C[(ci + 1 * ldc + 1) * 2 + 1] = Ci; + m_top += 2; + } + + if (M & 1) { + double result0 = 0; + double result1 = 0; + double result2 = 0; + double result3 = 0; + BLASLONG ai = m_top * K * 2; + BLASLONG bi = n_top * K * 2; + + for (BLASLONG k = 0; k < K; k++) { + result0 += S0 * A[ai + 0 + 0] * B[bi + 0 + 0] + S1 * A[ai + 0 + 1] * B[bi + 0 + 1]; + result1 += S2 * A[ai + 0 + 1] * B[bi + 0 + 0] + S3 * A[ai + 0 + 0] * B[bi + 0 + 1]; + result2 += S0 * A[ai + 0 + 0] * B[bi + 2 + 0] + S1 * A[ai + 0 + 1] * B[bi + 2 + 1]; + result3 += S2 * A[ai + 0 + 1] * B[bi + 2 + 0] + S3 * A[ai + 0 + 0] * B[bi + 2 + 1]; + ai += 1 * 2; + bi += 2 * 2; + } + + BLASLONG ci = n_top * ldc + m_top; + double Cr, Ci; + Cr = C[(ci + 0 * ldc + 0) * 2 + 0]; + Ci = C[(ci + 0 * ldc + 0) * 2 + 1]; + Cr += result0 * alphar; + Ci += result1 * alphar; + Cr -= result1 * alphai; + Ci += result0 * alphai; + C[(ci + 0 * ldc + 0) * 2 + 0] = Cr; + C[(ci + 0 * ldc + 0) * 2 + 1] = Ci; + Cr = C[(ci + 1 * ldc + 0) * 2 + 0]; + Ci = C[(ci + 1 * ldc + 0) * 2 + 1]; + Cr += result2 * alphar; + Ci += result3 * alphar; + Cr -= result3 * alphai; + Ci += result2 * alphai; + C[(ci + 1 * ldc + 0) * 2 + 0] = Cr; + C[(ci + 1 * ldc + 0) * 2 + 1] = Ci; + m_top += 1; + } + + n_top += 2; + } + + // -- tails for N=1 + + if (N & 1) { + gvl = __riscv_vsetvl_e64m2(4); + m_top = 0; + + for (BLASLONG i = 0; i < M / 4; i += 1) { + BLASLONG ai = m_top * K * 2; + BLASLONG bi = n_top * K * 2; + double B0r = B[bi + 0 * 2 + 0]; + double B0i = B[bi + 0 * 2 + 1]; + bi += 1 * 2; + + vfloat64m2_t A0r = __riscv_vlse64_v_f64m2(&A[ai + 0 * gvl * 2], sizeof(FLOAT) * 2, gvl); + vfloat64m2_t A0i = __riscv_vlse64_v_f64m2(&A[ai + 0 * gvl * 2 + 1], sizeof(FLOAT) * 2, gvl); + ai += 4 * 2; + + // 2 vector regs to hold A array contents, 2 regs to hold values accumulated over k + // leaving 12 vector registers for temporaries + vfloat64m2_t tmp0r = __riscv_vfmul_vf_f64m2(A0i, B0i, gvl); + vfloat64m2_t tmp0i = __riscv_vfmul_vf_f64m2(A0r, B0i, gvl); + tmp0r = VFMACC_RR(tmp0r, B0r, A0r, gvl); + tmp0i = VFMACC_RI(tmp0i, B0r, A0i, gvl); + vfloat64m2_t ACC0r = tmp0r; + vfloat64m2_t ACC0i = tmp0i; + + for (BLASLONG k = 1; k < K; k++) { + B0r = B[bi + 0 * 2 + 0]; + B0i = B[bi + 0 * 2 + 1]; + bi += 1 * 2; + + A0r = __riscv_vlse64_v_f64m2(&A[ai + 0 * gvl * 2], sizeof(FLOAT) * 2, gvl); + A0i = __riscv_vlse64_v_f64m2(&A[ai + 0 * gvl * 2 + 1], sizeof(FLOAT) * 2, gvl); + ai += 4 * 2; + + tmp0r = __riscv_vfmul_vf_f64m2(A0i, B0i, gvl); + tmp0i = __riscv_vfmul_vf_f64m2(A0r, B0i, gvl); + tmp0r = VFMACC_RR(tmp0r, B0r, A0r, gvl); + tmp0i = VFMACC_RI(tmp0i, B0r, A0i, gvl); + ACC0r = __riscv_vfadd(ACC0r, tmp0r, gvl); + ACC0i = __riscv_vfadd(ACC0i, tmp0i, gvl); + } + + BLASLONG ci = n_top * ldc + m_top; + + vfloat64m2_t C0r = __riscv_vlse64_v_f64m2(&C[ci * 2 + 0], sizeof(FLOAT) * 2, gvl); + vfloat64m2_t C0i = __riscv_vlse64_v_f64m2(&C[ci * 2 + 1], sizeof(FLOAT) * 2, gvl); + + C0r = __riscv_vfmacc(C0r, alphar, ACC0r, gvl); + C0i = __riscv_vfmacc(C0i, alphar, ACC0i, gvl); + C0r = __riscv_vfnmsac(C0r, alphai, ACC0i, gvl); + C0i = __riscv_vfmacc(C0i, alphai, ACC0r, gvl); + + ci = n_top * ldc + m_top; + + __riscv_vsse64_v_f64m2(&C[ci * 2 + 0], sizeof(FLOAT) * 2, C0r, gvl); + __riscv_vsse64_v_f64m2(&C[ci * 2 + 1], sizeof(FLOAT) * 2, C0i, gvl); + + m_top += 4; + } + + if (M & 2) { + double result0 = 0; + double result1 = 0; + double result2 = 0; + double result3 = 0; + BLASLONG ai = m_top * K * 2; + BLASLONG bi = n_top * K * 2; + + for (BLASLONG k = 0; k < K; k++) { + result0 += S0 * A[ai + 0 + 0] * B[bi + 0 + 0] + S1 * A[ai + 0 + 1] * B[bi + 0 + 1]; + result1 += S2 * A[ai + 0 + 1] * B[bi + 0 + 0] + S3 * A[ai + 0 + 0] * B[bi + 0 + 1]; + result2 += S0 * A[ai + 2 + 0] * B[bi + 0 + 0] + S1 * A[ai + 2 + 1] * B[bi + 0 + 1]; + result3 += S2 * A[ai + 2 + 1] * B[bi + 0 + 0] + S3 * A[ai + 2 + 0] * B[bi + 0 + 1]; + ai += 2 * 2; + bi += 1 * 2; + } + + BLASLONG ci = n_top * ldc + m_top; + double Cr, Ci; + Cr = C[(ci + 0 * ldc + 0) * 2 + 0]; + Ci = C[(ci + 0 * ldc + 0) * 2 + 1]; + Cr += result0 * alphar; + Ci += result1 * alphar; + Cr -= result1 * alphai; + Ci += result0 * alphai; + C[(ci + 0 * ldc + 0) * 2 + 0] = Cr; + C[(ci + 0 * ldc + 0) * 2 + 1] = Ci; + Cr = C[(ci + 0 * ldc + 1) * 2 + 0]; + Ci = C[(ci + 0 * ldc + 1) * 2 + 1]; + Cr += result2 * alphar; + Ci += result3 * alphar; + Cr -= result3 * alphai; + Ci += result2 * alphai; + C[(ci + 0 * ldc + 1) * 2 + 0] = Cr; + C[(ci + 0 * ldc + 1) * 2 + 1] = Ci; + m_top += 2; + } + + if (M & 1) { + double result0 = 0; + double result1 = 0; + BLASLONG ai = m_top * K * 2; + BLASLONG bi = n_top * K * 2; + + for (BLASLONG k = 0; k < K; k++) { + result0 += S0 * A[ai + 0 + 0] * B[bi + 0 + 0] + S1 * A[ai + 0 + 1] * B[bi + 0 + 1]; + result1 += S2 * A[ai + 0 + 1] * B[bi + 0 + 0] + S3 * A[ai + 0 + 0] * B[bi + 0 + 1]; + ai += 1 * 2; + bi += 1 * 2; + } + + BLASLONG ci = n_top * ldc + m_top; + double Cr, Ci; + Cr = C[(ci + 0 * ldc + 0) * 2 + 0]; + Ci = C[(ci + 0 * ldc + 0) * 2 + 1]; + Cr += result0 * alphar; + Ci += result1 * alphar; + Cr -= result1 * alphai; + Ci += result0 * alphai; + C[(ci + 0 * ldc + 0) * 2 + 0] = Cr; + C[(ci + 0 * ldc + 0) * 2 + 1] = Ci; + m_top += 1; + } + + n_top += 1; + } + + return 0; +} diff --git a/kernel/riscv64/ztrmm_kernel_4x4_zvl128b.c b/kernel/riscv64/ztrmm_kernel_4x4_zvl128b.c new file mode 100644 index 000000000..d7d5e5fea --- /dev/null +++ b/kernel/riscv64/ztrmm_kernel_4x4_zvl128b.c @@ -0,0 +1,805 @@ +/* + +AUTOGENERATED KERNEL +Script: ./kernel/riscv64/generate_kernel.py +Settings: + LMUL=2 + M=4 + M_tail_scalar_from=2 + N=4 + __riscv_='__riscv_' + complex=True + conjugate=False + cpu='zvl128b' + force_acc_double=False + index_type='BLASLONG' + op='trmm' + param_precision='double' + reg_width_bits=128 + tail_policy='' + trace=False + +Derived: + ELEN_ACC=64 + ELEN_PARAM=64 + LMUL_ACC=2 + VFMACC='__riscv_vfmacc_vf_f64m2' + VFMUL='__riscv_vfmul_vf_f64m2' + VLEV='__riscv_vle64_v_f64m2' + VLSEV='__riscv_vlse64_v_f64m2' + VMACC_TO_ACC='__riscv_vfmacc_vf_f64m2' + VMUL_TO_ACC='__riscv_vfmul_vf_f64m2' + VSETVL='__riscv_vsetvl_e64m2' + VSEV='__riscv_vse64_v_f64m2' + VSSEV='__riscv_vsse64_v_f64m2' + acc_vector_t='vfloat64m2_t' + output='ztrmm_kernel_4x4_zvl128b.c' + param_scalar_t='double' + param_vector_t='vfloat64m2_t' + +*/ + +#include "common.h" + +#if defined(NN) || defined(NT) || defined(TN) || defined(TT) +#define S0 1 +#define S1 -1 +#define S2 1 +#define S3 1 +#define VFMACC_RR __riscv_vfmsac +#define VFMACC_RI __riscv_vfmacc +#endif +#if defined(NR) || defined(NC) || defined(TR) || defined(TC) +#define S0 1 +#define S1 1 +#define S2 1 +#define S3 -1 +#define VFMACC_RR __riscv_vfmacc +#define VFMACC_RI __riscv_vfmsac +#endif +#if defined(RN) || defined(RT) || defined(CN) || defined(CT) +#define S0 1 +#define S1 1 +#define S2 -1 +#define S3 1 +#define VFMACC_RR __riscv_vfmacc +#define VFMACC_RI __riscv_vfnmsac +#endif +#if defined(RR) || defined(RC) || defined(CR) || defined(CC) +#define S0 1 +#define S1 -1 +#define S2 -1 +#define S3 -1 +#define VFMACC_RR __riscv_vfmsac +#define VFMACC_RI __riscv_vfnmacc +#endif + +#if defined(LEFT) != defined(TRANSA) +#define BACKWARDS +#endif + +int CNAME(BLASLONG M, BLASLONG N, BLASLONG K, FLOAT alphar, FLOAT alphai, FLOAT *A, FLOAT *B, FLOAT *C, BLASLONG ldc, BLASLONG offset) + +{ + BLASLONG gvl = 0; + BLASLONG m_top = 0; + BLASLONG n_top = 0; + + // -- MAIN PASS + + for (BLASLONG j = 0; j < N / 4; j += 1) { + m_top = 0; + BLASLONG gvl = __riscv_vsetvl_e64m2(4); + + for (BLASLONG i = 0; i < M / 4; i += 1) { + BLASLONG ai = m_top * K * 2; + BLASLONG bi = n_top * K * 2; + BLASLONG pass_K = K; +#ifdef LEFT + BLASLONG off = offset + m_top; +#else + BLASLONG off = -offset + n_top; +#endif +#ifdef BACKWARDS + ai += off * 4 * 2; + bi += off * 4 * 2; + pass_K -= off; +#else +#ifdef LEFT + pass_K = off + 4; +#else + pass_K = off + 4; +#endif +#endif + double B0r = B[bi + 0 * 2 + 0]; + double B0i = B[bi + 0 * 2 + 1]; + double B1r = B[bi + 1 * 2 + 0]; + double B1i = B[bi + 1 * 2 + 1]; + double B2r = B[bi + 2 * 2 + 0]; + double B2i = B[bi + 2 * 2 + 1]; + double B3r = B[bi + 3 * 2 + 0]; + double B3i = B[bi + 3 * 2 + 1]; + bi += 4 * 2; + + vfloat64m2_t A0r = __riscv_vlse64_v_f64m2(&A[ai + 0 * gvl * 2], sizeof(FLOAT) * 2, gvl); + vfloat64m2_t A0i = __riscv_vlse64_v_f64m2(&A[ai + 0 * gvl * 2 + 1], sizeof(FLOAT) * 2, gvl); + ai += 4 * 2; + + // 2 vector regs to hold A array contents, 8 regs to hold values accumulated over k + // leaving 6 vector registers for temporaries + // performing 2 operations between reuses of temporaries + vfloat64m2_t tmp0r = __riscv_vfmul_vf_f64m2(A0i, B0i, gvl); + vfloat64m2_t tmp0i = __riscv_vfmul_vf_f64m2(A0r, B0i, gvl); + vfloat64m2_t tmp1r = __riscv_vfmul_vf_f64m2(A0i, B1i, gvl); + vfloat64m2_t tmp1i = __riscv_vfmul_vf_f64m2(A0r, B1i, gvl); + tmp0r = VFMACC_RR(tmp0r, B0r, A0r, gvl); + tmp0i = VFMACC_RI(tmp0i, B0r, A0i, gvl); + tmp1r = VFMACC_RR(tmp1r, B1r, A0r, gvl); + tmp1i = VFMACC_RI(tmp1i, B1r, A0i, gvl); + vfloat64m2_t ACC0r = tmp0r; + vfloat64m2_t ACC0i = tmp0i; + vfloat64m2_t ACC1r = tmp1r; + vfloat64m2_t ACC1i = tmp1i; + tmp0r = __riscv_vfmul_vf_f64m2(A0i, B2i, gvl); + tmp0i = __riscv_vfmul_vf_f64m2(A0r, B2i, gvl); + tmp1r = __riscv_vfmul_vf_f64m2(A0i, B3i, gvl); + tmp1i = __riscv_vfmul_vf_f64m2(A0r, B3i, gvl); + tmp0r = VFMACC_RR(tmp0r, B2r, A0r, gvl); + tmp0i = VFMACC_RI(tmp0i, B2r, A0i, gvl); + tmp1r = VFMACC_RR(tmp1r, B3r, A0r, gvl); + tmp1i = VFMACC_RI(tmp1i, B3r, A0i, gvl); + vfloat64m2_t ACC2r = tmp0r; + vfloat64m2_t ACC2i = tmp0i; + vfloat64m2_t ACC3r = tmp1r; + vfloat64m2_t ACC3i = tmp1i; + + for (BLASLONG k = 1; k < pass_K; k++) { + B0r = B[bi + 0 * 2 + 0]; + B0i = B[bi + 0 * 2 + 1]; + B1r = B[bi + 1 * 2 + 0]; + B1i = B[bi + 1 * 2 + 1]; + B2r = B[bi + 2 * 2 + 0]; + B2i = B[bi + 2 * 2 + 1]; + B3r = B[bi + 3 * 2 + 0]; + B3i = B[bi + 3 * 2 + 1]; + bi += 4 * 2; + + A0r = __riscv_vlse64_v_f64m2(&A[ai + 0 * gvl * 2], sizeof(FLOAT) * 2, gvl); + A0i = __riscv_vlse64_v_f64m2(&A[ai + 0 * gvl * 2 + 1], sizeof(FLOAT) * 2, gvl); + ai += 4 * 2; + + tmp0r = __riscv_vfmul_vf_f64m2(A0i, B0i, gvl); + tmp0i = __riscv_vfmul_vf_f64m2(A0r, B0i, gvl); + tmp1r = __riscv_vfmul_vf_f64m2(A0i, B1i, gvl); + tmp1i = __riscv_vfmul_vf_f64m2(A0r, B1i, gvl); + tmp0r = VFMACC_RR(tmp0r, B0r, A0r, gvl); + tmp0i = VFMACC_RI(tmp0i, B0r, A0i, gvl); + tmp1r = VFMACC_RR(tmp1r, B1r, A0r, gvl); + tmp1i = VFMACC_RI(tmp1i, B1r, A0i, gvl); + ACC0r = __riscv_vfadd(ACC0r, tmp0r, gvl); + ACC0i = __riscv_vfadd(ACC0i, tmp0i, gvl); + ACC1r = __riscv_vfadd(ACC1r, tmp1r, gvl); + ACC1i = __riscv_vfadd(ACC1i, tmp1i, gvl); + tmp0r = __riscv_vfmul_vf_f64m2(A0i, B2i, gvl); + tmp0i = __riscv_vfmul_vf_f64m2(A0r, B2i, gvl); + tmp1r = __riscv_vfmul_vf_f64m2(A0i, B3i, gvl); + tmp1i = __riscv_vfmul_vf_f64m2(A0r, B3i, gvl); + tmp0r = VFMACC_RR(tmp0r, B2r, A0r, gvl); + tmp0i = VFMACC_RI(tmp0i, B2r, A0i, gvl); + tmp1r = VFMACC_RR(tmp1r, B3r, A0r, gvl); + tmp1i = VFMACC_RI(tmp1i, B3r, A0i, gvl); + ACC2r = __riscv_vfadd(ACC2r, tmp0r, gvl); + ACC2i = __riscv_vfadd(ACC2i, tmp0i, gvl); + ACC3r = __riscv_vfadd(ACC3r, tmp1r, gvl); + ACC3i = __riscv_vfadd(ACC3i, tmp1i, gvl); + } + + BLASLONG ci = n_top * ldc + m_top; + + vfloat64m2_t C0r = __riscv_vfmul(ACC0r, alphar, gvl); + vfloat64m2_t C0i = __riscv_vfmul(ACC0i, alphar, gvl); + vfloat64m2_t C1r = __riscv_vfmul(ACC1r, alphar, gvl); + vfloat64m2_t C1i = __riscv_vfmul(ACC1i, alphar, gvl); + vfloat64m2_t C2r = __riscv_vfmul(ACC2r, alphar, gvl); + vfloat64m2_t C2i = __riscv_vfmul(ACC2i, alphar, gvl); + vfloat64m2_t C3r = __riscv_vfmul(ACC3r, alphar, gvl); + vfloat64m2_t C3i = __riscv_vfmul(ACC3i, alphar, gvl); + C0r = __riscv_vfnmsac(C0r, alphai, ACC0i, gvl); + C0i = __riscv_vfmacc(C0i, alphai, ACC0r, gvl); + C1r = __riscv_vfnmsac(C1r, alphai, ACC1i, gvl); + C1i = __riscv_vfmacc(C1i, alphai, ACC1r, gvl); + C2r = __riscv_vfnmsac(C2r, alphai, ACC2i, gvl); + C2i = __riscv_vfmacc(C2i, alphai, ACC2r, gvl); + C3r = __riscv_vfnmsac(C3r, alphai, ACC3i, gvl); + C3i = __riscv_vfmacc(C3i, alphai, ACC3r, gvl); + __riscv_vsse64_v_f64m2(&C[ci * 2 + 0], sizeof(FLOAT) * 2, C0r, gvl); + __riscv_vsse64_v_f64m2(&C[ci * 2 + 1], sizeof(FLOAT) * 2, C0i, gvl); + ci += ldc - gvl * 0; + __riscv_vsse64_v_f64m2(&C[ci * 2 + 0], sizeof(FLOAT) * 2, C1r, gvl); + __riscv_vsse64_v_f64m2(&C[ci * 2 + 1], sizeof(FLOAT) * 2, C1i, gvl); + ci += ldc - gvl * 0; + __riscv_vsse64_v_f64m2(&C[ci * 2 + 0], sizeof(FLOAT) * 2, C2r, gvl); + __riscv_vsse64_v_f64m2(&C[ci * 2 + 1], sizeof(FLOAT) * 2, C2i, gvl); + ci += ldc - gvl * 0; + __riscv_vsse64_v_f64m2(&C[ci * 2 + 0], sizeof(FLOAT) * 2, C3r, gvl); + __riscv_vsse64_v_f64m2(&C[ci * 2 + 1], sizeof(FLOAT) * 2, C3i, gvl); + + m_top += 4; + } + + // -- tails for main pass + + if (M & 2) { + double result0 = 0; + double result1 = 0; + double result2 = 0; + double result3 = 0; + double result4 = 0; + double result5 = 0; + double result6 = 0; + double result7 = 0; + double result8 = 0; + double result9 = 0; + double result10 = 0; + double result11 = 0; + double result12 = 0; + double result13 = 0; + double result14 = 0; + double result15 = 0; + BLASLONG ai = m_top * K * 2; + BLASLONG bi = n_top * K * 2; + BLASLONG pass_K = K; +#ifdef LEFT + BLASLONG off = offset + m_top; +#else + BLASLONG off = -offset + n_top; +#endif +#ifdef BACKWARDS + ai += off * 2 * 2; + bi += off * 4 * 2; + pass_K -= off; +#else +#ifdef LEFT + pass_K = off + 2; +#else + pass_K = off + 4; +#endif +#endif + + for (BLASLONG k = 0; k < pass_K; k++) { + result0 += S0 * A[ai + 0 + 0] * B[bi + 0 + 0] + S1 * A[ai + 0 + 1] * B[bi + 0 + 1]; + result1 += S2 * A[ai + 0 + 1] * B[bi + 0 + 0] + S3 * A[ai + 0 + 0] * B[bi + 0 + 1]; + result2 += S0 * A[ai + 2 + 0] * B[bi + 0 + 0] + S1 * A[ai + 2 + 1] * B[bi + 0 + 1]; + result3 += S2 * A[ai + 2 + 1] * B[bi + 0 + 0] + S3 * A[ai + 2 + 0] * B[bi + 0 + 1]; + result4 += S0 * A[ai + 0 + 0] * B[bi + 2 + 0] + S1 * A[ai + 0 + 1] * B[bi + 2 + 1]; + result5 += S2 * A[ai + 0 + 1] * B[bi + 2 + 0] + S3 * A[ai + 0 + 0] * B[bi + 2 + 1]; + result6 += S0 * A[ai + 2 + 0] * B[bi + 2 + 0] + S1 * A[ai + 2 + 1] * B[bi + 2 + 1]; + result7 += S2 * A[ai + 2 + 1] * B[bi + 2 + 0] + S3 * A[ai + 2 + 0] * B[bi + 2 + 1]; + result8 += S0 * A[ai + 0 + 0] * B[bi + 4 + 0] + S1 * A[ai + 0 + 1] * B[bi + 4 + 1]; + result9 += S2 * A[ai + 0 + 1] * B[bi + 4 + 0] + S3 * A[ai + 0 + 0] * B[bi + 4 + 1]; + result10 += S0 * A[ai + 2 + 0] * B[bi + 4 + 0] + S1 * A[ai + 2 + 1] * B[bi + 4 + 1]; + result11 += S2 * A[ai + 2 + 1] * B[bi + 4 + 0] + S3 * A[ai + 2 + 0] * B[bi + 4 + 1]; + result12 += S0 * A[ai + 0 + 0] * B[bi + 6 + 0] + S1 * A[ai + 0 + 1] * B[bi + 6 + 1]; + result13 += S2 * A[ai + 0 + 1] * B[bi + 6 + 0] + S3 * A[ai + 0 + 0] * B[bi + 6 + 1]; + result14 += S0 * A[ai + 2 + 0] * B[bi + 6 + 0] + S1 * A[ai + 2 + 1] * B[bi + 6 + 1]; + result15 += S2 * A[ai + 2 + 1] * B[bi + 6 + 0] + S3 * A[ai + 2 + 0] * B[bi + 6 + 1]; + ai += 2 * 2; + bi += 4 * 2; + } + + BLASLONG ci = n_top * ldc + m_top; + double Cr, Ci; + Cr = result0 * alphar; + Ci = result1 * alphar; + Cr -= result1 * alphai; + Ci += result0 * alphai; + C[(ci + 0 * ldc + 0) * 2 + 0] = Cr; + C[(ci + 0 * ldc + 0) * 2 + 1] = Ci; + Cr = result2 * alphar; + Ci = result3 * alphar; + Cr -= result3 * alphai; + Ci += result2 * alphai; + C[(ci + 0 * ldc + 1) * 2 + 0] = Cr; + C[(ci + 0 * ldc + 1) * 2 + 1] = Ci; + Cr = result4 * alphar; + Ci = result5 * alphar; + Cr -= result5 * alphai; + Ci += result4 * alphai; + C[(ci + 1 * ldc + 0) * 2 + 0] = Cr; + C[(ci + 1 * ldc + 0) * 2 + 1] = Ci; + Cr = result6 * alphar; + Ci = result7 * alphar; + Cr -= result7 * alphai; + Ci += result6 * alphai; + C[(ci + 1 * ldc + 1) * 2 + 0] = Cr; + C[(ci + 1 * ldc + 1) * 2 + 1] = Ci; + Cr = result8 * alphar; + Ci = result9 * alphar; + Cr -= result9 * alphai; + Ci += result8 * alphai; + C[(ci + 2 * ldc + 0) * 2 + 0] = Cr; + C[(ci + 2 * ldc + 0) * 2 + 1] = Ci; + Cr = result10 * alphar; + Ci = result11 * alphar; + Cr -= result11 * alphai; + Ci += result10 * alphai; + C[(ci + 2 * ldc + 1) * 2 + 0] = Cr; + C[(ci + 2 * ldc + 1) * 2 + 1] = Ci; + Cr = result12 * alphar; + Ci = result13 * alphar; + Cr -= result13 * alphai; + Ci += result12 * alphai; + C[(ci + 3 * ldc + 0) * 2 + 0] = Cr; + C[(ci + 3 * ldc + 0) * 2 + 1] = Ci; + Cr = result14 * alphar; + Ci = result15 * alphar; + Cr -= result15 * alphai; + Ci += result14 * alphai; + C[(ci + 3 * ldc + 1) * 2 + 0] = Cr; + C[(ci + 3 * ldc + 1) * 2 + 1] = Ci; + m_top += 2; + } + + if (M & 1) { + double result0 = 0; + double result1 = 0; + double result2 = 0; + double result3 = 0; + double result4 = 0; + double result5 = 0; + double result6 = 0; + double result7 = 0; + BLASLONG ai = m_top * K * 2; + BLASLONG bi = n_top * K * 2; + BLASLONG pass_K = K; +#ifdef LEFT + BLASLONG off = offset + m_top; +#else + BLASLONG off = -offset + n_top; +#endif +#ifdef BACKWARDS + ai += off * 1 * 2; + bi += off * 4 * 2; + pass_K -= off; +#else +#ifdef LEFT + pass_K = off + 1; +#else + pass_K = off + 4; +#endif +#endif + + for (BLASLONG k = 0; k < pass_K; k++) { + result0 += S0 * A[ai + 0 + 0] * B[bi + 0 + 0] + S1 * A[ai + 0 + 1] * B[bi + 0 + 1]; + result1 += S2 * A[ai + 0 + 1] * B[bi + 0 + 0] + S3 * A[ai + 0 + 0] * B[bi + 0 + 1]; + result2 += S0 * A[ai + 0 + 0] * B[bi + 2 + 0] + S1 * A[ai + 0 + 1] * B[bi + 2 + 1]; + result3 += S2 * A[ai + 0 + 1] * B[bi + 2 + 0] + S3 * A[ai + 0 + 0] * B[bi + 2 + 1]; + result4 += S0 * A[ai + 0 + 0] * B[bi + 4 + 0] + S1 * A[ai + 0 + 1] * B[bi + 4 + 1]; + result5 += S2 * A[ai + 0 + 1] * B[bi + 4 + 0] + S3 * A[ai + 0 + 0] * B[bi + 4 + 1]; + result6 += S0 * A[ai + 0 + 0] * B[bi + 6 + 0] + S1 * A[ai + 0 + 1] * B[bi + 6 + 1]; + result7 += S2 * A[ai + 0 + 1] * B[bi + 6 + 0] + S3 * A[ai + 0 + 0] * B[bi + 6 + 1]; + ai += 1 * 2; + bi += 4 * 2; + } + + BLASLONG ci = n_top * ldc + m_top; + double Cr, Ci; + Cr = result0 * alphar; + Ci = result1 * alphar; + Cr -= result1 * alphai; + Ci += result0 * alphai; + C[(ci + 0 * ldc + 0) * 2 + 0] = Cr; + C[(ci + 0 * ldc + 0) * 2 + 1] = Ci; + Cr = result2 * alphar; + Ci = result3 * alphar; + Cr -= result3 * alphai; + Ci += result2 * alphai; + C[(ci + 1 * ldc + 0) * 2 + 0] = Cr; + C[(ci + 1 * ldc + 0) * 2 + 1] = Ci; + Cr = result4 * alphar; + Ci = result5 * alphar; + Cr -= result5 * alphai; + Ci += result4 * alphai; + C[(ci + 2 * ldc + 0) * 2 + 0] = Cr; + C[(ci + 2 * ldc + 0) * 2 + 1] = Ci; + Cr = result6 * alphar; + Ci = result7 * alphar; + Cr -= result7 * alphai; + Ci += result6 * alphai; + C[(ci + 3 * ldc + 0) * 2 + 0] = Cr; + C[(ci + 3 * ldc + 0) * 2 + 1] = Ci; + m_top += 1; + } + + n_top += 4; + } + + // -- tails for N=2 + + if (N & 2) { + gvl = __riscv_vsetvl_e64m2(4); + m_top = 0; + + for (BLASLONG i = 0; i < M / 4; i += 1) { + BLASLONG ai = m_top * K * 2; + BLASLONG bi = n_top * K * 2; + BLASLONG pass_K = K; +#ifdef LEFT + BLASLONG off = offset + m_top; +#else + BLASLONG off = -offset + n_top; +#endif +#ifdef BACKWARDS + ai += off * 4 * 2; + bi += off * 2 * 2; + pass_K -= off; +#else +#ifdef LEFT + pass_K = off + 4; +#else + pass_K = off + 2; +#endif +#endif + double B0r = B[bi + 0 * 2 + 0]; + double B0i = B[bi + 0 * 2 + 1]; + double B1r = B[bi + 1 * 2 + 0]; + double B1i = B[bi + 1 * 2 + 1]; + bi += 2 * 2; + + vfloat64m2_t A0r = __riscv_vlse64_v_f64m2(&A[ai + 0 * gvl * 2], sizeof(FLOAT) * 2, gvl); + vfloat64m2_t A0i = __riscv_vlse64_v_f64m2(&A[ai + 0 * gvl * 2 + 1], sizeof(FLOAT) * 2, gvl); + ai += 4 * 2; + + // 2 vector regs to hold A array contents, 4 regs to hold values accumulated over k + // leaving 10 vector registers for temporaries + vfloat64m2_t tmp0r = __riscv_vfmul_vf_f64m2(A0i, B0i, gvl); + vfloat64m2_t tmp0i = __riscv_vfmul_vf_f64m2(A0r, B0i, gvl); + vfloat64m2_t tmp1r = __riscv_vfmul_vf_f64m2(A0i, B1i, gvl); + vfloat64m2_t tmp1i = __riscv_vfmul_vf_f64m2(A0r, B1i, gvl); + tmp0r = VFMACC_RR(tmp0r, B0r, A0r, gvl); + tmp0i = VFMACC_RI(tmp0i, B0r, A0i, gvl); + tmp1r = VFMACC_RR(tmp1r, B1r, A0r, gvl); + tmp1i = VFMACC_RI(tmp1i, B1r, A0i, gvl); + vfloat64m2_t ACC0r = tmp0r; + vfloat64m2_t ACC0i = tmp0i; + vfloat64m2_t ACC1r = tmp1r; + vfloat64m2_t ACC1i = tmp1i; + + for (BLASLONG k = 1; k < pass_K; k++) { + B0r = B[bi + 0 * 2 + 0]; + B0i = B[bi + 0 * 2 + 1]; + B1r = B[bi + 1 * 2 + 0]; + B1i = B[bi + 1 * 2 + 1]; + bi += 2 * 2; + + A0r = __riscv_vlse64_v_f64m2(&A[ai + 0 * gvl * 2], sizeof(FLOAT) * 2, gvl); + A0i = __riscv_vlse64_v_f64m2(&A[ai + 0 * gvl * 2 + 1], sizeof(FLOAT) * 2, gvl); + ai += 4 * 2; + + tmp0r = __riscv_vfmul_vf_f64m2(A0i, B0i, gvl); + tmp0i = __riscv_vfmul_vf_f64m2(A0r, B0i, gvl); + tmp1r = __riscv_vfmul_vf_f64m2(A0i, B1i, gvl); + tmp1i = __riscv_vfmul_vf_f64m2(A0r, B1i, gvl); + tmp0r = VFMACC_RR(tmp0r, B0r, A0r, gvl); + tmp0i = VFMACC_RI(tmp0i, B0r, A0i, gvl); + tmp1r = VFMACC_RR(tmp1r, B1r, A0r, gvl); + tmp1i = VFMACC_RI(tmp1i, B1r, A0i, gvl); + ACC0r = __riscv_vfadd(ACC0r, tmp0r, gvl); + ACC0i = __riscv_vfadd(ACC0i, tmp0i, gvl); + ACC1r = __riscv_vfadd(ACC1r, tmp1r, gvl); + ACC1i = __riscv_vfadd(ACC1i, tmp1i, gvl); + } + + BLASLONG ci = n_top * ldc + m_top; + + vfloat64m2_t C0r = __riscv_vfmul(ACC0r, alphar, gvl); + vfloat64m2_t C0i = __riscv_vfmul(ACC0i, alphar, gvl); + vfloat64m2_t C1r = __riscv_vfmul(ACC1r, alphar, gvl); + vfloat64m2_t C1i = __riscv_vfmul(ACC1i, alphar, gvl); + C0r = __riscv_vfnmsac(C0r, alphai, ACC0i, gvl); + C0i = __riscv_vfmacc(C0i, alphai, ACC0r, gvl); + C1r = __riscv_vfnmsac(C1r, alphai, ACC1i, gvl); + C1i = __riscv_vfmacc(C1i, alphai, ACC1r, gvl); + __riscv_vsse64_v_f64m2(&C[ci * 2 + 0], sizeof(FLOAT) * 2, C0r, gvl); + __riscv_vsse64_v_f64m2(&C[ci * 2 + 1], sizeof(FLOAT) * 2, C0i, gvl); + ci += ldc - gvl * 0; + __riscv_vsse64_v_f64m2(&C[ci * 2 + 0], sizeof(FLOAT) * 2, C1r, gvl); + __riscv_vsse64_v_f64m2(&C[ci * 2 + 1], sizeof(FLOAT) * 2, C1i, gvl); + + m_top += 4; + } + + if (M & 2) { + double result0 = 0; + double result1 = 0; + double result2 = 0; + double result3 = 0; + double result4 = 0; + double result5 = 0; + double result6 = 0; + double result7 = 0; + BLASLONG ai = m_top * K * 2; + BLASLONG bi = n_top * K * 2; + BLASLONG pass_K = K; +#ifdef LEFT + BLASLONG off = offset + m_top; +#else + BLASLONG off = -offset + n_top; +#endif +#ifdef BACKWARDS + ai += off * 2 * 2; + bi += off * 2 * 2; + pass_K -= off; +#else +#ifdef LEFT + pass_K = off + 2; +#else + pass_K = off + 2; +#endif +#endif + + for (BLASLONG k = 0; k < pass_K; k++) { + result0 += S0 * A[ai + 0 + 0] * B[bi + 0 + 0] + S1 * A[ai + 0 + 1] * B[bi + 0 + 1]; + result1 += S2 * A[ai + 0 + 1] * B[bi + 0 + 0] + S3 * A[ai + 0 + 0] * B[bi + 0 + 1]; + result2 += S0 * A[ai + 2 + 0] * B[bi + 0 + 0] + S1 * A[ai + 2 + 1] * B[bi + 0 + 1]; + result3 += S2 * A[ai + 2 + 1] * B[bi + 0 + 0] + S3 * A[ai + 2 + 0] * B[bi + 0 + 1]; + result4 += S0 * A[ai + 0 + 0] * B[bi + 2 + 0] + S1 * A[ai + 0 + 1] * B[bi + 2 + 1]; + result5 += S2 * A[ai + 0 + 1] * B[bi + 2 + 0] + S3 * A[ai + 0 + 0] * B[bi + 2 + 1]; + result6 += S0 * A[ai + 2 + 0] * B[bi + 2 + 0] + S1 * A[ai + 2 + 1] * B[bi + 2 + 1]; + result7 += S2 * A[ai + 2 + 1] * B[bi + 2 + 0] + S3 * A[ai + 2 + 0] * B[bi + 2 + 1]; + ai += 2 * 2; + bi += 2 * 2; + } + + BLASLONG ci = n_top * ldc + m_top; + double Cr, Ci; + Cr = result0 * alphar; + Ci = result1 * alphar; + Cr -= result1 * alphai; + Ci += result0 * alphai; + C[(ci + 0 * ldc + 0) * 2 + 0] = Cr; + C[(ci + 0 * ldc + 0) * 2 + 1] = Ci; + Cr = result2 * alphar; + Ci = result3 * alphar; + Cr -= result3 * alphai; + Ci += result2 * alphai; + C[(ci + 0 * ldc + 1) * 2 + 0] = Cr; + C[(ci + 0 * ldc + 1) * 2 + 1] = Ci; + Cr = result4 * alphar; + Ci = result5 * alphar; + Cr -= result5 * alphai; + Ci += result4 * alphai; + C[(ci + 1 * ldc + 0) * 2 + 0] = Cr; + C[(ci + 1 * ldc + 0) * 2 + 1] = Ci; + Cr = result6 * alphar; + Ci = result7 * alphar; + Cr -= result7 * alphai; + Ci += result6 * alphai; + C[(ci + 1 * ldc + 1) * 2 + 0] = Cr; + C[(ci + 1 * ldc + 1) * 2 + 1] = Ci; + m_top += 2; + } + + if (M & 1) { + double result0 = 0; + double result1 = 0; + double result2 = 0; + double result3 = 0; + BLASLONG ai = m_top * K * 2; + BLASLONG bi = n_top * K * 2; + BLASLONG pass_K = K; +#ifdef LEFT + BLASLONG off = offset + m_top; +#else + BLASLONG off = -offset + n_top; +#endif +#ifdef BACKWARDS + ai += off * 1 * 2; + bi += off * 2 * 2; + pass_K -= off; +#else +#ifdef LEFT + pass_K = off + 1; +#else + pass_K = off + 2; +#endif +#endif + + for (BLASLONG k = 0; k < pass_K; k++) { + result0 += S0 * A[ai + 0 + 0] * B[bi + 0 + 0] + S1 * A[ai + 0 + 1] * B[bi + 0 + 1]; + result1 += S2 * A[ai + 0 + 1] * B[bi + 0 + 0] + S3 * A[ai + 0 + 0] * B[bi + 0 + 1]; + result2 += S0 * A[ai + 0 + 0] * B[bi + 2 + 0] + S1 * A[ai + 0 + 1] * B[bi + 2 + 1]; + result3 += S2 * A[ai + 0 + 1] * B[bi + 2 + 0] + S3 * A[ai + 0 + 0] * B[bi + 2 + 1]; + ai += 1 * 2; + bi += 2 * 2; + } + + BLASLONG ci = n_top * ldc + m_top; + double Cr, Ci; + Cr = result0 * alphar; + Ci = result1 * alphar; + Cr -= result1 * alphai; + Ci += result0 * alphai; + C[(ci + 0 * ldc + 0) * 2 + 0] = Cr; + C[(ci + 0 * ldc + 0) * 2 + 1] = Ci; + Cr = result2 * alphar; + Ci = result3 * alphar; + Cr -= result3 * alphai; + Ci += result2 * alphai; + C[(ci + 1 * ldc + 0) * 2 + 0] = Cr; + C[(ci + 1 * ldc + 0) * 2 + 1] = Ci; + m_top += 1; + } + + n_top += 2; + } + + // -- tails for N=1 + + if (N & 1) { + gvl = __riscv_vsetvl_e64m2(4); + m_top = 0; + + for (BLASLONG i = 0; i < M / 4; i += 1) { + BLASLONG ai = m_top * K * 2; + BLASLONG bi = n_top * K * 2; + BLASLONG pass_K = K; +#ifdef LEFT + BLASLONG off = offset + m_top; +#else + BLASLONG off = -offset + n_top; +#endif +#ifdef BACKWARDS + ai += off * 4 * 2; + bi += off * 1 * 2; + pass_K -= off; +#else +#ifdef LEFT + pass_K = off + 4; +#else + pass_K = off + 1; +#endif +#endif + double B0r = B[bi + 0 * 2 + 0]; + double B0i = B[bi + 0 * 2 + 1]; + bi += 1 * 2; + + vfloat64m2_t A0r = __riscv_vlse64_v_f64m2(&A[ai + 0 * gvl * 2], sizeof(FLOAT) * 2, gvl); + vfloat64m2_t A0i = __riscv_vlse64_v_f64m2(&A[ai + 0 * gvl * 2 + 1], sizeof(FLOAT) * 2, gvl); + ai += 4 * 2; + + // 2 vector regs to hold A array contents, 2 regs to hold values accumulated over k + // leaving 12 vector registers for temporaries + vfloat64m2_t tmp0r = __riscv_vfmul_vf_f64m2(A0i, B0i, gvl); + vfloat64m2_t tmp0i = __riscv_vfmul_vf_f64m2(A0r, B0i, gvl); + tmp0r = VFMACC_RR(tmp0r, B0r, A0r, gvl); + tmp0i = VFMACC_RI(tmp0i, B0r, A0i, gvl); + vfloat64m2_t ACC0r = tmp0r; + vfloat64m2_t ACC0i = tmp0i; + + for (BLASLONG k = 1; k < pass_K; k++) { + B0r = B[bi + 0 * 2 + 0]; + B0i = B[bi + 0 * 2 + 1]; + bi += 1 * 2; + + A0r = __riscv_vlse64_v_f64m2(&A[ai + 0 * gvl * 2], sizeof(FLOAT) * 2, gvl); + A0i = __riscv_vlse64_v_f64m2(&A[ai + 0 * gvl * 2 + 1], sizeof(FLOAT) * 2, gvl); + ai += 4 * 2; + + tmp0r = __riscv_vfmul_vf_f64m2(A0i, B0i, gvl); + tmp0i = __riscv_vfmul_vf_f64m2(A0r, B0i, gvl); + tmp0r = VFMACC_RR(tmp0r, B0r, A0r, gvl); + tmp0i = VFMACC_RI(tmp0i, B0r, A0i, gvl); + ACC0r = __riscv_vfadd(ACC0r, tmp0r, gvl); + ACC0i = __riscv_vfadd(ACC0i, tmp0i, gvl); + } + + BLASLONG ci = n_top * ldc + m_top; + + vfloat64m2_t C0r = __riscv_vfmul(ACC0r, alphar, gvl); + vfloat64m2_t C0i = __riscv_vfmul(ACC0i, alphar, gvl); + C0r = __riscv_vfnmsac(C0r, alphai, ACC0i, gvl); + C0i = __riscv_vfmacc(C0i, alphai, ACC0r, gvl); + __riscv_vsse64_v_f64m2(&C[ci * 2 + 0], sizeof(FLOAT) * 2, C0r, gvl); + __riscv_vsse64_v_f64m2(&C[ci * 2 + 1], sizeof(FLOAT) * 2, C0i, gvl); + + m_top += 4; + } + + if (M & 2) { + double result0 = 0; + double result1 = 0; + double result2 = 0; + double result3 = 0; + BLASLONG ai = m_top * K * 2; + BLASLONG bi = n_top * K * 2; + BLASLONG pass_K = K; +#ifdef LEFT + BLASLONG off = offset + m_top; +#else + BLASLONG off = -offset + n_top; +#endif +#ifdef BACKWARDS + ai += off * 2 * 2; + bi += off * 1 * 2; + pass_K -= off; +#else +#ifdef LEFT + pass_K = off + 2; +#else + pass_K = off + 1; +#endif +#endif + + for (BLASLONG k = 0; k < pass_K; k++) { + result0 += S0 * A[ai + 0 + 0] * B[bi + 0 + 0] + S1 * A[ai + 0 + 1] * B[bi + 0 + 1]; + result1 += S2 * A[ai + 0 + 1] * B[bi + 0 + 0] + S3 * A[ai + 0 + 0] * B[bi + 0 + 1]; + result2 += S0 * A[ai + 2 + 0] * B[bi + 0 + 0] + S1 * A[ai + 2 + 1] * B[bi + 0 + 1]; + result3 += S2 * A[ai + 2 + 1] * B[bi + 0 + 0] + S3 * A[ai + 2 + 0] * B[bi + 0 + 1]; + ai += 2 * 2; + bi += 1 * 2; + } + + BLASLONG ci = n_top * ldc + m_top; + double Cr, Ci; + Cr = result0 * alphar; + Ci = result1 * alphar; + Cr -= result1 * alphai; + Ci += result0 * alphai; + C[(ci + 0 * ldc + 0) * 2 + 0] = Cr; + C[(ci + 0 * ldc + 0) * 2 + 1] = Ci; + Cr = result2 * alphar; + Ci = result3 * alphar; + Cr -= result3 * alphai; + Ci += result2 * alphai; + C[(ci + 0 * ldc + 1) * 2 + 0] = Cr; + C[(ci + 0 * ldc + 1) * 2 + 1] = Ci; + m_top += 2; + } + + if (M & 1) { + double result0 = 0; + double result1 = 0; + BLASLONG ai = m_top * K * 2; + BLASLONG bi = n_top * K * 2; + BLASLONG pass_K = K; +#ifdef LEFT + BLASLONG off = offset + m_top; +#else + BLASLONG off = -offset + n_top; +#endif +#ifdef BACKWARDS + ai += off * 1 * 2; + bi += off * 1 * 2; + pass_K -= off; +#else +#ifdef LEFT + pass_K = off + 1; +#else + pass_K = off + 1; +#endif +#endif + + for (BLASLONG k = 0; k < pass_K; k++) { + result0 += S0 * A[ai + 0 + 0] * B[bi + 0 + 0] + S1 * A[ai + 0 + 1] * B[bi + 0 + 1]; + result1 += S2 * A[ai + 0 + 1] * B[bi + 0 + 0] + S3 * A[ai + 0 + 0] * B[bi + 0 + 1]; + ai += 1 * 2; + bi += 1 * 2; + } + + BLASLONG ci = n_top * ldc + m_top; + double Cr, Ci; + Cr = result0 * alphar; + Ci = result1 * alphar; + Cr -= result1 * alphai; + Ci += result0 * alphai; + C[(ci + 0 * ldc + 0) * 2 + 0] = Cr; + C[(ci + 0 * ldc + 0) * 2 + 1] = Ci; + m_top += 1; + } + + n_top += 1; + } + + return 0; +} diff --git a/param.h b/param.h index c5c70b78e..a1a70400c 100644 --- a/param.h +++ b/param.h @@ -3123,6 +3123,45 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #endif +#ifdef RISCV64_ZVL128B +#define GEMM_DEFAULT_OFFSET_A 0 +#define GEMM_DEFAULT_OFFSET_B 0 +#define GEMM_DEFAULT_ALIGN (BLASLONG)0x03fffUL + +#define SGEMM_DEFAULT_UNROLL_M 8 +#define SGEMM_DEFAULT_UNROLL_N 8 + +#define DGEMM_DEFAULT_UNROLL_M 8 +#define DGEMM_DEFAULT_UNROLL_N 4 + +#define CGEMM_DEFAULT_UNROLL_M 8 +#define CGEMM_DEFAULT_UNROLL_N 4 + +#define ZGEMM_DEFAULT_UNROLL_M 4 +#define ZGEMM_DEFAULT_UNROLL_N 4 + +#define SGEMM_DEFAULT_P 128 +#define DGEMM_DEFAULT_P 128 +#define CGEMM_DEFAULT_P 96 +#define ZGEMM_DEFAULT_P 64 + +#define SGEMM_DEFAULT_Q 240 +#define DGEMM_DEFAULT_Q 120 +#define CGEMM_DEFAULT_Q 120 +#define ZGEMM_DEFAULT_Q 120 + +#define SGEMM_DEFAULT_R 12288 +#define DGEMM_DEFAULT_R 8192 +#define CGEMM_DEFAULT_R 4096 +#define ZGEMM_DEFAULT_R 4096 + +#define SYMV_P 16 + +#define GEMM_DEFAULT_OFFSET_A 0 +#define GEMM_DEFAULT_OFFSET_B 0 + +#endif + #ifdef RISCV64_ZVL256B #define GEMM_DEFAULT_OFFSET_A 0 #define GEMM_DEFAULT_OFFSET_B 0 From 4a12cf53ec116c06e5d74073b54a3bca6046cb17 Mon Sep 17 00:00:00 2001 From: Octavian Maghiar Date: Mon, 4 Dec 2023 11:13:35 +0000 Subject: [PATCH 023/311] [RISC-V] Improve RVV kernel generator LMUL usage The RVV kernel generation script uses the provided LMUL to increase the number of accumulator registers. Since the effect of the LMUL is to group together the vector registers into larger ones, it actually should be used as a multiplier in the calculation of vlenmax. At the moment, no matter what LMUL is provided, the generated kernels would only set the maximum number of vector elements equal to VLEN/SEW. Commit changes the use of LMUL to properly adjust vlenmax. Note that an increase in LMUL results in a decrease in the number of effective vector registers. --- kernel/riscv64/generate_kernel.py | 23 +++++++++++++---------- 1 file changed, 13 insertions(+), 10 deletions(-) diff --git a/kernel/riscv64/generate_kernel.py b/kernel/riscv64/generate_kernel.py index e2ce97971..8be7c9f9c 100755 --- a/kernel/riscv64/generate_kernel.py +++ b/kernel/riscv64/generate_kernel.py @@ -197,13 +197,13 @@ def generate_gemm_kernel_inner_complex( settings, dest, M, N, vlen, a_regs ): dest.write("ai += {M}*2;") dest.write() - - accumulation_regs = a_regs * N * settings['LMUL_ACC'].value + # for each vector register loaded from matrix A, we require N registers to hold vector-scalar multiply-accumulate results + accumulation_regs = a_regs * N dest.write("// {a_regs} vector regs to hold A array contents, {accumulation_regs} regs to hold values accumulated over k", a_regs=a_regs*2, accumulation_regs=accumulation_regs*2 ) pass_regs = (accumulation_regs + a_regs)*2 - tmp_regs = 32-pass_regs + tmp_regs = (32 // settings['LMUL_ACC'].value) - pass_regs if tmp_regs < 2: raise RuntimeError("Complex kernel would use too many registers!") @@ -337,10 +337,12 @@ def generate_gemm_kernel( settings, OUTPUT ): M = settings['M'].value N = settings['N'].value - vlenmax = int( settings['reg_width_bits'].value / settings['ELEN_PARAM'].value ) + vlenmax = int(settings['reg_width_bits'].value * settings['LMUL_ACC'].value / + settings['ELEN_PARAM'].value) a_regs = max(int(M/vlenmax), 1) - accumulation_regs = a_regs * N * settings['LMUL_ACC'].value + # for each vector register loaded from matrix A, we require N registers to hold vector-scalar multiply-accumulate results + accumulation_regs = a_regs * N required_regs = accumulation_regs + a_regs if is_complex: required_regs = required_regs * 2 + 2 @@ -380,9 +382,9 @@ def generate_gemm_kernel( settings, OUTPUT ): '''.format(tail_policy=settings['tail_policy'].value)) - if required_regs > 32: - raise Exception("{} vector registers needed during accumulation for unrolling {} x {}{} but only 32 are available".format( - required_regs, N, M, (" with wide accumulator" if settings['LMUL_ACC'].value > 1 else '') + if required_regs > (32 // settings['LMUL_ACC'].value): + raise Exception("{} vector registers needed during accumulation for unrolling {} x {}{} but only {} are available".format( + required_regs, N, M, (" with wide accumulator" if settings['LMUL_ACC'].value > 1 else ''), 32 // settings['LMUL_ACC'].value )) TRMM = (settings['op'].value == 'trmm') @@ -448,7 +450,8 @@ def generate_gemm_kernel( settings, OUTPUT ): def generate_M_tails( dest, settings, M, N ): M_tail = int(M/2) M_tail_min = settings['M_tail_scalar_from'].value - vlenmax = int( settings['reg_width_bits'].value / settings['ELEN_PARAM'].value ) + vlenmax = int(settings['reg_width_bits'].value * settings['LMUL_ACC'].value + / settings['ELEN_PARAM'].value ) TRMM = (settings['op'].value == 'trmm') is_complex = settings['complex'].value generate_gemm_kernel_inner = generate_gemm_kernel_inner_complex if is_complex else generate_gemm_kernel_inner_real @@ -667,4 +670,4 @@ def main(): ERROR("unsupported kernel type {}".format(settings['op'])) if __name__ == "__main__": - main() \ No newline at end of file + main() From 6bd7c54af5ecc2004b8a6df0157fe72d55530927 Mon Sep 17 00:00:00 2001 From: Mark Seminatore Date: Mon, 11 Dec 2023 15:13:04 -0800 Subject: [PATCH 024/311] introduce MT_TRACE to clean up SMP_DEBUG code --- driver/others/blas_server_win32.c | 60 ++++++++++++------------------- 1 file changed, 23 insertions(+), 37 deletions(-) diff --git a/driver/others/blas_server_win32.c b/driver/others/blas_server_win32.c index 40ff85abc..5820a55f4 100644 --- a/driver/others/blas_server_win32.c +++ b/driver/others/blas_server_win32.c @@ -48,6 +48,12 @@ #endif #endif +#ifdef SMP_DEBUG +# define MT_TRACE(...) fprintf(stderr, __VA_ARGS__) +#else +# define MT_TRACE(...) +#endif + /* This is a thread implementation for Win32 lazy implementation */ /* Thread server common information */ @@ -213,29 +219,24 @@ static DWORD WINAPI blas_thread_server(void *arg){ /* Each server needs each buffer */ buffer = blas_memory_alloc(2); -#ifdef SMP_DEBUG - fprintf(STDERR, "Server[%2ld] Thread is started!\n", cpu); -#endif + MT_TRACE("Server[%2ld] Thread is started!\n", cpu); while (1){ /* Waiting for Queue */ -#ifdef SMP_DEBUG - fprintf(STDERR, "Server[%2ld] Waiting for Queue.\n", cpu); -#endif + MT_TRACE("Server[%2ld] Waiting for Queue.\n", cpu); + // event raised when work is added to the queue WaitForSingleObject(kickoff_event, INFINITE); if (cpu > thread_target - 2) { - //printf("thread [%d] exiting.\n", cpu); + //MT_TRACE("thread [%d] exiting.\n", cpu); break; // excess thread, so worker thread exits } -#ifdef SMP_DEBUG - fprintf(STDERR, "Server[%2ld] Got it.\n", cpu); -#endif + MT_TRACE("Server[%2ld] Got it.\n", cpu); #if 1 EnterCriticalSection(&queue_lock); @@ -270,10 +271,8 @@ static DWORD WINAPI blas_thread_server(void *arg){ __asm__ __volatile__ ("fldcw %0" : : "m" (queue -> x87_mode)); #endif -#ifdef SMP_DEBUG - fprintf(STDERR, "Server[%2ld] Started. Mode = 0x%03x M = %3ld N=%3ld K=%3ld\n", + MT_TRACE("Server[%2ld] Started. Mode = 0x%03x M = %3ld N=%3ld K=%3ld\n", cpu, queue->mode, queue-> args ->m, queue->args->n, queue->args->k); -#endif // fprintf(stderr, "queue start[%ld]!!!\n", cpu); @@ -342,19 +341,14 @@ static DWORD WINAPI blas_thread_server(void *arg){ continue; //if queue == NULL } -#ifdef SMP_DEBUG - fprintf(STDERR, "Server[%2ld] Finished!\n", cpu); -#endif + MT_TRACE("Server[%2ld] Finished!\n", cpu); queue->finished = 1; - } /* Shutdown procedure */ -#ifdef SMP_DEBUG - fprintf(STDERR, "Server[%2ld] Shutdown!\n", cpu); -#endif + MT_TRACE("Server[%2ld] Shutdown!\n", cpu); blas_memory_free(buffer); @@ -369,10 +363,7 @@ int blas_thread_init(void){ LOCK_COMMAND(&server_lock); -#ifdef SMP_DEBUG - fprintf(STDERR, "Initializing Thread(Num. threads = %d)\n", - blas_cpu_number); -#endif + MT_TRACE("Initializing Thread(Num. threads = %d)\n", blas_cpu_number); if (!blas_server_avail){ // create the kickoff Event @@ -383,7 +374,7 @@ int blas_thread_init(void){ InitializeCriticalSection(&queue_lock); for(i = 0; i < blas_cpu_number - 1; i++){ - //printf("thread_init: creating thread [%d]\n", i); + //MT_TRACE("thread_init: creating thread [%d]\n", i); blas_threads[i] = CreateThread(NULL, 0, blas_thread_server, (void *)i, @@ -458,14 +449,10 @@ int exec_blas_async(BLASLONG pos, blas_queue_t *queue){ int exec_blas_async_wait(BLASLONG num, blas_queue_t *queue){ -#ifdef SMP_DEBUG - fprintf(STDERR, "Synchronization Waiting.\n"); -#endif + MT_TRACE("Synchronization Waiting.\n"); while (num){ -#ifdef SMP_DEBUG - fprintf(STDERR, "Waiting Queue ..\n"); -#endif + MT_TRACE("Waiting Queue ..\n"); while (!queue->finished) YIELDING; @@ -473,9 +460,8 @@ int exec_blas_async_wait(BLASLONG num, blas_queue_t *queue){ num--; } -#ifdef SMP_DEBUG - fprintf(STDERR, "Completely Done.\n\n"); -#endif + MT_TRACE("Completely Done.\n\n"); + // if work was added to the queue after this batch we can't sleep the worker threads // by resetting the event EnterCriticalSection(&queue_lock); @@ -577,11 +563,11 @@ void goto_set_num_threads(int num_threads) SetEvent(kickoff_event); for (i = num_threads - 1; i < blas_num_threads - 1; i++) { - //printf("set_num_threads: waiting on thread [%d] to quit.\n", i); + //MT_TRACE("set_num_threads: waiting on thread [%d] to quit.\n", i); WaitForSingleObject(blas_threads[i], INFINITE); - //printf("set_num_threads: thread [%d] has quit.\n", i); + //MT_TRACE("set_num_threads: thread [%d] has quit.\n", i); CloseHandle(blas_threads[i]); } @@ -610,7 +596,7 @@ void goto_set_num_threads(int num_threads) } for(i = (blas_num_threads > 0) ? blas_num_threads - 1 : 0; i < num_threads - 1; i++){ - //printf("set_num_threads: creating thread [%d]\n", i); + //MT_TRACE("set_num_threads: creating thread [%d]\n", i); blas_threads[i] = CreateThread(NULL, 0, blas_thread_server, (void *)i, From 4f5da84e2f447b466db2a3d468dbee8881cc23a0 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Tue, 2 Jan 2024 22:32:27 +0100 Subject: [PATCH 025/311] Update version to 0.3.26.dev --- CMakeLists.txt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 6d09f5658..5a1e4b271 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -8,7 +8,7 @@ project(OpenBLAS C ASM) set(OpenBLAS_MAJOR_VERSION 0) set(OpenBLAS_MINOR_VERSION 3) -set(OpenBLAS_PATCH_VERSION 26) +set(OpenBLAS_PATCH_VERSION 26.dev) set(OpenBLAS_VERSION "${OpenBLAS_MAJOR_VERSION}.${OpenBLAS_MINOR_VERSION}.${OpenBLAS_PATCH_VERSION}") From 1412d2deeb32cfc1d80150eba520a5bba915f1c6 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Tue, 2 Jan 2024 22:33:01 +0100 Subject: [PATCH 026/311] Update version to 0.3.26.dev --- Makefile.rule | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Makefile.rule b/Makefile.rule index daf2d958d..8dbf5eab6 100644 --- a/Makefile.rule +++ b/Makefile.rule @@ -3,7 +3,7 @@ # # This library's version -VERSION = 0.3.26 +VERSION = 0.3.26.dev # If you set the suffix, the library name will be libopenblas_$(LIBNAMESUFFIX).a # and libopenblas_$(LIBNAMESUFFIX).so. Meanwhile, the soname in shared library From e48627c999e3aadfbcdb2b1f1589d4e75840dfca Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Sat, 6 Jan 2024 23:55:52 +0100 Subject: [PATCH 027/311] Add tests for ZSCAL with NaN and Inf arguments --- utest/CMakeLists.txt | 1 + utest/Makefile | 2 +- utest/test_zscal.c | 49 +++++++++++++++++++++++++++++++++++++++++++ utest/utest_main2.c | 50 +++++++++++++++++++++++++++++++++++++++++++- 4 files changed, 100 insertions(+), 2 deletions(-) create mode 100644 utest/test_zscal.c diff --git a/utest/CMakeLists.txt b/utest/CMakeLists.txt index 2e32827d3..c47954ce4 100644 --- a/utest/CMakeLists.txt +++ b/utest/CMakeLists.txt @@ -15,6 +15,7 @@ else () test_dsdot.c test_dnrm2.c test_swap.c + test_zscal.c ) endif () diff --git a/utest/Makefile b/utest/Makefile index f99035440..d0715c754 100644 --- a/utest/Makefile +++ b/utest/Makefile @@ -11,7 +11,7 @@ UTESTBIN=openblas_utest include $(TOPDIR)/Makefile.system -OBJS=utest_main.o test_min.o test_amax.o test_ismin.o test_rotmg.o test_axpy.o test_dotu.o test_dsdot.o test_swap.o test_rot.o test_dnrm2.o +OBJS=utest_main.o test_min.o test_amax.o test_ismin.o test_rotmg.o test_axpy.o test_dotu.o test_dsdot.o test_swap.o test_rot.o test_dnrm2.o test_zscal.o #test_rot.o test_swap.o test_axpy.o test_dotu.o test_dsdot.o test_fork.o ifneq ($(NO_LAPACK), 1) diff --git a/utest/test_zscal.c b/utest/test_zscal.c new file mode 100644 index 000000000..b6310439f --- /dev/null +++ b/utest/test_zscal.c @@ -0,0 +1,49 @@ +#include "openblas_utest.h" +#include +#ifdef BUILD_COMPLEX16 + +CTEST(zscal, i_nan) +{ + double i[] = {0,1, 0,1, 0,1, 0,1, 0,1, 0,1, 0,1, 0,1, 0,1 }; + double nan[] = {NAN,0, NAN,0, NAN,0, NAN,0, NAN,0, NAN,0, NAN,0, NAN,0, NAN,0, NAN,0}; + cblas_zscal(9, i, &nan, 1); + ASSERT_TRUE(isnan(nan[0])); + ASSERT_TRUE(isnan(nan[1])); + ASSERT_TRUE(isnan(nan[16])); + ASSERT_TRUE(isnan(nan[17])); +} + +CTEST(zscal, nan_i) +{ + double i[] = {0,1, 0,1, 0,1, 0,1, 0,1, 0,1, 0,1, 0,1, 0,1 }; + double nan[] = {NAN,0, NAN,0, NAN,0, NAN,0, NAN,0, NAN,0, NAN,0, NAN,0, NAN,0, NAN,0}; + cblas_zscal(9, &nan, &i, 1); + ASSERT_TRUE(isnan(i[0])); + ASSERT_TRUE(isnan(i[1])); + ASSERT_TRUE(isnan(i[16])); + ASSERT_TRUE(isnan(i[17])); +} + +CTEST(zscal, i_inf) +{ + double i[] = {0,1, 0,1, 0,1, 0,1, 0,1, 0,1, 0,1, 0,1, 0,1 }; + double inf[] = {INFINITY, 0, INFINITY,0, INFINITY,0, INFINITY,0, INFINITY,0, INFINITY,0, INFINITY,0, INFINITY,0, INFINITY,0}; + cblas_zscal(9, i, &inf, 1); + ASSERT_TRUE(isnan(inf[0])); + ASSERT_TRUE(isinf(inf[1])); + ASSERT_TRUE(isnan(inf[16])); + ASSERT_TRUE(isinf(inf[17])); +} + +CTEST(zscal, inf_i) +{ + double i[] = {0,1, 0,1, 0,1, 0,1, 0,1, 0,1, 0,1, 0,1, 0,1 }; + double inf[] = {INFINITY, 0, INFINITY,0, INFINITY,0, INFINITY,0, INFINITY,0, INFINITY,0, INFINITY,0, INFINITY,0, INFINITY,0}; + cblas_zscal(9, &inf, &i, 1); + ASSERT_TRUE(isnan(i[0])); + ASSERT_TRUE(isinf(i[1])); + ASSERT_TRUE(isnan(i[16])); + ASSERT_TRUE(isinf(i[17])); +} + +#endif diff --git a/utest/utest_main2.c b/utest/utest_main2.c index 4382bf159..8cb663190 100644 --- a/utest/utest_main2.c +++ b/utest/utest_main2.c @@ -617,6 +617,51 @@ CTEST(max, smax_zero){ ASSERT_DBL_NEAR_TOL((double)(tr_max), (double)(te_max), SINGLE_EPS); } + +CTEST(zscal, i_nan) +{ + double i[] = {0,1, 0,1, 0,1, 0,1, 0,1, 0,1, 0,1, 0,1, 0,1 }; + double nan[] = {NAN,0, NAN,0, NAN,0, NAN,0, NAN,0, NAN,0, NAN,0, NAN,0, NAN,0, NAN,0}; + cblas_zscal(9, i, &nan, 1); + ASSERT(isnan(nan[0]); + ASSERT(isnan(nan[1]); + ASSERT(isnan(nan[16]); + ASSERT(isnan(nan[17]); +} + +CTEST(zscal, nan_i) +{ + double i[] = {0,1, 0,1, 0,1, 0,1, 0,1, 0,1, 0,1, 0,1, 0,1 }; + double nan[] = {NAN,0, NAN,0, NAN,0, NAN,0, NAN,0, NAN,0, NAN,0, NAN,0, NAN,0, NAN,0}; + cblas_zscal(9, &nan, &i, 1); + ASSERT(isnan(i[0]); + ASSERT(isnan(i[1]); + ASSERT(isnan(i[16]); + ASSERT(isnan(i[17]); + } + +CTEST(zscal, i_inf) +{ + double i[] = {0,1, 0,1, 0,1, 0,1, 0,1, 0,1, 0,1, 0,1, 0,1 }; + double inf[] = {INFINITY, 0, INFINITY,0, INFINITY,0, INFINITY,0, INFINITY,0, INFINITY,0, INFINITY,0, INFINITY,0, INFINITY,0}; + cblas_zscal(9, i, &inf, 1); + ASSERT(isnan(inf[0]); + ASSERT(isinf(inf[1]); + ASSERT(isnan(inf[16]); + ASSERT(isinf(inf[17]); +} + +CTEST(zscal, inf_i) +{ + double i[] = {0,1, 0,1, 0,1, 0,1, 0,1, 0,1, 0,1, 0,1, 0,1 }; + double inf[] = {INFINITY, 0, INFINITY,0, INFINITY,0, INFINITY,0, INFINITY,0, INFINITY,0, INFINITY,0, INFINITY,0, INFINITY,0}; + cblas_zscal(9, &inf, &i, 1); + ASSERT(isnan(i[0]); + ASSERT(isinf(i[1]); + ASSERT(isnan(i[16]); + ASSERT(isinf(i[17]); +} + int main(int argc, const char ** argv){ CTEST_ADD (amax, samax); @@ -648,7 +693,10 @@ int main(int argc, const char ** argv){ CTEST_ADD (swap,zswap_inc_0); CTEST_ADD (swap,sswap_inc_0); CTEST_ADD (swap,cswap_inc_0); - + CTEST_ADD (zscal, i_nan); + CTEST_ADD (zscal, nan_i); + CTEST_ADD (zscal, i_inf); + CTEST_ADD (zscal, inf_i); int num_fail=0; num_fail=ctest_main(argc, argv); From def4996170815ced665af2d1d8bbc08490feb809 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Sun, 7 Jan 2024 15:29:42 +0100 Subject: [PATCH 028/311] Fix handling of NAN and INF arguments --- kernel/x86_64/zscal.c | 61 +++++++++++++++++++------------------- kernel/x86_64/zscal_sse2.S | 1 + 2 files changed, 32 insertions(+), 30 deletions(-) diff --git a/kernel/x86_64/zscal.c b/kernel/x86_64/zscal.c index 45e3531b8..b8d2a8754 100644 --- a/kernel/x86_64/zscal.c +++ b/kernel/x86_64/zscal.c @@ -39,7 +39,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #endif #include "common.h" - +#include #if defined (SKYLAKEX) || defined (COOPERLAKE) || defined (SAPPHIRERAPIDS) #include "zscal_microk_skylakex-2.c" @@ -222,12 +222,10 @@ int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT da_r, FLOAT da_i, if ( da_r == 0.0 ) { - BLASLONG n1 = n & -2; if ( da_i == 0.0 ) { - while(j < n1) { @@ -253,7 +251,6 @@ int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT da_r, FLOAT da_i, } else { - while(j < n1) { @@ -356,49 +353,59 @@ int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT da_r, FLOAT da_i, alpha[0] = da_r; alpha[1] = da_i; - + if ( da_r == 0.0 ) if ( da_i == 0 ) zscal_kernel_8_zero(n1 , alpha , x); else - zscal_kernel_8_zero_r(n1 , alpha , x); +// zscal_kernel_8_zero_r(n1 , alpha , x); + zscal_kernel_8(n1 , alpha , x); else - if ( da_i == 0 ) + if ( da_i == 0 && da_r == da_r) zscal_kernel_8_zero_i(n1 , alpha , x); else zscal_kernel_8(n1 , alpha , x); - + } i = n1 << 1; j = n1; - } - - - if ( da_r == 0.0 ) + + if ( da_r == 0.0 || da_r != da_r ) { - if ( da_i == 0.0 ) { - + FLOAT res=0.0; + if (da_r != da_r) res= da_r; while(j < n) { - - x[i]=0.0; - x[i+1]=0.0; + x[i]=res; + x[i+1]=res; i += 2 ; j++; } } - else + else if (da_r < -FLT_MAX || da_r > FLT_MAX) { + while(j < n) + { + x[i]=SNAN; + x[i+1]=da_r; + i += 2 ; + j++; + + } + + } else { while(j < n) { - temp0 = -da_i * x[i+1]; + if (x[i] < -FLT_MAX || x[i] > FLT_MAX) + temp0 = SNAN; x[i+1] = da_i * x[i]; - x[i] = temp0; + if ( x[i] == x[i]) //preserve NaN + x[i] = temp0; i += 2 ; j++; @@ -409,12 +416,10 @@ int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT da_r, FLOAT da_i, } else { - - if ( da_i == 0.0 ) + if (da_i == 0.0) { - - while(j < n) - { + while(j < n) + { temp0 = da_r * x[i]; x[i+1] = da_r * x[i+1]; @@ -422,15 +427,13 @@ int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT da_r, FLOAT da_i, i += 2 ; j++; - } - + } } else { while(j < n) { - temp0 = da_r * x[i] - da_i * x[i+1]; x[i+1] = da_r * x[i+1] + da_i * x[i]; x[i] = temp0; @@ -445,5 +448,3 @@ int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT da_r, FLOAT da_i, return(0); } - - diff --git a/kernel/x86_64/zscal_sse2.S b/kernel/x86_64/zscal_sse2.S index 223b1e439..d6a49136d 100644 --- a/kernel/x86_64/zscal_sse2.S +++ b/kernel/x86_64/zscal_sse2.S @@ -82,6 +82,7 @@ pxor %xmm15, %xmm15 comisd %xmm0, %xmm15 jne .L100 + jp .L100 comisd %xmm1, %xmm15 jne .L100 From c9df62e88375fae17adf555d73a757e2e8f65cab Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Sun, 7 Jan 2024 17:49:40 +0100 Subject: [PATCH 029/311] Fix handling of NAN --- kernel/arm64/zscal.S | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/kernel/arm64/zscal.S b/kernel/arm64/zscal.S index 929455975..4bd43320d 100644 --- a/kernel/arm64/zscal.S +++ b/kernel/arm64/zscal.S @@ -223,7 +223,7 @@ zscal_begin: fcmp DA_I, #0.0 beq .Lzscal_kernel_RI_zero - b .Lzscal_kernel_R_zero +// b .Lzscal_kernel_R_zero .Lzscal_kernel_R_non_zero: From d3d99c34f24a426bd90dfd97f76683dcd0eb2006 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Sun, 7 Jan 2024 17:56:51 +0100 Subject: [PATCH 030/311] Fix handling of NAN and INF --- kernel/mips/zscal.c | 1 + 1 file changed, 1 insertion(+) diff --git a/kernel/mips/zscal.c b/kernel/mips/zscal.c index bca1155c1..d8cbffcf9 100644 --- a/kernel/mips/zscal.c +++ b/kernel/mips/zscal.c @@ -63,6 +63,7 @@ int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT da_r,FLOAT da_i, F x[ip+1] = da_r * x[ip+1] + da_i * x[ip] ; } } + if (!isnan(x_ip] && !isinf(x[ip])) x[ip] = temp; ip += inc_x2; From 711433fcf0257cd07cf728c64e175960d0da38a2 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Sun, 7 Jan 2024 18:01:58 +0100 Subject: [PATCH 031/311] Update zscal.c --- kernel/mips/zscal.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/kernel/mips/zscal.c b/kernel/mips/zscal.c index d8cbffcf9..127f4f444 100644 --- a/kernel/mips/zscal.c +++ b/kernel/mips/zscal.c @@ -63,9 +63,9 @@ int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT da_r,FLOAT da_i, F x[ip+1] = da_r * x[ip+1] + da_i * x[ip] ; } } - if (!isnan(x_ip] && !isinf(x[ip])) +// if (!isnan(x_ip] && !isinf(x[ip])) x[ip] = temp; - + if ( da_r != da_r ) x[ip] = da_r; ip += inc_x2; } From 903589f84b97b3975fa29a0f2a2fcef418040721 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Sun, 7 Jan 2024 18:37:00 +0100 Subject: [PATCH 032/311] Update zscal.c --- kernel/mips/zscal.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/kernel/mips/zscal.c b/kernel/mips/zscal.c index 127f4f444..e76fb1ff1 100644 --- a/kernel/mips/zscal.c +++ b/kernel/mips/zscal.c @@ -63,7 +63,7 @@ int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT da_r,FLOAT da_i, F x[ip+1] = da_r * x[ip+1] + da_i * x[ip] ; } } -// if (!isnan(x_ip] && !isinf(x[ip])) +// if (!isnan(x[ip]) && !isinf(x[ip])) x[ip] = temp; if ( da_r != da_r ) x[ip] = da_r; ip += inc_x2; From 0c33b57f5fb3721b2c6aa6fb5c7ddd09e17d6542 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Sun, 7 Jan 2024 18:40:19 +0100 Subject: [PATCH 033/311] Handle NAN in input --- kernel/riscv64/zscal_vector.c | 23 ++++++++++++++++++++++- 1 file changed, 22 insertions(+), 1 deletion(-) diff --git a/kernel/riscv64/zscal_vector.c b/kernel/riscv64/zscal_vector.c index d275b75f8..24b44952d 100644 --- a/kernel/riscv64/zscal_vector.c +++ b/kernel/riscv64/zscal_vector.c @@ -59,7 +59,28 @@ int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT da_r,FLOAT da_i, F unsigned int gvl = 0; FLOAT_V_T vt, v0, v1; - if(da_r == 0.0 && da_i == 0.0){ + if (isnan(da_r)) { + gvl = VSETVL(n); + BLASLONG stride_x = inc_x * 2 * sizeof(FLOAT); + BLASLONG inc_xv = inc_x * 2 * gvl; + vt = VFMVVF_FLOAT(da_r, gvl); + for(i=0,j=0; i < n/(gvl*2); i++){ + VSSEV_FLOAT(&x[ix], stride_x, vt, gvl); + VSSEV_FLOAT(&x[ix+1], stride_x, vt, gvl); + VSSEV_FLOAT(&x[ix+inc_xv], stride_x, vt, gvl); + VSSEV_FLOAT(&x[ix+inc_xv+1], stride_x, vt, gvl); + + j += gvl*2; + ix += inc_xv*2; + } + for(; j < n; ){ + gvl = VSETVL(n-j); + VSSEV_FLOAT(&x[ix], stride_x, vt, gvl); + VSSEV_FLOAT(&x[ix+1], stride_x, vt, gvl); + j += gvl; + ix += inc_x * 2 * gvl; + } + else if(da_r == 0.0 && da_i == 0.0){ gvl = VSETVL(n); BLASLONG stride_x = inc_x * 2 * sizeof(FLOAT); BLASLONG inc_xv = inc_x * 2 * gvl; From b08a208365f0bfbc8c85b85b4401d3a05f57a222 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Sun, 7 Jan 2024 19:14:41 +0100 Subject: [PATCH 034/311] Update zscal_vector.c --- kernel/riscv64/zscal_vector.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/kernel/riscv64/zscal_vector.c b/kernel/riscv64/zscal_vector.c index 24b44952d..33cb5d7ea 100644 --- a/kernel/riscv64/zscal_vector.c +++ b/kernel/riscv64/zscal_vector.c @@ -80,7 +80,7 @@ int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT da_r,FLOAT da_i, F j += gvl; ix += inc_x * 2 * gvl; } - else if(da_r == 0.0 && da_i == 0.0){ + } else if(da_r == 0.0 && da_i == 0.0){ gvl = VSETVL(n); BLASLONG stride_x = inc_x * 2 * sizeof(FLOAT); BLASLONG inc_xv = inc_x * 2 * gvl; From 2173356d5b63ea5e5f861bfebea387bc41d9e3b0 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Sun, 7 Jan 2024 19:45:28 +0100 Subject: [PATCH 035/311] Update zscal_vector.c --- kernel/riscv64/zscal_vector.c | 24 +++--------------------- 1 file changed, 3 insertions(+), 21 deletions(-) diff --git a/kernel/riscv64/zscal_vector.c b/kernel/riscv64/zscal_vector.c index 33cb5d7ea..a943135df 100644 --- a/kernel/riscv64/zscal_vector.c +++ b/kernel/riscv64/zscal_vector.c @@ -59,28 +59,8 @@ int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT da_r,FLOAT da_i, F unsigned int gvl = 0; FLOAT_V_T vt, v0, v1; - if (isnan(da_r)) { - gvl = VSETVL(n); - BLASLONG stride_x = inc_x * 2 * sizeof(FLOAT); - BLASLONG inc_xv = inc_x * 2 * gvl; - vt = VFMVVF_FLOAT(da_r, gvl); - for(i=0,j=0; i < n/(gvl*2); i++){ - VSSEV_FLOAT(&x[ix], stride_x, vt, gvl); - VSSEV_FLOAT(&x[ix+1], stride_x, vt, gvl); - VSSEV_FLOAT(&x[ix+inc_xv], stride_x, vt, gvl); - VSSEV_FLOAT(&x[ix+inc_xv+1], stride_x, vt, gvl); - j += gvl*2; - ix += inc_xv*2; - } - for(; j < n; ){ - gvl = VSETVL(n-j); - VSSEV_FLOAT(&x[ix], stride_x, vt, gvl); - VSSEV_FLOAT(&x[ix+1], stride_x, vt, gvl); - j += gvl; - ix += inc_x * 2 * gvl; - } - } else if(da_r == 0.0 && da_i == 0.0){ + if(da_r == 0.0 && da_i == 0.0){ gvl = VSETVL(n); BLASLONG stride_x = inc_x * 2 * sizeof(FLOAT); BLASLONG inc_xv = inc_x * 2 * gvl; @@ -101,6 +81,7 @@ int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT da_r,FLOAT da_i, F j += gvl; ix += inc_x * 2 * gvl; } +#if 0 }else if(da_r == 0.0){ gvl = VSETVL(n); BLASLONG stride_x = inc_x * 2 * sizeof(FLOAT); @@ -129,6 +110,7 @@ int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT da_r,FLOAT da_i, F VSSEV_FLOAT(&x[ix], stride_x, vt, gvl); VSSEV_FLOAT(&x[ix+1], stride_x, v1, gvl); } + #endif }else if(da_i == 0.0){ gvl = VSETVL(n); BLASLONG stride_x = inc_x * 2 * sizeof(FLOAT); From 91bbde7f64ef9d176e69416897ce5e255c351ec8 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Sun, 7 Jan 2024 20:21:05 +0100 Subject: [PATCH 036/311] revert accidental direct commit to develop --- kernel/mips/zscal.c | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/kernel/mips/zscal.c b/kernel/mips/zscal.c index e76fb1ff1..bca1155c1 100644 --- a/kernel/mips/zscal.c +++ b/kernel/mips/zscal.c @@ -63,9 +63,8 @@ int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT da_r,FLOAT da_i, F x[ip+1] = da_r * x[ip+1] + da_i * x[ip] ; } } -// if (!isnan(x[ip]) && !isinf(x[ip])) x[ip] = temp; - if ( da_r != da_r ) x[ip] = da_r; + ip += inc_x2; } From f052bd4705210ef6c7293447b236f3a634799ba1 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Sun, 7 Jan 2024 20:21:48 +0100 Subject: [PATCH 037/311] revert accidental direct commit to develop --- kernel/riscv64/zscal_vector.c | 3 --- 1 file changed, 3 deletions(-) diff --git a/kernel/riscv64/zscal_vector.c b/kernel/riscv64/zscal_vector.c index a943135df..d275b75f8 100644 --- a/kernel/riscv64/zscal_vector.c +++ b/kernel/riscv64/zscal_vector.c @@ -59,7 +59,6 @@ int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT da_r,FLOAT da_i, F unsigned int gvl = 0; FLOAT_V_T vt, v0, v1; - if(da_r == 0.0 && da_i == 0.0){ gvl = VSETVL(n); BLASLONG stride_x = inc_x * 2 * sizeof(FLOAT); @@ -81,7 +80,6 @@ int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT da_r,FLOAT da_i, F j += gvl; ix += inc_x * 2 * gvl; } -#if 0 }else if(da_r == 0.0){ gvl = VSETVL(n); BLASLONG stride_x = inc_x * 2 * sizeof(FLOAT); @@ -110,7 +108,6 @@ int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT da_r,FLOAT da_i, F VSSEV_FLOAT(&x[ix], stride_x, vt, gvl); VSSEV_FLOAT(&x[ix+1], stride_x, v1, gvl); } - #endif }else if(da_i == 0.0){ gvl = VSETVL(n); BLASLONG stride_x = inc_x * 2 * sizeof(FLOAT); From acf17a825dadf070d595b901ae10d7f21db5aa25 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Sun, 7 Jan 2024 20:26:16 +0100 Subject: [PATCH 038/311] Handle NAN in input --- kernel/mips/zscal.c | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/kernel/mips/zscal.c b/kernel/mips/zscal.c index bca1155c1..d69477f97 100644 --- a/kernel/mips/zscal.c +++ b/kernel/mips/zscal.c @@ -63,8 +63,11 @@ int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT da_r,FLOAT da_i, F x[ip+1] = da_r * x[ip+1] + da_i * x[ip] ; } } - x[ip] = temp; - + if ( da_r != da_r ) + x[ip] = da_r; + else + x[ip] = temp; + ip += inc_x2; } From f0808d856b69d750facf288460b65f0e9b0dde65 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Sun, 7 Jan 2024 20:27:29 +0100 Subject: [PATCH 039/311] Handle NAN in input --- kernel/riscv64/zscal_vector.c | 2 ++ 1 file changed, 2 insertions(+) diff --git a/kernel/riscv64/zscal_vector.c b/kernel/riscv64/zscal_vector.c index d275b75f8..77f4fc312 100644 --- a/kernel/riscv64/zscal_vector.c +++ b/kernel/riscv64/zscal_vector.c @@ -80,6 +80,7 @@ int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT da_r,FLOAT da_i, F j += gvl; ix += inc_x * 2 * gvl; } +#if 0 }else if(da_r == 0.0){ gvl = VSETVL(n); BLASLONG stride_x = inc_x * 2 * sizeof(FLOAT); @@ -97,6 +98,7 @@ int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT da_r,FLOAT da_i, F j += gvl; ix += inc_xv; } +#endif if(j < n){ gvl = VSETVL(n-j); v0 = VLSEV_FLOAT(&x[ix], stride_x, gvl); From cf8b03ae8b59d41ea74fd7f8f52efe9fed897c23 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Sun, 7 Jan 2024 23:09:57 +0100 Subject: [PATCH 040/311] Use NAN rather than SNAN for portability --- kernel/x86_64/zscal.c | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/kernel/x86_64/zscal.c b/kernel/x86_64/zscal.c index b8d2a8754..66c8a0d2b 100644 --- a/kernel/x86_64/zscal.c +++ b/kernel/x86_64/zscal.c @@ -388,8 +388,8 @@ int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT da_r, FLOAT da_i, else if (da_r < -FLT_MAX || da_r > FLT_MAX) { while(j < n) { - x[i]=SNAN; - x[i+1]=da_r; + x[i]= NAN; + x[i+1] = da_r; i += 2 ; j++; @@ -402,7 +402,7 @@ int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT da_r, FLOAT da_i, { temp0 = -da_i * x[i+1]; if (x[i] < -FLT_MAX || x[i] > FLT_MAX) - temp0 = SNAN; + temp0 = NAN; x[i+1] = da_i * x[i]; if ( x[i] == x[i]) //preserve NaN x[i] = temp0; From 5e7f714e93848c72faa2d2e658b8584aa395f603 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Mon, 8 Jan 2024 08:17:40 +0100 Subject: [PATCH 041/311] Update zscal.c --- kernel/mips/zscal.c | 1 + 1 file changed, 1 insertion(+) diff --git a/kernel/mips/zscal.c b/kernel/mips/zscal.c index d69477f97..b117db1dd 100644 --- a/kernel/mips/zscal.c +++ b/kernel/mips/zscal.c @@ -47,6 +47,7 @@ int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT da_r,FLOAT da_i, F else { temp = - da_i * x[ip+1] ; + if (isnan(x[ip]) || isinf(x[ip])) temp = x[ip]; x[ip+1] = da_i * x[ip] ; } } From 25b0c48082a34bb2e5e9beebfdb65810e2e5affc Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Mon, 8 Jan 2024 09:49:18 +0100 Subject: [PATCH 042/311] Update zscal.c --- kernel/mips/zscal.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/kernel/mips/zscal.c b/kernel/mips/zscal.c index b117db1dd..7bb261941 100644 --- a/kernel/mips/zscal.c +++ b/kernel/mips/zscal.c @@ -47,7 +47,7 @@ int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT da_r,FLOAT da_i, F else { temp = - da_i * x[ip+1] ; - if (isnan(x[ip]) || isinf(x[ip])) temp = x[ip]; + if (isnan(x[ip]) || isinf(x[ip])) temp = NAN; x[ip+1] = da_i * x[ip] ; } } From f637e1271391765b4e9fc87b958ecb4fd7541460 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Mon, 8 Jan 2024 09:52:38 +0100 Subject: [PATCH 043/311] Handle INF and NAN --- kernel/riscv64/zscal.c | 1 + 1 file changed, 1 insertion(+) diff --git a/kernel/riscv64/zscal.c b/kernel/riscv64/zscal.c index 0521aaa0b..b2d537d04 100644 --- a/kernel/riscv64/zscal.c +++ b/kernel/riscv64/zscal.c @@ -60,6 +60,7 @@ int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT da_r,FLOAT da_i, F else { temp = - da_i * x[ip+1] ; + if (isnan(x[ip]) || isinf(x[ip])) temp = NAN; x[ip+1] = da_i * x[ip] ; } } From 7ee1ee38e22904837afd3e51dd67f91cd499185f Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Mon, 8 Jan 2024 14:20:07 +0100 Subject: [PATCH 044/311] Handle NaN in input --- kernel/x86/zscal_sse.S | 1 + kernel/x86/zscal_sse2.S | 1 + 2 files changed, 2 insertions(+) diff --git a/kernel/x86/zscal_sse.S b/kernel/x86/zscal_sse.S index e011c98f5..89e36251e 100644 --- a/kernel/x86/zscal_sse.S +++ b/kernel/x86/zscal_sse.S @@ -87,6 +87,7 @@ xorps %xmm7, %xmm7 comiss %xmm0, %xmm7 jne .L100 # Alpha_r != ZERO + jp .L100 # Alpha_r NaN comiss %xmm1, %xmm7 jne .L100 # Alpha_i != ZERO diff --git a/kernel/x86/zscal_sse2.S b/kernel/x86/zscal_sse2.S index cc7ab6686..0bc61b209 100644 --- a/kernel/x86/zscal_sse2.S +++ b/kernel/x86/zscal_sse2.S @@ -98,6 +98,7 @@ xorps %xmm7, %xmm7 comisd %xmm0, %xmm7 jne .L100 + jp .L100 comisd %xmm1, %xmm7 jne .L100 From 1c31f56e5a23f6dd7ebfd35014fc5a604e4702cd Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Mon, 8 Jan 2024 16:11:25 +0100 Subject: [PATCH 045/311] Handle NAN --- kernel/x86/zscal.S | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/kernel/x86/zscal.S b/kernel/x86/zscal.S index 1eb518563..adb56edb9 100644 --- a/kernel/x86/zscal.S +++ b/kernel/x86/zscal.S @@ -98,7 +98,7 @@ fcomip %st(1), %st ffreep %st(0) jne .L30 - +jp .L30 EMMS pxor %mm0, %mm0 From 058dd2a4cb4a6139796e29629191db5f2899fa1e Mon Sep 17 00:00:00 2001 From: Chip-Kerchner Date: Mon, 8 Jan 2024 14:16:09 -0600 Subject: [PATCH 046/311] Replace two vector loads with one vector pair load and fix endianess of stores - DGEMM versions. --- kernel/power/dgemm_tcopy_16_power8.S | 3 + kernel/power/dgemm_tcopy_macros_16_power10.S | 655 +++++++++++++++++++ kernel/power/dgemm_tcopy_macros_16_power8.S | 6 + 3 files changed, 664 insertions(+) create mode 100644 kernel/power/dgemm_tcopy_macros_16_power10.S diff --git a/kernel/power/dgemm_tcopy_16_power8.S b/kernel/power/dgemm_tcopy_16_power8.S index fc52e0202..7a3c04e8e 100644 --- a/kernel/power/dgemm_tcopy_16_power8.S +++ b/kernel/power/dgemm_tcopy_16_power8.S @@ -107,6 +107,9 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define o0 0 +#ifdef POWER10 +#include "dgemm_tcopy_macros_16_power10.S" +#endif #include "dgemm_tcopy_macros_16_power8.S" #define STACKSIZE 144 diff --git a/kernel/power/dgemm_tcopy_macros_16_power10.S b/kernel/power/dgemm_tcopy_macros_16_power10.S new file mode 100644 index 000000000..3cb416e09 --- /dev/null +++ b/kernel/power/dgemm_tcopy_macros_16_power10.S @@ -0,0 +1,655 @@ +/*************************************************************************** +Copyright (c) 2013-2016, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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. +*****************************************************************************/ + +/************************************************************************************** +* 2016/04/21 Werner Saar (wernsaar@googlemail.com) +* BLASTEST : OK +* CTEST : OK +* TEST : OK +* LAPACK-TEST : OK +**************************************************************************************/ + + +/********************************************************************************************** +* Macros for N=4 and M=16 +**********************************************************************************************/ + +#if defined(_AIX) +define(`COPY_4x16', ` +#else +.macro COPY_4x16 +#endif + + lxvpx vs32, o0, A0 + lxvpx vs34, o32, A0 + addi A0, A0, 64 + + lxvpx vs40, o0, A1 + lxvpx vs42, o32, A1 + addi A1, A1, 64 + + lxvpx vs48, o0, A2 + lxvpx vs50, o32, A2 + addi A2, A2, 64 + + lxvpx vs4, o0, A3 + lxvpx vs6, o32, A3 + addi A3, A3, 64 + + lxvpx vs36, o0, A0 + lxvpx vs38, o32, A0 + addi A0, A0, 64 + + lxvpx vs44, o0, A1 + lxvpx vs46, o32, A1 + addi A1, A1, 64 + + lxvpx vs12, o0, A2 + lxvpx vs2, o32, A2 + addi A2, A2, 64 + + lxvpx vs8, o0, A3 + lxvpx vs10, o32, A3 + addi A3, A3, 64 + + mr T1, BO + +#if (__BYTE_ORDER__ == __ORDER_BIG_ENDIAN__) + stxvd2x vs32, o0, T1 + stxvd2x vs33, o16, T1 + stxvd2x vs34, o32, T1 + stxvd2x vs35, o48, T1 +#else + stxvd2x vs33, o0, T1 + stxvd2x vs32, o16, T1 + stxvd2x vs35, o32, T1 + stxvd2x vs34, o48, T1 +#endif + addi T1, T1, 64 + +#if (__BYTE_ORDER__ == __ORDER_BIG_ENDIAN__) + stxvd2x vs36, o0, T1 + stxvd2x vs37, o16, T1 + stxvd2x vs38, o32, T1 + stxvd2x vs39, o48, T1 +#else + stxvd2x vs37, o0, T1 + stxvd2x vs36, o16, T1 + stxvd2x vs39, o32, T1 + stxvd2x vs38, o48, T1 +#endif + + addi T1, T1, 64 + +#if (__BYTE_ORDER__ == __ORDER_BIG_ENDIAN__) + stxvd2x vs40, o0, T1 + stxvd2x vs41, o16, T1 + stxvd2x vs42, o32, T1 + stxvd2x vs43, o48, T1 +#else + stxvd2x vs41, o0, T1 + stxvd2x vs40, o16, T1 + stxvd2x vs43, o32, T1 + stxvd2x vs42, o48, T1 +#endif + addi T1, T1, 64 + +#if (__BYTE_ORDER__ == __ORDER_BIG_ENDIAN__) + stxvd2x vs44, o0, T1 + stxvd2x vs45, o16, T1 + stxvd2x vs46, o32, T1 + stxvd2x vs47, o48, T1 +#else + stxvd2x vs45, o0, T1 + stxvd2x vs44, o16, T1 + stxvd2x vs47, o32, T1 + stxvd2x vs46, o48, T1 +#endif + + addi T1, T1, 64 + +#if (__BYTE_ORDER__ == __ORDER_BIG_ENDIAN__) + stxvd2x vs48, o0, T1 + stxvd2x vs49, o16, T1 + stxvd2x vs50, o32, T1 + stxvd2x vs51, o48, T1 +#else + stxvd2x vs49, o0, T1 + stxvd2x vs48, o16, T1 + stxvd2x vs51, o32, T1 + stxvd2x vs50, o48, T1 +#endif + addi T1, T1, 64 + +#if (__BYTE_ORDER__ == __ORDER_BIG_ENDIAN__) + stxvd2x vs12, o0, T1 + stxvd2x vs13, o16, T1 + stxvd2x vs2, o32, T1 + stxvd2x vs3, o48, T1 +#else + stxvd2x vs13, o0, T1 + stxvd2x vs12, o16, T1 + stxvd2x vs3, o32, T1 + stxvd2x vs2, o48, T1 +#endif + + addi T1, T1, 64 + +#if (__BYTE_ORDER__ == __ORDER_BIG_ENDIAN__) + stxvd2x vs4, o0, T1 + stxvd2x vs5, o16, T1 + stxvd2x vs6, o32, T1 + stxvd2x vs7, o48, T1 +#else + stxvd2x vs5, o0, T1 + stxvd2x vs4, o16, T1 + stxvd2x vs7, o32, T1 + stxvd2x vs6, o48, T1 +#endif + addi T1, T1, 64 + +#if (__BYTE_ORDER__ == __ORDER_BIG_ENDIAN__) + stxvd2x vs8, o0, T1 + stxvd2x vs9, o16, T1 + stxvd2x vs10, o32, T1 + stxvd2x vs11, o48, T1 +#else + stxvd2x vs9, o0, T1 + stxvd2x vs8, o16, T1 + stxvd2x vs11, o32, T1 + stxvd2x vs10, o48, T1 +#endif + +#if defined(_AIX) +') +#else +.endm +#endif + + +/********************************************************************************************** +* Macros for N=4 and M=8 +**********************************************************************************************/ + +#if defined(_AIX) +define(`COPY_4x8', ` +#else +.macro COPY_4x8 +#endif + + lxvpx vs32, o0, A0 + lxvpx vs34, o32, A0 + addi A0, A0, 64 + + + lxvpx vs36, o0, A1 + lxvpx vs38, o32, A1 + addi A1, A1, 64 + + + lxvpx vs40, o0, A2 + lxvpx vs42, o32, A2 + addi A2, A2, 64 + + + lxvpx vs44, o0, A3 + lxvpx vs46, o32, A3 + addi A3, A3, 64 + + + mr T1, BO + +#if (__BYTE_ORDER__ == __ORDER_BIG_ENDIAN__) + stxvd2x vs32, o0, T1 + stxvd2x vs33, o16, T1 + stxvd2x vs34, o32, T1 + stxvd2x vs35, o48, T1 +#else + stxvd2x vs33, o0, T1 + stxvd2x vs32, o16, T1 + stxvd2x vs35, o32, T1 + stxvd2x vs34, o48, T1 +#endif + + addi T1, T1, 64 + +#if (__BYTE_ORDER__ == __ORDER_BIG_ENDIAN__) + stxvd2x vs36, o0, T1 + stxvd2x vs37, o16, T1 + stxvd2x vs38, o32, T1 + stxvd2x vs39, o48, T1 +#else + stxvd2x vs37, o0, T1 + stxvd2x vs36, o16, T1 + stxvd2x vs39, o32, T1 + stxvd2x vs38, o48, T1 +#endif + + addi T1, T1, 64 + +#if (__BYTE_ORDER__ == __ORDER_BIG_ENDIAN__) + stxvd2x vs40, o0, T1 + stxvd2x vs41, o16, T1 + stxvd2x vs42, o32, T1 + stxvd2x vs43, o48, T1 +#else + stxvd2x vs41, o0, T1 + stxvd2x vs40, o16, T1 + stxvd2x vs43, o32, T1 + stxvd2x vs42, o48, T1 +#endif + + addi T1, T1, 64 + +#if (__BYTE_ORDER__ == __ORDER_BIG_ENDIAN__) + stxvd2x vs44, o0, T1 + stxvd2x vs45, o16, T1 + stxvd2x vs46, o32, T1 + stxvd2x vs47, o48, T1 +#else + stxvd2x vs45, o0, T1 + stxvd2x vs44, o16, T1 + stxvd2x vs47, o32, T1 + stxvd2x vs46, o48, T1 +#endif + +#if defined(_AIX) +') +#else +.endm +#endif + + +/********************************************************************************************** +* Macros for N=4 and M=4 +**********************************************************************************************/ + +#if defined(_AIX) +define(`COPY_4x4', ` +#else +.macro COPY_4x4 +#endif + + lxvpx vs32, o0, A0 + addi A0, A0, 32 + + + lxvpx vs34, o0, A1 + addi A1, A1, 32 + + + lxvpx vs36, o0, A2 + addi A2, A2, 32 + + + lxvpx vs38, o0, A3 + addi A3, A3, 32 + + + mr T1, BO + +#if (__BYTE_ORDER__ == __ORDER_BIG_ENDIAN__) + stxvd2x vs32, o0, T1 + stxvd2x vs33, o16, T1 + + stxvd2x vs34, o32, T1 + stxvd2x vs35, o48, T1 +#else + stxvd2x vs33, o0, T1 + stxvd2x vs32, o16, T1 + + stxvd2x vs35, o32, T1 + stxvd2x vs34, o48, T1 +#endif + + addi T1, T1, 64 + +#if (__BYTE_ORDER__ == __ORDER_BIG_ENDIAN__) + stxvd2x vs36, o0, T1 + stxvd2x vs37, o16, T1 + + stxvd2x vs38, o32, T1 + stxvd2x vs39, o48, T1 +#else + stxvd2x vs37, o0, T1 + stxvd2x vs36, o16, T1 + + stxvd2x vs39, o32, T1 + stxvd2x vs38, o48, T1 +#endif + +#if defined(_AIX) +') +#else +.endm +#endif + + +/********************************************************************************************** +* Macros for N=2 and M=16 +**********************************************************************************************/ + +#if defined(_AIX) +define(`COPY_2x16', ` +#else +.macro COPY_2x16 +#endif + + lxvpx vs32, o0, A0 + lxvpx vs34, o32, A0 + addi A0, A0, 64 + + lxvpx vs36, o0, A0 + lxvpx vs38, o32, A0 + addi A0, A0, 64 + + + lxvpx vs40, o0, A1 + lxvpx vs42, o32, A1 + addi A1, A1, 64 + + lxvpx vs44, o0, A1 + lxvpx vs46, o32, A1 + addi A1, A1, 64 + + + mr T1, BO + +#if (__BYTE_ORDER__ == __ORDER_BIG_ENDIAN__) + stxvd2x vs32, o0, T1 + stxvd2x vs33, o16, T1 + stxvd2x vs34, o32, T1 + stxvd2x vs35, o48, T1 +#else + stxvd2x vs33, o0, T1 + stxvd2x vs32, o16, T1 + stxvd2x vs35, o32, T1 + stxvd2x vs34, o48, T1 +#endif + addi T1, T1, 64 + +#if (__BYTE_ORDER__ == __ORDER_BIG_ENDIAN__) + stxvd2x vs36, o0, T1 + stxvd2x vs37, o16, T1 + stxvd2x vs38, o32, T1 + stxvd2x vs39, o48, T1 +#else + stxvd2x vs37, o0, T1 + stxvd2x vs36, o16, T1 + stxvd2x vs39, o32, T1 + stxvd2x vs38, o48, T1 +#endif + + addi T1, T1, 64 + +#if (__BYTE_ORDER__ == __ORDER_BIG_ENDIAN__) + stxvd2x vs40, o0, T1 + stxvd2x vs41, o16, T1 + stxvd2x vs42, o32, T1 + stxvd2x vs43, o48, T1 +#else + stxvd2x vs41, o0, T1 + stxvd2x vs40, o16, T1 + stxvd2x vs43, o32, T1 + stxvd2x vs42, o48, T1 +#endif + addi T1, T1, 64 + +#if (__BYTE_ORDER__ == __ORDER_BIG_ENDIAN__) + stxvd2x vs44, o0, T1 + stxvd2x vs45, o16, T1 + stxvd2x vs46, o32, T1 + stxvd2x vs47, o48, T1 +#else + stxvd2x vs45, o0, T1 + stxvd2x vs44, o16, T1 + stxvd2x vs47, o32, T1 + stxvd2x vs46, o48, T1 +#endif + +#if defined(_AIX) +') +#else +.endm +#endif + + +/********************************************************************************************** +* Macros for N=2 and M=8 +**********************************************************************************************/ + +#if defined(_AIX) +define(`COPY_2x8', ` +#else +.macro COPY_2x8 +#endif + + lxvpx vs32, o0, A0 + lxvpx vs34, o32, A0 + addi A0, A0, 64 + + + lxvpx vs36, o0, A1 + lxvpx vs38, o0, A1 + addi A1, A1, 64 + + + mr T1, BO + +#if (__BYTE_ORDER__ == __ORDER_BIG_ENDIAN__) + stxvd2x vs32, o0, T1 + stxvd2x vs33, o16, T1 + stxvd2x vs34, o32, T1 + stxvd2x vs35, o48, T1 +#else + stxvd2x vs33, o0, T1 + stxvd2x vs32, o16, T1 + stxvd2x vs35, o32, T1 + stxvd2x vs34, o48, T1 +#endif + + addi T1, T1, 64 + +#if (__BYTE_ORDER__ == __ORDER_BIG_ENDIAN__) + stxvd2x vs36, o0, T1 + stxvd2x vs37, o16, T1 + stxvd2x vs38, o32, T1 + stxvd2x vs39, o48, T1 +#else + stxvd2x vs37, o0, T1 + stxvd2x vs36, o16, T1 + stxvd2x vs39, o32, T1 + stxvd2x vs38, o48, T1 +#endif + +#if defined(_AIX) +') +#else +.endm +#endif + + +/********************************************************************************************** +* Macros for N=2 and M=4 +**********************************************************************************************/ + +#if defined(_AIX) +define(`COPY_2x4', ` +#else +.macro COPY_2x4 +#endif + + lxvpx vs32, o0, A0 + addi A0, A0, 32 + + + lxvpx vs34, o0, A1 + addi A1, A1, 32 + + + mr T1, BO + +#if (__BYTE_ORDER__ == __ORDER_BIG_ENDIAN__) + stxvd2x vs32, o0, T1 + stxvd2x vs33, o16, T1 + + stxvd2x vs34, o32, T1 + stxvd2x vs35, o48, T1 +#else + stxvd2x vs33, o0, T1 + stxvd2x vs32, o16, T1 + + stxvd2x vs35, o32, T1 + stxvd2x vs34, o48, T1 +#endif + +#if defined(_AIX) +') +#else +.endm +#endif + + +/********************************************************************************************** +* Macros for N=1 and M=16 +**********************************************************************************************/ + +#if defined(_AIX) +define(`COPY_1x16', ` +#else +.macro COPY_1x16 +#endif + + lxvpx vs32, o0, A0 + lxvpx vs34, o32, A0 + addi A0, A0, 64 + + lxvpx vs36, o0, A0 + lxvpx vs38, o0, A0 + addi A0, A0, 64 + + + mr T1, BO + +#if (__BYTE_ORDER__ == __ORDER_BIG_ENDIAN__) + stxvd2x vs32, o0, T1 + stxvd2x vs33, o16, T1 + stxvd2x vs34, o32, T1 + stxvd2x vs35, o48, T1 +#else + stxvd2x vs33, o0, T1 + stxvd2x vs32, o16, T1 + stxvd2x vs35, o32, T1 + stxvd2x vs34, o48, T1 +#endif + addi T1, T1, 64 + +#if (__BYTE_ORDER__ == __ORDER_BIG_ENDIAN__) + stxvd2x vs36, o0, T1 + stxvd2x vs37, o16, T1 + stxvd2x vs38, o32, T1 + stxvd2x vs39, o48, T1 +#else + stxvd2x vs37, o0, T1 + stxvd2x vs36, o16, T1 + stxvd2x vs39, o32, T1 + stxvd2x vs38, o48, T1 +#endif + +#if defined(_AIX) +') +#else +.endm +#endif + + +/********************************************************************************************** +* Macros for N=1 and M=8 +**********************************************************************************************/ + +#if defined(_AIX) +define(`COPY_1x8', ` +#else +.macro COPY_1x8 +#endif + + lxvpx vs32, o0, A0 + lxvpx vs34, o32, A0 + addi A0, A0, 64 + + + mr T1, BO + +#if (__BYTE_ORDER__ == __ORDER_BIG_ENDIAN__) + stxvd2x vs32, o0, T1 + stxvd2x vs33, o16, T1 + stxvd2x vs34, o32, T1 + stxvd2x vs35, o48, T1 +#else + stxvd2x vs33, o0, T1 + stxvd2x vs32, o16, T1 + stxvd2x vs35, o32, T1 + stxvd2x vs34, o48, T1 +#endif + +#if defined(_AIX) +') +#else +.endm +#endif + + +/********************************************************************************************** +* Macros for N=1 and M=4 +**********************************************************************************************/ + +#if defined(_AIX) +define(`COPY_1x4', ` +#else +.macro COPY_1x4 +#endif + + lxvpx vs32, o0, A0 + addi A0, A0, 32 + + + mr T1, BO + +#if (__BYTE_ORDER__ == __ORDER_BIG_ENDIAN__) + stxvd2x vs32, o0, T1 + stxvd2x vs33, o16, T1 +#else + stxvd2x vs33, o0, T1 + stxvd2x vs32, o16, T1 +#endif + +#if defined(_AIX) +') +#else +.endm +#endif + diff --git a/kernel/power/dgemm_tcopy_macros_16_power8.S b/kernel/power/dgemm_tcopy_macros_16_power8.S index 6c5b8ed62..93b488fd0 100644 --- a/kernel/power/dgemm_tcopy_macros_16_power8.S +++ b/kernel/power/dgemm_tcopy_macros_16_power8.S @@ -38,6 +38,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. * Macros for N=4 and M=16 **********************************************************************************************/ +#ifndef POWER10 #if defined(_AIX) define(`COPY_4x16', ` #else @@ -275,6 +276,7 @@ define(`COPY_4x4', ` #else .endm #endif +#endif /********************************************************************************************** @@ -369,6 +371,7 @@ define(`COPY_4x1', ` * Macros for N=2 and M=16 **********************************************************************************************/ +#ifndef POWER10 #if defined(_AIX) define(`COPY_2x16', ` #else @@ -512,6 +515,7 @@ define(`COPY_2x4', ` #else .endm #endif +#endif /********************************************************************************************** @@ -580,6 +584,7 @@ define(`COPY_2x1', ` * Macros for N=1 and M=16 **********************************************************************************************/ +#ifndef POWER10 #if defined(_AIX) define(`COPY_1x16', ` #else @@ -675,6 +680,7 @@ define(`COPY_1x4', ` #else .endm #endif +#endif /********************************************************************************************** From 7df363e1e2daef0916faae7d0b399fc998e5433e Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Fri, 12 Jan 2024 00:08:52 +0100 Subject: [PATCH 047/311] temporarily disable the MSA C/ZSCAL kernels --- kernel/mips/KERNEL.P5600 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/kernel/mips/KERNEL.P5600 b/kernel/mips/KERNEL.P5600 index 9a6e06d67..f0fb5e087 100644 --- a/kernel/mips/KERNEL.P5600 +++ b/kernel/mips/KERNEL.P5600 @@ -103,8 +103,10 @@ endif ifdef HAVE_MSA SSCALKERNEL = ../mips/sscal_msa.c DSCALKERNEL = ../mips/dscal_msa.c -CSCALKERNEL = ../mips/cscal_msa.c -ZSCALKERNEL = ../mips/zscal_msa.c +#CSCALKERNEL = ../mips/cscal_msa.c +#ZSCALKERNEL = ../mips/zscal_msa.c +CSCALKERNEL = ../mips/zscal.c +ZSCALKERNEL = ../mips/zscal.c else SSCALKERNEL = ../mips/scal.c DSCALKERNEL = ../mips/scal.c From 1dada6d65d89d19b2cf89b12169f6b2196c90f1d Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Fri, 12 Jan 2024 00:10:56 +0100 Subject: [PATCH 048/311] Add compiler test and flag for AVX512BF16 capability --- c_check | 22 ++++++++++++++++++++++ 1 file changed, 22 insertions(+) diff --git a/c_check b/c_check index b5e4a9ad0..3e507be81 100755 --- a/c_check +++ b/c_check @@ -244,6 +244,7 @@ case "$data" in esac no_avx512=0 +no_avx512bf=0 if [ "$architecture" = "x86" ] || [ "$architecture" = "x86_64" ]; then tmpd=$(mktemp -d 2>/dev/null || mktemp -d -t 'OBC') tmpf="$tmpd/a.c" @@ -262,6 +263,25 @@ if [ "$architecture" = "x86" ] || [ "$architecture" = "x86_64" ]; then } rm -rf "$tmpd" + if [ "$no_avx512" -eq 0 ]; then + tmpd=$(mktemp -d 2>/dev/null || mktemp -d -t 'OBC') + tmpf="$tmpd/a.c" + code='"__m512 a= _mm512_dpbf16_ps(a, (__m512bh) _mm512_loadu_si512(%1]), (__m512bh) _mm512_loadu_si512(%2]));"' + printf "#include \n\nint main(void){ %s; }\n" "$code" >> "$tmpf" + if [ "$compiler" = "PGI" ]; then + args=" -tp cooperlake -c -o $tmpf.o $tmpf" + else + args=" -march=cooperlake -c -o $tmpf.o $tmpf" + fi + no_avx512bf=0 + { + $compiler_name $flags $args >/dev/null 2>&1 + } || { + no_avx512bf=1 + } + + rm -rf "$tmpd" + fi fi no_rv64gv=0 @@ -409,6 +429,7 @@ done [ "$makefile" = "-" ] && { [ "$no_rv64gv" -eq 1 ] && printf "NO_RV64GV=1\n" [ "$no_avx512" -eq 1 ] && printf "NO_AVX512=1\n" + [ "$no_avx512bf" -eq 1 ] && printf "NO_AVX512BF16=1\n" [ "$no_avx2" -eq 1 ] && printf "NO_AVX2=1\n" [ "$oldgcc" -eq 1 ] && printf "OLDGCC=1\n" exit 0 @@ -437,6 +458,7 @@ done [ "$no_sve" -eq 1 ] && printf "NO_SVE=1\n" [ "$no_rv64gv" -eq 1 ] && printf "NO_RV64GV=1\n" [ "$no_avx512" -eq 1 ] && printf "NO_AVX512=1\n" + [ "$no_avx512bf" -eq 1 ] && printf "NO_AVX512BF16=1\n" [ "$no_avx2" -eq 1 ] && printf "NO_AVX2=1\n" [ "$oldgcc" -eq 1 ] && printf "OLDGCC=1\n" [ "$no_lsx" -eq 1 ] && printf "NO_LSX=1\n" From 995a990e24fdcc8080128a8abc17b4ccc66bd4fd Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Fri, 12 Jan 2024 00:12:46 +0100 Subject: [PATCH 049/311] Make AVX512 BFLOAT16 kernels conditional on compiler capability --- kernel/x86_64/KERNEL.COOPERLAKE | 3 ++- kernel/x86_64/KERNEL.SAPPHIRERAPIDS | 2 ++ 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/kernel/x86_64/KERNEL.COOPERLAKE b/kernel/x86_64/KERNEL.COOPERLAKE index dba94aea8..22b042029 100644 --- a/kernel/x86_64/KERNEL.COOPERLAKE +++ b/kernel/x86_64/KERNEL.COOPERLAKE @@ -1,5 +1,5 @@ include $(KERNELDIR)/KERNEL.SKYLAKEX - +ifneq ($(NO_AVX512BF16), 1) SBGEMM_SMALL_M_PERMIT = sbgemm_small_kernel_permit_cooperlake.c SBGEMM_SMALL_K_NN = sbgemm_small_kernel_nn_cooperlake.c SBGEMM_SMALL_K_B0_NN = sbgemm_small_kernel_nn_cooperlake.c @@ -20,3 +20,4 @@ SBGEMMINCOPYOBJ = sbgemm_incopy$(TSUFFIX).$(SUFFIX) SBGEMMITCOPYOBJ = sbgemm_itcopy$(TSUFFIX).$(SUFFIX) SBGEMMONCOPYOBJ = sbgemm_oncopy$(TSUFFIX).$(SUFFIX) SBGEMMOTCOPYOBJ = sbgemm_otcopy$(TSUFFIX).$(SUFFIX) +endif diff --git a/kernel/x86_64/KERNEL.SAPPHIRERAPIDS b/kernel/x86_64/KERNEL.SAPPHIRERAPIDS index 3a832e917..0ab2b4ddc 100644 --- a/kernel/x86_64/KERNEL.SAPPHIRERAPIDS +++ b/kernel/x86_64/KERNEL.SAPPHIRERAPIDS @@ -1,5 +1,6 @@ include $(KERNELDIR)/KERNEL.COOPERLAKE +ifneq ($(NO_AVX512BF16), 1) SBGEMM_SMALL_M_PERMIT = SBGEMM_SMALL_K_NN = SBGEMM_SMALL_K_B0_NN = @@ -20,3 +21,4 @@ SBGEMMINCOPYOBJ = sbgemm_incopy$(TSUFFIX).$(SUFFIX) SBGEMMITCOPYOBJ = sbgemm_itcopy$(TSUFFIX).$(SUFFIX) SBGEMMONCOPYOBJ = sbgemm_oncopy$(TSUFFIX).$(SUFFIX) SBGEMMOTCOPYOBJ = sbgemm_otcopy$(TSUFFIX).$(SUFFIX) +endif From d1ead06bd8707723e643099aa1072aefa914f660 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Fri, 12 Jan 2024 09:29:13 +0100 Subject: [PATCH 050/311] define NAN and INFINITY if needed --- utest/test_zscal.c | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/utest/test_zscal.c b/utest/test_zscal.c index b6310439f..8992eee90 100644 --- a/utest/test_zscal.c +++ b/utest/test_zscal.c @@ -2,6 +2,13 @@ #include #ifdef BUILD_COMPLEX16 +#ifndef NAN +#define NAN 0.0/0.0 +#endif +#ifndef INFINITY +#define INFINITY 1.0/0.0 +#endif + CTEST(zscal, i_nan) { double i[] = {0,1, 0,1, 0,1, 0,1, 0,1, 0,1, 0,1, 0,1, 0,1 }; From b57627c27f027692a4cc9725784e1b0e2e51bc49 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Fri, 12 Jan 2024 12:03:08 +0100 Subject: [PATCH 051/311] Handle NAN and INF --- kernel/zarch/zscal.c | 18 +++++++++++++++--- 1 file changed, 15 insertions(+), 3 deletions(-) diff --git a/kernel/zarch/zscal.c b/kernel/zarch/zscal.c index d39b8447e..d019d66df 100644 --- a/kernel/zarch/zscal.c +++ b/kernel/zarch/zscal.c @@ -233,9 +233,15 @@ int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT da_r, FLOAT da_i, while (j < n1) { - temp0 = -da_i * x[i + 1]; + if (isnan(x[i]) || isinf(x[i])) + temp0 = NAN; + else + temp0 = -da_i * x[i + 1]; x[i + 1] = da_i * x[i]; x[i] = temp0; + if (isnan(x[i + inc_x]) || isinf(x[i + inc_x])) + temp1 = NAN; + else temp1 = -da_i * x[i + 1 + inc_x]; x[i + 1 + inc_x] = da_i * x[i + inc_x]; x[i + inc_x] = temp1; @@ -246,7 +252,10 @@ int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT da_r, FLOAT da_i, while (j < n) { - temp0 = -da_i * x[i + 1]; + if (isnan(x[i]) || isinf(x[i])) + temp0 = NAN; + else + temp0 = -da_i * x[i + 1]; x[i + 1] = da_i * x[i]; x[i] = temp0; i += inc_x; @@ -347,7 +356,10 @@ int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT da_r, FLOAT da_i, while (j < n) { - temp0 = -da_i * x[i + 1]; + if (isnan(x[i]) || isinf(x[i])) + temp0 = NAN; + else + temp0 = -da_i * x[i + 1]; x[i + 1] = da_i * x[i]; x[i] = temp0; i += 2; From 20413ee6ecb05b4746e107ec61614178e498509b Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Fri, 12 Jan 2024 13:11:13 +0100 Subject: [PATCH 052/311] Update zscal.c --- kernel/zarch/zscal.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/kernel/zarch/zscal.c b/kernel/zarch/zscal.c index d019d66df..4160a1a76 100644 --- a/kernel/zarch/zscal.c +++ b/kernel/zarch/zscal.c @@ -329,7 +329,7 @@ int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT da_r, FLOAT da_i, if (da_i == 0) zscal_kernel_8_zero(n1, x); else - zscal_kernel_8_zero_r(n1, alpha, x); + zscal_kernel_8(n1, da_r, da_i, x); else if (da_i == 0) zscal_kernel_8_zero_i(n1, alpha, x); else From 2e2e538b7c493b727ed9ff160e18f086f5e17384 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Sat, 13 Jan 2024 20:02:43 +0100 Subject: [PATCH 053/311] Add openblas_set_num_threads_local() and use of blas_omp_threads_local in OMP parallel regions --- cblas.h | 1 + common_thread.h | 7 ++++--- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/cblas.h b/cblas.h index 8a5055cf8..ade2fca3a 100644 --- a/cblas.h +++ b/cblas.h @@ -12,6 +12,7 @@ extern "C" { /*Set the number of threads on runtime.*/ void openblas_set_num_threads(int num_threads); void goto_set_num_threads(int num_threads); +int openblas_set_num_threads_local(int num_threads); /*Get the number of threads on runtime.*/ int openblas_get_num_threads(void); diff --git a/common_thread.h b/common_thread.h index 9e7dae74a..d37fcb189 100644 --- a/common_thread.h +++ b/common_thread.h @@ -137,19 +137,20 @@ typedef struct blas_queue { extern int blas_server_avail; extern int blas_omp_number_max; +extern int blas_omp_threads_local; static __inline int num_cpu_avail(int level) { #ifdef USE_OPENMP int openmp_nthreads; openmp_nthreads=omp_get_max_threads(); + if (omp_in_parallel()) openmp_nthreads = blas_omp_threads_local; #endif #ifndef USE_OPENMP if (blas_cpu_number == 1 -#endif -#ifdef USE_OPENMP - if (openmp_nthreads == 1 || omp_in_parallel() +#else + if (openmp_nthreads == 1 #endif ) return 1; From 87d31af2ae8ef42c924d33633968af6262ab4344 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Sat, 13 Jan 2024 20:06:24 +0100 Subject: [PATCH 054/311] Add openblas_set_num_threads_local() --- driver/others/blas_server_omp.c | 1 + driver/others/openblas_set_num_threads.c | 13 +++++++++++++ 2 files changed, 14 insertions(+) diff --git a/driver/others/blas_server_omp.c b/driver/others/blas_server_omp.c index 213531057..4d3d1e0de 100644 --- a/driver/others/blas_server_omp.c +++ b/driver/others/blas_server_omp.c @@ -69,6 +69,7 @@ int blas_server_avail = 0; int blas_omp_number_max = 0; +int blas_omp_threads_local = 1; extern int openblas_omp_adaptive_env(void); diff --git a/driver/others/openblas_set_num_threads.c b/driver/others/openblas_set_num_threads.c index 0b57867b0..c938fde69 100644 --- a/driver/others/openblas_set_num_threads.c +++ b/driver/others/openblas_set_num_threads.c @@ -36,11 +36,20 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #ifdef SMP_SERVER extern void openblas_set_num_threads(int num_threads) ; +extern int openblas_get_num_threads(void) ; void openblas_set_num_threads_(int* num_threads){ openblas_set_num_threads(*num_threads); } +int openblas_set_num_threads_local(int num_threads){ + int ret = openblas_get_num_threads(); + openblas_set_num_threads(num_threads); + blas_omp_threads_local=num_threads; + return ret; +} + + #else //Single thread @@ -50,4 +59,8 @@ void openblas_set_num_threads(int num_threads) { void openblas_set_num_threads_(int* num_threads){ } + +int openblas_set_num_threads_local(int num_threads){ + return 1; +} #endif From bf66af3dc0060af9a7b001470a5300efb8f8313b Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Sat, 13 Jan 2024 20:37:36 +0100 Subject: [PATCH 055/311] remove matrix dimension 6 from DGS to avoid spurious errors from FMA --- lapack-netlib/TESTING/dgd.in | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lapack-netlib/TESTING/dgd.in b/lapack-netlib/TESTING/dgd.in index ca24dd2a0..127b63789 100644 --- a/lapack-netlib/TESTING/dgd.in +++ b/lapack-netlib/TESTING/dgd.in @@ -1,6 +1,6 @@ DGS Data for the Real Nonsymmetric Schur Form Driver 5 Number of matrix dimensions -2 6 10 12 20 30 Matrix dimensions +2 10 12 20 30 Matrix dimensions 1 1 1 2 1 Parameters NB, NBMIN, NXOVER, NS, NBCOL 10 Threshold for test ratios .TRUE. Put T to test the error exits From 9fab60d32f595350d599d5fe901dfaae2ce56592 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Sat, 13 Jan 2024 20:39:05 +0100 Subject: [PATCH 056/311] Remove matrix dimension 6 from SGS to avoid spurious errors from FMA --- lapack-netlib/TESTING/sgd.in | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lapack-netlib/TESTING/sgd.in b/lapack-netlib/TESTING/sgd.in index 164b3cc35..efab6c257 100644 --- a/lapack-netlib/TESTING/sgd.in +++ b/lapack-netlib/TESTING/sgd.in @@ -1,6 +1,6 @@ SGS Data for the Real Nonsymmetric Schur Form Driver 5 Number of matrix dimensions -2 6 10 12 20 30 Matrix dimensions +2 10 12 20 30 Matrix dimensions 1 1 1 2 1 Parameters NB, NBMIN, NXOVER, NS, NBCOL 10 Threshold for test ratios .TRUE. Put T to test the error exits From 8a9d492af7b26f6c94965301783f5895cae9cc3b Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Sun, 14 Jan 2024 19:58:49 +0100 Subject: [PATCH 057/311] Add default for blas_omp_threads_local --- driver/others/blas_server.c | 2 ++ 1 file changed, 2 insertions(+) diff --git a/driver/others/blas_server.c b/driver/others/blas_server.c index 2fcb37192..2531c57e9 100644 --- a/driver/others/blas_server.c +++ b/driver/others/blas_server.c @@ -113,6 +113,8 @@ extern unsigned int openblas_thread_timeout(void); /* We need this global for checking if initialization is finished. */ int blas_server_avail __attribute__((aligned(ATTRIBUTE_SIZE))) = 0; +int blas_omp_threads_local = 1; + /* Local Variables */ #if defined(USE_PTHREAD_LOCK) static pthread_mutex_t server_lock = PTHREAD_MUTEX_INITIALIZER; From 152a6c43b6c61607cc91d5285f94dbef2575ff4f Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Sun, 14 Jan 2024 19:59:55 +0100 Subject: [PATCH 058/311] Add blas_omp_threads_local --- driver/others/blas_server_win32.c | 2 ++ 1 file changed, 2 insertions(+) diff --git a/driver/others/blas_server_win32.c b/driver/others/blas_server_win32.c index 40ff85abc..2d41af228 100644 --- a/driver/others/blas_server_win32.c +++ b/driver/others/blas_server_win32.c @@ -59,6 +59,8 @@ static CRITICAL_SECTION queue_lock; /* We need this global for checking if initialization is finished. */ int blas_server_avail = 0; +int blas_omp_threads_local = 1; + /* Local Variables */ static BLASULONG server_lock = 0; From 0d2e486edfb6919afea1bba62f5ac3ebc460cee0 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Mon, 15 Jan 2024 11:18:59 +0100 Subject: [PATCH 059/311] Handle NAN and INF --- kernel/arm/zscal.c | 1 + 1 file changed, 1 insertion(+) diff --git a/kernel/arm/zscal.c b/kernel/arm/zscal.c index 0521aaa0b..b2d537d04 100644 --- a/kernel/arm/zscal.c +++ b/kernel/arm/zscal.c @@ -60,6 +60,7 @@ int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT da_r,FLOAT da_i, F else { temp = - da_i * x[ip+1] ; + if (isnan(x[ip]) || isinf(x[ip])) temp = NAN; x[ip+1] = da_i * x[ip] ; } } From 025a1b2c7b02c9984c331fde39eb27e492aeb8e1 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Mon, 15 Jan 2024 22:40:21 +0100 Subject: [PATCH 060/311] Only use mtune=native when not cross-compiling --- Makefile.arm64 | 20 ++++++++++++++++---- 1 file changed, 16 insertions(+), 4 deletions(-) diff --git a/Makefile.arm64 b/Makefile.arm64 index 1b10446f7..ed52a9424 100644 --- a/Makefile.arm64 +++ b/Makefile.arm64 @@ -104,9 +104,15 @@ ifneq ($(F_COMPILER), NAG) FCOMMON_OPT += -march=armv8.4-a -mtune=neoverse-v1 endif else -CCOMMON_OPT += -march=armv8.4-a+sve -mtune=native +CCOMMON_OPT += -march=armv8.4-a+sve +ifneq ($(CROSS), 1) +CCOMMON_OPT += -mtune=native +endif ifneq ($(F_COMPILER), NAG) -FCOMMON_OPT += -march=armv8.4-a -mtune=native +FCOMMON_OPT += -march=armv8.4-a +ifneq ($(CROSS), 1) +FCOMMON_OPT += -mtune=native +endif endif endif else @@ -138,9 +144,15 @@ ifneq ($(F_COMPILER), NAG) FCOMMON_OPT += -march=armv8.5-a+sve+sve2+bf16 -mtune=neoverse-n2 endif else -CCOMMON_OPT += -march=armv8.5-a+sve -mtune=native +CCOMMON_OPT += -march=armv8.5-a+sve +ifneq ($(CROSS), 1) +CCOMMON_OPT += -mtune=native +endif ifneq ($(F_COMPILER), NAG) -FCOMMON_OPT += -march=armv8.5-a -mtune=native +FCOMMON_OPT += -march=armv8.5-a +ifneq ($(CROSS), 1) +FCOMMON_OPT += -mtune=native +endif endif endif else From 8f4e325ea82f5d5f3791b147208cbaae8dde8f64 Mon Sep 17 00:00:00 2001 From: Ian McInerney Date: Mon, 15 Jan 2024 23:42:03 +0000 Subject: [PATCH 061/311] Fix Clang sapphire rapids march flag --- Makefile.x86_64 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/Makefile.x86_64 b/Makefile.x86_64 index 702447ace..c0dbe84c8 100644 --- a/Makefile.x86_64 +++ b/Makefile.x86_64 @@ -130,11 +130,11 @@ ifeq ($(C_COMPILER), GCC) endif endif else ifeq ($(C_COMPILER), CLANG) - # cooperlake support was added in clang 12 + # sapphire rapids support was added in clang 12 ifeq ($(CLANGVERSIONGTEQ12), 1) - CCOMMON_OPT += -march=cooperlake + CCOMMON_OPT += -march=sapphirerapids ifneq ($(F_COMPILER), NAG) - FCOMMON_OPT += -march=cooperlake + FCOMMON_OPT += -march=sapphirerapids endif else # not supported in clang, fallback to avx512 CCOMMON_OPT += -march=skylake-avx512 From 9edb805e645d3530e907864e242a3f64a881b28a Mon Sep 17 00:00:00 2001 From: Sergei Lewis Date: Tue, 16 Jan 2024 14:24:18 +0000 Subject: [PATCH 062/311] fix builds with t-head toolchains that use old versions of the intrinsics spec --- common_riscv64.h | 17 +++++- cpuid_riscv64.c | 4 +- kernel/riscv64/amax_vector.c | 18 +++--- kernel/riscv64/amin_vector.c | 18 +++--- kernel/riscv64/asum_vector.c | 20 ++++--- kernel/riscv64/axpby_vector.c | 16 +++--- kernel/riscv64/axpy_vector.c | 12 ++-- kernel/riscv64/copy_vector.c | 14 ++--- kernel/riscv64/dot_vector.c | 44 +++++++++------ kernel/riscv64/gemv_n_vector.c | 24 ++++---- kernel/riscv64/gemv_t_vector.c | 42 ++++++++------ kernel/riscv64/iamax_vector.c | 80 +++++++++++++++------------ kernel/riscv64/iamin_vector.c | 82 ++++++++++++++++------------ kernel/riscv64/imax_vector.c | 82 ++++++++++++++++------------ kernel/riscv64/imin_vector.c | 80 ++++++++++++++++----------- kernel/riscv64/izamax_vector.c | 94 ++++++++++++++++++-------------- kernel/riscv64/izamin_vector.c | 92 ++++++++++++++++++------------- kernel/riscv64/max_vector.c | 20 ++++--- kernel/riscv64/min_vector.c | 20 ++++--- kernel/riscv64/nrm2_vector.c | 64 ++++++++++++---------- kernel/riscv64/rot_vector.c | 36 ++++++------ kernel/riscv64/scal_vector.c | 14 ++--- kernel/riscv64/sum_vector.c | 32 +++++------ kernel/riscv64/swap_vector.c | 10 ++-- kernel/riscv64/symv_L_vector.c | 56 +++++++++++-------- kernel/riscv64/symv_U_vector.c | 60 +++++++++++--------- kernel/riscv64/zamax_vector.c | 25 +++++---- kernel/riscv64/zamin_vector.c | 25 +++++---- kernel/riscv64/zasum_vector.c | 22 +++++--- kernel/riscv64/zaxpby_vector.c | 32 +++++------ kernel/riscv64/zaxpy_vector.c | 20 +++---- kernel/riscv64/zcopy_vector.c | 12 ++-- kernel/riscv64/zdot_vector.c | 60 +++++++++++--------- kernel/riscv64/zgemv_n_vector.c | 28 +++++----- kernel/riscv64/zgemv_t_vector.c | 56 +++++++++++-------- kernel/riscv64/zhemv_LM_vector.c | 60 +++++++++++--------- kernel/riscv64/zhemv_UV_vector.c | 60 +++++++++++--------- kernel/riscv64/znrm2_vector.c | 51 +++++++++-------- kernel/riscv64/zrot_vector.c | 36 ++++++------ kernel/riscv64/zscal_vector.c | 32 +++++------ kernel/riscv64/zsum_vector.c | 16 +++--- kernel/riscv64/zswap_vector.c | 10 ++-- 42 files changed, 900 insertions(+), 696 deletions(-) diff --git a/common_riscv64.h b/common_riscv64.h index de79c8cab..f11e8b75d 100644 --- a/common_riscv64.h +++ b/common_riscv64.h @@ -91,12 +91,23 @@ static inline int blas_quickdivide(blasint x, blasint y){ #define BUFFER_SIZE ( 32 << 20) #define SEEK_ADDRESS -#if defined(C910V) || defined(RISCV64_ZVL256B) || defined(__riscv_v) +#if defined(C910V) || (defined(RISCV64_ZVL256B) && (defined(__clang__) || defined(RVV_COMPATIBLE_GCC))) # include +#endif + +#if defined( __riscv_xtheadc ) && defined( __riscv_v ) && ( __riscv_v <= 7000 ) +// t-head toolchain uses obsolete rvv intrinsics, can't build for C910V without this +#define RISCV_0p10_INTRINSICS +#define RISCV_RVV(x) x +#else +#define RISCV_RVV(x) __riscv_ ## x +#endif + +#if defined(C910V) || defined(RISCV64_ZVL256B) # if !defined(DOUBLE) -# define EXTRACT_FLOAT(v) __riscv_vfmv_f_s_f32m1_f32(v) +# define EXTRACT_FLOAT(v) RISCV_RVV(vfmv_f_s_f32m1_f32)(v) # else -# define EXTRACT_FLOAT(v) __riscv_vfmv_f_s_f64m1_f64(v) +# define EXTRACT_FLOAT(v) RISCV_RVV(vfmv_f_s_f64m1_f64)(v) # endif #else # define EXTRACT_FLOAT(v) (v[0]) diff --git a/cpuid_riscv64.c b/cpuid_riscv64.c index 1b6b62f21..928b5ba92 100644 --- a/cpuid_riscv64.c +++ b/cpuid_riscv64.c @@ -72,11 +72,13 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define CPU_GENERIC 0 #define CPU_C910V 1 -#define CPU_RISCV64_ZVL256B 2 +#define CPU_x280 2 +#define CPU_RISCV64_ZVL256B 3 static char *cpuname[] = { "RISCV64_GENERIC", "C910V", + "x280", "CPU_RISCV64_ZVL256B" }; diff --git a/kernel/riscv64/amax_vector.c b/kernel/riscv64/amax_vector.c index 81a39af32..b66d4871e 100644 --- a/kernel/riscv64/amax_vector.c +++ b/kernel/riscv64/amax_vector.c @@ -49,15 +49,19 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define JOIN2(x, y) JOIN2_X(x, y) #define JOIN(v, w, x, y, z) JOIN2( JOIN2( JOIN2( JOIN2( v, w ), x), y), z) -#define VSETVL JOIN(__riscv_vsetvl, _e, ELEN, LMUL, _) +#define VSETVL JOIN(RISCV_RVV(vsetvl), _e, ELEN, LMUL, _) #define FLOAT_V_T JOIN(vfloat, ELEN, LMUL, _t, _) #define FLOAT_V_T_M1 JOIN(vfloat, ELEN, m1, _t, _) -#define VLEV_FLOAT JOIN(__riscv_vle, ELEN, _v_f, ELEN, LMUL) -#define VLSEV_FLOAT JOIN(__riscv_vlse, ELEN, _v_f, ELEN, LMUL) -#define VFREDMAXVS_FLOAT JOIN(__riscv_vfredmax_vs_f, ELEN, LMUL, _f, JOIN2( ELEN, m1)) -#define VFABS_FLOAT JOIN(__riscv_vfabs, _v_f, ELEN, LMUL, _) -#define VFMVVF_FLOAT JOIN(__riscv_vfmv, _v_f_f, ELEN, LMUL, _) -#define VFMVVF_FLOAT_M1 JOIN(__riscv_vfmv, _v_f_f, ELEN, m1, _) +#define VLEV_FLOAT JOIN(RISCV_RVV(vle), ELEN, _v_f, ELEN, LMUL) +#define VLSEV_FLOAT JOIN(RISCV_RVV(vlse), ELEN, _v_f, ELEN, LMUL) +#ifdef RISCV_0p10_INTRINSICS +#define VFREDMAXVS_FLOAT(va, vb, gvl) JOIN(RISCV_RVV(vfredmax_vs_f), ELEN, LMUL, _f, JOIN2( ELEN, m1))(v_res, va, vb, gvl) +#else +#define VFREDMAXVS_FLOAT JOIN(RISCV_RVV(vfredmax_vs_f), ELEN, LMUL, _f, JOIN2( ELEN, m1)) +#endif +#define VFABS_FLOAT JOIN(RISCV_RVV(vfabs), _v_f, ELEN, LMUL, _) +#define VFMVVF_FLOAT JOIN(RISCV_RVV(vfmv), _v_f_f, ELEN, LMUL, _) +#define VFMVVF_FLOAT_M1 JOIN(RISCV_RVV(vfmv), _v_f_f, ELEN, m1, _) FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) { diff --git a/kernel/riscv64/amin_vector.c b/kernel/riscv64/amin_vector.c index c8ba75f4a..1c541f0fd 100644 --- a/kernel/riscv64/amin_vector.c +++ b/kernel/riscv64/amin_vector.c @@ -48,15 +48,19 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define JOIN2(x, y) JOIN2_X(x, y) #define JOIN(v, w, x, y, z) JOIN2( JOIN2( JOIN2( JOIN2( v, w ), x), y), z) -#define VSETVL JOIN(__riscv_vsetvl, _e, ELEN, LMUL, _) +#define VSETVL JOIN(RISCV_RVV(vsetvl), _e, ELEN, LMUL, _) #define FLOAT_V_T JOIN(vfloat, ELEN, LMUL, _t, _) #define FLOAT_V_T_M1 JOIN(vfloat, ELEN, m1, _t, _) -#define VLEV_FLOAT JOIN(__riscv_vle, ELEN, _v_f, ELEN, LMUL) -#define VLSEV_FLOAT JOIN(__riscv_vlse, ELEN, _v_f, ELEN, LMUL) -#define VFREDMINVS_FLOAT JOIN(__riscv_vfredmin_vs_f, ELEN, LMUL, _f, JOIN2( ELEN, m1)) -#define VFABS_FLOAT JOIN(__riscv_vfabs, _v_f, ELEN, LMUL, _) -#define VFMVVF_FLOAT JOIN(__riscv_vfmv, _v_f_f ELEN, LMUL, _) -#define VFMVVF_FLOAT_M1 JOIN(__riscv_vfmv, _v_f_f, ELEN, m1, _) +#define VLEV_FLOAT JOIN(RISCV_RVV(vle), ELEN, _v_f, ELEN, LMUL) +#define VLSEV_FLOAT JOIN(RISCV_RVV(vlse), ELEN, _v_f, ELEN, LMUL) +#ifdef RISCV_0p10_INTRINSICS +#define VFREDMINVS_FLOAT(va, vb, gvl) JOIN(RISCV_RVV(vfredmin_vs_f), ELEN, LMUL, _f, JOIN2( ELEN, m1))(v_res, va, vb, gvl) +#else +#define VFREDMINVS_FLOAT JOIN(RISCV_RVV(vfredmin_vs_f), ELEN, LMUL, _f, JOIN2( ELEN, m1)) +#endif +#define VFABS_FLOAT JOIN(RISCV_RVV(vfabs), _v_f, ELEN, LMUL, _) +#define VFMVVF_FLOAT JOIN(RISCV_RVV(vfmv), _v_f_f ELEN, LMUL, _) +#define VFMVVF_FLOAT_M1 JOIN(RISCV_RVV(vfmv), _v_f_f, ELEN, m1, _) FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) { diff --git a/kernel/riscv64/asum_vector.c b/kernel/riscv64/asum_vector.c index d10bf99e6..995dbf9a1 100644 --- a/kernel/riscv64/asum_vector.c +++ b/kernel/riscv64/asum_vector.c @@ -49,16 +49,20 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define JOIN2(x, y) JOIN2_X(x, y) #define JOIN(v, w, x, y, z) JOIN2( JOIN2( JOIN2( JOIN2( v, w ), x), y), z) -#define VSETVL JOIN(__riscv_vsetvl, _e, ELEN, LMUL, _) +#define VSETVL JOIN(RISCV_RVV(vsetvl), _e, ELEN, LMUL, _) #define FLOAT_V_T JOIN(vfloat, ELEN, LMUL, _t, _) #define FLOAT_V_T_M1 JOIN(vfloat, ELEN, m1, _t, _) -#define VLEV_FLOAT JOIN(__riscv_vle, ELEN, _v_f, ELEN, LMUL) -#define VLSEV_FLOAT JOIN(__riscv_vlse, ELEN, _v_f, ELEN, LMUL) -#define VFREDSUMVS_FLOAT JOIN(__riscv_vfredusum_vs_f, ELEN, LMUL, _f, JOIN2( ELEN, m1)) -#define VFABS_FLOAT JOIN(__riscv_vfabs, _v_f, ELEN, LMUL, _) -#define VFMVVF_FLOAT JOIN(__riscv_vfmv, _v_f_f, ELEN, LMUL, _) -#define VFMVVF_FLOAT_M1 JOIN(__riscv_vfmv, _v_f_f, ELEN, m1, _) -#define VFADDVV_FLOAT JOIN(__riscv_vfadd, _vv_f, ELEN, LMUL, _) +#define VLEV_FLOAT JOIN(RISCV_RVV(vle), ELEN, _v_f, ELEN, LMUL) +#define VLSEV_FLOAT JOIN(RISCV_RVV(vlse), ELEN, _v_f, ELEN, LMUL) +#ifdef RISCV_0p10_INTRINSICS +#define VFREDSUMVS_FLOAT(va, vb, gvl) JOIN(RISCV_RVV(vfredusum_vs_f), ELEN, LMUL, _f, JOIN2( ELEN, m1))(v_res, va, vb, gvl) +#else +#define VFREDSUMVS_FLOAT JOIN(RISCV_RVV(vfredusum_vs_f), ELEN, LMUL, _f, JOIN2( ELEN, m1)) +#endif +#define VFABS_FLOAT JOIN(RISCV_RVV(vfabs), _v_f, ELEN, LMUL, _) +#define VFMVVF_FLOAT JOIN(RISCV_RVV(vfmv), _v_f_f, ELEN, LMUL, _) +#define VFMVVF_FLOAT_M1 JOIN(RISCV_RVV(vfmv), _v_f_f, ELEN, m1, _) +#define VFADDVV_FLOAT JOIN(RISCV_RVV(vfadd), _vv_f, ELEN, LMUL, _) FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) { diff --git a/kernel/riscv64/axpby_vector.c b/kernel/riscv64/axpby_vector.c index b77cb58fb..386c4a5f1 100644 --- a/kernel/riscv64/axpby_vector.c +++ b/kernel/riscv64/axpby_vector.c @@ -48,15 +48,15 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define JOIN2(x, y) JOIN2_X(x, y) #define JOIN(v, w, x, y, z) JOIN2( JOIN2( JOIN2( JOIN2( v, w ), x), y), z) -#define VSETVL JOIN(__riscv_vsetvl, _e, ELEN, LMUL, _) +#define VSETVL JOIN(RISCV_RVV(vsetvl), _e, ELEN, LMUL, _) #define FLOAT_V_T JOIN(vfloat, ELEN, LMUL, _t, _) -#define VLEV_FLOAT JOIN(__riscv_vle, ELEN, _v_f, ELEN, LMUL) -#define VLSEV_FLOAT JOIN(__riscv_vlse, ELEN, _v_f, ELEN, LMUL) -#define VSEV_FLOAT JOIN(__riscv_vse, ELEN, _v_f, ELEN, LMUL) -#define VSSEV_FLOAT JOIN(__riscv_vsse, ELEN, _v_f, ELEN, LMUL) -#define VFMACCVF_FLOAT JOIN(__riscv_vfmacc, _vf_f, ELEN, LMUL, _) -#define VFMVVF_FLOAT JOIN(__riscv_vfmv, _v_f_f, ELEN, LMUL, _) -#define VFMULVF_FLOAT JOIN(__riscv_vfmul, _vf_f, ELEN, LMUL, _) +#define VLEV_FLOAT JOIN(RISCV_RVV(vle), ELEN, _v_f, ELEN, LMUL) +#define VLSEV_FLOAT JOIN(RISCV_RVV(vlse), ELEN, _v_f, ELEN, LMUL) +#define VSEV_FLOAT JOIN(RISCV_RVV(vse), ELEN, _v_f, ELEN, LMUL) +#define VSSEV_FLOAT JOIN(RISCV_RVV(vsse), ELEN, _v_f, ELEN, LMUL) +#define VFMACCVF_FLOAT JOIN(RISCV_RVV(vfmacc), _vf_f, ELEN, LMUL, _) +#define VFMVVF_FLOAT JOIN(RISCV_RVV(vfmv), _v_f_f, ELEN, LMUL, _) +#define VFMULVF_FLOAT JOIN(RISCV_RVV(vfmul), _vf_f, ELEN, LMUL, _) int CNAME(BLASLONG n, FLOAT alpha, FLOAT *x, BLASLONG inc_x, FLOAT beta, FLOAT *y, BLASLONG inc_y) { diff --git a/kernel/riscv64/axpy_vector.c b/kernel/riscv64/axpy_vector.c index 3447107a6..e99ca8542 100644 --- a/kernel/riscv64/axpy_vector.c +++ b/kernel/riscv64/axpy_vector.c @@ -49,13 +49,13 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define JOIN2(x, y) JOIN2_X(x, y) #define JOIN(v, w, x, y, z) JOIN2( JOIN2( JOIN2( JOIN2( v, w ), x), y), z) -#define VSETVL JOIN(__riscv_vsetvl, _e, ELEN, LMUL, _) +#define VSETVL JOIN(RISCV_RVV(vsetvl), _e, ELEN, LMUL, _) #define FLOAT_V_T JOIN(vfloat, ELEN, LMUL, _t, _) -#define VLEV_FLOAT JOIN(__riscv_vle, ELEN, _v_f, ELEN, LMUL) -#define VLSEV_FLOAT JOIN(__riscv_vlse, ELEN, _v_f, ELEN, LMUL) -#define VSEV_FLOAT JOIN(__riscv_vse, ELEN, _v_f, ELEN, LMUL) -#define VSSEV_FLOAT JOIN(__riscv_vsse, ELEN, _v_f, ELEN, LMUL) -#define VFMACCVF_FLOAT JOIN(__riscv_vfmacc, _vf_f, ELEN, LMUL, _) +#define VLEV_FLOAT JOIN(RISCV_RVV(vle), ELEN, _v_f, ELEN, LMUL) +#define VLSEV_FLOAT JOIN(RISCV_RVV(vlse), ELEN, _v_f, ELEN, LMUL) +#define VSEV_FLOAT JOIN(RISCV_RVV(vse), ELEN, _v_f, ELEN, LMUL) +#define VSSEV_FLOAT JOIN(RISCV_RVV(vsse), ELEN, _v_f, ELEN, LMUL) +#define VFMACCVF_FLOAT JOIN(RISCV_RVV(vfmacc), _vf_f, ELEN, LMUL, _) int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT da, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y, FLOAT *dummy, BLASLONG dummy2) { diff --git a/kernel/riscv64/copy_vector.c b/kernel/riscv64/copy_vector.c index 710e8670a..ccbd6e482 100644 --- a/kernel/riscv64/copy_vector.c +++ b/kernel/riscv64/copy_vector.c @@ -47,12 +47,12 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define JOIN2(x, y) JOIN2_X(x, y) #define JOIN(v, w, x, y, z) JOIN2( JOIN2( JOIN2( JOIN2( v, w ), x), y), z) -#define VSETVL JOIN(__riscv_vsetvl, _e, ELEN, LMUL, _) +#define VSETVL JOIN(RISCV_RVV(vsetvl), _e, ELEN, LMUL, _) #define FLOAT_V_T JOIN(vfloat, ELEN, LMUL, _t, _) -#define VLEV_FLOAT JOIN(__riscv_vle, ELEN, _v_f, ELEN, LMUL) -#define VLSEV_FLOAT JOIN(__riscv_vlse, ELEN, _v_f, ELEN, LMUL) -#define VSEV_FLOAT JOIN(__riscv_vse, ELEN, _v_f, ELEN, LMUL) -#define VSSEV_FLOAT JOIN(__riscv_vsse, ELEN, _v_f, ELEN, LMUL) +#define VLEV_FLOAT JOIN(RISCV_RVV(vle), ELEN, _v_f, ELEN, LMUL) +#define VLSEV_FLOAT JOIN(RISCV_RVV(vlse), ELEN, _v_f, ELEN, LMUL) +#define VSEV_FLOAT JOIN(RISCV_RVV(vse), ELEN, _v_f, ELEN, LMUL) +#define VSSEV_FLOAT JOIN(RISCV_RVV(vsse), ELEN, _v_f, ELEN, LMUL) int CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y) { @@ -71,7 +71,7 @@ int CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y) stride_x = inc_x * sizeof(FLOAT); if(gvl <= n/4){ BLASLONG inc_xv = inc_x * gvl; - BLASLONG gvl3 = gvl * 3; + unsigned int gvl3 = gvl * 3; BLASLONG inc_xv3 = inc_xv * 3; for(i=0,j=0; i #if !defined(DOUBLE) -#define VSETVL(n) __riscv_vsetvl_e32m8(n) -#define VSETVL_MAX __riscv_vsetvlmax_e32m1() +#define VSETVL(n) RISCV_RVV(vsetvl_e32m8)(n) +#define VSETVL_MAX RISCV_RVV(vsetvlmax_e32m1)() #define FLOAT_V_T vfloat32m8_t #define FLOAT_V_T_M1 vfloat32m1_t -#define VLEV_FLOAT __riscv_vle32_v_f32m8 -#define VLSEV_FLOAT __riscv_vlse32_v_f32m8 -#define VFREDSUMVS_FLOAT __riscv_vfredusum_vs_f32m8_f32m1 -#define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m8 -#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f32m1 -#define VFADDVV_FLOAT __riscv_vfadd_vv_f32m8 +#define VLEV_FLOAT RISCV_RVV(vle32_v_f32m8) +#define VLSEV_FLOAT RISCV_RVV(vlse32_v_f32m8) +#define VFREDSUMVS_FLOAT RISCV_RVV(vfredusum_vs_f32m8_f32m1) +#define VFMVVF_FLOAT RISCV_RVV(vfmv_v_f_f32m8) +#define VFMVVF_FLOAT_M1 RISCV_RVV(vfmv_v_f_f32m1) +#define VFADDVV_FLOAT RISCV_RVV(vfadd_vv_f32m8) #else -#define VSETVL(n) __riscv_vsetvl_e64m8(n) -#define VSETVL_MAX __riscv_vsetvlmax_e64m1() +#define VSETVL(n) RISCV_RVV(vsetvl_e64m8)(n) +#define VSETVL_MAX RISCV_RVV(vsetvlmax_e64m1)() #define FLOAT_V_T vfloat64m8_t #define FLOAT_V_T_M1 vfloat64m1_t -#define VLEV_FLOAT __riscv_vle64_v_f64m8 -#define VLSEV_FLOAT __riscv_vlse64_v_f64m8 -#define VFREDSUMVS_FLOAT __riscv_vfredusum_vs_f64m8_f64m1 -#define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m8 -#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f64m1 -#define VFADDVV_FLOAT __riscv_vfadd_vv_f64m8 +#define VLEV_FLOAT RISCV_RVV(vle64_v_f64m8) +#define VLSEV_FLOAT RISCV_RVV(vlse64_v_f64m8) +#define VFREDSUMVS_FLOAT RISCV_RVV(vfredusum_vs_f64m8_f64m1) +#define VFMVVF_FLOAT RISCV_RVV(vfmv_v_f_f64m8) +#define VFMVVF_FLOAT_M1 RISCV_RVV(vfmv_v_f_f64m1) +#define VFADDVV_FLOAT RISCV_RVV(vfadd_vv_f64m8) #endif FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) { diff --git a/kernel/riscv64/swap_vector.c b/kernel/riscv64/swap_vector.c index baf3d8f69..3b467a586 100644 --- a/kernel/riscv64/swap_vector.c +++ b/kernel/riscv64/swap_vector.c @@ -53,12 +53,12 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define JOIN2(x, y) JOIN2_X(x, y) #define JOIN(v, w, x, y, z) JOIN2( JOIN2( JOIN2( JOIN2( v, w ), x), y), z) -#define VSETVL JOIN(__riscv_vsetvl, _e, ELEN, LMUL, _) +#define VSETVL JOIN(RISCV_RVV(vsetvl), _e, ELEN, LMUL, _) #define FLOAT_V_T JOIN(vfloat, ELEN, LMUL, _t, _) -#define VLEV_FLOAT JOIN(__riscv_vle, ELEN, _v_f, ELEN, LMUL) -#define VLSEV_FLOAT JOIN(__riscv_vlse, ELEN, _v_f, ELEN, LMUL) -#define VSEV_FLOAT JOIN(__riscv_vse, ELEN, _v_f, ELEN, LMUL) -#define VSSEV_FLOAT JOIN(__riscv_vsse, ELEN, _v_f, ELEN, LMUL) +#define VLEV_FLOAT JOIN(RISCV_RVV(vle), ELEN, _v_f, ELEN, LMUL) +#define VLSEV_FLOAT JOIN(RISCV_RVV(vlse), ELEN, _v_f, ELEN, LMUL) +#define VSEV_FLOAT JOIN(RISCV_RVV(vse), ELEN, _v_f, ELEN, LMUL) +#define VSSEV_FLOAT JOIN(RISCV_RVV(vsse), ELEN, _v_f, ELEN, LMUL) int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT dummy3, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y, FLOAT *dummy, BLASLONG dummy2) { diff --git a/kernel/riscv64/symv_L_vector.c b/kernel/riscv64/symv_L_vector.c index f3b922195..cd89c63ec 100644 --- a/kernel/riscv64/symv_L_vector.c +++ b/kernel/riscv64/symv_L_vector.c @@ -27,35 +27,43 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include "common.h" #if !defined(DOUBLE) -#define VSETVL(n) __riscv_vsetvl_e32m4(n) -#define VSETVL_MAX __riscv_vsetvlmax_e32m1() +#define VSETVL(n) RISCV_RVV(vsetvl_e32m4)(n) +#define VSETVL_MAX RISCV_RVV(vsetvlmax_e32m1)() #define FLOAT_V_T vfloat32m4_t #define FLOAT_V_T_M1 vfloat32m1_t -#define VLEV_FLOAT __riscv_vle32_v_f32m4 -#define VLSEV_FLOAT __riscv_vlse32_v_f32m4 -#define VSEV_FLOAT __riscv_vse32_v_f32m4 -#define VSSEV_FLOAT __riscv_vsse32_v_f32m4 -#define VFREDSUM_FLOAT __riscv_vfredusum_vs_f32m4_f32m1 -#define VFMACCVV_FLOAT __riscv_vfmacc_vv_f32m4 -#define VFMACCVF_FLOAT __riscv_vfmacc_vf_f32m4 -#define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m4 -#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f32m1 -#define VFMULVV_FLOAT __riscv_vfmul_vv_f32m4 +#define VLEV_FLOAT RISCV_RVV(vle32_v_f32m4) +#define VLSEV_FLOAT RISCV_RVV(vlse32_v_f32m4) +#define VSEV_FLOAT RISCV_RVV(vse32_v_f32m4) +#define VSSEV_FLOAT RISCV_RVV(vsse32_v_f32m4) +#ifdef RISCV_0p10_INTRINSICS +#define VFREDSUM_FLOAT(va, vb, gvl) vfredusum_vs_f32m4_f32m1(v_res, va, vb, gvl) #else -#define VSETVL(n) __riscv_vsetvl_e64m4(n) -#define VSETVL_MAX __riscv_vsetvlmax_e64m1() +#define VFREDSUM_FLOAT RISCV_RVV(vfredusum_vs_f32m4_f32m1) +#endif +#define VFMACCVV_FLOAT RISCV_RVV(vfmacc_vv_f32m4) +#define VFMACCVF_FLOAT RISCV_RVV(vfmacc_vf_f32m4) +#define VFMVVF_FLOAT RISCV_RVV(vfmv_v_f_f32m4) +#define VFMVVF_FLOAT_M1 RISCV_RVV(vfmv_v_f_f32m1) +#define VFMULVV_FLOAT RISCV_RVV(vfmul_vv_f32m4) +#else +#define VSETVL(n) RISCV_RVV(vsetvl_e64m4)(n) +#define VSETVL_MAX RISCV_RVV(vsetvlmax_e64m1)() #define FLOAT_V_T vfloat64m4_t #define FLOAT_V_T_M1 vfloat64m1_t -#define VLEV_FLOAT __riscv_vle64_v_f64m4 -#define VLSEV_FLOAT __riscv_vlse64_v_f64m4 -#define VSEV_FLOAT __riscv_vse64_v_f64m4 -#define VSSEV_FLOAT __riscv_vsse64_v_f64m4 -#define VFREDSUM_FLOAT __riscv_vfredusum_vs_f64m4_f64m1 -#define VFMACCVV_FLOAT __riscv_vfmacc_vv_f64m4 -#define VFMACCVF_FLOAT __riscv_vfmacc_vf_f64m4 -#define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m4 -#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f64m1 -#define VFMULVV_FLOAT __riscv_vfmul_vv_f64m4 +#define VLEV_FLOAT RISCV_RVV(vle64_v_f64m4) +#define VLSEV_FLOAT RISCV_RVV(vlse64_v_f64m4) +#define VSEV_FLOAT RISCV_RVV(vse64_v_f64m4) +#define VSSEV_FLOAT RISCV_RVV(vsse64_v_f64m4) +#ifdef RISCV_0p10_INTRINSICS +#define VFREDSUM_FLOAT(va, vb, gvl) vfredusum_vs_f64m4_f64m1(v_res, va, vb, gvl) +#else +#define VFREDSUM_FLOAT RISCV_RVV(vfredusum_vs_f64m4_f64m1) +#endif +#define VFMACCVV_FLOAT RISCV_RVV(vfmacc_vv_f64m4) +#define VFMACCVF_FLOAT RISCV_RVV(vfmacc_vf_f64m4) +#define VFMVVF_FLOAT RISCV_RVV(vfmv_v_f_f64m4) +#define VFMVVF_FLOAT_M1 RISCV_RVV(vfmv_v_f_f64m1) +#define VFMULVV_FLOAT RISCV_RVV(vfmul_vv_f64m4) #endif int CNAME(BLASLONG m, BLASLONG offset, FLOAT alpha, FLOAT *a, BLASLONG lda, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y, FLOAT *buffer) diff --git a/kernel/riscv64/symv_U_vector.c b/kernel/riscv64/symv_U_vector.c index 9977e2741..894c6a643 100644 --- a/kernel/riscv64/symv_U_vector.c +++ b/kernel/riscv64/symv_U_vector.c @@ -27,37 +27,45 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include "common.h" #if !defined(DOUBLE) -#define VSETVL(n) __riscv_vsetvl_e32m4(n) -#define VSETVL_MAX __riscv_vsetvlmax_e32m1() +#define VSETVL(n) RISCV_RVV(vsetvl_e32m4)(n) +#define VSETVL_MAX RISCV_RVV(vsetvlmax_e32m1)() #define FLOAT_V_T vfloat32m4_t #define FLOAT_V_T_M1 vfloat32m1_t -#define VLEV_FLOAT __riscv_vle32_v_f32m4 -#define VLSEV_FLOAT __riscv_vlse32_v_f32m4 -#define VSEV_FLOAT __riscv_vse32_v_f32m4 -#define VSSEV_FLOAT __riscv_vsse32_v_f32m4 -#define VFREDSUM_FLOAT __riscv_vfredusum_vs_f32m4_f32m1 -#define VFMACCVV_FLOAT __riscv_vfmacc_vv_f32m4 -#define VFMACCVF_FLOAT __riscv_vfmacc_vf_f32m4 -#define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m4 -#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f32m1 -#define VFDOTVV_FLOAT __riscv_vfdot_vv_f32m4 -#define VFMULVV_FLOAT __riscv_vfmul_vv_f32m4 +#define VLEV_FLOAT RISCV_RVV(vle32_v_f32m4) +#define VLSEV_FLOAT RISCV_RVV(vlse32_v_f32m4) +#define VSEV_FLOAT RISCV_RVV(vse32_v_f32m4) +#define VSSEV_FLOAT RISCV_RVV(vsse32_v_f32m4) +#ifdef RISCV_0p10_INTRINSICS +#define VFREDSUM_FLOAT(va, vb, gvl) vfredusum_vs_f32m4_f32m1(v_res, va, vb, gvl) #else -#define VSETVL(n) __riscv_vsetvl_e64m4(n) -#define VSETVL_MAX __riscv_vsetvlmax_e64m1() +#define VFREDSUM_FLOAT RISCV_RVV(vfredusum_vs_f32m4_f32m1) +#endif +#define VFMACCVV_FLOAT RISCV_RVV(vfmacc_vv_f32m4) +#define VFMACCVF_FLOAT RISCV_RVV(vfmacc_vf_f32m4) +#define VFMVVF_FLOAT RISCV_RVV(vfmv_v_f_f32m4) +#define VFMVVF_FLOAT_M1 RISCV_RVV(vfmv_v_f_f32m1) +#define VFDOTVV_FLOAT RISCV_RVV(vfdot_vv_f32m4) +#define VFMULVV_FLOAT RISCV_RVV(vfmul_vv_f32m4) +#else +#define VSETVL(n) RISCV_RVV(vsetvl_e64m4)(n) +#define VSETVL_MAX RISCV_RVV(vsetvlmax_e64m1)() #define FLOAT_V_T vfloat64m4_t #define FLOAT_V_T_M1 vfloat64m1_t -#define VLEV_FLOAT __riscv_vle64_v_f64m4 -#define VLSEV_FLOAT __riscv_vlse64_v_f64m4 -#define VSEV_FLOAT __riscv_vse64_v_f64m4 -#define VSSEV_FLOAT __riscv_vsse64_v_f64m4 -#define VFREDSUM_FLOAT __riscv_vfredusum_vs_f64m4_f64m1 -#define VFMACCVV_FLOAT __riscv_vfmacc_vv_f64m4 -#define VFMACCVF_FLOAT __riscv_vfmacc_vf_f64m4 -#define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m4 -#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f64m1 -#define VFDOTVV_FLOAT __riscv_vfdot_vv_f64m4 -#define VFMULVV_FLOAT __riscv_vfmul_vv_f64m4 +#define VLEV_FLOAT RISCV_RVV(vle64_v_f64m4) +#define VLSEV_FLOAT RISCV_RVV(vlse64_v_f64m4) +#define VSEV_FLOAT RISCV_RVV(vse64_v_f64m4) +#define VSSEV_FLOAT RISCV_RVV(vsse64_v_f64m4) +#ifdef RISCV_0p10_INTRINSICS +#define VFREDSUM_FLOAT(va, vb, gvl) vfredusum_vs_f64m4_f64m1(v_res, va, vb, gvl) +#else +#define VFREDSUM_FLOAT RISCV_RVV(vfredusum_vs_f64m4_f64m1) +#endif +#define VFMACCVV_FLOAT RISCV_RVV(vfmacc_vv_f64m4) +#define VFMACCVF_FLOAT RISCV_RVV(vfmacc_vf_f64m4) +#define VFMVVF_FLOAT RISCV_RVV(vfmv_v_f_f64m4) +#define VFMVVF_FLOAT_M1 RISCV_RVV(vfmv_v_f_f64m1) +#define VFDOTVV_FLOAT RISCV_RVV(vfdot_vv_f64m4) +#define VFMULVV_FLOAT RISCV_RVV(vfmul_vv_f64m4) #endif int CNAME(BLASLONG m, BLASLONG offset, FLOAT alpha, FLOAT *a, BLASLONG lda, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y, FLOAT *buffer) diff --git a/kernel/riscv64/zamax_vector.c b/kernel/riscv64/zamax_vector.c index 4301528bd..2dee5ab29 100644 --- a/kernel/riscv64/zamax_vector.c +++ b/kernel/riscv64/zamax_vector.c @@ -53,19 +53,24 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define JOIN2(x, y) JOIN2_X(x, y) #define JOIN(v, w, x, y, z) JOIN2( JOIN2( JOIN2( JOIN2( v, w ), x), y), z) -#define VSETVL JOIN(__riscv_vsetvl, _e, ELEN, LMUL, _) +#define VSETVL JOIN(RISCV_RVV(vsetvl), _e, ELEN, LMUL, _) #define FLOAT_V_T JOIN(vfloat, ELEN, LMUL, _t, _) #define FLOAT_V_T_M1 JOIN(vfloat, ELEN, m1, _t, _) -#define VLEV_FLOAT JOIN(__riscv_vle, ELEN, _v_f, ELEN, LMUL) -#define VLSEV_FLOAT JOIN(__riscv_vlse, ELEN, _v_f, ELEN, LMUL) -#define VFREDMAXVS_FLOAT JOIN(__riscv_vfredmax_vs_f, ELEN, LMUL, _f, JOIN2( ELEN, m1)) +#define VLEV_FLOAT JOIN(RISCV_RVV(vle), ELEN, _v_f, ELEN, LMUL) +#define VLSEV_FLOAT JOIN(RISCV_RVV(vlse), ELEN, _v_f, ELEN, LMUL) +#ifdef RISCV_0p10_INTRINSICS +#define VFREDMAXVS_FLOAT(va,vb,gvl) JOIN(RISCV_RVV(vfredmax_vs_f), ELEN, LMUL, _f, JOIN2( ELEN, m1)) (v_res, va, vb, gvl) +#define VFRSUBVF_MASK_FLOAT(va,vb,c,gvl) JOIN(RISCV_RVV(vfrsub),_vf_f, ELEN, LMUL, _m) (va, vb, vb, c, gvl) +#else +#define VFREDMAXVS_FLOAT JOIN(RISCV_RVV(vfredmax_vs_f), ELEN, LMUL, _f, JOIN2( ELEN, m1)) +#define VFRSUBVF_MASK_FLOAT JOIN(RISCV_RVV(vfrsub),_vf_f, ELEN, LMUL, _m) +#endif #define MASK_T JOIN(vbool, MLEN, _t, _, _) -#define VMFLTVF_FLOAT JOIN(__riscv_vmflt_vf_f, ELEN, LMUL, _b, MLEN) -#define VFMVVF_FLOAT JOIN(__riscv_vfmv, _v_f_f, ELEN, LMUL, _) -#define VFMVVF_FLOAT_M1 JOIN(__riscv_vfmv, _v_f_f, ELEN, m1, _) -#define VFRSUBVF_MASK_FLOAT JOIN(__riscv_vfrsub,_vf_f, ELEN, LMUL, _m) -#define VFMAXVV_FLOAT JOIN(__riscv_vfmax, _vv_f, ELEN, LMUL, _) -#define VFADDVV_FLOAT JOIN(__riscv_vfadd, _vv_f, ELEN, LMUL, _) +#define VMFLTVF_FLOAT JOIN(RISCV_RVV(vmflt_vf_f), ELEN, LMUL, _b, MLEN) +#define VFMVVF_FLOAT JOIN(RISCV_RVV(vfmv), _v_f_f, ELEN, LMUL, _) +#define VFMVVF_FLOAT_M1 JOIN(RISCV_RVV(vfmv), _v_f_f, ELEN, m1, _) +#define VFMAXVV_FLOAT JOIN(RISCV_RVV(vfmax), _vv_f, ELEN, LMUL, _) +#define VFADDVV_FLOAT JOIN(RISCV_RVV(vfadd), _vv_f, ELEN, LMUL, _) FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) { diff --git a/kernel/riscv64/zamin_vector.c b/kernel/riscv64/zamin_vector.c index 095b1c3df..df9a7a7e1 100644 --- a/kernel/riscv64/zamin_vector.c +++ b/kernel/riscv64/zamin_vector.c @@ -55,19 +55,24 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define JOIN2(x, y) JOIN2_X(x, y) #define JOIN(v, w, x, y, z) JOIN2( JOIN2( JOIN2( JOIN2( v, w ), x), y), z) -#define VSETVL JOIN(__riscv_vsetvl, _e, ELEN, LMUL, _) +#define VSETVL JOIN(RISCV_RVV(vsetvl), _e, ELEN, LMUL, _) #define FLOAT_V_T JOIN(vfloat, ELEN, LMUL, _t, _) #define FLOAT_V_T_M1 JOIN(vfloat, ELEN, m1, _t, _) -#define VLEV_FLOAT JOIN(__riscv_vle, ELEN, _v_f, ELEN, LMUL) -#define VLSEV_FLOAT JOIN(__riscv_vlse, ELEN, _v_f, ELEN, LMUL) -#define VFREDMINVS_FLOAT JOIN(__riscv_vfredmin_vs_f, ELEN, LMUL, _f, JOIN2( ELEN, m1)) +#define VLEV_FLOAT JOIN(RISCV_RVV(vle), ELEN, _v_f, ELEN, LMUL) +#define VLSEV_FLOAT JOIN(RISCV_RVV(vlse), ELEN, _v_f, ELEN, LMUL) +#ifdef RISCV_0p10_INTRINSICS +#define VFREDMINVS_FLOAT(va,vb,gvl) JOIN(RISCV_RVV(vfredmin_vs_f), ELEN, LMUL, _f, JOIN2( ELEN, m1)) (v_res, va, vb, gvl) +#define VFRSUBVF_MASK_FLOAT(va,vb,c,gvl) JOIN(RISCV_RVV(vfrsub),_vf_f, ELEN, LMUL, _m) (va, vb, vb, c, gvl) +#else +#define VFREDMINVS_FLOAT JOIN(RISCV_RVV(vfredmin_vs_f), ELEN, LMUL, _f, JOIN2( ELEN, m1)) +#define VFRSUBVF_MASK_FLOAT JOIN(RISCV_RVV(vfrsub),_vf_f, ELEN, LMUL, _m) +#endif #define MASK_T JOIN(vbool, MLEN, _t, _, _) -#define VMFLTVF_FLOAT JOIN(__riscv_vmflt_vf_f, ELEN, LMUL, _b, MLEN) -#define VFMVVF_FLOAT JOIN(__riscv_vfmv, _v_f_f, ELEN, LMUL, _) -#define VFMVVF_FLOAT_M1 JOIN(__riscv_vfmv, _v_f_f, ELEN, m1, _) -#define VFRSUBVF_MASK_FLOAT JOIN(__riscv_vfrsub,_vf_f, ELEN, LMUL, _m) -#define VFMINVV_FLOAT JOIN(__riscv_vfmin, _vv_f, ELEN, LMUL, _) -#define VFADDVV_FLOAT JOIN(__riscv_vfadd, _vv_f, ELEN, LMUL, _) +#define VMFLTVF_FLOAT JOIN(RISCV_RVV(vmflt_vf_f), ELEN, LMUL, _b, MLEN) +#define VFMVVF_FLOAT JOIN(RISCV_RVV(vfmv), _v_f_f, ELEN, LMUL, _) +#define VFMVVF_FLOAT_M1 JOIN(RISCV_RVV(vfmv), _v_f_f, ELEN, m1, _) +#define VFMINVV_FLOAT JOIN(RISCV_RVV(vfmin), _vv_f, ELEN, LMUL, _) +#define VFADDVV_FLOAT JOIN(RISCV_RVV(vfadd), _vv_f, ELEN, LMUL, _) FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) { diff --git a/kernel/riscv64/zasum_vector.c b/kernel/riscv64/zasum_vector.c index 9136f0037..fca904d6a 100644 --- a/kernel/riscv64/zasum_vector.c +++ b/kernel/riscv64/zasum_vector.c @@ -53,17 +53,21 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define JOIN2(x, y) JOIN2_X(x, y) #define JOIN(v, w, x, y, z) JOIN2( JOIN2( JOIN2( JOIN2( v, w ), x), y), z) -#define VSETVL JOIN(__riscv_vsetvl, _e, ELEN, LMUL, _) +#define VSETVL JOIN(RISCV_RVV(vsetvl), _e, ELEN, LMUL, _) #define FLOAT_V_T JOIN(vfloat, ELEN, LMUL, _t, _) #define FLOAT_V_T_M1 JOIN(vfloat, ELEN, m1, _t, _) -#define VLEV_FLOAT JOIN(__riscv_vle, ELEN, _v_f, ELEN, LMUL) -#define VLSEV_FLOAT JOIN(__riscv_vlse, ELEN, _v_f, ELEN, LMUL) -#define VFREDSUMVS_FLOAT JOIN(__riscv_vfredusum_vs_f, ELEN, LMUL, _f, JOIN2( ELEN, m1)) -#define VFABS_FLOAT JOIN(__riscv_vfabs, _v_f, ELEN, LMUL, _) -#define VFMVVF_FLOAT JOIN(__riscv_vfmv, _v_f_f, ELEN, LMUL, _) -#define VFMVVF_FLOAT_M1 JOIN(__riscv_vfmv, _v_f_f, ELEN, m1, _) -#define VFADDVV_FLOAT JOIN(__riscv_vfadd, _vv_f, ELEN, LMUL, _) -#define VMFLTVF_FLOAT JOIN(__riscv_vmflt, _vf_f, ELEN, LMUL, MLEN) +#define VLEV_FLOAT JOIN(RISCV_RVV(vle), ELEN, _v_f, ELEN, LMUL) +#define VLSEV_FLOAT JOIN(RISCV_RVV(vlse), ELEN, _v_f, ELEN, LMUL) +#ifdef RISCV_0p10_INTRINSICS +#define VFREDSUMVS_FLOAT(va, vb, gvl) JOIN(RISCV_RVV(vfredusum_vs_f), ELEN, LMUL, _f, JOIN2( ELEN, m1))(v_res, va, vb, gvl) +#else +#define VFREDSUMVS_FLOAT JOIN(RISCV_RVV(vfredusum_vs_f), ELEN, LMUL, _f, JOIN2( ELEN, m1)) +#endif +#define VFABS_FLOAT JOIN(RISCV_RVV(vfabs), _v_f, ELEN, LMUL, _) +#define VFMVVF_FLOAT JOIN(RISCV_RVV(vfmv), _v_f_f, ELEN, LMUL, _) +#define VFMVVF_FLOAT_M1 JOIN(RISCV_RVV(vfmv), _v_f_f, ELEN, m1, _) +#define VFADDVV_FLOAT JOIN(RISCV_RVV(vfadd), _vv_f, ELEN, LMUL, _) +#define VMFLTVF_FLOAT JOIN(RISCV_RVV(vmflt), _vf_f, ELEN, LMUL, MLEN) FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) { diff --git a/kernel/riscv64/zaxpby_vector.c b/kernel/riscv64/zaxpby_vector.c index 404f51fb3..d5ad974cf 100644 --- a/kernel/riscv64/zaxpby_vector.c +++ b/kernel/riscv64/zaxpby_vector.c @@ -28,25 +28,25 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include "common.h" #if !defined(DOUBLE) -#define VSETVL(n) __riscv_vsetvl_e32m4(n) +#define VSETVL(n) RISCV_RVV(vsetvl_e32m4)(n) #define FLOAT_V_T vfloat32m4_t -#define VLSEV_FLOAT __riscv_vlse32_v_f32m4 -#define VSSEV_FLOAT __riscv_vsse32_v_f32m4 -#define VFMACCVF_FLOAT __riscv_vfmacc_vf_f32m4 -#define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m4 -#define VFMULVF_FLOAT __riscv_vfmul_vf_f32m4 -#define VFMSACVF_FLOAT __riscv_vfmsac_vf_f32m4 -#define VFNMSACVF_FLOAT __riscv_vfnmsac_vf_f32m4 +#define VLSEV_FLOAT RISCV_RVV(vlse32_v_f32m4) +#define VSSEV_FLOAT RISCV_RVV(vsse32_v_f32m4) +#define VFMACCVF_FLOAT RISCV_RVV(vfmacc_vf_f32m4) +#define VFMVVF_FLOAT RISCV_RVV(vfmv_v_f_f32m4) +#define VFMULVF_FLOAT RISCV_RVV(vfmul_vf_f32m4) +#define VFMSACVF_FLOAT RISCV_RVV(vfmsac_vf_f32m4) +#define VFNMSACVF_FLOAT RISCV_RVV(vfnmsac_vf_f32m4) #else -#define VSETVL(n) __riscv_vsetvl_e64m4(n) +#define VSETVL(n) RISCV_RVV(vsetvl_e64m4)(n) #define FLOAT_V_T vfloat64m4_t -#define VLSEV_FLOAT __riscv_vlse64_v_f64m4 -#define VSSEV_FLOAT __riscv_vsse64_v_f64m4 -#define VFMACCVF_FLOAT __riscv_vfmacc_vf_f64m4 -#define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m4 -#define VFMULVF_FLOAT __riscv_vfmul_vf_f64m4 -#define VFMSACVF_FLOAT __riscv_vfmsac_vf_f64m4 -#define VFNMSACVF_FLOAT __riscv_vfnmsac_vf_f64m4 +#define VLSEV_FLOAT RISCV_RVV(vlse64_v_f64m4) +#define VSSEV_FLOAT RISCV_RVV(vsse64_v_f64m4) +#define VFMACCVF_FLOAT RISCV_RVV(vfmacc_vf_f64m4) +#define VFMVVF_FLOAT RISCV_RVV(vfmv_v_f_f64m4) +#define VFMULVF_FLOAT RISCV_RVV(vfmul_vf_f64m4) +#define VFMSACVF_FLOAT RISCV_RVV(vfmsac_vf_f64m4) +#define VFNMSACVF_FLOAT RISCV_RVV(vfnmsac_vf_f64m4) #endif int CNAME(BLASLONG n, FLOAT alpha_r, FLOAT alpha_i, FLOAT *x, BLASLONG inc_x, FLOAT beta_r, FLOAT beta_i, FLOAT *y, BLASLONG inc_y) diff --git a/kernel/riscv64/zaxpy_vector.c b/kernel/riscv64/zaxpy_vector.c index 20bfe74ec..d19e51118 100644 --- a/kernel/riscv64/zaxpy_vector.c +++ b/kernel/riscv64/zaxpy_vector.c @@ -28,19 +28,19 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include "common.h" #if !defined(DOUBLE) -#define VSETVL(n) __riscv_vsetvl_e32m4(n) +#define VSETVL(n) RISCV_RVV(vsetvl_e32m4)(n) #define FLOAT_V_T vfloat32m4_t -#define VLSEV_FLOAT __riscv_vlse32_v_f32m4 -#define VSSEV_FLOAT __riscv_vsse32_v_f32m4 -#define VFMACCVF_FLOAT __riscv_vfmacc_vf_f32m4 -#define VFNMSACVF_FLOAT __riscv_vfnmsac_vf_f32m4 +#define VLSEV_FLOAT RISCV_RVV(vlse32_v_f32m4) +#define VSSEV_FLOAT RISCV_RVV(vsse32_v_f32m4) +#define VFMACCVF_FLOAT RISCV_RVV(vfmacc_vf_f32m4) +#define VFNMSACVF_FLOAT RISCV_RVV(vfnmsac_vf_f32m4) #else -#define VSETVL(n) __riscv_vsetvl_e64m4(n) +#define VSETVL(n) RISCV_RVV(vsetvl_e64m4)(n) #define FLOAT_V_T vfloat64m4_t -#define VLSEV_FLOAT __riscv_vlse64_v_f64m4 -#define VSSEV_FLOAT __riscv_vsse64_v_f64m4 -#define VFMACCVF_FLOAT __riscv_vfmacc_vf_f64m4 -#define VFNMSACVF_FLOAT __riscv_vfnmsac_vf_f64m4 +#define VLSEV_FLOAT RISCV_RVV(vlse64_v_f64m4) +#define VSSEV_FLOAT RISCV_RVV(vsse64_v_f64m4) +#define VFMACCVF_FLOAT RISCV_RVV(vfmacc_vf_f64m4) +#define VFNMSACVF_FLOAT RISCV_RVV(vfnmsac_vf_f64m4) #endif int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT da_r, FLOAT da_i, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y, FLOAT *dummy, BLASLONG dummy2) diff --git a/kernel/riscv64/zcopy_vector.c b/kernel/riscv64/zcopy_vector.c index 9da60acb0..9e4a67b71 100644 --- a/kernel/riscv64/zcopy_vector.c +++ b/kernel/riscv64/zcopy_vector.c @@ -27,15 +27,15 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include "common.h" #if !defined(DOUBLE) -#define VSETVL(n) __riscv_vsetvl_e32m4(n) +#define VSETVL(n) RISCV_RVV(vsetvl_e32m4)(n) #define FLOAT_V_T vfloat32m4_t -#define VLSEV_FLOAT __riscv_vlse32_v_f32m4 -#define VSSEV_FLOAT __riscv_vsse32_v_f32m4 +#define VLSEV_FLOAT RISCV_RVV(vlse32_v_f32m4) +#define VSSEV_FLOAT RISCV_RVV(vsse32_v_f32m4) #else -#define VSETVL(n) __riscv_vsetvl_e64m4(n) +#define VSETVL(n) RISCV_RVV(vsetvl_e64m4)(n) #define FLOAT_V_T vfloat64m4_t -#define VLSEV_FLOAT __riscv_vlse64_v_f64m4 -#define VSSEV_FLOAT __riscv_vsse64_v_f64m4 +#define VLSEV_FLOAT RISCV_RVV(vlse64_v_f64m4) +#define VSSEV_FLOAT RISCV_RVV(vsse64_v_f64m4) #endif diff --git a/kernel/riscv64/zdot_vector.c b/kernel/riscv64/zdot_vector.c index 57542714a..13b8fe378 100644 --- a/kernel/riscv64/zdot_vector.c +++ b/kernel/riscv64/zdot_vector.c @@ -27,37 +27,45 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include "common.h" #if !defined(DOUBLE) -#define VSETVL(n) __riscv_vsetvl_e32m4(n) -#define VSETVL_MAX __riscv_vsetvlmax_e32m1() +#define VSETVL(n) RISCV_RVV(vsetvl_e32m4)(n) +#define VSETVL_MAX RISCV_RVV(vsetvlmax_e32m1)() #define FLOAT_V_T vfloat32m4_t #define FLOAT_V_T_M1 vfloat32m1_t -#define VFMVFS_FLOAT __riscv_vfmv_f_s_f32m1_f32 -#define VLEV_FLOAT __riscv_vle32_v_f32m4 -#define VLSEV_FLOAT __riscv_vlse32_v_f32m4 -#define VFREDSUM_FLOAT __riscv_vfredusum_vs_f32m4_f32m1 -#define VFMACCVV_FLOAT __riscv_vfmacc_vv_f32m4 -#define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m4 -#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f32m1 -#define VFDOTVV_FLOAT __riscv_vfdot_vv_f32m4 -#define VFMULVV_FLOAT __riscv_vfmul_vv_f32m4 -#define VFMSACVV_FLOAT __riscv_vfmsac_vv_f32m4 -#define VFNMSACVV_FLOAT __riscv_vfnmsac_vv_f32m4 +#define VFMVFS_FLOAT RISCV_RVV(vfmv_f_s_f32m1_f32) +#define VLEV_FLOAT RISCV_RVV(vle32_v_f32m4) +#define VLSEV_FLOAT RISCV_RVV(vlse32_v_f32m4) +#ifdef RISCV_0p10_INTRINSICS +#define VFREDSUM_FLOAT(va, vb, gvl) RISCV_RVV(vfredusum_vs_f32m4_f32m1)(v_res, va, vb, gvl) #else -#define VSETVL(n) __riscv_vsetvl_e64m4(n) -#define VSETVL_MAX __riscv_vsetvlmax_e64m1() +#define VFREDSUM_FLOAT RISCV_RVV(vfredusum_vs_f32m4_f32m1) +#endif +#define VFMACCVV_FLOAT RISCV_RVV(vfmacc_vv_f32m4) +#define VFMVVF_FLOAT RISCV_RVV(vfmv_v_f_f32m4) +#define VFMVVF_FLOAT_M1 RISCV_RVV(vfmv_v_f_f32m1) +#define VFDOTVV_FLOAT RISCV_RVV(vfdot_vv_f32m4) +#define VFMULVV_FLOAT RISCV_RVV(vfmul_vv_f32m4) +#define VFMSACVV_FLOAT RISCV_RVV(vfmsac_vv_f32m4) +#define VFNMSACVV_FLOAT RISCV_RVV(vfnmsac_vv_f32m4) +#else +#define VSETVL(n) RISCV_RVV(vsetvl_e64m4)(n) +#define VSETVL_MAX RISCV_RVV(vsetvlmax_e64m1)() #define FLOAT_V_T vfloat64m4_t #define FLOAT_V_T_M1 vfloat64m1_t -#define VFMVFS_FLOAT __riscv_vfmv_f_s_f64m1_f64 -#define VLEV_FLOAT __riscv_vle64_v_f64m4 -#define VLSEV_FLOAT __riscv_vlse64_v_f64m4 -#define VFREDSUM_FLOAT __riscv_vfredusum_vs_f64m4_f64m1 -#define VFMACCVV_FLOAT __riscv_vfmacc_vv_f64m4 -#define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m4 -#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f64m1 -#define VFDOTVV_FLOAT __riscv_vfdot_vv_f64m4 -#define VFMULVV_FLOAT __riscv_vfmul_vv_f64m4 -#define VFMSACVV_FLOAT __riscv_vfmsac_vv_f64m4 -#define VFNMSACVV_FLOAT __riscv_vfnmsac_vv_f64m4 +#define VFMVFS_FLOAT RISCV_RVV(vfmv_f_s_f64m1_f64) +#define VLEV_FLOAT RISCV_RVV(vle64_v_f64m4) +#define VLSEV_FLOAT RISCV_RVV(vlse64_v_f64m4) +#ifdef RISCV_0p10_INTRINSICS +#define VFREDSUM_FLOAT(va, vb, gvl) RISCV_RVV(vfredusum_vs_f64m4_f64m1)(v_res, va, vb, gvl) +#else +#define VFREDSUM_FLOAT RISCV_RVV(vfredusum_vs_f64m4_f64m1) +#endif +#define VFMACCVV_FLOAT RISCV_RVV(vfmacc_vv_f64m4) +#define VFMVVF_FLOAT RISCV_RVV(vfmv_v_f_f64m4) +#define VFMVVF_FLOAT_M1 RISCV_RVV(vfmv_v_f_f64m1) +#define VFDOTVV_FLOAT RISCV_RVV(vfdot_vv_f64m4) +#define VFMULVV_FLOAT RISCV_RVV(vfmul_vv_f64m4) +#define VFMSACVV_FLOAT RISCV_RVV(vfmsac_vv_f64m4) +#define VFNMSACVV_FLOAT RISCV_RVV(vfnmsac_vv_f64m4) #endif OPENBLAS_COMPLEX_FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y) diff --git a/kernel/riscv64/zgemv_n_vector.c b/kernel/riscv64/zgemv_n_vector.c index f4acad770..104d3865d 100644 --- a/kernel/riscv64/zgemv_n_vector.c +++ b/kernel/riscv64/zgemv_n_vector.c @@ -27,23 +27,23 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include "common.h" #if !defined(DOUBLE) -#define VSETVL(n) __riscv_vsetvl_e32m4(n) +#define VSETVL(n) RISCV_RVV(vsetvl_e32m4)(n) #define FLOAT_V_T vfloat32m4_t -#define VLEV_FLOAT __riscv_vle32_v_f32m4 -#define VLSEV_FLOAT __riscv_vlse32_v_f32m4 -#define VSEV_FLOAT __riscv_vse32_v_f32m4 -#define VSSEV_FLOAT __riscv_vsse32_v_f32m4 -#define VFMACCVF_FLOAT __riscv_vfmacc_vf_f32m4 -#define VFNMSACVF_FLOAT __riscv_vfnmsac_vf_f32m4 +#define VLEV_FLOAT RISCV_RVV(vle32_v_f32m4) +#define VLSEV_FLOAT RISCV_RVV(vlse32_v_f32m4) +#define VSEV_FLOAT RISCV_RVV(vse32_v_f32m4) +#define VSSEV_FLOAT RISCV_RVV(vsse32_v_f32m4) +#define VFMACCVF_FLOAT RISCV_RVV(vfmacc_vf_f32m4) +#define VFNMSACVF_FLOAT RISCV_RVV(vfnmsac_vf_f32m4) #else -#define VSETVL(n) __riscv_vsetvl_e64m4(n) +#define VSETVL(n) RISCV_RVV(vsetvl_e64m4)(n) #define FLOAT_V_T vfloat64m4_t -#define VLEV_FLOAT __riscv_vle64_v_f64m4 -#define VLSEV_FLOAT __riscv_vlse64_v_f64m4 -#define VSEV_FLOAT __riscv_vse64_v_f64m4 -#define VSSEV_FLOAT __riscv_vsse64_v_f64m4 -#define VFMACCVF_FLOAT __riscv_vfmacc_vf_f64m4 -#define VFNMSACVF_FLOAT __riscv_vfnmsac_vf_f64m4 +#define VLEV_FLOAT RISCV_RVV(vle64_v_f64m4) +#define VLSEV_FLOAT RISCV_RVV(vlse64_v_f64m4) +#define VSEV_FLOAT RISCV_RVV(vse64_v_f64m4) +#define VSSEV_FLOAT RISCV_RVV(vsse64_v_f64m4) +#define VFMACCVF_FLOAT RISCV_RVV(vfmacc_vf_f64m4) +#define VFNMSACVF_FLOAT RISCV_RVV(vfnmsac_vf_f64m4) #endif int CNAME(BLASLONG m, BLASLONG n, BLASLONG dummy1, FLOAT alpha_r, FLOAT alpha_i, FLOAT *a, BLASLONG lda, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y, FLOAT *buffer) diff --git a/kernel/riscv64/zgemv_t_vector.c b/kernel/riscv64/zgemv_t_vector.c index 179454094..5d85ab3a4 100644 --- a/kernel/riscv64/zgemv_t_vector.c +++ b/kernel/riscv64/zgemv_t_vector.c @@ -27,31 +27,39 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include "common.h" #if !defined(DOUBLE) -#define VSETVL(n) __riscv_vsetvl_e32m2(n) -#define VSETVL_MAX __riscv_vsetvlmax_e32m1() +#define VSETVL(n) RISCV_RVV(vsetvl_e32m2)(n) +#define VSETVL_MAX RISCV_RVV(vsetvlmax_e32m1)() #define FLOAT_V_T vfloat32m2_t #define FLOAT_V_T_M1 vfloat32m1_t -#define VFMVFS_FLOAT __riscv_vfmv_f_s_f32m1_f32 -#define VLSEV_FLOAT __riscv_vlse32_v_f32m2 -#define VFREDSUM_FLOAT __riscv_vfredusum_vs_f32m2_f32m1 -#define VFMACCVV_FLOAT __riscv_vfmacc_vv_f32m2 -#define VFNMSACVV_FLOAT __riscv_vfnmsac_vv_f32m2 -#define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m2 -#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f32m1 -#define VFMULVV_FLOAT __riscv_vfmul_vv_f32m2 +#define VFMVFS_FLOAT RISCV_RVV(vfmv_f_s_f32m1_f32) +#define VLSEV_FLOAT RISCV_RVV(vlse32_v_f32m2) +#ifdef RISCV_0p10_INTRINSICS +#define VFREDSUM_FLOAT(vr, va, vb, gvl) RISCV_RVV(vfredusum_vs_f32m2_f32m1)(vr, va, vb, gvl) #else -#define VSETVL(n) __riscv_vsetvl_e64m2(n) -#define VSETVL_MAX __riscv_vsetvlmax_e64m1() +#define VFREDSUM_FLOAT(vr, va, vb, gvl) RISCV_RVV(vfredusum_vs_f32m2_f32m1)(va, vb, gvl) +#endif +#define VFMACCVV_FLOAT RISCV_RVV(vfmacc_vv_f32m2) +#define VFNMSACVV_FLOAT RISCV_RVV(vfnmsac_vv_f32m2) +#define VFMVVF_FLOAT RISCV_RVV(vfmv_v_f_f32m2) +#define VFMVVF_FLOAT_M1 RISCV_RVV(vfmv_v_f_f32m1) +#define VFMULVV_FLOAT RISCV_RVV(vfmul_vv_f32m2) +#else +#define VSETVL(n) RISCV_RVV(vsetvl_e64m2)(n) +#define VSETVL_MAX RISCV_RVV(vsetvlmax_e64m1)() #define FLOAT_V_T vfloat64m2_t #define FLOAT_V_T_M1 vfloat64m1_t -#define VFMVFS_FLOAT __riscv_vfmv_f_s_f64m1_f64 -#define VLSEV_FLOAT __riscv_vlse64_v_f64m2 -#define VFREDSUM_FLOAT __riscv_vfredusum_vs_f64m2_f64m1 -#define VFMACCVV_FLOAT __riscv_vfmacc_vv_f64m2 -#define VFNMSACVV_FLOAT __riscv_vfnmsac_vv_f64m2 -#define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m2 -#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f64m1 -#define VFMULVV_FLOAT __riscv_vfmul_vv_f64m2 +#define VFMVFS_FLOAT RISCV_RVV(vfmv_f_s_f64m1_f64) +#define VLSEV_FLOAT RISCV_RVV(vlse64_v_f64m2) +#ifdef RISCV_0p10_INTRINSICS +#define VFREDSUM_FLOAT(vr, va, vb, gvl) RISCV_RVV(vfredusum_vs_f64m2_f64m1)(vr, va, vb, gvl) +#else +#define VFREDSUM_FLOAT(vr, va, vb, gvl) RISCV_RVV(vfredusum_vs_f64m2_f64m1)(va, vb, gvl) +#endif +#define VFMACCVV_FLOAT RISCV_RVV(vfmacc_vv_f64m2) +#define VFNMSACVV_FLOAT RISCV_RVV(vfnmsac_vv_f64m2) +#define VFMVVF_FLOAT RISCV_RVV(vfmv_v_f_f64m2) +#define VFMVVF_FLOAT_M1 RISCV_RVV(vfmv_v_f_f64m1) +#define VFMULVV_FLOAT RISCV_RVV(vfmul_vv_f64m2) #endif int CNAME(BLASLONG m, BLASLONG n, BLASLONG dummy1, FLOAT alpha_r, FLOAT alpha_i, FLOAT *a, BLASLONG lda, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y, FLOAT *buffer) @@ -93,8 +101,8 @@ int CNAME(BLASLONG m, BLASLONG n, BLASLONG dummy1, FLOAT alpha_r, FLOAT alpha_i, vr = VFMACCVV_FLOAT(vr, va1, vx1, gvl); vi = VFNMSACVV_FLOAT(vi, va1, vx0, gvl); #endif - v_res_r = VFREDSUM_FLOAT(vr, v_res_r, gvl); - v_res_i = VFREDSUM_FLOAT(vi, v_res_i, gvl); + v_res_r = VFREDSUM_FLOAT(v_res_r, vr, v_res_r, gvl); + v_res_i = VFREDSUM_FLOAT(v_res_i, vi, v_res_i, gvl); j += inc_av; ix += inc_xv; @@ -117,8 +125,8 @@ int CNAME(BLASLONG m, BLASLONG n, BLASLONG dummy1, FLOAT alpha_r, FLOAT alpha_i, vi = VFNMSACVV_FLOAT(vi, va1, vx0, gvl); #endif - v_res_r = VFREDSUM_FLOAT(vr, v_res_r, gvl); - v_res_i = VFREDSUM_FLOAT(vi, v_res_i, gvl); + v_res_r = VFREDSUM_FLOAT(v_res_r, vr, v_res_r, gvl); + v_res_i = VFREDSUM_FLOAT(v_res_i, vi, v_res_i, gvl); } temp_r = VFMVFS_FLOAT(v_res_r); diff --git a/kernel/riscv64/zhemv_LM_vector.c b/kernel/riscv64/zhemv_LM_vector.c index e025120e5..117db7d84 100644 --- a/kernel/riscv64/zhemv_LM_vector.c +++ b/kernel/riscv64/zhemv_LM_vector.c @@ -27,37 +27,45 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include "common.h" #if !defined(DOUBLE) -#define VSETVL(n) __riscv_vsetvl_e32m4(n) -#define VSETVL_MAX __riscv_vsetvlmax_e32m1() +#define VSETVL(n) RISCV_RVV(vsetvl_e32m4)(n) +#define VSETVL_MAX RISCV_RVV(vsetvlmax_e32m1)() #define FLOAT_V_T vfloat32m4_t #define FLOAT_V_T_M1 vfloat32m1_t -#define VFMVFS_FLOAT __riscv_vfmv_f_s_f32m1_f32 -#define VLSEV_FLOAT __riscv_vlse32_v_f32m4 -#define VSSEV_FLOAT __riscv_vsse32_v_f32m4 -#define VFREDSUM_FLOAT __riscv_vfredusum_vs_f32m4_f32m1 -#define VFMACCVV_FLOAT __riscv_vfmacc_vv_f32m4 -#define VFMACCVF_FLOAT __riscv_vfmacc_vf_f32m4 -#define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m4 -#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f32m1 -#define VFMULVV_FLOAT __riscv_vfmul_vv_f32m4 -#define VFNMSACVF_FLOAT __riscv_vfnmsac_vf_f32m4 -#define VFNMSACVV_FLOAT __riscv_vfnmsac_vv_f32m4 +#define VFMVFS_FLOAT RISCV_RVV(vfmv_f_s_f32m1_f32) +#define VLSEV_FLOAT RISCV_RVV(vlse32_v_f32m4) +#define VSSEV_FLOAT RISCV_RVV(vsse32_v_f32m4) +#ifdef RISCV_0p10_INTRINSICS +#define VFREDSUM_FLOAT(va, vb, gvl) RISCV_RVV(vfredusum_vs_f32m4_f32m1)(v_res, va, vb, gvl) #else -#define VSETVL(n) __riscv_vsetvl_e64m4(n) -#define VSETVL_MAX __riscv_vsetvlmax_e64m1() +#define VFREDSUM_FLOAT RISCV_RVV(vfredusum_vs_f32m4_f32m1) +#endif +#define VFMACCVV_FLOAT RISCV_RVV(vfmacc_vv_f32m4) +#define VFMACCVF_FLOAT RISCV_RVV(vfmacc_vf_f32m4) +#define VFMVVF_FLOAT RISCV_RVV(vfmv_v_f_f32m4) +#define VFMVVF_FLOAT_M1 RISCV_RVV(vfmv_v_f_f32m1) +#define VFMULVV_FLOAT RISCV_RVV(vfmul_vv_f32m4) +#define VFNMSACVF_FLOAT RISCV_RVV(vfnmsac_vf_f32m4) +#define VFNMSACVV_FLOAT RISCV_RVV(vfnmsac_vv_f32m4) +#else +#define VSETVL(n) RISCV_RVV(vsetvl_e64m4)(n) +#define VSETVL_MAX RISCV_RVV(vsetvlmax_e64m1)() #define FLOAT_V_T vfloat64m4_t #define FLOAT_V_T_M1 vfloat64m1_t -#define VFMVFS_FLOAT __riscv_vfmv_f_s_f64m1_f64 -#define VLSEV_FLOAT __riscv_vlse64_v_f64m4 -#define VSSEV_FLOAT __riscv_vsse64_v_f64m4 -#define VFREDSUM_FLOAT __riscv_vfredusum_vs_f64m4_f64m1 -#define VFMACCVV_FLOAT __riscv_vfmacc_vv_f64m4 -#define VFMACCVF_FLOAT __riscv_vfmacc_vf_f64m4 -#define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m4 -#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f64m1 -#define VFMULVV_FLOAT __riscv_vfmul_vv_f64m4 -#define VFNMSACVF_FLOAT __riscv_vfnmsac_vf_f64m4 -#define VFNMSACVV_FLOAT __riscv_vfnmsac_vv_f64m4 +#define VFMVFS_FLOAT RISCV_RVV(vfmv_f_s_f64m1_f64) +#define VLSEV_FLOAT RISCV_RVV(vlse64_v_f64m4) +#define VSSEV_FLOAT RISCV_RVV(vsse64_v_f64m4) +#ifdef RISCV_0p10_INTRINSICS +#define VFREDSUM_FLOAT(va, vb, gvl) RISCV_RVV(vfredusum_vs_f64m4_f64m1)(v_res, va, vb, gvl) +#else +#define VFREDSUM_FLOAT RISCV_RVV(vfredusum_vs_f64m4_f64m1) +#endif +#define VFMACCVV_FLOAT RISCV_RVV(vfmacc_vv_f64m4) +#define VFMACCVF_FLOAT RISCV_RVV(vfmacc_vf_f64m4) +#define VFMVVF_FLOAT RISCV_RVV(vfmv_v_f_f64m4) +#define VFMVVF_FLOAT_M1 RISCV_RVV(vfmv_v_f_f64m1) +#define VFMULVV_FLOAT RISCV_RVV(vfmul_vv_f64m4) +#define VFNMSACVF_FLOAT RISCV_RVV(vfnmsac_vf_f64m4) +#define VFNMSACVV_FLOAT RISCV_RVV(vfnmsac_vv_f64m4) #endif int CNAME(BLASLONG m, BLASLONG offset, FLOAT alpha_r, FLOAT alpha_i, FLOAT *a, BLASLONG lda, FLOAT *x, BLASLONG incx, FLOAT *y, BLASLONG incy, FLOAT *buffer){ diff --git a/kernel/riscv64/zhemv_UV_vector.c b/kernel/riscv64/zhemv_UV_vector.c index 0e1ea5436..7c6b63bf3 100644 --- a/kernel/riscv64/zhemv_UV_vector.c +++ b/kernel/riscv64/zhemv_UV_vector.c @@ -27,37 +27,45 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include "common.h" #if !defined(DOUBLE) -#define VSETVL(n) __riscv_vsetvl_e32m4(n) -#define VSETVL_MAX __riscv_vsetvlmax_e32m1() +#define VSETVL(n) RISCV_RVV(vsetvl_e32m4)(n) +#define VSETVL_MAX RISCV_RVV(vsetvlmax_e32m1)() #define FLOAT_V_T vfloat32m4_t #define FLOAT_V_T_M1 vfloat32m1_t -#define VFMVFS_FLOAT __riscv_vfmv_f_s_f32m1_f32 -#define VLSEV_FLOAT __riscv_vlse32_v_f32m4 -#define VSSEV_FLOAT __riscv_vsse32_v_f32m4 -#define VFREDSUM_FLOAT __riscv_vfredusum_vs_f32m4_f32m1 -#define VFMACCVV_FLOAT __riscv_vfmacc_vv_f32m4 -#define VFMACCVF_FLOAT __riscv_vfmacc_vf_f32m4 -#define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m4 -#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f32m1 -#define VFMULVV_FLOAT __riscv_vfmul_vv_f32m4 -#define VFNMSACVF_FLOAT __riscv_vfnmsac_vf_f32m4 -#define VFNMSACVV_FLOAT __riscv_vfnmsac_vv_f32m4 +#define VFMVFS_FLOAT RISCV_RVV(vfmv_f_s_f32m1_f32) +#define VLSEV_FLOAT RISCV_RVV(vlse32_v_f32m4) +#define VSSEV_FLOAT RISCV_RVV(vsse32_v_f32m4) +#ifdef RISCV_0p10_INTRINSICS +#define VFREDSUM_FLOAT(va, vb, gvl) RISCV_RVV(vfredusum_vs_f32m4_f32m1)(v_res, va, vb, gvl) #else -#define VSETVL(n) __riscv_vsetvl_e64m4(n) -#define VSETVL_MAX __riscv_vsetvlmax_e64m1() +#define VFREDSUM_FLOAT RISCV_RVV(vfredusum_vs_f32m4_f32m1) +#endif +#define VFMACCVV_FLOAT RISCV_RVV(vfmacc_vv_f32m4) +#define VFMACCVF_FLOAT RISCV_RVV(vfmacc_vf_f32m4) +#define VFMVVF_FLOAT RISCV_RVV(vfmv_v_f_f32m4) +#define VFMVVF_FLOAT_M1 RISCV_RVV(vfmv_v_f_f32m1) +#define VFMULVV_FLOAT RISCV_RVV(vfmul_vv_f32m4) +#define VFNMSACVF_FLOAT RISCV_RVV(vfnmsac_vf_f32m4) +#define VFNMSACVV_FLOAT RISCV_RVV(vfnmsac_vv_f32m4) +#else +#define VSETVL(n) RISCV_RVV(vsetvl_e64m4)(n) +#define VSETVL_MAX RISCV_RVV(vsetvlmax_e64m1)() #define FLOAT_V_T vfloat64m4_t #define FLOAT_V_T_M1 vfloat64m1_t -#define VFMVFS_FLOAT __riscv_vfmv_f_s_f64m1_f64 -#define VLSEV_FLOAT __riscv_vlse64_v_f64m4 -#define VSSEV_FLOAT __riscv_vsse64_v_f64m4 -#define VFREDSUM_FLOAT __riscv_vfredusum_vs_f64m4_f64m1 -#define VFMACCVV_FLOAT __riscv_vfmacc_vv_f64m4 -#define VFMACCVF_FLOAT __riscv_vfmacc_vf_f64m4 -#define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m4 -#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f64m1 -#define VFMULVV_FLOAT __riscv_vfmul_vv_f64m4 -#define VFNMSACVF_FLOAT __riscv_vfnmsac_vf_f64m4 -#define VFNMSACVV_FLOAT __riscv_vfnmsac_vv_f64m4 +#define VFMVFS_FLOAT RISCV_RVV(vfmv_f_s_f64m1_f64) +#define VLSEV_FLOAT RISCV_RVV(vlse64_v_f64m4) +#define VSSEV_FLOAT RISCV_RVV(vsse64_v_f64m4) +#ifdef RISCV_0p10_INTRINSICS +#define VFREDSUM_FLOAT(va, vb, gvl) RISCV_RVV(vfredusum_vs_f64m4_f64m1)(v_res, va, vb, gvl) +#else +#define VFREDSUM_FLOAT RISCV_RVV(vfredusum_vs_f64m4_f64m1) +#endif +#define VFMACCVV_FLOAT RISCV_RVV(vfmacc_vv_f64m4) +#define VFMACCVF_FLOAT RISCV_RVV(vfmacc_vf_f64m4) +#define VFMVVF_FLOAT RISCV_RVV(vfmv_v_f_f64m4) +#define VFMVVF_FLOAT_M1 RISCV_RVV(vfmv_v_f_f64m1) +#define VFMULVV_FLOAT RISCV_RVV(vfmul_vv_f64m4) +#define VFNMSACVF_FLOAT RISCV_RVV(vfnmsac_vf_f64m4) +#define VFNMSACVV_FLOAT RISCV_RVV(vfnmsac_vv_f64m4) #endif int CNAME(BLASLONG m, BLASLONG offset, FLOAT alpha_r, FLOAT alpha_i, FLOAT *a, BLASLONG lda, FLOAT *x, BLASLONG incx, FLOAT *y, BLASLONG incy, FLOAT *buffer){ diff --git a/kernel/riscv64/znrm2_vector.c b/kernel/riscv64/znrm2_vector.c index 437bf4246..8614f7539 100644 --- a/kernel/riscv64/znrm2_vector.c +++ b/kernel/riscv64/znrm2_vector.c @@ -52,37 +52,44 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define JOIN2(x, y) JOIN2_X(x, y) #define JOIN(v, w, x, y, z) JOIN2( JOIN2( JOIN2( JOIN2( v, w ), x), y), z) -#define VSETVL JOIN(__riscv_vsetvl, _e, ELEN, LMUL, _) +#define VSETVL JOIN(RISCV_RVV(vsetvl), _e, ELEN, LMUL, _) #define FLOAT_V_T JOIN(vfloat, ELEN, LMUL, _t, _) #define FLOAT_V_T_M1 JOIN(vfloat, ELEN, m1, _t, _) -#define VLEV_FLOAT JOIN(__riscv_vle, ELEN, _v_f, ELEN, LMUL) -#define VLSEV_FLOAT JOIN(__riscv_vlse, ELEN, _v_f, ELEN, LMUL) -#define VFMVVF_FLOAT JOIN(__riscv_vfmv, _v_f_f, ELEN, LMUL, _) -#define VFMVVF_FLOAT_M1 JOIN(__riscv_vfmv, _v_f_f, ELEN, m1, _) +#define VLEV_FLOAT JOIN(RISCV_RVV(vle), ELEN, _v_f, ELEN, LMUL) +#define VLSEV_FLOAT JOIN(RISCV_RVV(vlse), ELEN, _v_f, ELEN, LMUL) +#define VFMVVF_FLOAT JOIN(RISCV_RVV(vfmv), _v_f_f, ELEN, LMUL, _) +#define VFMVVF_FLOAT_M1 JOIN(RISCV_RVV(vfmv), _v_f_f, ELEN, m1, _) #define MASK_T JOIN(vbool, MLEN, _t, _, _) -#define VFABS JOIN(__riscv_vfabs, _v_f, ELEN, LMUL, _) -#define VMFNE JOIN(__riscv_vmfne_vf_f,ELEN, LMUL, _b, MLEN) -#define VMFGT JOIN(__riscv_vmfgt_vv_f,ELEN, LMUL, _b, MLEN) -#define VMFEQ JOIN(__riscv_vmfeq_vv_f,ELEN, LMUL, _b, MLEN) -#define VCPOP JOIN(__riscv_vcpop, _m_b, MLEN, _, _) -#define VFREDMAX JOIN(__riscv_vfredmax_vs_f,ELEN,LMUL, JOIN2(_f, ELEN), m1) -#define VFIRST JOIN(__riscv_vfirst, _m_b, MLEN, _, _) -#define VRGATHER JOIN(__riscv_vrgather, _vx_f, ELEN, LMUL, _) -#define VFDIV JOIN(__riscv_vfdiv, _vf_f, ELEN, LMUL, _) -#define VFDIV_M JOIN(__riscv_vfdiv, _vv_f, ELEN, LMUL, _mu) -#define VFMUL JOIN(__riscv_vfmul, _vv_f, ELEN, LMUL, _) -#define VFMACC JOIN(__riscv_vfmacc, _vv_f, ELEN, LMUL, _) -#define VFMACC_M JOIN(__riscv_vfmacc, _vv_f, ELEN, LMUL, _mu) -#define VMSOF JOIN(__riscv_vmsof, _m_b, MLEN, _, _) -#define VMANDN JOIN(__riscv_vmandn, _mm_b, MLEN, _, _) -#define VFREDUSUM JOIN(__riscv_vfredusum_vs_f,ELEN,LMUL, JOIN2(_f, ELEN), m1) +#define VFABS JOIN(RISCV_RVV(vfabs), _v_f, ELEN, LMUL, _) +#define VMFNE JOIN(RISCV_RVV(vmfne_vf_f),ELEN, LMUL, _b, MLEN) +#define VMFGT JOIN(RISCV_RVV(vmfgt_vv_f),ELEN, LMUL, _b, MLEN) +#define VMFEQ JOIN(RISCV_RVV(vmfeq_vv_f),ELEN, LMUL, _b, MLEN) +#define VCPOP JOIN(RISCV_RVV(vcpop), _m_b, MLEN, _, _) +#ifdef RISCV_0p10_INTRINSICS +#define VFREDMAX(va, vb, gvl) JOIN(RISCV_RVV(vfredmax_vs_f),ELEN,LMUL, JOIN2(_f, ELEN), m1)(v_res, va, vb, gvl) +#define VFREDUSUM(va, vb, gvl) JOIN(RISCV_RVV(vfredusum_vs_f),ELEN,LMUL, JOIN2(_f, ELEN), m1)(v_res, va, vb, gvl) +#define VFDIV_M JOIN(RISCV_RVV(vfdiv), _vv_f, ELEN, LMUL, _m) +#define VFMACC_M JOIN(RISCV_RVV(vfmacc), _vv_f, ELEN, LMUL, _m) +#else +#define VFREDMAX JOIN(RISCV_RVV(vfredmax_vs_f),ELEN,LMUL, JOIN2(_f, ELEN), m1) +#define VFREDUSUM JOIN(RISCV_RVV(vfredusum_vs_f),ELEN,LMUL, JOIN2(_f, ELEN), m1) +#define VFDIV_M JOIN(RISCV_RVV(vfdiv), _vv_f, ELEN, LMUL, _mu) +#define VFMACC_M JOIN(RISCV_RVV(vfmacc), _vv_f, ELEN, LMUL, _mu) +#endif +#define VFIRST JOIN(RISCV_RVV(vfirst), _m_b, MLEN, _, _) +#define VRGATHER JOIN(RISCV_RVV(vrgather), _vx_f, ELEN, LMUL, _) +#define VFDIV JOIN(RISCV_RVV(vfdiv), _vf_f, ELEN, LMUL, _) +#define VFMUL JOIN(RISCV_RVV(vfmul), _vv_f, ELEN, LMUL, _) +#define VFMACC JOIN(RISCV_RVV(vfmacc), _vv_f, ELEN, LMUL, _) +#define VMSOF JOIN(RISCV_RVV(vmsof), _m_b, MLEN, _, _) +#define VMANDN JOIN(RISCV_RVV(vmandn), _mm_b, MLEN, _, _) #if defined(DOUBLE) #define ABS fabs #else #define ABS fabsf #endif -#define EXTRACT_FLOAT0_V(v) JOIN(__riscv_vfmv_f_s_f, ELEN, LMUL, _f, ELEN)(v) +#define EXTRACT_FLOAT0_V(v) JOIN(RISCV_RVV(vfmv_f_s_f), ELEN, LMUL, _f, ELEN)(v) FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) diff --git a/kernel/riscv64/zrot_vector.c b/kernel/riscv64/zrot_vector.c index c3afbc7cc..50751b343 100644 --- a/kernel/riscv64/zrot_vector.c +++ b/kernel/riscv64/zrot_vector.c @@ -27,27 +27,27 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include "common.h" #if !defined(DOUBLE) -#define VSETVL(n) __riscv_vsetvl_e32m4(n) -#define VSETVL_MAX __riscv_vsetvlmax_e32m1() +#define VSETVL(n) RISCV_RVV(vsetvl_e32m4)(n) +#define VSETVL_MAX RISCV_RVV(vsetvlmax_e32m1)() #define FLOAT_V_T vfloat32m4_t -#define VLEV_FLOAT __riscv_vle32_v_f32m4 -#define VLSEV_FLOAT __riscv_vlse32_v_f32m4 -#define VSEV_FLOAT __riscv_vse32_v_f32m4 -#define VSSEV_FLOAT __riscv_vsse32_v_f32m4 -#define VFMACCVF_FLOAT __riscv_vfmacc_vf_f32m4 -#define VFMULVF_FLOAT __riscv_vfmul_vf_f32m4 -#define VFNMSACVF_FLOAT __riscv_vfnmsac_vf_f32m4 +#define VLEV_FLOAT RISCV_RVV(vle32_v_f32m4) +#define VLSEV_FLOAT RISCV_RVV(vlse32_v_f32m4) +#define VSEV_FLOAT RISCV_RVV(vse32_v_f32m4) +#define VSSEV_FLOAT RISCV_RVV(vsse32_v_f32m4) +#define VFMACCVF_FLOAT RISCV_RVV(vfmacc_vf_f32m4) +#define VFMULVF_FLOAT RISCV_RVV(vfmul_vf_f32m4) +#define VFNMSACVF_FLOAT RISCV_RVV(vfnmsac_vf_f32m4) #else -#define VSETVL(n) __riscv_vsetvl_e64m4(n) -#define VSETVL_MAX __riscv_vsetvlmax_e64m1() +#define VSETVL(n) RISCV_RVV(vsetvl_e64m4)(n) +#define VSETVL_MAX RISCV_RVV(vsetvlmax_e64m1)() #define FLOAT_V_T vfloat64m4_t -#define VLEV_FLOAT __riscv_vle64_v_f64m4 -#define VLSEV_FLOAT __riscv_vlse64_v_f64m4 -#define VSEV_FLOAT __riscv_vse64_v_f64m4 -#define VSSEV_FLOAT __riscv_vsse64_v_f64m4 -#define VFMACCVF_FLOAT __riscv_vfmacc_vf_f64m4 -#define VFMULVF_FLOAT __riscv_vfmul_vf_f64m4 -#define VFNMSACVF_FLOAT __riscv_vfnmsac_vf_f64m4 +#define VLEV_FLOAT RISCV_RVV(vle64_v_f64m4) +#define VLSEV_FLOAT RISCV_RVV(vlse64_v_f64m4) +#define VSEV_FLOAT RISCV_RVV(vse64_v_f64m4) +#define VSSEV_FLOAT RISCV_RVV(vsse64_v_f64m4) +#define VFMACCVF_FLOAT RISCV_RVV(vfmacc_vf_f64m4) +#define VFMULVF_FLOAT RISCV_RVV(vfmul_vf_f64m4) +#define VFNMSACVF_FLOAT RISCV_RVV(vfnmsac_vf_f64m4) #endif int CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y, FLOAT c, FLOAT s) diff --git a/kernel/riscv64/zscal_vector.c b/kernel/riscv64/zscal_vector.c index 5d9ab7b28..2034aafaa 100644 --- a/kernel/riscv64/zscal_vector.c +++ b/kernel/riscv64/zscal_vector.c @@ -27,25 +27,25 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include "common.h" #if !defined(DOUBLE) -#define VSETVL(n) __riscv_vsetvl_e32m4(n) -#define VSETVL_MAX __riscv_vsetvlmax_e32m1() +#define VSETVL(n) RISCV_RVV(vsetvl_e32m4)(n) +#define VSETVL_MAX RISCV_RVV(vsetvlmax_e32m1)() #define FLOAT_V_T vfloat32m4_t -#define VLSEV_FLOAT __riscv_vlse32_v_f32m4 -#define VSSEV_FLOAT __riscv_vsse32_v_f32m4 -#define VFMACCVF_FLOAT __riscv_vfmacc_vf_f32m4 -#define VFMULVF_FLOAT __riscv_vfmul_vf_f32m4 -#define VFNMSACVF_FLOAT __riscv_vfnmsac_vf_f32m4 -#define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m4 +#define VLSEV_FLOAT RISCV_RVV(vlse32_v_f32m4) +#define VSSEV_FLOAT RISCV_RVV(vsse32_v_f32m4) +#define VFMACCVF_FLOAT RISCV_RVV(vfmacc_vf_f32m4) +#define VFMULVF_FLOAT RISCV_RVV(vfmul_vf_f32m4) +#define VFNMSACVF_FLOAT RISCV_RVV(vfnmsac_vf_f32m4) +#define VFMVVF_FLOAT RISCV_RVV(vfmv_v_f_f32m4) #else -#define VSETVL(n) __riscv_vsetvl_e64m4(n) -#define VSETVL_MAX __riscv_vsetvlmax_e64m1() +#define VSETVL(n) RISCV_RVV(vsetvl_e64m4)(n) +#define VSETVL_MAX RISCV_RVV(vsetvlmax_e64m1)() #define FLOAT_V_T vfloat64m4_t -#define VLSEV_FLOAT __riscv_vlse64_v_f64m4 -#define VSSEV_FLOAT __riscv_vsse64_v_f64m4 -#define VFMACCVF_FLOAT __riscv_vfmacc_vf_f64m4 -#define VFMULVF_FLOAT __riscv_vfmul_vf_f64m4 -#define VFNMSACVF_FLOAT __riscv_vfnmsac_vf_f64m4 -#define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m4 +#define VLSEV_FLOAT RISCV_RVV(vlse64_v_f64m4) +#define VSSEV_FLOAT RISCV_RVV(vsse64_v_f64m4) +#define VFMACCVF_FLOAT RISCV_RVV(vfmacc_vf_f64m4) +#define VFMULVF_FLOAT RISCV_RVV(vfmul_vf_f64m4) +#define VFNMSACVF_FLOAT RISCV_RVV(vfnmsac_vf_f64m4) +#define VFMVVF_FLOAT RISCV_RVV(vfmv_v_f_f64m4) #endif int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT da_r,FLOAT da_i, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y, FLOAT *dummy, BLASLONG dummy2) diff --git a/kernel/riscv64/zsum_vector.c b/kernel/riscv64/zsum_vector.c index 7aab15105..ca0b02b5c 100644 --- a/kernel/riscv64/zsum_vector.c +++ b/kernel/riscv64/zsum_vector.c @@ -53,16 +53,16 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define JOIN2(x, y) JOIN2_X(x, y) #define JOIN(v, w, x, y, z) JOIN2( JOIN2( JOIN2( JOIN2( v, w ), x), y), z) -#define VSETVL JOIN(__riscv_vsetvl, _e, ELEN, LMUL, _) +#define VSETVL JOIN(RISCV_RVV(vsetvl), _e, ELEN, LMUL, _) #define FLOAT_V_T JOIN(vfloat, ELEN, LMUL, _t, _) #define FLOAT_V_T_M1 JOIN(vfloat, ELEN, m1, _t, _) -#define VLEV_FLOAT JOIN(__riscv_vle, ELEN, _v_f, ELEN, LMUL) -#define VLSEV_FLOAT JOIN(__riscv_vlse, ELEN, _v_f, ELEN, LMUL) -#define VFREDSUMVS_FLOAT JOIN(__riscv_vfredusum_vs_f, ELEN, LMUL, _f, JOIN2( ELEN, m1)) -#define VFMVVF_FLOAT JOIN(__riscv_vfmv, _v_f_f, ELEN, LMUL, _) -#define VFMVVF_FLOAT_M1 JOIN(__riscv_vfmv, _v_f_f, ELEN, m1, _) -#define VFADDVV_FLOAT JOIN(__riscv_vfadd, _vv_f, ELEN, LMUL, _) -#define VMFLTVF_FLOAT JOIN(__riscv_vmflt, _vf_f, ELEN, LMUL, MLEN) +#define VLEV_FLOAT JOIN(RISCV_RVV(vle), ELEN, _v_f, ELEN, LMUL) +#define VLSEV_FLOAT JOIN(RISCV_RVV(vlse), ELEN, _v_f, ELEN, LMUL) +#define VFREDSUMVS_FLOAT JOIN(RISCV_RVV(vfredusum_vs_f), ELEN, LMUL, _f, JOIN2( ELEN, m1)) +#define VFMVVF_FLOAT JOIN(RISCV_RVV(vfmv), _v_f_f, ELEN, LMUL, _) +#define VFMVVF_FLOAT_M1 JOIN(RISCV_RVV(vfmv), _v_f_f, ELEN, m1, _) +#define VFADDVV_FLOAT JOIN(RISCV_RVV(vfadd), _vv_f, ELEN, LMUL, _) +#define VMFLTVF_FLOAT JOIN(RISCV_RVV(vmflt), _vf_f, ELEN, LMUL, MLEN) FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) { diff --git a/kernel/riscv64/zswap_vector.c b/kernel/riscv64/zswap_vector.c index d8980602d..02c98b588 100644 --- a/kernel/riscv64/zswap_vector.c +++ b/kernel/riscv64/zswap_vector.c @@ -53,12 +53,12 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define JOIN2(x, y) JOIN2_X(x, y) #define JOIN(v, w, x, y, z) JOIN2( JOIN2( JOIN2( JOIN2( v, w ), x), y), z) -#define VSETVL JOIN(__riscv_vsetvl, _e, ELEN, LMUL, _) +#define VSETVL JOIN(RISCV_RVV(vsetvl), _e, ELEN, LMUL, _) #define FLOAT_V_T JOIN(vfloat, ELEN, LMUL, _t, _) -#define VLEV_FLOAT JOIN(__riscv_vle, ELEN, _v_f, ELEN, LMUL) -#define VLSEV_FLOAT JOIN(__riscv_vlse, ELEN, _v_f, ELEN, LMUL) -#define VSEV_FLOAT JOIN(__riscv_vse, ELEN, _v_f, ELEN, LMUL) -#define VSSEV_FLOAT JOIN(__riscv_vsse, ELEN, _v_f, ELEN, LMUL) +#define VLEV_FLOAT JOIN(RISCV_RVV(vle), ELEN, _v_f, ELEN, LMUL) +#define VLSEV_FLOAT JOIN(RISCV_RVV(vlse), ELEN, _v_f, ELEN, LMUL) +#define VSEV_FLOAT JOIN(RISCV_RVV(vse), ELEN, _v_f, ELEN, LMUL) +#define VSSEV_FLOAT JOIN(RISCV_RVV(vsse), ELEN, _v_f, ELEN, LMUL) int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT dummy3, FLOAT dummy4, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y, FLOAT *dummy, BLASLONG dummy2) { From ec89466e14d3dff51128682b3975f8554439a2f1 Mon Sep 17 00:00:00 2001 From: Dirreke Date: Tue, 16 Jan 2024 23:45:06 +0800 Subject: [PATCH 063/311] Add CSKY support --- CONTRIBUTORS.md | 5 +- Makefile.csky | 4 + Makefile.prebuild | 4 + Makefile.system | 5 ++ TargetList.txt | 4 + c_check | 2 + c_check.pl | 7 ++ common.h | 4 + common_csky.h | 56 ++++++++++++++ ctest.c | 4 + getarch.c | 34 ++++++++- kernel/csky/KERNEL | 149 +++++++++++++++++++++++++++++++++++++ kernel/csky/Makefile | 1 + lapack/laswp/csky/Makefile | 13 ++++ param.h | 37 +++++++++ 15 files changed, 325 insertions(+), 4 deletions(-) create mode 100644 Makefile.csky create mode 100644 common_csky.h create mode 100644 kernel/csky/KERNEL create mode 100644 kernel/csky/Makefile create mode 100644 lapack/laswp/csky/Makefile diff --git a/CONTRIBUTORS.md b/CONTRIBUTORS.md index 493747052..419f90dab 100644 --- a/CONTRIBUTORS.md +++ b/CONTRIBUTORS.md @@ -218,4 +218,7 @@ In chronological order: * [2022-08] Fix building from sources for QNX * Mark Seminatore - * [2023-11-09] Improve Windows threading performance scaling \ No newline at end of file + * [2023-11-09] Improve Windows threading performance scaling + +* Dirreke + * [2024-01-16] Add basic support for the CSKY architecture diff --git a/Makefile.csky b/Makefile.csky new file mode 100644 index 000000000..36162af2a --- /dev/null +++ b/Makefile.csky @@ -0,0 +1,4 @@ +ifeq ($(CORE), CK860FV) +CCOMMON_OPT += -march=ck860v -mcpu=ck860fv -mfdivdu -mhard-float +FCOMMON_OPT += -march=ck860v -mcpu=ck860fv -mfdivdu -mhard-float -static +endif diff --git a/Makefile.prebuild b/Makefile.prebuild index 0be4f1274..83da8e2ce 100644 --- a/Makefile.prebuild +++ b/Makefile.prebuild @@ -55,6 +55,10 @@ ifeq ($(TARGET), C910V) TARGET_FLAGS = -march=rv64gcv0p7_zfh_xtheadc -mabi=lp64d endif +ifeq ($(TARGET), CK860FV) +TARGET_FLAGS = -march=ck860v -mcpu=ck860fv -mfdivdu -mhard-float +endif + all: getarch_2nd ./getarch_2nd 0 >> $(TARGET_MAKE) ./getarch_2nd 1 >> $(TARGET_CONF) diff --git a/Makefile.system b/Makefile.system index e602eaf05..0088eaff5 100644 --- a/Makefile.system +++ b/Makefile.system @@ -873,6 +873,11 @@ endif endif endif +ifeq ($(ARCH), csky) +NO_BINARY_MODE = 1 +BINARY_DEFINED = 1 +endif + # # C Compiler dependent settings # diff --git a/TargetList.txt b/TargetList.txt index deef75819..c11b94fa5 100644 --- a/TargetList.txt +++ b/TargetList.txt @@ -133,3 +133,7 @@ E2K EV4 EV5 EV6 + +14.CSKY +CSKY +CK860FV diff --git a/c_check b/c_check index 3e507be81..59ab9bb13 100755 --- a/c_check +++ b/c_check @@ -91,6 +91,7 @@ case "$data" in *ARCH_ZARCH*) architecture=zarch ;; *ARCH_RISCV64*) architecture=riscv64 ;; *ARCH_LOONGARCH64*) architecture=loongarch64 ;; + *ARCH_CSKY*) architecture=csky ;; esac defined=0 @@ -236,6 +237,7 @@ case "$data" in *ARCH_ARM*) architecture=arm ;; *ARCH_ZARCH*) architecture=zarch ;; *ARCH_LOONGARCH64*) architecture=loongarch64 ;; + *ARCH_CSKY*) architecture=csky ;; esac binformat='bin32' diff --git a/c_check.pl b/c_check.pl index d9c36793c..6b89f06eb 100644 --- a/c_check.pl +++ b/c_check.pl @@ -97,6 +97,7 @@ $architecture = arm64 if ($data =~ /ARCH_ARM64/); $architecture = zarch if ($data =~ /ARCH_ZARCH/); $architecture = riscv64 if ($data =~ /ARCH_RISCV64/); $architecture = loongarch64 if ($data =~ /ARCH_LOONGARCH64/); +$architecture = csky if ($data =~ /ARCH_CSKY/); $defined = 0; @@ -156,6 +157,11 @@ if ($architecture eq "loongarch64") { $binary = 64; } +if ($architecture eq "csky") { + $defined = 1; + $binary = 32; +} + if ($compiler eq "PGI") { $compiler_name .= " -tp p7" if ($binary eq "32"); $compiler_name .= " -tp p7-64" if ($binary eq "64"); @@ -284,6 +290,7 @@ $architecture = arm if ($data =~ /ARCH_ARM/); $architecture = arm64 if ($data =~ /ARCH_ARM64/); $architecture = zarch if ($data =~ /ARCH_ZARCH/); $architecture = loongarch64 if ($data =~ /ARCH_LOONGARCH64/); +$architecture = csky if ($data =~ /ARCH_CSKY/); $binformat = bin32; $binformat = bin64 if ($data =~ /BINARY_64/); diff --git a/common.h b/common.h index 462c1d428..1f0b9e533 100644 --- a/common.h +++ b/common.h @@ -482,6 +482,10 @@ please https://github.com/xianyi/OpenBLAS/issues/246 #include "common_e2k.h" #endif +#ifdef ARCH_CSKY +#include "common_csky.h" +#endif + #ifndef ASSEMBLER #ifdef OS_WINDOWSSTORE typedef char env_var_t[MAX_PATH]; diff --git a/common_csky.h b/common_csky.h new file mode 100644 index 000000000..3095dc781 --- /dev/null +++ b/common_csky.h @@ -0,0 +1,56 @@ +/***************************************************************************** +Copyright (c) 2011-2015, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. 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. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +**********************************************************************************/ + +#ifndef COMMON_CSKY +#define COMMON_CSKY + +#define MB __sync_synchronize() +#define WMB __sync_synchronize() +#define RMB __sync_synchronize() + +#define INLINE inline + +#ifndef ASSEMBLER + + +static inline int blas_quickdivide(blasint x, blasint y){ + return x / y; +} + +#endif + + + +#define BUFFER_SIZE ( 32 << 20) +#define SEEK_ADDRESS + +#endif \ No newline at end of file diff --git a/ctest.c b/ctest.c index 2ccae8dcc..cbc15326f 100644 --- a/ctest.c +++ b/ctest.c @@ -173,6 +173,10 @@ HAVE_C11 ARCH_E2K #endif +#if defined(__csky__) +ARCH_CSKY +#endif + #if defined(__EMSCRIPTEN__) ARCH_RISCV64 OS_WINDOWS diff --git a/getarch.c b/getarch.c index 87384c084..2d26da079 100644 --- a/getarch.c +++ b/getarch.c @@ -150,6 +150,8 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. /* #define FORCE_EV4 */ /* #define FORCE_EV5 */ /* #define FORCE_EV6 */ +/* #define FORCE_CSKY */ +/* #define FORCE_CK860FV */ /* #define FORCE_GENERIC */ #ifdef FORCE_P2 @@ -1692,6 +1694,33 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define CORENAME "generic" #endif +#ifdef FORCE_CSKY +#define FORCE +#define ARCHITECTURE "CSKY" +#define SUBARCHITECTURE "CSKY" +#define SUBDIRNAME "csky" +#define ARCHCONFIG "-DCSKY" \ + "-DL1_DATA_SIZE=65536 -DL1_DATA_LINESIZE=32 " \ + "-DL2_SIZE=524288 -DL2_LINESIZE=32 " \ + "-DDTB_DEFAULT_ENTRIES=64 -DDTB_SIZE=4096 -DL2_ASSOCIATIVE=8 " +#define LIBNAME "csky" +#define CORENAME "CSKY" +#endif + +#ifdef FORCE_CK860FV +#define FORCE +#define ARCHITECTURE "CSKY" +#define SUBARCHITECTURE "CK860V" +#define SUBDIRNAME "csky" +#define ARCHCONFIG "-DCK860FV " \ + "-DL1_DATA_SIZE=65536 -DL1_DATA_LINESIZE=32 " \ + "-DL2_SIZE=524288 -DL2_LINESIZE=32 " \ + "-DDTB_DEFAULT_ENTRIES=64 -DDTB_SIZE=4096 -DL2_ASSOCIATIVE=8 " +#define LIBNAME "ck860fv" +#define CORENAME "CK860FV" +#endif + + #ifndef FORCE #ifdef USER_TARGET @@ -1766,7 +1795,6 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define OPENBLAS_SUPPORTED #endif - #ifndef OPENBLAS_SUPPORTED #error "This arch/CPU is not supported by OpenBLAS." #endif @@ -1831,7 +1859,7 @@ int main(int argc, char *argv[]){ #ifdef FORCE printf("CORE=%s\n", CORENAME); #else -#if defined(INTEL_AMD) || defined(POWER) || defined(__mips__) || defined(__arm__) || defined(__aarch64__) || defined(ZARCH) || defined(sparc) || defined(__loongarch__) || defined(__riscv) || defined(__alpha__) +#if defined(INTEL_AMD) || defined(POWER) || defined(__mips__) || defined(__arm__) || defined(__aarch64__) || defined(ZARCH) || defined(sparc) || defined(__loongarch__) || defined(__riscv) || defined(__alpha__) || defined(__csky__) printf("CORE=%s\n", get_corename()); #endif #endif @@ -1979,7 +2007,7 @@ printf("ELF_VERSION=2\n"); #ifdef FORCE printf("#define CHAR_CORENAME \"%s\"\n", CORENAME); #else -#if defined(INTEL_AMD) || defined(POWER) || defined(__mips__) || defined(__arm__) || defined(__aarch64__) || defined(ZARCH) || defined(sparc) || defined(__loongarch__) || defined(__riscv) +#if defined(INTEL_AMD) || defined(POWER) || defined(__mips__) || defined(__arm__) || defined(__aarch64__) || defined(ZARCH) || defined(sparc) || defined(__loongarch__) || defined(__riscv) || defined(__csky__) printf("#define CHAR_CORENAME \"%s\"\n", get_corename()); #endif #endif diff --git a/kernel/csky/KERNEL b/kernel/csky/KERNEL new file mode 100644 index 000000000..afa8a0881 --- /dev/null +++ b/kernel/csky/KERNEL @@ -0,0 +1,149 @@ +SAMAXKERNEL = ../arm/amax.c +DAMAXKERNEL = ../arm/amax.c +CAMAXKERNEL = ../arm/zamax.c +ZAMAXKERNEL = ../arm/zamax.c + +SAMINKERNEL = ../arm/amin.c +DAMINKERNEL = ../arm/amin.c +CAMINKERNEL = ../arm/zamin.c +ZAMINKERNEL = ../arm/zamin.c + +SMAXKERNEL = ../arm/max.c +DMAXKERNEL = ../arm/max.c + +SMINKERNEL = ../arm/min.c +DMINKERNEL = ../arm/min.c + +ISAMAXKERNEL = ../arm/iamax.c +IDAMAXKERNEL = ../arm/iamax.c +ICAMAXKERNEL = ../arm/izamax.c +IZAMAXKERNEL = ../arm/izamax.c + +ISAMINKERNEL = ../arm/iamin.c +IDAMINKERNEL = ../arm/iamin.c +ICAMINKERNEL = ../arm/izamin.c +IZAMINKERNEL = ../arm/izamin.c + +ISMAXKERNEL = ../arm/imax.c +IDMAXKERNEL = ../arm/imax.c + +ISMINKERNEL = ../arm/imin.c +IDMINKERNEL = ../arm/imin.c + +SASUMKERNEL = ../arm/asum.c +DASUMKERNEL = ../arm/asum.c +CASUMKERNEL = ../arm/zasum.c +ZASUMKERNEL = ../arm/zasum.c + +SSUMKERNEL = ../arm/sum.c +DSUMKERNEL = ../arm/sum.c +CSUMKERNEL = ../arm/zsum.c +ZSUMKERNEL = ../arm/zsum.c + +SAXPYKERNEL = ../arm/axpy.c +DAXPYKERNEL = ../arm/axpy.c +CAXPYKERNEL = ../arm/zaxpy.c +ZAXPYKERNEL = ../arm/zaxpy.c + +SCOPYKERNEL = ../arm/copy.c +DCOPYKERNEL = ../arm/copy.c +CCOPYKERNEL = ../arm/zcopy.c +ZCOPYKERNEL = ../arm/zcopy.c + +SDOTKERNEL = ../arm/dot.c +DDOTKERNEL = ../arm/dot.c +CDOTKERNEL = ../arm/zdot.c +ZDOTKERNEL = ../arm/zdot.c +DSDOTKERNEL = ../generic/dot.c + +SNRM2KERNEL = ../arm/nrm2.c +DNRM2KERNEL = ../arm/nrm2.c +CNRM2KERNEL = ../arm/znrm2.c +ZNRM2KERNEL = ../arm/znrm2.c + +SROTKERNEL = ../arm/rot.c +DROTKERNEL = ../arm/rot.c +CROTKERNEL = ../arm/zrot.c +ZROTKERNEL = ../arm/zrot.c + +SSCALKERNEL = ../arm/scal.c +DSCALKERNEL = ../arm/scal.c +CSCALKERNEL = ../arm/zscal.c +ZSCALKERNEL = ../arm/zscal.c + +SSWAPKERNEL = ../arm/swap.c +DSWAPKERNEL = ../arm/swap.c +CSWAPKERNEL = ../arm/zswap.c +ZSWAPKERNEL = ../arm/zswap.c + +SGEMVNKERNEL = ../arm/gemv_n.c +DGEMVNKERNEL = ../arm/gemv_n.c +CGEMVNKERNEL = ../arm/zgemv_n.c +ZGEMVNKERNEL = ../arm/zgemv_n.c + +SGEMVTKERNEL = ../arm/gemv_t.c +DGEMVTKERNEL = ../arm/gemv_t.c +CGEMVTKERNEL = ../arm/zgemv_t.c +ZGEMVTKERNEL = ../arm/zgemv_t.c + +STRMMKERNEL = ../generic/trmmkernel_2x2.c +DTRMMKERNEL = ../generic/trmmkernel_2x2.c +CTRMMKERNEL = ../generic/ztrmmkernel_2x2.c +ZTRMMKERNEL = ../generic/ztrmmkernel_2x2.c + +SGEMMKERNEL = ../generic/gemmkernel_2x2.c +SGEMMONCOPY = ../generic/gemm_ncopy_2.c +SGEMMOTCOPY = ../generic/gemm_tcopy_2.c +SGEMMONCOPYOBJ = sgemm_oncopy$(TSUFFIX).$(SUFFIX) +SGEMMOTCOPYOBJ = sgemm_otcopy$(TSUFFIX).$(SUFFIX) + +DGEMMKERNEL = ../generic/gemmkernel_2x2.c +DGEMMONCOPY = ../generic/gemm_ncopy_2.c +DGEMMOTCOPY = ../generic/gemm_tcopy_2.c +DGEMMONCOPYOBJ = dgemm_oncopy$(TSUFFIX).$(SUFFIX) +DGEMMOTCOPYOBJ = dgemm_otcopy$(TSUFFIX).$(SUFFIX) + +CGEMMKERNEL = ../generic/zgemmkernel_2x2.c +CGEMMONCOPY = ../generic/zgemm_ncopy_2.c +CGEMMOTCOPY = ../generic/zgemm_tcopy_2.c +CGEMMONCOPYOBJ = cgemm_oncopy$(TSUFFIX).$(SUFFIX) +CGEMMOTCOPYOBJ = cgemm_otcopy$(TSUFFIX).$(SUFFIX) + +ZGEMMKERNEL = ../generic/zgemmkernel_2x2.c +ZGEMMONCOPY = ../generic/zgemm_ncopy_2.c +ZGEMMOTCOPY = ../generic/zgemm_tcopy_2.c +ZGEMMONCOPYOBJ = zgemm_oncopy$(TSUFFIX).$(SUFFIX) +ZGEMMOTCOPYOBJ = zgemm_otcopy$(TSUFFIX).$(SUFFIX) + +STRSMKERNEL_LN = ../generic/trsm_kernel_LN.c +STRSMKERNEL_LT = ../generic/trsm_kernel_LT.c +STRSMKERNEL_RN = ../generic/trsm_kernel_RN.c +STRSMKERNEL_RT = ../generic/trsm_kernel_RT.c + +DTRSMKERNEL_LN = ../generic/trsm_kernel_LN.c +DTRSMKERNEL_LT = ../generic/trsm_kernel_LT.c +DTRSMKERNEL_RN = ../generic/trsm_kernel_RN.c +DTRSMKERNEL_RT = ../generic/trsm_kernel_RT.c + +CTRSMKERNEL_LN = ../generic/trsm_kernel_LN.c +CTRSMKERNEL_LT = ../generic/trsm_kernel_LT.c +CTRSMKERNEL_RN = ../generic/trsm_kernel_RN.c +CTRSMKERNEL_RT = ../generic/trsm_kernel_RT.c + +ZTRSMKERNEL_LN = ../generic/trsm_kernel_LN.c +ZTRSMKERNEL_LT = ../generic/trsm_kernel_LT.c +ZTRSMKERNEL_RN = ../generic/trsm_kernel_RN.c +ZTRSMKERNEL_RT = ../generic/trsm_kernel_RT.c + + +SCABS_KERNEL = ../generic/cabs.c +DCABS_KERNEL = ../generic/cabs.c +QCABS_KERNEL = ../generic/cabs.c +LSAME_KERNEL = ../generic/lsame.c + +SGEMM_BETA = ../generic/gemm_beta.c +DGEMM_BETA = ../generic/gemm_beta.c +CGEMM_BETA = ../generic/zgemm_beta.c +ZGEMM_BETA = ../generic/zgemm_beta.c + + diff --git a/kernel/csky/Makefile b/kernel/csky/Makefile new file mode 100644 index 000000000..520349bd6 --- /dev/null +++ b/kernel/csky/Makefile @@ -0,0 +1 @@ +clean :: diff --git a/lapack/laswp/csky/Makefile b/lapack/laswp/csky/Makefile new file mode 100644 index 000000000..75411deb5 --- /dev/null +++ b/lapack/laswp/csky/Makefile @@ -0,0 +1,13 @@ +TOPDIR = ../../.. +include ../../../Makefile.system + +ifndef LASWP +LASWP = ../generic/laswp_k.c +endif + +ifndef ZLASWP +ZLASWP = ../generic/zlaswp_k.c +endif + +include ../generic/Makefile + diff --git a/param.h b/param.h index 469c38ce3..e048dabe7 100644 --- a/param.h +++ b/param.h @@ -3807,7 +3807,44 @@ Until then, just keep it different than DGEMM_DEFAULT_UNROLL_N to keep copy rout #define SYMV_P 16 #endif +#if defined(CSKY) || defined(CK860FV) +#define GEMM_DEFAULT_OFFSET_A 0 +#define GEMM_DEFAULT_OFFSET_B 0 +#define GEMM_DEFAULT_ALIGN (BLASLONG)0x03fffUL + +#define SGEMM_DEFAULT_UNROLL_M 2 +#define SGEMM_DEFAULT_UNROLL_N 2 + +#define DGEMM_DEFAULT_UNROLL_M 2 +#define DGEMM_DEFAULT_UNROLL_N 2 + +#define CGEMM_DEFAULT_UNROLL_M 2 +#define CGEMM_DEFAULT_UNROLL_N 2 + +#define ZGEMM_DEFAULT_UNROLL_M 2 +#define ZGEMM_DEFAULT_UNROLL_N 2 + +#define SGEMM_DEFAULT_P 128 +#define DGEMM_DEFAULT_P 128 +#define CGEMM_DEFAULT_P 96 +#define ZGEMM_DEFAULT_P 64 + +#define SGEMM_DEFAULT_Q 240 +#define DGEMM_DEFAULT_Q 120 +#define CGEMM_DEFAULT_Q 120 +#define ZGEMM_DEFAULT_Q 120 + +#define SGEMM_DEFAULT_R 12288 +#define DGEMM_DEFAULT_R 8192 +#define CGEMM_DEFAULT_R 4096 +#define ZGEMM_DEFAULT_R 4096 + +#define SYMV_P 16 +#define GEMM_DEFAULT_OFFSET_A 0 +#define GEMM_DEFAULT_OFFSET_B 0 + +#endif #ifdef GENERIC From ec46ca7a4344dac05f16ce29e3be86368f595d0c Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Wed, 17 Jan 2024 07:33:10 +0100 Subject: [PATCH 064/311] Support Arm Compiler for Linux as classic flang (#4436) * Support ArmCompilerforLinux as classic flang --- f_check | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/f_check b/f_check index dac34edee..81f598ffa 100755 --- a/f_check +++ b/f_check @@ -45,7 +45,7 @@ if [ -z "$compiler" ]; then pathf90 pathf95 pgf95 pgf90 pgf77 pgfortran nvfortran flang egfortran - ifort nagfor ifx ftn crayftn" + ifort nagfor ifx ftn crayftn armflang" for list in $lists; do for p in $path; do @@ -85,7 +85,11 @@ else *Hewlett*) vendor=CRAY openmp='-fopenmp' - ;; + ;; + *Arm\ F90*) + vendor=FLANG + openmp='-fopenmp' + ;; *GNU*|*GCC*) v="${data#*GCC: *\) }" @@ -108,7 +112,7 @@ else if [ "$major" -ge 17 ]; then vendor=FLANGNEW fi - ;; + ;; *ifort*|*ifx*) vendor=INTEL openmp='-fopenmp' From d2fc4f3b4d7f41527bc7dc8f62e9aa6229cfac89 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Wed, 17 Jan 2024 20:59:24 +0100 Subject: [PATCH 065/311] Increase multithreading threshold by a factor of 50 --- interface/gemv.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/interface/gemv.c b/interface/gemv.c index 1f0763579..2c121f130 100644 --- a/interface/gemv.c +++ b/interface/gemv.c @@ -226,7 +226,7 @@ void CNAME(enum CBLAS_ORDER order, #ifdef SMP - if ( 1L * m * n < 2304L * GEMM_MULTITHREAD_THRESHOLD ) + if ( 1L * m * n < 115200L * GEMM_MULTITHREAD_THRESHOLD ) nthreads = 1; else nthreads = num_cpu_avail(2); From a4992e09bc75cf95ea829c8ce3a8e2ea09d3d1fc Mon Sep 17 00:00:00 2001 From: Pierrick Bouvier Date: Thu, 18 Jan 2024 18:20:37 +0400 Subject: [PATCH 066/311] Fix utest compilation Introduced recently when adding new test cases for ZSCAL - include cblas is needed for cblas_zscal - ASSERT macro does not exist - missing closing ) --- utest/utest_main2.c | 33 +++++++++++++++++---------------- 1 file changed, 17 insertions(+), 16 deletions(-) diff --git a/utest/utest_main2.c b/utest/utest_main2.c index 8cb663190..46a3b067d 100644 --- a/utest/utest_main2.c +++ b/utest/utest_main2.c @@ -38,6 +38,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define CTEST_SEGFAULT #define CTEST_ADD_TESTS_MANUALLY +#include "cblas.h" #include "openblas_utest.h" CTEST(amax, samax){ @@ -623,10 +624,10 @@ CTEST(zscal, i_nan) double i[] = {0,1, 0,1, 0,1, 0,1, 0,1, 0,1, 0,1, 0,1, 0,1 }; double nan[] = {NAN,0, NAN,0, NAN,0, NAN,0, NAN,0, NAN,0, NAN,0, NAN,0, NAN,0, NAN,0}; cblas_zscal(9, i, &nan, 1); - ASSERT(isnan(nan[0]); - ASSERT(isnan(nan[1]); - ASSERT(isnan(nan[16]); - ASSERT(isnan(nan[17]); + ASSERT_TRUE(isnan(nan[0])); + ASSERT_TRUE(isnan(nan[1])); + ASSERT_TRUE(isnan(nan[16])); + ASSERT_TRUE(isnan(nan[17])); } CTEST(zscal, nan_i) @@ -634,10 +635,10 @@ CTEST(zscal, nan_i) double i[] = {0,1, 0,1, 0,1, 0,1, 0,1, 0,1, 0,1, 0,1, 0,1 }; double nan[] = {NAN,0, NAN,0, NAN,0, NAN,0, NAN,0, NAN,0, NAN,0, NAN,0, NAN,0, NAN,0}; cblas_zscal(9, &nan, &i, 1); - ASSERT(isnan(i[0]); - ASSERT(isnan(i[1]); - ASSERT(isnan(i[16]); - ASSERT(isnan(i[17]); + ASSERT_TRUE(isnan(i[0])); + ASSERT_TRUE(isnan(i[1])); + ASSERT_TRUE(isnan(i[16])); + ASSERT_TRUE(isnan(i[17])); } CTEST(zscal, i_inf) @@ -645,10 +646,10 @@ CTEST(zscal, i_inf) double i[] = {0,1, 0,1, 0,1, 0,1, 0,1, 0,1, 0,1, 0,1, 0,1 }; double inf[] = {INFINITY, 0, INFINITY,0, INFINITY,0, INFINITY,0, INFINITY,0, INFINITY,0, INFINITY,0, INFINITY,0, INFINITY,0}; cblas_zscal(9, i, &inf, 1); - ASSERT(isnan(inf[0]); - ASSERT(isinf(inf[1]); - ASSERT(isnan(inf[16]); - ASSERT(isinf(inf[17]); + ASSERT_TRUE(isnan(inf[0])); + ASSERT_TRUE(isinf(inf[1])); + ASSERT_TRUE(isnan(inf[16])); + ASSERT_TRUE(isinf(inf[17])); } CTEST(zscal, inf_i) @@ -656,10 +657,10 @@ CTEST(zscal, inf_i) double i[] = {0,1, 0,1, 0,1, 0,1, 0,1, 0,1, 0,1, 0,1, 0,1 }; double inf[] = {INFINITY, 0, INFINITY,0, INFINITY,0, INFINITY,0, INFINITY,0, INFINITY,0, INFINITY,0, INFINITY,0, INFINITY,0}; cblas_zscal(9, &inf, &i, 1); - ASSERT(isnan(i[0]); - ASSERT(isinf(i[1]); - ASSERT(isnan(i[16]); - ASSERT(isinf(i[17]); + ASSERT_TRUE(isnan(i[0])); + ASSERT_TRUE(isinf(i[1])); + ASSERT_TRUE(isnan(i[16])); + ASSERT_TRUE(isinf(i[17])); } int main(int argc, const char ** argv){ From b193ea3d7b6ae9950d6c7c73937661318a719c26 Mon Sep 17 00:00:00 2001 From: kseniyazaytseva Date: Thu, 18 Jan 2024 22:11:12 +0300 Subject: [PATCH 067/311] Fix BLAS and LAPACK tests for RVV 1.0 target, update to 0.12.0 intrincics * Update intrincics API to 0.12.0 version (Stride Segment Loads/Stores) * Fixed nrm2, axpby, ncopy, zgemv and scal kernels * Added zero size checks --- kernel/riscv64/axpby_rvv.c | 8 +- kernel/riscv64/copy_rvv.c | 2 +- kernel/riscv64/gemm_ncopy_8_rvv.c | 51 ++++- kernel/riscv64/gemm_tcopy_8_rvv.c | 71 +++--- kernel/riscv64/izamax_rvv.c | 23 +- kernel/riscv64/izamin_rvv.c | 23 +- kernel/riscv64/nrm2_rvv.c | 237 +++++++++++++------ kernel/riscv64/scal_rvv.c | 49 ++-- kernel/riscv64/symv_U_rvv.c | 2 +- kernel/riscv64/trsm_kernel_LN_rvv_v1.c | 39 ++-- kernel/riscv64/trsm_kernel_LT_rvv_v1.c | 39 ++-- kernel/riscv64/trsm_kernel_RN_rvv_v1.c | 37 +-- kernel/riscv64/trsm_kernel_RT_rvv_v1.c | 33 ++- kernel/riscv64/zamax_rvv.c | 23 +- kernel/riscv64/zamin_rvv.c | 23 +- kernel/riscv64/zaxpby_rvv.c | 63 ++++-- kernel/riscv64/zaxpy_rvv.c | 76 +++++-- kernel/riscv64/zcopy_rvv.c | 40 ++-- kernel/riscv64/zdot_rvv.c | 49 +++- kernel/riscv64/zgemm_beta_rvv.c | 27 ++- kernel/riscv64/zgemm_ncopy_4_rvv.c | 72 ++++-- kernel/riscv64/zgemm_ncopy_rvv_v1.c | 18 +- kernel/riscv64/zgemm_tcopy_4_rvv.c | 60 +++-- kernel/riscv64/zgemm_tcopy_rvv_v1.c | 18 +- kernel/riscv64/zgemmkernel_rvv_v1x4.c | 144 +++++++++--- kernel/riscv64/zgemv_n_rvv.c | 50 ++-- kernel/riscv64/zgemv_t_rvv.c | 44 ++-- kernel/riscv64/zhemm_ltcopy_rvv_v1.c | 33 ++- kernel/riscv64/zhemm_utcopy_rvv_v1.c | 33 ++- kernel/riscv64/znrm2_rvv.c | 301 +++++++++++++++++++------ kernel/riscv64/zrot_rvv.c | 95 ++++++-- kernel/riscv64/zscal_rvv.c | 66 ++++-- kernel/riscv64/zsum_rvv.c | 23 +- kernel/riscv64/zswap_rvv.c | 62 ++--- kernel/riscv64/zsymm_lcopy_rvv_v1.c | 33 ++- kernel/riscv64/zsymm_ucopy_rvv_v1.c | 33 ++- kernel/riscv64/ztrmm_lncopy_rvv_v1.c | 30 ++- kernel/riscv64/ztrmm_ltcopy_rvv_v1.c | 30 ++- kernel/riscv64/ztrmm_uncopy_rvv_v1.c | 30 ++- kernel/riscv64/ztrmm_utcopy_rvv_v1.c | 31 ++- kernel/riscv64/ztrmmkernel_rvv_v1x4.c | 110 ++++++--- kernel/riscv64/ztrsm_lncopy_rvv_v1.c | 26 +-- kernel/riscv64/ztrsm_ltcopy_rvv_v1.c | 26 +-- kernel/riscv64/ztrsm_uncopy_rvv_v1.c | 26 +-- kernel/riscv64/ztrsm_utcopy_rvv_v1.c | 26 +-- param.h | 2 +- 46 files changed, 1628 insertions(+), 709 deletions(-) diff --git a/kernel/riscv64/axpby_rvv.c b/kernel/riscv64/axpby_rvv.c index a1dbdb0e4..d7fb86eab 100644 --- a/kernel/riscv64/axpby_rvv.c +++ b/kernel/riscv64/axpby_rvv.c @@ -53,7 +53,7 @@ int CNAME(BLASLONG n, FLOAT alpha, FLOAT *x, BLASLONG inc_x, FLOAT beta, FLOAT * { FLOAT_V_T vx, vy; - if ( n < 0 ) return(0); + if ( n <= 0 ) return(0); if ( beta == 0.0 ) { if ( alpha == 0.0 ) { @@ -63,7 +63,7 @@ int CNAME(BLASLONG n, FLOAT alpha, FLOAT *x, BLASLONG inc_x, FLOAT beta, FLOAT * BLASLONG stride_y = inc_y * sizeof(FLOAT); size_t vl = VSETVL(n); vy = VFMVVF_FLOAT(0.0, vl); - for ( ; n > 0; n -= vl, y += vl*stride_y) { + for ( ; n > 0; n -= vl, y += vl*inc_y) { vl = VSETVL(n); VSSEV_FLOAT(y, stride_y, vy, vl); } @@ -126,10 +126,12 @@ int CNAME(BLASLONG n, FLOAT alpha, FLOAT *x, BLASLONG inc_x, FLOAT beta, FLOAT * } else { if ((1 == inc_x) && (1 == inc_y)) { - for (size_t vl; n > 0; n -= vl, y += vl) { + for (size_t vl; n > 0; n -= vl, x += vl, y += vl) { vl = VSETVL(n); + vx = VLEV_FLOAT(x, vl); vy = VLEV_FLOAT(y, vl); vy = VFMULVF_FLOAT(vy, beta, vl); + vy = VFMACCVF_FLOAT(vy, alpha, vx, vl); VSEV_FLOAT (y, vy, vl); } } else if (1 == inc_x) { diff --git a/kernel/riscv64/copy_rvv.c b/kernel/riscv64/copy_rvv.c index 041fd2dae..9d4b84095 100644 --- a/kernel/riscv64/copy_rvv.c +++ b/kernel/riscv64/copy_rvv.c @@ -45,7 +45,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. int CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y) { - if(n < 0) return(0); + if(n <= 0) return(0); FLOAT_V_T v0; diff --git a/kernel/riscv64/gemm_ncopy_8_rvv.c b/kernel/riscv64/gemm_ncopy_8_rvv.c index 3030d67fb..c652ab0c0 100644 --- a/kernel/riscv64/gemm_ncopy_8_rvv.c +++ b/kernel/riscv64/gemm_ncopy_8_rvv.c @@ -30,19 +30,31 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #if !defined(DOUBLE) #define VSETVL(n) __riscv_vsetvl_e32m1(n) #define FLOAT_V_T vfloat32m1_t +#define FLOAT_VX2_T vfloat32m1x2_t +#define FLOAT_VX4_T vfloat32m1x4_t +#define FLOAT_VX8_T vfloat32m1x8_t +#define VSET_VX2 __riscv_vset_v_f32m1_f32m1x2 +#define VSET_VX4 __riscv_vset_v_f32m1_f32m1x4 +#define VSET_VX8 __riscv_vset_v_f32m1_f32m1x8 #define VLEV_FLOAT __riscv_vle32_v_f32m1 #define VSEV_FLOAT __riscv_vse32_v_f32m1 -#define VSSEG2_FLOAT __riscv_vsseg2e32_v_f32m1 -#define VSSEG4_FLOAT __riscv_vsseg4e32_v_f32m1 -#define VSSEG8_FLOAT __riscv_vsseg8e32_v_f32m1 +#define VSSEG2_FLOAT __riscv_vsseg2e32_v_f32m1x2 +#define VSSEG4_FLOAT __riscv_vsseg4e32_v_f32m1x4 +#define VSSEG8_FLOAT __riscv_vsseg8e32_v_f32m1x8 #else #define VSETVL(n) __riscv_vsetvl_e64m1(n) #define FLOAT_V_T vfloat64m1_t +#define FLOAT_VX2_T vfloat64m1x2_t +#define FLOAT_VX4_T vfloat64m1x4_t +#define FLOAT_VX8_T vfloat64m1x8_t +#define VSET_VX2 __riscv_vset_v_f64m1_f64m1x2 +#define VSET_VX4 __riscv_vset_v_f64m1_f64m1x4 +#define VSET_VX8 __riscv_vset_v_f64m1_f64m1x8 #define VLEV_FLOAT __riscv_vle64_v_f64m1 #define VSEV_FLOAT __riscv_vse64_v_f64m1 -#define VSSEG2_FLOAT __riscv_vsseg2e64_v_f64m1 -#define VSSEG4_FLOAT __riscv_vsseg4e64_v_f64m1 -#define VSSEG8_FLOAT __riscv_vsseg8e64_v_f64m1 +#define VSSEG2_FLOAT __riscv_vsseg2e64_v_f64m1x2 +#define VSSEG4_FLOAT __riscv_vsseg4e64_v_f64m1x4 +#define VSSEG8_FLOAT __riscv_vsseg8e64_v_f64m1x8 #endif // Optimizes the implementation in ../generic/gemm_ncopy_8.c @@ -57,6 +69,10 @@ int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, FLOAT *b) FLOAT *b_offset; FLOAT_V_T v1, v2, v3, v4, v5, v6, v7, v8; + FLOAT_VX2_T vx2; + FLOAT_VX4_T vx4; + FLOAT_VX8_T vx8; + size_t vl; //fprintf(stderr, "gemm_ncopy_8 m=%ld n=%ld lda=%ld\n", m, n, lda); @@ -87,7 +103,16 @@ int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, FLOAT *b) v7 = VLEV_FLOAT(a_offset7, vl); v8 = VLEV_FLOAT(a_offset8, vl); - VSSEG8_FLOAT(b_offset, v1, v2, v3, v4, v5, v6, v7, v8, vl); + vx8 = VSET_VX8(vx8, 0, v1); + vx8 = VSET_VX8(vx8, 1, v2); + vx8 = VSET_VX8(vx8, 2, v3); + vx8 = VSET_VX8(vx8, 3, v4); + vx8 = VSET_VX8(vx8, 4, v5); + vx8 = VSET_VX8(vx8, 5, v6); + vx8 = VSET_VX8(vx8, 6, v7); + vx8 = VSET_VX8(vx8, 7, v8); + + VSSEG8_FLOAT(b_offset, vx8, vl); a_offset1 += vl; a_offset2 += vl; @@ -116,7 +141,12 @@ int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, FLOAT *b) v3 = VLEV_FLOAT(a_offset3, vl); v4 = VLEV_FLOAT(a_offset4, vl); - VSSEG4_FLOAT(b_offset, v1, v2, v3, v4, vl); + vx4 = VSET_VX4(vx4, 0, v1); + vx4 = VSET_VX4(vx4, 1, v2); + vx4 = VSET_VX4(vx4, 2, v3); + vx4 = VSET_VX4(vx4, 3, v4); + + VSSEG4_FLOAT(b_offset, vx4, vl); a_offset1 += vl; a_offset2 += vl; @@ -137,7 +167,10 @@ int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, FLOAT *b) v1 = VLEV_FLOAT(a_offset1, vl); v2 = VLEV_FLOAT(a_offset2, vl); - VSSEG2_FLOAT(b_offset, v1, v2, vl); + vx2 = VSET_VX2(vx2, 0, v1); + vx2 = VSET_VX2(vx2, 1, v2); + + VSSEG2_FLOAT(b_offset, vx2, vl); a_offset1 += vl; a_offset2 += vl; diff --git a/kernel/riscv64/gemm_tcopy_8_rvv.c b/kernel/riscv64/gemm_tcopy_8_rvv.c index 080a87312..4742ae6a7 100644 --- a/kernel/riscv64/gemm_tcopy_8_rvv.c +++ b/kernel/riscv64/gemm_tcopy_8_rvv.c @@ -30,27 +30,33 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #if !defined(DOUBLE) #define VSETVL(n) __riscv_vsetvl_e32m1(n) #define FLOAT_V_T vfloat32m1_t +#define FLOAT_VX2_T vfloat32m1x2_t +#define FLOAT_VX4_T vfloat32m1x4_t +#define FLOAT_VX8_T vfloat32m1x8_t #define VLEV_FLOAT __riscv_vle32_v_f32m1 #define VLSEV_FLOAT __riscv_vlse32_v_f32m1 #define VSEV_FLOAT __riscv_vse32_v_f32m1 -#define VLSSEG2_FLOAT __riscv_vlsseg2e32_v_f32m1 -#define VSSEG2_FLOAT __riscv_vsseg2e32_v_f32m1 -#define VLSSEG4_FLOAT __riscv_vlsseg4e32_v_f32m1 -#define VSSEG4_FLOAT __riscv_vsseg4e32_v_f32m1 -#define VLSSEG8_FLOAT __riscv_vlsseg8e32_v_f32m1 -#define VSSEG8_FLOAT __riscv_vsseg8e32_v_f32m1 +#define VLSSEG2_FLOAT __riscv_vlsseg2e32_v_f32m1x2 +#define VSSEG2_FLOAT __riscv_vsseg2e32_v_f32m1x2 +#define VLSSEG4_FLOAT __riscv_vlsseg4e32_v_f32m1x4 +#define VSSEG4_FLOAT __riscv_vsseg4e32_v_f32m1x4 +#define VLSSEG8_FLOAT __riscv_vlsseg8e32_v_f32m1x8 +#define VSSEG8_FLOAT __riscv_vsseg8e32_v_f32m1x8 #else #define VSETVL(n) __riscv_vsetvl_e64m1(n) #define FLOAT_V_T vfloat64m1_t +#define FLOAT_VX2_T vfloat64m1x2_t +#define FLOAT_VX4_T vfloat64m1x4_t +#define FLOAT_VX8_T vfloat64m1x8_t #define VLEV_FLOAT __riscv_vle64_v_f64m1 #define VLSEV_FLOAT __riscv_vlse64_v_f64m1 #define VSEV_FLOAT __riscv_vse64_v_f64m1 -#define VLSSEG2_FLOAT __riscv_vlsseg2e64_v_f64m1 -#define VSSEG2_FLOAT __riscv_vsseg2e64_v_f64m1 -#define VLSSEG4_FLOAT __riscv_vlsseg4e64_v_f64m1 -#define VSSEG4_FLOAT __riscv_vsseg4e64_v_f64m1 -#define VLSSEG8_FLOAT __riscv_vlsseg8e64_v_f64m1 -#define VSSEG8_FLOAT __riscv_vsseg8e64_v_f64m1 +#define VLSSEG2_FLOAT __riscv_vlsseg2e64_v_f64m1x2 +#define VSSEG2_FLOAT __riscv_vsseg2e64_v_f64m1x2 +#define VLSSEG4_FLOAT __riscv_vlsseg4e64_v_f64m1x4 +#define VSSEG4_FLOAT __riscv_vsseg4e64_v_f64m1x4 +#define VLSSEG8_FLOAT __riscv_vlsseg8e64_v_f64m1x8 +#define VSSEG8_FLOAT __riscv_vsseg8e64_v_f64m1x8 #endif int CNAME(BLASLONG m, BLASLONG n, IFLOAT *a, BLASLONG lda, IFLOAT *b) @@ -62,7 +68,10 @@ int CNAME(BLASLONG m, BLASLONG n, IFLOAT *a, BLASLONG lda, IFLOAT *b) IFLOAT *boffset, *boffset1, *boffset2, *boffset3, *boffset4; - FLOAT_V_T v0, v1, v2, v3, v4, v5, v6, v7; + FLOAT_V_T v0; + FLOAT_VX2_T vx2; + FLOAT_VX4_T vx4; + FLOAT_VX8_T vx8; // fprintf(stderr, "gemm_tcopy_8 m=%ld n=%ld lda=%ld\n", m, n, lda); @@ -83,8 +92,8 @@ int CNAME(BLASLONG m, BLASLONG n, IFLOAT *a, BLASLONG lda, IFLOAT *b) for(i = (n >> 3); i > 0; i--) { size_t vl = 8; - VLSSEG8_FLOAT(&v0, &v1, &v2, &v3, &v4, &v5, &v6, &v7, aoffset1, lda * sizeof(FLOAT), vl); - VSSEG8_FLOAT(boffset1, v0, v1, v2, v3, v4, v5, v6, v7, vl); + vx8 = VLSSEG8_FLOAT(aoffset1, lda * sizeof(FLOAT), vl); + VSSEG8_FLOAT(boffset1, vx8, vl); aoffset1 += 8; boffset1 += m * 8; @@ -93,8 +102,8 @@ int CNAME(BLASLONG m, BLASLONG n, IFLOAT *a, BLASLONG lda, IFLOAT *b) if (n & 4) { size_t vl = 8; - VLSSEG4_FLOAT(&v0, &v1, &v2, &v3, aoffset1, lda * sizeof(FLOAT), vl); - VSSEG4_FLOAT(boffset2, v0, v1, v2, v3, vl); + vx4 = VLSSEG4_FLOAT(aoffset1, lda * sizeof(FLOAT), vl); + VSSEG4_FLOAT(boffset2, vx4, vl); aoffset1 += 4; boffset2 += 32; @@ -103,8 +112,8 @@ int CNAME(BLASLONG m, BLASLONG n, IFLOAT *a, BLASLONG lda, IFLOAT *b) if (n & 2) { size_t vl = 8; - VLSSEG2_FLOAT(&v0, &v1, aoffset1, lda * sizeof(FLOAT), vl); - VSSEG2_FLOAT(boffset3, v0, v1, vl); + vx2 = VLSSEG2_FLOAT(aoffset1, lda * sizeof(FLOAT), vl); + VSSEG2_FLOAT(boffset3, vx2, vl); aoffset1 += 2; boffset3 += 16; @@ -133,8 +142,8 @@ int CNAME(BLASLONG m, BLASLONG n, IFLOAT *a, BLASLONG lda, IFLOAT *b) for(i = (n >> 3); i > 0; i--) { size_t vl = 4; - VLSSEG8_FLOAT(&v0, &v1, &v2, &v3, &v4, &v5, &v6, &v7, aoffset1, lda * sizeof(FLOAT), vl); - VSSEG8_FLOAT(boffset1, v0, v1, v2, v3, v4, v5, v6, v7, vl); + vx8 = VLSSEG8_FLOAT(aoffset1, lda * sizeof(FLOAT), vl); + VSSEG8_FLOAT(boffset1, vx8, vl); aoffset1 += 8; boffset1 += m * 8; @@ -143,8 +152,8 @@ int CNAME(BLASLONG m, BLASLONG n, IFLOAT *a, BLASLONG lda, IFLOAT *b) if (n & 4) { size_t vl = 4; - VLSSEG4_FLOAT(&v0, &v1, &v2, &v3, aoffset1, lda * sizeof(FLOAT), vl); - VSSEG4_FLOAT(boffset2, v0, v1, v2, v3, vl); + vx4 = VLSSEG4_FLOAT(aoffset1, lda * sizeof(FLOAT), vl); + VSSEG4_FLOAT(boffset2, vx4, vl); aoffset1 += 4; boffset2 += 16; @@ -153,8 +162,8 @@ int CNAME(BLASLONG m, BLASLONG n, IFLOAT *a, BLASLONG lda, IFLOAT *b) if (n & 2) { size_t vl = 4; - VLSSEG2_FLOAT(&v0, &v1, aoffset1, lda * sizeof(FLOAT), vl); - VSSEG2_FLOAT(boffset3, v0, v1, vl); + vx2 = VLSSEG2_FLOAT(aoffset1, lda * sizeof(FLOAT), vl); + VSSEG2_FLOAT(boffset3, vx2, vl); aoffset1 += 2; boffset3 += 8; @@ -181,8 +190,8 @@ int CNAME(BLASLONG m, BLASLONG n, IFLOAT *a, BLASLONG lda, IFLOAT *b) for(i = (n >> 3); i > 0; i--) { size_t vl = 2; - VLSSEG8_FLOAT(&v0, &v1, &v2, &v3, &v4, &v5, &v6, &v7, aoffset1, lda * sizeof(FLOAT), vl); - VSSEG8_FLOAT(boffset1, v0, v1, v2, v3, v4, v5, v6, v7, vl); + vx8 = VLSSEG8_FLOAT(aoffset1, lda * sizeof(FLOAT), vl); + VSSEG8_FLOAT(boffset1, vx8, vl); aoffset1 += 8; boffset1 += m * 8; @@ -191,8 +200,8 @@ int CNAME(BLASLONG m, BLASLONG n, IFLOAT *a, BLASLONG lda, IFLOAT *b) if (n & 4) { size_t vl = 2; - VLSSEG4_FLOAT(&v0, &v1, &v2, &v3, aoffset1, lda * sizeof(FLOAT), vl); - VSSEG4_FLOAT(boffset2, v0, v1, v2, v3, vl); + vx4 = VLSSEG4_FLOAT(aoffset1, lda * sizeof(FLOAT), vl); + VSSEG4_FLOAT(boffset2, vx4, vl); aoffset1 += 4; boffset2 += 8; @@ -201,8 +210,8 @@ int CNAME(BLASLONG m, BLASLONG n, IFLOAT *a, BLASLONG lda, IFLOAT *b) if (n & 2) { size_t vl = 2; - VLSSEG2_FLOAT(&v0, &v1, aoffset1, lda * sizeof(FLOAT), vl); - VSSEG2_FLOAT(boffset3, v0, v1, vl); + vx2 = VLSSEG2_FLOAT(aoffset1, lda * sizeof(FLOAT), vl); + VSSEG2_FLOAT(boffset3, vx2, vl); aoffset1 += 2; boffset3 += 4; diff --git a/kernel/riscv64/izamax_rvv.c b/kernel/riscv64/izamax_rvv.c index e93f0056c..32f66a7a7 100644 --- a/kernel/riscv64/izamax_rvv.c +++ b/kernel/riscv64/izamax_rvv.c @@ -32,10 +32,12 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VSETVL_MAX __riscv_vsetvlmax_e64m4() #define FLOAT_V_T vfloat64m4_t #define FLOAT_V_T_M1 vfloat64m1_t +#define FLOAT_VX2_T vfloat64m4x2_t +#define VGET_VX2 __riscv_vget_v_f64m4x2_f64m4 #define VLEV_FLOAT __riscv_vle64_v_f64m4 #define VLSEV_FLOAT __riscv_vlse64_v_f64m4 -#define VLSEG_FLOAT __riscv_vlseg2e64_v_f64m4 -#define VLSSEG_FLOAT __riscv_vlsseg2e64_v_f64m4 +#define VLSEG_FLOAT __riscv_vlseg2e64_v_f64m4x2 +#define VLSSEG_FLOAT __riscv_vlsseg2e64_v_f64m4x2 #define VFREDMAXVS_FLOAT __riscv_vfredmax_vs_f64m4_f64m1 #define MASK_T vbool16_t #define VMFLTVF_FLOAT __riscv_vmflt_vf_f64m4_b16 @@ -61,10 +63,12 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VSETVL_MAX __riscv_vsetvlmax_e32m4() #define FLOAT_V_T vfloat32m4_t #define FLOAT_V_T_M1 vfloat32m1_t +#define FLOAT_VX2_T vfloat32m4x2_t +#define VGET_VX2 __riscv_vget_v_f32m4x2_f32m4 #define VLEV_FLOAT __riscv_vle32_v_f32m4 #define VLSEV_FLOAT __riscv_vlse32_v_f32m4 -#define VLSEG_FLOAT __riscv_vlseg2e32_v_f32m4 -#define VLSSEG_FLOAT __riscv_vlsseg2e32_v_f32m4 +#define VLSEG_FLOAT __riscv_vlseg2e32_v_f32m4x2 +#define VLSSEG_FLOAT __riscv_vlsseg2e32_v_f32m4x2 #define VFREDMAXVS_FLOAT __riscv_vfredmax_vs_f32m4_f32m1 #define MASK_T vbool8_t #define VMFLTVF_FLOAT __riscv_vmflt_vf_f32m4_b8 @@ -93,6 +97,7 @@ BLASLONG CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) if (n <= 0 || inc_x <= 0) return(max_index); FLOAT_V_T vx0, vx1, v_max; + FLOAT_VX2_T vxx2; UINT_V_T v_max_index; MASK_T mask; @@ -107,7 +112,10 @@ BLASLONG CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) for (size_t vl; n > 0; n -= vl, x += vl*2, j += vl) { vl = VSETVL(n); - VLSEG_FLOAT(&vx0, &vx1, x, vl); + vxx2 = VLSEG_FLOAT(x, vl); + + vx0 = VGET_VX2(vxx2, 0); + vx1 = VGET_VX2(vxx2, 1); vx0 = VFABSV_FLOAT(vx0, vl); vx1 = VFABSV_FLOAT(vx1, vl); @@ -129,7 +137,10 @@ BLASLONG CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) for (size_t vl; n > 0; n -= vl, x += vl*inc_x*2, j += vl) { vl = VSETVL(n); - VLSSEG_FLOAT(&vx0, &vx1, x, stride_x, vl); + vxx2 = VLSSEG_FLOAT(x, stride_x, vl); + + vx0 = VGET_VX2(vxx2, 0); + vx1 = VGET_VX2(vxx2, 1); vx0 = VFABSV_FLOAT(vx0, vl); vx1 = VFABSV_FLOAT(vx1, vl); diff --git a/kernel/riscv64/izamin_rvv.c b/kernel/riscv64/izamin_rvv.c index b5bc27404..d34b220fa 100644 --- a/kernel/riscv64/izamin_rvv.c +++ b/kernel/riscv64/izamin_rvv.c @@ -33,8 +33,10 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VSETVL_MAX __riscv_vsetvlmax_e64m4() #define FLOAT_V_T vfloat64m4_t #define FLOAT_V_T_M1 vfloat64m1_t -#define VLSEG_FLOAT __riscv_vlseg2e64_v_f64m4 -#define VLSSEG_FLOAT __riscv_vlsseg2e64_v_f64m4 +#define FLOAT_VX2_T vfloat64m4x2_t +#define VGET_VX2 __riscv_vget_v_f64m4x2_f64m4 +#define VLSEG_FLOAT __riscv_vlseg2e64_v_f64m4x2 +#define VLSSEG_FLOAT __riscv_vlsseg2e64_v_f64m4x2 #define VFREDMINVS_FLOAT __riscv_vfredmin_vs_f64m4_f64m1 #define MASK_T vbool16_t #define VMFLTVF_FLOAT __riscv_vmflt_vf_f64m4_b16 @@ -60,8 +62,10 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VSETVL_MAX __riscv_vsetvlmax_e32m4() #define FLOAT_V_T vfloat32m4_t #define FLOAT_V_T_M1 vfloat32m1_t -#define VLSEG_FLOAT __riscv_vlseg2e32_v_f32m4 -#define VLSSEG_FLOAT __riscv_vlsseg2e32_v_f32m4 +#define FLOAT_VX2_T vfloat32m4x2_t +#define VGET_VX2 __riscv_vget_v_f32m4x2_f32m4 +#define VLSEG_FLOAT __riscv_vlseg2e32_v_f32m4x2 +#define VLSSEG_FLOAT __riscv_vlsseg2e32_v_f32m4x2 #define VFREDMINVS_FLOAT __riscv_vfredmin_vs_f32m4_f32m1 #define MASK_T vbool8_t #define VMFLTVF_FLOAT __riscv_vmflt_vf_f32m4_b8 @@ -90,6 +94,7 @@ BLASLONG CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) if (n <= 0 || inc_x <= 0) return(min_index); FLOAT_V_T vx0, vx1, v_min; + FLOAT_VX2_T vxx2; UINT_V_T v_min_index; MASK_T mask; @@ -104,7 +109,10 @@ BLASLONG CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) for (size_t vl; n > 0; n -= vl, x += vl*2, j += vl) { vl = VSETVL(n); - VLSEG_FLOAT(&vx0, &vx1, x, vl); + vxx2 = VLSEG_FLOAT(x, vl); + + vx0 = VGET_VX2(vxx2, 0); + vx1 = VGET_VX2(vxx2, 1); vx0 = VFABSV_FLOAT(vx0, vl); vx1 = VFABSV_FLOAT(vx1, vl); @@ -127,7 +135,10 @@ BLASLONG CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) for (size_t vl; n > 0; n -= vl, x += vl*inc_x*2, j += vl) { vl = VSETVL(n); - VLSSEG_FLOAT(&vx0, &vx1, x, stride_x, vl); + vxx2 = VLSSEG_FLOAT(x, stride_x, vl); + + vx0 = VGET_VX2(vxx2, 0); + vx1 = VGET_VX2(vxx2, 1); vx0 = VFABSV_FLOAT(vx0, vl); vx1 = VFABSV_FLOAT(vx1, vl); diff --git a/kernel/riscv64/nrm2_rvv.c b/kernel/riscv64/nrm2_rvv.c index 994fadb70..3eb423849 100644 --- a/kernel/riscv64/nrm2_rvv.c +++ b/kernel/riscv64/nrm2_rvv.c @@ -26,78 +26,187 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. *****************************************************************************/ #include "common.h" -#include - -#if !defined(DOUBLE) -#define VSETVL(n) __riscv_vsetvl_e32m8(n) -#define VSETVL_MAX __riscv_vsetvlmax_e32m8() -#define FLOAT_V_T vfloat32m8_t -#define FLOAT_V_T_M1 vfloat32m1_t -#define VLEV_FLOAT __riscv_vle32_v_f32m8 -#define VLSEV_FLOAT __riscv_vlse32_v_f32m8 -#define VFREDSUM_FLOAT __riscv_vfredusum_vs_f32m8_f32m1 -#define VFMACCVV_FLOAT_TU __riscv_vfmacc_vv_f32m8_tu -#define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m8 -#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f32m1 -#define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f32m1_f32 -#define ABS fabsf -#else -#define VSETVL(n) __riscv_vsetvl_e64m8(n) -#define VSETVL_MAX __riscv_vsetvlmax_e64m8() -#define FLOAT_V_T vfloat64m8_t -#define FLOAT_V_T_M1 vfloat64m1_t -#define VLEV_FLOAT __riscv_vle64_v_f64m8 -#define VLSEV_FLOAT __riscv_vlse64_v_f64m8 -#define VFREDSUM_FLOAT __riscv_vfredusum_vs_f64m8_f64m1 -#define VFMACCVV_FLOAT_TU __riscv_vfmacc_vv_f64m8_tu -#define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m8 -#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f64m1 -#define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f64m1_f64 + +#if defined(DOUBLE) +#define VSETVL __riscv_vsetvl_e64m4 +#define FLOAT_V_T vfloat64m4_t +#define FLOAT_V_T_M1 vfloat64m1_t +#define VLEV_FLOAT __riscv_vle64_v_f64m4 +#define VLSEV_FLOAT __riscv_vlse64_v_f64m4 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m4 +#define VFMVSF_FLOAT __riscv_vfmv_s_f_f64m4 +#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f64m1 +#define MASK_T vbool16_t +#define VFABS __riscv_vfabs_v_f64m4 +#define VMFNE __riscv_vmfne_vf_f64m4_b16 +#define VMFGT __riscv_vmfgt_vv_f64m4_b16 +#define VMFEQ __riscv_vmfeq_vf_f64m4_b16 +#define VCPOP __riscv_vcpop_m_b16 +#define VFREDMAX __riscv_vfredmax_vs_f64m4_f64m1 +#define VFREDMIN __riscv_vfredmin_vs_f64m4_f64m1 +#define VFIRST __riscv_vfirst_m_b16 +#define VRGATHER __riscv_vrgather_vx_f64m4 +#define VFDIV __riscv_vfdiv_vv_f64m4 +#define VFDIV_M __riscv_vfdiv_vv_f64m4_mu +#define VFMUL __riscv_vfmul_vv_f64m4 +#define VFMUL_M __riscv_vfmul_vv_f64m4_mu +#define VFMACC __riscv_vfmacc_vv_f64m4 +#define VFMACC_M __riscv_vfmacc_vv_f64m4_mu +#define VMSBF __riscv_vmsbf_m_b16 +#define VMSOF __riscv_vmsof_m_b16 +#define VMAND __riscv_vmand_mm_b16 +#define VMANDN __riscv_vmand_mm_b16 +#define VFREDSUM __riscv_vfredusum_vs_f64m4_f64m1 +#define VMERGE __riscv_vmerge_vvm_f64m4 +#define VSEV_FLOAT __riscv_vse64_v_f64m4 +#define EXTRACT_FLOAT0_V(v) __riscv_vfmv_f_s_f64m4_f64(v) #define ABS fabs +#else +#define VSETVL __riscv_vsetvl_e32m4 +#define FLOAT_V_T vfloat32m4_t +#define FLOAT_V_T_M1 vfloat32m1_t +#define VLEV_FLOAT __riscv_vle32_v_f32m4 +#define VLSEV_FLOAT __riscv_vlse32_v_f32m4 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m4 +#define VFMVSF_FLOAT __riscv_vfmv_s_f_f32m4 +#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f32m1 +#define MASK_T vbool8_t +#define VFABS __riscv_vfabs_v_f32m4 +#define VMFNE __riscv_vmfne_vf_f32m4_b8 +#define VMFGT __riscv_vmfgt_vv_f32m4_b8 +#define VMFEQ __riscv_vmfeq_vf_f32m4_b8 +#define VCPOP __riscv_vcpop_m_b8 +#define VFREDMAX __riscv_vfredmax_vs_f32m4_f32m1 +#define VFREDMIN __riscv_vfredmin_vs_f32m4_f32m1 +#define VFIRST __riscv_vfirst_m_b8 +#define VRGATHER __riscv_vrgather_vx_f32m4 +#define VFDIV __riscv_vfdiv_vv_f32m4 +#define VFDIV_M __riscv_vfdiv_vv_f32m4_mu +#define VFMUL __riscv_vfmul_vv_f32m4 +#define VFMUL_M __riscv_vfmul_vv_f32m4_mu +#define VFMACC __riscv_vfmacc_vv_f32m4 +#define VFMACC_M __riscv_vfmacc_vv_f32m4_mu +#define VMSBF __riscv_vmsbf_m_b8 +#define VMSOF __riscv_vmsof_m_b8 +#define VMAND __riscv_vmand_mm_b8 +#define VMANDN __riscv_vmand_mm_b8 +#define VFREDSUM __riscv_vfredusum_vs_f32m4_f32m1 +#define VMERGE __riscv_vmerge_vvm_f32m4 +#define VSEV_FLOAT __riscv_vse32_v_f32m4 +#define EXTRACT_FLOAT0_V(v) __riscv_vfmv_f_s_f32m4_f32(v) +#define ABS fabsf #endif - FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) { - - if( n <= 0 ) return(0.0); - if(n == 1) return (ABS(x[0])); - - FLOAT_V_T vr, v0; - FLOAT_V_T_M1 v_res; - FLOAT ssq = 0.0; - - size_t vlmax = VSETVL_MAX; - v_res = VFMVVF_FLOAT_M1(0, vlmax); - - vr = VFMVVF_FLOAT(0, vlmax); - - if(inc_x == 1) { - - for (size_t vl; n > 0; n -= vl, x += vl) { - vl = VSETVL(n); - - v0 = VLEV_FLOAT(x, vl); - - vr = VFMACCVV_FLOAT_TU(vr, v0, v0, vl); + BLASLONG i=0; + + if (n <= 0 || inc_x <= 0) return(0.0); + if(n == 1) return (ABS(x[0])); + + unsigned int gvl = 0; + + MASK_T nonzero_mask; + MASK_T scale_mask; + + gvl = VSETVL(n); + FLOAT_V_T v0; + FLOAT_V_T v_ssq = VFMVVF_FLOAT(0, gvl); + FLOAT_V_T v_scale = VFMVVF_FLOAT(0, gvl); + + FLOAT scale = 0; + FLOAT ssq = 0; + unsigned int stride_x = inc_x * sizeof(FLOAT); + int idx = 0; + + if( n >= gvl ) // don't pay overheads if we're not doing useful work + { + for(i=0; i 0; n -= vl, x += vl * inc_x) { - vl = VSETVL(n); - - v0 = VLSEV_FLOAT(x, stride_x, vl); - - vr = VFMACCVV_FLOAT_TU(vr, v0, v0, vl); + //finish any tail using scalar ops + i*=gvl*inc_x; + n*=inc_x; + while(i < n){ + if ( x[i] != 0.0 ){ + FLOAT absxi = ABS( x[i] ); + if ( scale < absxi ){ + ssq = 1 + ssq * ( scale / absxi ) * ( scale / absxi ); + scale = absxi ; + } + else{ + ssq += ( absxi/scale ) * ( absxi/scale ); + } + + } + + i += inc_x; } - } - v_res = VFREDSUM_FLOAT(vr, v_res, vlmax); + return(scale * sqrt(ssq)); +} - ssq = VFMVFS_FLOAT_M1(v_res); - return sqrt(ssq); -} diff --git a/kernel/riscv64/scal_rvv.c b/kernel/riscv64/scal_rvv.c index 2e2cfd31e..2c273fb63 100644 --- a/kernel/riscv64/scal_rvv.c +++ b/kernel/riscv64/scal_rvv.c @@ -29,6 +29,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #if !defined(DOUBLE) #define VSETVL(n) __riscv_vsetvl_e32m8(n) +#define VSETVL_MAX __riscv_vsetvlmax_e32m8() #define FLOAT_V_T vfloat32m8_t #define VLEV_FLOAT __riscv_vle32_v_f32m8 #define VLSEV_FLOAT __riscv_vlse32_v_f32m8 @@ -38,6 +39,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m8 #else #define VSETVL(n) __riscv_vsetvl_e64m8(n) +#define VSETVL_MAX __riscv_vsetvlmax_e64m8() #define FLOAT_V_T vfloat64m8_t #define VLEV_FLOAT __riscv_vle64_v_f64m8 #define VLSEV_FLOAT __riscv_vlse64_v_f64m8 @@ -54,26 +56,41 @@ int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT da, FLOAT *x, BLAS FLOAT_V_T v0; if(inc_x == 1) { - - for (size_t vl; n > 0; n -= vl, x += vl) { - vl = VSETVL(n); - - v0 = VLEV_FLOAT(x, vl); - v0 = VFMULVF_FLOAT(v0, da, vl); - VSEV_FLOAT(x, v0, vl); + if(da == 0.0) { + int gvl = VSETVL_MAX; + v0 = VFMVVF_FLOAT(0.0, gvl); + for (size_t vl; n > 0; n -= vl, x += vl) { + vl = VSETVL(n); + VSEV_FLOAT(x, v0, vl); + } } - - } else { + else { + for (size_t vl; n > 0; n -= vl, x += vl) { + vl = VSETVL(n); + v0 = VLEV_FLOAT(x, vl); + v0 = VFMULVF_FLOAT(v0, da, vl); + VSEV_FLOAT(x, v0, vl); + } + } + } else { BLASLONG stride_x = inc_x * sizeof(FLOAT); - for (size_t vl; n > 0; n -= vl, x += vl*inc_x) { - vl = VSETVL(n); - - v0 = VLSEV_FLOAT(x, stride_x, vl); - v0 = VFMULVF_FLOAT(v0, da, vl); - VSSEV_FLOAT(x, stride_x, v0, vl); + if(da == 0.0) { + int gvl = VSETVL_MAX; + v0 = VFMVVF_FLOAT(0.0, gvl); + for (size_t vl; n > 0; n -= vl, x += vl*inc_x) { + vl = VSETVL(n); + VSSEV_FLOAT(x, stride_x, v0, vl); + } + } + else { + for (size_t vl; n > 0; n -= vl, x += vl*inc_x) { + vl = VSETVL(n); + v0 = VLSEV_FLOAT(x, stride_x, vl); + v0 = VFMULVF_FLOAT(v0, da, vl); + VSSEV_FLOAT(x, stride_x, v0, vl); + } } - } return 0; diff --git a/kernel/riscv64/symv_U_rvv.c b/kernel/riscv64/symv_U_rvv.c index 3cfd3ee4c..bcd2f6981 100644 --- a/kernel/riscv64/symv_U_rvv.c +++ b/kernel/riscv64/symv_U_rvv.c @@ -82,7 +82,7 @@ int CNAME(BLASLONG m, BLASLONG offset, FLOAT alpha, FLOAT *a, BLASLONG lda, FLOA FLOAT_V_T va, vx, vy, vr; BLASLONG stride_x, stride_y, inc_xv, inc_yv; - + BLASLONG m1 = m - offset; if(inc_x == 1 && inc_y == 1) { diff --git a/kernel/riscv64/trsm_kernel_LN_rvv_v1.c b/kernel/riscv64/trsm_kernel_LN_rvv_v1.c index 886af0c3b..869561fb3 100644 --- a/kernel/riscv64/trsm_kernel_LN_rvv_v1.c +++ b/kernel/riscv64/trsm_kernel_LN_rvv_v1.c @@ -31,13 +31,15 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VSETVL(n) __riscv_vsetvl_e32m2(n) #define VSETVL_MAX __riscv_vsetvlmax_e32m2() #define FLOAT_V_T vfloat32m2_t +#define FLOAT_VX2_T vfloat32m2x2_t +#define VGET_VX2 __riscv_vget_v_f32m2x2_f32m2 +#define VSET_VX2 __riscv_vset_v_f32m2_f32m2x2 #define VLSEV_FLOAT __riscv_vlse32_v_f32m2 #define VSSEV_FLOAT __riscv_vsse32_v_f32m2 #define VSEV_FLOAT __riscv_vse32_v_f32m2 -#define VLSEG2_FLOAT __riscv_vlseg2e32_v_f32m2 -#define VSSEG2_FLOAT __riscv_vsseg2e32_v_f32m2 -#define VLSSEG2_FLOAT __riscv_vlsseg2e32_v_f32m2 -#define VSSSEG2_FLOAT __riscv_vssseg2e32_v_f32m2 +#define VSSEG2_FLOAT __riscv_vsseg2e32_v_f32m2x2 +#define VLSSEG2_FLOAT __riscv_vlsseg2e32_v_f32m2x2 +#define VSSSEG2_FLOAT __riscv_vssseg2e32_v_f32m2x2 #define VFMACCVF_FLOAT __riscv_vfmacc_vf_f32m2 #define VFNMSACVF_FLOAT __riscv_vfnmsac_vf_f32m2 #define VFMULVF_FLOAT __riscv_vfmul_vf_f32m2 @@ -45,13 +47,15 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VSETVL(n) __riscv_vsetvl_e64m2(n) #define VSETVL_MAX __riscv_vsetvlmax_e64m2() #define FLOAT_V_T vfloat64m2_t +#define FLOAT_VX2_T vfloat64m2x2_t +#define VGET_VX2 __riscv_vget_v_f64m2x2_f64m2 +#define VSET_VX2 __riscv_vset_v_f64m2_f64m2x2 #define VLSEV_FLOAT __riscv_vlse64_v_f64m2 #define VSSEV_FLOAT __riscv_vsse64_v_f64m2 #define VSEV_FLOAT __riscv_vse64_v_f64m2 -#define VLSEG2_FLOAT __riscv_vlseg2e64_v_f64m2 -#define VSSEG2_FLOAT __riscv_vsseg2e64_v_f64m2 -#define VLSSEG2_FLOAT __riscv_vlsseg2e64_v_f64m2 -#define VSSSEG2_FLOAT __riscv_vssseg2e64_v_f64m2 +#define VSSEG2_FLOAT __riscv_vsseg2e64_v_f64m2x2 +#define VLSSEG2_FLOAT __riscv_vlsseg2e64_v_f64m2x2 +#define VSSSEG2_FLOAT __riscv_vssseg2e64_v_f64m2x2 #define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m2 #define VFMACCVF_FLOAT __riscv_vfmacc_vf_f64m2 #define VFNMSACVF_FLOAT __riscv_vfnmsac_vf_f64m2 @@ -140,6 +144,7 @@ static inline void solve(BLASLONG m, BLASLONG n, FLOAT *a, FLOAT *b, FLOAT *c, B BLASLONG stride_ldc = sizeof(FLOAT) * ldc * 2; + FLOAT_VX2_T vbx2, vsx2, vcx2; FLOAT_V_T vb1, vb2, vc1, vc2, vs1, vs2; size_t vl; a += (m - 1) * m * 2; @@ -153,7 +158,9 @@ static inline void solve(BLASLONG m, BLASLONG n, FLOAT *a, FLOAT *b, FLOAT *c, B for (j = n; j > 0; j -= vl) { vl = VSETVL(j); - VLSSEG2_FLOAT(&vb1, &vb2, pc + i * 2, stride_ldc, vl); + vbx2 = VLSSEG2_FLOAT(pc + i * 2, stride_ldc, vl); + vb1 = VGET_VX2(vbx2, 0); + vb2 = VGET_VX2(vbx2, 1); #ifndef CONJ vs1 = VFMULVF_FLOAT(vb1, aa1, vl); vs1 = VFNMSACVF_FLOAT(vs1, aa2, vb2, vl); @@ -165,12 +172,16 @@ static inline void solve(BLASLONG m, BLASLONG n, FLOAT *a, FLOAT *b, FLOAT *c, B vs2 = VFMULVF_FLOAT(vb2, aa1, vl); vs2 = VFNMSACVF_FLOAT(vs2, aa2, vb1, vl); #endif - VSSEG2_FLOAT(b, vs1, vs2, vl); - VSSSEG2_FLOAT(pc + i * 2, stride_ldc, vs1, vs2, vl); + vsx2 = VSET_VX2(vsx2, 0, vs1); + vsx2 = VSET_VX2(vsx2, 1, vs2); + VSSEG2_FLOAT(b, vsx2, vl); + VSSSEG2_FLOAT(pc + i * 2, stride_ldc, vsx2, vl); b += vl * 2; for (k = 0; k < i; k ++) { - VLSSEG2_FLOAT(&vc1, &vc2, pc + k * 2, stride_ldc, vl); + vcx2 = VLSSEG2_FLOAT(pc + k * 2, stride_ldc, vl); + vc1 = VGET_VX2(vcx2, 0); + vc2 = VGET_VX2(vcx2, 1); #ifndef CONJ vc1 = VFMACCVF_FLOAT(vc1, *(a + k * 2 + 1), vs2, vl); vc1 = VFNMSACVF_FLOAT(vc1, *(a + k * 2 + 0), vs1, vl); @@ -182,7 +193,9 @@ static inline void solve(BLASLONG m, BLASLONG n, FLOAT *a, FLOAT *b, FLOAT *c, B vc2 = VFMACCVF_FLOAT(vc2, *(a + k * 2 + 1), vs1, vl); vc2 = VFNMSACVF_FLOAT(vc2, *(a + k * 2 + 0), vs2, vl); #endif - VSSSEG2_FLOAT(pc + k * 2, stride_ldc, vc1, vc2, vl); + vcx2 = VSET_VX2(vcx2, 0, vc1); + vcx2 = VSET_VX2(vcx2, 1, vc2); + VSSSEG2_FLOAT(pc + k * 2, stride_ldc, vcx2, vl); } pc += vl * ldc * 2; } diff --git a/kernel/riscv64/trsm_kernel_LT_rvv_v1.c b/kernel/riscv64/trsm_kernel_LT_rvv_v1.c index ddeef966c..da443cfba 100644 --- a/kernel/riscv64/trsm_kernel_LT_rvv_v1.c +++ b/kernel/riscv64/trsm_kernel_LT_rvv_v1.c @@ -31,13 +31,15 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VSETVL(n) __riscv_vsetvl_e32m2(n) #define VSETVL_MAX __riscv_vsetvlmax_e32m2() #define FLOAT_V_T vfloat32m2_t +#define FLOAT_VX2_T vfloat32m2x2_t +#define VGET_VX2 __riscv_vget_v_f32m2x2_f32m2 +#define VSET_VX2 __riscv_vset_v_f32m2_f32m2x2 #define VLSEV_FLOAT __riscv_vlse32_v_f32m2 #define VSSEV_FLOAT __riscv_vsse32_v_f32m2 #define VSEV_FLOAT __riscv_vse32_v_f32m2 -#define VLSEG2_FLOAT __riscv_vlseg2e32_v_f32m2 -#define VSSEG2_FLOAT __riscv_vsseg2e32_v_f32m2 -#define VLSSEG2_FLOAT __riscv_vlsseg2e32_v_f32m2 -#define VSSSEG2_FLOAT __riscv_vssseg2e32_v_f32m2 +#define VSSEG2_FLOAT __riscv_vsseg2e32_v_f32m2x2 +#define VLSSEG2_FLOAT __riscv_vlsseg2e32_v_f32m2x2 +#define VSSSEG2_FLOAT __riscv_vssseg2e32_v_f32m2x2 #define VFMACCVF_FLOAT __riscv_vfmacc_vf_f32m2 #define VFNMSACVF_FLOAT __riscv_vfnmsac_vf_f32m2 #define VFMULVF_FLOAT __riscv_vfmul_vf_f32m2 @@ -45,13 +47,15 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VSETVL(n) __riscv_vsetvl_e64m2(n) #define VSETVL_MAX __riscv_vsetvlmax_e64m2() #define FLOAT_V_T vfloat64m2_t +#define FLOAT_VX2_T vfloat64m2x2_t +#define VGET_VX2 __riscv_vget_v_f64m2x2_f64m2 +#define VSET_VX2 __riscv_vset_v_f64m2_f64m2x2 #define VLSEV_FLOAT __riscv_vlse64_v_f64m2 #define VSSEV_FLOAT __riscv_vsse64_v_f64m2 #define VSEV_FLOAT __riscv_vse64_v_f64m2 -#define VLSEG2_FLOAT __riscv_vlseg2e64_v_f64m2 -#define VSSEG2_FLOAT __riscv_vsseg2e64_v_f64m2 -#define VLSSEG2_FLOAT __riscv_vlsseg2e64_v_f64m2 -#define VSSSEG2_FLOAT __riscv_vssseg2e64_v_f64m2 +#define VSSEG2_FLOAT __riscv_vsseg2e64_v_f64m2x2 +#define VLSSEG2_FLOAT __riscv_vlsseg2e64_v_f64m2x2 +#define VSSSEG2_FLOAT __riscv_vssseg2e64_v_f64m2x2 #define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m2 #define VFMACCVF_FLOAT __riscv_vfmacc_vf_f64m2 #define VFNMSACVF_FLOAT __riscv_vfnmsac_vf_f64m2 @@ -137,6 +141,7 @@ static inline void solve(BLASLONG m, BLASLONG n, FLOAT *a, FLOAT *b, FLOAT *c, B BLASLONG stride_ldc = sizeof(FLOAT) * ldc * 2; + FLOAT_VX2_T vbx2, vsx2, vcx2; FLOAT_V_T vb1, vb2, vc1, vc2, vs1, vs2; size_t vl; @@ -149,7 +154,9 @@ static inline void solve(BLASLONG m, BLASLONG n, FLOAT *a, FLOAT *b, FLOAT *c, B for (j = n; j > 0; j -= vl) { vl = VSETVL(j); - VLSSEG2_FLOAT(&vb1, &vb2, pc + i * 2, stride_ldc, vl); + vbx2 = VLSSEG2_FLOAT(pc + i * 2, stride_ldc, vl); + vb1 = VGET_VX2(vbx2, 0); + vb2 = VGET_VX2(vbx2, 1); #ifndef CONJ vs1 = VFMULVF_FLOAT(vb1, aa1, vl); vs1 = VFNMSACVF_FLOAT(vs1, aa2, vb2, vl); @@ -161,12 +168,16 @@ static inline void solve(BLASLONG m, BLASLONG n, FLOAT *a, FLOAT *b, FLOAT *c, B vs2 = VFMULVF_FLOAT(vb2, aa1, vl); vs2 = VFNMSACVF_FLOAT(vs2, aa2, vb1, vl); #endif - VSSEG2_FLOAT(b, vs1, vs2, vl); - VSSSEG2_FLOAT(pc + i * 2, stride_ldc, vs1, vs2, vl); + vsx2 = VSET_VX2(vsx2, 0, vs1); + vsx2 = VSET_VX2(vsx2, 1, vs2); + VSSEG2_FLOAT(b, vsx2, vl); + VSSSEG2_FLOAT(pc + i * 2, stride_ldc, vsx2, vl); b += vl * 2; for (k = i + 1; k < m; k++) { - VLSSEG2_FLOAT(&vc1, &vc2, pc + k * 2, stride_ldc, vl); + vcx2 = VLSSEG2_FLOAT(pc + k * 2, stride_ldc, vl); + vc1 = VGET_VX2(vcx2, 0); + vc2 = VGET_VX2(vcx2, 1); #ifndef CONJ vc1 = VFMACCVF_FLOAT(vc1, *(a + k * 2 + 1), vs2, vl); vc1 = VFNMSACVF_FLOAT(vc1, *(a + k * 2 + 0), vs1, vl); @@ -178,7 +189,9 @@ static inline void solve(BLASLONG m, BLASLONG n, FLOAT *a, FLOAT *b, FLOAT *c, B vc2 = VFMACCVF_FLOAT(vc2, *(a + k * 2 + 1), vs1, vl); vc2 = VFNMSACVF_FLOAT(vc2, *(a + k * 2 + 0), vs2, vl); #endif - VSSSEG2_FLOAT(pc + k * 2, stride_ldc, vc1, vc2, vl); + vcx2 = VSET_VX2(vcx2, 0, vc1); + vcx2 = VSET_VX2(vcx2, 1, vc2); + VSSSEG2_FLOAT(pc + k * 2, stride_ldc, vcx2, vl); } pc += vl * ldc * 2; } diff --git a/kernel/riscv64/trsm_kernel_RN_rvv_v1.c b/kernel/riscv64/trsm_kernel_RN_rvv_v1.c index 4c83bbaa3..32e481036 100644 --- a/kernel/riscv64/trsm_kernel_RN_rvv_v1.c +++ b/kernel/riscv64/trsm_kernel_RN_rvv_v1.c @@ -31,13 +31,14 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VSETVL(n) __riscv_vsetvl_e32m2(n) #define VSETVL_MAX __riscv_vsetvlmax_e32m2() #define FLOAT_V_T vfloat32m2_t +#define FLOAT_VX2_T vfloat32m2x2_t +#define VGET_VX2 __riscv_vget_v_f32m2x2_f32m2 +#define VSET_VX2 __riscv_vset_v_f32m2_f32m2x2 #define VLEV_FLOAT __riscv_vle32_v_f32m2 #define VSSEV_FLOAT __riscv_vsse32_v_f32m2 #define VSEV_FLOAT __riscv_vse32_v_f32m2 -#define VLSEG2_FLOAT __riscv_vlseg2e32_v_f32m2 -#define VSSEG2_FLOAT __riscv_vsseg2e32_v_f32m2 -#define VLSSEG2_FLOAT __riscv_vlsseg2e32_v_f32m2 -#define VSSSEG2_FLOAT __riscv_vssseg2e32_v_f32m2 +#define VLSEG2_FLOAT __riscv_vlseg2e32_v_f32m2x2 +#define VSSEG2_FLOAT __riscv_vsseg2e32_v_f32m2x2 #define VFMACCVF_FLOAT __riscv_vfmacc_vf_f32m2 #define VFNMSACVF_FLOAT __riscv_vfnmsac_vf_f32m2 #define VFMULVF_FLOAT __riscv_vfmul_vf_f32m2 @@ -45,13 +46,14 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VSETVL(n) __riscv_vsetvl_e64m2(n) #define VSETVL_MAX __riscv_vsetvlmax_e64m2() #define FLOAT_V_T vfloat64m2_t +#define FLOAT_VX2_T vfloat64m2x2_t +#define VGET_VX2 __riscv_vget_v_f64m2x2_f64m2 +#define VSET_VX2 __riscv_vset_v_f64m2_f64m2x2 #define VLEV_FLOAT __riscv_vle64_v_f64m2 #define VSSEV_FLOAT __riscv_vsse64_v_f64m2 #define VSEV_FLOAT __riscv_vse64_v_f64m2 -#define VLSEG2_FLOAT __riscv_vlseg2e64_v_f64m2 -#define VSSEG2_FLOAT __riscv_vsseg2e64_v_f64m2 -#define VLSSEG2_FLOAT __riscv_vlsseg2e64_v_f64m2 -#define VSSSEG2_FLOAT __riscv_vssseg2e64_v_f64m2 +#define VLSEG2_FLOAT __riscv_vlseg2e64_v_f64m2x2 +#define VSSEG2_FLOAT __riscv_vsseg2e64_v_f64m2x2 #define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m2 #define VFMACCVF_FLOAT __riscv_vfmacc_vf_f64m2 #define VFNMSACVF_FLOAT __riscv_vfnmsac_vf_f64m2 @@ -133,6 +135,7 @@ static inline void solve(BLASLONG m, BLASLONG n, FLOAT *a, FLOAT *b, FLOAT *c, B int i, j, k; + FLOAT_VX2_T vax2, vsx2, vcx2; FLOAT_V_T va1, va2, vs1, vs2, vc1, vc2; size_t vl; @@ -147,7 +150,9 @@ static inline void solve(BLASLONG m, BLASLONG n, FLOAT *a, FLOAT *b, FLOAT *c, B for (j = m; j > 0; j -= vl) { vl = VSETVL(j); - VLSEG2_FLOAT(&va1, &va2, pci, vl); + vax2 = VLSEG2_FLOAT(pci, vl); + va1 = VGET_VX2(vax2, 0); + va2 = VGET_VX2(vax2, 1); #ifndef CONJ vs1 = VFMULVF_FLOAT(va1, bb1, vl); vs1 = VFNMSACVF_FLOAT(vs1, bb2, va2, vl); @@ -159,13 +164,17 @@ static inline void solve(BLASLONG m, BLASLONG n, FLOAT *a, FLOAT *b, FLOAT *c, B vs2 = VFMULVF_FLOAT(va2, bb1, vl); vs2 = VFNMSACVF_FLOAT(vs2, bb2, va1, vl); #endif - VSSEG2_FLOAT(a, vs1, vs2, vl); - VSSEG2_FLOAT(pci, vs1, vs2, vl); + vsx2 = VSET_VX2(vsx2, 0, vs1); + vsx2 = VSET_VX2(vsx2, 1, vs2); + VSSEG2_FLOAT(a, vsx2, vl); + VSSEG2_FLOAT(pci, vsx2, vl); a += vl * 2; pci += vl * 2; for (k = i + 1; k < n; k ++){ - VLSEG2_FLOAT(&vc1, &vc2, pcj + k * ldc * 2, vl); + vcx2 = VLSEG2_FLOAT(pcj + k * ldc * 2, vl); + vc1 = VGET_VX2(vcx2, 0); + vc2 = VGET_VX2(vcx2, 1); #ifndef CONJ vc1 = VFMACCVF_FLOAT(vc1, *(b + k * 2 + 1), vs2, vl); vc1 = VFNMSACVF_FLOAT(vc1, *(b + k * 2 + 0), vs1, vl); @@ -177,7 +186,9 @@ static inline void solve(BLASLONG m, BLASLONG n, FLOAT *a, FLOAT *b, FLOAT *c, B vc2 = VFMACCVF_FLOAT(vc2, *(b + k * 2 + 1), vs1, vl); vc2 = VFNMSACVF_FLOAT(vc2, *(b + k * 2 + 0), vs2, vl); #endif - VSSEG2_FLOAT(pcj + k * ldc * 2, vc1, vc2, vl); + vcx2 = VSET_VX2(vcx2, 0, vc1); + vcx2 = VSET_VX2(vcx2, 1, vc2); + VSSEG2_FLOAT(pcj + k * ldc * 2, vcx2, vl); } pcj += vl * 2; } diff --git a/kernel/riscv64/trsm_kernel_RT_rvv_v1.c b/kernel/riscv64/trsm_kernel_RT_rvv_v1.c index b368eefb9..81cc41818 100644 --- a/kernel/riscv64/trsm_kernel_RT_rvv_v1.c +++ b/kernel/riscv64/trsm_kernel_RT_rvv_v1.c @@ -31,10 +31,13 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VSETVL(n) __riscv_vsetvl_e32m2(n) #define VSETVL_MAX __riscv_vsetvlmax_e32m2() #define FLOAT_V_T vfloat32m2_t +#define FLOAT_VX2_T vfloat32m2x2_t +#define VGET_VX2 __riscv_vget_v_f32m2x2_f32m2 +#define VSET_VX2 __riscv_vset_v_f32m2_f32m2x2 #define VLEV_FLOAT __riscv_vle32_v_f32m2 #define VSEV_FLOAT __riscv_vse32_v_f32m2 -#define VLSEG2_FLOAT __riscv_vlseg2e32_v_f32m2 -#define VSSEG2_FLOAT __riscv_vsseg2e32_v_f32m2 +#define VLSEG2_FLOAT __riscv_vlseg2e32_v_f32m2x2 +#define VSSEG2_FLOAT __riscv_vsseg2e32_v_f32m2x2 #define VFMACCVF_FLOAT __riscv_vfmacc_vf_f32m2 #define VFNMSACVF_FLOAT __riscv_vfnmsac_vf_f32m2 #define VFMULVF_FLOAT __riscv_vfmul_vf_f32m2 @@ -42,10 +45,13 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VSETVL(n) __riscv_vsetvl_e64m2(n) #define VSETVL_MAX __riscv_vsetvlmax_e64m2() #define FLOAT_V_T vfloat64m2_t +#define FLOAT_VX2_T vfloat64m2x2_t +#define VGET_VX2 __riscv_vget_v_f64m2x2_f64m2 +#define VSET_VX2 __riscv_vset_v_f64m2_f64m2x2 #define VLEV_FLOAT __riscv_vle64_v_f64m2 #define VSEV_FLOAT __riscv_vse64_v_f64m2 -#define VLSEG2_FLOAT __riscv_vlseg2e64_v_f64m2 -#define VSSEG2_FLOAT __riscv_vsseg2e64_v_f64m2 +#define VLSEG2_FLOAT __riscv_vlseg2e64_v_f64m2x2 +#define VSSEG2_FLOAT __riscv_vsseg2e64_v_f64m2x2 #define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m2 #define VFMACCVF_FLOAT __riscv_vfmacc_vf_f64m2 #define VFNMSACVF_FLOAT __riscv_vfnmsac_vf_f64m2 @@ -133,6 +139,7 @@ static inline void solve(BLASLONG m, BLASLONG n, FLOAT *a, FLOAT *b, FLOAT *c, B int i, j, k; + FLOAT_VX2_T vax2, vsx2, vcx2; FLOAT_V_T va1, va2, vs1, vs2, vc1, vc2; size_t vl; @@ -149,7 +156,9 @@ static inline void solve(BLASLONG m, BLASLONG n, FLOAT *a, FLOAT *b, FLOAT *c, B pcj = c; for (j = m; j > 0; j -= vl) { vl = VSETVL(j); - VLSEG2_FLOAT(&va1, &va2, pci, vl); + vax2 = VLSEG2_FLOAT(pci, vl); + va1 = VGET_VX2(vax2, 0); + va2 = VGET_VX2(vax2, 1); #ifndef CONJ vs1 = VFMULVF_FLOAT(va1, bb1, vl); vs1 = VFNMSACVF_FLOAT(vs1, bb2, va2, vl); @@ -161,13 +170,17 @@ static inline void solve(BLASLONG m, BLASLONG n, FLOAT *a, FLOAT *b, FLOAT *c, B vs2 = VFMULVF_FLOAT(va2, bb1, vl); vs2 = VFNMSACVF_FLOAT(vs2, bb2, va1, vl); #endif - VSSEG2_FLOAT(a, vs1, vs2, vl); - VSSEG2_FLOAT(pci, vs1, vs2, vl); + vsx2 = VSET_VX2(vsx2, 0, vs1); + vsx2 = VSET_VX2(vsx2, 1, vs2); + VSSEG2_FLOAT(a, vsx2, vl); + VSSEG2_FLOAT(pci, vsx2, vl); a += vl * 2; pci += vl * 2; for (k = 0; k < i; k ++){ - VLSEG2_FLOAT(&vc1, &vc2, pcj + k * ldc * 2, vl); + vcx2 = VLSEG2_FLOAT(pcj + k * ldc * 2, vl); + vc1 = VGET_VX2(vcx2, 0); + vc2 = VGET_VX2(vcx2, 1); #ifndef CONJ vc1 = VFMACCVF_FLOAT(vc1, *(b + k * 2 + 1), vs2, vl); vc1 = VFNMSACVF_FLOAT(vc1, *(b + k * 2 + 0), vs1, vl); @@ -179,7 +192,9 @@ static inline void solve(BLASLONG m, BLASLONG n, FLOAT *a, FLOAT *b, FLOAT *c, B vc2 = VFMACCVF_FLOAT(vc2, *(b + k * 2 + 1), vs1, vl); vc2 = VFNMSACVF_FLOAT(vc2, *(b + k * 2 + 0), vs2, vl); #endif - VSSEG2_FLOAT(pcj + k * ldc * 2, vc1, vc2, vl); + vcx2 = VSET_VX2(vcx2, 0, vc1); + vcx2 = VSET_VX2(vcx2, 1, vc2); + VSSEG2_FLOAT(pcj + k * ldc * 2, vcx2, vl); } pcj += vl * 2; } diff --git a/kernel/riscv64/zamax_rvv.c b/kernel/riscv64/zamax_rvv.c index bbb1e876b..180cf059a 100644 --- a/kernel/riscv64/zamax_rvv.c +++ b/kernel/riscv64/zamax_rvv.c @@ -34,8 +34,10 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VSETVL_MAX_M1 __riscv_vsetvlmax_e32m1() #define FLOAT_V_T vfloat32m4_t #define FLOAT_V_T_M1 vfloat32m1_t -#define VLSEG_FLOAT __riscv_vlseg2e32_v_f32m4 -#define VLSSEG_FLOAT __riscv_vlsseg2e32_v_f32m4 +#define FLOAT_VX2_T vfloat32m4x2_t +#define VGET_VX2 __riscv_vget_v_f32m4x2_f32m4 +#define VLSEG_FLOAT __riscv_vlseg2e32_v_f32m4x2 +#define VLSSEG_FLOAT __riscv_vlsseg2e32_v_f32m4x2 #define VFREDMAXVS_FLOAT __riscv_vfredmax_vs_f32m4_f32m1 #define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m4 #define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f32m1 @@ -49,8 +51,10 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VSETVL_MAX_M1 __riscv_vsetvlmax_e64m1() #define FLOAT_V_T vfloat64m4_t #define FLOAT_V_T_M1 vfloat64m1_t -#define VLSEG_FLOAT __riscv_vlseg2e64_v_f64m4 -#define VLSSEG_FLOAT __riscv_vlsseg2e64_v_f64m4 +#define FLOAT_VX2_T vfloat64m4x2_t +#define VGET_VX2 __riscv_vget_v_f64m4x2_f64m4 +#define VLSEG_FLOAT __riscv_vlseg2e64_v_f64m4x2 +#define VLSSEG_FLOAT __riscv_vlsseg2e64_v_f64m4x2 #define VFREDMAXVS_FLOAT __riscv_vfredmax_vs_f64m4_f64m1 #define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m4 #define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f64m1 @@ -68,6 +72,7 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) FLOAT_V_T v0, v1, vmax; FLOAT_V_T_M1 v_res; + FLOAT_VX2_T vx2; v_res = VFMVVF_FLOAT_M1(0, VSETVL_MAX_M1); size_t vlmax = VSETVL_MAX; @@ -78,7 +83,10 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) for (size_t vl; n > 0; n -= vl, x += vl*2) { vl = VSETVL(n); - VLSEG_FLOAT(&v0, &v1, x, vl); + vx2 = VLSEG_FLOAT(x, vl); + + v0 = VGET_VX2(vx2, 0); + v1 = VGET_VX2(vx2, 1); v0 = VFABSV_FLOAT(v0, vl); v1 = VFABSV_FLOAT(v1, vl); @@ -95,7 +103,10 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) for (size_t vl; n > 0; n -= vl, x += vl*inc_x*2) { vl = VSETVL(n); - VLSSEG_FLOAT(&v0, &v1, x, stride_x, vl); + vx2 = VLSSEG_FLOAT(x, stride_x, vl); + + v0 = VGET_VX2(vx2, 0); + v1 = VGET_VX2(vx2, 1); v0 = VFABSV_FLOAT(v0, vl); v1 = VFABSV_FLOAT(v1, vl); diff --git a/kernel/riscv64/zamin_rvv.c b/kernel/riscv64/zamin_rvv.c index c5453121b..56a467502 100644 --- a/kernel/riscv64/zamin_rvv.c +++ b/kernel/riscv64/zamin_rvv.c @@ -34,8 +34,10 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VSETVL_MAX_M1 __riscv_vsetvlmax_e32m1() #define FLOAT_V_T vfloat32m4_t #define FLOAT_V_T_M1 vfloat32m1_t -#define VLSEG_FLOAT __riscv_vlseg2e32_v_f32m4 -#define VLSSEG_FLOAT __riscv_vlsseg2e32_v_f32m4 +#define FLOAT_VX2_T vfloat32m4x2_t +#define VGET_VX2 __riscv_vget_v_f32m4x2_f32m4 +#define VLSEG_FLOAT __riscv_vlseg2e32_v_f32m4x2 +#define VLSSEG_FLOAT __riscv_vlsseg2e32_v_f32m4x2 #define VFREDMINVS_FLOAT __riscv_vfredmin_vs_f32m4_f32m1 #define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m4 #define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f32m1 @@ -49,8 +51,10 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VSETVL_MAX_M1 __riscv_vsetvlmax_e64m1() #define FLOAT_V_T vfloat64m4_t #define FLOAT_V_T_M1 vfloat64m1_t -#define VLSEG_FLOAT __riscv_vlseg2e64_v_f64m4 -#define VLSSEG_FLOAT __riscv_vlsseg2e64_v_f64m4 +#define FLOAT_VX2_T vfloat64m4x2_t +#define VGET_VX2 __riscv_vget_v_f64m4x2_f64m4 +#define VLSEG_FLOAT __riscv_vlseg2e64_v_f64m4x2 +#define VLSSEG_FLOAT __riscv_vlsseg2e64_v_f64m4x2 #define VFREDMINVS_FLOAT __riscv_vfredmin_vs_f64m4_f64m1 #define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m4 #define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f64m1 @@ -68,6 +72,7 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) FLOAT_V_T v0, v1, vmin; FLOAT_V_T_M1 v_res; + FLOAT_VX2_T vx2; v_res = VFMVVF_FLOAT_M1(FLT_MAX, VSETVL_MAX_M1); size_t vlmax = VSETVL_MAX; @@ -78,7 +83,10 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) for (size_t vl; n > 0; n -= vl, x += vl*2) { vl = VSETVL(n); - VLSEG_FLOAT(&v0, &v1, x, vl); + vx2 = VLSEG_FLOAT(x, vl); + + v0 = VGET_VX2(vx2, 0); + v1 = VGET_VX2(vx2, 1); v0 = VFABSV_FLOAT(v0, vl); v1 = VFABSV_FLOAT(v1, vl); @@ -94,7 +102,10 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) for (size_t vl; n > 0; n -= vl, x += vl*inc_x*2) { vl = VSETVL(n); - VLSSEG_FLOAT(&v0, &v1, x, stride_x, vl); + vx2 = VLSSEG_FLOAT(x, stride_x, vl); + + v0 = VGET_VX2(vx2, 0); + v1 = VGET_VX2(vx2, 1); v0 = VFABSV_FLOAT(v0, vl); v1 = VFABSV_FLOAT(v1, vl); diff --git a/kernel/riscv64/zaxpby_rvv.c b/kernel/riscv64/zaxpby_rvv.c index e0da55311..66e38c1e4 100644 --- a/kernel/riscv64/zaxpby_rvv.c +++ b/kernel/riscv64/zaxpby_rvv.c @@ -35,6 +35,9 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #if !defined(DOUBLE) #define VSETVL(n) __riscv_vsetvl_e32m4(n) #define FLOAT_V_T vfloat32m4_t +#define FLOAT_VX2_T vfloat32m4x2_t +#define VGET_VX2 __riscv_vget_v_f32m4x2_f32m4 +#define VSET_VX2 __riscv_vset_v_f32m4_f32m4x2 #define VLSEV_FLOAT __riscv_vlse32_v_f32m4 #define VSSEV_FLOAT __riscv_vsse32_v_f32m4 #define VFMACCVF_FLOAT __riscv_vfmacc_vf_f32m4 @@ -42,13 +45,16 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m4 #define VFMULVF_FLOAT __riscv_vfmul_vf_f32m4 #define VFMSACVF_FLOAT __riscv_vfmsac_vf_f32m4 -#define VLSEG_FLOAT __riscv_vlseg2e32_v_f32m4 -#define VSSEG_FLOAT __riscv_vsseg2e32_v_f32m4 -#define VLSSEG_FLOAT __riscv_vlsseg2e32_v_f32m4 -#define VSSSEG_FLOAT __riscv_vssseg2e32_v_f32m4 +#define VLSEG_FLOAT __riscv_vlseg2e32_v_f32m4x2 +#define VSSEG_FLOAT __riscv_vsseg2e32_v_f32m4x2 +#define VLSSEG_FLOAT __riscv_vlsseg2e32_v_f32m4x2 +#define VSSSEG_FLOAT __riscv_vssseg2e32_v_f32m4x2 #else #define VSETVL(n) __riscv_vsetvl_e64m4(n) #define FLOAT_V_T vfloat64m4_t +#define FLOAT_VX2_T vfloat64m4x2_t +#define VGET_VX2 __riscv_vget_v_f64m4x2_f64m4 +#define VSET_VX2 __riscv_vset_v_f64m4_f64m4x2 #define VLSEV_FLOAT __riscv_vlse64_v_f64m4 #define VSSEV_FLOAT __riscv_vsse64_v_f64m4 #define VFMACCVF_FLOAT __riscv_vfmacc_vf_f64m4 @@ -56,10 +62,10 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m4 #define VFMULVF_FLOAT __riscv_vfmul_vf_f64m4 #define VFMSACVF_FLOAT __riscv_vfmsac_vf_f64m4 -#define VLSEG_FLOAT __riscv_vlseg2e64_v_f64m4 -#define VSSEG_FLOAT __riscv_vsseg2e64_v_f64m4 -#define VLSSEG_FLOAT __riscv_vlsseg2e64_v_f64m4 -#define VSSSEG_FLOAT __riscv_vssseg2e64_v_f64m4 +#define VLSEG_FLOAT __riscv_vlseg2e64_v_f64m4x2 +#define VSSEG_FLOAT __riscv_vsseg2e64_v_f64m4x2 +#define VLSSEG_FLOAT __riscv_vlsseg2e64_v_f64m4x2 +#define VSSSEG_FLOAT __riscv_vssseg2e64_v_f64m4x2 #endif int CNAME(BLASLONG n, FLOAT alpha_r, FLOAT alpha_i, FLOAT *x, BLASLONG inc_x, FLOAT beta_r, FLOAT beta_i,FLOAT *y, BLASLONG inc_y) @@ -74,6 +80,7 @@ int CNAME(BLASLONG n, FLOAT alpha_r, FLOAT alpha_i, FLOAT *x, BLASLONG inc_x, FL BLASLONG stride_x = inc_x2 * sizeof(FLOAT); BLASLONG stride_y = inc_y2 * sizeof(FLOAT); FLOAT_V_T vx0, vx1, vy0, vy1; + FLOAT_VX2_T vxx2, vyx2; if ( beta_r == 0.0 && beta_i == 0.0) { @@ -81,10 +88,12 @@ int CNAME(BLASLONG n, FLOAT alpha_r, FLOAT alpha_i, FLOAT *x, BLASLONG inc_x, FL { size_t vl = VSETVL(n); FLOAT_V_T temp = VFMVVF_FLOAT(0.0, vl); - for ( ; n > 0; n -= vl, y += vl*stride_y) + vxx2 = VSET_VX2(vxx2, 0, temp); + vxx2 = VSET_VX2(vxx2, 1, temp); + for ( ; n > 0; n -= vl, y += vl*inc_y2) { vl = VSETVL(n); - VSSSEG_FLOAT(y, stride_y, temp, temp, vl); + VSSSEG_FLOAT(y, stride_y, vxx2, vl); } } else @@ -92,7 +101,10 @@ int CNAME(BLASLONG n, FLOAT alpha_r, FLOAT alpha_i, FLOAT *x, BLASLONG inc_x, FL for (size_t vl; n > 0; n -= vl, x += vl*inc_x2, y += vl*inc_y2) { vl = VSETVL(n); - VLSSEG_FLOAT(&vx0, &vx1, x, stride_x, vl); + + vxx2 = VLSSEG_FLOAT(x, stride_x, vl); + vx0 = VGET_VX2(vxx2, 0); + vx1 = VGET_VX2(vxx2, 1); vy0 = VFMULVF_FLOAT(vx1, alpha_i, vl); vy0 = VFMSACVF_FLOAT(vy0, alpha_r, vx0, vl); @@ -100,20 +112,26 @@ int CNAME(BLASLONG n, FLOAT alpha_r, FLOAT alpha_i, FLOAT *x, BLASLONG inc_x, FL vy1 = VFMULVF_FLOAT(vx1, alpha_r, vl); vy1 = VFMACCVF_FLOAT(vy1, alpha_i, vx0, vl); - VSSSEG_FLOAT(y, stride_y, vy0, vy1, vl); + vyx2 = VSET_VX2(vyx2, 0, vy0); + vyx2 = VSET_VX2(vyx2, 1, vy1); + VSSSEG_FLOAT(y, stride_y, vyx2, vl); } } } else { FLOAT_V_T v0, v1; + FLOAT_VX2_T v_x2; if ( alpha_r == 0.0 && alpha_i == 0.0 ) { for (size_t vl; n > 0; n -= vl, y += vl*inc_y2) { vl = VSETVL(n); - VLSSEG_FLOAT(&vy0, &vy1, y, stride_y, vl); + + vyx2 = VLSSEG_FLOAT(y, stride_y, vl); + vy0 = VGET_VX2(vyx2, 0); + vy1 = VGET_VX2(vyx2, 1); v0 = VFMULVF_FLOAT(vy1, beta_i, vl); v0 = VFMSACVF_FLOAT(v0, beta_r, vy0, vl); @@ -121,7 +139,9 @@ int CNAME(BLASLONG n, FLOAT alpha_r, FLOAT alpha_i, FLOAT *x, BLASLONG inc_x, FL v1 = VFMULVF_FLOAT(vy1, beta_r, vl); v1 = VFMACCVF_FLOAT(v1, beta_i, vy0, vl); - VSSSEG_FLOAT(y, stride_y, v0, v1, vl); + v_x2 = VSET_VX2(v_x2, 0, v0); + v_x2 = VSET_VX2(v_x2, 1, v1); + VSSSEG_FLOAT(y, stride_y, v_x2, vl); } } else @@ -129,8 +149,14 @@ int CNAME(BLASLONG n, FLOAT alpha_r, FLOAT alpha_i, FLOAT *x, BLASLONG inc_x, FL for (size_t vl; n > 0; n -= vl, x += vl*inc_x2, y += vl*inc_y2) { vl = VSETVL(n); - VLSSEG_FLOAT(&vx0, &vx1, x, stride_x, vl); - VLSSEG_FLOAT(&vy0, &vy1, y, stride_y, vl); + + vxx2 = VLSSEG_FLOAT(x, stride_x, vl); + vyx2 = VLSSEG_FLOAT(y, stride_y, vl); + + vx0 = VGET_VX2(vxx2, 0); + vx1 = VGET_VX2(vxx2, 1); + vy0 = VGET_VX2(vyx2, 0); + vy1 = VGET_VX2(vyx2, 1); v0 = VFMULVF_FLOAT(vx0, alpha_r, vl); v0 = VFNMSACVF_FLOAT(v0, alpha_i, vx1, vl); @@ -142,7 +168,10 @@ int CNAME(BLASLONG n, FLOAT alpha_r, FLOAT alpha_i, FLOAT *x, BLASLONG inc_x, FL v1 = VFMACCVF_FLOAT(v1, beta_r, vy1, vl); v1 = VFMACCVF_FLOAT(v1, beta_i, vy0, vl); - VSSSEG_FLOAT(y, stride_y, v0, v1, vl); + v_x2 = VSET_VX2(v_x2, 0, v0); + v_x2 = VSET_VX2(v_x2, 1, v1); + + VSSSEG_FLOAT(y, stride_y, v_x2, vl); } } } diff --git a/kernel/riscv64/zaxpy_rvv.c b/kernel/riscv64/zaxpy_rvv.c index 3f75898e0..0db32df10 100644 --- a/kernel/riscv64/zaxpy_rvv.c +++ b/kernel/riscv64/zaxpy_rvv.c @@ -30,19 +30,25 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #if !defined(DOUBLE) #define VSETVL(n) __riscv_vsetvl_e32m4(n) #define FLOAT_V_T vfloat32m4_t -#define VLSEG_FLOAT __riscv_vlseg2e32_v_f32m4 -#define VLSSEG_FLOAT __riscv_vlsseg2e32_v_f32m4 -#define VSSEG_FLOAT __riscv_vsseg2e32_v_f32m4 -#define VSSSEG_FLOAT __riscv_vssseg2e32_v_f32m4 +#define FLOAT_VX2_T vfloat32m4x2_t +#define VGET_VX2 __riscv_vget_v_f32m4x2_f32m4 +#define VSET_VX2 __riscv_vset_v_f32m4_f32m4x2 +#define VLSEG_FLOAT __riscv_vlseg2e32_v_f32m4x2 +#define VLSSEG_FLOAT __riscv_vlsseg2e32_v_f32m4x2 +#define VSSEG_FLOAT __riscv_vsseg2e32_v_f32m4x2 +#define VSSSEG_FLOAT __riscv_vssseg2e32_v_f32m4x2 #define VFMACCVF_FLOAT __riscv_vfmacc_vf_f32m4 #define VFNMSACVF_FLOAT __riscv_vfnmsac_vf_f32m4 #else #define VSETVL(n) __riscv_vsetvl_e64m4(n) #define FLOAT_V_T vfloat64m4_t -#define VLSEG_FLOAT __riscv_vlseg2e64_v_f64m4 -#define VLSSEG_FLOAT __riscv_vlsseg2e64_v_f64m4 -#define VSSEG_FLOAT __riscv_vsseg2e64_v_f64m4 -#define VSSSEG_FLOAT __riscv_vssseg2e64_v_f64m4 +#define FLOAT_VX2_T vfloat64m4x2_t +#define VGET_VX2 __riscv_vget_v_f64m4x2_f64m4 +#define VSET_VX2 __riscv_vset_v_f64m4_f64m4x2 +#define VLSEG_FLOAT __riscv_vlseg2e64_v_f64m4x2 +#define VLSSEG_FLOAT __riscv_vlsseg2e64_v_f64m4x2 +#define VSSEG_FLOAT __riscv_vsseg2e64_v_f64m4x2 +#define VSSSEG_FLOAT __riscv_vssseg2e64_v_f64m4x2 #define VFMACCVF_FLOAT __riscv_vfmacc_vf_f64m4 #define VFNMSACVF_FLOAT __riscv_vfnmsac_vf_f64m4 #endif @@ -53,14 +59,21 @@ int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT da_r, FLOAT da_i, if(da_r == 0.0 && da_i == 0.0) return(0); FLOAT_V_T vx0, vx1, vy0, vy1; + FLOAT_VX2_T vxx2, vyx2; if(inc_x == 1 && inc_y == 1) { for (size_t vl; n > 0; n -= vl, x += vl*2, y += vl*2) { vl = VSETVL(n); - VLSEG_FLOAT(&vx0, &vx1, x, vl); - VLSEG_FLOAT(&vy0, &vy1, y, vl); + vxx2 = VLSEG_FLOAT(x, vl); + vyx2 = VLSEG_FLOAT(y, vl); + + vx0 = VGET_VX2(vxx2, 0); + vx1 = VGET_VX2(vxx2, 1); + vy0 = VGET_VX2(vyx2, 0); + vy1 = VGET_VX2(vyx2, 1); + #if !defined(CONJ) vy0 = VFMACCVF_FLOAT(vy0, da_r, vx0, vl); vy0 = VFNMSACVF_FLOAT(vy0, da_i, vx1, vl); @@ -72,7 +85,9 @@ int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT da_r, FLOAT da_i, vy1 = VFNMSACVF_FLOAT(vy1, da_r, vx1, vl); vy1 = VFMACCVF_FLOAT(vy1, da_i, vx0, vl); #endif - VSSEG_FLOAT(y, vy0, vy1, vl); + vyx2 = VSET_VX2(vyx2, 0, vy0); + vyx2 = VSET_VX2(vyx2, 1, vy1); + VSSEG_FLOAT(y, vyx2, vl); } } else if (inc_x == 1) { @@ -82,8 +97,13 @@ int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT da_r, FLOAT da_i, for (size_t vl; n > 0; n -= vl, x += vl*2, y += vl*inc_y*2) { vl = VSETVL(n); - VLSEG_FLOAT(&vx0, &vx1, x, vl); - VLSSEG_FLOAT(&vy0, &vy1, y, stride_y, vl); + vxx2 = VLSEG_FLOAT(x, vl); + vyx2 = VLSSEG_FLOAT(y, stride_y, vl); + + vx0 = VGET_VX2(vxx2, 0); + vx1 = VGET_VX2(vxx2, 1); + vy0 = VGET_VX2(vyx2, 0); + vy1 = VGET_VX2(vyx2, 1); #if !defined(CONJ) vy0 = VFMACCVF_FLOAT(vy0, da_r, vx0, vl); @@ -96,7 +116,9 @@ int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT da_r, FLOAT da_i, vy1 = VFNMSACVF_FLOAT(vy1, da_r, vx1, vl); vy1 = VFMACCVF_FLOAT(vy1, da_i, vx0, vl); #endif - VSSSEG_FLOAT(y, stride_y, vy0, vy1, vl); + vyx2 = VSET_VX2(vyx2, 0, vy0); + vyx2 = VSET_VX2(vyx2, 1, vy1); + VSSSEG_FLOAT(y, stride_y, vyx2, vl); } } else if (inc_y == 1) { @@ -106,8 +128,13 @@ int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT da_r, FLOAT da_i, for (size_t vl; n > 0; n -= vl, x += vl*inc_x*2, y += vl*2) { vl = VSETVL(n); - VLSSEG_FLOAT(&vx0, &vx1, x, stride_x, vl); - VLSEG_FLOAT(&vy0, &vy1, y, vl); + vxx2 = VLSSEG_FLOAT(x, stride_x, vl); + vyx2 = VLSEG_FLOAT(y, vl); + + vx0 = VGET_VX2(vxx2, 0); + vx1 = VGET_VX2(vxx2, 1); + vy0 = VGET_VX2(vyx2, 0); + vy1 = VGET_VX2(vyx2, 1); #if !defined(CONJ) vy0 = VFMACCVF_FLOAT(vy0, da_r, vx0, vl); @@ -120,7 +147,9 @@ int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT da_r, FLOAT da_i, vy1 = VFNMSACVF_FLOAT(vy1, da_r, vx1, vl); vy1 = VFMACCVF_FLOAT(vy1, da_i, vx0, vl); #endif - VSSEG_FLOAT(y, vy0, vy1, vl); + vyx2 = VSET_VX2(vyx2, 0, vy0); + vyx2 = VSET_VX2(vyx2, 1, vy1); + VSSEG_FLOAT(y, vyx2, vl); } } else { @@ -131,8 +160,13 @@ int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT da_r, FLOAT da_i, for (size_t vl; n > 0; n -= vl, x += vl*inc_x*2, y += vl*inc_y*2) { vl = VSETVL(n); - VLSSEG_FLOAT(&vx0, &vx1, x, stride_x, vl); - VLSSEG_FLOAT(&vy0, &vy1, y, stride_y, vl); + vxx2 = VLSSEG_FLOAT(x, stride_x, vl); + vyx2 = VLSSEG_FLOAT(y, stride_y, vl); + + vx0 = VGET_VX2(vxx2, 0); + vx1 = VGET_VX2(vxx2, 1); + vy0 = VGET_VX2(vyx2, 0); + vy1 = VGET_VX2(vyx2, 1); #if !defined(CONJ) vy0 = VFMACCVF_FLOAT(vy0, da_r, vx0, vl); @@ -145,7 +179,9 @@ int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT da_r, FLOAT da_i, vy1 = VFNMSACVF_FLOAT(vy1, da_r, vx1, vl); vy1 = VFMACCVF_FLOAT(vy1, da_i, vx0, vl); #endif - VSSSEG_FLOAT(y, stride_y, vy0, vy1, vl); + vyx2 = VSET_VX2(vyx2, 0, vy0); + vyx2 = VSET_VX2(vyx2, 1, vy1); + VSSSEG_FLOAT(y, stride_y, vyx2, vl); } } diff --git a/kernel/riscv64/zcopy_rvv.c b/kernel/riscv64/zcopy_rvv.c index bd94810ce..13879f03b 100644 --- a/kernel/riscv64/zcopy_rvv.c +++ b/kernel/riscv64/zcopy_rvv.c @@ -34,11 +34,11 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VSEV_FLOAT_M8 __riscv_vse32_v_f32m8 #define VSETVL_M4(n) __riscv_vsetvl_e32m4(n) -#define FLOAT_V_T_M4 vfloat32m4_t -#define VLSEG_FLOAT_M4 __riscv_vlseg2e32_v_f32m4 -#define VSSEG_FLOAT_M4 __riscv_vsseg2e32_v_f32m4 -#define VLSSEG_FLOAT_M4 __riscv_vlsseg2e32_v_f32m4 -#define VSSSEG_FLOAT_M4 __riscv_vssseg2e32_v_f32m4 +#define FLOAT_VX2_T_M4 vfloat32m4x2_t +#define VLSEG_FLOAT_M4 __riscv_vlseg2e32_v_f32m4x2 +#define VSSEG_FLOAT_M4 __riscv_vsseg2e32_v_f32m4x2 +#define VLSSEG_FLOAT_M4 __riscv_vlsseg2e32_v_f32m4x2 +#define VSSSEG_FLOAT_M4 __riscv_vssseg2e32_v_f32m4x2 #else #define VSETVL_M8(n) __riscv_vsetvl_e64m8(n) #define FLOAT_V_T_M8 vfloat64m8_t @@ -46,16 +46,16 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VSEV_FLOAT_M8 __riscv_vse64_v_f64m8 #define VSETVL_M4(n) __riscv_vsetvl_e64m4(n) -#define FLOAT_V_T_M4 vfloat64m4_t -#define VLSEG_FLOAT_M4 __riscv_vlseg2e64_v_f64m4 -#define VSSEG_FLOAT_M4 __riscv_vsseg2e64_v_f64m4 -#define VLSSEG_FLOAT_M4 __riscv_vlsseg2e64_v_f64m4 -#define VSSSEG_FLOAT_M4 __riscv_vssseg2e64_v_f64m4 +#define FLOAT_VX2_T_M4 vfloat64m4x2_t +#define VLSEG_FLOAT_M4 __riscv_vlseg2e64_v_f64m4x2 +#define VSSEG_FLOAT_M4 __riscv_vsseg2e64_v_f64m4x2 +#define VLSSEG_FLOAT_M4 __riscv_vlsseg2e64_v_f64m4x2 +#define VSSSEG_FLOAT_M4 __riscv_vssseg2e64_v_f64m4x2 #endif int CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y) { - if(n < 0) return(0); + if(n <= 0) return(0); if(inc_x == 1 && inc_y == 1) { @@ -70,34 +70,34 @@ int CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y) }else if (1 == inc_x) { - FLOAT_V_T_M4 vr, vi; + FLOAT_VX2_T_M4 vx2; BLASLONG stride_y = inc_y * 2 * sizeof(FLOAT); for(size_t vl; n > 0; n -= vl, x += vl*2, y += vl*inc_y*2) { vl = VSETVL_M4(n); - VLSEG_FLOAT_M4(&vr, &vi, x, vl); - VSSSEG_FLOAT_M4(y, stride_y, vr, vi, vl); + vx2 = VLSEG_FLOAT_M4(x, vl); + VSSSEG_FLOAT_M4(y, stride_y, vx2, vl); } } else if (1 == inc_y) { - FLOAT_V_T_M4 vr, vi; + FLOAT_VX2_T_M4 vx2; BLASLONG stride_x = inc_x * 2 * sizeof(FLOAT); for(size_t vl; n > 0; n -= vl, x += vl*inc_x*2, y += vl*2) { vl = VSETVL_M4(n); - VLSSEG_FLOAT_M4(&vr, &vi, x, stride_x, vl); - VSSEG_FLOAT_M4(y, vr, vi, vl); + vx2 = VLSSEG_FLOAT_M4(x, stride_x, vl); + VSSEG_FLOAT_M4(y, vx2, vl); } } else { - FLOAT_V_T_M4 vr, vi; + FLOAT_VX2_T_M4 vx2; BLASLONG stride_x = inc_x * 2 * sizeof(FLOAT); BLASLONG stride_y = inc_y * 2 * sizeof(FLOAT); for(size_t vl; n > 0; n -= vl, x += vl*inc_x*2, y += vl*inc_y*2) { vl = VSETVL_M4(n); - VLSSEG_FLOAT_M4(&vr, &vi, x, stride_x, vl); - VSSSEG_FLOAT_M4(y, stride_y, vr, vi, vl); + vx2 = VLSSEG_FLOAT_M4(x, stride_x, vl); + VSSSEG_FLOAT_M4(y, stride_y, vx2, vl); } } diff --git a/kernel/riscv64/zdot_rvv.c b/kernel/riscv64/zdot_rvv.c index fa0e89353..13bc2ee39 100644 --- a/kernel/riscv64/zdot_rvv.c +++ b/kernel/riscv64/zdot_rvv.c @@ -33,8 +33,10 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VSETVL_MAX_M1 __riscv_vsetvlmax_e32m1() #define FLOAT_V_T vfloat32m4_t #define FLOAT_V_T_M1 vfloat32m1_t -#define VLSEG_FLOAT __riscv_vlseg2e32_v_f32m4 -#define VLSSEG_FLOAT __riscv_vlsseg2e32_v_f32m4 +#define FLOAT_VX2_T vfloat32m4x2_t +#define VGET_VX2 __riscv_vget_v_f32m4x2_f32m4 +#define VLSEG_FLOAT __riscv_vlseg2e32_v_f32m4x2 +#define VLSSEG_FLOAT __riscv_vlsseg2e32_v_f32m4x2 #define VFREDSUM_FLOAT __riscv_vfredusum_vs_f32m4_f32m1 #define VFMACCVV_FLOAT_TU __riscv_vfmacc_vv_f32m4_tu #define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m4 @@ -49,8 +51,10 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VSETVL_MAX_M1 __riscv_vsetvlmax_e64m1() #define FLOAT_V_T vfloat64m4_t #define FLOAT_V_T_M1 vfloat64m1_t -#define VLSEG_FLOAT __riscv_vlseg2e64_v_f64m4 -#define VLSSEG_FLOAT __riscv_vlsseg2e64_v_f64m4 +#define FLOAT_VX2_T vfloat64m4x2_t +#define VGET_VX2 __riscv_vget_v_f64m4x2_f64m4 +#define VLSEG_FLOAT __riscv_vlseg2e64_v_f64m4x2 +#define VLSSEG_FLOAT __riscv_vlsseg2e64_v_f64m4x2 #define VFREDSUM_FLOAT __riscv_vfredusum_vs_f64m4_f64m1 #define VFMACCVV_FLOAT_TU __riscv_vfmacc_vv_f64m4_tu #define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m4 @@ -71,6 +75,7 @@ OPENBLAS_COMPLEX_FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLA FLOAT_V_T vr0, vr1, vx0, vx1, vy0, vy1; FLOAT_V_T_M1 v_res, v_z0; + FLOAT_VX2_T vxx2, vyx2; size_t vlmax_m1 = VSETVL_MAX_M1; v_z0 = VFMVVF_FLOAT_M1(0, vlmax_m1); @@ -83,8 +88,13 @@ OPENBLAS_COMPLEX_FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLA for (size_t vl; n > 0; n -= vl, x += vl*2, y += vl*2) { vl = VSETVL(n); - VLSEG_FLOAT(&vx0, &vx1, x, vl); - VLSEG_FLOAT(&vy0, &vy1, y, vl); + vxx2 = VLSEG_FLOAT(x, vl); + vyx2 = VLSEG_FLOAT(y, vl); + + vx0 = VGET_VX2(vxx2, 0); + vx1 = VGET_VX2(vxx2, 1); + vy0 = VGET_VX2(vyx2, 0); + vy1 = VGET_VX2(vyx2, 1); vr0 = VFMACCVV_FLOAT_TU(vr0, vx0, vy0, vl); vr1 = VFMACCVV_FLOAT_TU(vr1, vx0, vy1, vl); @@ -104,8 +114,13 @@ OPENBLAS_COMPLEX_FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLA for (size_t vl; n > 0; n -= vl, x += vl*2, y += vl*inc_y*2) { vl = VSETVL(n); - VLSEG_FLOAT(&vx0, &vx1, x, vl); - VLSSEG_FLOAT(&vy0, &vy1, y, stride_y, vl); + vxx2 = VLSEG_FLOAT(x, vl); + vyx2 = VLSSEG_FLOAT(y, stride_y, vl); + + vx0 = VGET_VX2(vxx2, 0); + vx1 = VGET_VX2(vxx2, 1); + vy0 = VGET_VX2(vyx2, 0); + vy1 = VGET_VX2(vyx2, 1); vr0 = VFMACCVV_FLOAT_TU(vr0, vx0, vy0, vl); vr1 = VFMACCVV_FLOAT_TU(vr1, vx0, vy1, vl); @@ -124,8 +139,13 @@ OPENBLAS_COMPLEX_FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLA for (size_t vl; n > 0; n -= vl, x += vl*inc_x*2, y += vl*2) { vl = VSETVL(n); - VLSSEG_FLOAT(&vx0, &vx1, x, stride_x, vl); - VLSEG_FLOAT(&vy0, &vy1, y, vl); + vxx2 = VLSSEG_FLOAT(x, stride_x, vl); + vyx2 = VLSEG_FLOAT(y, vl); + + vx0 = VGET_VX2(vxx2, 0); + vx1 = VGET_VX2(vxx2, 1); + vy0 = VGET_VX2(vyx2, 0); + vy1 = VGET_VX2(vyx2, 1); vr0 = VFMACCVV_FLOAT_TU(vr0, vx0, vy0, vl); vr1 = VFMACCVV_FLOAT_TU(vr1, vx0, vy1, vl); @@ -145,8 +165,13 @@ OPENBLAS_COMPLEX_FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLA for (size_t vl; n > 0; n -= vl, x += vl*inc_x*2, y += vl*inc_y*2) { vl = VSETVL(n); - VLSSEG_FLOAT(&vx0, &vx1, x, stride_x, vl); - VLSSEG_FLOAT(&vy0, &vy1, y, stride_y, vl); + vxx2 = VLSSEG_FLOAT(x, stride_x, vl); + vyx2 = VLSSEG_FLOAT(y, stride_y, vl); + + vx0 = VGET_VX2(vxx2, 0); + vx1 = VGET_VX2(vxx2, 1); + vy0 = VGET_VX2(vyx2, 0); + vy1 = VGET_VX2(vyx2, 1); vr0 = VFMACCVV_FLOAT_TU(vr0, vx0, vy0, vl); vr1 = VFMACCVV_FLOAT_TU(vr1, vx0, vy1, vl); diff --git a/kernel/riscv64/zgemm_beta_rvv.c b/kernel/riscv64/zgemm_beta_rvv.c index b94b5f4bf..ee334801b 100644 --- a/kernel/riscv64/zgemm_beta_rvv.c +++ b/kernel/riscv64/zgemm_beta_rvv.c @@ -41,8 +41,11 @@ #if !defined(DOUBLE) #define VSETVL(n) __riscv_vsetvl_e32m4(n) #define FLOAT_V_T vfloat32m4_t -#define VLSEG_FLOAT __riscv_vlseg2e32_v_f32m4 -#define VSSEG_FLOAT __riscv_vsseg2e32_v_f32m4 +#define FLOAT_VX2_T vfloat32m4x2_t +#define VGET_VX2 __riscv_vget_v_f32m4x2_f32m4 +#define VSET_VX2 __riscv_vset_v_f32m4_f32m4x2 +#define VLSEG_FLOAT __riscv_vlseg2e32_v_f32m4x2 +#define VSSEG_FLOAT __riscv_vsseg2e32_v_f32m4x2 #define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m4 #define VFMULVF_FLOAT __riscv_vfmul_vf_f32m4 #define VFADDVV_FLOAT __riscv_vfadd_vv_f32m4 @@ -50,8 +53,11 @@ #else #define VSETVL(n) __riscv_vsetvl_e64m4(n) #define FLOAT_V_T vfloat64m4_t -#define VLSEG_FLOAT __riscv_vlseg2e64_v_f64m4 -#define VSSEG_FLOAT __riscv_vsseg2e64_v_f64m4 +#define FLOAT_VX2_T vfloat64m4x2_t +#define VGET_VX2 __riscv_vget_v_f64m4x2_f64m4 +#define VSET_VX2 __riscv_vset_v_f64m4_f64m4x2 +#define VLSEG_FLOAT __riscv_vlseg2e64_v_f64m4x2 +#define VSSEG_FLOAT __riscv_vsseg2e64_v_f64m4x2 #define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m4 #define VFMULVF_FLOAT __riscv_vfmul_vf_f64m4 #define VFADDVV_FLOAT __riscv_vfadd_vv_f64m4 @@ -68,6 +74,7 @@ int CNAME(BLASLONG m, BLASLONG n, BLASLONG dummy1, FLOAT *c_offset; size_t vl; FLOAT_V_T vr, vi, v1, v2, v3, v4; + FLOAT_VX2_T vx2; ldc *= 2; c_offset = c; @@ -77,6 +84,8 @@ int CNAME(BLASLONG m, BLASLONG n, BLASLONG dummy1, vl = VSETVL(m); vr = VFMVVF_FLOAT(0.0, vl); vi = VFMVVF_FLOAT(0.0, vl); + vx2 = VSET_VX2(vx2, 0, vr); + vx2 = VSET_VX2(vx2, 1, vi); for( ; n > 0; n--, c += ldc) { c_offset = c; @@ -84,7 +93,7 @@ int CNAME(BLASLONG m, BLASLONG n, BLASLONG dummy1, for(chunk=m; chunk > 0; chunk -= vl, c_offset += vl*2) { vl = VSETVL(chunk); - VSSEG_FLOAT(c_offset, vr, vi, vl); + VSSEG_FLOAT(c_offset, vx2, vl); } } @@ -96,7 +105,9 @@ int CNAME(BLASLONG m, BLASLONG n, BLASLONG dummy1, for(chunk=m; chunk > 0; chunk -= vl, c_offset += vl*2) { vl = VSETVL(chunk); - VLSEG_FLOAT(&vr, &vi, c_offset, vl); + vx2 = VLSEG_FLOAT(c_offset, vl); + vr = VGET_VX2(vx2, 0); + vi = VGET_VX2(vx2, 1); v1 = VFMULVF_FLOAT(vr, beta_r, vl); v2 = VFMULVF_FLOAT(vi, beta_i, vl); @@ -107,7 +118,9 @@ int CNAME(BLASLONG m, BLASLONG n, BLASLONG dummy1, vr = VFSUBVV_FLOAT(v1, v2, vl); vi = VFADDVV_FLOAT(v3, v4, vl); - VSSEG_FLOAT(c_offset, vr, vi, vl); + vx2 = VSET_VX2(vx2, 0, vr); + vx2 = VSET_VX2(vx2, 1, vi); + VSSEG_FLOAT(c_offset, vx2, vl); } } diff --git a/kernel/riscv64/zgemm_ncopy_4_rvv.c b/kernel/riscv64/zgemm_ncopy_4_rvv.c index d50a4b8d5..dce98752e 100644 --- a/kernel/riscv64/zgemm_ncopy_4_rvv.c +++ b/kernel/riscv64/zgemm_ncopy_4_rvv.c @@ -29,18 +29,30 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #if !defined(DOUBLE) #define VSETVL(n) __riscv_vsetvl_e32m1(n) -#define FLOAT_V_T vfloat32m1_t -#define VLSEG2_FLOAT __riscv_vlseg2e32_v_f32m1 -#define VSSEG2_FLOAT __riscv_vsseg2e32_v_f32m1 -#define VSSEG4_FLOAT __riscv_vsseg4e32_v_f32m1 -#define VSSEG8_FLOAT __riscv_vsseg8e32_v_f32m1 +#define FLOAT_VX2_T vfloat32m1x2_t +#define FLOAT_VX4_T vfloat32m1x4_t +#define FLOAT_VX8_T vfloat32m1x8_t +#define VGET_VX2 __riscv_vget_v_f32m1x2_f32m1 +#define VSET_VX2 __riscv_vset_v_f32m1_f32m1x2 +#define VSET_VX4 __riscv_vset_v_f32m1_f32m1x4 +#define VSET_VX8 __riscv_vset_v_f32m1_f32m1x8 +#define VLSEG2_FLOAT __riscv_vlseg2e32_v_f32m1x2 +#define VSSEG2_FLOAT __riscv_vsseg2e32_v_f32m1x2 +#define VSSEG4_FLOAT __riscv_vsseg4e32_v_f32m1x4 +#define VSSEG8_FLOAT __riscv_vsseg8e32_v_f32m1x8 #else #define VSETVL(n) __riscv_vsetvl_e64m1(n) -#define FLOAT_V_T vfloat64m1_t -#define VLSEG2_FLOAT __riscv_vlseg2e64_v_f64m1 -#define VSSEG2_FLOAT __riscv_vsseg2e64_v_f64m1 -#define VSSEG4_FLOAT __riscv_vsseg4e64_v_f64m1 -#define VSSEG8_FLOAT __riscv_vsseg8e64_v_f64m1 +#define FLOAT_VX2_T vfloat64m1x2_t +#define FLOAT_VX4_T vfloat64m1x4_t +#define FLOAT_VX8_T vfloat64m1x8_t +#define VGET_VX2 __riscv_vget_v_f64m1x2_f64m1 +#define VSET_VX2 __riscv_vset_v_f64m1_f64m1x2 +#define VSET_VX4 __riscv_vset_v_f64m1_f64m1x4 +#define VSET_VX8 __riscv_vset_v_f64m1_f64m1x8 +#define VLSEG2_FLOAT __riscv_vlseg2e64_v_f64m1x2 +#define VSSEG2_FLOAT __riscv_vsseg2e64_v_f64m1x2 +#define VSSEG4_FLOAT __riscv_vsseg4e64_v_f64m1x4 +#define VSSEG8_FLOAT __riscv_vsseg8e64_v_f64m1x8 #endif // Optimizes the implementation in ../generic/zgemm_ncopy_4.c @@ -53,7 +65,9 @@ int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, FLOAT *b){ FLOAT *boffset; - FLOAT_V_T v11, v12, v21, v22, v31, v32, v41, v42; + FLOAT_VX2_T v1x2, v2x2, v3x2, v4x2; + FLOAT_VX4_T vxx4; + FLOAT_VX8_T vxx8; size_t vl; aoffset = a; @@ -69,12 +83,21 @@ int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, FLOAT *b){ for (i = m; i > 0; i -= vl) { vl = VSETVL(i); - VLSEG2_FLOAT(&v11, &v12, aoffset1, vl); - VLSEG2_FLOAT(&v21, &v22, aoffset2, vl); - VLSEG2_FLOAT(&v31, &v32, aoffset3, vl); - VLSEG2_FLOAT(&v41, &v42, aoffset4, vl); - - VSSEG8_FLOAT(boffset, v11, v12, v21, v22, v31, v32, v41, v42, vl); + v1x2 = VLSEG2_FLOAT(aoffset1, vl); + v2x2 = VLSEG2_FLOAT(aoffset2, vl); + v3x2 = VLSEG2_FLOAT(aoffset3, vl); + v4x2 = VLSEG2_FLOAT(aoffset4, vl); + + vxx8 = VSET_VX8(vxx8, 0, VGET_VX2(v1x2, 0)); + vxx8 = VSET_VX8(vxx8, 1, VGET_VX2(v1x2, 1)); + vxx8 = VSET_VX8(vxx8, 2, VGET_VX2(v2x2, 0)); + vxx8 = VSET_VX8(vxx8, 3, VGET_VX2(v2x2, 1)); + vxx8 = VSET_VX8(vxx8, 4, VGET_VX2(v3x2, 0)); + vxx8 = VSET_VX8(vxx8, 5, VGET_VX2(v3x2, 1)); + vxx8 = VSET_VX8(vxx8, 6, VGET_VX2(v4x2, 0)); + vxx8 = VSET_VX8(vxx8, 7, VGET_VX2(v4x2, 1)); + + VSSEG8_FLOAT(boffset, vxx8, vl); aoffset1 += vl * 2; aoffset2 += vl * 2; @@ -91,10 +114,15 @@ int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, FLOAT *b){ for (i = m; i > 0; i -= vl) { vl = VSETVL(i); - VLSEG2_FLOAT(&v11, &v12, aoffset1, vl); - VLSEG2_FLOAT(&v21, &v22, aoffset2, vl); + v1x2 = VLSEG2_FLOAT(aoffset1, vl); + v2x2 = VLSEG2_FLOAT(aoffset2, vl); + + vxx4 = VSET_VX4(vxx4, 0, VGET_VX2(v1x2, 0)); + vxx4 = VSET_VX4(vxx4, 1, VGET_VX2(v1x2, 1)); + vxx4 = VSET_VX4(vxx4, 2, VGET_VX2(v2x2, 0)); + vxx4 = VSET_VX4(vxx4, 3, VGET_VX2(v2x2, 1)); - VSSEG4_FLOAT(boffset, v11, v12, v21, v22, vl); + VSSEG4_FLOAT(boffset, vxx4, vl); aoffset1 += vl * 2; aoffset2 += vl * 2; @@ -108,9 +136,9 @@ int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, FLOAT *b){ for (i = m; i > 0; i -= vl) { vl = VSETVL(i); - VLSEG2_FLOAT(&v11, &v12, aoffset1, vl); + v1x2 = VLSEG2_FLOAT(aoffset1, vl); - VSSEG2_FLOAT(boffset, v11, v12, vl); + VSSEG2_FLOAT(boffset, v1x2, vl); aoffset1 += vl * 2; boffset += vl * 2; diff --git a/kernel/riscv64/zgemm_ncopy_rvv_v1.c b/kernel/riscv64/zgemm_ncopy_rvv_v1.c index 1d3b8d3b7..275daa5f2 100644 --- a/kernel/riscv64/zgemm_ncopy_rvv_v1.c +++ b/kernel/riscv64/zgemm_ncopy_rvv_v1.c @@ -30,14 +30,14 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #if !defined(DOUBLE) #define VSETVL(n) __riscv_vsetvl_e32m2(n) -#define FLOAT_V_T vfloat32m2_t -#define VLSSEG2_FLOAT __riscv_vlsseg2e32_v_f32m2 -#define VSSEG2_FLOAT __riscv_vsseg2e32_v_f32m2 +#define FLOAT_VX2_T vfloat32m2x2_t +#define VLSSEG2_FLOAT __riscv_vlsseg2e32_v_f32m2x2 +#define VSSEG2_FLOAT __riscv_vsseg2e32_v_f32m2x2 #else #define VSETVL(n) __riscv_vsetvl_e64m2(n) -#define FLOAT_V_T vfloat64m2_t -#define VLSSEG2_FLOAT __riscv_vlsseg2e64_v_f64m2 -#define VSSEG2_FLOAT __riscv_vsseg2e64_v_f64m2 +#define FLOAT_VX2_T vfloat64m2x2_t +#define VLSSEG2_FLOAT __riscv_vlsseg2e64_v_f64m2x2 +#define VSSEG2_FLOAT __riscv_vsseg2e64_v_f64m2x2 #endif int CNAME(BLASLONG m, BLASLONG n, IFLOAT *a, BLASLONG lda, IFLOAT *b){ @@ -48,7 +48,7 @@ int CNAME(BLASLONG m, BLASLONG n, IFLOAT *a, BLASLONG lda, IFLOAT *b){ FLOAT *a_offset1; FLOAT *b_offset; - FLOAT_V_T v0, v1; + FLOAT_VX2_T vx2; size_t vl; //fprintf(stderr, "%s, m=%ld n=%ld lda=%ld\n", __FUNCTION__, m, n, lda); @@ -62,8 +62,8 @@ int CNAME(BLASLONG m, BLASLONG n, IFLOAT *a, BLASLONG lda, IFLOAT *b){ a_offset += vl * lda * 2; for(i = m; i > 0; i--) { - VLSSEG2_FLOAT(&v0, &v1, a_offset1, lda * sizeof(FLOAT) * 2, vl); - VSSEG2_FLOAT(b_offset, v0, v1, vl); + vx2 = VLSSEG2_FLOAT(a_offset1, lda * sizeof(FLOAT) * 2, vl); + VSSEG2_FLOAT(b_offset, vx2, vl); a_offset1 += 2; b_offset += vl * 2; diff --git a/kernel/riscv64/zgemm_tcopy_4_rvv.c b/kernel/riscv64/zgemm_tcopy_4_rvv.c index 8c35b5616..cfafbf0dc 100644 --- a/kernel/riscv64/zgemm_tcopy_4_rvv.c +++ b/kernel/riscv64/zgemm_tcopy_4_rvv.c @@ -30,25 +30,31 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #if !defined(DOUBLE) #define VSETVL(n) __riscv_vsetvl_e32m1(n) #define FLOAT_V_T vfloat32m1_t +#define FLOAT_VX2_T vfloat32m1x2_t +#define FLOAT_VX4_T vfloat32m1x4_t +#define FLOAT_VX8_T vfloat32m1x8_t #define VLEV_FLOAT __riscv_vle32_v_f32m1 #define VSEV_FLOAT __riscv_vse32_v_f32m1 -#define VLSSEG2_FLOAT __riscv_vlsseg2e32_v_f32m1 -#define VLSSEG4_FLOAT __riscv_vlsseg4e32_v_f32m1 -#define VLSSEG8_FLOAT __riscv_vlsseg8e32_v_f32m1 -#define VSSEG2_FLOAT __riscv_vsseg2e32_v_f32m1 -#define VSSEG4_FLOAT __riscv_vsseg4e32_v_f32m1 -#define VSSEG8_FLOAT __riscv_vsseg8e32_v_f32m1 +#define VLSSEG2_FLOAT __riscv_vlsseg2e32_v_f32m1x2 +#define VLSSEG4_FLOAT __riscv_vlsseg4e32_v_f32m1x4 +#define VLSSEG8_FLOAT __riscv_vlsseg8e32_v_f32m1x8 +#define VSSEG2_FLOAT __riscv_vsseg2e32_v_f32m1x2 +#define VSSEG4_FLOAT __riscv_vsseg4e32_v_f32m1x4 +#define VSSEG8_FLOAT __riscv_vsseg8e32_v_f32m1x8 #else #define VSETVL(n) __riscv_vsetvl_e64m1(n) #define FLOAT_V_T vfloat64m1_t +#define FLOAT_VX2_T vfloat64m1x2_t +#define FLOAT_VX4_T vfloat64m1x4_t +#define FLOAT_VX8_T vfloat64m1x8_t #define VLEV_FLOAT __riscv_vle64_v_f64m1 #define VSEV_FLOAT __riscv_vse64_v_f64m1 -#define VLSSEG2_FLOAT __riscv_vlsseg2e64_v_f64m1 -#define VLSSEG4_FLOAT __riscv_vlsseg4e64_v_f64m1 -#define VLSSEG8_FLOAT __riscv_vlsseg8e64_v_f64m1 -#define VSSEG2_FLOAT __riscv_vsseg2e64_v_f64m1 -#define VSSEG4_FLOAT __riscv_vsseg4e64_v_f64m1 -#define VSSEG8_FLOAT __riscv_vsseg8e64_v_f64m1 +#define VLSSEG2_FLOAT __riscv_vlsseg2e64_v_f64m1x2 +#define VLSSEG4_FLOAT __riscv_vlsseg4e64_v_f64m1x4 +#define VLSSEG8_FLOAT __riscv_vlsseg8e64_v_f64m1x8 +#define VSSEG2_FLOAT __riscv_vsseg2e64_v_f64m1x2 +#define VSSEG4_FLOAT __riscv_vsseg4e64_v_f64m1x4 +#define VSSEG8_FLOAT __riscv_vsseg8e64_v_f64m1x8 #endif int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, FLOAT *b){ @@ -60,7 +66,11 @@ int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, FLOAT *b){ IFLOAT *boffset, *boffset1, *boffset2, *boffset3; - FLOAT_V_T v0, v1, v2, v3, v4, v5, v6, v7; + FLOAT_V_T v0; + FLOAT_VX2_T vx2; + FLOAT_VX4_T vx4; + FLOAT_VX8_T vx8; + size_t vl; //fprintf(stderr, "%s m=%ld n=%ld lda=%ld\n", __FUNCTION__, m, n, lda); @@ -81,8 +91,8 @@ int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, FLOAT *b){ for(i = (n >> 2); i > 0; i--) { vl = 4; - VLSSEG8_FLOAT(&v0, &v1, &v2, &v3, &v4, &v5, &v6, &v7, aoffset1, lda * sizeof(FLOAT) * 2, vl); - VSSEG8_FLOAT(boffset1, v0, v1, v2, v3, v4, v5, v6, v7, vl); + vx8 = VLSSEG8_FLOAT(aoffset1, lda * sizeof(FLOAT) * 2, vl); + VSSEG8_FLOAT(boffset1, vx8, vl); aoffset1 += 8; boffset1 += m * 8; @@ -91,8 +101,8 @@ int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, FLOAT *b){ if (n & 2) { vl = 4; - VLSSEG4_FLOAT(&v0, &v1, &v2, &v3, aoffset1, lda * sizeof(FLOAT) * 2, vl); - VSSEG4_FLOAT(boffset2, v0, v1, v2, v3, vl); + vx4 = VLSSEG4_FLOAT(aoffset1, lda * sizeof(FLOAT) * 2, vl); + VSSEG4_FLOAT(boffset2, vx4, vl); aoffset1 += 4; boffset2 += 16; @@ -101,8 +111,8 @@ int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, FLOAT *b){ if (n & 1) { vl = 4; - VLSSEG2_FLOAT(&v0, &v1, aoffset1, lda * sizeof(FLOAT) * 2, vl); - VSSEG2_FLOAT(boffset3, v0, v1, vl); + vx2 = VLSSEG2_FLOAT(aoffset1, lda * sizeof(FLOAT) * 2, vl); + VSSEG2_FLOAT(boffset3, vx2, vl); aoffset1 += 2; boffset3 += 8; @@ -119,8 +129,8 @@ int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, FLOAT *b){ for(i = (n >> 2); i > 0; i--) { vl = 2; - VLSSEG8_FLOAT(&v0, &v1, &v2, &v3, &v4, &v5, &v6, &v7, aoffset1, lda * sizeof(FLOAT) * 2, vl); - VSSEG8_FLOAT(boffset1, v0, v1, v2, v3, v4, v5, v6, v7, vl); + vx8 = VLSSEG8_FLOAT(aoffset1, lda * sizeof(FLOAT) * 2, vl); + VSSEG8_FLOAT(boffset1, vx8, vl); aoffset1 += 8; boffset1 += m * 8; @@ -129,8 +139,8 @@ int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, FLOAT *b){ if (n & 2) { vl = 2; - VLSSEG4_FLOAT(&v0, &v1, &v2, &v3, aoffset1, lda * sizeof(FLOAT) * 2, vl); - VSSEG4_FLOAT(boffset2, v0, v1, v2, v3, vl); + vx4 = VLSSEG4_FLOAT(aoffset1, lda * sizeof(FLOAT) * 2, vl); + VSSEG4_FLOAT(boffset2, vx4, vl); aoffset1 += 4; boffset2 += 8; @@ -139,8 +149,8 @@ int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, FLOAT *b){ if (n & 1) { vl = 2; - VLSSEG2_FLOAT(&v0, &v1, aoffset1, lda * sizeof(FLOAT) * 2, vl); - VSSEG2_FLOAT(boffset3, v0, v1, vl); + vx2 = VLSSEG2_FLOAT(aoffset1, lda * sizeof(FLOAT) * 2, vl); + VSSEG2_FLOAT(boffset3, vx2, vl); //aoffset1 += 2; boffset3 += 4; diff --git a/kernel/riscv64/zgemm_tcopy_rvv_v1.c b/kernel/riscv64/zgemm_tcopy_rvv_v1.c index 7a085269c..96e986502 100644 --- a/kernel/riscv64/zgemm_tcopy_rvv_v1.c +++ b/kernel/riscv64/zgemm_tcopy_rvv_v1.c @@ -29,14 +29,14 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #if !defined(DOUBLE) #define VSETVL(n) __riscv_vsetvl_e32m2(n) -#define FLOAT_V_T vfloat32m2_t -#define VLSEG2_FLOAT __riscv_vlseg2e32_v_f32m2 -#define VSSEG2_FLOAT __riscv_vsseg2e32_v_f32m2 +#define FLOAT_VX2_T vfloat32m2x2_t +#define VLSEG2_FLOAT __riscv_vlseg2e32_v_f32m2x2 +#define VSSEG2_FLOAT __riscv_vsseg2e32_v_f32m2x2 #else #define VSETVL(n) __riscv_vsetvl_e64m2(n) -#define FLOAT_V_T vfloat64m2_t -#define VLSEG2_FLOAT __riscv_vlseg2e64_v_f64m2 -#define VSSEG2_FLOAT __riscv_vsseg2e64_v_f64m2 +#define FLOAT_VX2_T vfloat64m2x2_t +#define VLSEG2_FLOAT __riscv_vlseg2e64_v_f64m2x2 +#define VSSEG2_FLOAT __riscv_vsseg2e64_v_f64m2x2 #endif int CNAME(BLASLONG m, BLASLONG n, IFLOAT *a, BLASLONG lda, IFLOAT *b) @@ -47,7 +47,7 @@ int CNAME(BLASLONG m, BLASLONG n, IFLOAT *a, BLASLONG lda, IFLOAT *b) IFLOAT *aoffset1; IFLOAT *boffset; - FLOAT_V_T v0, v1; + FLOAT_VX2_T vx2; size_t vl; //fprintf(stderr, "%s, m=%ld n=%ld lda=%ld\n", __FUNCTION__, m, n, lda); @@ -62,8 +62,8 @@ int CNAME(BLASLONG m, BLASLONG n, IFLOAT *a, BLASLONG lda, IFLOAT *b) aoffset += vl * 2; for(i = m; i > 0; i--) { - VLSEG2_FLOAT(&v0, &v1, aoffset1, vl); - VSSEG2_FLOAT(boffset, v0, v1, vl); + vx2 = VLSEG2_FLOAT(aoffset1, vl); + VSSEG2_FLOAT(boffset, vx2, vl); aoffset1 += lda * 2; boffset += vl * 2; diff --git a/kernel/riscv64/zgemmkernel_rvv_v1x4.c b/kernel/riscv64/zgemmkernel_rvv_v1x4.c index 41399cf79..77e012ff5 100644 --- a/kernel/riscv64/zgemmkernel_rvv_v1x4.c +++ b/kernel/riscv64/zgemmkernel_rvv_v1x4.c @@ -30,20 +30,26 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #if !defined(DOUBLE) #define VSETVL(n) __riscv_vsetvl_e32m2(n) #define FLOAT_V_T vfloat32m2_t +#define FLOAT_VX2_T vfloat32m2x2_t +#define VGET_VX2 __riscv_vget_v_f32m2x2_f32m2 +#define VSET_VX2 __riscv_vset_v_f32m2_f32m2x2 #define VLEV_FLOAT __riscv_vle32_v_f32m2 #define VSEV_FLOAT __riscv_vse32_v_f32m2 -#define VLSEG2_FLOAT __riscv_vlseg2e32_v_f32m2 -#define VSSEG2_FLOAT __riscv_vsseg2e32_v_f32m2 +#define VLSEG2_FLOAT __riscv_vlseg2e32_v_f32m2x2 +#define VSSEG2_FLOAT __riscv_vsseg2e32_v_f32m2x2 #define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m2 #define VFMACCVF_FLOAT __riscv_vfmacc_vf_f32m2 #define VFNMSACVF_FLOAT __riscv_vfnmsac_vf_f32m2 #else #define VSETVL(n) __riscv_vsetvl_e64m2(n) #define FLOAT_V_T vfloat64m2_t +#define FLOAT_VX2_T vfloat64m2x2_t +#define VGET_VX2 __riscv_vget_v_f64m2x2_f64m2 +#define VSET_VX2 __riscv_vset_v_f64m2_f64m2x2 #define VLEV_FLOAT __riscv_vle64_v_f64m2 #define VSEV_FLOAT __riscv_vse64_v_f64m2 -#define VLSEG2_FLOAT __riscv_vlseg2e64_v_f64m2 -#define VSSEG2_FLOAT __riscv_vsseg2e64_v_f64m2 +#define VLSEG2_FLOAT __riscv_vlseg2e64_v_f64m2x2 +#define VSSEG2_FLOAT __riscv_vsseg2e64_v_f64m2x2 #define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m2 #define VFMACCVF_FLOAT __riscv_vfmacc_vf_f64m2 #define VFNMSACVF_FLOAT __riscv_vfnmsac_vf_f64m2 @@ -80,6 +86,7 @@ int CNAME(BLASLONG bm,BLASLONG bn,BLASLONG bk,FLOAT alphar,FLOAT alphai,FLOAT* b BLASLONG i,j,k; FLOAT *C0, *C1, *C2, *C3, *ptrba,*ptrbb; + FLOAT_VX2_T vax2; FLOAT_V_T va0, va1, va2, va3, va4, va5, va6, va7; FLOAT_V_T vres0, vres1, vres2, vres3, vres4, vres5, vres6, vres7; @@ -109,10 +116,14 @@ int CNAME(BLASLONG bm,BLASLONG bn,BLASLONG bk,FLOAT alphar,FLOAT alphai,FLOAT* b for (k = bk/4; k > 0; k--) { - VLSEG2_FLOAT(&va0, &va1, ptrba, vl); + vax2 = VLSEG2_FLOAT(ptrba, vl); + va0 = VGET_VX2(vax2, 0); + va1 = VGET_VX2(vax2, 1); ptrba += vl*2; - VLSEG2_FLOAT(&va2, &va3, ptrba, vl); + vax2 = VLSEG2_FLOAT(ptrba, vl); + va2 = VGET_VX2(vax2, 0); + va3 = VGET_VX2(vax2, 1); ptrba += vl*2; vres0 = OP_rr(vres0, *(ptrbb + 0), va0, vl); @@ -137,7 +148,9 @@ int CNAME(BLASLONG bm,BLASLONG bn,BLASLONG bk,FLOAT alphar,FLOAT alphai,FLOAT* b ptrbb += 8; - VLSEG2_FLOAT(&va4, &va5, ptrba, vl); + vax2 = VLSEG2_FLOAT(ptrba, vl); + va4 = VGET_VX2(vax2, 0); + va5 = VGET_VX2(vax2, 1); ptrba += vl*2; vres0 = OP_rr(vres0, *(ptrbb + 0), va2, vl); @@ -162,7 +175,9 @@ int CNAME(BLASLONG bm,BLASLONG bn,BLASLONG bk,FLOAT alphar,FLOAT alphai,FLOAT* b ptrbb += 8; - VLSEG2_FLOAT(&va6, &va7, ptrba, vl); + vax2 = VLSEG2_FLOAT(ptrba, vl); + va6 = VGET_VX2(vax2, 0); + va7 = VGET_VX2(vax2, 1); ptrba += vl*2; vres0 = OP_rr(vres0, *(ptrbb + 0), va4, vl); @@ -211,7 +226,9 @@ int CNAME(BLASLONG bm,BLASLONG bn,BLASLONG bk,FLOAT alphar,FLOAT alphai,FLOAT* b for (k = (bk & 3); k > 0; k--) { - VLSEG2_FLOAT(&va0, &va1, ptrba, vl); + vax2 = VLSEG2_FLOAT(ptrba, vl); + va0 = VGET_VX2(vax2, 0); + va1 = VGET_VX2(vax2, 1); ptrba += vl*2; vres0 = OP_rr(vres0, *(ptrbb + 0), va0, vl); @@ -237,35 +254,57 @@ int CNAME(BLASLONG bm,BLASLONG bn,BLASLONG bk,FLOAT alphar,FLOAT alphai,FLOAT* b ptrbb += 8; } - VLSEG2_FLOAT(&va0, &va1, C0, vl); - VLSEG2_FLOAT(&va2, &va3, C1, vl); + vax2 = VLSEG2_FLOAT(C0, vl); + va0 = VGET_VX2(vax2, 0); + va1 = VGET_VX2(vax2, 1); + + vax2 = VLSEG2_FLOAT(C1, vl); + va2 = VGET_VX2(vax2, 0); + va3 = VGET_VX2(vax2, 1); va0 = VFMACCVF_FLOAT(va0, alphar, vres0, vl); va1 = VFMACCVF_FLOAT(va1, alphar, vres1, vl); va0 = VFNMSACVF_FLOAT(va0, alphai, vres1, vl); va1 = VFMACCVF_FLOAT(va1, alphai, vres0, vl); - VSSEG2_FLOAT(C0, va0, va1, vl); + + vax2 = VSET_VX2(vax2, 0, va0); + vax2 = VSET_VX2(vax2, 1, va1); + VSSEG2_FLOAT(C0, vax2, vl); va2 = VFMACCVF_FLOAT(va2, alphar, vres2, vl); va3 = VFMACCVF_FLOAT(va3, alphar, vres3, vl); va2 = VFNMSACVF_FLOAT(va2, alphai, vres3, vl); va3 = VFMACCVF_FLOAT(va3, alphai, vres2, vl); - VSSEG2_FLOAT(C1, va2, va3, vl); - VLSEG2_FLOAT(&va0, &va1, C2, vl); - VLSEG2_FLOAT(&va2, &va3, C3, vl); + vax2 = VSET_VX2(vax2, 0, va2); + vax2 = VSET_VX2(vax2, 1, va3); + VSSEG2_FLOAT(C1, vax2, vl); + + vax2 = VLSEG2_FLOAT(C2, vl); + va0 = VGET_VX2(vax2, 0); + va1 = VGET_VX2(vax2, 1); + + vax2 = VLSEG2_FLOAT(C3, vl); + va2 = VGET_VX2(vax2, 0); + va3 = VGET_VX2(vax2, 1); va0 = VFMACCVF_FLOAT(va0, alphar, vres4, vl); va1 = VFMACCVF_FLOAT(va1, alphar, vres5, vl); va0 = VFNMSACVF_FLOAT(va0, alphai, vres5, vl); va1 = VFMACCVF_FLOAT(va1, alphai, vres4, vl); - VSSEG2_FLOAT(C2, va0, va1, vl); + + vax2 = VSET_VX2(vax2, 0, va0); + vax2 = VSET_VX2(vax2, 1, va1); + VSSEG2_FLOAT(C2, vax2, vl); va2 = VFMACCVF_FLOAT(va2, alphar, vres6, vl); va3 = VFMACCVF_FLOAT(va3, alphar, vres7, vl); va2 = VFNMSACVF_FLOAT(va2, alphai, vres7, vl); va3 = VFMACCVF_FLOAT(va3, alphai, vres6, vl); - VSSEG2_FLOAT(C3, va2, va3, vl); + + vax2 = VSET_VX2(vax2, 0, va2); + vax2 = VSET_VX2(vax2, 1, va3); + VSSEG2_FLOAT(C3, vax2, vl); C0 += vl * 2; C1 += vl * 2; @@ -294,9 +333,14 @@ int CNAME(BLASLONG bm,BLASLONG bn,BLASLONG bk,FLOAT alphar,FLOAT alphai,FLOAT* b for (k = bk/4; k > 0; k--) { - VLSEG2_FLOAT(&va0, &va1, ptrba, vl); + vax2 = VLSEG2_FLOAT(ptrba, vl); + va0 = VGET_VX2(vax2, 0); + va1 = VGET_VX2(vax2, 1); ptrba += vl*2; - VLSEG2_FLOAT(&va2, &va3, ptrba, vl); + + vax2 = VLSEG2_FLOAT(ptrba, vl); + va2 = VGET_VX2(vax2, 0); + va3 = VGET_VX2(vax2, 1); ptrba += vl*2; vres0 = OP_rr(vres0, *(ptrbb + 0), va0, vl); @@ -311,7 +355,9 @@ int CNAME(BLASLONG bm,BLASLONG bn,BLASLONG bk,FLOAT alphar,FLOAT alphai,FLOAT* b ptrbb += 4; - VLSEG2_FLOAT(&va4, &va5, ptrba, vl); + vax2 = VLSEG2_FLOAT(ptrba, vl); + va4 = VGET_VX2(vax2, 0); + va5 = VGET_VX2(vax2, 1); ptrba += vl*2; vres0 = OP_rr(vres0, *(ptrbb + 0), va2, vl); @@ -326,7 +372,9 @@ int CNAME(BLASLONG bm,BLASLONG bn,BLASLONG bk,FLOAT alphar,FLOAT alphai,FLOAT* b ptrbb += 4; - VLSEG2_FLOAT(&va6, &va7, ptrba, vl); + vax2 = VLSEG2_FLOAT(ptrba, vl); + va6 = VGET_VX2(vax2, 0); + va7 = VGET_VX2(vax2, 1); ptrba += vl*2; vres0 = OP_rr(vres0, *(ptrbb + 0), va4, vl); @@ -356,7 +404,9 @@ int CNAME(BLASLONG bm,BLASLONG bn,BLASLONG bk,FLOAT alphar,FLOAT alphai,FLOAT* b for (k = (bk & 3); k > 0; k--) { - VLSEG2_FLOAT(&va0, &va1, ptrba, vl); + vax2 = VLSEG2_FLOAT(ptrba, vl); + va0 = VGET_VX2(vax2, 0); + va1 = VGET_VX2(vax2, 1); ptrba += vl*2; vres0 = OP_rr(vres0, *(ptrbb + 0), va0, vl); @@ -372,20 +422,31 @@ int CNAME(BLASLONG bm,BLASLONG bn,BLASLONG bk,FLOAT alphar,FLOAT alphai,FLOAT* b ptrbb += 4; } - VLSEG2_FLOAT(&va0, &va1, C0, vl); - VLSEG2_FLOAT(&va2, &va3, C1, vl); + vax2 = VLSEG2_FLOAT(C0, vl); + va0 = VGET_VX2(vax2, 0); + va1 = VGET_VX2(vax2, 1); + + vax2 = VLSEG2_FLOAT(C1, vl); + va2 = VGET_VX2(vax2, 0); + va3 = VGET_VX2(vax2, 1); va0 = VFMACCVF_FLOAT(va0, alphar, vres0, vl); va1 = VFMACCVF_FLOAT(va1, alphar, vres1, vl); va0 = VFNMSACVF_FLOAT(va0, alphai, vres1, vl); va1 = VFMACCVF_FLOAT(va1, alphai, vres0, vl); - VSSEG2_FLOAT(C0, va0, va1, vl); + + vax2 = VSET_VX2(vax2, 0, va0); + vax2 = VSET_VX2(vax2, 1, va1); + VSSEG2_FLOAT(C0, vax2, vl); va2 = VFMACCVF_FLOAT(va2, alphar, vres2, vl); va3 = VFMACCVF_FLOAT(va3, alphar, vres3, vl); va2 = VFNMSACVF_FLOAT(va2, alphai, vres3, vl); va3 = VFMACCVF_FLOAT(va3, alphai, vres2, vl); - VSSEG2_FLOAT(C1, va2, va3, vl); + + vax2 = VSET_VX2(vax2, 0, va2); + vax2 = VSET_VX2(vax2, 1, va3); + VSSEG2_FLOAT(C1, vax2, vl); C0 += vl * 2; C1 += vl * 2; @@ -409,9 +470,14 @@ int CNAME(BLASLONG bm,BLASLONG bn,BLASLONG bk,FLOAT alphar,FLOAT alphai,FLOAT* b for (k = bk/4; k > 0; k--) { - VLSEG2_FLOAT(&va0, &va1, ptrba, vl); + vax2 = VLSEG2_FLOAT(ptrba, vl); + va0 = VGET_VX2(vax2, 0); + va1 = VGET_VX2(vax2, 1); ptrba += vl*2; - VLSEG2_FLOAT(&va2, &va3, ptrba, vl); + + vax2 = VLSEG2_FLOAT(ptrba, vl); + va2 = VGET_VX2(vax2, 0); + va3 = VGET_VX2(vax2, 1); ptrba += vl*2; vres0 = OP_rr(vres0, *(ptrbb + 0), va0, vl); @@ -420,7 +486,9 @@ int CNAME(BLASLONG bm,BLASLONG bn,BLASLONG bk,FLOAT alphar,FLOAT alphai,FLOAT* b vres1 = OP_ri(vres1, *(ptrbb + 1), va0, vl); ptrbb += 2; - VLSEG2_FLOAT(&va4, &va5, ptrba, vl); + vax2 = VLSEG2_FLOAT(ptrba, vl); + va4 = VGET_VX2(vax2, 0); + va5 = VGET_VX2(vax2, 1); ptrba += vl*2; vres0 = OP_rr(vres0, *(ptrbb + 0), va2, vl); @@ -430,7 +498,9 @@ int CNAME(BLASLONG bm,BLASLONG bn,BLASLONG bk,FLOAT alphar,FLOAT alphai,FLOAT* b ptrbb += 2; - VLSEG2_FLOAT(&va6, &va7, ptrba, vl); + vax2 = VLSEG2_FLOAT(ptrba, vl); + va6 = VGET_VX2(vax2, 0); + va7 = VGET_VX2(vax2, 1); ptrba += vl*2; vres0 = OP_rr(vres0, *(ptrbb + 0), va4, vl); @@ -448,7 +518,9 @@ int CNAME(BLASLONG bm,BLASLONG bn,BLASLONG bk,FLOAT alphar,FLOAT alphai,FLOAT* b for (k = (bk & 3); k > 0; k--) { - VLSEG2_FLOAT(&va0, &va1, ptrba, vl); + vax2 = VLSEG2_FLOAT(ptrba, vl); + va0 = VGET_VX2(vax2, 0); + va1 = VGET_VX2(vax2, 1); ptrba += vl*2; vres0 = OP_rr(vres0, *(ptrbb + 0), va0, vl); @@ -458,12 +530,18 @@ int CNAME(BLASLONG bm,BLASLONG bn,BLASLONG bk,FLOAT alphar,FLOAT alphai,FLOAT* b ptrbb += 2; } - VLSEG2_FLOAT(&va0, &va1, C0, vl); + vax2 = VLSEG2_FLOAT(C0, vl); + va0 = VGET_VX2(vax2, 0); + va1 = VGET_VX2(vax2, 1); + va0 = VFMACCVF_FLOAT(va0, alphar, vres0, vl); va1 = VFMACCVF_FLOAT(va1, alphar, vres1, vl); va0 = VFNMSACVF_FLOAT(va0, alphai, vres1, vl); va1 = VFMACCVF_FLOAT(va1, alphai, vres0, vl); - VSSEG2_FLOAT(C0, va0, va1, vl); + + vax2 = VSET_VX2(vax2, 0, va0); + vax2 = VSET_VX2(vax2, 1, va1); + VSSEG2_FLOAT(C0, vax2, vl); C0 += vl * 2; } diff --git a/kernel/riscv64/zgemv_n_rvv.c b/kernel/riscv64/zgemv_n_rvv.c index 4a40c30a7..f14ef5ba8 100644 --- a/kernel/riscv64/zgemv_n_rvv.c +++ b/kernel/riscv64/zgemv_n_rvv.c @@ -30,27 +30,33 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #if !defined(DOUBLE) #define VSETVL(n) __riscv_vsetvl_e32m4(n) #define FLOAT_V_T vfloat32m4_t +#define FLOAT_VX2_T vfloat32m4x2_t +#define VGET_VX2 __riscv_vget_v_f32m4x2_f32m4 +#define VSET_VX2 __riscv_vset_v_f32m4_f32m4x2 #define VLEV_FLOAT __riscv_vle32_v_f32m4 #define VLSEV_FLOAT __riscv_vlse32_v_f32m4 #define VSEV_FLOAT __riscv_vse32_v_f32m4 #define VSSEV_FLOAT __riscv_vsse32_v_f32m4 -#define VLSEG_FLOAT __riscv_vlseg2e32_v_f32m4 -#define VSSEG_FLOAT __riscv_vsseg2e32_v_f32m4 -#define VLSSEG_FLOAT __riscv_vlsseg2e32_v_f32m4 -#define VSSSEG_FLOAT __riscv_vssseg2e32_v_f32m4 +#define VLSEG_FLOAT __riscv_vlseg2e32_v_f32m4x2 +#define VSSEG_FLOAT __riscv_vsseg2e32_v_f32m4x2 +#define VLSSEG_FLOAT __riscv_vlsseg2e32_v_f32m4x2 +#define VSSSEG_FLOAT __riscv_vssseg2e32_v_f32m4x2 #define VFMACCVF_FLOAT __riscv_vfmacc_vf_f32m4 #define VFNMSACVF_FLOAT __riscv_vfnmsac_vf_f32m4 #else #define VSETVL(n) __riscv_vsetvl_e64m4(n) #define FLOAT_V_T vfloat64m4_t +#define FLOAT_VX2_T vfloat64m4x2_t +#define VGET_VX2 __riscv_vget_v_f64m4x2_f64m4 +#define VSET_VX2 __riscv_vset_v_f64m4_f64m4x2 #define VLEV_FLOAT __riscv_vle64_v_f64m4 #define VLSEV_FLOAT __riscv_vlse64_v_f64m4 #define VSEV_FLOAT __riscv_vse64_v_f64m4 #define VSSEV_FLOAT __riscv_vsse64_v_f64m4 -#define VLSEG_FLOAT __riscv_vlseg2e64_v_f64m4 -#define VSSEG_FLOAT __riscv_vsseg2e64_v_f64m4 -#define VLSSEG_FLOAT __riscv_vlsseg2e64_v_f64m4 -#define VSSSEG_FLOAT __riscv_vssseg2e64_v_f64m4 +#define VLSEG_FLOAT __riscv_vlseg2e64_v_f64m4x2 +#define VSSEG_FLOAT __riscv_vsseg2e64_v_f64m4x2 +#define VLSSEG_FLOAT __riscv_vlsseg2e64_v_f64m4x2 +#define VSSSEG_FLOAT __riscv_vssseg2e64_v_f64m4x2 #define VFMACCVF_FLOAT __riscv_vfmacc_vf_f64m4 #define VFNMSACVF_FLOAT __riscv_vfnmsac_vf_f64m4 #endif @@ -62,6 +68,7 @@ int CNAME(BLASLONG m, BLASLONG n, BLASLONG dummy1, FLOAT alpha_r, FLOAT alpha_i, FLOAT *a_ptr; FLOAT temp_r, temp_i; FLOAT_V_T va0, va1, vy0, vy1; + FLOAT_VX2_T vax2, vyx2; BLASLONG stride_y = inc_y * sizeof(FLOAT) * 2; @@ -73,7 +80,10 @@ int CNAME(BLASLONG m, BLASLONG n, BLASLONG dummy1, FLOAT alpha_r, FLOAT alpha_i, vl = VSETVL(m); a_ptr = a; ix = 0; - VLSEG_FLOAT(&vy0, &vy1, y, vl); + vyx2 = VLSEG_FLOAT(y, vl); + + vy0 = VGET_VX2(vyx2, 0); + vy1 = VGET_VX2(vyx2, 1); for(i = 0; i < n; i++){ #if !defined(XCONJ) @@ -84,7 +94,10 @@ int CNAME(BLASLONG m, BLASLONG n, BLASLONG dummy1, FLOAT alpha_r, FLOAT alpha_i, temp_i = alpha_r * x[ix+1] - alpha_i * x[ix]; #endif - VLSEG_FLOAT(&va0, &va1, a_ptr, vl); + vax2 = VLSEG_FLOAT(a_ptr, vl); + + va0 = VGET_VX2(vax2, 0); + va1 = VGET_VX2(vax2, 1); #if !defined(CONJ) #if !defined(XCONJ) vy0 = VFMACCVF_FLOAT(vy0, temp_r, va0, vl); @@ -113,7 +126,10 @@ int CNAME(BLASLONG m, BLASLONG n, BLASLONG dummy1, FLOAT alpha_r, FLOAT alpha_i, a_ptr += lda2; ix += inc_x2; } - VSSEG_FLOAT(y, vy0, vy1, vl); + + vyx2 = VSET_VX2(vyx2, 0, vy0); + vyx2 = VSET_VX2(vyx2, 1, vy1); + VSSEG_FLOAT(y, vyx2, vl); } } @@ -123,7 +139,9 @@ int CNAME(BLASLONG m, BLASLONG n, BLASLONG dummy1, FLOAT alpha_r, FLOAT alpha_i, vl = VSETVL(m); a_ptr = a; ix = 0; - VLSSEG_FLOAT(&vy0, &vy1, y, stride_y, vl); + vyx2 = VLSSEG_FLOAT(y, stride_y, vl); + vy0 = VGET_VX2(vyx2, 0); + vy1 = VGET_VX2(vyx2, 1); for(i = 0; i < n; i++){ #if !defined(XCONJ) @@ -134,7 +152,9 @@ int CNAME(BLASLONG m, BLASLONG n, BLASLONG dummy1, FLOAT alpha_r, FLOAT alpha_i, temp_i = alpha_r * x[ix+1] - alpha_i * x[ix]; #endif - VLSEG_FLOAT(&va0, &va1, a_ptr, vl); + vax2 = VLSEG_FLOAT(a_ptr, vl); + va0 = VGET_VX2(vax2, 0); + va1 = VGET_VX2(vax2, 1); #if !defined(CONJ) #if !defined(XCONJ) vy0 = VFMACCVF_FLOAT(vy0, temp_r, va0, vl); @@ -163,7 +183,9 @@ int CNAME(BLASLONG m, BLASLONG n, BLASLONG dummy1, FLOAT alpha_r, FLOAT alpha_i, a_ptr += lda2; ix += inc_x2; } - VSSSEG_FLOAT(y, stride_y, vy0, vy1, vl); + vyx2 = VSET_VX2(vyx2, 0, vy0); + vyx2 = VSET_VX2(vyx2, 1, vy1); + VSSSEG_FLOAT(y, stride_y, vyx2, vl); } } return(0); diff --git a/kernel/riscv64/zgemv_t_rvv.c b/kernel/riscv64/zgemv_t_rvv.c index 2f0380530..1c89a9f72 100644 --- a/kernel/riscv64/zgemv_t_rvv.c +++ b/kernel/riscv64/zgemv_t_rvv.c @@ -32,9 +32,11 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VSETVL_MAX_M1 __riscv_vsetvlmax_e32m1() #define FLOAT_V_T vfloat32m4_t #define FLOAT_V_T_M1 vfloat32m1_t -#define VLSEG_FLOAT __riscv_vlseg2e32_v_f32m4 -#define VLSSEG_FLOAT __riscv_vlsseg2e32_v_f32m4 -#define VFREDSUM_FLOAT __riscv_vfredusum_vs_f32m4_f32m1 +#define FLOAT_VX2_T vfloat32m4x2_t +#define VGET_VX2 __riscv_vget_v_f32m4x2_f32m4 +#define VLSEG_FLOAT __riscv_vlseg2e32_v_f32m4x2 +#define VLSSEG_FLOAT __riscv_vlsseg2e32_v_f32m4x2 +#define VFREDSUM_FLOAT_TU __riscv_vfredusum_vs_f32m4_f32m1_tu #define VFMACCVV_FLOAT_TU __riscv_vfmacc_vv_f32m4_tu #define VFNMSACVV_FLOAT_TU __riscv_vfnmsac_vv_f32m4_tu #define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m4 @@ -46,9 +48,11 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VSETVL_MAX_M1 __riscv_vsetvlmax_e64m1() #define FLOAT_V_T vfloat64m4_t #define FLOAT_V_T_M1 vfloat64m1_t -#define VLSEG_FLOAT __riscv_vlseg2e64_v_f64m4 -#define VLSSEG_FLOAT __riscv_vlsseg2e64_v_f64m4 -#define VFREDSUM_FLOAT __riscv_vfredusum_vs_f64m4_f64m1 +#define FLOAT_VX2_T vfloat64m4x2_t +#define VGET_VX2 __riscv_vget_v_f64m4x2_f64m4 +#define VLSEG_FLOAT __riscv_vlseg2e64_v_f64m4x2 +#define VLSSEG_FLOAT __riscv_vlsseg2e64_v_f64m4x2 +#define VFREDSUM_FLOAT_TU __riscv_vfredusum_vs_f64m4_f64m1_tu #define VFMACCVV_FLOAT_TU __riscv_vfmacc_vv_f64m4_tu #define VFNMSACVV_FLOAT_TU __riscv_vfnmsac_vv_f64m4_tu #define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m4 @@ -66,6 +70,7 @@ int CNAME(BLASLONG m, BLASLONG n, BLASLONG dummy1, FLOAT alpha_r, FLOAT alpha_i, FLOAT_V_T va0, va1, vx0, vx1, vr, vi; FLOAT_V_T_M1 v_res, v_z0; + FLOAT_VX2_T vxx2, vax2; BLASLONG stride_x = inc_x * sizeof(FLOAT) * 2; //BLASLONG stride_a = sizeof(FLOAT) * 2; @@ -73,6 +78,7 @@ int CNAME(BLASLONG m, BLASLONG n, BLASLONG dummy1, FLOAT alpha_r, FLOAT alpha_i, BLASLONG lda2 = lda * 2; size_t vlmax = VSETVL_MAX_M1; + v_res = VFMVVF_FLOAT_M1(0, vlmax); v_z0 = VFMVVF_FLOAT_M1(0, vlmax); vlmax = VSETVL(m); @@ -86,8 +92,13 @@ int CNAME(BLASLONG m, BLASLONG n, BLASLONG dummy1, FLOAT alpha_r, FLOAT alpha_i, for(size_t vl, k = m; k > 0; k -= vl) { vl = VSETVL(k); - VLSEG_FLOAT(&va0, &va1, &a_ptr[j], vl); - VLSEG_FLOAT(&vx0, &vx1, &x[ix], vl); + vax2 = VLSEG_FLOAT(&a_ptr[j], vl); + vxx2 = VLSEG_FLOAT(&x[ix], vl); + + va0 = VGET_VX2(vax2, 0); + va1 = VGET_VX2(vax2, 1); + vx0 = VGET_VX2(vxx2, 0); + vx1 = VGET_VX2(vxx2, 1); #if ( !defined(CONJ) && !defined(XCONJ) ) || ( defined(CONJ) && defined(XCONJ) ) vr = VFMACCVV_FLOAT_TU(vr, va0, vx0, vl); @@ -104,9 +115,9 @@ int CNAME(BLASLONG m, BLASLONG n, BLASLONG dummy1, FLOAT alpha_r, FLOAT alpha_i, ix += vl * inc_x * 2; } - v_res = VFREDSUM_FLOAT(vr, v_z0, vlmax); + v_res = VFREDSUM_FLOAT_TU(v_res, vr, v_z0, vlmax); temp_r = VFMVFS_FLOAT_M1(v_res); - v_res = VFREDSUM_FLOAT(vi, v_z0, vlmax); + v_res = VFREDSUM_FLOAT_TU(v_res, vi, v_z0, vlmax); temp_i = VFMVFS_FLOAT_M1(v_res); #if !defined(XCONJ) @@ -130,8 +141,13 @@ int CNAME(BLASLONG m, BLASLONG n, BLASLONG dummy1, FLOAT alpha_r, FLOAT alpha_i, for(size_t vl, k = m; k > 0; k -= vl) { vl = VSETVL(k); - VLSEG_FLOAT(&va0, &va1, &a_ptr[j], vl); - VLSSEG_FLOAT(&vx0, &vx1, &x[ix], stride_x, vl); + vax2 = VLSEG_FLOAT(&a_ptr[j], vl); + vxx2 = VLSSEG_FLOAT(&x[ix], stride_x, vl); + + va0 = VGET_VX2(vax2, 0); + va1 = VGET_VX2(vax2, 1); + vx0 = VGET_VX2(vxx2, 0); + vx1 = VGET_VX2(vxx2, 1); #if ( !defined(CONJ) && !defined(XCONJ) ) || ( defined(CONJ) && defined(XCONJ) ) vr = VFMACCVV_FLOAT_TU(vr, va0, vx0, vl); @@ -148,9 +164,9 @@ int CNAME(BLASLONG m, BLASLONG n, BLASLONG dummy1, FLOAT alpha_r, FLOAT alpha_i, ix += vl * inc_x * 2; } - v_res = VFREDSUM_FLOAT(vr, v_z0, vlmax); + v_res = VFREDSUM_FLOAT_TU(v_res, vr, v_z0, vlmax); temp_r = VFMVFS_FLOAT_M1(v_res); - v_res = VFREDSUM_FLOAT(vi, v_z0, vlmax); + v_res = VFREDSUM_FLOAT_TU(v_res, vi, v_z0, vlmax); temp_i = VFMVFS_FLOAT_M1(v_res); #if !defined(XCONJ) diff --git a/kernel/riscv64/zhemm_ltcopy_rvv_v1.c b/kernel/riscv64/zhemm_ltcopy_rvv_v1.c index 79b20a646..97013895a 100644 --- a/kernel/riscv64/zhemm_ltcopy_rvv_v1.c +++ b/kernel/riscv64/zhemm_ltcopy_rvv_v1.c @@ -31,12 +31,15 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VSETVL(n) __riscv_vsetvl_e32m2(n) #define VSETVL_MAX __riscv_vsetvlmax_e32m2() #define FLOAT_V_T vfloat32m2_t +#define FLOAT_VX2_T vfloat32m2x2_t +#define VGET_VX2 __riscv_vget_v_f32m2x2_f32m2 +#define VSET_VX2 __riscv_vset_v_f32m2_f32m2x2 #define VLEV_FLOAT __riscv_vle32_v_f32m2 #define VSEV_FLOAT __riscv_vse32_v_f32m2 #define VLSEV_FLOAT __riscv_vlse32_v_f32m2 -#define VLSEG2_FLOAT __riscv_vlseg2e32_v_f32m2 -#define VLSSEG2_FLOAT __riscv_vlsseg2e32_v_f32m2 -#define VSSEG2_FLOAT __riscv_vsseg2e32_v_f32m2 +#define VLSEG2_FLOAT __riscv_vlseg2e32_v_f32m2x2 +#define VLSSEG2_FLOAT __riscv_vlsseg2e32_v_f32m2x2 +#define VSSEG2_FLOAT __riscv_vsseg2e32_v_f32m2x2 #define INT_V_T vint32m2_t #define VID_V_INT __riscv_vid_v_i32m2 #define VADD_VX_INT __riscv_vadd_vx_i32m2 @@ -51,12 +54,15 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VSETVL(n) __riscv_vsetvl_e64m2(n) #define VSETVL_MAX __riscv_vsetvlmax_e64m2() #define FLOAT_V_T vfloat64m2_t +#define FLOAT_VX2_T vfloat64m2x2_t +#define VGET_VX2 __riscv_vget_v_f64m2x2_f64m2 +#define VSET_VX2 __riscv_vset_v_f64m2_f64m2x2 #define VLEV_FLOAT __riscv_vle64_v_f64m2 #define VSEV_FLOAT __riscv_vse64_v_f64m2 #define VLSEV_FLOAT __riscv_vlse64_v_f64m2 -#define VLSEG2_FLOAT __riscv_vlseg2e64_v_f64m2 -#define VLSSEG2_FLOAT __riscv_vlsseg2e64_v_f64m2 -#define VSSEG2_FLOAT __riscv_vsseg2e64_v_f64m2 +#define VLSEG2_FLOAT __riscv_vlseg2e64_v_f64m2x2 +#define VLSSEG2_FLOAT __riscv_vlsseg2e64_v_f64m2x2 +#define VSSEG2_FLOAT __riscv_vsseg2e64_v_f64m2x2 #define INT_V_T vint64m2_t #define VID_V_INT __riscv_vid_v_i64m2 #define VADD_VX_INT __riscv_vadd_vx_i64m2 @@ -81,6 +87,7 @@ int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG posX, BLASLON BLASLONG stride_lda = sizeof(FLOAT) * lda * 2; FLOAT_V_T vb0, vb1, vb2, va10, va11, va20, va21, vzero; + FLOAT_VX2_T va1x2, va2x2, vbx2; VBOOL_T vbool_gt0, vbool_lt0, vbool_eq0; INT_V_T vindex_max, vindex; @@ -96,8 +103,13 @@ int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG posX, BLASLON ao2 = a + posY * 2 + posX * lda * 2; for (i = m; i > 0; i--, offset--) { - VLSSEG2_FLOAT(&va20, &va21, ao2, stride_lda, vl); - VLSEG2_FLOAT(&va10, &va11, ao1, vl); + va2x2 = VLSSEG2_FLOAT(ao2, stride_lda, vl); + va1x2 = VLSEG2_FLOAT(ao1, vl); + + va20 = VGET_VX2(va2x2, 0); + va21 = VGET_VX2(va2x2, 1); + va10 = VGET_VX2(va1x2, 0); + va11 = VGET_VX2(va1x2, 1); vindex = VADD_VX_INT(vindex_max, offset, vl); vbool_gt0 = VMSGT_VX_INT(vindex, 0, vl); @@ -111,7 +123,10 @@ int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG posX, BLASLON vb1 = VMERGE_VVM_FLOAT(vb1, vb2, vbool_lt0, vl); vb1 = VMERGE_VVM_FLOAT(vb1, vzero, vbool_eq0, vl); - VSSEG2_FLOAT(b, vb0, vb1, vl); + + vbx2 = VSET_VX2(vbx2, 0, vb0); + vbx2 = VSET_VX2(vbx2, 1, vb1); + VSSEG2_FLOAT(b, vbx2, vl); b += vl * 2; ao1 += lda * 2; diff --git a/kernel/riscv64/zhemm_utcopy_rvv_v1.c b/kernel/riscv64/zhemm_utcopy_rvv_v1.c index a86815275..59029e9e5 100644 --- a/kernel/riscv64/zhemm_utcopy_rvv_v1.c +++ b/kernel/riscv64/zhemm_utcopy_rvv_v1.c @@ -31,12 +31,15 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VSETVL(n) __riscv_vsetvl_e32m2(n) #define VSETVL_MAX __riscv_vsetvlmax_e32m2() #define FLOAT_V_T vfloat32m2_t +#define FLOAT_VX2_T vfloat32m2x2_t +#define VGET_VX2 __riscv_vget_v_f32m2x2_f32m2 +#define VSET_VX2 __riscv_vset_v_f32m2_f32m2x2 #define VLEV_FLOAT __riscv_vle32_v_f32m2 #define VSEV_FLOAT __riscv_vse32_v_f32m2 #define VLSEV_FLOAT __riscv_vlse32_v_f32m2 -#define VLSEG2_FLOAT __riscv_vlseg2e32_v_f32m2 -#define VLSSEG2_FLOAT __riscv_vlsseg2e32_v_f32m2 -#define VSSEG2_FLOAT __riscv_vsseg2e32_v_f32m2 +#define VLSEG2_FLOAT __riscv_vlseg2e32_v_f32m2x2 +#define VLSSEG2_FLOAT __riscv_vlsseg2e32_v_f32m2x2 +#define VSSEG2_FLOAT __riscv_vsseg2e32_v_f32m2x2 #define INT_V_T vint32m2_t #define VID_V_INT __riscv_vid_v_i32m2 #define VADD_VX_INT __riscv_vadd_vx_i32m2 @@ -51,12 +54,15 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VSETVL(n) __riscv_vsetvl_e64m2(n) #define VSETVL_MAX __riscv_vsetvlmax_e64m2() #define FLOAT_V_T vfloat64m2_t +#define FLOAT_VX2_T vfloat64m2x2_t +#define VGET_VX2 __riscv_vget_v_f64m2x2_f64m2 +#define VSET_VX2 __riscv_vset_v_f64m2_f64m2x2 #define VLEV_FLOAT __riscv_vle64_v_f64m2 #define VSEV_FLOAT __riscv_vse64_v_f64m2 #define VLSEV_FLOAT __riscv_vlse64_v_f64m2 -#define VLSEG2_FLOAT __riscv_vlseg2e64_v_f64m2 -#define VLSSEG2_FLOAT __riscv_vlsseg2e64_v_f64m2 -#define VSSEG2_FLOAT __riscv_vsseg2e64_v_f64m2 +#define VLSEG2_FLOAT __riscv_vlseg2e64_v_f64m2x2 +#define VLSSEG2_FLOAT __riscv_vlsseg2e64_v_f64m2x2 +#define VSSEG2_FLOAT __riscv_vsseg2e64_v_f64m2x2 #define INT_V_T vint64m2_t #define VID_V_INT __riscv_vid_v_i64m2 #define VADD_VX_INT __riscv_vadd_vx_i64m2 @@ -79,6 +85,7 @@ int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG posX, BLASLON BLASLONG stride_lda = sizeof(FLOAT) * lda * 2; FLOAT_V_T vb0, vb1, vb2, va10, va11, va20, va21, vzero; + FLOAT_VX2_T va1x2, va2x2, vbx2; VBOOL_T vbool_gt0, vbool_eq0; INT_V_T vindex_max, vindex; @@ -94,8 +101,13 @@ int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG posX, BLASLON ao2 = a + posX * 2 + posY * lda * 2; for (i = m; i > 0; i--, offset--) { - VLSSEG2_FLOAT(&va10, &va11, ao1, stride_lda, vl); - VLSEG2_FLOAT(&va20, &va21, ao2, vl); + va1x2 = VLSSEG2_FLOAT(ao1, stride_lda, vl); + va2x2 = VLSEG2_FLOAT(ao2, vl); + + va20 = VGET_VX2(va2x2, 0); + va21 = VGET_VX2(va2x2, 1); + va10 = VGET_VX2(va1x2, 0); + va11 = VGET_VX2(va1x2, 1); vindex = VADD_VX_INT(vindex_max, offset, vl); vbool_gt0 = VMSGT_VX_INT(vindex, 0, vl); @@ -108,7 +120,10 @@ int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG posX, BLASLON vb1 = VMERGE_VVM_FLOAT(vb1, vb2, vbool_gt0, vl); vb1 = VMERGE_VVM_FLOAT(vb1, vzero, vbool_eq0, vl); - VSSEG2_FLOAT(b, vb0, vb1, vl); + + vbx2 = VSET_VX2(vbx2, 0, vb0); + vbx2 = VSET_VX2(vbx2, 1, vb1); + VSSEG2_FLOAT(b, vbx2, vl); b += vl * 2; ao1 += 2; diff --git a/kernel/riscv64/znrm2_rvv.c b/kernel/riscv64/znrm2_rvv.c index d2b27aa8d..32f67758a 100644 --- a/kernel/riscv64/znrm2_rvv.c +++ b/kernel/riscv64/znrm2_rvv.c @@ -28,95 +28,248 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include "common.h" #if !defined(DOUBLE) -#define VSETVL(n) __riscv_vsetvl_e32m4(n) -#define VSETVL_MAX __riscv_vsetvlmax_e32m4() -#define VSETVL_MAX_M1 __riscv_vsetvlmax_e32m1() -#define FLOAT_V_T vfloat32m4_t -#define FLOAT_V_T_M1 vfloat32m1_t -#define VLSEG_FLOAT __riscv_vlseg2e32_v_f32m4 -#define VLSSEG_FLOAT __riscv_vlsseg2e32_v_f32m4 -#define VFREDSUM_FLOAT __riscv_vfredusum_vs_f32m4_f32m1 -#define VFMACCVV_FLOAT_TU __riscv_vfmacc_vv_f32m4_tu -#define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m4 -#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f32m1 -#define VFREDMAXVS_FLOAT_TU __riscv_vfredmax_vs_f32m4_f32m1_tu -#define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f32m1_f32 -#define VFABSV_FLOAT __riscv_vfabs_v_f32m4 +#define VSETVL(n) __riscv_vsetvl_e32m4(n) +#define VSETVL_MAX __riscv_vsetvlmax_e32m4() +#define FLOAT_V_T vfloat32m4_t +#define FLOAT_V_T_M1 vfloat32m1_t +#define MASK_T vbool8_t +#define VLEV_FLOAT __riscv_vle32_v_f32m4 +#define VLSEV_FLOAT __riscv_vlse32_v_f32m4 +#define VFREDSUM_FLOAT __riscv_vfredusum_vs_f32m4_f32m1_tu +#define VFMACCVV_FLOAT_TU __riscv_vfmacc_vv_f32m4_tu +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m4 +#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f32m1 +#define VMFIRSTM __riscv_vfirst_m_b8 +#define VFREDMAXVS_FLOAT_TU __riscv_vfredmax_vs_f32m4_f32m1_tu +#define VFMVFS_FLOAT __riscv_vfmv_f_s_f32m1_f32 +#define VMFGTVF_FLOAT __riscv_vmfgt_vf_f32m4_b8 +#define VFDIVVF_FLOAT __riscv_vfdiv_vf_f32m4 +#define VFABSV_FLOAT __riscv_vfabs_v_f32m4 #else -#define VSETVL(n) __riscv_vsetvl_e64m4(n) -#define VSETVL_MAX __riscv_vsetvlmax_e64m4() -#define VSETVL_MAX_M1 __riscv_vsetvlmax_e64m1() -#define FLOAT_V_T vfloat64m4_t -#define FLOAT_V_T_M1 vfloat64m1_t -#define VLSEG_FLOAT __riscv_vlseg2e64_v_f64m4 -#define VLSSEG_FLOAT __riscv_vlsseg2e64_v_f64m4 -#define VFREDSUM_FLOAT __riscv_vfredusum_vs_f64m4_f64m1 -#define VFMACCVV_FLOAT_TU __riscv_vfmacc_vv_f64m4_tu -#define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m4 -#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f64m1 -#define VFREDMAXVS_FLOAT_TU __riscv_vfredmax_vs_f64m4_f64m1_tu -#define VFMVFS_FLOAT_M1 __riscv_vfmv_f_s_f64m1_f64 -#define VFABSV_FLOAT __riscv_vfabs_v_f64m4 +#define VSETVL(n) __riscv_vsetvl_e64m4(n) +#define VSETVL_MAX __riscv_vsetvlmax_e64m4() +#define FLOAT_V_T vfloat64m4_t +#define FLOAT_V_T_M1 vfloat64m1_t +#define MASK_T vbool16_t +#define VLEV_FLOAT __riscv_vle64_v_f64m4 +#define VLSEV_FLOAT __riscv_vlse64_v_f64m4 +#define VFREDSUM_FLOAT __riscv_vfredusum_vs_f64m4_f64m1_tu +#define VFMACCVV_FLOAT_TU __riscv_vfmacc_vv_f64m4_tu +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m4 +#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f64m1 +#define VMFIRSTM __riscv_vfirst_m_b16 +#define VFREDMAXVS_FLOAT_TU __riscv_vfredmax_vs_f64m4_f64m1_tu +#define VFMVFS_FLOAT __riscv_vfmv_f_s_f64m1_f64 +#define VMFGTVF_FLOAT __riscv_vmfgt_vf_f64m4_b16 +#define VFDIVVF_FLOAT __riscv_vfdiv_vf_f64m4 +#define VFABSV_FLOAT __riscv_vfabs_v_f64m4 #endif -// TODO: Should single precision use the widening MAC, or perhaps all should be double? - FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) { + BLASLONG i=0, j=0; - if ( n <= 0 ) return(0.0); - - FLOAT_V_T vr, v0, v1; - FLOAT_V_T_M1 v_max, v_res; - FLOAT scale = 0.0, ssq = 0.0; - - size_t vlmax = VSETVL_MAX; - v_res = VFMVVF_FLOAT_M1(0, vlmax); - v_max = VFMVVF_FLOAT_M1(0, vlmax); + if (n <= 0 || inc_x <= 0) return(0.0); - vr = VFMVVF_FLOAT(0, vlmax); + FLOAT_V_T vr, v0, v_zero; + unsigned int gvl = 0; + FLOAT_V_T_M1 v_res, v_z0; + gvl = VSETVL_MAX; + v_res = VFMVVF_FLOAT_M1(0, gvl); + v_z0 = VFMVVF_FLOAT_M1(0, gvl); + FLOAT scale = 0.0, ssq = 0.0; + MASK_T mask; + BLASLONG index = 0; if (inc_x == 1) { - - for (size_t vl; n > 0; n -= vl, x += vl*2) { - vl = VSETVL(n); - - VLSEG_FLOAT(&v0, &v1, x, vl); - v0 = VFABSV_FLOAT(v0, vl); - v1 = VFABSV_FLOAT(v1, vl); - - v_max = VFREDMAXVS_FLOAT_TU(v_max, v0, v_max, vl); - vr = VFMACCVV_FLOAT_TU(vr, v0, v0, vl); - - v_max = VFREDMAXVS_FLOAT_TU(v_max, v1, v_max, vl); - vr = VFMACCVV_FLOAT_TU(vr, v1, v1, vl); + BLASLONG n2 = n * 2; + gvl = VSETVL(n2); + vr = VFMVVF_FLOAT(0, gvl); + v_zero = VFMVVF_FLOAT(0, gvl); + for (i=0,j=0; i 0; n -= vl, x += vl*inc_x*2) { - vl = VSETVL(n); - - VLSSEG_FLOAT(&v0, &v1, x, stride_x, vl); - v0 = VFABSV_FLOAT(v0, vl); - v1 = VFABSV_FLOAT(v1, vl); + v0 = VLSEV_FLOAT(&x[idx+1], stride_x, gvl); + //fabs(vector) + v0 = VFABSV_FLOAT(v0, gvl); + //if scale change + mask = VMFGTVF_FLOAT(v0, scale, gvl); + index = VMFIRSTM(mask, gvl); + if (index == -1) { // no elements greater than scale + if(scale != 0.0) { + v0 = VFDIVVF_FLOAT(v0, scale, gvl); + vr = VFMACCVV_FLOAT_TU(vr, v0, v0, gvl); + } + } else { // found greater element + //ssq in vector vr: vr[0] + v_res = VFREDSUM_FLOAT(v_res, vr, v_z0, gvl); + //total ssq before current vector + ssq += VFMVFS_FLOAT(v_res); + //find max + v_res = VFREDMAXVS_FLOAT_TU(v_res, v0, v_z0, gvl); + //update ssq before max_index + ssq = ssq * (scale/VFMVFS_FLOAT(v_res))*(scale/VFMVFS_FLOAT(v_res)); + //update scale + scale = VFMVFS_FLOAT(v_res); + //ssq in vector vr + v0 = VFDIVVF_FLOAT(v0, scale, gvl); + vr = VFMACCVV_FLOAT_TU(v_zero, v0, v0, gvl); + } + j += gvl; + idx += inc_v; + } + //ssq in vector vr: vr[0] + v_res = VFREDSUM_FLOAT(v_res, vr, v_z0, gvl); + //total ssq now + ssq += VFMVFS_FLOAT(v_res); - v_max = VFREDMAXVS_FLOAT_TU(v_max, v0, v_max, vl); - vr = VFMACCVV_FLOAT_TU(vr, v0, v0, vl); + //tail + if (j < n) { + gvl = VSETVL(n-j); + v0 = VLSEV_FLOAT(&x[idx], stride_x, gvl); + //fabs(vector) + v0 = VFABSV_FLOAT(v0, gvl); + //if scale change + mask = VMFGTVF_FLOAT(v0, scale, gvl); + index = VMFIRSTM(mask, gvl); + if(index == -1) { // no elements greater than scale + if(scale != 0.0) { + v0 = VFDIVVF_FLOAT(v0, scale, gvl); + vr = VFMACCVV_FLOAT_TU(v_zero, v0, v0, gvl); + } + } else { // found greater element + //find max + v_res = VFREDMAXVS_FLOAT_TU(v_res, v0, v_z0, gvl); + //update ssq before max_index + ssq = ssq * (scale/VFMVFS_FLOAT(v_res))*(scale/VFMVFS_FLOAT(v_res)); + //update scale + scale = VFMVFS_FLOAT(v_res); + v0 = VFDIVVF_FLOAT(v0, scale, gvl); + vr = VFMACCVV_FLOAT_TU(v_zero, v0, v0, gvl); + } - v_max = VFREDMAXVS_FLOAT_TU(v_max, v1, v_max, vl); - vr = VFMACCVV_FLOAT_TU(vr, v1, v1, vl); + v0 = VLSEV_FLOAT(&x[idx+1], stride_x, gvl); + //fabs(vector) + v0 = VFABSV_FLOAT(v0, gvl); + //if scale change + mask = VMFGTVF_FLOAT(v0, scale, gvl); + index = VMFIRSTM(mask, gvl); + if (index == -1) {//no elements greater than scale + if(scale != 0.0) { + v0 = VFDIVVF_FLOAT(v0, scale, gvl); + vr = VFMACCVV_FLOAT_TU(vr, v0, v0, gvl); + } + } else { // found greater element + //ssq in vector vr: vr[0] + v_res = VFREDSUM_FLOAT(v_res, vr, v_z0, gvl); + //total ssq before current vector + ssq += VFMVFS_FLOAT(v_res); + //find max + v_res = VFREDMAXVS_FLOAT_TU(v_res, v0, v_z0, gvl); + //update ssq before max_index + ssq = ssq * (scale/VFMVFS_FLOAT(v_res))*(scale/VFMVFS_FLOAT(v_res)); + //update scale + scale = VFMVFS_FLOAT(v_res); + v0 = VFDIVVF_FLOAT(v0, scale, gvl); + vr = VFMACCVV_FLOAT_TU(v_zero, v0, v0, gvl); + } + //ssq in vector vr: vr[0] + v_res = VFREDSUM_FLOAT(v_res, vr, v_z0, gvl); + //total ssq now + ssq += VFMVFS_FLOAT(v_res); } - } - - v_res = VFREDSUM_FLOAT(vr, v_res, vlmax); - - ssq = VFMVFS_FLOAT_M1(v_res); - scale = VFMVFS_FLOAT_M1(v_max); - ssq = ssq / (scale*scale); - - return(scale * sqrt(ssq)); + return(scale * sqrt(ssq)); } diff --git a/kernel/riscv64/zrot_rvv.c b/kernel/riscv64/zrot_rvv.c index ee81bfe91..1d5390684 100644 --- a/kernel/riscv64/zrot_rvv.c +++ b/kernel/riscv64/zrot_rvv.c @@ -30,28 +30,34 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #if !defined(DOUBLE) #define VSETVL(n) __riscv_vsetvl_e32m4(n) #define FLOAT_V_T vfloat32m4_t +#define FLOAT_VX2_T vfloat32m4x2_t +#define VGET_VX2 __riscv_vget_v_f32m4x2_f32m4 +#define VSET_VX2 __riscv_vset_v_f32m4_f32m4x2 #define VLEV_FLOAT __riscv_vle32_v_f32m4 #define VLSEV_FLOAT __riscv_vlse32_v_f32m4 #define VSEV_FLOAT __riscv_vse32_v_f32m4 #define VSSEV_FLOAT __riscv_vsse32_v_f32m4 -#define VLSEG_FLOAT __riscv_vlseg2e32_v_f32m4 -#define VSSEG_FLOAT __riscv_vsseg2e32_v_f32m4 -#define VLSSEG_FLOAT __riscv_vlsseg2e32_v_f32m4 -#define VSSSEG_FLOAT __riscv_vssseg2e32_v_f32m4 +#define VLSEG_FLOAT __riscv_vlseg2e32_v_f32m4x2 +#define VSSEG_FLOAT __riscv_vsseg2e32_v_f32m4x2 +#define VLSSEG_FLOAT __riscv_vlsseg2e32_v_f32m4x2 +#define VSSSEG_FLOAT __riscv_vssseg2e32_v_f32m4x2 #define VFMACCVF_FLOAT __riscv_vfmacc_vf_f32m4 #define VFMULVF_FLOAT __riscv_vfmul_vf_f32m4 #define VFNMSACVF_FLOAT __riscv_vfnmsac_vf_f32m4 #else #define VSETVL(n) __riscv_vsetvl_e64m4(n) #define FLOAT_V_T vfloat64m4_t +#define FLOAT_VX2_T vfloat64m4x2_t +#define VGET_VX2 __riscv_vget_v_f64m4x2_f64m4 +#define VSET_VX2 __riscv_vset_v_f64m4_f64m4x2 #define VLEV_FLOAT __riscv_vle64_v_f64m4 #define VLSEV_FLOAT __riscv_vlse64_v_f64m4 #define VSEV_FLOAT __riscv_vse64_v_f64m4 #define VSSEV_FLOAT __riscv_vsse64_v_f64m4 -#define VLSEG_FLOAT __riscv_vlseg2e64_v_f64m4 -#define VSSEG_FLOAT __riscv_vsseg2e64_v_f64m4 -#define VLSSEG_FLOAT __riscv_vlsseg2e64_v_f64m4 -#define VSSSEG_FLOAT __riscv_vssseg2e64_v_f64m4 +#define VLSEG_FLOAT __riscv_vlseg2e64_v_f64m4x2 +#define VSSEG_FLOAT __riscv_vsseg2e64_v_f64m4x2 +#define VLSSEG_FLOAT __riscv_vlsseg2e64_v_f64m4x2 +#define VSSSEG_FLOAT __riscv_vssseg2e64_v_f64m4x2 #define VFMACCVF_FLOAT __riscv_vfmacc_vf_f64m4 #define VFMULVF_FLOAT __riscv_vfmul_vf_f64m4 #define VFNMSACVF_FLOAT __riscv_vfnmsac_vf_f64m4 @@ -63,6 +69,7 @@ int CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y, FLOAT if (n <= 0) return(0); FLOAT_V_T vt0, vt1, vx0, vx1, vy0, vy1; + FLOAT_VX2_T vxx2, vyx2, vtx2; if (inc_x == 0 && inc_y == 0) { BLASLONG i=0; @@ -93,8 +100,13 @@ int CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y, FLOAT for (size_t vl; n > 0; n -= vl, x += vl*2, y += vl*2) { vl = VSETVL(n); - VLSEG_FLOAT(&vx0, &vx1, x, vl); - VLSEG_FLOAT(&vy0, &vy1, y, vl); + vxx2 = VLSEG_FLOAT(x, vl); + vyx2 = VLSEG_FLOAT(y, vl); + + vx0 = VGET_VX2(vxx2, 0); + vx1 = VGET_VX2(vxx2, 1); + vy0 = VGET_VX2(vyx2, 0); + vy1 = VGET_VX2(vyx2, 1); vt0 = VFMULVF_FLOAT(vx0, c, vl); vt0 = VFMACCVF_FLOAT(vt0, s, vy0, vl); @@ -105,8 +117,13 @@ int CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y, FLOAT vy1 = VFMULVF_FLOAT(vy1, c, vl); vy1 = VFNMSACVF_FLOAT(vy1, s, vx1, vl); - VSSEG_FLOAT(x, vt0, vt1, vl); - VSSEG_FLOAT(y, vy0, vy1, vl); + vtx2 = VSET_VX2(vtx2, 0, vt0); + vtx2 = VSET_VX2(vtx2, 1, vt1); + vyx2 = VSET_VX2(vyx2, 0, vy0); + vyx2 = VSET_VX2(vyx2, 1, vy1); + + VSSEG_FLOAT(x, vtx2, vl); + VSSEG_FLOAT(y, vyx2, vl); } } else if (inc_x == 1){ @@ -115,8 +132,13 @@ int CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y, FLOAT for (size_t vl; n > 0; n -= vl, x += vl*2, y += vl*inc_y*2) { vl = VSETVL(n); - VLSEG_FLOAT(&vx0, &vx1, x, vl); - VLSSEG_FLOAT(&vy0, &vy1, y, stride_y, vl); + vxx2 = VLSEG_FLOAT(x, vl); + vyx2 = VLSSEG_FLOAT(y, stride_y, vl); + + vx0 = VGET_VX2(vxx2, 0); + vx1 = VGET_VX2(vxx2, 1); + vy0 = VGET_VX2(vyx2, 0); + vy1 = VGET_VX2(vyx2, 1); vt0 = VFMULVF_FLOAT(vx0, c, vl); vt0 = VFMACCVF_FLOAT(vt0, s, vy0, vl); @@ -127,8 +149,13 @@ int CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y, FLOAT vy1 = VFMULVF_FLOAT(vy1, c, vl); vy1 = VFNMSACVF_FLOAT(vy1, s, vx1, vl); - VSSEG_FLOAT(x, vt0, vt1, vl); - VSSSEG_FLOAT(y, stride_y, vy0, vy1, vl); + vtx2 = VSET_VX2(vtx2, 0, vt0); + vtx2 = VSET_VX2(vtx2, 1, vt1); + vyx2 = VSET_VX2(vyx2, 0, vy0); + vyx2 = VSET_VX2(vyx2, 1, vy1); + + VSSEG_FLOAT(x, vtx2, vl); + VSSSEG_FLOAT(y, stride_y, vyx2, vl); } } else if (inc_y == 1){ @@ -137,8 +164,13 @@ int CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y, FLOAT for (size_t vl; n > 0; n -= vl, x += vl*inc_x*2, y += vl*2) { vl = VSETVL(n); - VLSSEG_FLOAT(&vx0, &vx1, x, stride_x, vl); - VLSEG_FLOAT(&vy0, &vy1, y, vl); + vxx2 = VLSSEG_FLOAT(x, stride_x, vl); + vyx2 = VLSEG_FLOAT(y, vl); + + vx0 = VGET_VX2(vxx2, 0); + vx1 = VGET_VX2(vxx2, 1); + vy0 = VGET_VX2(vyx2, 0); + vy1 = VGET_VX2(vyx2, 1); vt0 = VFMULVF_FLOAT(vx0, c, vl); vt0 = VFMACCVF_FLOAT(vt0, s, vy0, vl); @@ -149,8 +181,13 @@ int CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y, FLOAT vy1 = VFMULVF_FLOAT(vy1, c, vl); vy1 = VFNMSACVF_FLOAT(vy1, s, vx1, vl); - VSSSEG_FLOAT(x, stride_x, vt0, vt1, vl); - VSSEG_FLOAT(y, vy0, vy1, vl); + vtx2 = VSET_VX2(vtx2, 0, vt0); + vtx2 = VSET_VX2(vtx2, 1, vt1); + vyx2 = VSET_VX2(vyx2, 0, vy0); + vyx2 = VSET_VX2(vyx2, 1, vy1); + + VSSSEG_FLOAT(x, stride_x, vtx2, vl); + VSSEG_FLOAT(y, vyx2, vl); } } else { @@ -160,8 +197,13 @@ int CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y, FLOAT for (size_t vl; n > 0; n -= vl, x += vl*inc_x*2, y += vl*inc_y*2) { vl = VSETVL(n); - VLSSEG_FLOAT(&vx0, &vx1, x, stride_x, vl); - VLSSEG_FLOAT(&vy0, &vy1, y, stride_y, vl); + vxx2 = VLSSEG_FLOAT(x, stride_x, vl); + vyx2 = VLSSEG_FLOAT(y, stride_y, vl); + + vx0 = VGET_VX2(vxx2, 0); + vx1 = VGET_VX2(vxx2, 1); + vy0 = VGET_VX2(vyx2, 0); + vy1 = VGET_VX2(vyx2, 1); vt0 = VFMULVF_FLOAT(vx0, c, vl); vt0 = VFMACCVF_FLOAT(vt0, s, vy0, vl); @@ -172,8 +214,13 @@ int CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y, FLOAT vy1 = VFMULVF_FLOAT(vy1, c, vl); vy1 = VFNMSACVF_FLOAT(vy1, s, vx1, vl); - VSSSEG_FLOAT(x, stride_x, vt0, vt1, vl); - VSSSEG_FLOAT(y, stride_y, vy0, vy1, vl); + vtx2 = VSET_VX2(vtx2, 0, vt0); + vtx2 = VSET_VX2(vtx2, 1, vt1); + vyx2 = VSET_VX2(vyx2, 0, vy0); + vyx2 = VSET_VX2(vyx2, 1, vy1); + + VSSSEG_FLOAT(x, stride_x, vtx2, vl); + VSSSEG_FLOAT(y, stride_y, vyx2, vl); } } diff --git a/kernel/riscv64/zscal_rvv.c b/kernel/riscv64/zscal_rvv.c index 779fab68c..2586c6036 100644 --- a/kernel/riscv64/zscal_rvv.c +++ b/kernel/riscv64/zscal_rvv.c @@ -31,10 +31,13 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VSETVL(n) __riscv_vsetvl_e32m4(n) #define VSETVL_MAX __riscv_vsetvlmax_e32m4() #define FLOAT_V_T vfloat32m4_t -#define VLSEG_FLOAT __riscv_vlseg2e32_v_f32m4 -#define VLSSEG_FLOAT __riscv_vlsseg2e32_v_f32m4 -#define VSSEG_FLOAT __riscv_vsseg2e32_v_f32m4 -#define VSSSEG_FLOAT __riscv_vssseg2e32_v_f32m4 +#define FLOAT_VX2_T vfloat32m4x2_t +#define VGET_VX2 __riscv_vget_v_f32m4x2_f32m4 +#define VSET_VX2 __riscv_vset_v_f32m4_f32m4x2 +#define VLSEG_FLOAT __riscv_vlseg2e32_v_f32m4x2 +#define VLSSEG_FLOAT __riscv_vlsseg2e32_v_f32m4x2 +#define VSSEG_FLOAT __riscv_vsseg2e32_v_f32m4x2 +#define VSSSEG_FLOAT __riscv_vssseg2e32_v_f32m4x2 #define VFMACCVF_FLOAT __riscv_vfmacc_vf_f32m4 #define VFMULVF_FLOAT __riscv_vfmul_vf_f32m4 #define VFNMSACVF_FLOAT __riscv_vfnmsac_vf_f32m4 @@ -43,10 +46,13 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VSETVL(n) __riscv_vsetvl_e64m4(n) #define VSETVL_MAX __riscv_vsetvlmax_e64m4() #define FLOAT_V_T vfloat64m4_t -#define VLSEG_FLOAT __riscv_vlseg2e64_v_f64m4 -#define VLSSEG_FLOAT __riscv_vlsseg2e64_v_f64m4 -#define VSSEG_FLOAT __riscv_vsseg2e64_v_f64m4 -#define VSSSEG_FLOAT __riscv_vssseg2e64_v_f64m4 +#define FLOAT_VX2_T vfloat64m4x2_t +#define VGET_VX2 __riscv_vget_v_f64m4x2_f64m4 +#define VSET_VX2 __riscv_vset_v_f64m4_f64m4x2 +#define VLSEG_FLOAT __riscv_vlseg2e64_v_f64m4x2 +#define VLSSEG_FLOAT __riscv_vlsseg2e64_v_f64m4x2 +#define VSSEG_FLOAT __riscv_vsseg2e64_v_f64m4x2 +#define VSSSEG_FLOAT __riscv_vssseg2e64_v_f64m4x2 #define VFMACCVF_FLOAT __riscv_vfmacc_vf_f64m4 #define VFMULVF_FLOAT __riscv_vfmul_vf_f64m4 #define VFNMSACVF_FLOAT __riscv_vfnmsac_vf_f64m4 @@ -61,6 +67,7 @@ int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT da_r,FLOAT da_i, F FLOAT_V_T vt, vr, vi; BLASLONG stride_x = inc_x * 2 * sizeof(FLOAT); size_t vlmax = VSETVL_MAX; + FLOAT_VX2_T vx2; if(da_r == 0.0 && da_i == 0.0) { @@ -71,16 +78,18 @@ int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT da_r,FLOAT da_i, F for (size_t vl; n > 0; n -= vl, x += vl*2) { vl = VSETVL(n); - - VSSEG_FLOAT(x, vr, vi, vl); + vx2 = VSET_VX2(vx2, 0, vr); + vx2 = VSET_VX2(vx2, 1, vi); + VSSEG_FLOAT(x, vx2, vl); } } else { for (size_t vl; n > 0; n -= vl, x += vl*inc_x*2) { vl = VSETVL(n); - - VSSSEG_FLOAT(x, stride_x, vr, vi, vl); + vx2 = VSET_VX2(vx2, 0, vr); + vx2 = VSET_VX2(vx2, 1, vi); + VSSSEG_FLOAT(x, stride_x, vx2, vl); } } @@ -89,12 +98,17 @@ int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT da_r,FLOAT da_i, F for (size_t vl; n > 0; n -= vl, x += vl*inc_x*2) { vl = VSETVL(n); - VLSSEG_FLOAT(&vr, &vi, x, stride_x, vl); + vx2 = VLSSEG_FLOAT(x, stride_x, vl); + vr = VGET_VX2(vx2, 0); + vi = VGET_VX2(vx2, 1); vt = VFMULVF_FLOAT(vi, -da_i, vl); vi = VFMULVF_FLOAT(vr, da_i, vl); - VSSSEG_FLOAT(x, stride_x, vt, vi, vl); + vx2 = VSET_VX2(vx2, 0, vt); + vx2 = VSET_VX2(vx2, 1, vi); + + VSSSEG_FLOAT(x, stride_x, vx2, vl); } } else if(da_i == 0.0) { @@ -102,12 +116,16 @@ int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT da_r,FLOAT da_i, F for (size_t vl; n > 0; n -= vl, x += vl*inc_x*2) { vl = VSETVL(n); - VLSSEG_FLOAT(&vr, &vi, x, stride_x, vl); + vx2 = VLSSEG_FLOAT(x, stride_x, vl); + vr = VGET_VX2(vx2, 0); + vi = VGET_VX2(vx2, 1); vr = VFMULVF_FLOAT(vr, da_r, vl); vi = VFMULVF_FLOAT(vi, da_r, vl); - VSSSEG_FLOAT(x, stride_x, vr, vi, vl); + vx2 = VSET_VX2(vx2, 0, vr); + vx2 = VSET_VX2(vx2, 1, vi); + VSSSEG_FLOAT(x, stride_x, vx2, vl); } } else { @@ -117,14 +135,18 @@ int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT da_r,FLOAT da_i, F for (size_t vl; n > 0; n -= vl, x += vl*2) { vl = VSETVL(n); - VLSEG_FLOAT(&vr, &vi, x, vl); + vx2 = VLSEG_FLOAT(x, vl); + vr = VGET_VX2(vx2, 0); + vi = VGET_VX2(vx2, 1); vt = VFMULVF_FLOAT(vr, da_r, vl); vt = VFNMSACVF_FLOAT(vt, da_i, vi, vl); vi = VFMULVF_FLOAT(vi, da_r, vl); vi = VFMACCVF_FLOAT(vi, da_i, vr, vl); - VSSEG_FLOAT(x, vt, vi, vl); + vx2 = VSET_VX2(vx2, 0, vt); + vx2 = VSET_VX2(vx2, 1, vi); + VSSEG_FLOAT(x, vx2, vl); } } else { @@ -132,14 +154,18 @@ int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT da_r,FLOAT da_i, F for (size_t vl; n > 0; n -= vl, x += vl*inc_x*2) { vl = VSETVL(n); - VLSSEG_FLOAT(&vr, &vi, x, stride_x, vl); + vx2 = VLSSEG_FLOAT(x, stride_x, vl); + vr = VGET_VX2(vx2, 0); + vi = VGET_VX2(vx2, 1); vt = VFMULVF_FLOAT(vr, da_r, vl); vt = VFNMSACVF_FLOAT(vt, da_i, vi, vl); vi = VFMULVF_FLOAT(vi, da_r, vl); vi = VFMACCVF_FLOAT(vi, da_i, vr, vl); - VSSSEG_FLOAT(x, stride_x, vt, vi, vl); + vx2 = VSET_VX2(vx2, 0, vt); + vx2 = VSET_VX2(vx2, 1, vi); + VSSSEG_FLOAT(x, stride_x, vx2, vl); } } } diff --git a/kernel/riscv64/zsum_rvv.c b/kernel/riscv64/zsum_rvv.c index b41f70eb5..489188bd5 100644 --- a/kernel/riscv64/zsum_rvv.c +++ b/kernel/riscv64/zsum_rvv.c @@ -32,8 +32,10 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VSETVL_MAX __riscv_vsetvlmax_e32m4() #define FLOAT_V_T vfloat32m4_t #define FLOAT_V_T_M1 vfloat32m1_t -#define VLSEG_FLOAT __riscv_vlseg2e32_v_f32m4 -#define VLSSEG_FLOAT __riscv_vlsseg2e32_v_f32m4 +#define FLOAT_VX2_T vfloat32m4x2_t +#define VGET_VX2 __riscv_vget_v_f32m4x2_f32m4 +#define VLSEG_FLOAT __riscv_vlseg2e32_v_f32m4x2 +#define VLSSEG_FLOAT __riscv_vlsseg2e32_v_f32m4x2 #define VFREDSUMVS_FLOAT __riscv_vfredusum_vs_f32m4_f32m1 #define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m4 #define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f32m1 @@ -44,8 +46,10 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VSETVL_MAX __riscv_vsetvlmax_e64m4() #define FLOAT_V_T vfloat64m4_t #define FLOAT_V_T_M1 vfloat64m1_t -#define VLSEG_FLOAT __riscv_vlseg2e64_v_f64m4 -#define VLSSEG_FLOAT __riscv_vlsseg2e64_v_f64m4 +#define FLOAT_VX2_T vfloat64m4x2_t +#define VGET_VX2 __riscv_vget_v_f64m4x2_f64m4 +#define VLSEG_FLOAT __riscv_vlseg2e64_v_f64m4x2 +#define VLSSEG_FLOAT __riscv_vlsseg2e64_v_f64m4x2 #define VFREDSUMVS_FLOAT __riscv_vfredusum_vs_f64m4_f64m1 #define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m4 #define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f64m1 @@ -59,6 +63,7 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) if (n <= 0 || inc_x <= 0) return(sumf); FLOAT_V_T v0, v1; + FLOAT_VX2_T vx2; size_t vlmax = VSETVL_MAX; FLOAT_V_T v_sum = VFMVVF_FLOAT(0, vlmax); @@ -67,7 +72,10 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) for (size_t vl; n > 0; n -= vl, x += vl*2) { vl = VSETVL(n); - VLSEG_FLOAT(&v0, &v1, x, vl); + vx2 = VLSEG_FLOAT(x, vl); + + v0 = VGET_VX2(vx2, 0); + v1 = VGET_VX2(vx2, 1); v_sum = VFADDVV_FLOAT_TU(v_sum, v_sum, v0, vl); v_sum = VFADDVV_FLOAT_TU(v_sum, v_sum, v1, vl); @@ -80,7 +88,10 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) for (size_t vl; n > 0; n -= vl, x += vl*inc_x*2) { vl = VSETVL(n); - VLSSEG_FLOAT(&v0, &v1, x, stride_x, vl); + vx2 = VLSSEG_FLOAT(x, stride_x, vl); + + v0 = VGET_VX2(vx2, 0); + v1 = VGET_VX2(vx2, 1); v_sum = VFADDVV_FLOAT_TU(v_sum, v_sum, v0, vl); v_sum = VFADDVV_FLOAT_TU(v_sum, v_sum, v1, vl); diff --git a/kernel/riscv64/zswap_rvv.c b/kernel/riscv64/zswap_rvv.c index 17b7b9f43..c2adf5e05 100644 --- a/kernel/riscv64/zswap_rvv.c +++ b/kernel/riscv64/zswap_rvv.c @@ -29,18 +29,18 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #if !defined(DOUBLE) #define VSETVL(n) __riscv_vsetvl_e32m4(n) -#define FLOAT_V_T vfloat32m4_t -#define VLSEG_FLOAT __riscv_vlseg2e32_v_f32m4 -#define VLSSEG_FLOAT __riscv_vlsseg2e32_v_f32m4 -#define VSSEG_FLOAT __riscv_vsseg2e32_v_f32m4 -#define VSSSEG_FLOAT __riscv_vssseg2e32_v_f32m4 +#define FLOAT_VX2_T vfloat32m4x2_t +#define VLSEG_FLOAT __riscv_vlseg2e32_v_f32m4x2 +#define VLSSEG_FLOAT __riscv_vlsseg2e32_v_f32m4x2 +#define VSSEG_FLOAT __riscv_vsseg2e32_v_f32m4x2 +#define VSSSEG_FLOAT __riscv_vssseg2e32_v_f32m4x2 #else #define VSETVL(n) __riscv_vsetvl_e64m4(n) -#define FLOAT_V_T vfloat64m4_t -#define VLSEG_FLOAT __riscv_vlseg2e64_v_f64m4 -#define VLSSEG_FLOAT __riscv_vlsseg2e64_v_f64m4 -#define VSSEG_FLOAT __riscv_vsseg2e64_v_f64m4 -#define VSSSEG_FLOAT __riscv_vssseg2e64_v_f64m4 +#define FLOAT_VX2_T vfloat64m4x2_t +#define VLSEG_FLOAT __riscv_vlseg2e64_v_f64m4x2 +#define VLSSEG_FLOAT __riscv_vlsseg2e64_v_f64m4x2 +#define VSSEG_FLOAT __riscv_vsseg2e64_v_f64m4x2 +#define VSSSEG_FLOAT __riscv_vssseg2e64_v_f64m4x2 #endif int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT dummy3, FLOAT dummy4, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y, FLOAT *dummy, BLASLONG dummy2) @@ -48,7 +48,7 @@ int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT dummy3, FLOAT dumm if (n <= 0) return(0); - FLOAT_V_T vx0, vx1, vy0, vy1; + FLOAT_VX2_T vxx2, vyx2; if (inc_x == 0 && inc_y == 0) { if (n & 1) { @@ -75,8 +75,8 @@ int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT dummy3, FLOAT dumm BLASLONG m = n - 1; for (size_t vl; m > 0; m -= vl * 2, ptr -= vl*inc_y * 2) { vl = VSETVL(m); - VLSSEG_FLOAT(&vy0, &vy1, ptr - 2, stride_y, vl); - VSSSEG_FLOAT(ptr, stride_y, vy0, vy1, vl); + vyx2 = VLSSEG_FLOAT(ptr - 2, stride_y, vl); + VSSSEG_FLOAT(ptr, stride_y, vyx2, vl); } y[0] = temp[0]; y[1] = temp[1]; @@ -92,8 +92,8 @@ int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT dummy3, FLOAT dumm BLASLONG m = n - 1; for (size_t vl; m > 0; m -= vl * 2, ptr -= vl*inc_x * 2) { vl = VSETVL(m); - VLSSEG_FLOAT(&vx0, &vx1, ptr - 2, stride_x, vl); - VSSSEG_FLOAT(ptr, stride_x, vx0, vx1, vl); + vxx2 = VLSSEG_FLOAT(ptr - 2, stride_x, vl); + VSSSEG_FLOAT(ptr, stride_x, vxx2, vl); } x[0] = temp[0]; x[1] = temp[1]; @@ -103,11 +103,11 @@ int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT dummy3, FLOAT dumm for (size_t vl; n > 0; n -= vl, x += vl*2, y += vl*2) { vl = VSETVL(n); - VLSEG_FLOAT(&vx0, &vx1, x, vl); - VLSEG_FLOAT(&vy0, &vy1, y, vl); + vxx2 = VLSEG_FLOAT(x, vl); + vyx2 = VLSEG_FLOAT(y, vl); - VSSEG_FLOAT(y, vx0, vx1, vl); - VSSEG_FLOAT(x, vy0, vy1, vl); + VSSEG_FLOAT(y, vxx2, vl); + VSSEG_FLOAT(x, vyx2, vl); } } else if (inc_x == 1){ @@ -116,11 +116,11 @@ int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT dummy3, FLOAT dumm for (size_t vl; n > 0; n -= vl, x += vl*2, y += vl*inc_y*2) { vl = VSETVL(n); - VLSEG_FLOAT(&vx0, &vx1, x, vl); - VLSSEG_FLOAT(&vy0, &vy1, y, stride_y, vl); + vxx2 = VLSEG_FLOAT(x, vl); + vyx2 = VLSSEG_FLOAT(y, stride_y, vl); - VSSSEG_FLOAT(y, stride_y, vx0, vx1, vl); - VSSEG_FLOAT(x, vy0, vy1, vl); + VSSSEG_FLOAT(y, stride_y, vxx2, vl); + VSSEG_FLOAT(x, vyx2, vl); } } else if (inc_y == 1){ @@ -129,11 +129,11 @@ int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT dummy3, FLOAT dumm for (size_t vl; n > 0; n -= vl, x += vl*inc_x*2, y += vl*2) { vl = VSETVL(n); - VLSSEG_FLOAT(&vx0, &vx1, x, stride_x, vl); - VLSEG_FLOAT(&vy0, &vy1, y, vl); + vxx2 = VLSSEG_FLOAT(x, stride_x, vl); + vyx2 = VLSEG_FLOAT(y, vl); - VSSEG_FLOAT(y, vx0, vx1, vl); - VSSSEG_FLOAT(x, stride_x, vy0, vy1, vl); + VSSEG_FLOAT(y, vxx2, vl); + VSSSEG_FLOAT(x, stride_x, vyx2, vl); } } else { @@ -143,11 +143,11 @@ int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT dummy3, FLOAT dumm for (size_t vl; n > 0; n -= vl, x += vl*inc_x*2, y += vl*inc_y*2) { vl = VSETVL(n); - VLSSEG_FLOAT(&vx0, &vx1, x, stride_x, vl); - VLSSEG_FLOAT(&vy0, &vy1, y, stride_y, vl); + vxx2 = VLSSEG_FLOAT(x, stride_x, vl); + vyx2 = VLSSEG_FLOAT(y, stride_y, vl); - VSSSEG_FLOAT(y, stride_y, vx0, vx1, vl); - VSSSEG_FLOAT(x, stride_x, vy0, vy1, vl); + VSSSEG_FLOAT(y, stride_y, vxx2, vl); + VSSSEG_FLOAT(x, stride_x, vyx2, vl); } } diff --git a/kernel/riscv64/zsymm_lcopy_rvv_v1.c b/kernel/riscv64/zsymm_lcopy_rvv_v1.c index 0f9e04869..f4d806190 100644 --- a/kernel/riscv64/zsymm_lcopy_rvv_v1.c +++ b/kernel/riscv64/zsymm_lcopy_rvv_v1.c @@ -31,12 +31,15 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VSETVL(n) __riscv_vsetvl_e32m2(n) #define VSETVL_MAX __riscv_vsetvlmax_e32m2() #define FLOAT_V_T vfloat32m2_t +#define FLOAT_VX2_T vfloat32m2x2_t +#define VGET_VX2 __riscv_vget_v_f32m2x2_f32m2 +#define VSET_VX2 __riscv_vset_v_f32m2_f32m2x2 #define VLEV_FLOAT __riscv_vle32_v_f32m2 #define VSEV_FLOAT __riscv_vse32_v_f32m2 #define VLSEV_FLOAT __riscv_vlse32_v_f32m2 -#define VLSEG2_FLOAT __riscv_vlseg2e32_v_f32m2 -#define VLSSEG2_FLOAT __riscv_vlsseg2e32_v_f32m2 -#define VSSEG2_FLOAT __riscv_vsseg2e32_v_f32m2 +#define VLSEG2_FLOAT __riscv_vlseg2e32_v_f32m2x2 +#define VLSSEG2_FLOAT __riscv_vlsseg2e32_v_f32m2x2 +#define VSSEG2_FLOAT __riscv_vsseg2e32_v_f32m2x2 #define INT_V_T vint32m2_t #define VID_V_INT __riscv_vid_v_i32m2 #define VADD_VX_INT __riscv_vadd_vx_i32m2 @@ -47,12 +50,15 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VSETVL(n) __riscv_vsetvl_e64m2(n) #define VSETVL_MAX __riscv_vsetvlmax_e64m2() #define FLOAT_V_T vfloat64m2_t +#define FLOAT_VX2_T vfloat64m2x2_t +#define VGET_VX2 __riscv_vget_v_f64m2x2_f64m2 +#define VSET_VX2 __riscv_vset_v_f64m2_f64m2x2 #define VLEV_FLOAT __riscv_vle64_v_f64m2 #define VSEV_FLOAT __riscv_vse64_v_f64m2 #define VLSEV_FLOAT __riscv_vlse64_v_f64m2 -#define VLSEG2_FLOAT __riscv_vlseg2e64_v_f64m2 -#define VLSSEG2_FLOAT __riscv_vlsseg2e64_v_f64m2 -#define VSSEG2_FLOAT __riscv_vsseg2e64_v_f64m2 +#define VLSEG2_FLOAT __riscv_vlseg2e64_v_f64m2x2 +#define VLSSEG2_FLOAT __riscv_vlsseg2e64_v_f64m2x2 +#define VSSEG2_FLOAT __riscv_vsseg2e64_v_f64m2x2 #define INT_V_T vint64m2_t #define VID_V_INT __riscv_vid_v_i64m2 #define VADD_VX_INT __riscv_vadd_vx_i64m2 @@ -70,6 +76,7 @@ int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG posX, BLASLON BLASLONG stride_lda = sizeof(FLOAT)*lda*2; FLOAT_V_T vb0, vb1, va10, va11, va20, va21; + FLOAT_VX2_T va1x2, va2x2, vbx2; VBOOL_T vbool; INT_V_T vindex_max, vindex; @@ -85,15 +92,23 @@ int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG posX, BLASLON for (i = m; i > 0; i--, offset--) { - VLSSEG2_FLOAT(&va20, &va21, ao2, stride_lda, vl); - VLSEG2_FLOAT(&va10, &va11, ao1, vl); + va2x2 = VLSSEG2_FLOAT(ao2, stride_lda, vl); + va1x2 = VLSEG2_FLOAT(ao1, vl); + + va20 = VGET_VX2(va2x2, 0); + va21 = VGET_VX2(va2x2, 1); + va10 = VGET_VX2(va1x2, 0); + va11 = VGET_VX2(va1x2, 1); vindex = VADD_VX_INT(vindex_max, offset, vl); vbool = VMSGT_VX_INT(vindex, 0, vl); vb0 = VMERGE_VVM_FLOAT(va20, va10, vbool, vl); vb1 = VMERGE_VVM_FLOAT(va21, va11, vbool, vl); - VSSEG2_FLOAT(b, vb0, vb1, vl); + + vbx2 = VSET_VX2(vbx2, 0, vb0); + vbx2 = VSET_VX2(vbx2, 1, vb1); + VSSEG2_FLOAT(b, vbx2, vl); b += vl * 2; ao1 += lda * 2; diff --git a/kernel/riscv64/zsymm_ucopy_rvv_v1.c b/kernel/riscv64/zsymm_ucopy_rvv_v1.c index fdc693700..069551bb0 100644 --- a/kernel/riscv64/zsymm_ucopy_rvv_v1.c +++ b/kernel/riscv64/zsymm_ucopy_rvv_v1.c @@ -31,12 +31,15 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VSETVL(n) __riscv_vsetvl_e32m2(n) #define VSETVL_MAX __riscv_vsetvlmax_e32m2() #define FLOAT_V_T vfloat32m2_t +#define FLOAT_VX2_T vfloat32m2x2_t +#define VGET_VX2 __riscv_vget_v_f32m2x2_f32m2 +#define VSET_VX2 __riscv_vset_v_f32m2_f32m2x2 #define VLEV_FLOAT __riscv_vle32_v_f32m2 #define VSEV_FLOAT __riscv_vse32_v_f32m2 #define VLSEV_FLOAT __riscv_vlse32_v_f32m2 -#define VLSEG2_FLOAT __riscv_vlseg2e32_v_f32m2 -#define VLSSEG2_FLOAT __riscv_vlsseg2e32_v_f32m2 -#define VSSEG2_FLOAT __riscv_vsseg2e32_v_f32m2 +#define VLSEG2_FLOAT __riscv_vlseg2e32_v_f32m2x2 +#define VLSSEG2_FLOAT __riscv_vlsseg2e32_v_f32m2x2 +#define VSSEG2_FLOAT __riscv_vsseg2e32_v_f32m2x2 #define INT_V_T vint32m2_t #define VID_V_INT __riscv_vid_v_i32m2 #define VADD_VX_INT __riscv_vadd_vx_i32m2 @@ -47,12 +50,15 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VSETVL(n) __riscv_vsetvl_e64m2(n) #define VSETVL_MAX __riscv_vsetvlmax_e64m2() #define FLOAT_V_T vfloat64m2_t +#define FLOAT_VX2_T vfloat64m2x2_t +#define VGET_VX2 __riscv_vget_v_f64m2x2_f64m2 +#define VSET_VX2 __riscv_vset_v_f64m2_f64m2x2 #define VLEV_FLOAT __riscv_vle64_v_f64m2 #define VSEV_FLOAT __riscv_vse64_v_f64m2 #define VLSEV_FLOAT __riscv_vlse64_v_f64m2 -#define VLSEG2_FLOAT __riscv_vlseg2e64_v_f64m2 -#define VLSSEG2_FLOAT __riscv_vlsseg2e64_v_f64m2 -#define VSSEG2_FLOAT __riscv_vsseg2e64_v_f64m2 +#define VLSEG2_FLOAT __riscv_vlseg2e64_v_f64m2x2 +#define VLSSEG2_FLOAT __riscv_vlsseg2e64_v_f64m2x2 +#define VSSEG2_FLOAT __riscv_vsseg2e64_v_f64m2x2 #define INT_V_T vint64m2_t #define VID_V_INT __riscv_vid_v_i64m2 #define VADD_VX_INT __riscv_vadd_vx_i64m2 @@ -71,6 +77,7 @@ int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG posX, BLASLON BLASLONG stride_lda = sizeof(FLOAT)*lda * 2; FLOAT_V_T vb0, vb1, va10, va11, va20, va21; + FLOAT_VX2_T va1x2, va2x2, vbx2; VBOOL_T vbool; INT_V_T vindex_max, vindex; @@ -86,15 +93,23 @@ int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG posX, BLASLON ao2 = a + posX * 2 + 0 + posY * lda * 2; for (i = m; i > 0; i--, offset--) { - VLSSEG2_FLOAT(&va10, &va11, ao1, stride_lda, vl); - VLSEG2_FLOAT(&va20, &va21, ao2, vl); + va1x2 = VLSSEG2_FLOAT(ao1, stride_lda, vl); + va2x2 = VLSEG2_FLOAT(ao2, vl); + + va20 = VGET_VX2(va2x2, 0); + va21 = VGET_VX2(va2x2, 1); + va10 = VGET_VX2(va1x2, 0); + va11 = VGET_VX2(va1x2, 1); vindex = VADD_VX_INT(vindex_max, offset, vl); vbool = VMSGT_VX_INT(vindex, 0, vl); vb0 = VMERGE_VVM_FLOAT(va20, va10, vbool, vl); vb1 = VMERGE_VVM_FLOAT(va21, va11, vbool, vl); - VSSEG2_FLOAT(b, vb0, vb1, vl); + + vbx2 = VSET_VX2(vbx2, 0, vb0); + vbx2 = VSET_VX2(vbx2, 1, vb1); + VSSEG2_FLOAT(b, vbx2, vl); b += vl * 2; ao1 += 2; diff --git a/kernel/riscv64/ztrmm_lncopy_rvv_v1.c b/kernel/riscv64/ztrmm_lncopy_rvv_v1.c index 7276618c5..ae664561b 100644 --- a/kernel/riscv64/ztrmm_lncopy_rvv_v1.c +++ b/kernel/riscv64/ztrmm_lncopy_rvv_v1.c @@ -32,12 +32,14 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #if !defined(DOUBLE) #define VSETVL(n) __riscv_vsetvl_e32m2(n) #define FLOAT_V_T vfloat32m2_t +#define FLOAT_VX2_T vfloat32m2x2_t +#define VGET_VX2 __riscv_vget_v_f32m2x2_f32m2 +#define VSET_VX2 __riscv_vset_v_f32m2_f32m2x2 #define VLEV_FLOAT __riscv_vle32_v_f32m2 #define VSEV_FLOAT __riscv_vse32_v_f32m2 #define VLSEV_FLOAT __riscv_vlse32_v_f32m2 -#define VLSEG2_FLOAT __riscv_vlseg2e32_v_f32m2 -#define VLSSEG2_FLOAT __riscv_vlsseg2e32_v_f32m2 -#define VSSEG2_FLOAT __riscv_vsseg2e32_v_f32m2 +#define VLSSEG2_FLOAT __riscv_vlsseg2e32_v_f32m2x2 +#define VSSEG2_FLOAT __riscv_vsseg2e32_v_f32m2x2 #define VBOOL_T vbool16_t #define UINT_V_T vint32m2_t #define VID_V_UINT __riscv_vid_v_i32m2 @@ -47,12 +49,14 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #else #define VSETVL(n) __riscv_vsetvl_e64m2(n) #define FLOAT_V_T vfloat64m2_t +#define FLOAT_VX2_T vfloat64m2x2_t +#define VGET_VX2 __riscv_vget_v_f64m2x2_f64m2 +#define VSET_VX2 __riscv_vset_v_f64m2_f64m2x2 #define VLEV_FLOAT __riscv_vle64_v_f64m2 #define VSEV_FLOAT __riscv_vse64_v_f64m2 #define VLSEV_FLOAT __riscv_vlse64_v_f64m2 -#define VLSEG2_FLOAT __riscv_vlseg2e64_v_f64m2 -#define VLSSEG2_FLOAT __riscv_vlsseg2e64_v_f64m2 -#define VSSEG2_FLOAT __riscv_vsseg2e64_v_f64m2 +#define VLSSEG2_FLOAT __riscv_vlsseg2e64_v_f64m2x2 +#define VSSEG2_FLOAT __riscv_vsseg2e64_v_f64m2x2 #define VBOOL_T vbool32_t #define UINT_V_T vuint64m2_t #define VID_V_UINT __riscv_vid_v_u64m2 @@ -69,6 +73,7 @@ int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG posX, BLASLON BLASLONG stride_lda = sizeof(FLOAT)*lda*2; + FLOAT_VX2_T vax2; FLOAT_V_T va0, va1; size_t vl; @@ -98,8 +103,8 @@ int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG posX, BLASLON { if (X > posY) { - VLSSEG2_FLOAT(&va0, &va1, ao, stride_lda, vl); - VSSEG2_FLOAT(b, va0, va1, vl); + vax2 = VLSSEG2_FLOAT(ao, stride_lda, vl); + VSSEG2_FLOAT(b, vax2, vl); ao += 2; b += vl * 2; @@ -119,7 +124,10 @@ int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG posX, BLASLON vindex = VID_V_UINT(vl); for (unsigned int j = 0; j < vl; j++) { - VLSSEG2_FLOAT(&va0, &va1, ao, stride_lda, vl); + vax2 = VLSSEG2_FLOAT(ao, stride_lda, vl); + va0 = VGET_VX2(vax2, 0); + va1 = VGET_VX2(vax2, 1); + vbool_cmp = VMSGTU_VX_UINT(vindex, j, vl); va0 = VFMERGE_VFM_FLOAT(va0, ZERO, vbool_cmp, vl); va1 = VFMERGE_VFM_FLOAT(va1, ZERO, vbool_cmp, vl); @@ -128,7 +136,9 @@ int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG posX, BLASLON va0 = VFMERGE_VFM_FLOAT(va0, ONE, vbool_eq, vl); va1 = VFMERGE_VFM_FLOAT(va1, ZERO, vbool_eq, vl); #endif - VSSEG2_FLOAT(b, va0, va1, vl); + vax2 = VSET_VX2(vax2, 0, va0); + vax2 = VSET_VX2(vax2, 1, va1); + VSSEG2_FLOAT(b, vax2, vl); ao += 2; b += vl * 2; } diff --git a/kernel/riscv64/ztrmm_ltcopy_rvv_v1.c b/kernel/riscv64/ztrmm_ltcopy_rvv_v1.c index 72e8f2ce2..ab8d34337 100644 --- a/kernel/riscv64/ztrmm_ltcopy_rvv_v1.c +++ b/kernel/riscv64/ztrmm_ltcopy_rvv_v1.c @@ -32,11 +32,13 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #if !defined(DOUBLE) #define VSETVL(n) __riscv_vsetvl_e32m2(n) #define FLOAT_V_T vfloat32m2_t +#define FLOAT_VX2_T vfloat32m2x2_t +#define VGET_VX2 __riscv_vget_v_f32m2x2_f32m2 +#define VSET_VX2 __riscv_vset_v_f32m2_f32m2x2 #define VLEV_FLOAT __riscv_vle32_v_f32m2 #define VSEV_FLOAT __riscv_vse32_v_f32m2 -#define VLSEG2_FLOAT __riscv_vlseg2e32_v_f32m2 -#define VLSSEG2_FLOAT __riscv_vlsseg2e32_v_f32m2 -#define VSSEG2_FLOAT __riscv_vsseg2e32_v_f32m2 +#define VLSEG2_FLOAT __riscv_vlseg2e32_v_f32m2x2 +#define VSSEG2_FLOAT __riscv_vsseg2e32_v_f32m2x2 #define VBOOL_T vbool16_t #define UINT_V_T vuint32m2_t #define VID_V_UINT __riscv_vid_v_u32m2 @@ -46,11 +48,13 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #else #define VSETVL(n) __riscv_vsetvl_e64m2(n) #define FLOAT_V_T vfloat64m2_t +#define FLOAT_VX2_T vfloat64m2x2_t +#define VGET_VX2 __riscv_vget_v_f64m2x2_f64m2 +#define VSET_VX2 __riscv_vset_v_f64m2_f64m2x2 #define VLEV_FLOAT __riscv_vle64_v_f64m2 #define VSEV_FLOAT __riscv_vse64_v_f64m2 -#define VLSEG2_FLOAT __riscv_vlseg2e64_v_f64m2 -#define VLSSEG2_FLOAT __riscv_vlsseg2e64_v_f64m2 -#define VSSEG2_FLOAT __riscv_vsseg2e64_v_f64m2 +#define VLSEG2_FLOAT __riscv_vlseg2e64_v_f64m2x2 +#define VSSEG2_FLOAT __riscv_vsseg2e64_v_f64m2x2 #define VBOOL_T vbool32_t #define UINT_V_T vuint64m2_t #define VID_V_UINT __riscv_vid_v_u64m2 @@ -65,6 +69,7 @@ int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG posX, BLASLON FLOAT *ao; + FLOAT_VX2_T vax2; FLOAT_V_T va0, va1; size_t vl; #ifdef UNIT @@ -101,8 +106,8 @@ int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG posX, BLASLON else if (X < posY) { //va1 = VLEV_FLOAT(ao, vl); - VLSEG2_FLOAT(&va0, &va1, ao, vl); - VSSEG2_FLOAT(b, va0, va1, vl); + vax2 = VLSEG2_FLOAT(ao, vl); + VSSEG2_FLOAT(b, vax2, vl); ao += lda * 2; b += vl * 2; @@ -115,7 +120,10 @@ int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG posX, BLASLON for (unsigned int j = 0; j < vl; j++) { //va1 = VLEV_FLOAT(ao, vl); - VLSEG2_FLOAT(&va0, &va1, ao, vl); + vax2 = VLSEG2_FLOAT(ao, vl); + va0 = VGET_VX2(vax2, 0); + va1 = VGET_VX2(vax2, 1); + vbool_cmp = VMSLTU_VX_UINT(vindex, j, vl); va0 = VFMERGE_VFM_FLOAT(va0, ZERO, vbool_cmp, vl); va1 = VFMERGE_VFM_FLOAT(va1, ZERO, vbool_cmp, vl); @@ -124,7 +132,9 @@ int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG posX, BLASLON va0 = VFMERGE_VFM_FLOAT(va0, ONE, vbool_eq, vl); va1 = VFMERGE_VFM_FLOAT(va1, ZERO, vbool_eq, vl); #endif - VSSEG2_FLOAT(b, va0, va1, vl); + vax2 = VSET_VX2(vax2, 0, va0); + vax2 = VSET_VX2(vax2, 1, va1); + VSSEG2_FLOAT(b, vax2, vl); ao += lda * 2; b += vl * 2; } diff --git a/kernel/riscv64/ztrmm_uncopy_rvv_v1.c b/kernel/riscv64/ztrmm_uncopy_rvv_v1.c index e6d36c86d..ba6e63b96 100644 --- a/kernel/riscv64/ztrmm_uncopy_rvv_v1.c +++ b/kernel/riscv64/ztrmm_uncopy_rvv_v1.c @@ -32,12 +32,14 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #if !defined(DOUBLE) #define VSETVL(n) __riscv_vsetvl_e32m2(n) #define FLOAT_V_T vfloat32m2_t +#define FLOAT_VX2_T vfloat32m2x2_t +#define VGET_VX2 __riscv_vget_v_f32m2x2_f32m2 +#define VSET_VX2 __riscv_vset_v_f32m2_f32m2x2 #define VLEV_FLOAT __riscv_vle32_v_f32m2 #define VLSEV_FLOAT __riscv_vlse32_v_f32m2 #define VSEV_FLOAT __riscv_vse32_v_f32m2 -#define VLSEG2_FLOAT __riscv_vlseg2e32_v_f32m2 -#define VLSSEG2_FLOAT __riscv_vlsseg2e32_v_f32m2 -#define VSSEG2_FLOAT __riscv_vsseg2e32_v_f32m2 +#define VLSSEG2_FLOAT __riscv_vlsseg2e32_v_f32m2x2 +#define VSSEG2_FLOAT __riscv_vsseg2e32_v_f32m2x2 #define VBOOL_T vbool16_t #define UINT_V_T vuint32m2_t #define VID_V_UINT __riscv_vid_v_u32m2 @@ -47,12 +49,14 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #else #define VSETVL(n) __riscv_vsetvl_e64m2(n) #define FLOAT_V_T vfloat64m2_t +#define FLOAT_VX2_T vfloat64m2x2_t +#define VGET_VX2 __riscv_vget_v_f64m2x2_f64m2 +#define VSET_VX2 __riscv_vset_v_f64m2_f64m2x2 #define VLEV_FLOAT __riscv_vle64_v_f64m2 #define VLSEV_FLOAT __riscv_vlse64_v_f64m2 #define VSEV_FLOAT __riscv_vse64_v_f64m2 -#define VLSEG2_FLOAT __riscv_vlseg2e64_v_f64m2 -#define VLSSEG2_FLOAT __riscv_vlsseg2e64_v_f64m2 -#define VSSEG2_FLOAT __riscv_vsseg2e64_v_f64m2 +#define VLSSEG2_FLOAT __riscv_vlsseg2e64_v_f64m2x2 +#define VSSEG2_FLOAT __riscv_vsseg2e64_v_f64m2x2 #define VBOOL_T vbool32_t #define UINT_V_T vuint64m2_t #define VID_V_UINT __riscv_vid_v_u64m2 @@ -67,6 +71,7 @@ int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG posX, BLASLON BLASLONG stride_lda = sizeof(FLOAT) * lda * 2; FLOAT *ao; + FLOAT_VX2_T vax2; FLOAT_V_T va0, va1; size_t vl; @@ -96,8 +101,8 @@ int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG posX, BLASLON { if (X < posY) { - VLSSEG2_FLOAT(&va0, &va1, ao, stride_lda, vl); - VSSEG2_FLOAT(b, va0, va1, vl); + vax2 = VLSSEG2_FLOAT(ao, stride_lda, vl); + VSSEG2_FLOAT(b, vax2, vl); ao += 2; b += vl * 2; @@ -118,7 +123,10 @@ int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG posX, BLASLON vindex = VID_V_UINT(vl); for (unsigned int j = 0; j < vl; j++) { - VLSSEG2_FLOAT(&va0, &va1, ao, stride_lda, vl); + vax2 = VLSSEG2_FLOAT(ao, stride_lda, vl); + va0 = VGET_VX2(vax2, 0); + va1 = VGET_VX2(vax2, 1); + vbool_cmp = VMSLTU_VX_UINT(vindex, j, vl); va0 = VFMERGE_VFM_FLOAT(va0, ZERO, vbool_cmp, vl); va1 = VFMERGE_VFM_FLOAT(va1, ZERO, vbool_cmp, vl); @@ -127,7 +135,9 @@ int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG posX, BLASLON va0 = VFMERGE_VFM_FLOAT(va0, ONE, vbool_eq, vl); va1 = VFMERGE_VFM_FLOAT(va1, ZERO, vbool_eq, vl); #endif - VSSEG2_FLOAT(b, va0, va1, vl); + vax2 = VSET_VX2(vax2, 0, va0); + vax2 = VSET_VX2(vax2, 1, va1); + VSSEG2_FLOAT(b, vax2, vl); ao += 2; b += vl * 2; } diff --git a/kernel/riscv64/ztrmm_utcopy_rvv_v1.c b/kernel/riscv64/ztrmm_utcopy_rvv_v1.c index 7085cfc37..a624fff54 100644 --- a/kernel/riscv64/ztrmm_utcopy_rvv_v1.c +++ b/kernel/riscv64/ztrmm_utcopy_rvv_v1.c @@ -34,11 +34,13 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #if !defined(DOUBLE) #define VSETVL(n) __riscv_vsetvl_e32m2(n) #define FLOAT_V_T vfloat32m2_t +#define FLOAT_VX2_T vfloat32m2x2_t +#define VGET_VX2 __riscv_vget_v_f32m2x2_f32m2 +#define VSET_VX2 __riscv_vset_v_f32m2_f32m2x2 #define VLEV_FLOAT __riscv_vle32_v_f32m2 #define VSEV_FLOAT __riscv_vse32_v_f32m2 -#define VLSEG2_FLOAT __riscv_vlseg2e32_v_f32m2 -#define VLSSEG2_FLOAT __riscv_vlsseg2e32_v_f32m2 -#define VSSEG2_FLOAT __riscv_vsseg2e32_v_f32m2 +#define VLSEG2_FLOAT __riscv_vlseg2e32_v_f32m2x2 +#define VSSEG2_FLOAT __riscv_vsseg2e32_v_f32m2x2 #define VBOOL_T vbool16_t #define UINT_V_T vuint32m2_t #define VID_V_UINT __riscv_vid_v_u32m2 @@ -48,11 +50,13 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #else #define VSETVL(n) __riscv_vsetvl_e64m2(n) #define FLOAT_V_T vfloat64m2_t +#define FLOAT_VX2_T vfloat64m2x2_t +#define VGET_VX2 __riscv_vget_v_f64m2x2_f64m2 +#define VSET_VX2 __riscv_vset_v_f64m2_f64m2x2 #define VLEV_FLOAT __riscv_vle64_v_f64m2 #define VSEV_FLOAT __riscv_vse64_v_f64m2 -#define VLSEG2_FLOAT __riscv_vlseg2e64_v_f64m2 -#define VLSSEG2_FLOAT __riscv_vlsseg2e64_v_f64m2 -#define VSSEG2_FLOAT __riscv_vsseg2e64_v_f64m2 +#define VLSEG2_FLOAT __riscv_vlseg2e64_v_f64m2x2 +#define VSSEG2_FLOAT __riscv_vsseg2e64_v_f64m2x2 #define VBOOL_T vbool32_t #define UINT_V_T vuint64m2_t #define VID_V_UINT __riscv_vid_v_u64m2 @@ -66,6 +70,8 @@ int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG posX, BLASLON BLASLONG i, j, js, X; FLOAT *ao; + + FLOAT_VX2_T vax2; FLOAT_V_T va0, va1; #ifdef UNIT VBOOL_T vbool_eq; @@ -103,8 +109,8 @@ int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG posX, BLASLON } else if (X > posY) { - VLSEG2_FLOAT(&va0, &va1, ao, vl); - VSSEG2_FLOAT(b, va0, va1, vl); + vax2 = VLSEG2_FLOAT(ao, vl); + VSSEG2_FLOAT(b, vax2, vl); ao += lda * 2; b += vl * 2; X++; @@ -115,7 +121,10 @@ int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG posX, BLASLON vindex = VID_V_UINT(vl); for (j = 0; j < vl; j++) { - VLSEG2_FLOAT(&va0, &va1, ao, vl); + vax2 = VLSEG2_FLOAT(ao, vl); + va0 = VGET_VX2(vax2, 0); + va1 = VGET_VX2(vax2, 1); + vbool_cmp = VMSGTU_VX_UINT(vindex, j, vl); va0 = VFMERGE_VFM_FLOAT(va0, ZERO, vbool_cmp, vl); va1 = VFMERGE_VFM_FLOAT(va1, ZERO, vbool_cmp, vl); @@ -124,7 +133,9 @@ int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG posX, BLASLON va0 = VFMERGE_VFM_FLOAT(va0, ONE, vbool_eq, vl); va1 = VFMERGE_VFM_FLOAT(va1, ZERO, vbool_eq, vl); #endif - VSSEG2_FLOAT(b, va0, va1, vl); + vax2 = VSET_VX2(vax2, 0, va0); + vax2 = VSET_VX2(vax2, 1, va1); + VSSEG2_FLOAT(b, vax2, vl); ao += lda * 2; b += vl * 2; } diff --git a/kernel/riscv64/ztrmmkernel_rvv_v1x4.c b/kernel/riscv64/ztrmmkernel_rvv_v1x4.c index 92b4b855b..db5f06af8 100644 --- a/kernel/riscv64/ztrmmkernel_rvv_v1x4.c +++ b/kernel/riscv64/ztrmmkernel_rvv_v1x4.c @@ -30,10 +30,13 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #if !defined(DOUBLE) #define VSETVL(n) __riscv_vsetvl_e32m2(n) #define FLOAT_V_T vfloat32m2_t +#define FLOAT_VX2_T vfloat32m2x2_t +#define VGET_VX2 __riscv_vget_v_f32m2x2_f32m2 +#define VSET_VX2 __riscv_vset_v_f32m2_f32m2x2 #define VLEV_FLOAT __riscv_vle32_v_f32m2 #define VSEV_FLOAT __riscv_vse32_v_f32m2 -#define VLSEG2_FLOAT __riscv_vlseg2e32_v_f32m2 -#define VSSEG2_FLOAT __riscv_vsseg2e32_v_f32m2 +#define VLSEG2_FLOAT __riscv_vlseg2e32_v_f32m2x2 +#define VSSEG2_FLOAT __riscv_vsseg2e32_v_f32m2x2 #define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m2 #define VFMACCVF_FLOAT __riscv_vfmacc_vf_f32m2 #define VFNMSACVF_FLOAT __riscv_vfnmsac_vf_f32m2 @@ -41,10 +44,13 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #else #define VSETVL(n) __riscv_vsetvl_e64m2(n) #define FLOAT_V_T vfloat64m2_t +#define FLOAT_VX2_T vfloat64m2x2_t +#define VGET_VX2 __riscv_vget_v_f64m2x2_f64m2 +#define VSET_VX2 __riscv_vset_v_f64m2_f64m2x2 #define VLEV_FLOAT __riscv_vle64_v_f64m2 #define VSEV_FLOAT __riscv_vse64_v_f64m2 -#define VLSEG2_FLOAT __riscv_vlseg2e64_v_f64m2 -#define VSSEG2_FLOAT __riscv_vsseg2e64_v_f64m2 +#define VLSEG2_FLOAT __riscv_vlseg2e64_v_f64m2x2 +#define VSSEG2_FLOAT __riscv_vsseg2e64_v_f64m2x2 #define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m2 #define VFMACCVF_FLOAT __riscv_vfmacc_vf_f64m2 #define VFNMSACVF_FLOAT __riscv_vfnmsac_vf_f64m2 @@ -85,6 +91,7 @@ int CNAME(BLASLONG bm,BLASLONG bn,BLASLONG bk,FLOAT alphar,FLOAT alphai,FLOAT* b off = 0; #endif + FLOAT_VX2_T vax2; FLOAT_V_T va0, va1, va2, va3, va4, va5, va6, va7; FLOAT_V_T vres0, vres1, vres2, vres3, vres4, vres5, vres6, vres7; @@ -130,10 +137,14 @@ int CNAME(BLASLONG bm,BLASLONG bn,BLASLONG bk,FLOAT alphar,FLOAT alphai,FLOAT* b for (k = temp/4; k > 0; k--) { - VLSEG2_FLOAT(&va0, &va1, ptrba, vl); + vax2 = VLSEG2_FLOAT(ptrba, vl); + va0 = VGET_VX2(vax2, 0); + va1 = VGET_VX2(vax2, 1); ptrba += vl*2; - VLSEG2_FLOAT(&va2, &va3, ptrba, vl); + vax2 = VLSEG2_FLOAT(ptrba, vl); + va2 = VGET_VX2(vax2, 0); + va3 = VGET_VX2(vax2, 1); ptrba += vl*2; vres0 = OP_rr(vres0, *(ptrbb + 0), va0, vl); @@ -158,7 +169,9 @@ int CNAME(BLASLONG bm,BLASLONG bn,BLASLONG bk,FLOAT alphar,FLOAT alphai,FLOAT* b ptrbb += 8; - VLSEG2_FLOAT(&va4, &va5, ptrba, vl); + vax2 = VLSEG2_FLOAT(ptrba, vl); + va4 = VGET_VX2(vax2, 0); + va5 = VGET_VX2(vax2, 1); ptrba += vl*2; vres0 = OP_rr(vres0, *(ptrbb + 0), va2, vl); @@ -183,7 +196,9 @@ int CNAME(BLASLONG bm,BLASLONG bn,BLASLONG bk,FLOAT alphar,FLOAT alphai,FLOAT* b ptrbb += 8; - VLSEG2_FLOAT(&va6, &va7, ptrba, vl); + vax2 = VLSEG2_FLOAT(ptrba, vl); + va6 = VGET_VX2(vax2, 0); + va7 = VGET_VX2(vax2, 1); ptrba += vl*2; vres0 = OP_rr(vres0, *(ptrbb + 0), va4, vl); @@ -233,7 +248,9 @@ int CNAME(BLASLONG bm,BLASLONG bn,BLASLONG bk,FLOAT alphar,FLOAT alphai,FLOAT* b for (k = temp & 3; k > 0; k--) { - VLSEG2_FLOAT(&va0, &va1, ptrba, vl); + vax2 = VLSEG2_FLOAT(ptrba, vl); + va0 = VGET_VX2(vax2, 0); + va1 = VGET_VX2(vax2, 1); ptrba += vl*2; vres0 = OP_rr(vres0, *(ptrbb + 0), va0, vl); @@ -262,25 +279,37 @@ int CNAME(BLASLONG bm,BLASLONG bn,BLASLONG bk,FLOAT alphar,FLOAT alphai,FLOAT* b va1 = VFMULVF_FLOAT(vres1, alphar, vl); va0 = VFNMSACVF_FLOAT(va0, alphai, vres1, vl); va1 = VFMACCVF_FLOAT(va1, alphai, vres0, vl); - VSSEG2_FLOAT(C0, va0, va1, vl); + + vax2 = VSET_VX2(vax2, 0, va0); + vax2 = VSET_VX2(vax2, 1, va1); + VSSEG2_FLOAT(C0, vax2, vl); va2 = VFMULVF_FLOAT(vres2, alphar, vl); va3 = VFMULVF_FLOAT(vres3, alphar, vl); va2 = VFNMSACVF_FLOAT(va2, alphai, vres3, vl); va3 = VFMACCVF_FLOAT(va3, alphai, vres2, vl); - VSSEG2_FLOAT(C1, va2, va3, vl); + + vax2 = VSET_VX2(vax2, 0, va2); + vax2 = VSET_VX2(vax2, 1, va3); + VSSEG2_FLOAT(C1, vax2, vl); va0 = VFMULVF_FLOAT(vres4, alphar, vl); va1 = VFMULVF_FLOAT(vres5, alphar, vl); va0 = VFNMSACVF_FLOAT(va0, alphai, vres5, vl); va1 = VFMACCVF_FLOAT(va1, alphai, vres4, vl); - VSSEG2_FLOAT(C2, va0, va1, vl); + + vax2 = VSET_VX2(vax2, 0, va0); + vax2 = VSET_VX2(vax2, 1, va1); + VSSEG2_FLOAT(C2, vax2, vl); va2 = VFMULVF_FLOAT(vres6, alphar, vl); va3 = VFMULVF_FLOAT(vres7, alphar, vl); va2 = VFNMSACVF_FLOAT(va2, alphai, vres7, vl); va3 = VFMACCVF_FLOAT(va3, alphai, vres6, vl); - VSSEG2_FLOAT(C3, va2, va3, vl); + + vax2 = VSET_VX2(vax2, 0, va2); + vax2 = VSET_VX2(vax2, 1, va3); + VSSEG2_FLOAT(C3, vax2, vl); #if ( defined(LEFT) && defined(TRANSA)) || (!defined(LEFT) && !defined(TRANSA)) temp = bk - off; @@ -342,10 +371,14 @@ int CNAME(BLASLONG bm,BLASLONG bn,BLASLONG bk,FLOAT alphar,FLOAT alphai,FLOAT* b #endif for (k = temp/4; k > 0; k--) { - VLSEG2_FLOAT(&va0, &va1, ptrba, vl); + vax2 = VLSEG2_FLOAT(ptrba, vl); + va0 = VGET_VX2(vax2, 0); + va1 = VGET_VX2(vax2, 1); ptrba += vl*2; - VLSEG2_FLOAT(&va2, &va3, ptrba, vl); + vax2 = VLSEG2_FLOAT(ptrba, vl); + va2 = VGET_VX2(vax2, 0); + va3 = VGET_VX2(vax2, 1); ptrba += vl*2; vres0 = OP_rr(vres0, *(ptrbb + 0), va0, vl); @@ -360,7 +393,9 @@ int CNAME(BLASLONG bm,BLASLONG bn,BLASLONG bk,FLOAT alphar,FLOAT alphai,FLOAT* b ptrbb += 4; - VLSEG2_FLOAT(&va4, &va5, ptrba, vl); + vax2 = VLSEG2_FLOAT(ptrba, vl); + va4 = VGET_VX2(vax2, 0); + va5 = VGET_VX2(vax2, 1); ptrba += vl*2; vres0 = OP_rr(vres0, *(ptrbb + 0), va2, vl); @@ -375,7 +410,9 @@ int CNAME(BLASLONG bm,BLASLONG bn,BLASLONG bk,FLOAT alphar,FLOAT alphai,FLOAT* b ptrbb += 4; - VLSEG2_FLOAT(&va6, &va7, ptrba, vl); + vax2 = VLSEG2_FLOAT(ptrba, vl); + va6 = VGET_VX2(vax2, 0); + va7 = VGET_VX2(vax2, 1); ptrba += vl*2; vres0 = OP_rr(vres0, *(ptrbb + 0), va4, vl); @@ -405,7 +442,9 @@ int CNAME(BLASLONG bm,BLASLONG bn,BLASLONG bk,FLOAT alphar,FLOAT alphai,FLOAT* b for (k = temp & 3; k > 0; k--) { - VLSEG2_FLOAT(&va0, &va1, ptrba, vl); + vax2 = VLSEG2_FLOAT(ptrba, vl); + va0 = VGET_VX2(vax2, 0); + va1 = VGET_VX2(vax2, 1); ptrba += vl*2; vres0 = OP_rr(vres0, *(ptrbb + 0), va0, vl); @@ -425,13 +464,19 @@ int CNAME(BLASLONG bm,BLASLONG bn,BLASLONG bk,FLOAT alphar,FLOAT alphai,FLOAT* b va1 = VFMULVF_FLOAT(vres1, alphar, vl); va0 = VFNMSACVF_FLOAT(va0, alphai, vres1, vl); va1 = VFMACCVF_FLOAT(va1, alphai, vres0, vl); - VSSEG2_FLOAT(C0, va0, va1, vl); + + vax2 = VSET_VX2(vax2, 0, va0); + vax2 = VSET_VX2(vax2, 1, va1); + VSSEG2_FLOAT(C0, vax2, vl); va2 = VFMULVF_FLOAT(vres2, alphar, vl); va3 = VFMULVF_FLOAT(vres3, alphar, vl); va2 = VFNMSACVF_FLOAT(va2, alphai, vres3, vl); va3 = VFMACCVF_FLOAT(va3, alphai, vres2, vl); - VSSEG2_FLOAT(C1, va2, va3, vl); + + vax2 = VSET_VX2(vax2, 0, va2); + vax2 = VSET_VX2(vax2, 1, va3); + VSSEG2_FLOAT(C1, vax2, vl); #if ( defined(LEFT) && defined(TRANSA)) || (!defined(LEFT) && !defined(TRANSA)) temp = bk - off; @@ -487,10 +532,14 @@ int CNAME(BLASLONG bm,BLASLONG bn,BLASLONG bk,FLOAT alphar,FLOAT alphai,FLOAT* b #endif for (k = temp/4; k > 0; k--) { - VLSEG2_FLOAT(&va0, &va1, ptrba, vl); + vax2 = VLSEG2_FLOAT(ptrba, vl); + va0 = VGET_VX2(vax2, 0); + va1 = VGET_VX2(vax2, 1); ptrba += vl*2; - VLSEG2_FLOAT(&va2, &va3, ptrba, vl); + vax2 = VLSEG2_FLOAT(ptrba, vl); + va2 = VGET_VX2(vax2, 0); + va3 = VGET_VX2(vax2, 1); ptrba += vl*2; vres0 = OP_rr(vres0, *(ptrbb + 0), va0, vl); @@ -500,7 +549,9 @@ int CNAME(BLASLONG bm,BLASLONG bn,BLASLONG bk,FLOAT alphar,FLOAT alphai,FLOAT* b ptrbb += 2; - VLSEG2_FLOAT(&va4, &va5, ptrba, vl); + vax2 = VLSEG2_FLOAT(ptrba, vl); + va4 = VGET_VX2(vax2, 0); + va5 = VGET_VX2(vax2, 1); ptrba += vl*2; vres0 = OP_rr(vres0, *(ptrbb + 0), va2, vl); @@ -510,7 +561,9 @@ int CNAME(BLASLONG bm,BLASLONG bn,BLASLONG bk,FLOAT alphar,FLOAT alphai,FLOAT* b ptrbb += 2; - VLSEG2_FLOAT(&va6, &va7, ptrba, vl); + vax2 = VLSEG2_FLOAT(ptrba, vl); + va6 = VGET_VX2(vax2, 0); + va7 = VGET_VX2(vax2, 1); ptrba += vl*2; vres0 = OP_rr(vres0, *(ptrbb + 0), va4, vl); @@ -530,7 +583,9 @@ int CNAME(BLASLONG bm,BLASLONG bn,BLASLONG bk,FLOAT alphar,FLOAT alphai,FLOAT* b for (k = temp & 3; k > 0; k--) { - VLSEG2_FLOAT(&va0, &va1, ptrba, vl); + vax2 = VLSEG2_FLOAT(ptrba, vl); + va0 = VGET_VX2(vax2, 0); + va1 = VGET_VX2(vax2, 1); ptrba += vl*2; vres0 = OP_rr(vres0, *(ptrbb + 0), va0, vl); @@ -545,7 +600,10 @@ int CNAME(BLASLONG bm,BLASLONG bn,BLASLONG bk,FLOAT alphar,FLOAT alphai,FLOAT* b va1 = VFMULVF_FLOAT(vres1, alphar, vl); va0 = VFNMSACVF_FLOAT(va0, alphai, vres1, vl); va1 = VFMACCVF_FLOAT(va1, alphai, vres0, vl); - VSSEG2_FLOAT(C0, va0, va1, vl); + + vax2 = VSET_VX2(vax2, 0, va0); + vax2 = VSET_VX2(vax2, 1, va1); + VSSEG2_FLOAT(C0, vax2, vl); #if ( defined(LEFT) && defined(TRANSA)) || (!defined(LEFT) && !defined(TRANSA)) temp = bk - off; diff --git a/kernel/riscv64/ztrsm_lncopy_rvv_v1.c b/kernel/riscv64/ztrsm_lncopy_rvv_v1.c index 383cb883f..36cec711d 100644 --- a/kernel/riscv64/ztrsm_lncopy_rvv_v1.c +++ b/kernel/riscv64/ztrsm_lncopy_rvv_v1.c @@ -30,20 +30,20 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #if !defined(DOUBLE) #define VSETVL(n) __riscv_vsetvl_e32m2(n) -#define FLOAT_V_T vfloat32m2_t -#define VLSSEG2_FLOAT __riscv_vlsseg2e32_v_f32m2 -#define VSSEG2_FLOAT __riscv_vsseg2e32_v_f32m2 -#define VSSEG2_FLOAT_M __riscv_vsseg2e32_v_f32m2_m +#define FLOAT_VX2_T vfloat32m2x2_t +#define VLSSEG2_FLOAT __riscv_vlsseg2e32_v_f32m2x2 +#define VSSEG2_FLOAT __riscv_vsseg2e32_v_f32m2x2 +#define VSSEG2_FLOAT_M __riscv_vsseg2e32_v_f32m2x2_m #define VBOOL_T vbool16_t #define UINT_V_T vuint32m2_t #define VID_V_UINT __riscv_vid_v_u32m2 #define VMSLTU_VX_UINT __riscv_vmsltu_vx_u32m2_b16 #else #define VSETVL(n) __riscv_vsetvl_e64m2(n) -#define FLOAT_V_T vfloat64m2_t -#define VLSSEG2_FLOAT __riscv_vlsseg2e64_v_f64m2 -#define VSSEG2_FLOAT __riscv_vsseg2e64_v_f64m2 -#define VSSEG2_FLOAT_M __riscv_vsseg2e64_v_f64m2_m +#define FLOAT_VX2_T vfloat64m2x2_t +#define VLSSEG2_FLOAT __riscv_vlsseg2e64_v_f64m2x2 +#define VSSEG2_FLOAT __riscv_vsseg2e64_v_f64m2x2 +#define VSSEG2_FLOAT_M __riscv_vsseg2e64_v_f64m2x2_m #define VBOOL_T vbool32_t #define UINT_V_T vuint64m2_t #define VID_V_UINT __riscv_vid_v_u64m2 @@ -64,7 +64,7 @@ int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG offset, FLOAT BLASLONG stride_lda = sizeof(FLOAT)*lda*2; - FLOAT_V_T va0, va1; + FLOAT_VX2_T vax2; VBOOL_T vbool_cmp; UINT_V_T vindex; size_t vl; @@ -82,9 +82,9 @@ int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG offset, FLOAT vindex = VID_V_UINT(vl); for (unsigned int j = 0; j < vl; j++) { - VLSSEG2_FLOAT(&va0, &va1, ao, stride_lda, vl); + vax2 = VLSSEG2_FLOAT(ao, stride_lda, vl); vbool_cmp = VMSLTU_VX_UINT(vindex, j, vl); - VSSEG2_FLOAT_M(vbool_cmp, b, va0, va1, vl); + VSSEG2_FLOAT_M(vbool_cmp, b, vax2, vl); compinv((b + j * 2), *(ao + j * lda * 2), *(ao + j * lda * 2 + 1)); ao += 2; @@ -97,8 +97,8 @@ int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG offset, FLOAT { if (ii > jj) { - VLSSEG2_FLOAT(&va0, &va1, ao, stride_lda, vl); - VSSEG2_FLOAT(b, va0, va1, vl); + vax2 = VLSSEG2_FLOAT(ao, stride_lda, vl); + VSSEG2_FLOAT(b, vax2, vl); } ao += 2; b += vl * 2; diff --git a/kernel/riscv64/ztrsm_ltcopy_rvv_v1.c b/kernel/riscv64/ztrsm_ltcopy_rvv_v1.c index f57e9f1de..3a7bdb522 100644 --- a/kernel/riscv64/ztrsm_ltcopy_rvv_v1.c +++ b/kernel/riscv64/ztrsm_ltcopy_rvv_v1.c @@ -30,20 +30,20 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #if !defined(DOUBLE) #define VSETVL(n) __riscv_vsetvl_e32m2(n) -#define FLOAT_V_T vfloat32m2_t -#define VLSEG2_FLOAT __riscv_vlseg2e32_v_f32m2 -#define VSSEG2_FLOAT __riscv_vsseg2e32_v_f32m2 -#define VSSEG2_FLOAT_M __riscv_vsseg2e32_v_f32m2_m +#define FLOAT_VX2_T vfloat32m2x2_t +#define VLSEG2_FLOAT __riscv_vlseg2e32_v_f32m2x2 +#define VSSEG2_FLOAT __riscv_vsseg2e32_v_f32m2x2 +#define VSSEG2_FLOAT_M __riscv_vsseg2e32_v_f32m2x2_m #define VBOOL_T vbool16_t #define UINT_V_T vuint32m2_t #define VID_V_UINT __riscv_vid_v_u32m2 #define VMSGTU_VX_UINT __riscv_vmsgtu_vx_u32m2_b16 #else #define VSETVL(n) __riscv_vsetvl_e64m2(n) -#define FLOAT_V_T vfloat64m2_t -#define VLSEG2_FLOAT __riscv_vlseg2e64_v_f64m2 -#define VSSEG2_FLOAT __riscv_vsseg2e64_v_f64m2 -#define VSSEG2_FLOAT_M __riscv_vsseg2e64_v_f64m2_m +#define FLOAT_VX2_T vfloat64m2x2_t +#define VLSEG2_FLOAT __riscv_vlseg2e64_v_f64m2x2 +#define VSSEG2_FLOAT __riscv_vsseg2e64_v_f64m2x2 +#define VSSEG2_FLOAT_M __riscv_vsseg2e64_v_f64m2x2_m #define VBOOL_T vbool32_t #define UINT_V_T vuint64m2_t #define VID_V_UINT __riscv_vid_v_u64m2 @@ -60,7 +60,7 @@ int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG offset, FLOAT jj = offset; - FLOAT_V_T va0, va1; + FLOAT_VX2_T vax2; VBOOL_T vbool_cmp; UINT_V_T vindex; @@ -82,9 +82,9 @@ int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG offset, FLOAT { compinv((b + j * 2), *(ao + j * 2), *(ao + j * 2 + 1)); - VLSEG2_FLOAT(&va0, &va1, ao, vl); + vax2 = VLSEG2_FLOAT(ao, vl); vbool_cmp = VMSGTU_VX_UINT(vindex, j, vl); - VSSEG2_FLOAT_M(vbool_cmp, b, va0, va1, vl); + VSSEG2_FLOAT_M(vbool_cmp, b, vax2, vl); b += vl * 2; ao += lda * 2; @@ -96,8 +96,8 @@ int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG offset, FLOAT { if (ii < jj) { - VLSEG2_FLOAT(&va0, &va1, ao, vl); - VSSEG2_FLOAT(b, va0, va1, vl); + vax2 = VLSEG2_FLOAT(ao, vl); + VSSEG2_FLOAT(b, vax2, vl); } ao += lda * 2; b += vl * 2; diff --git a/kernel/riscv64/ztrsm_uncopy_rvv_v1.c b/kernel/riscv64/ztrsm_uncopy_rvv_v1.c index be3613429..2a158d4de 100644 --- a/kernel/riscv64/ztrsm_uncopy_rvv_v1.c +++ b/kernel/riscv64/ztrsm_uncopy_rvv_v1.c @@ -31,20 +31,20 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #if !defined(DOUBLE) #define VSETVL(n) __riscv_vsetvl_e32m2(n) -#define FLOAT_V_T vfloat32m2_t -#define VLSSEG2_FLOAT __riscv_vlsseg2e32_v_f32m2 -#define VSSEG2_FLOAT __riscv_vsseg2e32_v_f32m2 -#define VSSEG2_FLOAT_M __riscv_vsseg2e32_v_f32m2_m +#define FLOAT_VX2_T vfloat32m2x2_t +#define VLSSEG2_FLOAT __riscv_vlsseg2e32_v_f32m2x2 +#define VSSEG2_FLOAT __riscv_vsseg2e32_v_f32m2x2 +#define VSSEG2_FLOAT_M __riscv_vsseg2e32_v_f32m2x2_m #define VBOOL_T vbool16_t #define UINT_V_T vuint32m2_t #define VID_V_UINT __riscv_vid_v_u32m2 #define VMSGTU_VX_UINT __riscv_vmsgtu_vx_u32m2_b16 #else #define VSETVL(n) __riscv_vsetvl_e64m2(n) -#define FLOAT_V_T vfloat64m2_t -#define VLSSEG2_FLOAT __riscv_vlsseg2e64_v_f64m2 -#define VSSEG2_FLOAT __riscv_vsseg2e64_v_f64m2 -#define VSSEG2_FLOAT_M __riscv_vsseg2e64_v_f64m2_m +#define FLOAT_VX2_T vfloat64m2x2_t +#define VLSSEG2_FLOAT __riscv_vlsseg2e64_v_f64m2x2 +#define VSSEG2_FLOAT __riscv_vsseg2e64_v_f64m2x2 +#define VSSEG2_FLOAT_M __riscv_vsseg2e64_v_f64m2x2_m #define VBOOL_T vbool32_t #define UINT_V_T vuint64m2_t #define VID_V_UINT __riscv_vid_v_u64m2 @@ -62,7 +62,7 @@ int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG offset, FLOAT FLOAT *ao; jj = offset; - FLOAT_V_T va0, va1; + FLOAT_VX2_T vax2; VBOOL_T vbool_cmp; UINT_V_T vindex; @@ -83,9 +83,9 @@ int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG offset, FLOAT for (unsigned int j = 0; j < vl; j++) { compinv((b + j * 2), *(ao + j * lda * 2), *(ao + j * lda * 2 + 1)); - VLSSEG2_FLOAT(&va0, &va1, ao, stride_lda, vl); + vax2 = VLSSEG2_FLOAT(ao, stride_lda, vl); vbool_cmp = VMSGTU_VX_UINT(vindex, j, vl); - VSSEG2_FLOAT_M(vbool_cmp, b, va0, va1, vl); + VSSEG2_FLOAT_M(vbool_cmp, b, vax2, vl); ao += 2; b += vl * 2; } @@ -96,8 +96,8 @@ int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG offset, FLOAT { if (ii < jj) { - VLSSEG2_FLOAT(&va0, &va1, ao, stride_lda, vl); - VSSEG2_FLOAT(b, va0, va1, vl); + vax2 = VLSSEG2_FLOAT(ao, stride_lda, vl); + VSSEG2_FLOAT(b, vax2, vl); } ao += 2; b += vl * 2; diff --git a/kernel/riscv64/ztrsm_utcopy_rvv_v1.c b/kernel/riscv64/ztrsm_utcopy_rvv_v1.c index b1f5ef8f0..4b3319588 100644 --- a/kernel/riscv64/ztrsm_utcopy_rvv_v1.c +++ b/kernel/riscv64/ztrsm_utcopy_rvv_v1.c @@ -30,20 +30,20 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #if !defined(DOUBLE) #define VSETVL(n) __riscv_vsetvl_e32m2(n) -#define FLOAT_V_T vfloat32m2_t -#define VLSEG2_FLOAT __riscv_vlseg2e32_v_f32m2 -#define VSSEG2_FLOAT __riscv_vsseg2e32_v_f32m2 -#define VSSEG2_FLOAT_M __riscv_vsseg2e32_v_f32m2_m +#define FLOAT_VX2_T vfloat32m2x2_t +#define VLSEG2_FLOAT __riscv_vlseg2e32_v_f32m2x2 +#define VSSEG2_FLOAT __riscv_vsseg2e32_v_f32m2x2 +#define VSSEG2_FLOAT_M __riscv_vsseg2e32_v_f32m2x2_m #define VBOOL_T vbool16_t #define UINT_V_T vuint32m2_t #define VID_V_UINT __riscv_vid_v_u32m2 #define VMSLTU_VX_UINT __riscv_vmsltu_vx_u32m2_b16 #else #define VSETVL(n) __riscv_vsetvl_e64m2(n) -#define FLOAT_V_T vfloat64m2_t -#define VLSEG2_FLOAT __riscv_vlseg2e64_v_f64m2 -#define VSSEG2_FLOAT __riscv_vsseg2e64_v_f64m2 -#define VSSEG2_FLOAT_M __riscv_vsseg2e64_v_f64m2_m +#define FLOAT_VX2_T vfloat64m2x2_t +#define VLSEG2_FLOAT __riscv_vlseg2e64_v_f64m2x2 +#define VSSEG2_FLOAT __riscv_vsseg2e64_v_f64m2x2 +#define VSSEG2_FLOAT_M __riscv_vsseg2e64_v_f64m2x2_m #define VBOOL_T vbool32_t #define UINT_V_T vuint64m2_t #define VID_V_UINT __riscv_vid_v_u64m2 @@ -60,7 +60,7 @@ int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG offset, FLOAT FLOAT *ao; jj = offset; - FLOAT_V_T va0, va1; + FLOAT_VX2_T vax2; VBOOL_T vbool_cmp; UINT_V_T vindex; @@ -81,9 +81,9 @@ int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG offset, FLOAT vindex = VID_V_UINT(vl); for (unsigned int j = 0; j < vl; j++) { - VLSEG2_FLOAT(&va0, &va1, ao, vl); + vax2 = VLSEG2_FLOAT(ao, vl); vbool_cmp = VMSLTU_VX_UINT(vindex, j, vl); - VSSEG2_FLOAT_M(vbool_cmp, b, va0, va1, vl); + VSSEG2_FLOAT_M(vbool_cmp, b, vax2, vl); compinv((b + j * 2), *(ao + j * 2), *(ao + j * 2 + 1)); @@ -97,8 +97,8 @@ int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG offset, FLOAT { if (ii > jj) { - VLSEG2_FLOAT(&va0, &va1, ao, vl); - VSSEG2_FLOAT(b, va0, va1, vl); + vax2 = VLSEG2_FLOAT(ao, vl); + VSSEG2_FLOAT(b, vax2, vl); } ao += lda * 2; b += vl * 2; diff --git a/param.h b/param.h index c5c70b78e..d93221d28 100644 --- a/param.h +++ b/param.h @@ -3057,7 +3057,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define CGEMM_DEFAULT_UNROLL_M 8 #define CGEMM_DEFAULT_UNROLL_N 4 -#define CGEMM_DEFAULT_UNROLL_MN 16 +#define CGEMM_DEFAULT_UNROLL_MN 32 #define ZGEMM_DEFAULT_UNROLL_M 8 #define ZGEMM_DEFAULT_UNROLL_N 4 From ff41cf5c49bda6bf84950812e737b2e7bcddf139 Mon Sep 17 00:00:00 2001 From: kseniyazaytseva Date: Fri, 17 Mar 2023 14:28:26 +0300 Subject: [PATCH 068/311] Fix BLAS, BLAS-like functions and Generic RISC-V kernels * Fixed gemmt, imatcopy, zimatcopy_cnc functions * Fixed cblas_cscal testing in ctest * Removed rotmg unreacheble code * Added zero size checks --- cblas.h | 8 ++ common_interface.h | 9 ++ ctest/c_cblat1.f | 10 +- ctest/c_cblat1c.c | 6 +- interface/gemmt.c | 233 ++++++++++++++++++++++----------- interface/imatcopy.c | 8 +- interface/rotmg.c | 28 +--- interface/zimatcopy.c | 6 +- kernel/generic/zimatcopy_cnc.c | 1 - kernel/riscv64/axpby.c | 2 +- kernel/riscv64/axpy.c | 2 +- kernel/riscv64/copy.c | 2 +- kernel/riscv64/dot.c | 2 +- kernel/riscv64/swap.c | 2 +- kernel/riscv64/zaxpy.c | 2 +- kernel/riscv64/zcopy.c | 2 +- kernel/riscv64/zswap.c | 2 +- 17 files changed, 201 insertions(+), 124 deletions(-) diff --git a/cblas.h b/cblas.h index c2bdd27fa..f7d36788d 100644 --- a/cblas.h +++ b/cblas.h @@ -289,6 +289,14 @@ void cblas_zgemm(OPENBLAS_CONST enum CBLAS_ORDER Order, OPENBLAS_CONST enum CBLA void cblas_zgemm3m(OPENBLAS_CONST enum CBLAS_ORDER Order, OPENBLAS_CONST enum CBLAS_TRANSPOSE TransA, OPENBLAS_CONST enum CBLAS_TRANSPOSE TransB, OPENBLAS_CONST blasint M, OPENBLAS_CONST blasint N, OPENBLAS_CONST blasint K, OPENBLAS_CONST void *alpha, OPENBLAS_CONST void *A, OPENBLAS_CONST blasint lda, OPENBLAS_CONST void *B, OPENBLAS_CONST blasint ldb, OPENBLAS_CONST void *beta, void *C, OPENBLAS_CONST blasint ldc); +void cblas_sgemmt(OPENBLAS_CONST enum CBLAS_ORDER Order, OPENBLAS_CONST enum CBLAS_UPLO Uplo, OPENBLAS_CONST enum CBLAS_TRANSPOSE TransA, OPENBLAS_CONST enum CBLAS_TRANSPOSE TransB, OPENBLAS_CONST blasint M, OPENBLAS_CONST blasint K, + OPENBLAS_CONST float alpha, OPENBLAS_CONST float *A, OPENBLAS_CONST blasint lda, OPENBLAS_CONST float *B, OPENBLAS_CONST blasint ldb, OPENBLAS_CONST float beta, float *C, OPENBLAS_CONST blasint ldc); +void cblas_dgemmt(OPENBLAS_CONST enum CBLAS_ORDER Order, OPENBLAS_CONST enum CBLAS_UPLO Uplo, OPENBLAS_CONST enum CBLAS_TRANSPOSE TransA, OPENBLAS_CONST enum CBLAS_TRANSPOSE TransB, OPENBLAS_CONST blasint M, OPENBLAS_CONST blasint K, + OPENBLAS_CONST double alpha, OPENBLAS_CONST double *A, OPENBLAS_CONST blasint lda, OPENBLAS_CONST double *B, OPENBLAS_CONST blasint ldb, OPENBLAS_CONST double beta, double *C, OPENBLAS_CONST blasint ldc); +void cblas_cgemmt(OPENBLAS_CONST enum CBLAS_ORDER Order, OPENBLAS_CONST enum CBLAS_UPLO Uplo, OPENBLAS_CONST enum CBLAS_TRANSPOSE TransA, OPENBLAS_CONST enum CBLAS_TRANSPOSE TransB, OPENBLAS_CONST blasint M, OPENBLAS_CONST blasint K, + OPENBLAS_CONST void *alpha, OPENBLAS_CONST void *A, OPENBLAS_CONST blasint lda, OPENBLAS_CONST void *B, OPENBLAS_CONST blasint ldb, OPENBLAS_CONST void *beta, void *C, OPENBLAS_CONST blasint ldc); +void cblas_zgemmt(OPENBLAS_CONST enum CBLAS_ORDER Order, OPENBLAS_CONST enum CBLAS_UPLO Uplo, OPENBLAS_CONST enum CBLAS_TRANSPOSE TransA, OPENBLAS_CONST enum CBLAS_TRANSPOSE TransB, OPENBLAS_CONST blasint M, OPENBLAS_CONST blasint K, + OPENBLAS_CONST void *alpha, OPENBLAS_CONST void *A, OPENBLAS_CONST blasint lda, OPENBLAS_CONST void *B, OPENBLAS_CONST blasint ldb, OPENBLAS_CONST void *beta, void *C, OPENBLAS_CONST blasint ldc); void cblas_ssymm(OPENBLAS_CONST enum CBLAS_ORDER Order, OPENBLAS_CONST enum CBLAS_SIDE Side, OPENBLAS_CONST enum CBLAS_UPLO Uplo, OPENBLAS_CONST blasint M, OPENBLAS_CONST blasint N, OPENBLAS_CONST float alpha, OPENBLAS_CONST float *A, OPENBLAS_CONST blasint lda, OPENBLAS_CONST float *B, OPENBLAS_CONST blasint ldb, OPENBLAS_CONST float beta, float *C, OPENBLAS_CONST blasint ldc); diff --git a/common_interface.h b/common_interface.h index 318827920..61a82c306 100644 --- a/common_interface.h +++ b/common_interface.h @@ -498,6 +498,15 @@ void BLASFUNC(zgemm3m)(char *, char *, blasint *, blasint *, blasint *, double * void BLASFUNC(xgemm3m)(char *, char *, blasint *, blasint *, blasint *, xdouble *, xdouble *, blasint *, xdouble *, blasint *, xdouble *, xdouble *, blasint *); +void BLASFUNC(sgemmt)(char*, char *, char *, blasint *, blasint *, float *, + float *, blasint *, float *, blasint *, float *, float *, blasint *); +void BLASFUNC(dgemmt)(char*, char *, char *, blasint *, blasint *, double *, + double *, blasint *, double *, blasint *, double *, double *, blasint *); +void BLASFUNC(cgemmt)(char*, char *, char *, blasint *, blasint *, float *, + float *, blasint *, float *, blasint *, float *, float *, blasint *); +void BLASFUNC(zgemmt)(char*, char *, char *, blasint *, blasint *, double *, + double *, blasint *, double *, blasint *, double *, double *, blasint *); + int BLASFUNC(sge2mm)(char *, char *, char *, blasint *, blasint *, float *, float *, blasint *, float *, blasint *, float *, float *, blasint *); diff --git a/ctest/c_cblat1.f b/ctest/c_cblat1.f index 1a123d74d..cad7c7fa7 100644 --- a/ctest/c_cblat1.f +++ b/ctest/c_cblat1.f @@ -96,7 +96,7 @@ INTEGER ICAMAXTEST EXTERNAL SCASUMTEST, SCNRM2TEST, ICAMAXTEST * .. External Subroutines .. - EXTERNAL CSCAL, CSSCALTEST, CTEST, ITEST1, STEST1 + EXTERNAL CSCALTEST, CSSCALTEST, CTEST, ITEST1, STEST1 * .. Intrinsic Functions .. INTRINSIC MAX * .. Common blocks .. @@ -214,8 +214,8 @@ CALL STEST1(SCASUMTEST(N,CX,INCX),STRUE4(NP1), + STRUE4(NP1),SFAC) ELSE IF (ICASE.EQ.8) THEN -* .. CSCAL .. - CALL CSCAL(N,CA,CX,INCX) +* .. CSCALTEST .. + CALL CSCALTEST(N,CA,CX,INCX) CALL CTEST(LEN,CX,CTRUE5(1,NP1,INCX),CTRUE5(1,NP1,INCX), + SFAC) ELSE IF (ICASE.EQ.9) THEN @@ -236,14 +236,14 @@ * INCX = 1 IF (ICASE.EQ.8) THEN -* CSCAL +* CSCALTEST * Add a test for alpha equal to zero. CA = (0.0E0,0.0E0) DO 80 I = 1, 5 MWPCT(I) = (0.0E0,0.0E0) MWPCS(I) = (1.0E0,1.0E0) 80 CONTINUE - CALL CSCAL(5,CA,CX,INCX) + CALL CSCALTEST(5,CA,CX,INCX) CALL CTEST(5,CX,MWPCT,MWPCS,SFAC) ELSE IF (ICASE.EQ.9) THEN * CSSCALTEST diff --git a/ctest/c_cblat1c.c b/ctest/c_cblat1c.c index 8c0dd140c..af29301af 100644 --- a/ctest/c_cblat1c.c +++ b/ctest/c_cblat1c.c @@ -685,7 +685,7 @@ real *sfac; static integer i__; extern /* Subroutine */ int ctest_(); static complex mwpcs[5], mwpct[5]; - extern /* Subroutine */ int itest1_(), stest1_(); + extern /* Subroutine */ int cscaltest_(), itest1_(), stest1_(); static complex cx[8]; extern real scnrm2test_(); static integer np1; @@ -727,7 +727,7 @@ real *sfac; stest1_(&r__1, &strue4[np1 - 1], &strue4[np1 - 1], sfac); } else if (combla_1.icase == 8) { /* .. CSCAL .. */ - cscal_(&combla_1.n, &ca, cx, &combla_1.incx); + cscaltest_(&combla_1.n, &ca, cx, &combla_1.incx); ctest_(&len, cx, &ctrue5[(np1 + combla_1.incx * 5 << 3) - 48], &ctrue5[(np1 + combla_1.incx * 5 << 3) - 48], sfac); } else if (combla_1.icase == 9) { @@ -761,7 +761,7 @@ real *sfac; mwpcs[i__1].r = (float)1., mwpcs[i__1].i = (float)1.; /* L80: */ } - cscal_(&c__5, &ca, cx, &combla_1.incx); + cscaltest_(&c__5, &ca, cx, &combla_1.incx); ctest_(&c__5, cx, mwpct, mwpcs, sfac); } else if (combla_1.icase == 9) { /* CSSCALTEST */ diff --git a/interface/gemmt.c b/interface/gemmt.c index 3eed1dfe4..a4530721c 100644 --- a/interface/gemmt.c +++ b/interface/gemmt.c @@ -35,29 +35,26 @@ #include #include #include "common.h" -#ifdef FUNCTION_PROFILE -#include "functable.h" -#endif #ifndef COMPLEX #define SMP_THRESHOLD_MIN 65536.0 #ifdef XDOUBLE -#define ERROR_NAME "QGEMT " +#define ERROR_NAME "QGEMMT " #elif defined(DOUBLE) -#define ERROR_NAME "DGEMT " +#define ERROR_NAME "DGEMMT " #elif defined(BFLOAT16) -#define ERROR_NAME "SBGEMT " +#define ERROR_NAME "SBGEMMT " #else -#define ERROR_NAME "SGEMT " +#define ERROR_NAME "SGEMMT " #endif #else #define SMP_THRESHOLD_MIN 8192.0 #ifdef XDOUBLE -#define ERROR_NAME "XGEMT " +#define ERROR_NAME "XGEMMT " #elif defined(DOUBLE) -#define ERROR_NAME "ZGEMT " +#define ERROR_NAME "ZGEMMT " #else -#define ERROR_NAME "CGEMT " +#define ERROR_NAME "CGEMMT " #endif #endif @@ -68,18 +65,22 @@ #ifndef CBLAS void NAME(char *UPLO, char *TRANSA, char *TRANSB, - blasint * M, blasint * N, blasint * K, + blasint * M, blasint * K, FLOAT * Alpha, IFLOAT * a, blasint * ldA, IFLOAT * b, blasint * ldB, FLOAT * Beta, FLOAT * c, blasint * ldC) { - blasint m, n, k; + blasint m, k; blasint lda, ldb, ldc; int transa, transb, uplo; blasint info; char transA, transB, Uplo; + blasint nrowa, nrowb; +#if defined(COMPLEX) + blasint ncolb; +#endif IFLOAT *buffer; IFLOAT *aa, *bb; FLOAT *cc; @@ -92,7 +93,6 @@ void NAME(char *UPLO, char *TRANSA, char *TRANSB, PRINT_DEBUG_NAME; m = *M; - n = *N; k = *K; #if defined(COMPLEX) @@ -159,32 +159,47 @@ void NAME(char *UPLO, char *TRANSA, char *TRANSB, if (Uplo == 'L') uplo = 1; + nrowa = m; + if (transa & 1) nrowa = k; + nrowb = k; +#if defined(COMPLEX) + ncolb = m; +#endif + if (transb & 1) { + nrowb = m; +#if defined(COMPLEX) + ncolb = k; +#endif + } + info = 0; - if (uplo < 0) - info = 14; - if (ldc < m) + if (ldc < MAX(1, m)) info = 13; + if (ldb < MAX(1, nrowb)) + info = 10; + if (lda < MAX(1, nrowa)) + info = 8; if (k < 0) info = 5; - if (n < 0) - info = 4; if (m < 0) - info = 3; + info = 4; if (transb < 0) - info = 2; + info = 3; if (transa < 0) + info = 2; + if (uplo < 0) info = 1; - if (info) { + if (info != 0) { BLASFUNC(xerbla) (ERROR_NAME, &info, sizeof(ERROR_NAME)); return; } #else void CNAME(enum CBLAS_ORDER order, enum CBLAS_UPLO Uplo, - enum CBLAS_TRANSPOSE TransA, enum CBLAS_TRANSPOSE TransB, blasint M, - blasint N, blasint k, + enum CBLAS_TRANSPOSE TransA, enum CBLAS_TRANSPOSE TransB, blasint m, + blasint k, #ifndef COMPLEX FLOAT alpha, IFLOAT * A, blasint LDA, @@ -205,17 +220,23 @@ void CNAME(enum CBLAS_ORDER order, enum CBLAS_UPLO Uplo, int transa, transb, uplo; blasint info; - blasint m, n, lda, ldb; + blasint lda, ldb; FLOAT *a, *b; +#if defined(COMPLEX) + blasint nrowb, ncolb; +#endif XFLOAT *buffer; PRINT_DEBUG_CNAME; + uplo = -1; transa = -1; transb = -1; info = 0; if (order == CblasColMajor) { + if (Uplo == CblasUpper) uplo = 0; + if (Uplo == CblasLower) uplo = 1; if (TransA == CblasNoTrans) transa = 0; @@ -248,9 +269,6 @@ void CNAME(enum CBLAS_ORDER order, enum CBLAS_UPLO Uplo, transb = 3; #endif - m = M; - n = N; - a = (void *)A; b = (void *)B; lda = LDA; @@ -258,23 +276,42 @@ void CNAME(enum CBLAS_ORDER order, enum CBLAS_UPLO Uplo, info = -1; - if (ldc < m) + blasint nrowa; +#if !defined(COMPLEX) + blasint nrowb; +#endif + nrowa = m; + if (transa & 1) nrowa = k; + nrowb = k; +#if defined(COMPLEX) + ncolb = m; +#endif + if (transb & 1) { + nrowb = m; +#if defined(COMPLEX) + ncolb = k; +#endif + } + + if (ldc < MAX(1, m)) info = 13; + if (ldb < MAX(1, nrowb)) + info = 10; + if (lda < MAX(1, nrowa)) + info = 8; if (k < 0) info = 5; - if (n < 0) - info = 4; if (m < 0) - info = 3; + info = 4; if (transb < 0) - info = 2; + info = 3; if (transa < 0) + info = 2; + if (uplo < 0) info = 1; } if (order == CblasRowMajor) { - m = N; - n = M; a = (void *)B; b = (void *)A; @@ -282,6 +319,9 @@ void CNAME(enum CBLAS_ORDER order, enum CBLAS_UPLO Uplo, lda = LDB; ldb = LDA; + if (Uplo == CblasUpper) uplo = 0; + if (Uplo == CblasLower) uplo = 1; + if (TransB == CblasNoTrans) transa = 0; if (TransB == CblasTrans) @@ -315,29 +355,42 @@ void CNAME(enum CBLAS_ORDER order, enum CBLAS_UPLO Uplo, info = -1; - if (ldc < m) + blasint ncola; +#if !defined(COMPLEX) + blasint ncolb; +#endif + ncola = m; + if (transa & 1) ncola = k; + ncolb = k; +#if defined(COMPLEX) + nrowb = m; +#endif + + if (transb & 1) { +#if defined(COMPLEX) + nrowb = k; +#endif + ncolb = m; + } + + if (ldc < MAX(1,m)) info = 13; + if (ldb < MAX(1, ncolb)) + info = 8; + if (lda < MAX(1, ncola)) + info = 10; if (k < 0) info = 5; - if (n < 0) - info = 4; if (m < 0) - info = 3; + info = 4; if (transb < 0) info = 2; if (transa < 0) + info = 3; + if (uplo < 0) info = 1; - } - uplo = -1; - if (Uplo == CblasUpper) - uplo = 0; - if (Uplo == CblasLower) - uplo = 1; - if (uplo < 0) - info = 14; - if (info >= 0) { BLASFUNC(xerbla) (ERROR_NAME, &info, sizeof(ERROR_NAME)); return; @@ -407,37 +460,48 @@ void CNAME(enum CBLAS_ORDER order, enum CBLAS_UPLO Uplo, #endif - if ((m == 0) || (n == 0)) + if (m == 0) return; IDEBUG_START; - FUNCTION_PROFILE_START(); +#if defined(COMPLEX) + if (transb > 1){ +#ifndef CBLAS + IMATCOPY_K_CNC(nrowb, ncolb, (FLOAT)(1.0), (FLOAT)(0.0), b, ldb); +#else + if (order == CblasColMajor) + IMATCOPY_K_CNC(nrowb, ncolb, (FLOAT)(1.0), (FLOAT)(0.0), b, ldb); + if (order == CblasRowMajor) + IMATCOPY_K_RNC(nrowb, ncolb, (FLOAT)(1.0), (FLOAT)(0.0), b, ldb); +#endif + } +#endif - const blasint incb = (transb == 0) ? 1 : ldb; + const blasint incb = ((transb & 1) == 0) ? 1 : ldb; if (uplo == 1) { - for (i = 0; i < n; i++) { - j = n - i; + for (i = 0; i < m; i++) { + j = m - i; l = j; #if defined(COMPLEX) aa = a + i * 2; bb = b + i * ldb * 2; - if (transa) { - l = k; + if (transa & 1) { aa = a + lda * i * 2; - bb = b + i * 2; } + if (transb & 1) + bb = b + i * 2; cc = c + i * 2 * ldc + i * 2; #else aa = a + i; bb = b + i * ldb; - if (transa) { - l = k; + if (transa & 1) { aa = a + lda * i; - bb = b + i; } + if (transb & 1) + bb = b + i; cc = c + i * ldc + i; #endif @@ -447,7 +511,7 @@ void CNAME(enum CBLAS_ORDER order, enum CBLAS_UPLO Uplo, NULL, 0); if (alpha_r == ZERO && alpha_i == ZERO) - return; + continue; #else if (beta != ONE) SCAL_K(l, 0, 0, beta, cc, 1, NULL, 0, NULL, 0); @@ -458,8 +522,6 @@ void CNAME(enum CBLAS_ORDER order, enum CBLAS_UPLO Uplo, IDEBUG_START; - FUNCTION_PROFILE_START(); - buffer_size = j + k + 128 / sizeof(FLOAT); #ifdef WINDOWS_ABI buffer_size += 160 / sizeof(FLOAT); @@ -479,20 +541,34 @@ void CNAME(enum CBLAS_ORDER order, enum CBLAS_UPLO Uplo, #endif #if defined(COMPLEX) + if (!(transa & 1)) (gemv[(int)transa]) (j, k, 0, alpha_r, alpha_i, aa, lda, bb, incb, cc, 1, buffer); + else + (gemv[(int)transa]) (k, j, 0, alpha_r, alpha_i, + aa, lda, bb, incb, cc, 1, + buffer); #else + if (!(transa & 1)) (gemv[(int)transa]) (j, k, 0, alpha, aa, lda, bb, incb, cc, 1, buffer); + else + (gemv[(int)transa]) (k, j, 0, alpha, aa, lda, + bb, incb, cc, 1, buffer); #endif #ifdef SMP } else { - + if (!(transa & 1)) (gemv_thread[(int)transa]) (j, k, alpha, aa, lda, bb, incb, cc, 1, buffer, nthreads); + else + (gemv_thread[(int)transa]) (k, j, alpha, aa, + lda, bb, incb, cc, + 1, buffer, + nthreads); } #endif @@ -501,21 +577,19 @@ void CNAME(enum CBLAS_ORDER order, enum CBLAS_UPLO Uplo, } } else { - for (i = 0; i < n; i++) { + for (i = 0; i < m; i++) { j = i + 1; l = j; #if defined COMPLEX bb = b + i * ldb * 2; - if (transa) { - l = k; + if (transb & 1) { bb = b + i * 2; } cc = c + i * 2 * ldc; #else bb = b + i * ldb; - if (transa) { - l = k; + if (transb & 1) { bb = b + i; } cc = c + i * ldc; @@ -527,7 +601,7 @@ void CNAME(enum CBLAS_ORDER order, enum CBLAS_UPLO Uplo, NULL, 0); if (alpha_r == ZERO && alpha_i == ZERO) - return; + continue; #else if (beta != ONE) SCAL_K(l, 0, 0, beta, cc, 1, NULL, 0, NULL, 0); @@ -537,8 +611,6 @@ void CNAME(enum CBLAS_ORDER order, enum CBLAS_UPLO Uplo, #endif IDEBUG_START; - FUNCTION_PROFILE_START(); - buffer_size = j + k + 128 / sizeof(FLOAT); #ifdef WINDOWS_ABI buffer_size += 160 / sizeof(FLOAT); @@ -558,32 +630,41 @@ void CNAME(enum CBLAS_ORDER order, enum CBLAS_UPLO Uplo, #endif #if defined(COMPLEX) + if (!(transa & 1)) (gemv[(int)transa]) (j, k, 0, alpha_r, alpha_i, a, lda, bb, incb, cc, 1, buffer); + else + (gemv[(int)transa]) (k, j, 0, alpha_r, alpha_i, + a, lda, bb, incb, cc, 1, + buffer); #else + if (!(transa & 1)) (gemv[(int)transa]) (j, k, 0, alpha, a, lda, bb, incb, cc, 1, buffer); + else + (gemv[(int)transa]) (k, j, 0, alpha, a, lda, bb, + incb, cc, 1, buffer); #endif #ifdef SMP } else { - + if (!(transa & 1)) (gemv_thread[(int)transa]) (j, k, alpha, a, lda, bb, incb, cc, 1, buffer, nthreads); - + else + (gemv_thread[(int)transa]) (k, j, alpha, a, lda, + bb, incb, cc, 1, + buffer, nthreads); } #endif STACK_FREE(buffer); } } - FUNCTION_PROFILE_END(COMPSIZE * COMPSIZE, - args.m * args.k + args.k * args.n + - args.m * args.n, 2 * args.m * args.n * args.k); IDEBUG_END; return; -} +} \ No newline at end of file diff --git a/interface/imatcopy.c b/interface/imatcopy.c index 91975f7f4..109280fe6 100644 --- a/interface/imatcopy.c +++ b/interface/imatcopy.c @@ -149,10 +149,10 @@ void CNAME( enum CBLAS_ORDER CORDER, enum CBLAS_TRANSPOSE CTRANS, blasint crows, #endif - if ( *lda > *ldb ) - msize = (size_t)(*lda) * (*ldb) * sizeof(FLOAT); - else - msize = (size_t)(*ldb) * (*ldb) * sizeof(FLOAT); + if ( *rows > *cols ) + msize = (size_t)(*rows) * (*ldb) * sizeof(FLOAT); + else + msize = (size_t)(*cols) * (*ldb) * sizeof(FLOAT); b = malloc(msize); if ( b == NULL ) diff --git a/interface/rotmg.c b/interface/rotmg.c index 3a5ca8f95..b8f627221 100644 --- a/interface/rotmg.c +++ b/interface/rotmg.c @@ -96,12 +96,6 @@ void CNAME(FLOAT *dd1, FLOAT *dd2, FLOAT *dx1, FLOAT dy1, FLOAT *dparam){ else { dp2 = *dd2 * dy1; - if(dp2 == ZERO) - { - dflag = -TWO; - dparam[0] = dflag; - return; - } dp1 = *dd1 * *dx1; dq2 = dp2 * dy1; dq1 = dp1 * *dx1; @@ -113,24 +107,10 @@ void CNAME(FLOAT *dd1, FLOAT *dd2, FLOAT *dx1, FLOAT dy1, FLOAT *dparam){ dh12 = dp2 / dp1; du = ONE - dh12 * dh21; - if(du > ZERO) - { - dflag = ZERO; - *dd1 = *dd1 / du; - *dd2 = *dd2 / du; - *dx1 = *dx1 * du; - } else { - dflag = -ONE; - - dh11 = ZERO; - dh12 = ZERO; - dh21 = ZERO; - dh22 = ZERO; - - *dd1 = ZERO; - *dd2 = ZERO; - *dx1 = ZERO; - } + dflag = ZERO; + *dd1 = *dd1 / du; + *dd2 = *dd2 / du; + *dx1 = *dx1 * du; } else diff --git a/interface/zimatcopy.c b/interface/zimatcopy.c index ecda5ef4e..7d73ba572 100644 --- a/interface/zimatcopy.c +++ b/interface/zimatcopy.c @@ -171,10 +171,10 @@ void CNAME( enum CBLAS_ORDER CORDER, enum CBLAS_TRANSPOSE CTRANS, blasint crows, } #endif - if ( *lda > *ldb ) - msize = (size_t)(*lda) * (*ldb) * sizeof(FLOAT) * 2; + if ( *rows > *cols ) + msize = (size_t)(*rows) * (*ldb) * sizeof(FLOAT) * 2; else - msize = (size_t)(*ldb) * (*ldb) * sizeof(FLOAT) * 2; + msize = (size_t)(*cols) * (*ldb) * sizeof(FLOAT) * 2; b = malloc(msize); if ( b == NULL ) diff --git a/kernel/generic/zimatcopy_cnc.c b/kernel/generic/zimatcopy_cnc.c index 8e772bd8a..6426cffc0 100644 --- a/kernel/generic/zimatcopy_cnc.c +++ b/kernel/generic/zimatcopy_cnc.c @@ -40,7 +40,6 @@ int CNAME(BLASLONG rows, BLASLONG cols, FLOAT alpha_r, FLOAT alpha_i, FLOAT *a, if ( rows <= 0 ) return(0); if ( cols <= 0 ) return(0); - if ( alpha_r == 1.0 && alpha_i == 0.0 ) return (0); aptr = a; lda *= 2; diff --git a/kernel/riscv64/axpby.c b/kernel/riscv64/axpby.c index 278747f75..04f9518d3 100644 --- a/kernel/riscv64/axpby.c +++ b/kernel/riscv64/axpby.c @@ -33,7 +33,7 @@ int CNAME(BLASLONG n, FLOAT alpha, FLOAT *x, BLASLONG inc_x, FLOAT beta, FLOAT * BLASLONG i=0; BLASLONG ix,iy; - if ( n < 0 ) return(0); + if ( n <= 0 ) return(0); ix = 0; iy = 0; diff --git a/kernel/riscv64/axpy.c b/kernel/riscv64/axpy.c index fb1094dd9..19d12ad3f 100644 --- a/kernel/riscv64/axpy.c +++ b/kernel/riscv64/axpy.c @@ -42,7 +42,7 @@ int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT da, FLOAT *x, BLAS BLASLONG i=0; BLASLONG ix,iy; - if ( n < 0 ) return(0); + if ( n <= 0 ) return(0); if ( da == 0.0 ) return(0); ix = 0; diff --git a/kernel/riscv64/copy.c b/kernel/riscv64/copy.c index 7b4f04f30..e79ca59af 100644 --- a/kernel/riscv64/copy.c +++ b/kernel/riscv64/copy.c @@ -41,7 +41,7 @@ int CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y) BLASLONG i=0; BLASLONG ix=0,iy=0; - if ( n < 0 ) return(0); + if ( n <= 0 ) return(0); while(i < n) { diff --git a/kernel/riscv64/dot.c b/kernel/riscv64/dot.c index 46a84ad18..bf55998ca 100644 --- a/kernel/riscv64/dot.c +++ b/kernel/riscv64/dot.c @@ -46,7 +46,7 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y) BLASLONG ix=0,iy=0; double dot = 0.0 ; - if ( n < 0 ) return(dot); + if ( n < 1 ) return(dot); while(i < n) { diff --git a/kernel/riscv64/swap.c b/kernel/riscv64/swap.c index eac621fb2..33bbeeb6a 100644 --- a/kernel/riscv64/swap.c +++ b/kernel/riscv64/swap.c @@ -41,7 +41,7 @@ int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT dummy3, FLOAT *x, BLASLONG ix=0,iy=0; FLOAT temp; - if ( n < 0 ) return(0); + if ( n <= 0 ) return(0); while(i < n) { diff --git a/kernel/riscv64/zaxpy.c b/kernel/riscv64/zaxpy.c index 1dcaeac27..18b6315cb 100644 --- a/kernel/riscv64/zaxpy.c +++ b/kernel/riscv64/zaxpy.c @@ -44,7 +44,7 @@ int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT da_r, FLOAT da_i, BLASLONG inc_x2; BLASLONG inc_y2; - if ( n < 0 ) return(0); + if ( n <= 0 ) return(0); if ( da_r == 0.0 && da_i == 0.0 ) return(0); ix = 0; diff --git a/kernel/riscv64/zcopy.c b/kernel/riscv64/zcopy.c index 07fe584c5..b0f19efd5 100644 --- a/kernel/riscv64/zcopy.c +++ b/kernel/riscv64/zcopy.c @@ -43,7 +43,7 @@ int CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y) BLASLONG inc_x2; BLASLONG inc_y2; - if ( n < 0 ) return(0); + if ( n <= 0 ) return(0); inc_x2 = 2 * inc_x; inc_y2 = 2 * inc_y; diff --git a/kernel/riscv64/zswap.c b/kernel/riscv64/zswap.c index ae4760ae0..df1402b94 100644 --- a/kernel/riscv64/zswap.c +++ b/kernel/riscv64/zswap.c @@ -45,7 +45,7 @@ int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT dummy3, FLOAT dumm BLASLONG inc_x2; BLASLONG inc_y2; - if ( n < 0 ) return(0); + if ( n <= 0 ) return(0); inc_x2 = 2 * inc_x; inc_y2 = 2 * inc_y; From 5b4df851d7581145f0aee4336f11127a3a7acc8a Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Tue, 21 Mar 2023 08:29:05 +0100 Subject: [PATCH 069/311] fix stray blank on continuation line --- interface/Makefile | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/interface/Makefile b/interface/Makefile index 6f320d8f7..a4d3f710a 100644 --- a/interface/Makefile +++ b/interface/Makefile @@ -92,8 +92,9 @@ CBLAS2OBJS = \ cgemv.$(SUFFIX) cgeru.$(SUFFIX) cgerc.$(SUFFIX) \ ctrsv.$(SUFFIX) ctrmv.$(SUFFIX) \ csyr2.$(SUFFIX) cgbmv.$(SUFFIX) \ - csbmv.$(SUFFIX) \ - cspr2.$(SUFFIX) \ + csbmv.$(SUFFIX) cspmv.$(SUFFIX) \ + cspr.$(SUFFIX) cspr2.$(SUFFIX) \ + csymv.$(SUFFIX) csyr.$(SUFFIX) \ ctbsv.$(SUFFIX) ctbmv.$(SUFFIX) \ ctpsv.$(SUFFIX) ctpmv.$(SUFFIX) \ chemv.$(SUFFIX) chbmv.$(SUFFIX) \ From 1c04df20bd9c845160b3eb2e51adaceb6f93cf8a Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Mon, 20 Mar 2023 23:04:12 +0100 Subject: [PATCH 070/311] Re-enable overriding the LAPACK SYMV,SYR,SPMV and SPR implementations --- lapack-netlib/SRC/Makefile | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/lapack-netlib/SRC/Makefile b/lapack-netlib/SRC/Makefile index 49798b0c5..5f22789bd 100644 --- a/lapack-netlib/SRC/Makefile +++ b/lapack-netlib/SRC/Makefile @@ -572,22 +572,26 @@ ALL_AUX_OBJS = xerbla.o ../INSTALL/lsame.o SLAPACKOBJS = \ sgetrf.o sgetrs.o spotrf.o sgetf2.o \ spotf2.o slaswp.o sgesv.o slauu2.o \ - slauum.o strti2.o strtri.o strtrs.o + slauum.o strti2.o strtri.o strtrs.o \ + ssymv.o ssyr.o sspmv.o sspr.o DLAPACKOBJS = \ dgetrf.o dgetrs.o dpotrf.o dgetf2.o \ dpotf2.o dlaswp.o dgesv.o dlauu2.o \ - dlauum.o dtrti2.o dtrtri.o dtrtrs.o + dlauum.o dtrti2.o dtrtri.o dtrtrs.o \ + dsymv.o dsyr.o dspmv.o dspr.o CLAPACKOBJS = \ cgetrf.o cgetrs.o cpotrf.o cgetf2.o \ cpotf2.o claswp.o cgesv.o clauu2.o \ - clauum.o ctrti2.o ctrtri.o ctrtrs.o + clauum.o ctrti2.o ctrtri.o ctrtrs.o \ + csymv.o csyr.o cspmv.o cspr.o ZLAPACKOBJS = \ zgetrf.o zgetrs.o zpotrf.o zgetf2.o \ zpotf2.o zlaswp.o zgesv.o zlauu2.o \ - zlauum.o ztrti2.o ztrtri.o ztrtrs.o + zlauum.o ztrti2.o ztrtri.o ztrtrs.o \ + zsymv.o zsyr.o zspmv.o zspr.o ALLAUX = $(filter-out $(ALL_AUX_OBJS),$(ALLAUX_O)) SLASRC = $(filter-out $(SLAPACKOBJS),$(SLASRC_O)) From 5222b5fc18829265be7ffc77e77271a18f17c005 Mon Sep 17 00:00:00 2001 From: kseniyazaytseva Date: Thu, 12 Oct 2023 22:06:00 +0300 Subject: [PATCH 071/311] Added axpby kernels for GENERIC RISC-V target --- kernel/riscv64/KERNEL.RISCV64_GENERIC | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/kernel/riscv64/KERNEL.RISCV64_GENERIC b/kernel/riscv64/KERNEL.RISCV64_GENERIC index 61a8a2b91..15bcd2289 100644 --- a/kernel/riscv64/KERNEL.RISCV64_GENERIC +++ b/kernel/riscv64/KERNEL.RISCV64_GENERIC @@ -45,6 +45,11 @@ DAXPYKERNEL = ../riscv64/axpy.c CAXPYKERNEL = ../riscv64/zaxpy.c ZAXPYKERNEL = ../riscv64/zaxpy.c +SAXPBYKERNEL = ../riscv64/axpby.c +DAXPBYKERNEL = ../riscv64/axpby.c +CAXPBYKERNEL = ../riscv64/zaxpby.c +ZAXPBYKERNEL = ../riscv64/zaxpby.c + SCOPYKERNEL = ../riscv64/copy.c DCOPYKERNEL = ../riscv64/copy.c CCOPYKERNEL = ../riscv64/zcopy.c From f1291614536d7d1bec6508fda9b0c56dd7286bb3 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Tue, 21 Mar 2023 07:43:03 +0100 Subject: [PATCH 072/311] restore C/Z SPMV, SPR, SYR,SYMV --- interface/Makefile | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/interface/Makefile b/interface/Makefile index a4d3f710a..3db4b2b6d 100644 --- a/interface/Makefile +++ b/interface/Makefile @@ -122,8 +122,9 @@ ZBLAS2OBJS = \ zgemv.$(SUFFIX) zgeru.$(SUFFIX) zgerc.$(SUFFIX) \ ztrsv.$(SUFFIX) ztrmv.$(SUFFIX) \ zsyr2.$(SUFFIX) zgbmv.$(SUFFIX) \ - zsbmv.$(SUFFIX) \ - zspr2.$(SUFFIX) \ + zsbmv.$(SUFFIX) zspmv.$(SUFFIX) \ + zspr.$(SUFFIX) zspr2.$(SUFFIX) \ + zsymv.$(SUFFIX) zsyr.$(SUFFIX) \ ztbsv.$(SUFFIX) ztbmv.$(SUFFIX) \ ztpsv.$(SUFFIX) ztpmv.$(SUFFIX) \ zhemv.$(SUFFIX) zhbmv.$(SUFFIX) \ From 85548e66ca25228a73ec08c257d5d92108b94b62 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Tue, 28 Mar 2023 16:33:09 +0200 Subject: [PATCH 073/311] Fix build failures seen with the NO_LAPACK option - cspr/csymv/csyr belong on the LAPACK list --- interface/Makefile | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) diff --git a/interface/Makefile b/interface/Makefile index 3db4b2b6d..6f320d8f7 100644 --- a/interface/Makefile +++ b/interface/Makefile @@ -92,9 +92,8 @@ CBLAS2OBJS = \ cgemv.$(SUFFIX) cgeru.$(SUFFIX) cgerc.$(SUFFIX) \ ctrsv.$(SUFFIX) ctrmv.$(SUFFIX) \ csyr2.$(SUFFIX) cgbmv.$(SUFFIX) \ - csbmv.$(SUFFIX) cspmv.$(SUFFIX) \ - cspr.$(SUFFIX) cspr2.$(SUFFIX) \ - csymv.$(SUFFIX) csyr.$(SUFFIX) \ + csbmv.$(SUFFIX) \ + cspr2.$(SUFFIX) \ ctbsv.$(SUFFIX) ctbmv.$(SUFFIX) \ ctpsv.$(SUFFIX) ctpmv.$(SUFFIX) \ chemv.$(SUFFIX) chbmv.$(SUFFIX) \ @@ -122,9 +121,8 @@ ZBLAS2OBJS = \ zgemv.$(SUFFIX) zgeru.$(SUFFIX) zgerc.$(SUFFIX) \ ztrsv.$(SUFFIX) ztrmv.$(SUFFIX) \ zsyr2.$(SUFFIX) zgbmv.$(SUFFIX) \ - zsbmv.$(SUFFIX) zspmv.$(SUFFIX) \ - zspr.$(SUFFIX) zspr2.$(SUFFIX) \ - zsymv.$(SUFFIX) zsyr.$(SUFFIX) \ + zsbmv.$(SUFFIX) \ + zspr2.$(SUFFIX) \ ztbsv.$(SUFFIX) ztbmv.$(SUFFIX) \ ztpsv.$(SUFFIX) ztpmv.$(SUFFIX) \ zhemv.$(SUFFIX) zhbmv.$(SUFFIX) \ From f7cf637d7aad0990625f41f83db74446a5908509 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Tue, 28 Mar 2023 18:31:04 +0200 Subject: [PATCH 074/311] redo lost edit --- interface/Makefile | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/interface/Makefile b/interface/Makefile index 6f320d8f7..275b71a1c 100644 --- a/interface/Makefile +++ b/interface/Makefile @@ -445,7 +445,8 @@ QLAPACKOBJS = \ CLAPACKOBJS = \ cgetrf.$(SUFFIX) cgetrs.$(SUFFIX) cpotrf.$(SUFFIX) cgetf2.$(SUFFIX) \ cpotf2.$(SUFFIX) claswp.$(SUFFIX) cgesv.$(SUFFIX) clauu2.$(SUFFIX) \ - clauum.$(SUFFIX) ctrti2.$(SUFFIX) ctrtri.$(SUFFIX) ctrtrs.$(SUFFIX) + clauum.$(SUFFIX) ctrti2.$(SUFFIX) ctrtri.$(SUFFIX) ctrtrs.$(SUFFIX) \ + cspr.$(SUFFIX) cspmv.$(SUFFIX) csymv.$(SUFFIX) csyr.$(SUFFIX) #ZLAPACKOBJS = \ # zgetrf.$(SUFFIX) zgetrs.$(SUFFIX) zpotrf.$(SUFFIX) zgetf2.$(SUFFIX) \ @@ -456,8 +457,8 @@ CLAPACKOBJS = \ ZLAPACKOBJS = \ zgetrf.$(SUFFIX) zgetrs.$(SUFFIX) zpotrf.$(SUFFIX) zgetf2.$(SUFFIX) \ zpotf2.$(SUFFIX) zlaswp.$(SUFFIX) zgesv.$(SUFFIX) zlauu2.$(SUFFIX) \ - zlauum.$(SUFFIX) ztrti2.$(SUFFIX) ztrtri.$(SUFFIX) ztrtrs.$(SUFFIX) - + zlauum.$(SUFFIX) ztrti2.$(SUFFIX) ztrtri.$(SUFFIX) ztrtrs.$(SUFFIX) \ + zspr.$(SUFFIX) zspmv.$(SUFFIX) zsymv.$(SUFFIX) zsyr.$(SUFFIX) XLAPACKOBJS = \ xgetf2.$(SUFFIX) xgetrf.$(SUFFIX) xlauu2.$(SUFFIX) xlauum.$(SUFFIX) \ From f89e0034a479016ab5d9e1681abf07dab7f8cf38 Mon Sep 17 00:00:00 2001 From: kseniyazaytseva Date: Wed, 20 Dec 2023 21:20:30 +0300 Subject: [PATCH 075/311] Fix LAPACK usage from BLAS --- interface/Makefile | 7 +++---- lapack-netlib/SRC/Makefile | 12 ++++-------- 2 files changed, 7 insertions(+), 12 deletions(-) diff --git a/interface/Makefile b/interface/Makefile index 275b71a1c..6f320d8f7 100644 --- a/interface/Makefile +++ b/interface/Makefile @@ -445,8 +445,7 @@ QLAPACKOBJS = \ CLAPACKOBJS = \ cgetrf.$(SUFFIX) cgetrs.$(SUFFIX) cpotrf.$(SUFFIX) cgetf2.$(SUFFIX) \ cpotf2.$(SUFFIX) claswp.$(SUFFIX) cgesv.$(SUFFIX) clauu2.$(SUFFIX) \ - clauum.$(SUFFIX) ctrti2.$(SUFFIX) ctrtri.$(SUFFIX) ctrtrs.$(SUFFIX) \ - cspr.$(SUFFIX) cspmv.$(SUFFIX) csymv.$(SUFFIX) csyr.$(SUFFIX) + clauum.$(SUFFIX) ctrti2.$(SUFFIX) ctrtri.$(SUFFIX) ctrtrs.$(SUFFIX) #ZLAPACKOBJS = \ # zgetrf.$(SUFFIX) zgetrs.$(SUFFIX) zpotrf.$(SUFFIX) zgetf2.$(SUFFIX) \ @@ -457,8 +456,8 @@ CLAPACKOBJS = \ ZLAPACKOBJS = \ zgetrf.$(SUFFIX) zgetrs.$(SUFFIX) zpotrf.$(SUFFIX) zgetf2.$(SUFFIX) \ zpotf2.$(SUFFIX) zlaswp.$(SUFFIX) zgesv.$(SUFFIX) zlauu2.$(SUFFIX) \ - zlauum.$(SUFFIX) ztrti2.$(SUFFIX) ztrtri.$(SUFFIX) ztrtrs.$(SUFFIX) \ - zspr.$(SUFFIX) zspmv.$(SUFFIX) zsymv.$(SUFFIX) zsyr.$(SUFFIX) + zlauum.$(SUFFIX) ztrti2.$(SUFFIX) ztrtri.$(SUFFIX) ztrtrs.$(SUFFIX) + XLAPACKOBJS = \ xgetf2.$(SUFFIX) xgetrf.$(SUFFIX) xlauu2.$(SUFFIX) xlauum.$(SUFFIX) \ diff --git a/lapack-netlib/SRC/Makefile b/lapack-netlib/SRC/Makefile index 5f22789bd..49798b0c5 100644 --- a/lapack-netlib/SRC/Makefile +++ b/lapack-netlib/SRC/Makefile @@ -572,26 +572,22 @@ ALL_AUX_OBJS = xerbla.o ../INSTALL/lsame.o SLAPACKOBJS = \ sgetrf.o sgetrs.o spotrf.o sgetf2.o \ spotf2.o slaswp.o sgesv.o slauu2.o \ - slauum.o strti2.o strtri.o strtrs.o \ - ssymv.o ssyr.o sspmv.o sspr.o + slauum.o strti2.o strtri.o strtrs.o DLAPACKOBJS = \ dgetrf.o dgetrs.o dpotrf.o dgetf2.o \ dpotf2.o dlaswp.o dgesv.o dlauu2.o \ - dlauum.o dtrti2.o dtrtri.o dtrtrs.o \ - dsymv.o dsyr.o dspmv.o dspr.o + dlauum.o dtrti2.o dtrtri.o dtrtrs.o CLAPACKOBJS = \ cgetrf.o cgetrs.o cpotrf.o cgetf2.o \ cpotf2.o claswp.o cgesv.o clauu2.o \ - clauum.o ctrti2.o ctrtri.o ctrtrs.o \ - csymv.o csyr.o cspmv.o cspr.o + clauum.o ctrti2.o ctrtri.o ctrtrs.o ZLAPACKOBJS = \ zgetrf.o zgetrs.o zpotrf.o zgetf2.o \ zpotf2.o zlaswp.o zgesv.o zlauu2.o \ - zlauum.o ztrti2.o ztrtri.o ztrtrs.o \ - zsymv.o zsyr.o zspmv.o zspr.o + zlauum.o ztrti2.o ztrtri.o ztrtrs.o ALLAUX = $(filter-out $(ALL_AUX_OBJS),$(ALLAUX_O)) SLASRC = $(filter-out $(SLAPACKOBJS),$(SLASRC_O)) From bf39c0d8b53c8899fb81a9515da91a004d25ec0b Mon Sep 17 00:00:00 2001 From: kseniyazaytseva Date: Fri, 23 Jun 2023 14:51:39 +0300 Subject: [PATCH 076/311] Added new tests for BLAS-like and BLAS API in utest --- .gitignore | 1 + utest/CMakeLists.txt | 75 + utest/Makefile | 30 +- utest/test_extensions/common.c | 259 +++ utest/test_extensions/common.h | 76 + utest/test_extensions/test_caxpby.c | 631 ++++++++ utest/test_extensions/test_caxpyc.c | 158 ++ utest/test_extensions/test_cgbmv.c | 279 ++++ utest/test_extensions/test_cgeadd.c | 880 +++++++++++ utest/test_extensions/test_cgemm.c | 273 ++++ utest/test_extensions/test_cgemmt.c | 2010 ++++++++++++++++++++++++ utest/test_extensions/test_cgemv_n.c | 340 ++++ utest/test_extensions/test_cgemv_t.c | 1132 +++++++++++++ utest/test_extensions/test_cimatcopy.c | 850 ++++++++++ utest/test_extensions/test_comatcopy.c | 728 +++++++++ utest/test_extensions/test_crot.c | 792 ++++++++++ utest/test_extensions/test_crotg.c | 290 ++++ utest/test_extensions/test_csbmv.c | 606 +++++++ utest/test_extensions/test_cscal.c | 164 ++ utest/test_extensions/test_cspmv.c | 428 +++++ utest/test_extensions/test_ctrmv.c | 266 ++++ utest/test_extensions/test_ctrsv.c | 267 ++++ utest/test_extensions/test_damin.c | 354 +++++ utest/test_extensions/test_daxpby.c | 799 ++++++++++ utest/test_extensions/test_dgeadd.c | 878 +++++++++++ utest/test_extensions/test_dgemmt.c | 1442 +++++++++++++++++ utest/test_extensions/test_dimatcopy.c | 947 +++++++++++ utest/test_extensions/test_domatcopy.c | 672 ++++++++ utest/test_extensions/test_drotmg.c | 414 +++++ utest/test_extensions/test_dsum.c | 403 +++++ utest/test_extensions/test_dzamax.c | 294 ++++ utest/test_extensions/test_dzamin.c | 310 ++++ utest/test_extensions/test_dzsum.c | 403 +++++ utest/test_extensions/test_icamin.c | 625 ++++++++ utest/test_extensions/test_idamin.c | 787 ++++++++++ utest/test_extensions/test_isamin.c | 787 ++++++++++ utest/test_extensions/test_izamin.c | 625 ++++++++ utest/test_extensions/test_samin.c | 354 +++++ utest/test_extensions/test_saxpby.c | 794 ++++++++++ utest/test_extensions/test_scamax.c | 294 ++++ utest/test_extensions/test_scamin.c | 310 ++++ utest/test_extensions/test_scsum.c | 403 +++++ utest/test_extensions/test_sgeadd.c | 880 +++++++++++ utest/test_extensions/test_sgemmt.c | 1442 +++++++++++++++++ utest/test_extensions/test_simatcopy.c | 947 +++++++++++ utest/test_extensions/test_somatcopy.c | 672 ++++++++ utest/test_extensions/test_srotmg.c | 414 +++++ utest/test_extensions/test_ssum.c | 403 +++++ utest/test_extensions/test_zaxpby.c | 630 ++++++++ utest/test_extensions/test_zaxpyc.c | 159 ++ utest/test_extensions/test_zgbmv.c | 280 ++++ utest/test_extensions/test_zgeadd.c | 880 +++++++++++ utest/test_extensions/test_zgemm.c | 273 ++++ utest/test_extensions/test_zgemmt.c | 2010 ++++++++++++++++++++++++ utest/test_extensions/test_zgemv_n.c | 341 ++++ utest/test_extensions/test_zgemv_t.c | 1136 +++++++++++++ utest/test_extensions/test_zimatcopy.c | 850 ++++++++++ utest/test_extensions/test_zomatcopy.c | 745 +++++++++ utest/test_extensions/test_zrot.c | 790 ++++++++++ utest/test_extensions/test_zrotg.c | 290 ++++ utest/test_extensions/test_zsbmv.c | 606 +++++++ utest/test_extensions/test_zscal.c | 165 ++ utest/test_extensions/test_zspmv.c | 427 +++++ utest/test_extensions/test_ztrmv.c | 266 ++++ utest/test_extensions/test_ztrsv.c | 267 ++++ utest/test_extensions/xerbla.c | 88 ++ 66 files changed, 37387 insertions(+), 4 deletions(-) create mode 100644 utest/test_extensions/common.c create mode 100644 utest/test_extensions/common.h create mode 100644 utest/test_extensions/test_caxpby.c create mode 100644 utest/test_extensions/test_caxpyc.c create mode 100644 utest/test_extensions/test_cgbmv.c create mode 100644 utest/test_extensions/test_cgeadd.c create mode 100644 utest/test_extensions/test_cgemm.c create mode 100644 utest/test_extensions/test_cgemmt.c create mode 100644 utest/test_extensions/test_cgemv_n.c create mode 100644 utest/test_extensions/test_cgemv_t.c create mode 100644 utest/test_extensions/test_cimatcopy.c create mode 100644 utest/test_extensions/test_comatcopy.c create mode 100644 utest/test_extensions/test_crot.c create mode 100644 utest/test_extensions/test_crotg.c create mode 100644 utest/test_extensions/test_csbmv.c create mode 100644 utest/test_extensions/test_cscal.c create mode 100644 utest/test_extensions/test_cspmv.c create mode 100644 utest/test_extensions/test_ctrmv.c create mode 100644 utest/test_extensions/test_ctrsv.c create mode 100644 utest/test_extensions/test_damin.c create mode 100644 utest/test_extensions/test_daxpby.c create mode 100644 utest/test_extensions/test_dgeadd.c create mode 100644 utest/test_extensions/test_dgemmt.c create mode 100644 utest/test_extensions/test_dimatcopy.c create mode 100644 utest/test_extensions/test_domatcopy.c create mode 100644 utest/test_extensions/test_drotmg.c create mode 100644 utest/test_extensions/test_dsum.c create mode 100644 utest/test_extensions/test_dzamax.c create mode 100644 utest/test_extensions/test_dzamin.c create mode 100644 utest/test_extensions/test_dzsum.c create mode 100644 utest/test_extensions/test_icamin.c create mode 100644 utest/test_extensions/test_idamin.c create mode 100644 utest/test_extensions/test_isamin.c create mode 100644 utest/test_extensions/test_izamin.c create mode 100644 utest/test_extensions/test_samin.c create mode 100644 utest/test_extensions/test_saxpby.c create mode 100644 utest/test_extensions/test_scamax.c create mode 100644 utest/test_extensions/test_scamin.c create mode 100644 utest/test_extensions/test_scsum.c create mode 100644 utest/test_extensions/test_sgeadd.c create mode 100644 utest/test_extensions/test_sgemmt.c create mode 100644 utest/test_extensions/test_simatcopy.c create mode 100644 utest/test_extensions/test_somatcopy.c create mode 100644 utest/test_extensions/test_srotmg.c create mode 100644 utest/test_extensions/test_ssum.c create mode 100644 utest/test_extensions/test_zaxpby.c create mode 100644 utest/test_extensions/test_zaxpyc.c create mode 100644 utest/test_extensions/test_zgbmv.c create mode 100644 utest/test_extensions/test_zgeadd.c create mode 100644 utest/test_extensions/test_zgemm.c create mode 100644 utest/test_extensions/test_zgemmt.c create mode 100644 utest/test_extensions/test_zgemv_n.c create mode 100644 utest/test_extensions/test_zgemv_t.c create mode 100644 utest/test_extensions/test_zimatcopy.c create mode 100644 utest/test_extensions/test_zomatcopy.c create mode 100644 utest/test_extensions/test_zrot.c create mode 100644 utest/test_extensions/test_zrotg.c create mode 100644 utest/test_extensions/test_zsbmv.c create mode 100644 utest/test_extensions/test_zscal.c create mode 100644 utest/test_extensions/test_zspmv.c create mode 100644 utest/test_extensions/test_ztrmv.c create mode 100644 utest/test_extensions/test_ztrsv.c create mode 100644 utest/test_extensions/xerbla.c diff --git a/.gitignore b/.gitignore index 0fe20ecaa..e3e783c46 100644 --- a/.gitignore +++ b/.gitignore @@ -46,6 +46,7 @@ config_last.h getarch getarch_2nd utest/openblas_utest +utest/openblas_utest_ext ctest/xccblat1 ctest/xccblat2 ctest/xccblat3 diff --git a/utest/CMakeLists.txt b/utest/CMakeLists.txt index 2e32827d3..d78701707 100644 --- a/utest/CMakeLists.txt +++ b/utest/CMakeLists.txt @@ -18,6 +18,69 @@ else () ) endif () + +set(DIR_EXT test_extensions) +set(OpenBLAS_utest_ext_src +utest_main.c +${DIR_EXT}/xerbla.c +${DIR_EXT}/test_isamin.c +${DIR_EXT}/test_idamin.c +${DIR_EXT}/test_icamin.c +${DIR_EXT}/test_izamin.c +${DIR_EXT}/test_ssum.c +${DIR_EXT}/test_dsum.c +${DIR_EXT}/test_scsum.c +${DIR_EXT}/test_dzsum.c +${DIR_EXT}/test_samin.c +${DIR_EXT}/test_damin.c +${DIR_EXT}/test_scamin.c +${DIR_EXT}/test_dzamin.c +${DIR_EXT}/test_scamax.c +${DIR_EXT}/test_dzamax.c +${DIR_EXT}/test_zrotg.c +${DIR_EXT}/test_crotg.c +$(DIR_EXT)/test_drotmg.c +$(DIR_EXT)/test_srotmg.c +$(DIR_EXT)/test_zscal.c +$(DIR_EXT)/test_cscal.c +$(DIR_EXT)/test_domatcopy.c +$(DIR_EXT)/test_somatcopy.c +$(DIR_EXT)/test_zomatcopy.c +$(DIR_EXT)/test_comatcopy.c +${DIR_EXT}/test_simatcopy.c +${DIR_EXT}/test_dimatcopy.c +${DIR_EXT}/test_cimatcopy.c +${DIR_EXT}/test_zimatcopy.c +${DIR_EXT}/test_sgeadd.c +${DIR_EXT}/test_dgeadd.c +${DIR_EXT}/test_cgeadd.c +${DIR_EXT}/test_zgeadd.c +${DIR_EXT}/test_saxpby.c +${DIR_EXT}/test_daxpby.c +${DIR_EXT}/test_caxpby.c +${DIR_EXT}/test_zaxpby.c +${DIR_EXT}/test_caxpyc.c +${DIR_EXT}/test_zaxpyc.c +$(DIR_EXT)/test_cgemv_t.c +$(DIR_EXT)/test_zgemv_t.c +$(DIR_EXT)/test_cgemv_n.c +$(DIR_EXT)/test_zgemv_n.c +${DIR_EXT}/test_crot.c +${DIR_EXT}/test_zrot.c +${DIR_EXT}/test_cgbmv.c +${DIR_EXT}/test_zgbmv.c +${DIR_EXT}/test_dgemmt.c +${DIR_EXT}/test_sgemmt.c +${DIR_EXT}/test_cgemmt.c +${DIR_EXT}/test_zgemmt.c +${DIR_EXT}/test_ztrmv.c +${DIR_EXT}/test_ctrmv.c +$(DIR_EXT)/test_ztrsv.c +$(DIR_EXT)/test_ctrsv.c +$(DIR_EXT)/test_zgemm.c +$(DIR_EXT)/test_cgemm.c +) + # crashing on travis cl with an error code suggesting resource not found if (NOT MSVC) set(OpenBLAS_utest_src @@ -46,6 +109,13 @@ set(OpenBLAS_utest_src ${OpenBLAS_utest_src} test_potrs.c ) +set(OpenBLAS_utest_ext_src + ${OpenBLAS_utest_ext_src} + ${DIR_EXT}/test_cspmv.c + ${DIR_EXT}/test_zspmv.c + ${DIR_EXT}/test_csbmv.c + ${DIR_EXT}/test_zsbmv.c + ) if (NOT NO_CBLAS AND NOT NO_LAPACKE) set(OpenBLAS_utest_src ${OpenBLAS_utest_src} @@ -57,7 +127,11 @@ endif() set(OpenBLAS_utest_bin openblas_utest) add_executable(${OpenBLAS_utest_bin} ${OpenBLAS_utest_src}) +set(OpenBLAS_utest_ext_bin openblas_utest_ext) +add_executable(${OpenBLAS_utest_ext_bin} ${OpenBLAS_utest_ext_src}) + target_link_libraries(${OpenBLAS_utest_bin} ${OpenBLAS_LIBNAME}) +target_link_libraries(${OpenBLAS_utest_ext_bin} ${OpenBLAS_LIBNAME}) if(${CMAKE_SYSTEM_NAME} MATCHES "Linux" OR ${CMAKE_SYSTEM_NAME} MATCHES "FreeBSD" OR ${CMAKE_SYSTEM_NAME} MATCHES "QNX" ) target_link_libraries(${OpenBLAS_utest_bin} m) @@ -82,3 +156,4 @@ add_custom_command(TARGET ${OpenBLAS_utest_bin} endif() add_test(${OpenBLAS_utest_bin} ${CMAKE_CURRENT_BINARY_DIR}/${OpenBLAS_utest_bin}) +add_test(${OpenBLAS_utest_ext_bin} ${CMAKE_CURRENT_BINARY_DIR}/${OpenBLAS_utest_bin}) diff --git a/utest/Makefile b/utest/Makefile index f99035440..55561c770 100644 --- a/utest/Makefile +++ b/utest/Makefile @@ -1,21 +1,38 @@ UTEST_CHECK = 1 TOPDIR = .. +DIR_EXT=test_extensions override TARGET_ARCH= override TARGET_MACH= UTESTBIN=openblas_utest +UTESTEXTBIN=openblas_utest_ext .PHONY : all -.NOTPARALLEL : all run_test $(UTESTBIN) +.NOTPARALLEL : all run_test $(UTESTBIN) $(UTESTEXTBIN) include $(TOPDIR)/Makefile.system OBJS=utest_main.o test_min.o test_amax.o test_ismin.o test_rotmg.o test_axpy.o test_dotu.o test_dsdot.o test_swap.o test_rot.o test_dnrm2.o #test_rot.o test_swap.o test_axpy.o test_dotu.o test_dsdot.o test_fork.o +OBJS_EXT=utest_main.o $(DIR_EXT)/xerbla.o $(DIR_EXT)/common.o +OBJS_EXT+=$(DIR_EXT)/test_isamin.o $(DIR_EXT)/test_idamin.o $(DIR_EXT)/test_icamin.o $(DIR_EXT)/test_izamin.o +OBJS_EXT+=$(DIR_EXT)/test_ssum.o $(DIR_EXT)/test_dsum.o $(DIR_EXT)/test_scsum.o $(DIR_EXT)/test_dzsum.o +OBJS_EXT+=$(DIR_EXT)/test_saxpby.o $(DIR_EXT)/test_daxpby.o $(DIR_EXT)/test_caxpby.o $(DIR_EXT)/test_zaxpby.o $(DIR_EXT)/test_zaxpyc.o $(DIR_EXT)/test_caxpyc.o +OBJS_EXT+=$(DIR_EXT)/test_samin.o $(DIR_EXT)/test_damin.o $(DIR_EXT)/test_scamin.o $(DIR_EXT)/test_dzamin.o $(DIR_EXT)/test_scamax.o $(DIR_EXT)/test_dzamax.o +OBJS_EXT+=$(DIR_EXT)/test_drotmg.o $(DIR_EXT)/test_srotmg.o $(DIR_EXT)/test_zrotg.o $(DIR_EXT)/test_crotg.o $(DIR_EXT)/test_crot.o $(DIR_EXT)/test_zrot.o +OBJS_EXT+=$(DIR_EXT)/test_zscal.o $(DIR_EXT)/test_cscal.o +OBJS_EXT+=$(DIR_EXT)/test_domatcopy.o $(DIR_EXT)/test_somatcopy.o $(DIR_EXT)/test_zomatcopy.o $(DIR_EXT)/test_comatcopy.o +OBJS_EXT+=$(DIR_EXT)/test_simatcopy.o $(DIR_EXT)/test_dimatcopy.o $(DIR_EXT)/test_cimatcopy.o $(DIR_EXT)/test_zimatcopy.o +OBJS_EXT+=$(DIR_EXT)/test_sgeadd.o $(DIR_EXT)/test_dgeadd.o $(DIR_EXT)/test_cgeadd.o $(DIR_EXT)/test_zgeadd.o +OBJS_EXT+=$(DIR_EXT)/test_cgemv_t.o $(DIR_EXT)/test_zgemv_t.o $(DIR_EXT)/test_cgemv_n.o $(DIR_EXT)/test_zgemv_n.o +OBJS_EXT+=$(DIR_EXT)/test_sgemmt.o $(DIR_EXT)/test_dgemmt.o $(DIR_EXT)/test_cgemmt.o $(DIR_EXT)/test_zgemmt.o +OBJS_EXT+=$(DIR_EXT)/test_ztrmv.o $(DIR_EXT)/test_ctrmv.o $(DIR_EXT)/test_ztrsv.o $(DIR_EXT)/test_ctrsv.o +OBJS_EXT+=$(DIR_EXT)/test_zgemm.o $(DIR_EXT)/test_cgemm.o $(DIR_EXT)/test_zgbmv.o $(DIR_EXT)/test_cgbmv.o ifneq ($(NO_LAPACK), 1) OBJS += test_potrs.o +OBJS_EXT += $(DIR_EXT)/test_zspmv.o $(DIR_EXT)/test_cspmv.o $(DIR_EXT)/test_zsbmv.o $(DIR_EXT)/test_csbmv.o ifneq ($(NO_CBLAS), 1) ifneq ($(NO_LAPACKE), 1) OBJS += test_kernel_regress.o @@ -47,12 +64,17 @@ all : run_test $(UTESTBIN): $(OBJS) $(CC) $(CFLAGS) $(LDFLAGS) -o $@ $^ ../$(LIBNAME) $(EXTRALIB) $(FEXTRALIB) -run_test: $(UTESTBIN) +$(UTESTEXTBIN): $(OBJS_EXT) + $(CC) $(CFLAGS) $(LDFLAGS) -o $@ $^ ../$(LIBNAME) $(EXTRALIB) $(FEXTRALIB) + +run_test: $(UTESTBIN) $(UTESTEXTBIN) ifneq ($(CROSS), 1) ./$(UTESTBIN) + ./$(UTESTEXTBIN) endif clean: - -rm -f *.o $(UTESTBIN) + -rm -f *.o $(UTESTBIN) $(UTESTEXTBIN) + -rm -f $(DIR_EXT)/*.o -libs: +libs: \ No newline at end of file diff --git a/utest/test_extensions/common.c b/utest/test_extensions/common.c new file mode 100644 index 000000000..c3bdcefc7 --- /dev/null +++ b/utest/test_extensions/common.c @@ -0,0 +1,259 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. 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. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "common.h" + +/** + * Generate random array + */ +void srand_generate(float *alpha, blasint n) +{ + blasint i; + for (i = 0; i < n; i++) + alpha[i] = (float)rand() / (float)RAND_MAX * 5.0f; +} + +void drand_generate(double *alpha, blasint n) +{ + blasint i; + for (i = 0; i < n; i++) + alpha[i] = (double)rand() / (double)RAND_MAX * 5.0; +} + +/** + * Find difference between two rectangle matrix + * return norm of differences + */ +float smatrix_difference(float *a, float *b, blasint cols, blasint rows, blasint ld) +{ + blasint i = 0; + blasint j = 0; + blasint inc = 1; + float norm = 0.0f; + + float *a_ptr = a; + float *b_ptr = b; + + for(i = 0; i < rows; i++) + { + for (j = 0; j < cols; j++) { + a_ptr[j] -= b_ptr[j]; + } + norm += cblas_snrm2(cols, a_ptr, inc); + + a_ptr += ld; + b_ptr += ld; + } + return norm/(float)(rows); +} + +double dmatrix_difference(double *a, double *b, blasint cols, blasint rows, blasint ld) +{ + blasint i = 0; + blasint j = 0; + blasint inc = 1; + double norm = 0.0; + + double *a_ptr = a; + double *b_ptr = b; + + for(i = 0; i < rows; i++) + { + for (j = 0; j < cols; j++) { + a_ptr[j] -= b_ptr[j]; + } + norm += cblas_dnrm2(cols, a_ptr, inc); + + a_ptr += ld; + b_ptr += ld; + } + return norm/(double)(rows); +} + +/** + * Complex conjugate operation for vector + * + * param n specifies number of elements in vector x + * param inc_x specifies increment of vector x + * param x_ptr specifies buffer holding vector x + */ +void cconjugate_vector(blasint n, blasint inc_x, float *x_ptr) +{ + blasint i; + inc_x *= 2; + + for (i = 0; i < n; i++) + { + x_ptr[1] *= (-1.0f); + x_ptr += inc_x; + } +} + +void zconjugate_vector(blasint n, blasint inc_x, double *x_ptr) +{ + blasint i; + inc_x *= 2; + + for (i = 0; i < n; i++) + { + x_ptr[1] *= (-1.0); + x_ptr += inc_x; + } +} + +/** + * Transpose matrix + * + * param rows specifies number of rows of A + * param cols specifies number of columns of A + * param alpha specifies scaling factor for matrix A + * param a_src - buffer holding input matrix A + * param lda_src - leading dimension of the matrix A + * param a_dst - buffer holding output matrix A + * param lda_dst - leading dimension of output matrix A + */ +void stranspose(blasint rows, blasint cols, float alpha, float *a_src, int lda_src, + float *a_dst, blasint lda_dst) +{ + blasint i, j; + for (i = 0; i != cols; i++) + { + for (j = 0; j != rows; j++) + a_dst[i*lda_dst+j] = alpha*a_src[j*lda_src+i]; + } +} + +void dtranspose(blasint rows, blasint cols, double alpha, double *a_src, int lda_src, + double *a_dst, blasint lda_dst) +{ + blasint i, j; + for (i = 0; i != cols; i++) + { + for (j = 0; j != rows; j++) + a_dst[i*lda_dst+j] = alpha*a_src[j*lda_src+i]; + } +} + +void ctranspose(blasint rows, blasint cols, float *alpha, float *a_src, int lda_src, + float *a_dst, blasint lda_dst, int conj) +{ + blasint i, j; + lda_dst *= 2; + lda_src *= 2; + for (i = 0; i != cols*2; i+=2) + { + for (j = 0; j != rows*2; j+=2){ + a_dst[(i/2)*lda_dst+j] = alpha[0] * a_src[(j/2)*lda_src+i] + conj * alpha[1] * a_src[(j/2)*lda_src+i+1]; + a_dst[(i/2)*lda_dst+j+1] = (-1.0f) * conj * alpha[0] * a_src[(j/2)*lda_src+i+1] + alpha[1] * a_src[(j/2)*lda_src+i]; + } + } +} + +void ztranspose(blasint rows, blasint cols, double *alpha, double *a_src, int lda_src, + double *a_dst, blasint lda_dst, int conj) +{ + blasint i, j; + lda_dst *= 2; + lda_src *= 2; + for (i = 0; i != cols*2; i+=2) + { + for (j = 0; j != rows*2; j+=2){ + a_dst[(i/2)*lda_dst+j] = alpha[0] * a_src[(j/2)*lda_src+i] + conj * alpha[1] * a_src[(j/2)*lda_src+i+1]; + a_dst[(i/2)*lda_dst+j+1] = (-1.0) * conj * alpha[0] * a_src[(j/2)*lda_src+i+1] + alpha[1] * a_src[(j/2)*lda_src+i]; + } + } +} + +/** + * Copy matrix from source A to destination A + * + * param rows specifies number of rows of A + * param cols specifies number of columns of A + * param alpha specifies scaling factor for matrix A + * param a_src - buffer holding input matrix A + * param lda_src - leading dimension of the matrix A + * param a_dst - buffer holding output matrix A + * param lda_dst - leading dimension of output matrix A + * param conj specifies conjugation + */ +void scopy(blasint rows, blasint cols, float alpha, float *a_src, int lda_src, + float *a_dst, blasint lda_dst) +{ + blasint i, j; + for (i = 0; i != rows; i++) + { + for (j = 0; j != cols; j++) + a_dst[i*lda_dst+j] = alpha*a_src[i*lda_src+j]; + } +} + +void dcopy(blasint rows, blasint cols, double alpha, double *a_src, int lda_src, + double *a_dst, blasint lda_dst) +{ + blasint i, j; + for (i = 0; i != rows; i++) + { + for (j = 0; j != cols; j++) + a_dst[i*lda_dst+j] = alpha*a_src[i*lda_src+j]; + } +} + +void ccopy(blasint rows, blasint cols, float *alpha, float *a_src, int lda_src, + float *a_dst, blasint lda_dst, int conj) +{ + blasint i, j; + lda_dst *= 2; + lda_src *= 2; + for (i = 0; i != rows; i++) + { + for (j = 0; j != cols*2; j+=2){ + a_dst[i*lda_dst+j] = alpha[0] * a_src[i*lda_src+j] + conj * alpha[1] * a_src[i*lda_src+j+1]; + a_dst[i*lda_dst+j+1] = (-1.0f) * conj *alpha[0] * a_src[i*lda_src+j+1] + alpha[1] * a_src[i*lda_src+j]; + } + } +} + +void zcopy(blasint rows, blasint cols, double *alpha, double *a_src, int lda_src, + double *a_dst, blasint lda_dst, int conj) +{ + blasint i, j; + lda_dst *= 2; + lda_src *= 2; + for (i = 0; i != rows; i++) + { + for (j = 0; j != cols*2; j+=2){ + a_dst[i*lda_dst+j] = alpha[0] * a_src[i*lda_src+j] + conj * alpha[1] * a_src[i*lda_src+j+1]; + a_dst[i*lda_dst+j+1] = (-1.0) * conj *alpha[0] * a_src[i*lda_src+j+1] + alpha[1] * a_src[i*lda_src+j]; + } + } +} \ No newline at end of file diff --git a/utest/test_extensions/common.h b/utest/test_extensions/common.h new file mode 100644 index 000000000..62b84325c --- /dev/null +++ b/utest/test_extensions/common.h @@ -0,0 +1,76 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. 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. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#ifndef _TEST_EXTENSION_COMMON_H_ +#define _TEST_EXTENSION_COMMON_H_ + +#include +#include + +#define TRUE 1 +#define FALSE 0 +#define INVALID -1 +#define SINGLE_TOL 1e-02f +#define DOUBLE_TOL 1e-10 + +extern int check_error(void); +extern void set_xerbla(char* current_rout, int expected_info); +extern int BLASFUNC(xerbla)(char *name, blasint *info, blasint length); + +extern void srand_generate(float *alpha, blasint n); +extern void drand_generate(double *alpha, blasint n); + +extern float smatrix_difference(float *a, float *b, blasint cols, blasint rows, blasint ld); +extern double dmatrix_difference(double *a, double *b, blasint cols, blasint rows, blasint ld); + +extern void cconjugate_vector(blasint n, blasint inc_x, float *x_ptr); +extern void zconjugate_vector(blasint n, blasint inc_x, double *x_ptr); + +extern void stranspose(blasint rows, blasint cols, float alpha, float *a_src, int lda_src, + float *a_dst, blasint lda_dst); +extern void dtranspose(blasint rows, blasint cols, double alpha, double *a_src, int lda_src, + double *a_dst, blasint lda_dst); +extern void ctranspose(blasint rows, blasint cols, float *alpha, float *a_src, int lda_src, + float *a_dst, blasint lda_dst, int conj); +extern void ztranspose(blasint rows, blasint cols, double *alpha, double *a_src, int lda_src, + double *a_dst, blasint lda_dst, int conj); + +extern void scopy(blasint rows, blasint cols, float alpha, float *a_src, int lda_src, + float *a_dst, blasint lda_dst); +extern void dcopy(blasint rows, blasint cols, double alpha, double *a_src, int lda_src, + double *a_dst, blasint lda_dst); +extern void ccopy(blasint rows, blasint cols, float *alpha, float *a_src, int lda_src, + float *a_dst, blasint lda_dst, int conj); +extern void zcopy(blasint rows, blasint cols, double *alpha, double *a_src, int lda_src, + double *a_dst, blasint lda_dst, int conj); +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_caxpby.c b/utest/test_extensions/test_caxpby.c new file mode 100644 index 000000000..221a48ac7 --- /dev/null +++ b/utest/test_extensions/test_caxpby.c @@ -0,0 +1,631 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. 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. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include "common.h" + +#define DATASIZE 100 +#define INCREMENT 2 + +struct DATA_CAXPBY { + float x_test[DATASIZE * INCREMENT * 2]; + float x_verify[DATASIZE * INCREMENT * 2]; + float y_test[DATASIZE * INCREMENT * 2]; + float y_verify[DATASIZE * INCREMENT * 2]; +}; + +#ifdef BUILD_COMPLEX +static struct DATA_CAXPBY data_caxpby; + +/** + * Fortran API specific function + * Test caxpby by comparing it with cscal and caxpy. + * Compare with the following options: + * + * param n - number of elements in vectors x and y + * param alpha - scalar alpha + * param incx - increment for the elements of x + * param beta - scalar beta + * param incy - increment for the elements of y + * return norm of difference + */ +static float check_caxpby(blasint n, float *alpha, blasint incx, float *beta, blasint incy) +{ + blasint i; + + // cscal accept only positive increments + blasint incx_abs = labs(incx); + blasint incy_abs = labs(incy); + + // Fill vectors x, y + srand_generate(data_caxpby.x_test, n * incx_abs * 2); + srand_generate(data_caxpby.y_test, n * incy_abs * 2); + + // Copy vector x for caxpy + for (i = 0; i < n * incx_abs * 2; i++) + data_caxpby.x_verify[i] = data_caxpby.x_test[i]; + + // Copy vector y for cscal + for (i = 0; i < n * incy_abs * 2; i++) + data_caxpby.y_verify[i] = data_caxpby.y_test[i]; + + // Find beta*y + BLASFUNC(cscal)(&n, beta, data_caxpby.y_verify, &incy_abs); + + // Find sum of alpha*x and beta*y + BLASFUNC(caxpy)(&n, alpha, data_caxpby.x_verify, &incx, + data_caxpby.y_verify, &incy); + + BLASFUNC(caxpby)(&n, alpha, data_caxpby.x_test, &incx, + beta, data_caxpby.y_test, &incy); + + // Find the differences between output vector caculated by caxpby and caxpy + for (i = 0; i < n * incy_abs * 2; i++) + data_caxpby.y_test[i] -= data_caxpby.y_verify[i]; + + // Find the norm of differences + return BLASFUNC(scnrm2)(&n, data_caxpby.y_test, &incy_abs); +} + +/** + * C API specific function + * Test caxpby by comparing it with cscal and caxpy. + * Compare with the following options: + * + * param n - number of elements in vectors x and y + * param alpha - scalar alpha + * param incx - increment for the elements of x + * param beta - scalar beta + * param incy - increment for the elements of y + * return norm of difference + */ +static float c_api_check_caxpby(blasint n, float *alpha, blasint incx, float *beta, blasint incy) +{ + blasint i; + + // cscal accept only positive increments + blasint incx_abs = labs(incx); + blasint incy_abs = labs(incy); + + // Fill vectors x, y + srand_generate(data_caxpby.x_test, n * incx_abs * 2); + srand_generate(data_caxpby.y_test, n * incy_abs * 2); + + // Copy vector x for caxpy + for (i = 0; i < n * incx_abs * 2; i++) + data_caxpby.x_verify[i] = data_caxpby.x_test[i]; + + // Copy vector y for cscal + for (i = 0; i < n * incy_abs * 2; i++) + data_caxpby.y_verify[i] = data_caxpby.y_test[i]; + + // Find beta*y + cblas_cscal(n, beta, data_caxpby.y_verify, incy_abs); + + // Find sum of alpha*x and beta*y + cblas_caxpy(n, alpha, data_caxpby.x_verify, incx, + data_caxpby.y_verify, incy); + + cblas_caxpby(n, alpha, data_caxpby.x_test, incx, + beta, data_caxpby.y_test, incy); + + // Find the differences between output vector caculated by caxpby and caxpy + for (i = 0; i < n * incy_abs * 2; i++) + data_caxpby.y_test[i] -= data_caxpby.y_verify[i]; + + // Find the norm of differences + return cblas_scnrm2(n, data_caxpby.y_test, incy_abs); +} + +/** + * Fortran API specific test + * Test caxpby by comparing it with cscal and caxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 1 + */ +CTEST(caxpby, inc_x_1_inc_y_1_N_100) +{ + blasint n = DATASIZE, incx = 1, incy = 1; + float alpha[] = {1.0f, 1.0f}; + float beta[] = {1.0f, 1.0f}; + + float norm = check_caxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test caxpby by comparing it with cscal and caxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 1 + */ +CTEST(caxpby, inc_x_2_inc_y_1_N_100) +{ + blasint n = DATASIZE, incx = 2, incy = 1; + float alpha[] = {2.0f, 1.0f}; + float beta[] = {1.0f, 1.0f}; + + float norm = check_caxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test caxpby by comparing it with cscal and caxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 2 + */ +CTEST(caxpby, inc_x_1_inc_y_2_N_100) +{ + blasint n = DATASIZE, incx = 1, incy = 2; + float alpha[] = {1.0f, 1.0f}; + float beta[] = {2.0f, 1.0f}; + + float norm = check_caxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test caxpby by comparing it with cscal and caxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 2 + */ +CTEST(caxpby, inc_x_2_inc_y_2_N_100) +{ + blasint n = DATASIZE, incx = 2, incy = 2; + float alpha[] = {3.0f, 1.0f}; + float beta[] = {4.0f, 3.0f}; + + float norm = check_caxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test caxpby by comparing it with cscal and caxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is -1 + * Stride of vector y is 2 + */ +CTEST(caxpby, inc_x_neg_1_inc_y_2_N_100) +{ + blasint n = DATASIZE, incx = -1, incy = 2; + float alpha[] = {5.0f, 2.2f}; + float beta[] = {4.0f, 5.0f}; + + float norm = check_caxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test caxpby by comparing it with cscal and caxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is -1 + */ +CTEST(caxpby, inc_x_2_inc_y_neg_1_N_100) +{ + blasint n = DATASIZE, incx = 2, incy = -1; + float alpha[] = {1.0f, 1.0f}; + float beta[] = {6.0f, 3.0f}; + + float norm = check_caxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test caxpby by comparing it with cscal and caxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is -2 + * Stride of vector y is -1 + */ +CTEST(caxpby, inc_x_neg_2_inc_y_neg_1_N_100) +{ + blasint n = DATASIZE, incx = -2, incy = -1; + float alpha[] = {7.0f, 2.0f}; + float beta[] = {3.5f, 1.3f}; + + float norm = check_caxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test caxpby by comparing it with cscal and caxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 1 + * Scalar alpha is zero + */ +CTEST(caxpby, inc_x_1_inc_y_1_N_100_alpha_zero) +{ + blasint n = DATASIZE, incx = 1, incy = 1; + float alpha[] = {0.0f, 0.0f}; + float beta[] = {1.0f, 1.0f}; + + float norm = check_caxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test caxpby by comparing it with cscal and caxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 1 + * Scalar beta is zero + */ +CTEST(caxpby, inc_x_1_inc_y_1_N_100_beta_zero) +{ + blasint n = DATASIZE, incx = 1, incy = 1; + float alpha[] = {1.0f, 1.0f}; + float beta[] = {0.0f, 0.0f}; + + float norm = check_caxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test caxpby by comparing it with cscal and caxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 1 + * Scalar alpha is zero + * Scalar beta is zero + */ +CTEST(caxpby, inc_x_1_inc_y_1_N_100_a_beta_zero) +{ + blasint n = DATASIZE, incx = 1, incy = 1; + float alpha[] = {0.0f, 0.0f}; + float beta[] = {0.0f, 0.0f}; + + float norm = check_caxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test caxpby by comparing it with cscal and caxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 2 + * Scalar alpha is zero + * Scalar beta is zero +*/ +CTEST(caxpby, inc_x_1_inc_y_2_N_100_alpha_beta_zero) +{ + blasint n = DATASIZE, incx = 1, incy = 2; + float alpha[] = {0.0f, 0.0f}; + float beta[] = {0.0f, 0.0f}; + + float norm = check_caxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Check if n - size of vectors x, y is zero + */ +CTEST(caxpby, check_n_zero) +{ + blasint n = 0, incx = 1, incy = 1; + float alpha[] = {1.0f, 1.0f}; + float beta[] = {1.0f, 1.0f}; + + float norm = check_caxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test caxpby by comparing it with cscal and caxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 1 + */ +CTEST(caxpby, c_api_inc_x_1_inc_y_1_N_100) +{ + blasint n = DATASIZE, incx = 1, incy = 1; + float alpha[] = {1.0f, 1.0f}; + float beta[] = {1.0f, 1.0f}; + + float norm = c_api_check_caxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test caxpby by comparing it with cscal and caxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 1 + */ +CTEST(caxpby, c_api_inc_x_2_inc_y_1_N_100) +{ + blasint n = DATASIZE, incx = 2, incy = 1; + float alpha[] = {2.0f, 1.0f}; + float beta[] = {1.0f, 1.0f}; + + float norm = c_api_check_caxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test caxpby by comparing it with cscal and caxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 2 + */ +CTEST(caxpby, c_api_inc_x_1_inc_y_2_N_100) +{ + blasint n = DATASIZE, incx = 1, incy = 2; + float alpha[] = {1.0f, 1.0f}; + float beta[] = {2.0f, 2.1f}; + + float norm = c_api_check_caxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test caxpby by comparing it with cscal and caxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 2 + */ +CTEST(caxpby, c_api_inc_x_2_inc_y_2_N_100) +{ + blasint n = DATASIZE, incx = 2, incy = 2; + float alpha[] = {3.0f, 2.0f}; + float beta[] = {4.0f, 3.0f}; + + float norm = c_api_check_caxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test caxpby by comparing it with cscal and caxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is -1 + * Stride of vector y is 2 + */ +CTEST(caxpby, c_api_inc_x_neg_1_inc_y_2_N_100) +{ + blasint n = DATASIZE, incx = -1, incy = 2; + float alpha[] = {5.0f, 2.0f}; + float beta[] = {4.0f, 3.1f}; + + float norm = c_api_check_caxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test caxpby by comparing it with cscal and caxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is -1 + */ +CTEST(caxpby, c_api_inc_x_2_inc_y_neg_1_N_100) +{ + blasint n = DATASIZE, incx = 2, incy = -1; + float alpha[] = {1.0f, 1.0f}; + float beta[] = {6.0f, 2.3f}; + + float norm = c_api_check_caxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test caxpby by comparing it with cscal and caxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is -2 + * Stride of vector y is -1 + */ +CTEST(caxpby, c_api_inc_x_neg_2_inc_y_neg_1_N_100) +{ + blasint n = DATASIZE, incx = -2, incy = -1; + float alpha[] = {7.0f, 1.0f}; + float beta[] = {3.5f, 1.0f}; + + float norm = c_api_check_caxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test caxpby by comparing it with cscal and caxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 1 + * Scalar alpha is zero + */ +CTEST(caxpby, c_api_inc_x_1_inc_y_1_N_100_alpha_zero) +{ + blasint n = DATASIZE, incx = 1, incy = 1; + float alpha[] = {0.0f, 0.0f}; + float beta[] = {1.0f, 1.0f}; + + float norm = c_api_check_caxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test caxpby by comparing it with cscal and caxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 1 + * Scalar beta is zero + */ +CTEST(caxpby, c_api_inc_x_1_inc_y_1_N_100_beta_zero) +{ + blasint n = DATASIZE, incx = 1, incy = 1; + float alpha[] = {1.0f, 1.0f}; + float beta[] = {0.0f, 0.0f}; + + float norm = c_api_check_caxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test caxpby by comparing it with cscal and caxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 1 + * Scalar alpha is zero + * Scalar beta is zero + */ +CTEST(caxpby, c_api_inc_x_1_inc_y_1_N_100_a_beta_zero) +{ + blasint n = DATASIZE, incx = 1, incy = 1; + float alpha[] = {0.0f, 0.0f}; + float beta[] = {0.0f, 0.0f}; + + float norm = c_api_check_caxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test caxpby by comparing it with cscal and caxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 2 + * Scalar alpha is zero + * Scalar beta is zero +*/ +CTEST(caxpby, c_api_inc_x_1_inc_y_2_N_100_alpha_beta_zero) +{ + blasint n = DATASIZE, incx = 1, incy = 2; + float alpha[] = {0.0f, 0.0f}; + float beta[] = {0.0f, 0.0f}; + + float norm = c_api_check_caxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Check if n - size of vectors x, y is zero + */ +CTEST(caxpby, c_api_check_n_zero) +{ + blasint n = 0, incx = 1, incy = 1; + float alpha[] = {1.0f, 1.0f}; + float beta[] = {1.0f, 1.0f}; + + float norm = c_api_check_caxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} +#endif diff --git a/utest/test_extensions/test_caxpyc.c b/utest/test_extensions/test_caxpyc.c new file mode 100644 index 000000000..ed1899e57 --- /dev/null +++ b/utest/test_extensions/test_caxpyc.c @@ -0,0 +1,158 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. 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. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include "common.h" + +#define DATASIZE 100 +#define INCREMENT 2 + +struct DATA_CAXPYC { + float x_test[DATASIZE * INCREMENT * 2]; + float x_verify[DATASIZE * INCREMENT * 2]; + float y_test[DATASIZE * INCREMENT * 2]; + float y_verify[DATASIZE * INCREMENT * 2]; +}; + +#ifdef BUILD_COMPLEX +static struct DATA_CAXPYC data_caxpyc; + +/** + * Test caxpyc by conjugating vector x and comparing with caxpy. + * Compare with the following options: + * + * param n - number of elements in vectors x and y + * param alpha - scalar alpha + * param incx - increment for the elements of x + * param incy - increment for the elements of y + * return norm of difference + */ +static float check_caxpyc(blasint n, float *alpha, blasint incx, blasint incy) +{ + blasint i; + + srand_generate(data_caxpyc.x_test, n * incx * 2); + srand_generate(data_caxpyc.y_test, n * incy * 2); + + for (i = 0; i < n * incx * 2; i++) + data_caxpyc.x_verify[i] = data_caxpyc.x_test[i]; + + for (i = 0; i < n * incy * 2; i++) + data_caxpyc.y_verify[i] = data_caxpyc.y_test[i]; + + cconjugate_vector(n, incx, data_caxpyc.x_verify); + + BLASFUNC(caxpy)(&n, alpha, data_caxpyc.x_verify, &incx, + data_caxpyc.y_verify, &incy); + + BLASFUNC(caxpyc)(&n, alpha, data_caxpyc.x_test, &incx, + data_caxpyc.y_test, &incy); + + for (i = 0; i < n * incy * 2; i++) + data_caxpyc.y_verify[i] -= data_caxpyc.y_test[i]; + + return BLASFUNC(scnrm2)(&n, data_caxpyc.y_verify, &incy); +} + +/** + * Test caxpyc by conjugating vector x and comparing with caxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 1 + */ +CTEST(caxpyc, conj_strides_one) +{ + blasint n = DATASIZE, incx = 1, incy = 1; + float alpha[] = {5.0f, 2.2f}; + + float norm = check_caxpyc(n, alpha, incx, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Test caxpyc by conjugating vector x and comparing with caxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 2 + */ +CTEST(caxpyc, conj_incx_one) +{ + blasint n = DATASIZE, incx = 1, incy = 2; + float alpha[] = {5.0f, 2.2f}; + + float norm = check_caxpyc(n, alpha, incx, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Test caxpyc by conjugating vector x and comparing with caxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 1 + */ +CTEST(caxpyc, conj_incy_one) +{ + blasint n = DATASIZE, incx = 2, incy = 1; + float alpha[] = {5.0f, 2.2f}; + + float norm = check_caxpyc(n, alpha, incx, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Test caxpyc by conjugating vector x and comparing with caxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 2 + */ +CTEST(caxpyc, conj_strides_two) +{ + blasint n = DATASIZE, incx = 2, incy = 2; + float alpha[] = {5.0f, 2.2f}; + + float norm = check_caxpyc(n, alpha, incx, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} +#endif diff --git a/utest/test_extensions/test_cgbmv.c b/utest/test_extensions/test_cgbmv.c new file mode 100644 index 000000000..8e0640c5d --- /dev/null +++ b/utest/test_extensions/test_cgbmv.c @@ -0,0 +1,279 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. 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. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include "common.h" + +#define DATASIZE 100 +#define INCREMENT 1 + +struct DATA_CGBMV { + float a_test[DATASIZE * DATASIZE * 2]; + float a_band_storage[DATASIZE * DATASIZE * 2]; + float matrix[DATASIZE * DATASIZE * 2]; + float b_test[DATASIZE * 2 * INCREMENT]; + float c_test[DATASIZE * 2 * INCREMENT]; + float c_verify[DATASIZE * 2 * INCREMENT]; +}; + +#ifdef BUILD_COMPLEX +static struct DATA_CGBMV data_cgbmv; + +/** + * Transform full-storage band matrix A to band-packed storage mode. + * + * param m - number of rows of A + * param n - number of columns of A + * param kl - number of sub-diagonals of the matrix A + * param ku - number of super-diagonals of the matrix A + * output param a - buffer for holding band-packed matrix + * param lda - specifies the leading dimension of a + * param matrix - buffer holding full-storage band matrix A + * param ldm - specifies the leading full-storage band matrix A + */ +static void transform_to_band_storage(blasint m, blasint n, blasint kl, + blasint ku, float* a, blasint lda, + float* matrix, blasint ldm) +{ + blasint i, j, k; + for (j = 0; j < n; j++) + { + k = 2 * (ku - j); + for (i = MAX(0, 2*(j - ku)); i < MIN(m, j + kl + 1) * 2; i+=2) + { + a[(k + i) + j * lda * 2] = matrix[i + j * ldm * 2]; + a[(k + i) + j * lda * 2 + 1] = matrix[i + j * ldm * 2 + 1]; + } + } +} + +/** + * Generate full-storage band matrix A with kl sub-diagonals and ku super-diagonals + * + * param m - number of rows of A + * param n - number of columns of A + * param kl - number of sub-diagonals of the matrix A + * param ku - number of super-diagonals of the matrix A + * output param band_matrix - buffer for full-storage band matrix. + * param matrix - buffer holding input general matrix + * param ldm - specifies the leading of input general matrix +*/ +static void get_band_matrix(blasint m, blasint n, blasint kl, blasint ku, + float *band_matrix, float *matrix, blasint ldm) +{ + blasint i, j; + blasint k = 0; + for (i = 0; i < n; i++) + { + for (j = 0; j < m * 2; j += 2) + { + if ((blasint)(j/2) > kl + i || i > ku + (blasint)(j/2)) + { + band_matrix[i * ldm * 2 + j] = 0.0f; + band_matrix[i * ldm * 2 + j + 1] = 0.0f; + continue; + } + + band_matrix[i * ldm * 2 + j] = matrix[k++]; + band_matrix[i * ldm * 2 + j + 1] = matrix[k++]; + } + } +} + +/** + * Comapare results computed by cgbmv and cgemv + * since gbmv is gemv for band matrix + * + * param trans specifies op(A), the transposition operation applied to A + * param m - number of rows of A + * param n - number of columns of A + * param kl - number of sub-diagonals of the matrix A + * param ku - number of super-diagonals of the matrix A + * param alpha - scaling factor for the matrix-vector product + * param lda - specifies the leading dimension of a + * param inc_b - stride of vector b + * param beta - scaling factor for vector c + * param inc_c - stride of vector c + * return norm of differences + */ +static float check_cgbmv(char trans, blasint m, blasint n, blasint kl, blasint ku, + float *alpha, blasint lda, blasint inc_b, float *beta, blasint inc_c) +{ + blasint i; + blasint lenb, lenc; + + if(trans == 'T' || trans == 'C' || trans == 'D' || trans == 'U'){ + lenb = m; + lenc = n; + } else { + lenb = n; + lenc = m; + } + + srand_generate(data_cgbmv.matrix, m * n * 2); + srand_generate(data_cgbmv.b_test, 2 * (1 + (lenb - 1) * inc_b)); + srand_generate(data_cgbmv.c_test, 2 * (1 + (lenc - 1) * inc_c)); + + for (i = 0; i < 2 * (1 + (lenc - 1) * inc_c); i++) + data_cgbmv.c_verify[i] = data_cgbmv.c_test[i]; + + get_band_matrix(m, n, kl, ku, data_cgbmv.a_test, data_cgbmv.matrix, m); + + transform_to_band_storage(m, n, kl, ku, data_cgbmv.a_band_storage, lda, data_cgbmv.a_test, m); + + BLASFUNC(cgemv)(&trans, &m, &n, alpha, data_cgbmv.a_test, &m, data_cgbmv.b_test, + &inc_b, beta, data_cgbmv.c_verify, &inc_c); + + BLASFUNC(cgbmv)(&trans, &m, &n, &kl, &ku, alpha, data_cgbmv.a_band_storage, &lda, data_cgbmv.b_test, + &inc_b, beta, data_cgbmv.c_test, &inc_c); + + for (i = 0; i < 2 * (1 + (lenc - 1) * inc_c); i++) + data_cgbmv.c_verify[i] -= data_cgbmv.c_test[i]; + + return BLASFUNC(scnrm2)(&lenc, data_cgbmv.c_verify, &inc_c); +} + +/** + * Test cgbmv by comparing it against cgemv + * with param trans is D + */ +CTEST(cgbmv, trans_D) +{ + blasint m = 50, n = 25; + blasint inc_b = 1, inc_c = 1; + blasint kl = 20, ku = 11; + blasint lda = 50; + char trans = 'D'; + + float alpha[] = {7.0f, 1.0f}; + float beta[] = {1.5f, -1.5f}; + + float norm = check_cgbmv(trans, m, n, kl, ku, alpha, lda, inc_b, beta, inc_c); + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_TOL); +} + +/** + * Test cgbmv by comparing it against cgemv + * with param trans is O + */ +CTEST(cgbmv, trans_O) +{ + blasint m = 50, n = 25; + blasint inc_b = 1, inc_c = 1; + blasint kl = 20, ku = 10; + blasint lda = 50; + char trans = 'O'; + + float alpha[] = {7.0f, 1.0f}; + float beta[] = {1.5f, -1.5f}; + + float norm = check_cgbmv(trans, m, n, kl, ku, alpha, lda, inc_b, beta, inc_c); + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_TOL); +} + +/** + * Test cgbmv by comparing it against cgemv + * with param trans is S + */ +CTEST(cgbmv, trans_S) +{ + blasint m = 50, n = 25; + blasint inc_b = 1, inc_c = 1; + blasint kl = 6, ku = 9; + blasint lda = 50; + char trans = 'S'; + + float alpha[] = {7.0f, 1.0f}; + float beta[] = {1.5f, -1.5f}; + + float norm = check_cgbmv(trans, m, n, kl, ku, alpha, lda, inc_b, beta, inc_c); + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_TOL); +} + +/** + * Test cgbmv by comparing it against cgemv + * with param trans is U + */ +CTEST(cgbmv, trans_U) +{ + blasint m = 25, n = 50; + blasint inc_b = 1, inc_c = 1; + blasint kl = 7, ku = 11; + blasint lda = kl + ku + 1; + char trans = 'U'; + + float alpha[] = {7.0f, 1.0f}; + float beta[] = {1.5f, -1.5f}; + + float norm = check_cgbmv(trans, m, n, kl, ku, alpha, lda, inc_b, beta, inc_c); + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_TOL); +} + +/** + * Test cgbmv by comparing it against cgemv + * with param trans is C + */ +CTEST(cgbmv, trans_C) +{ + blasint m = 50, n = 25; + blasint inc_b = 1, inc_c = 1; + blasint kl = 20, ku = 11; + blasint lda = 50; + char trans = 'C'; + + float alpha[] = {7.0f, 1.0f}; + float beta[] = {1.5f, -1.5f}; + + float norm = check_cgbmv(trans, m, n, kl, ku, alpha, lda, inc_b, beta, inc_c); + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_TOL); +} + +/** + * Test cgbmv by comparing it against cgemv + * with param trans is R + */ +CTEST(cgbmv, trans_R) +{ + blasint m = 50, n = 100; + blasint inc_b = 1, inc_c = 1; + blasint kl = 20, ku = 11; + blasint lda = 50; + char trans = 'R'; + + float alpha[] = {7.0f, 1.0f}; + float beta[] = {1.5f, -1.5f}; + + float norm = check_cgbmv(trans, m, n, kl, ku, alpha, lda, inc_b, beta, inc_c); + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_TOL); +} +#endif diff --git a/utest/test_extensions/test_cgeadd.c b/utest/test_extensions/test_cgeadd.c new file mode 100644 index 000000000..0cf6cbf87 --- /dev/null +++ b/utest/test_extensions/test_cgeadd.c @@ -0,0 +1,880 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. 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. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include "common.h" + +#define N 100 +#define M 100 + +struct DATA_CGEADD { + float a_test[M * N * 2]; + float c_test[M * N * 2]; + float c_verify[M * N * 2]; +}; + +#ifdef BUILD_COMPLEX +static struct DATA_CGEADD data_cgeadd; + +/** + * cgeadd reference implementation + * + * param m - number of rows of A and C + * param n - number of columns of A and C + * param alpha - scaling factor for matrix A + * param aptr - refer to matrix A + * param lda - leading dimension of A + * param beta - scaling factor for matrix C + * param cptr - refer to matrix C + * param ldc - leading dimension of C + */ +static void cgeadd_trusted(blasint m, blasint n, float *alpha, float *aptr, + blasint lda, float *beta, float *cptr, blasint ldc) +{ + blasint i; + + lda *= 2; + ldc *= 2; + + for (i = 0; i < n; i++) + { + cblas_caxpby(m, alpha, aptr, 1, beta, cptr, 1); + aptr += lda; + cptr += ldc; + } +} + +/** + * Test cgeadd by comparing it against reference + * Compare with the following options: + * + * param api - specifies Fortran or C API + * param order - specifies whether A and C stored in + * row-major order or column-major order + * param m - number of rows of A and C + * param n - number of columns of A and C + * param alpha - scaling factor for matrix A + * param lda - leading dimension of A + * param beta - scaling factor for matrix C + * param ldc - leading dimension of C + * return norm of differences + */ +static float check_cgeadd(char api, OPENBLAS_CONST enum CBLAS_ORDER order, + blasint m, blasint n, float *alpha, blasint lda, + float *beta, blasint ldc) +{ + blasint i; + blasint cols = m, rows = n; + + if (order == CblasRowMajor) + { + rows = m; + cols = n; + } + + // Fill matrix A, C + srand_generate(data_cgeadd.a_test, lda * rows * 2); + srand_generate(data_cgeadd.c_test, ldc * rows * 2); + + // Copy matrix C for cgeadd + for (i = 0; i < ldc * rows * 2; i++) + data_cgeadd.c_verify[i] = data_cgeadd.c_test[i]; + + cgeadd_trusted(cols, rows, alpha, data_cgeadd.a_test, lda, + beta, data_cgeadd.c_verify, ldc); + + if (api == 'F') + BLASFUNC(cgeadd)(&m, &n, alpha, data_cgeadd.a_test, &lda, + beta, data_cgeadd.c_test, &ldc); + else + cblas_cgeadd(order, m, n, alpha, data_cgeadd.a_test, lda, + beta, data_cgeadd.c_test, ldc); + + // Find the differences between output matrix caculated by cgeadd and sgemm + return smatrix_difference(data_cgeadd.c_test, data_cgeadd.c_verify, cols, rows, ldc*2); +} + +/** + * Check if error function was called with expected function name + * and param info + * + * param api - specifies Fortran or C API + * param order - specifies whether A and C stored in + * row-major order or column-major order + * param m - number of rows of A and C + * param n - number of columns of A and C + * param lda - leading dimension of A + * param ldc - leading dimension of C + * param expected_info - expected invalid parameter number in cgeadd + * return TRUE if everything is ok, otherwise FALSE + */ +static int check_badargs(char api, OPENBLAS_CONST enum CBLAS_ORDER order, + blasint m, blasint n, blasint lda, + blasint ldc, int expected_info) +{ + float alpha[] = {1.0f, 1.0f}; + float beta[] = {1.0f, 1.0f}; + + set_xerbla("CGEADD ", expected_info); + + if (api == 'F') + BLASFUNC(cgeadd)(&m, &n, alpha, data_cgeadd.a_test, &lda, + beta, data_cgeadd.c_test, &ldc); + else + cblas_cgeadd(order, m, n, alpha, data_cgeadd.a_test, lda, + beta, data_cgeadd.c_test, ldc); + + return check_error(); +} + +/** + * Fortran API specific test + * Test cgeadd by comparing it against sgemm + * with the following options: + * + * For A number of rows is 100, number of colums is 100 + * For C number of rows is 100, number of colums is 100 + */ +CTEST(cgeadd, matrix_n_100_m_100) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = N; + blasint m = M; + + blasint lda = m; + blasint ldc = m; + + float alpha[] = {3.0f, 2.0f}; + float beta[] = {1.0f, 3.0f}; + + float norm = check_cgeadd('F', order, m, n, alpha, lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test cgeadd by comparing it against sgemm + * with the following options: + * + * For A number of rows is 100, number of colums is 100 + * For C number of rows is 100, number of colums is 100 + * Scalar alpha is zero (operation is C:=beta*C) + */ +CTEST(cgeadd, matrix_n_100_m_100_alpha_zero) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = N; + blasint m = M; + + blasint lda = m; + blasint ldc = m; + + float alpha[] = {0.0f, 0.0f}; + float beta[] = {2.5f, 1.0f}; + + float norm = check_cgeadd('F', order, m, n, alpha, lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test cgeadd by comparing it against sgemm + * with the following options: + * + * For A number of rows is 100, number of colums is 100 + * For C number of rows is 100, number of colums is 100 + * Scalar beta is zero (operation is C:=alpha*A) + */ +CTEST(cgeadd, matrix_n_100_m_100_beta_zero) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = N; + blasint m = M; + + blasint lda = m; + blasint ldc = m; + + float alpha[] = {3.0f, 1.5f}; + float beta[] = {0.0f, 0.0f}; + + float norm = check_cgeadd('F', order, m, n, alpha, lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test cgeadd by comparing it against sgemm + * with the following options: + * + * For A number of rows is 100, number of colums is 100 + * For C number of rows is 100, number of colums is 100 + * Scalars alpha, beta is zero (operation is C:= 0) + */ +CTEST(cgeadd, matrix_n_100_m_100_alpha_beta_zero) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = N; + blasint m = M; + + blasint lda = m; + blasint ldc = m; + + float alpha[] = {0.0f, 0.0f}; + float beta[] = {0.0f, 0.0f}; + + float norm = check_cgeadd('F', order, m, n, alpha, lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test cgeadd by comparing it against sgemm + * with the following options: + * + * For A number of rows is 50, number of colums is 100 + * For C number of rows is 50, number of colums is 100 + */ +CTEST(cgeadd, matrix_n_100_m_50) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = N; + blasint m = M / 2; + + blasint lda = m; + blasint ldc = m; + + float alpha[] = {1.0f, 1.0f}; + float beta[] = {1.0f, 1.0f}; + + float norm = check_cgeadd('F', order, m, n, alpha, lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test error function for an invalid param n - + * number of columns of A and C + * Must be at least zero. + */ +CTEST(cgeadd, xerbla_n_invalid) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = INVALID; + blasint m = 1; + + blasint lda = m; + blasint ldc = m; + + int expected_info = 2; + + int passed = check_badargs('F', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific tests + * Test error function for an invalid param m - + * number of rows of A and C + * Must be at least zero. + */ +CTEST(cgeadd, xerbla_m_invalid) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = 1; + blasint m = INVALID; + + blasint lda = 1; + blasint ldc = 1; + + int expected_info = 1; + + int passed = check_badargs('F', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param lda - + * specifies the leading dimension of A. Must be at least MAX(1, m). + */ +CTEST(cgeadd, xerbla_lda_invalid) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = 1; + blasint m = 1; + + blasint lda = INVALID; + blasint ldc = 1; + + int expected_info = 6; + + int passed = check_badargs('F', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param ldc - + * specifies the leading dimension of C. Must be at least MAX(1, m). + */ +CTEST(cgeadd, xerbla_ldc_invalid) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = 1; + blasint m = 1; + + blasint lda = 1; + blasint ldc = INVALID; + + int expected_info = 8; + + int passed = check_badargs('F', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Check if n - number of columns of A, C equal zero. + */ +CTEST(cgeadd, n_zero) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = 0; + blasint m = 1; + + blasint lda = 1; + blasint ldc = 1; + + float alpha[] = {1.0f, 1.0f}; + float beta[] = {1.0f, 1.0f}; + + float norm = check_cgeadd('F', order, m, n, alpha, lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Check if m - number of rows of A and C equal zero. + */ +CTEST(cgeadd, m_zero) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = 1; + blasint m = 0; + + blasint lda = 1; + blasint ldc = 1; + + float alpha[] = {1.0f, 1.0f}; + float beta[] = {1.0f, 1.0f}; + + float norm = check_cgeadd('F', order, m, n, alpha, lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgeadd by comparing it against sgemm + * with the following options: + * + * c api option order is column-major order + * For A number of rows is 100, number of colums is 100 + * For C number of rows is 100, number of colums is 100 + */ +CTEST(cgeadd, c_api_matrix_n_100_m_100) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = N; + blasint m = M; + + blasint lda = m; + blasint ldc = m; + + float alpha[] = {2.0f, 1.0f}; + float beta[] = {1.0f, 3.0f}; + + float norm = check_cgeadd('C', order, m, n, alpha, + lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgeadd by comparing it against sgemm + * with the following options: + * + * c api option order is row-major order + * For A number of rows is 100, number of colums is 100 + * For C number of rows is 100, number of colums is 100 + */ +CTEST(cgeadd, c_api_matrix_n_100_m_100_row_major) +{ + CBLAS_ORDER order = CblasRowMajor; + + blasint n = N; + blasint m = M; + + blasint lda = m; + blasint ldc = m; + + float alpha[] = {4.0f, 1.5f}; + float beta[] = {2.0f, 1.0f}; + + float norm = check_cgeadd('C', order, m, n, alpha, + lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgeadd by comparing it against sgemm + * with the following options: + * + * c api option order is row-major order + * For A number of rows is 50, number of colums is 100 + * For C number of rows is 50, number of colums is 100 + */ +CTEST(cgeadd, c_api_matrix_n_50_m_100_row_major) +{ + CBLAS_ORDER order = CblasRowMajor; + + blasint n = N / 2; + blasint m = M; + + blasint lda = n; + blasint ldc = n; + + float alpha[] = {3.0f, 2.5f}; + float beta[] = {1.0f, 2.0f}; + + float norm = check_cgeadd('C', order, m, n, alpha, + lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgeadd by comparing it against sgemm + * with the following options: + * + * c api option order is column-major order + * For A number of rows is 100, number of colums is 100 + * For C number of rows is 100, number of colums is 100 + * Scalar alpha is zero (operation is C:=beta*C) + */ +CTEST(cgeadd, c_api_matrix_n_100_m_100_alpha_zero) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = N; + blasint m = M; + + blasint lda = m; + blasint ldc = m; + + float alpha[] = {0.0f, 0.0f}; + float beta[] = {1.0f, 1.0f}; + + float norm = check_cgeadd('C', order, m, n, alpha, + lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgeadd by comparing it against sgemm + * with the following options: + * + * c api option order is column-major order + * For A number of rows is 100, number of colums is 100 + * For C number of rows is 100, number of colums is 100 + * Scalar beta is zero (operation is C:=alpha*A) + */ +CTEST(cgeadd, c_api_matrix_n_100_m_100_beta_zero) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = N; + blasint m = M; + + blasint lda = m; + blasint ldc = m; + + float alpha[] = {3.0f, 1.5f}; + float beta[] = {0.0f, 0.0f}; + + float norm = check_cgeadd('C', order, m, n, alpha, + lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgeadd by comparing it against sgemm + * with the following options: + * + * c api option order is column-major order + * For A number of rows is 100, number of colums is 100 + * For C number of rows is 100, number of colums is 100 + * Scalars alpha, beta is zero (operation is C:= 0) + */ +CTEST(cgeadd, c_api_matrix_n_100_m_100_alpha_beta_zero) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = N; + blasint m = M; + + blasint lda = m; + blasint ldc = m; + + float alpha[] = {0.0f, 0.0f}; + float beta[] = {0.0f, 0.0f}; + + float norm = check_cgeadd('C', order, m, n, alpha, + lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgeadd by comparing it against sgemm + * with the following options: + * + * For A number of rows is 50, number of colums is 100 + * For C number of rows is 50, number of colums is 100 + */ +CTEST(cgeadd, c_api_matrix_n_100_m_50) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = N; + blasint m = M / 2; + + blasint lda = m; + blasint ldc = m; + + float alpha[] = {2.0f, 3.0f}; + float beta[] = {2.0f, 4.0f}; + + float norm = check_cgeadd('C', order, m, n, alpha, + lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test error function for an invalid param order - + * specifies whether A and C stored in + * row-major order or column-major order + */ +CTEST(cgeadd, c_api_xerbla_invalid_order) +{ + CBLAS_ORDER order = INVALID; + + blasint n = 1; + blasint m = 1; + + blasint lda = 1; + blasint ldc = 1; + + int expected_info = 0; + + int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param n - + * number of columns of A and C. + * Must be at least zero. + * + * c api option order is column-major order + */ +CTEST(cgeadd, c_api_xerbla_n_invalid) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = INVALID; + blasint m = 1; + + blasint lda = 1; + blasint ldc = 1; + + int expected_info = 2; + + int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param n - + * number of columns of A and C. + * Must be at least zero. + * + * c api option order is row-major order + */ +CTEST(cgeadd, c_api_xerbla_n_invalid_row_major) +{ + CBLAS_ORDER order = CblasRowMajor; + + blasint n = INVALID; + blasint m = 1; + + blasint lda = 1; + blasint ldc = 1; + + int expected_info = 1; + + int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param m - + * number of rows of A and C + * Must be at least zero. + * + * c api option order is column-major order + */ +CTEST(cgeadd, c_api_xerbla_m_invalid) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = 1; + blasint m = INVALID; + + blasint lda = 1; + blasint ldc = 1; + + int expected_info = 1; + + int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param m - + * number of rows of A and C + * Must be at least zero. + * + * c api option order is row-major order + */ +CTEST(cgeadd, c_api_xerbla_m_invalid_row_major) +{ + CBLAS_ORDER order = CblasRowMajor; + + blasint n = 1; + blasint m = INVALID; + + blasint lda = 1; + blasint ldc = 1; + + int expected_info = 2; + + int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param lda - + * specifies the leading dimension of A. Must be at least MAX(1, m). + * + * c api option order is column-major order + */ +CTEST(cgeadd, c_api_xerbla_lda_invalid) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = 1; + blasint m = 1; + + blasint lda = INVALID; + blasint ldc = 1; + + int expected_info = 5; + + int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param lda - + * specifies the leading dimension of A. Must be at least MAX(1, m). + * + * c api option order is row-major order + */ +CTEST(cgeadd, c_api_xerbla_lda_invalid_row_major) +{ + CBLAS_ORDER order = CblasRowMajor; + + blasint n = 1; + blasint m = 1; + + blasint lda = INVALID; + blasint ldc = 1; + + int expected_info = 5; + + int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param ldc - + * specifies the leading dimension of C. Must be at least MAX(1, m). + * + * c api option order is column-major order + */ +CTEST(cgeadd, c_api_xerbla_ldc_invalid) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = 1; + blasint m = 1; + + blasint lda = 1; + blasint ldc = INVALID; + + int expected_info = 8; + + int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param ldc - + * specifies the leading dimension of C. Must be at least MAX(1, m). + * + * c api option order is row-major order + */ +CTEST(cgeadd, c_api_xerbla_ldc_invalid_row_major) +{ + CBLAS_ORDER order = CblasRowMajor; + + blasint n = 1; + blasint m = 1; + + blasint lda = 1; + blasint ldc = INVALID; + + int expected_info = 8; + + int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Check if n - number of columns of A, C equal zero. + * + * c api option order is column-major order + */ +CTEST(cgeadd, c_api_n_zero) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = 0; + blasint m = 1; + + blasint lda = 1; + blasint ldc = 1; + + float alpha[] = {1.0f, 1.0f}; + float beta[] = {1.0f, 1.0f}; + + float norm = check_cgeadd('C', order, m, n, alpha, + lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Check if m - number of rows of A and C equal zero. + * + * c api option order is column-major order + */ +CTEST(cgeadd, c_api_m_zero) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = 1; + blasint m = 0; + + blasint lda = 1; + blasint ldc = 1; + + float alpha[] = {1.0f, 1.0f}; + float beta[] = {1.0f, 1.0f}; + + float norm = check_cgeadd('C', order, m, n, alpha, + lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_cgemm.c b/utest/test_extensions/test_cgemm.c new file mode 100644 index 000000000..cd38d710b --- /dev/null +++ b/utest/test_extensions/test_cgemm.c @@ -0,0 +1,273 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. 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. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include +#include "common.h" + +#define DATASIZE 100 +#define INCREMENT 2 + +struct DATA_CGEMM { + float a_test[DATASIZE * DATASIZE * 2]; + float a_verify[DATASIZE * DATASIZE * 2]; + float b_test[DATASIZE * DATASIZE * 2]; + float b_verify[DATASIZE * DATASIZE * 2]; + float c_test[DATASIZE * DATASIZE * 2]; + float c_verify[DATASIZE * DATASIZE * 2]; +}; + +#ifdef BUILD_COMPLEX +static struct DATA_CGEMM data_cgemm; + +/** + * Test cgemm with the conjugate matrices by conjugating and not transposed matrices + * and comparing it with the non-conjugate cgemm. + * + * param transa specifies op(A), the transposition (conjugation) operation applied to A + * param transb specifies op(B), the transposition (conjugation) operation applied to B + * param m specifies the number of rows of the matrix op(A) and of the matrix C + * param n specifies the number of columns of the matrix op(B) and the number of columns of the matrix C + * param k specifies the number of columns of the matrix op(A) and the number of rows of the matrix op(B) + * param alpha - scaling factor for the matrix-matrix product + * param lda - leading dimension of matrix A + * param ldb - leading dimension of matrix B + * param beta - scaling factor for matrix C + * param ldc - leading dimension of matrix C + * return norm of difference + */ +static float check_cgemm(char transa, char transb, blasint m, blasint n, blasint k, + float *alpha, blasint lda, blasint ldb, float *beta, blasint ldc) +{ + blasint i; + float alpha_conj[] = {1.0f, 0.0f}; + char transa_verify = transa; + char transb_verify = transb; + + int arows = k, acols = m; + int brows = n, bcols = k; + + if (transa == 'T' || transa == 'C'){ + arows = m; acols = k; + } + + if (transb == 'T' || transb == 'C'){ + brows = k; bcols = n; + } + + srand_generate(data_cgemm.a_test, arows * lda * 2); + srand_generate(data_cgemm.b_test, brows * ldb * 2); + srand_generate(data_cgemm.c_test, n * ldc * 2); + + for (i = 0; i < arows * lda * 2; i++) + data_cgemm.a_verify[i] = data_cgemm.a_test[i]; + + for (i = 0; i < brows * ldb * 2; i++) + data_cgemm.b_verify[i] = data_cgemm.b_test[i]; + + for (i = 0; i < n * ldc * 2; i++) + data_cgemm.c_verify[i] = data_cgemm.c_test[i]; + + if (transa == 'R'){ + cblas_cimatcopy(CblasColMajor, CblasConjNoTrans, arows, acols, alpha_conj, data_cgemm.a_verify, lda, lda); + transa_verify = 'N'; + } + + if (transb == 'R'){ + cblas_cimatcopy(CblasColMajor, CblasConjNoTrans, brows, bcols, alpha_conj, data_cgemm.b_verify, ldb, ldb); + transb_verify = 'N'; + } + + BLASFUNC(cgemm)(&transa_verify, &transb_verify, &m, &n, &k, alpha, data_cgemm.a_verify, &lda, + data_cgemm.b_verify, &ldb, beta, data_cgemm.c_verify, &ldc); + + BLASFUNC(cgemm)(&transa, &transb, &m, &n, &k, alpha, data_cgemm.a_test, &lda, + data_cgemm.b_test, &ldb, beta, data_cgemm.c_test, &ldc); + + return smatrix_difference(data_cgemm.c_test, data_cgemm.c_verify, m, n, ldc*2); +} + +/** + * Test cgemm with the conjugate matrices by conjugating and not transposed matrices + * and comparing it with the non-conjugate cgemm. + * Test with the following options: + * + * matrix A is conjugate and transposed + * matrix B is conjugate and not transposed + */ +CTEST(cgemm, conjtransa_conjnotransb) +{ + blasint n = DATASIZE, m = DATASIZE, k = DATASIZE; + blasint lda = DATASIZE, ldb = DATASIZE, ldc = DATASIZE; + char transa = 'C'; + char transb = 'R'; + float alpha[] = {-2.0, 1.0f}; + float beta[] = {1.0f, -1.0f}; + + float norm = check_cgemm(transa, transb, m, n, k, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Test cgemm with the conjugate matrices by conjugating and not transposed matrices + * and comparing it with the non-conjugate cgemm. + * Test with the following options: + * + * matrix A is not conjugate and not transposed + * matrix B is conjugate and not transposed + */ +CTEST(cgemm, notransa_conjnotransb) +{ + blasint n = DATASIZE, m = DATASIZE, k = DATASIZE; + blasint lda = DATASIZE, ldb = DATASIZE, ldc = DATASIZE; + char transa = 'N'; + char transb = 'R'; + float alpha[] = {-2.0, 1.0f}; + float beta[] = {1.0f, -1.0f}; + + float norm = check_cgemm(transa, transb, m, n, k, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Test cgemm with the conjugate matrices by conjugating and not transposed matrices + * and comparing it with the non-conjugate cgemm. + * Test with the following options: + * + * matrix A is conjugate and not transposed + * matrix B is conjugate and transposed + */ +CTEST(cgemm, conjnotransa_conjtransb) +{ + blasint n = DATASIZE, m = DATASIZE, k = DATASIZE; + blasint lda = DATASIZE, ldb = DATASIZE, ldc = DATASIZE; + char transa = 'R'; + char transb = 'C'; + float alpha[] = {-2.0, 1.0f}; + float beta[] = {1.0f, -1.0f}; + + float norm = check_cgemm(transa, transb, m, n, k, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Test cgemm with the conjugate matrices by conjugating and not transposed matrices + * and comparing it with the non-conjugate cgemm. + * Test with the following options: + * + * matrix A is conjugate and not transposed + * matrix B is not conjugate and not transposed + */ +CTEST(cgemm, conjnotransa_notransb) +{ + blasint n = DATASIZE, m = DATASIZE, k = DATASIZE; + blasint lda = DATASIZE, ldb = DATASIZE, ldc = DATASIZE; + char transa = 'R'; + char transb = 'N'; + float alpha[] = {-2.0, 1.0f}; + float beta[] = {1.0f, -1.0f}; + + float norm = check_cgemm(transa, transb, m, n, k, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Test cgemm with the conjugate matrices by conjugating and not transposed matrices + * and comparing it with the non-conjugate cgemm. + * Test with the following options: + * + * matrix A is conjugate and not transposed + * matrix B is conjugate and not transposed + */ +CTEST(cgemm, conjnotransa_conjnotransb) +{ + blasint n = DATASIZE, m = DATASIZE, k = DATASIZE; + blasint lda = DATASIZE, ldb = DATASIZE, ldc = DATASIZE; + char transa = 'R'; + char transb = 'R'; + float alpha[] = {-2.0, 1.0f}; + float beta[] = {1.0f, -1.0f}; + + float norm = check_cgemm(transa, transb, m, n, k, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Test cgemm with the conjugate matrices by conjugating and not transposed matrices + * and comparing it with the non-conjugate cgemm. + * Test with the following options: + * + * matrix A is conjugate and not transposed + * matrix B is transposed + */ +CTEST(cgemm, conjnotransa_transb) +{ + blasint n = DATASIZE, m = DATASIZE, k = DATASIZE; + blasint lda = DATASIZE, ldb = DATASIZE, ldc = DATASIZE; + char transa = 'R'; + char transb = 'T'; + float alpha[] = {-2.0, 1.0f}; + float beta[] = {1.0f, -1.0f}; + + float norm = check_cgemm(transa, transb, m, n, k, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Test cgemm with the conjugate matrices by conjugating and not transposed matrices + * and comparing it with the non-conjugate cgemm. + * Test with the following options: + * + * matrix A is transposed + * matrix B is conjugate and not transposed + */ +CTEST(cgemm, transa_conjnotransb) +{ + blasint n = DATASIZE, m = DATASIZE, k = DATASIZE; + blasint lda = DATASIZE, ldb = DATASIZE, ldc = DATASIZE; + char transa = 'T'; + char transb = 'R'; + float alpha[] = {-2.0, 1.0f}; + float beta[] = {1.0f, -1.0f}; + + float norm = check_cgemm(transa, transb, m, n, k, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_cgemmt.c b/utest/test_extensions/test_cgemmt.c new file mode 100644 index 000000000..ed9279933 --- /dev/null +++ b/utest/test_extensions/test_cgemmt.c @@ -0,0 +1,2010 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. 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. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include "common.h" + +#define DATASIZE 100 + +struct DATA_CGEMMT { + float a_test[DATASIZE * DATASIZE * 2]; + float b_test[DATASIZE * DATASIZE * 2]; + float c_test[DATASIZE * DATASIZE * 2]; + float c_verify[DATASIZE * DATASIZE * 2]; + float c_gemm[DATASIZE * DATASIZE * 2]; +}; + +#ifdef BUILD_COMPLEX +static struct DATA_CGEMMT data_cgemmt; + +/** + * Compute gemmt via gemm since gemmt is gemm but updates only + * the upper or lower triangular part of the result matrix + * + * param api specifies tested api (C or Fortran) + * param order specifies row or column major order (for Fortran API column major always) + * param uplo specifies whether C’s data is stored in its upper or lower triangle + * param transa specifies op(A), the transposition operation applied to A + * param transb specifies op(B), the transposition operation applied to B + * param m - number of rows of op(A), columns of op(B), and columns and rows of C + * param k - number of columns of op(A) and rows of op(B) + * param alpha - scaling factor for the matrix-matrix product + * param lda - leading dimension of A + * param ldb - leading dimension of B + * param beta - scaling factor for matrix C + * param ldc - leading dimension of C + */ +static void cgemmt_trusted(char api, enum CBLAS_ORDER order, char uplo, char transa, + char transb, blasint m, blasint k, float *alpha, blasint lda, + blasint ldb, float *beta, blasint ldc) +{ + blasint i, j; + + if(api == 'F') + BLASFUNC(cgemm)(&transa, &transb, &m, &m, &k, alpha, data_cgemmt.a_test, &lda, + data_cgemmt.b_test, &ldb, beta, data_cgemmt.c_gemm, &ldc); + else + cblas_cgemm(order, transa, transb, m, m, k, alpha, data_cgemmt.a_test, lda, + data_cgemmt.b_test, ldb, beta, data_cgemmt.c_gemm, ldc); + + ldc *= 2; + + if (uplo == 'L' || uplo == CblasLower) + { + for (i = 0; i < m; i++) + for (j = i * 2; j < m * 2; j+=2){ + data_cgemmt.c_verify[i * ldc + j] = + data_cgemmt.c_gemm[i * ldc + j]; + data_cgemmt.c_verify[i * ldc + j + 1] = + data_cgemmt.c_gemm[i * ldc + j + 1]; + } + } else { + for (i = 0; i < m; i++) + for (j = 0; j <= i * 2; j+=2){ + data_cgemmt.c_verify[i * ldc + j] = + data_cgemmt.c_gemm[i * ldc + j]; + data_cgemmt.c_verify[i * ldc + j + 1] = + data_cgemmt.c_gemm[i * ldc + j + 1]; + } + } +} + +/** + * Comapare results computed by cgemmt and cgemmt_trusted + * + * param api specifies tested api (C or Fortran) + * param order specifies row or column major order (for Fortran API column major always) + * param uplo specifies whether C’s data is stored in its upper or lower triangle + * param transa specifies op(A), the transposition operation applied to A + * param transb specifies op(B), the transposition operation applied to B + * param m - number of rows of op(A), columns of op(B), and columns and rows of C + * param k - number of columns of op(A) and rows of op(B) + * param alpha - scaling factor for the matrix-matrix product + * param lda - leading dimension of A + * param ldb - leading dimension of B + * param beta - scaling factor for matrix C + * param ldc - leading dimension of C + * return norm of differences + */ +static float check_cgemmt(char api, enum CBLAS_ORDER order, char uplo, char transa, + char transb, blasint m, blasint k, float *alpha, blasint lda, + blasint ldb, float *beta, blasint ldc) +{ + blasint i; + blasint b_cols; + blasint a_cols; + blasint inc = 1; + blasint size_c = m * ldc * 2; + + if(order == CblasColMajor){ + if (transa == 'T' || transa == 'C' || + transa == CblasTrans || transa == CblasConjTrans) + a_cols = m; + else a_cols = k; + + if (transb == 'T' || transb == 'C' || + transb == CblasTrans || transb == CblasConjTrans) + b_cols = k; + else b_cols = m; + } else { + if (transa == 'T' || transa == 'C' || + transa == CblasTrans || transa == CblasConjTrans) + a_cols = k; + else a_cols = m; + + if (transb == 'T' || transb == 'C' || + transb == CblasTrans || transb == CblasConjTrans) + b_cols = m; + else b_cols = k; + } + + srand_generate(data_cgemmt.a_test, a_cols * lda * 2); + srand_generate(data_cgemmt.b_test, b_cols * ldb * 2); + srand_generate(data_cgemmt.c_test, m * ldc * 2); + + for (i = 0; i < m * ldc * 2; i++) + data_cgemmt.c_gemm[i] = data_cgemmt.c_verify[i] = data_cgemmt.c_test[i]; + + cgemmt_trusted(api, order, uplo, transa, transb, m, k, alpha, lda, ldb, beta, ldc); + + if (api == 'F') + BLASFUNC(cgemmt)(&uplo, &transa, &transb, &m, &k, alpha, data_cgemmt.a_test, + &lda, data_cgemmt.b_test, &ldb, beta, data_cgemmt.c_test, &ldc); + else + cblas_cgemmt(order, uplo, transa, transb, m, k, alpha, data_cgemmt.a_test, lda, + data_cgemmt.b_test, ldb, beta, data_cgemmt.c_test, ldc); + + for (i = 0; i < m * ldc * 2; i++) + data_cgemmt.c_verify[i] -= data_cgemmt.c_test[i]; + + return BLASFUNC(snrm2)(&size_c, data_cgemmt.c_verify, &inc) / size_c; +} + +/** + * Check if error function was called with expected function name + * and param info + * + * param uplo specifies whether C’s data is stored in its upper or lower triangle + * param transa specifies op(A), the transposition operation applied to A + * param transb specifies op(B), the transposition operation applied to B + * param m - number of rows of op(A), columns of op(B), and columns and rows of C + * param k - number of columns of op(A) and rows of op(B) + * param lda - leading dimension of A + * param ldb - leading dimension of B + * param ldc - leading dimension of C + * param expected_info - expected invalid parameter number in cgemmt + * return TRUE if everything is ok, otherwise FALSE + */ +static int check_badargs(char api, enum CBLAS_ORDER order, char uplo, char transa, + char transb, blasint m, blasint k, blasint lda, blasint ldb, + blasint ldc, int expected_info) +{ + float alpha[] = {1.0f, 1.0f}; + float beta[] = {0.0f, 0.0f}; + + set_xerbla("CGEMMT ", expected_info); + + if (api == 'F') + BLASFUNC(cgemmt)(&uplo, &transa, &transb, &m, &k, alpha, data_cgemmt.a_test, + &lda, data_cgemmt.b_test, &ldb, beta, data_cgemmt.c_test, &ldc); + else + cblas_cgemmt(order, uplo, transa, transb, m, k, alpha, data_cgemmt.a_test, lda, + data_cgemmt.b_test, ldb, beta, data_cgemmt.c_test, ldc); + + return check_error(); +} + +/** + * Fortran API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its upper triangle part + * A not transposed + * B not transposed + */ +CTEST(cgemmt, upper_M_50_K_50_a_notrans_b_notrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'N'; + char uplo = 'U'; + float alpha[] = {-1.0f, 1.0f}; + float beta[] = {2.0f, 1.0f}; + + float norm = check_cgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its upper triangle part + * A transposed + * B not transposed + */ +CTEST(cgemmt, upper_M_50_K_25_a_trans_b_notrans) +{ + blasint M = 50, K = 25; + blasint lda = 25, ldb = 25, ldc = 50; + char transa = 'T', transb = 'N'; + char uplo = 'U'; + float alpha[] = {1.0f, 1.0f}; + float beta[] = {2.0f, 1.0f}; + + float norm = check_cgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its upper triangle part + * A not transposed + * B transposed + */ +CTEST(cgemmt, upper_M_25_K_50_a_notrans_b_trans) +{ + blasint M = 25, K = 50; + blasint lda = 25, ldb = 25, ldc = 25; + char transa = 'N', transb = 'T'; + char uplo = 'U'; + float alpha[] = {1.0f, 1.0f}; + float beta[] = {0.0f, 0.0f}; + + float norm = check_cgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its upper triangle part + * A transposed + * B transposed + */ +CTEST(cgemmt, upper_M_50_K_50_a_trans_b_trans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'T', transb = 'T'; + char uplo = 'U'; + float alpha[] = {-1.0f, 1.0f}; + float beta[] = {2.0f, 1.0f}; + + float norm = check_cgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its upper triangle part + * A conjugate not transposed + * B conjugate not transposed + */ +CTEST(cgemmt, upper_M_25_K_50_a_conjnotrans_b_conjnotrans) +{ + blasint M = 25, K = 50; + blasint lda = 25, ldb = 50, ldc = 25; + char transa = 'R', transb = 'R'; + char uplo = 'U'; + float alpha[] = {2.0f, 1.0f}; + float beta[] = {-1.0f, 2.0f}; + + float norm = check_cgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its upper triangle part + * A conjugate transposed + * B conjugate not transposed + */ +CTEST(cgemmt, upper_M_50_K_50_a_conjtrans_b_conjnotrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'C', transb = 'R'; + char uplo = 'U'; + float alpha[] = {1.0f, 1.0f}; + float beta[] = {1.0f, 1.0f}; + + float norm = check_cgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its upper triangle part + * A conjugate not transposed + * B conjugate transposed + */ +CTEST(cgemmt, upper_M_50_K_50_a_conjnotrans_b_conjtrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'R', transb = 'C'; + char uplo = 'U'; + float alpha[] = {2.0f, 1.0f}; + float beta[] = {-1.0f, 2.0f}; + + float norm = check_cgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its upper triangle part + * A conjugate transposed + * B conjugate transposed + */ +CTEST(cgemmt, upper_M_50_K_25_a_conjtrans_b_conjtrans) +{ + blasint M = 50, K = 25; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'C', transb = 'C'; + char uplo = 'U'; + float alpha[] = {2.0f, 1.0f}; + float beta[] = {-1.0f, 2.0f}; + + float norm = check_cgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its upper triangle part + * alpha_r = 0.0, alpha_i = 0.0 + */ +CTEST(cgemmt, upper_alpha_zero) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'N'; + char uplo = 'U'; + float alpha[] = {0.0f, 0.0f}; + float beta[] = {2.0f, 1.0f}; + + float norm = check_cgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its upper triangle part + * beta_r = 1.0, beta_i = 0.0 + */ +CTEST(cgemmt, upper_beta_one) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'N'; + char uplo = 'U'; + float alpha[] = {1.0f, 1.0f}; + float beta[] = {1.0f, 0.0f}; + + float norm = check_cgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its lower triangle part + * A not transposed + * B not transposed + */ +CTEST(cgemmt, lower_M_50_K_50_a_notrans_b_notrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'N'; + char uplo = 'L'; + float alpha[] = {-1.0f, 1.0f}; + float beta[] = {2.0f, 1.0f}; + + float norm = check_cgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its lower triangle part + * A transposed + * B not transposed + */ +CTEST(cgemmt, lower_M_50_K_25_a_trans_b_notrans) +{ + blasint M = 50, K = 25; + blasint lda = 25, ldb = 25, ldc = 50; + char transa = 'T', transb = 'N'; + char uplo = 'L'; + float alpha[] = {1.0f, 1.0f}; + float beta[] = {2.0f, 1.0f}; + + float norm = check_cgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its lower triangle part + * A not transposed + * B transposed + */ +CTEST(cgemmt, lower_M_25_K_50_a_notrans_b_trans) +{ + blasint M = 25, K = 50; + blasint lda = 25, ldb = 25, ldc = 25; + char transa = 'N', transb = 'T'; + char uplo = 'L'; + float alpha[] = {1.0f, 1.0f}; + float beta[] = {0.0f, 0.0f}; + + float norm = check_cgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its lower triangle part + * A transposed + * B transposed + */ +CTEST(cgemmt, lower_M_50_K_50_a_trans_b_trans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'T', transb = 'T'; + char uplo = 'L'; + float alpha[] = {-1.0f, 1.0f}; + float beta[] = {2.0f, 1.0f}; + + float norm = check_cgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its lower triangle part + * A conjugate not transposed + * B conjugate not transposed + */ +CTEST(cgemmt, lower_M_25_K_50_a_conjnotrans_b_conjnotrans) +{ + blasint M = 25, K = 50; + blasint lda = 25, ldb = 50, ldc = 25; + char transa = 'R', transb = 'R'; + char uplo = 'L'; + float alpha[] = {2.0f, 1.0f}; + float beta[] = {-1.0f, 2.0f}; + + float norm = check_cgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its lower triangle part + * A conjugate transposed + * B conjugate not transposed + */ +CTEST(cgemmt, lower_M_50_K_50_a_conjtrans_b_conjnotrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'C', transb = 'R'; + char uplo = 'L'; + float alpha[] = {1.0f, 1.0f}; + float beta[] = {1.0f, 1.0f}; + + float norm = check_cgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its lower triangle part + * A conjugate not transposed + * B conjugate transposed + */ +CTEST(cgemmt, lower_M_50_K_50_a_conjnotrans_b_conjtrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'R', transb = 'C'; + char uplo = 'L'; + float alpha[] = {2.0f, 1.0f}; + float beta[] = {-1.0f, 2.0f}; + + float norm = check_cgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its lower triangle part + * A conjugate transposed + * B conjugate transposed + */ +CTEST(cgemmt, lower_M_50_K_25_a_conjtrans_b_conjtrans) +{ + blasint M = 50, K = 25; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'C', transb = 'C'; + char uplo = 'L'; + float alpha[] = {2.0f, 1.0f}; + float beta[] = {-1.0f, 2.0f}; + + float norm = check_cgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its lower triangle part + * alpha_r = 0.0, alpha_i = 0.0 + */ +CTEST(cgemmt, lower_alpha_zero) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'N'; + char uplo = 'L'; + float alpha[] = {0.0f, 0.0f}; + float beta[] = {2.0f, 1.0f}; + + float norm = check_cgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its lower triangle part + * beta_r = 1.0, beta_i = 0.0 + */ +CTEST(cgemmt, lower_beta_one) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'N'; + char uplo = 'L'; + float alpha[] = {1.0f, 1.0f}; + float beta[] = {1.0f, 0.0f}; + + float norm = check_cgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its upper triangle part + * A not transposed + * B not transposed + */ +CTEST(cgemmt, c_api_colmajor_upper_M_50_K_50_a_notrans_b_notrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha[] = {-1.0f, 1.0f}; + float beta[] = {2.0f, 1.0f}; + + float norm = check_cgemmt('C', CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its upper triangle part + * A transposed + * B not transposed + */ +CTEST(cgemmt, c_api_colmajor_upper_M_50_K_25_a_trans_b_notrans) +{ + blasint M = 50, K = 25; + blasint lda = 25, ldb = 25, ldc = 50; + float alpha[] = {1.0f, 1.0f}; + float beta[] = {2.0f, 1.0f}; + + float norm = check_cgemmt('C', CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its upper triangle part + * A not transposed + * B transposed + */ +CTEST(cgemmt, c_api_colmajor_upper_M_25_K_50_a_notrans_b_trans) +{ + blasint M = 25, K = 50; + blasint lda = 25, ldb = 25, ldc = 25; + float alpha[] = {1.0f, 1.0f}; + float beta[] = {0.0f, 0.0f}; + + float norm = check_cgemmt('C', CblasColMajor, CblasUpper, CblasNoTrans, CblasTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its upper triangle part + * A transposed + * B transposed + */ +CTEST(cgemmt, c_api_colmajor_upper_M_50_K_50_a_trans_b_trans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha[] = {-1.0f, 1.0f}; + float beta[] = {2.0f, 1.0f}; + + float norm = check_cgemmt('C', CblasColMajor, CblasUpper, CblasTrans, CblasTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its upper triangle part + * A conjugate not transposed + * B conjugate not transposed + */ +CTEST(cgemmt, c_api_colmajor_upper_M_25_K_50_a_conjnotrans_b_conjnotrans) +{ + blasint M = 25, K = 50; + blasint lda = 25, ldb = 50, ldc = 25; + float alpha[] = {2.0f, 1.0f}; + float beta[] = {-1.0f, 2.0f}; + + float norm = check_cgemmt('C', CblasColMajor, CblasUpper, CblasConjNoTrans, CblasConjNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its upper triangle part + * A conjugate transposed + * B conjugate not transposed + */ +CTEST(cgemmt, c_api_colmajor_upper_M_50_K_50_a_conjtrans_b_conjnotrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha[] = {1.0f, 1.0f}; + float beta[] = {1.0f, 1.0f}; + + float norm = check_cgemmt('C', CblasColMajor, CblasUpper, CblasConjTrans, CblasConjNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its upper triangle part + * A conjugate not transposed + * B conjugate transposed + */ +CTEST(cgemmt, c_api_colmajor_upper_M_50_K_50_a_conjnotrans_b_conjtrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha[] = {2.0f, 1.0f}; + float beta[] = {-1.0f, 2.0f}; + + float norm = check_cgemmt('C', CblasColMajor, CblasUpper, CblasConjNoTrans, CblasConjTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its upper triangle part + * A conjugate transposed + * B conjugate transposed + */ +CTEST(cgemmt, c_api_colmajor_upper_M_50_K_25_a_conjtrans_b_conjtrans) +{ + blasint M = 50, K = 25; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha[] = {2.0f, 1.0f}; + float beta[] = {-1.0f, 2.0f}; + + float norm = check_cgemmt('C', CblasColMajor, CblasUpper, CblasConjTrans, CblasConjTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its upper triangle part + * alpha_r = 0.0, alpha_i = 0.0 + */ +CTEST(cgemmt, c_api_colmajor_upper_alpha_zero) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha[] = {0.0f, 0.0f}; + float beta[] = {2.0f, 1.0f}; + + float norm = check_cgemmt('C', CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its upper triangle part + * beta_r = 1.0, beta_i = 0.0 + */ +CTEST(cgemmt, c_api_colmajor_upper_beta_one) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha[] = {1.0f, 1.0f}; + float beta[] = {1.0f, 0.0f}; + + float norm = check_cgemmt('C', CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its lower triangle part + * A not transposed + * B not transposed + */ +CTEST(cgemmt, c_api_colmajor_lower_M_50_K_50_a_notrans_b_notrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha[] = {-1.0f, 1.0f}; + float beta[] = {2.0f, 1.0f}; + + float norm = check_cgemmt('C', CblasColMajor, CblasLower, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its lower triangle part + * A transposed + * B not transposed + */ +CTEST(cgemmt, c_api_colmajor_lower_M_50_K_25_a_trans_b_notrans) +{ + blasint M = 50, K = 25; + blasint lda = 25, ldb = 25, ldc = 50; + float alpha[] = {1.0f, 1.0f}; + float beta[] = {2.0f, 1.0f}; + + float norm = check_cgemmt('C', CblasColMajor, CblasLower, CblasTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its lower triangle part + * A not transposed + * B transposed + */ +CTEST(cgemmt, c_api_colmajor_lower_M_25_K_50_a_notrans_b_trans) +{ + blasint M = 25, K = 50; + blasint lda = 25, ldb = 25, ldc = 25; + float alpha[] = {1.0f, 1.0f}; + float beta[] = {0.0f, 0.0f}; + + float norm = check_cgemmt('C', CblasColMajor, CblasLower, CblasNoTrans, CblasTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its lower triangle part + * A transposed + * B transposed + */ +CTEST(cgemmt, c_api_colmajor_lower_M_50_K_50_a_trans_b_trans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha[] = {-1.0f, 1.0f}; + float beta[] = {2.0f, 1.0f}; + + float norm = check_cgemmt('C', CblasColMajor, CblasLower, CblasTrans, CblasTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its lower triangle part + * A conjugate not transposed + * B conjugate not transposed + */ +CTEST(cgemmt, c_api_colmajor_lower_M_25_K_50_a_conjnotrans_b_conjnotrans) +{ + blasint M = 25, K = 50; + blasint lda = 25, ldb = 50, ldc = 25; + float alpha[] = {2.0f, 1.0f}; + float beta[] = {-1.0f, 2.0f}; + + float norm = check_cgemmt('C', CblasColMajor, CblasLower, CblasConjNoTrans, CblasConjNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its lower triangle part + * A conjugate transposed + * B conjugate not transposed + */ +CTEST(cgemmt, c_api_colmajor_lower_M_50_K_50_a_conjtrans_b_conjnotrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha[] = {2.0f, 1.0f}; + float beta[] = {-1.0f, 2.0f}; + + float norm = check_cgemmt('C', CblasColMajor, CblasLower, CblasConjTrans, CblasConjNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its lower triangle part + * A conjugate not transposed + * B conjugate transposed + */ +CTEST(cgemmt, c_api_colmajor_lower_M_50_K_50_a_conjnotrans_b_conjtrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha[] = {2.0f, 1.0f}; + float beta[] = {-1.0f, 2.0f}; + + float norm = check_cgemmt('C', CblasColMajor, CblasLower, CblasConjNoTrans, CblasConjTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its lower triangle part + * A conjugate transposed + * B conjugate transposed + */ +CTEST(cgemmt, c_api_colmajor_lower_M_50_K_25_a_conjtrans_b_conjtrans) +{ + blasint M = 50, K = 25; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha[] = {2.0f, 1.0f}; + float beta[] = {-1.0f, 2.0f}; + + float norm = check_cgemmt('C', CblasColMajor, CblasLower, CblasConjTrans, CblasConjTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its lower triangle part + * alpha_r = 0.0, alpha_i = 0.0 + */ +CTEST(cgemmt, c_api_colmajor_lower_alpha_zero) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha[] = {0.0f, 0.0f}; + float beta[] = {2.0f, 1.0f}; + + float norm = check_cgemmt('C', CblasColMajor, CblasLower, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its lower triangle part + * beta_r = 1.0, beta_i = 0.0 + */ +CTEST(cgemmt, c_api_colmajor_lower_beta_one) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha[] = {1.0f, 1.0f}; + float beta[] = {1.0f, 0.0f}; + + float norm = check_cgemmt('C', CblasColMajor, CblasLower, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its upper triangle part + * A not transposed + * B not transposed + */ +CTEST(cgemmt, c_api_rowmajor_upper_M_50_K_50_a_notrans_b_notrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha[] = {-1.0f, 1.0f}; + float beta[] = {2.0f, 1.0f}; + + float norm = check_cgemmt('C', CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its upper triangle part + * A transposed + * B not transposed + */ +CTEST(cgemmt, c_api_rowmajor_upper_M_50_K_25_a_trans_b_notrans) +{ + blasint M = 50, K = 25; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha[] = {1.0f, 1.0f}; + float beta[] = {2.0f, 1.0f}; + + float norm = check_cgemmt('C', CblasRowMajor, CblasUpper, CblasTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its upper triangle part + * A not transposed + * B transposed + */ +CTEST(cgemmt, c_api_rowmajor_upper_M_25_K_50_a_notrans_b_trans) +{ + blasint M = 25, K = 50; + blasint lda = 50, ldb = 50, ldc = 25; + float alpha[] = {1.0f, 1.0f}; + float beta[] = {-1.0f, -1.0f}; + + float norm = check_cgemmt('C', CblasRowMajor, CblasUpper, CblasNoTrans, CblasTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its upper triangle part + * A transposed + * B transposed + */ +CTEST(cgemmt, c_api_rowmajor_upper_M_50_K_50_a_trans_b_trans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha[] = {-1.0f, 1.0f}; + float beta[] = {2.0f, 1.0f}; + + float norm = check_cgemmt('C', CblasRowMajor, CblasUpper, CblasTrans, CblasTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its upper triangle part + * A conjugate not transposed + * B conjugate not transposed + */ +CTEST(cgemmt, c_api_rowmajor_upper_M_25_K_50_a_conjnotrans_b_conjnotrans) +{ + blasint M = 25, K = 50; + blasint lda = 50, ldb = 25, ldc = 25; + float alpha[] = {2.0f, 1.0f}; + float beta[] = {-1.0f, 2.0f}; + + float norm = check_cgemmt('C', CblasRowMajor, CblasUpper, CblasConjNoTrans, CblasConjNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its upper triangle part + * A conjugate transposed + * B conjugate not transposed + */ +CTEST(cgemmt, c_api_rowmajor_upper_M_50_K_50_a_conjtrans_b_conjnotrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha[] = {2.0f, 1.0f}; + float beta[] = {-1.0f, 2.0f}; + + float norm = check_cgemmt('C', CblasRowMajor, CblasUpper, CblasConjTrans, CblasConjNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its upper triangle part + * A conjugate not transposed + * B conjugate transposed + */ +CTEST(cgemmt, c_api_rowmajor_upper_M_50_K_50_a_conjnotrans_b_conjtrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha[] = {2.0f, 1.0f}; + float beta[] = {-1.0f, 2.0f}; + + float norm = check_cgemmt('C', CblasRowMajor, CblasUpper, CblasConjNoTrans, CblasConjTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its upper triangle part + * A conjugate transposed + * B conjugate transposed + */ +CTEST(cgemmt, c_api_rowmajor_upper_M_25_K_50_a_conjtrans_b_conjtrans) +{ + blasint M = 25, K = 50; + blasint lda = 25, ldb = 50, ldc = 25; + float alpha[] = {2.0f, 1.0f}; + float beta[] = {-1.0f, 2.0f}; + + float norm = check_cgemmt('C', CblasRowMajor, CblasUpper, CblasConjTrans, CblasConjTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its upper triangle part + * alpha_r = 0.0, alpha_i = 0.0 + */ +CTEST(cgemmt, c_api_rowmajor_upper_alpha_zero) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha[] = {0.0f, 0.0f}; + float beta[] = {2.0f, 1.0f}; + + float norm = check_cgemmt('C', CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its upper triangle part + * beta_r = 1.0, beta_i = 0.0 + */ +CTEST(cgemmt, c_api_rowmajor_upper_beta_one) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha[] = {1.0f, 1.0f}; + float beta[] = {1.0f, 0.0f}; + + float norm = check_cgemmt('C', CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its lower triangle part + * A not transposed + * B not transposed + */ +CTEST(cgemmt, c_api_rowmajor_lower_M_50_K_50_a_notrans_b_notrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha[] = {-1.0f, 1.0f}; + float beta[] = {2.0f, 1.0f}; + + float norm = check_cgemmt('C', CblasRowMajor, CblasLower, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its lower triangle part + * A transposed + * B not transposed + */ +CTEST(cgemmt, c_api_rowmajor_lower_M_50_K_25_a_trans_b_notrans) +{ + blasint M = 50, K = 25; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha[] = {1.0f, 1.0f}; + float beta[] = {2.0f, 1.0f}; + + float norm = check_cgemmt('C', CblasRowMajor, CblasLower, CblasTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its lower triangle part + * A not transposed + * B transposed + */ +CTEST(cgemmt, c_api_rowmajor_lower_M_25_K_50_a_notrans_b_trans) +{ + blasint M = 25, K = 50; + blasint lda = 50, ldb = 50, ldc = 25; + float alpha[] = {1.0f, 1.0f}; + float beta[] = {0.0f, 0.0f}; + + float norm = check_cgemmt('C', CblasRowMajor, CblasLower, CblasNoTrans, CblasTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its lower triangle part + * A transposed + * B transposed + */ +CTEST(cgemmt, c_api_rowmajor_lower_M_50_K_50_a_trans_b_trans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha[] = {-1.0f, 1.0f}; + float beta[] = {2.0f, 1.0f}; + + float norm = check_cgemmt('C', CblasRowMajor, CblasLower, CblasTrans, CblasTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its lower triangle part + * A conjugate not transposed + * B conjugate not transposed + */ +CTEST(cgemmt, c_api_rowmajor_lower_M_25_K_50_a_conjnotrans_b_conjnotrans) +{ + blasint M = 25, K = 50; + blasint lda = 50, ldb = 25, ldc = 25; + float alpha[] = {2.0f, 1.0f}; + float beta[] = {-1.0f, 2.0f}; + + float norm = check_cgemmt('C', CblasRowMajor, CblasLower, CblasConjNoTrans, CblasConjNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its lower triangle part + * A conjugate transposed + * B conjugate not transposed + */ +CTEST(cgemmt, c_api_rowmajor_lower_M_50_K_50_a_conjtrans_b_conjnotrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha[] = {2.0f, 1.0f}; + float beta[] = {-1.0f, 2.0f}; + + float norm = check_cgemmt('C', CblasRowMajor, CblasLower, CblasConjTrans, CblasConjNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its lower triangle part + * A conjugate not transposed + * B conjugate transposed + */ +CTEST(cgemmt, c_api_rowmajor_lower_M_50_K_50_a_conjnotrans_b_conjtrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha[] = {2.0f, 1.0f}; + float beta[] = {-1.0f, 2.0f}; + + float norm = check_cgemmt('C', CblasRowMajor, CblasLower, CblasConjNoTrans, CblasConjTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its lower triangle part + * A conjugate transposed + * B conjugate transposed + */ +CTEST(cgemmt, c_api_rowmajor_lower_M_50_K_25_a_conjtrans_b_conjtrans) +{ + blasint M = 50, K = 25; + blasint lda = 50, ldb = 25, ldc = 50; + float alpha[] = {2.0f, 1.0f}; + float beta[] = {-1.0f, 2.0f}; + + float norm = check_cgemmt('C', CblasRowMajor, CblasLower, CblasConjTrans, CblasConjTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its lower triangle part + * alpha_r = 0.0, alpha_i = 0.0 + */ +CTEST(cgemmt, c_api_rowmajor_lower_alpha_zero) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha[] = {0.0f, 0.0f}; + float beta[] = {2.0f, 1.0f}; + + float norm = check_cgemmt('C', CblasRowMajor, CblasLower, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its lower triangle part + * beta_r = 1.0, beta_i = 0.0 + */ +CTEST(cgemmt, c_api_rowmajor_lower_beta_one) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha[] = {1.0f, 1.0f}; + float beta[] = {1.0f, 0.0f}; + + float norm = check_cgemmt('C', CblasRowMajor, CblasLower, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test error function for an invalid param uplo. + * Must be upper (U) or lower (L). + */ +CTEST(cgemmt, xerbla_uplo_invalid) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'N'; + char uplo = 'O'; + int expected_info = 1; + + int passed = check_badargs('F', CblasColMajor, uplo, transa, transb, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param transa. + * Must be trans (T/C) or no-trans (N/R). + */ +CTEST(cgemmt, xerbla_transa_invalid) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'O', transb = 'N'; + char uplo = 'U'; + int expected_info = 2; + + int passed = check_badargs('F', CblasColMajor, uplo, transa, transb, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param transb. + * Must be trans (T/C) or no-trans (N/R). + */ +CTEST(cgemmt, xerbla_transb_invalid) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'O'; + char uplo = 'U'; + int expected_info = 3; + + int passed = check_badargs('F', CblasColMajor, uplo, transa, transb, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param M. + * Must be positive. + */ +CTEST(cgemmt, xerbla_m_invalid) +{ + blasint M = -1, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'N'; + char uplo = 'U'; + int expected_info = 4; + + int passed = check_badargs('F', CblasColMajor, uplo, transa, transb, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param K. + * Must be positive. + */ +CTEST(cgemmt, xerbla_k_invalid) +{ + blasint M = 50, K = -1; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'N'; + char uplo = 'U'; + int expected_info = 5; + + int passed = check_badargs('F', CblasColMajor, uplo, transa, transb, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param lda. + * Must be must be at least K if matrix A transposed. + */ +CTEST(cgemmt, xerbla_lda_invalid) +{ + blasint M = 50, K = 100; + blasint lda = 50, ldb = 100, ldc = 50; + char transa = 'T', transb = 'N'; + char uplo = 'U'; + int expected_info = 8; + + int passed = check_badargs('F', CblasColMajor, uplo, transa, transb, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param ldb. + * Must be must be at least K if matrix B not transposed. + */ +CTEST(cgemmt, xerbla_ldb_invalid) +{ + blasint M = 50, K = 100; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'N'; + char uplo = 'U'; + int expected_info = 10; + + int passed = check_badargs('F', CblasColMajor, uplo, transa, transb, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param ldc. + * Must be must be at least M. + */ +CTEST(cgemmt, xerbla_ldc_invalid) +{ + blasint M = 100, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'T', transb = 'N'; + char uplo = 'U'; + int expected_info = 13; + + int passed = check_badargs('F', CblasColMajor, uplo, transa, transb, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. + * Test error function for an invalid param order. + * Must be column or row major. + */ +CTEST(cgemmt, xerbla_c_api_major_invalid) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 0; + + int passed = check_badargs('C', 'O', CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Column Major + * Test error function for an invalid param uplo. + * Must be upper or lower. + */ +CTEST(cgemmt, xerbla_c_api_colmajor_uplo_invalid) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 1; + + int passed = check_badargs('C', CblasColMajor, 'O', CblasNoTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Column Major + * Test error function for an invalid param transa. + * Must be trans or no-trans. + */ +CTEST(cgemmt, xerbla_c_api_colmajor_transa_invalid) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 2; + + int passed = check_badargs('C', CblasColMajor, CblasUpper, 'O', CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Column Major + * Test error function for an invalid param transb. + * Must be trans or no-trans. + */ +CTEST(cgemmt, xerbla_c_api_colmajor_transb_invalid) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 3; + + int passed = check_badargs('C', CblasColMajor, CblasUpper, CblasNoTrans, 'O', + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Column Major + * Test error function for an invalid param M. + * Must be positive. + */ +CTEST(cgemmt, xerbla_c_api_colmajor_m_invalid) +{ + blasint M = -1, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 4; + + int passed = check_badargs('C', CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Column Major + * Test error function for an invalid param K. + * Must be positive. + */ +CTEST(cgemmt, xerbla_c_api_colmajor_k_invalid) +{ + blasint M = 50, K = -1; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 5; + + int passed = check_badargs('C', CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Column Major + * Test error function for an invalid param lda. + * Must be must be at least K if matrix A transposed. + */ +CTEST(cgemmt, xerbla_c_api_colmajor_lda_invalid) +{ + blasint M = 50, K = 100; + blasint lda = 50, ldb = 100, ldc = 50; + int expected_info = 8; + + int passed = check_badargs('C', CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Column Major + * Test error function for an invalid param ldb. + * Must be must be at least K if matrix B not transposed. + */ +CTEST(cgemmt, xerbla_c_api_colmajor_ldb_invalid) +{ + blasint M = 50, K = 100; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 10; + + int passed = check_badargs('C', CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Column Major + * Test error function for an invalid param ldc. + * Must be must be at least M. + */ +CTEST(cgemmt, xerbla_c_api_colmajor_ldc_invalid) +{ + blasint M = 100, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 13; + + int passed = check_badargs('C', CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Row Major + * Test error function for an invalid param uplo. + * Must be upper or lower. + */ +CTEST(cgemmt, xerbla_c_api_rowmajor_uplo_invalid) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 1; + + int passed = check_badargs('C', CblasRowMajor, 'O', CblasNoTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Row Major + * Test error function for an invalid param transa. + * Must be trans or no-trans. + */ +CTEST(cgemmt, xerbla_c_api_rowmajor_transa_invalid) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 2; + + int passed = check_badargs('C', CblasRowMajor, CblasUpper, 'O', CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Row Major + * Test error function for an invalid param transb. + * Must be trans or no-trans. + */ +CTEST(cgemmt, xerbla_c_api_rowmajor_transb_invalid) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 3; + + int passed = check_badargs('C', CblasRowMajor, CblasUpper, CblasNoTrans, 'O', + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Row Major + * Test error function for an invalid param M. + * Must be positive. + */ +CTEST(cgemmt, xerbla_c_api_rowmajor_m_invalid) +{ + blasint M = -1, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 4; + + int passed = check_badargs('C', CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Row Major + * Test error function for an invalid param K. + * Must be positive. + */ +CTEST(cgemmt, xerbla_c_api_rowmajor_k_invalid) +{ + blasint M = 50, K = -1; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 5; + + int passed = check_badargs('C', CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Row Major + * Test error function for an invalid param lda. + * Must be must be at least K if matrix A transposed. + */ +CTEST(cgemmt, xerbla_c_api_rowmajor_lda_invalid) +{ + blasint M = 50, K = 100; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 8; + + int passed = check_badargs('C', CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Row Major + * Test error function for an invalid param ldb. + * Must be must be at least K if matrix B transposed. + */ +CTEST(cgemmt, xerbla_c_api_rowmajor_ldb_invalid) +{ + blasint M = 50, K = 100; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 10; + + int passed = check_badargs('C', CblasRowMajor, CblasUpper, CblasTrans, CblasTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Row Major + * Test error function for an invalid param ldc. + * Must be must be at least M. + */ +CTEST(cgemmt, xerbla_c_api_rowmajor_ldc_invalid) +{ + blasint M = 100, K = 50; + blasint lda = 100, ldb = 100, ldc = 50; + int expected_info = 13; + + int passed = check_badargs('C', CblasRowMajor, CblasUpper, CblasTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_cgemv_n.c b/utest/test_extensions/test_cgemv_n.c new file mode 100644 index 000000000..60c9af86a --- /dev/null +++ b/utest/test_extensions/test_cgemv_n.c @@ -0,0 +1,340 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. 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. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include "common.h" + +#define DATASIZE 100 +#define INCREMENT 2 + +struct DATA_CSPMV_N { + float a_test[DATASIZE * DATASIZE * 2]; + float b_test[DATASIZE * 2 * INCREMENT]; + float c_test[DATASIZE * 2 * INCREMENT]; + float c_verify[DATASIZE * 2 * INCREMENT]; +}; + +#ifdef BUILD_COMPLEX +static struct DATA_CSPMV_N data_cgemv_n; + +/** + * cgemv not transposed reference code + * + * param trans specifies whether matris A is conj or/and xconj + * param m - number of rows of A + * param n - number of columns of A + * param alpha - scaling factor for the matrib-vector product + * param a - buffer holding input matrib A + * param lda - leading dimension of matrix A + * param b - Buffer holding input vector b + * param inc_b - stride of vector b + * param beta - scaling factor for vector c + * param c - buffer holding input/output vector c + * param inc_c - stride of vector c + */ +static void cgemv_n_trusted(char trans, blasint m, blasint n, float *alpha, float *a, + blasint lda, float *b, blasint inc_b, float *beta, float *c, + blasint inc_c) +{ + blasint i, j; + blasint i2 = 0; + blasint ib = 0, ic = 0; + + float temp_r, temp_i; + + float *a_ptr = a; + blasint lda2 = 2*lda; + + blasint inc_b2 = 2 * inc_b; + blasint inc_c2 = 2 * inc_c; + + BLASFUNC(cscal)(&m, beta, c, &inc_c); + + for (j = 0; j < n; j++) + { + + if (trans == 'N' || trans == 'R') { + temp_r = alpha[0] * b[ib] - alpha[1] * b[ib+1]; + temp_i = alpha[0] * b[ib+1] + alpha[1] * b[ib]; + } else { + temp_r = alpha[0] * b[ib] + alpha[1] * b[ib+1]; + temp_i = alpha[0] * b[ib+1] - alpha[1] * b[ib]; + } + + ic = 0; + i2 = 0; + + for (i = 0; i < m; i++) + { + if (trans == 'N') { + c[ic] += temp_r * a_ptr[i2] - temp_i * a_ptr[i2+1]; + c[ic+1] += temp_r * a_ptr[i2+1] + temp_i * a_ptr[i2]; + } + if (trans == 'O') { + c[ic] += temp_r * a_ptr[i2] + temp_i * a_ptr[i2+1]; + c[ic+1] += temp_r * a_ptr[i2+1] - temp_i * a_ptr[i2]; + } + if (trans == 'R') { + c[ic] += temp_r * a_ptr[i2] + temp_i * a_ptr[i2+1]; + c[ic+1] -= temp_r * a_ptr[i2+1] - temp_i * a_ptr[i2]; + } + if (trans == 'S') { + c[ic] += temp_r * a_ptr[i2] - temp_i * a_ptr[i2+1]; + c[ic+1] -= temp_r * a_ptr[i2+1] + temp_i * a_ptr[i2]; + } + i2 += 2; + ic += inc_c2; + } + a_ptr += lda2; + ib += inc_b2; + } + +} + +/** + * Comapare results computed by cgemv and cgemv_n_trusted + * + * param trans specifies whether matris A is conj or/and xconj + * param m - number of rows of A + * param n - number of columns of A + * param alpha - scaling factor for the matrib-vector product + * param lda - leading dimension of matrix A + * param inc_b - stride of vector b + * param beta - scaling factor for vector c + * param inc_c - stride of vector c + * return norm of differences + */ +static float check_cgemv_n(char trans, blasint m, blasint n, float *alpha, blasint lda, + blasint inc_b, float *beta, blasint inc_c) +{ + blasint i; + + srand_generate(data_cgemv_n.a_test, n * lda); + srand_generate(data_cgemv_n.b_test, 2 * n * inc_b); + srand_generate(data_cgemv_n.c_test, 2 * m * inc_c); + + for (i = 0; i < m * 2 * inc_c; i++) + data_cgemv_n.c_verify[i] = data_cgemv_n.c_test[i]; + + cgemv_n_trusted(trans, m, n, alpha, data_cgemv_n.a_test, lda, data_cgemv_n.b_test, + inc_b, beta, data_cgemv_n.c_test, inc_c); + BLASFUNC(cgemv)(&trans, &m, &n, alpha, data_cgemv_n.a_test, &lda, data_cgemv_n.b_test, + &inc_b, beta, data_cgemv_n.c_verify, &inc_c); + + for (i = 0; i < m * 2 * inc_c; i++) + data_cgemv_n.c_verify[i] -= data_cgemv_n.c_test[i]; + + return BLASFUNC(scnrm2)(&n, data_cgemv_n.c_verify, &inc_c); +} + +/** + * Test cgemv by comparing it against reference + * with the following options: + * + * A is xconj + * Number of rows and columns of A is 100 + * Stride of vector b is 1 + * Stride of vector c is 1 + */ +CTEST(cgemv, trans_o_square_matrix) +{ + blasint n = 100, m = 100, lda = 100; + blasint inc_b = 1, inc_c = 1; + char trans = 'O'; + float alpha[] = {2.0f, -1.0f}; + float beta[] = {1.4f, 5.0f}; + + float norm = check_cgemv_n(trans, m, n, alpha, lda, inc_b, beta, inc_c); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_TOL); +} + +/** + * Test cgemv by comparing it against reference + * with the following options: + * + * A is xconj + * Number of rows of A is 50 + * Number of colums of A is 100 + * Stride of vector b is 1 + * Stride of vector c is 1 + */ +CTEST(cgemv, trans_o_rectangular_matrix_rows_less_then_cols) +{ + blasint n = 100, m = 50, lda = 50; + blasint inc_b = 1, inc_c = 1; + char trans = 'O'; + float alpha[] = {2.0f, -1.0f}; + float beta[] = {1.4f, 5.0f}; + + float norm = check_cgemv_n(trans, m, n, alpha, lda, inc_b, beta, inc_c); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_TOL); +} + +/** + * Test cgemv by comparing it against reference + * with the following options: + * + * A is xconj + * Number of rows of A is 100 + * Number of colums of A is 50 + * Stride of vector b is 1 + * Stride of vector c is 1 + */ +CTEST(cgemv, trans_o_rectangular_matrix_cols_less_then_rows) +{ + blasint n = 50, m = 100, lda = 100; + blasint inc_b = 1, inc_c = 1; + char trans = 'O'; + float alpha[] = {2.0f, -1.0f}; + float beta[] = {1.4f, 5.0f}; + + float norm = check_cgemv_n(trans, m, n, alpha, lda, inc_b, beta, inc_c); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_TOL); +} + +/** + * Test cgemv by comparing it against reference + * with the following options: + * + * A is xconj + * Number of rows and columns of A is 100 + * Stride of vector b is 2 + * Stride of vector c is 2 + */ +CTEST(cgemv, trans_o_double_strides) +{ + blasint n = 100, m = 100, lda = 100; + blasint inc_b = 2, inc_c = 2; + char trans = 'O'; + float alpha[] = {2.0f, -1.0f}; + float beta[] = {1.4f, 5.0f}; + + float norm = check_cgemv_n(trans, m, n, alpha, lda, inc_b, beta, inc_c); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_TOL); +} + +/** + * Test cgemv by comparing it against reference + * with the following options: + * + * A is xconj and conj + * Number of rows and columns of A is 100 + * Stride of vector b is 1 + * Stride of vector c is 1 + */ +CTEST(cgemv, trans_s_square_matrix) +{ + blasint n = 100, m = 100, lda = 100; + blasint inc_b = 1, inc_c = 1; + char trans = 'S'; + float alpha[] = {1.0f, 1.0f}; + float beta[] = {1.4f, 5.0f}; + + float norm = check_cgemv_n(trans, m, n, alpha, lda, inc_b, beta, inc_c); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_TOL); +} + +/** + * Test cgemv by comparing it against reference + * with the following options: + * + * A is xconj and conj + * Number of rows of A is 50 + * Number of colums of A is 100 + * Stride of vector b is 1 + * Stride of vector c is 1 + */ +CTEST(cgemv, trans_s_rectangular_matrix_rows_less_then_cols) +{ + blasint n = 100, m = 50, lda = 50; + blasint inc_b = 1, inc_c = 1; + char trans = 'S'; + float alpha[] = {2.0f, -1.0f}; + float beta[] = {1.4f, 5.0f}; + + float norm = check_cgemv_n(trans, m, n, alpha, lda, inc_b, beta, inc_c); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_TOL); +} + +/** + * Test cgemv by comparing it against reference + * with the following options: + * + * A is xconj and conj + * Number of rows of A is 100 + * Number of colums of A is 50 + * Stride of vector b is 1 + * Stride of vector c is 1 + */ +CTEST(cgemv, trans_s_rectangular_matrix_cols_less_then_rows) +{ + blasint n = 50, m = 100, lda = 100; + blasint inc_b = 1, inc_c = 1; + char trans = 'S'; + float alpha[] = {2.0f, -1.0f}; + float beta[] = {1.4f, 0.0f}; + + float norm = check_cgemv_n(trans, m, n, alpha, lda, inc_b, beta, inc_c); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_TOL); +} + +/** + * Test cgemv by comparing it against reference + * with the following options: + * + * A is xconj and conj + * Number of rows and columns of A is 100 + * Stride of vector b is 2 + * Stride of vector c is 2 + */ +CTEST(cgemv, trans_s_double_strides) +{ + blasint n = 100, m = 100, lda = 100; + blasint inc_b = 2, inc_c = 2; + char trans = 'S'; + float alpha[] = {2.0f, -1.0f}; + float beta[] = {1.0f, 5.0f}; + + float norm = check_cgemv_n(trans, m, n, alpha, lda, inc_b, beta, inc_c); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_TOL); +} + +#endif diff --git a/utest/test_extensions/test_cgemv_t.c b/utest/test_extensions/test_cgemv_t.c new file mode 100644 index 000000000..aa3281e66 --- /dev/null +++ b/utest/test_extensions/test_cgemv_t.c @@ -0,0 +1,1132 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. 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. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include "common.h" + +#define N 100 +#define M 100 +#define INCREMENT 2 + +struct DATA_CGEMV_T { + float a_test[N * M * 2]; + float a_verify[N * M * 2]; + float y_test[M * INCREMENT * 2]; + float y_verify[M * INCREMENT * 2]; + float x_test[M * INCREMENT * 2]; + float x_verify[M * INCREMENT * 2]; +}; + +// SINGLE_EPS_ZGEMV = MAX_VAL * NUMBER OF OPERATIONS * FLT_EPSILON +// SINGLE_EPS_ZGEMV = 5.0 * O(100 * 100) * 1.19e-07 = 5*e-03 +#define SINGLE_EPS_ZGEMV 5e-03 + +#ifdef BUILD_COMPLEX +static struct DATA_CGEMV_T data_cgemv_t; + +/** + * Find product of matrix-vector multiplication + * + * param n specifies number of columns of A + * param m specifies number of rows of A and size of vector x + * param lda specifies leading dimension of A + * param inc_x specifies increment of vector x + */ +static void matrix_vector_product(blasint n, blasint m, blasint lda, blasint inc_x) +{ + blasint i; + float *a_ptr = data_cgemv_t.a_verify; + float *x_ptr = data_cgemv_t.x_test; + float *x_res = data_cgemv_t.x_verify; + + openblas_complex_float result; + + for (i = 0; i < n * inc_x; i+= inc_x) + { + result = cblas_cdotu(lda, a_ptr, 1, x_ptr, inc_x); + x_res[0] = CREAL(result); + x_res[1] = CIMAG(result); + a_ptr += lda * 2; + x_res += 2 * inc_x; + } +} + +/** + * Test cgemv by comparing it against comatcopy, caxpby and + * reference func matrix_vector_product + * + * comatcopy perform operation: op(A) + * matrix_vector_product perform operation: A*x + * caxpby perform operation: alpha*x + beta*y + * + * param api specifies tested api (C or Fortran) + * param order specifies row or column major order + * param trans specifies op(A), the transposition operation + * applied to the matrix A + * param m specifies number of rows of A + * param n specifies number of columns of A + * param alpha specifies scalar alpha + * param lda specifies leading dimension of the matrix A + * param inc_x specifies increment for vector x + * param beta specifies scalar beta + * param inc_y specifies increment for vector y + * return norm of difference between cgemv and result of reference funcs + */ +static float check_cgemv(char api, char order, char trans, blasint m, blasint n, float *alpha, + blasint lda, blasint inc_x, float *beta, blasint inc_y) +{ + blasint i; + + enum CBLAS_ORDER corder; + enum CBLAS_TRANSPOSE ctrans; + + // Transpose parameters for comatcopy + // cgemv_t perform operation on transposed matrix, no need to transpose a_verify + char trans_copy; + char ctrans_copy; + + // Param alpha for comatcopy, scale on alpha perform caxpby + float alpha_one[] = {1.0f, 0.0f}; + + memset(data_cgemv_t.x_verify, 0.0f, m * inc_x * 2 * sizeof(float)); + + // Fill matrix A, vectors x, y + srand_generate(data_cgemv_t.a_test, lda * n * 2); + srand_generate(data_cgemv_t.x_test, m * inc_x * 2); + srand_generate(data_cgemv_t.y_test, m * inc_y * 2); + + // Copy vector y for reference funcs + for (int i = 0; i < m * inc_y * 2; i++) { + data_cgemv_t.y_verify[i] = data_cgemv_t.y_test[i]; + } + + if (api == 'F') { + if (trans == 'T') trans_copy = 'N'; + if (trans == 'C') trans_copy = 'R'; + if (trans == 'U') trans_copy = 'R'; + if (trans == 'D') trans_copy = 'N'; + + // Perform operation: op(A) + BLASFUNC(comatcopy)(&order, &trans_copy, &m, &n, alpha_one, data_cgemv_t.a_test, &lda, data_cgemv_t.a_verify, &lda); + + // Find A*x + matrix_vector_product(n, m, lda, inc_x); + + // Find conj(x) + if (trans == 'U' || trans == 'D') { + cconjugate_vector(m, inc_x, data_cgemv_t.x_verify); + } + + // Find alpha*x+beta*y + BLASFUNC(caxpby)(&n, alpha, data_cgemv_t.x_verify, &inc_x, beta, data_cgemv_t.y_verify, &inc_y); + + BLASFUNC(cgemv)(&trans, &m, &n, alpha, data_cgemv_t.a_test, + &lda, data_cgemv_t.x_test, &inc_x, beta, data_cgemv_t.y_test, &inc_y); + } + else { + if (order == 'C') corder = CblasColMajor; + if (order == 'R') corder = CblasRowMajor; + if (trans == 'T') {ctrans = CblasTrans; ctrans_copy = (corder == CblasRowMajor) ? CblasTrans : CblasNoTrans;} + if (trans == 'N') {ctrans = CblasNoTrans; ctrans_copy = (corder == CblasRowMajor) ? CblasNoTrans : CblasTrans;} + if (trans == 'C') {ctrans = CblasConjTrans; ctrans_copy = (corder == CblasRowMajor) ? CblasConjTrans : CblasConjNoTrans;} + if (trans == 'R') {ctrans = CblasConjNoTrans; ctrans_copy = (corder == CblasRowMajor) ? CblasConjNoTrans : CblasConjTrans;} + + // Perform operation: op(A) + cblas_comatcopy(corder, ctrans_copy, m, n, alpha_one, data_cgemv_t.a_test, lda, data_cgemv_t.a_verify, lda); + + // Find A*x + matrix_vector_product(n, m, lda, inc_x); + + // Find alpha*x+beta*y + cblas_caxpby(n, alpha, data_cgemv_t.x_verify, inc_x, beta, data_cgemv_t.y_verify, inc_y); + + cblas_cgemv(corder, ctrans, m, n, alpha, data_cgemv_t.a_test, + lda, data_cgemv_t.x_test, inc_x, beta, data_cgemv_t.y_test, inc_y); + } + + // Find the differences between output vector caculated by cgemv and reference funcs + for (i = 0; i < m * inc_y * 2; i++) + data_cgemv_t.y_test[i] -= data_cgemv_t.y_verify[i]; + + // Find the norm of differences + return cblas_scnrm2(m, data_cgemv_t.y_test, inc_y); +} + +/** + * Check if error function was called with expected function name + * and param info + * + * param order specifies row or column major order + * param trans specifies op(A), the transposition operation + * applied to the matrix A + * param m specifies number of rows of A + * param n specifies number of columns of A + * param lda specifies leading dimension of the matrix A + * param inc_x specifies increment for vector x + * param inc_y specifies increment for vector y + * param expected_info - expected invalid parameter number + * return TRUE if everything is ok, otherwise FALSE + */ +static int check_badargs(char order, char trans, blasint m, blasint n, + blasint lda, blasint inc_x, blasint inc_y, int expected_info) +{ + float alpha[] = {1.0f, 1.0f}; + float a[] = {1.0f, 1.0f}; + float x[] = {1.0f, 1.0f}; + float beta[] = {1.0f, 1.0f}; + float y[] = {1.0f, 1.0f}; + + set_xerbla("CGEMV ", expected_info); + + BLASFUNC(cgemv)(&trans, &m, &n, alpha, a, &lda, x, &inc_x, beta, y, &inc_y); + + return check_error(); +} + +/** + * C API specific function + * Check if error function was called with expected function name + * and param info + * + * param order specifies row or column major order + * param trans specifies op(A), the transposition operation + * applied to the matrix A + * param m specifies number of rows of A + * param n specifies number of columns of A + * param lda specifies leading dimension of the matrix A + * param inc_x specifies increment for vector x + * param inc_y specifies increment for vector y + * param expected_info - expected invalid parameter number + * return TRUE if everything is ok, otherwise FALSE + */ +static int c_api_check_badargs(CBLAS_ORDER corder, CBLAS_TRANSPOSE ctrans, blasint m, blasint n, + blasint lda, blasint inc_x, blasint inc_y, int expected_info) +{ + float alpha[] = {1.0f, 1.0f}; + float a[] = {1.0f, 1.0f}; + float x[] = {1.0f, 1.0f}; + float beta[] = {1.0f, 1.0f}; + float y[] = {1.0f, 1.0f}; + + set_xerbla("CGEMV ", expected_info); + + cblas_cgemv(corder, ctrans, m, n, alpha, a, lda, x, inc_x, beta, y, inc_y); + + return check_error(); +} + +/** + * Fortran API specific test + * Test cgemv by comparing it against reference + * with the following options: + * + * Column Major + * Transposition + * Square matrix + * inc x = 2, inc y = 1 + * alpha_r = 1.0f, alpha_i = 1.0f + * beta_r = 2.0f, beta_i = 2.0f + */ +CTEST(cgemv, colmajor_trans_col_100_row_100_inc_x_1_y_1) +{ + blasint m = 100, n = 100; + blasint lda = 100; + char order = 'C'; + char trans = 'T'; + + float alpha[] = {2.0f, 1.0f}; + float beta[] = {1.0f, 2.0f}; + + blasint inc_x = 1; + blasint inc_y = 1; + + float norm = check_cgemv('F', order, trans, m, n, alpha, lda, + inc_x, beta, inc_y); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS_ZGEMV); +} + +/** + * Fortran API specific test + * Test cgemv by comparing it against reference + * with the following options: + * + * Column Major + * Transposition + * Square matrix + * inc x = 2, inc y = 1 + * alpha_r = 1.0f, alpha_i = 1.0f + * beta_r = 2.0f, beta_i = 2.0f + */ +CTEST(cgemv, colmajor_trans_col_100_row_100_inc_x_2_y_1) +{ + blasint m = 100, n = 100; + blasint lda = 100; + char order = 'C'; + char trans = 'T'; + + float alpha[] = {1.0f, 1.0f}; + float beta[] = {2.0f, 2.0f}; + + blasint inc_x = 2; + blasint inc_y = 1; + + float norm = check_cgemv('F', order, trans, m, n, alpha, lda, + inc_x, beta, inc_y); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS_ZGEMV); +} + +/** + * Fortran API specific test + * Test cgemv by comparing it against reference + * with the following options: + * + * Column Major + * Transposition and conjugate A + * Square matrix + * inc x = 1, inc y = 1 + * alpha_r = 2.0f, alpha_i = 1.0f + * beta_r = 2.0f, beta_i = 1.0f + */ +CTEST(cgemv, colmajor_conjtrans_col_100_row_100_inc_x_1_y_1) +{ + blasint m = 100, n = 100; + blasint lda = 100; + char order = 'C'; + char trans = 'C'; + + float alpha[] = {2.0f, 1.0f}; + float beta[] = {2.0f, 1.0f}; + + blasint inc_x = 1; + blasint inc_y = 1; + + float norm = check_cgemv('F', order, trans, m, n, alpha, lda, + inc_x, beta, inc_y); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS_ZGEMV); +} + +/** + * Fortran API specific test + * Test cgemv by comparing it against reference + * with the following options: + * + * Column Major + * Transposition and conjugate A + * Square matrix + * inc x = 1, inc y = 2 + * alpha_r = 2.0f, alpha_i = 1.0f + * beta_r = 2.0f, beta_i = 1.0f + */ +CTEST(cgemv, colmajor_conjtrans_col_100_row_100_inc_x_1_y_2) +{ + blasint m = 100, n = 100; + blasint lda = 100; + char order = 'C'; + char trans = 'C'; + + float alpha[] = {1.0f, 1.0f}; + float beta[] = {1.0f, 1.0f}; + + blasint inc_x = 1; + blasint inc_y = 2; + + float norm = check_cgemv('F', order, trans, m, n, alpha, lda, + inc_x, beta, inc_y); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS_ZGEMV); +} + +/** + * Fortran API specific test + * Test cgemv by comparing it against reference + * with the following options: + * + * Column Major + * Transposition and x conjugate + * Square matrix + * inc x = 1, inc y = 1 + * alpha_r = 2.0f, alpha_i = 1.0f + * beta_r = 2.0f, beta_i = 1.0f + */ +CTEST(cgemv, colmajor_trans_x_conj_col_100_row_100_inc_x_1_y_1) +{ + blasint m = 100, n = 100; + blasint lda = 100; + char order = 'C'; + char trans = 'U'; + + float alpha[] = {1.0f, 1.0f}; + float beta[] = {1.0f, 1.0f}; + + blasint inc_x = 1; + blasint inc_y = 1; + + float norm = check_cgemv('F', order, trans, m, n, alpha, lda, + inc_x, beta, inc_y); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS_ZGEMV); +} + +/** + * Fortran API specific test + * Test cgemv by comparing it against reference + * with the following options: + * + * Column Major + * Transposition and x conjugate + * Square matrix + * inc x = 2, inc y = 2 + * alpha_r = 1.0f, alpha_i = 2.0f + * beta_r = 1.0f, beta_i = 1.0f + */ +CTEST(cgemv, colmajor_trans_x_conj_col_100_row_100_inc_x_2_y_2) +{ + blasint m = 100, n = 100; + blasint lda = 100; + char order = 'C'; + char trans = 'U'; + + float alpha[] = {1.0f, 2.0f}; + float beta[] = {1.0f, 1.0f}; + + blasint inc_x = 2; + blasint inc_y = 2; + + float norm = check_cgemv('F', order, trans, m, n, alpha, lda, + inc_x, beta, inc_y); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS_ZGEMV); +} + + +/** + * Fortran API specific test + * Test cgemv by comparing it against reference + * with the following options: + * + * Column Major + * Transposition, conjugate A, conjugate x + * Square matrix + * inc x = 2, inc y = 2 + * alpha_r = 2.0f, alpha_i = 1.0f + * beta_r = 1.0f, beta_i = 2.0f + */ +CTEST(cgemv, colmajor_conjtrans_x_conj_col_100_row_100_inc_x_1_y_2) +{ + blasint m = 100, n = 100; + blasint lda = 100; + char order = 'C'; + char trans = 'D'; + + float alpha[] = {2.0f, 1.0f}; + float beta[] = {1.0f, 2.0f}; + + blasint inc_x = 1; + blasint inc_y = 2; + + float norm = check_cgemv('F', order, trans, m, n, alpha, lda, + inc_x, beta, inc_y); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS_ZGEMV); +} + +/** + * C API specific test + * Test cgemv by comparing it against reference + * with the following options: + * + * Column Major + * Transposition, conjugate A, conjugate x + * Square matrix + * inc x = 2, inc y = 1 + * alpha_r = 2.0f, alpha_i = 1.0f + * beta_r = 1.0f, beta_i = 2.0f + */ +CTEST(cgemv, c_api_colmajor_trans_col_100_row_100_inc_x_1_y_1) +{ + blasint m = 100, n = 100; + blasint lda = 100; + char order = 'C'; + char trans = 'T'; + + float alpha[] = {2.0f, 1.0f}; + float beta[] = {1.0f, 2.0f}; + + blasint inc_x = 1; + blasint inc_y = 1; + + float norm = check_cgemv('C', order, trans, m, n, alpha, lda, + inc_x, beta, inc_y); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS_ZGEMV); +} + +/** + * C API specific test + * Test cgemv by comparing it against reference + * with the following options: + * + * Column Major + * Transposition and conjugate A + * Square matrix + * inc x = 2, inc y = 1 + * alpha_r = 1.0f, alpha_i = 1.0f + * beta_r = 1.0f, beta_i = 2.0f + */ +CTEST(cgemv, c_api_colmajor_conjtrans_col_100_row_100_inc_x_1_y_1) +{ + blasint m = 100, n = 100; + blasint lda = 100; + char order = 'C'; + char trans = 'C'; + + float alpha[] = {1.0f, 1.0f}; + float beta[] = {1.0f, 2.0f}; + + blasint inc_x = 1; + blasint inc_y = 1; + + float norm = check_cgemv('C', order, trans, m, n, alpha, lda, + inc_x, beta, inc_y); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS_ZGEMV); +} + +/** + * C API specific test + * Test cgemv by comparing it against reference + * with the following options: + * + * Column Major + * Transposition and conjugate A + * Square matrix + * inc x = 1, inc y = 2 + * alpha_r = 1.0f, alpha_i = 1.0f + * beta_r = 1.0f, beta_i = 2.0f + */ +CTEST(cgemv, c_api_colmajor_conjtrans_col_100_row_100_inc_x_1_y_2) +{ + blasint m = 100, n = 100; + blasint lda = 100; + char order = 'C'; + char trans = 'C'; + + float alpha[] = {1.0f, 1.0f}; + float beta[] = {1.0f, 2.0f}; + + blasint inc_x = 1; + blasint inc_y = 2; + + float norm = check_cgemv('C', order, trans, m, n, alpha, lda, + inc_x, beta, inc_y); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS_ZGEMV); +} + +/** + * C API specific test + * Test cgemv by comparing it against reference + * with the following options: + * + * Row Major + * Square matrix + * inc x = 1, inc y = 1 + * alpha_r = 2.0f, alpha_i = 1.0f + * beta_r = 1.0f, beta_i = 1.0f + */ +CTEST(cgemv, c_api_rowmajor_notrans_col_100_row_100_inc_x_1_y_1) +{ + blasint m = 100, n = 100; + blasint lda = 100; + char order = 'R'; + char trans = 'N'; + + float alpha[] = {2.0f, 1.0f}; + float beta[] = {1.0f, 1.0f}; + + blasint inc_x = 1; + blasint inc_y = 1; + + float norm = check_cgemv('C', order, trans, m, n, alpha, lda, + inc_x, beta, inc_y); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS_ZGEMV); +} + +/** + * C API specific test + * Test cgemv by comparing it against reference + * with the following options: + * + * Row Major + * No trans + * Square matrix + * inc x = 2, inc y = 2 + * alpha_r = 1.0f, alpha_i = 1.0f + * beta_r = 3.0f, beta_i = 2.0f + */ +CTEST(cgemv, c_api_rowmajor_notrans_col_100_row_100_inc_x_2_y_2) +{ + blasint m = 100, n = 100; + blasint lda = 100; + char order = 'R'; + char trans = 'N'; + + float alpha[] = {1.0f, 1.0f}; + float beta[] = {3.0f, 1.0f}; + + blasint inc_x = 2; + blasint inc_y = 2; + + float norm = check_cgemv('C', order, trans, m, n, alpha, lda, + inc_x, beta, inc_y); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS_ZGEMV); +} + +/** + * C API specific test + * Test cgemv by comparing it against reference + * with the following options: + * + * Column Major + * Conjugate + * Square matrix + * inc x = 1, inc y = 1 + * alpha_r = 1.0f, alpha_i = 3.0f + * beta_r = 1.0f, beta_i = 2.5f + */ +CTEST(cgemv, c_api_rowmajor_conj_col_100_row_100_inc_x_1_y_1) +{ + blasint m = 100, n = 100; + blasint lda = 100; + char order = 'R'; + char trans = 'R'; + + float alpha[] = {1.0f, 3.0f}; + float beta[] = {1.0f, 2.5f}; + + blasint inc_x = 1; + blasint inc_y = 1; + + float norm = check_cgemv('C', order, trans, m, n, alpha, lda, + inc_x, beta, inc_y); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS_ZGEMV); +} + +/** + * C API specific test + * Test cgemv by comparing it against reference + * with the following options: + * + * Row Major + * Conjugate + * Square matrix + * inc x = 2, inc y = 1 + * alpha_r = 1.0f, alpha_i = 1.0f + * beta_r = 1.0f, beta_i = 1.5f + */ +CTEST(cgemv, c_api_rowmajor_conj_col_100_row_100_inc_x_2_y_1) +{ + blasint m = 100, n = 100; + blasint lda = 100; + char order = 'R'; + char trans = 'R'; + + float alpha[] = {1.0f, 1.0f}; + float beta[] = {1.0f, 1.5f}; + + blasint inc_x = 2; + blasint inc_y = 1; + + float norm = check_cgemv('C', order, trans, m, n, alpha, lda, + inc_x, beta, inc_y); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS_ZGEMV); +} + +/** + * Fortran API specific test + * Test error function for an invalid param inc_y. + * Must be positive + * + * Column major + */ +CTEST(cgemv, xerbla_invalid_inc_y) +{ + char order = 'C'; + char trans = 'T'; + + blasint m = 1, n = 1; + blasint lda = 1; + + blasint inc_x = 1; + blasint inc_y = 0; + + int expected_info = 11; + + int passed = check_badargs(order, trans, m, n, lda, inc_x, inc_y, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param inc_y. + * Must be positive + * + * Column major + */ +CTEST(cgemv, c_api_xerbla_invalid_inc_y_col_major) +{ + enum CBLAS_ORDER corder = CblasColMajor; + enum CBLAS_TRANSPOSE ctrans = CblasTrans; + + blasint m = 1, n = 1; + blasint lda = 1; + + blasint inc_x = 1; + blasint inc_y = 0; + + int expected_info = 11; + + int passed = c_api_check_badargs(corder, ctrans, m, n, lda, inc_x, inc_y, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param inc_y. + * Must be positive + * + * Row major + */ +CTEST(cgemv, c_api_xerbla_invalid_inc_y_row_major) +{ + enum CBLAS_ORDER corder = CblasRowMajor; + enum CBLAS_TRANSPOSE ctrans = CblasNoTrans; + + blasint m = 1, n = 1; + blasint lda = 1; + + blasint inc_x = 1; + blasint inc_y = 0; + + int expected_info = 11; + + int passed = c_api_check_badargs(corder, ctrans, m, n, lda, inc_x, inc_y, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param inc_x. + * Must be positive + * + * Column major + */ +CTEST(cgemv, xerbla_invalid_inc_x) +{ + char order = 'C'; + char trans = 'T'; + blasint m = 1, n = 1; + blasint lda = 1; + + blasint inc_x = 0; + blasint inc_y = 1; + + int expected_info = 8; + + int passed = check_badargs(order, trans, m, n, lda, inc_x, inc_y, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param inc_x. + * Must be positive + * + * Column major + */ +CTEST(cgemv, c_api_xerbla_invalid_inc_x_col_major) +{ + enum CBLAS_ORDER corder = CblasColMajor; + enum CBLAS_TRANSPOSE ctrans = CblasTrans; + + blasint m = 1, n = 1; + blasint lda = 1; + + blasint inc_x = 0; + blasint inc_y = 1; + + int expected_info = 8; + + int passed = c_api_check_badargs(corder, ctrans, m, n, lda, inc_x, inc_y, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param inc_x. + * Must be positive + * + * Row major + */ +CTEST(cgemv, c_api_xerbla_invalid_inc_x_row_major) +{ + enum CBLAS_ORDER corder = CblasColMajor; + enum CBLAS_TRANSPOSE ctrans = CblasTrans; + + blasint m = 1, n = 1; + blasint lda = 1; + + blasint inc_x = 0; + blasint inc_y = 1; + + int expected_info = 8; + + int passed = c_api_check_badargs(corder, ctrans, m, n, lda, inc_x, inc_y, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param n. + * Must be positive. + * + * Column major + */ +CTEST(cgemv, xerbla_invalid_n) +{ + char order = 'C'; + char trans = 'T'; + + blasint m = 1, n = INVALID; + blasint lda = 1; + + blasint inc_x = 1; + blasint inc_y = 1; + + int expected_info = 3; + + int passed = check_badargs(order, trans, m, n, lda, inc_x, inc_y, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param n. + * Must be positive. + * + * Column major + */ +CTEST(cgemv, c_api_xerbla_invalid_n_col_major) +{ + enum CBLAS_ORDER corder = CblasColMajor; + enum CBLAS_TRANSPOSE ctrans = CblasTrans; + + blasint m = 1, n = INVALID; + blasint lda = 1; + + blasint inc_x = 1; + blasint inc_y = 1; + + int expected_info = 3; + + int passed = c_api_check_badargs(corder, ctrans, m, n, lda, inc_x, inc_y, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param n. + * Must be positive. + * + * Row major + */ +CTEST(cgemv, c_api_xerbla_invalid_n_row_major) +{ + enum CBLAS_ORDER corder = CblasRowMajor; + enum CBLAS_TRANSPOSE ctrans = CblasNoTrans; + + blasint m = INVALID, n = 1; + blasint lda = 1; + + blasint inc_x = 1; + blasint inc_y = 1; + + int expected_info = 3; + + int passed = c_api_check_badargs(corder, ctrans, m, n, lda, inc_x, inc_y, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param m. + * Must be positive. + * + * Column major + */ +CTEST(cgemv, xerbla_invalid_m) +{ + char order = 'C'; + char trans = 'T'; + + blasint m = INVALID, n = 1; + blasint lda = 1; + + blasint inc_x = 1; + blasint inc_y = 1; + + int expected_info = 2; + + int passed = check_badargs(order, trans, m, n, lda, inc_x, inc_y, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param m. + * Must be positive. + * + * Column major + */ +CTEST(cgemv, c_api_xerbla_invalid_m_col_major) +{ + enum CBLAS_ORDER corder = CblasColMajor; + enum CBLAS_TRANSPOSE ctrans = CblasTrans; + + blasint m = INVALID, n = 1; + blasint lda = 1; + + blasint inc_x = 1; + blasint inc_y = 1; + + int expected_info = 2; + + int passed = c_api_check_badargs(corder, ctrans, m, n, lda, inc_x, inc_y, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param m. + * Must be positive. + * + * Row major + */ +CTEST(cgemv, c_api_xerbla_invalid_m_row_major) +{ + enum CBLAS_ORDER corder = CblasRowMajor; + enum CBLAS_TRANSPOSE ctrans = CblasNoTrans; + + blasint m = 1, n = INVALID; + blasint lda = 1; + + blasint inc_x = 1; + blasint inc_y = 1; + + int expected_info = 2; + + int passed = c_api_check_badargs(corder, ctrans, m, n, lda, inc_x, inc_y, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param lda. + * lda must be at least n. + * + * Column major + */ +CTEST(cgemv, xerbla_invalid_lda) +{ + char order = 'C'; + char trans = 'T'; + + blasint m = 1, n = 1; + blasint lda = INVALID; + + blasint inc_x = 1; + blasint inc_y = 1; + + int expected_info = 6; + + int passed = check_badargs(order, trans, m, n, lda, inc_x, inc_y, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param lda. + * If matrices are stored using col major layout, + * lda must be at least m. + * + * Column major + */ +CTEST(cgemv, c_api_xerbla_invalid_lda_col_major) +{ + enum CBLAS_ORDER corder = CblasColMajor; + enum CBLAS_TRANSPOSE ctrans = CblasTrans; + + blasint m = 1, n = 1; + blasint lda = INVALID; + + blasint inc_x = 1; + blasint inc_y = 1; + + int expected_info = 6; + + int passed = c_api_check_badargs(corder, ctrans, m, n, lda, inc_x, inc_y, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param lda. + * If matrices are stored using col major layout, + * lda must be at least n. + * + * Column major + */ +CTEST(cgemv, c_api_xerbla_invalid_lda_row_major) +{ + enum CBLAS_ORDER corder = CblasRowMajor; + enum CBLAS_TRANSPOSE ctrans = CblasNoTrans; + + blasint m = 1, n = 1; + blasint lda = INVALID; + + blasint inc_x = 1; + blasint inc_y = 1; + + int expected_info = 6; + + int passed = c_api_check_badargs(corder, ctrans, m, n, lda, inc_x, inc_y, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param trans. + * + * Column major + */ +CTEST(cgemv, xerbla_invalid_trans) +{ + char order = 'C'; + char trans = 'Z'; + + blasint m = 1, n = 1; + blasint lda = 1; + + blasint inc_x = 1; + blasint inc_y = 1; + + int expected_info = 1; + + int passed = check_badargs(order, trans, m, n, lda, inc_x, inc_y, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param trans. + * + * Column major + */ +CTEST(cgemv, c_api_xerbla_invalid_trans_col_major) +{ + enum CBLAS_ORDER corder = CblasColMajor; + enum CBLAS_TRANSPOSE ctrans = INVALID; + + blasint m = 1, n = 1; + blasint lda = 1; + + blasint inc_x = 1; + blasint inc_y = 1; + + int expected_info = 1; + + int passed = c_api_check_badargs(corder, ctrans, m, n, lda, inc_x, inc_y, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param trans. + * + * Row major + */ +CTEST(cgemv, c_api_xerbla_invalid_trans_row_major) +{ + enum CBLAS_ORDER corder = CblasRowMajor; + enum CBLAS_TRANSPOSE ctrans = INVALID; + + blasint m = 1, n = 1; + blasint lda = 1; + + blasint inc_x = 1; + blasint inc_y = 1; + + int expected_info = 1; + + int passed = c_api_check_badargs(corder, ctrans, m, n, lda, inc_x, inc_y, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param order. + */ +CTEST(cgemv, c_api_xerbla_invalid_order_col_major) +{ + enum CBLAS_ORDER corder = INVALID; + enum CBLAS_TRANSPOSE ctrans = CblasTrans; + + blasint m = 1, n = 1; + blasint lda = 1; + + blasint inc_x = 1; + blasint inc_y = 1; + + int expected_info = 0; + + int passed = c_api_check_badargs(corder, ctrans, m, n, lda, inc_x, inc_y, expected_info); + ASSERT_EQUAL(TRUE, passed); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_cimatcopy.c b/utest/test_extensions/test_cimatcopy.c new file mode 100644 index 000000000..800f8a2d1 --- /dev/null +++ b/utest/test_extensions/test_cimatcopy.c @@ -0,0 +1,850 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. 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. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include "common.h" + +#define DATASIZE 100 + +struct DATA_CIMATCOPY { + float a_test[DATASIZE * DATASIZE * 2]; + float a_verify[DATASIZE * DATASIZE * 2]; +}; + +#ifdef BUILD_COMPLEX +static struct DATA_CIMATCOPY data_cimatcopy; + +/** + * Comapare results computed by cimatcopy and reference func + * + * param api specifies tested api (C or Fortran) + * param order specifies row or column major order + * param trans specifies op(A), the transposition operation + * applied to the matrix A + * param rows specifies number of rows of A + * param cols specifies number of columns of A + * param alpha specifies scaling factor for matrix A + * param lda_src - leading dimension of the matrix A + * param lda_dst - leading dimension of output matrix A + * return norm of difference between openblas and reference func + */ +static float check_cimatcopy(char api, char order, char trans, blasint rows, blasint cols, float *alpha, + blasint lda_src, blasint lda_dst) +{ + blasint m, n; + blasint rows_out, cols_out; + enum CBLAS_ORDER corder; + enum CBLAS_TRANSPOSE ctrans; + int conj = -1; + + if (order == 'C') { + n = rows; m = cols; + } + else { + m = rows; n = cols; + } + + if(trans == 'T' || trans == 'C') { + rows_out = n; cols_out = m*2; + if (trans == 'C') + conj = 1; + } + else { + rows_out = m; cols_out = n*2; + if (trans == 'R') + conj = 1; + } + + srand_generate(data_cimatcopy.a_test, lda_src*m*2); + + if (trans == 'T' || trans == 'C') { + ctranspose(m, n, alpha, data_cimatcopy.a_test, lda_src, data_cimatcopy.a_verify, lda_dst, conj); + } + else { + ccopy(m, n, alpha, data_cimatcopy.a_test, lda_src, data_cimatcopy.a_verify, lda_dst, conj); + } + + if (api == 'F') { + BLASFUNC(cimatcopy)(&order, &trans, &rows, &cols, alpha, data_cimatcopy.a_test, + &lda_src, &lda_dst); + } + else { + if (order == 'C') corder = CblasColMajor; + if (order == 'R') corder = CblasRowMajor; + if (trans == 'T') ctrans = CblasTrans; + if (trans == 'N') ctrans = CblasNoTrans; + if (trans == 'C') ctrans = CblasConjTrans; + if (trans == 'R') ctrans = CblasConjNoTrans; + cblas_cimatcopy(corder, ctrans, rows, cols, alpha, data_cimatcopy.a_test, + lda_src, lda_dst); + } + + // Find the differences between output matrix computed by cimatcopy and reference func + return smatrix_difference(data_cimatcopy.a_test, data_cimatcopy.a_verify, cols_out, rows_out, 2*lda_dst); +} + +/** + * Check if error function was called with expected function name + * and param info + * + * param order specifies row or column major order + * param trans specifies op(A), the transposition operation + * applied to the matrix A + * param rows specifies number of rows of A + * param cols specifies number of columns of A + * param lda_src - leading dimension of the matrix A + * param lda_dst - leading dimension of output matrix A + * param expected_info - expected invalid parameter number + * return TRUE if everything is ok, otherwise FALSE + */ +static int check_badargs(char order, char trans, blasint rows, blasint cols, + blasint lda_src, blasint lda_dst, int expected_info) +{ + float alpha[] = {1.0f, 1.0f}; + + set_xerbla("CIMATCOPY", expected_info); + + BLASFUNC(cimatcopy)(&order, &trans, &rows, &cols, alpha, data_cimatcopy.a_test, + &lda_src, &lda_dst); + + return check_error(); +} + +/** + * Fortran API specific test + * Test cimatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Transposition + * Square matrix + * alpha_r = 1.0, alpha_i = 2.0 + */ +CTEST(cimatcopy, colmajor_trans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'C'; + char trans = 'T'; + float alpha[] = {1.0f, 2.0f}; + + float norm = check_cimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test cimatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Copy only + * Square matrix + * alpha_r = -3.0, alpha_i = 1.0 + */ +CTEST(cimatcopy, colmajor_notrans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'C'; + char trans = 'N'; + float alpha[] = {-3.0f, 1.0f}; + + float norm = check_cimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test cimatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Copy and conjugate + * alpha_r = 1.0, alpha_i = 2.0 + */ +CTEST(cimatcopy, colmajor_conj_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'C'; + char trans = 'R'; + float alpha[] = {1.0f, 2.0f}; + + float norm = check_cimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test cimatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Transposition and conjugate + * alpha_r = 2.0, alpha_i = 1.0 + */ +CTEST(cimatcopy, colmajor_conjtrans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'C'; + char trans = 'C'; + float alpha[] = {2.0f, 1.0f}; + + float norm = check_cimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test cimatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Transposition + * Rectangular matrix + * alpha_r = 1.0, alpha_i = 2.0 + */ +CTEST(cimatcopy, colmajor_trans_col_50_row_100) +{ + blasint m = 100, n = 50; + blasint lda_src = 100, lda_dst = 50; + char order = 'C'; + char trans = 'T'; + float alpha[] = {1.0f, 2.0f}; + + float norm = check_cimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test cimatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Copy only + * Rectangular matrix + * alpha_r = 1.0, alpha_i = 2.0 + */ +CTEST(cimatcopy, colmajor_notrans_col_100_row_50) +{ + blasint m = 50, n = 100; + blasint lda_src = 50, lda_dst = 50; + char order = 'C'; + char trans = 'N'; + float alpha[] = {1.0f, 2.0f}; + + float norm = check_cimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific tests + * Test cimatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Transposition and conjugate + * Rectangular matrix + * alpha_r = 1.0, alpha_i = 1.0 + */ +CTEST(cimatcopy, colmajor_conjtrans_col_50_row_100) +{ + blasint m = 100, n = 50; + blasint lda_src = 100, lda_dst = 50; + char order = 'C'; + char trans = 'C'; + float alpha[] = {1.0f, 1.0f}; + + float norm = check_cimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test cimatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Copy and conjugate + * Rectangular matrix + * alpha_r = 1.0, alpha_i = 2.0 + */ +CTEST(cimatcopy, colmajor_conj_col_100_row_50) +{ + blasint m = 50, n = 100; + blasint lda_src = 50, lda_dst = 50; + char order = 'C'; + char trans = 'R'; + float alpha[] = {1.0f, 2.0f}; + + float norm = check_cimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test cimatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Transposition + * Square matrix + * alpha_r = 1.0, alpha_i = 2.0 + */ +CTEST(cimatcopy, rowmajor_trans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'R'; + char trans = 'T'; + float alpha[] = {1.0f, 2.0f}; + + float norm = check_cimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test cimatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Copy only + * Square matrix + * alpha_r = 2.0, alpha_i = 3.0 + */ +CTEST(cimatcopy, rowmajor_notrans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'R'; + char trans = 'N'; + float alpha[] = {2.0f, 3.0f}; + + float norm = check_cimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific tests + * Test cimatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Copy and conjugate + * alpha_r = 1.0, alpha_i = 2.0 + */ +CTEST(cimatcopy, rowmajor_conj_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'R'; + char trans = 'R'; + float alpha[] = {1.0f, 2.0f}; + + float norm = check_cimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific tests + * Test cimatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Transposition and conjugate + * alpha_r = 2.0, alpha_i = 1.0 + */ +CTEST(cimatcopy, rowmajor_conjtrans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'R'; + char trans = 'C'; + float alpha[] = {2.0f, 1.0f}; + + float norm = check_cimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test cimatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Copy only + * Rectangular matrix + * alpha_r = 2.0, alpha_i = 1.0 + */ +CTEST(cimatcopy, rowmajor_notrans_col_50_row_100) +{ + blasint m = 100, n = 50; + blasint lda_src = 50, lda_dst = 50; + char order = 'R'; + char trans = 'N'; + float alpha[] = {2.0f, 1.0f}; + + float norm = check_cimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test cimatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Transposition + * Rectangular matrix + * alpha_r = 1.0, alpha_i = 2.0 + */ +CTEST(cimatcopy, rowmajor_trans_col_50_row_100) +{ + blasint m = 100, n = 50; + blasint lda_src = 50, lda_dst = 100; + char order = 'R'; + char trans = 'T'; + float alpha[] = {1.0f, 2.0f}; + + float norm = check_cimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test cimatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Copy and conjugate + * alpha_r = 1.5, alpha_i = -1.0 + */ +CTEST(cimatcopy, rowmajor_conj_col_50_row_100) +{ + blasint m = 100, n = 50; + blasint lda_src = 50, lda_dst = 50; + char order = 'R'; + char trans = 'R'; + float alpha[] = {1.5f, -1.0f}; + + float norm = check_cimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test cimatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Transposition and conjugate + * alpha_r = 1.0, alpha_i = 2.0 + */ +CTEST(cimatcopy, rowmajor_conjtrans_col_50_row_100) +{ + blasint m = 100, n = 50; + blasint lda_src = 50, lda_dst = 100; + char order = 'R'; + char trans = 'C'; + float alpha[] = {1.0f, 2.0f}; + + float norm = check_cimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cimatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Transposition + * Square matrix + * alpha_r = 3.0, alpha_i = 2.0 + */ +CTEST(cimatcopy, c_api_colmajor_trans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'C'; + char trans = 'T'; + float alpha[] = {3.0f, 2.0f}; + + float norm = check_cimatcopy('C', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cimatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Copy only + * Square matrix + * alpha_r = 3.0, alpha_i = 1.5 + */ +CTEST(cimatcopy, c_api_colmajor_notrans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'C'; + char trans = 'N'; + float alpha[] = {3.0f, 1.5f}; + + float norm = check_cimatcopy('C', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cimatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Transposition + * Square matrix + * alpha_r = 3.0, alpha_i = 1.0 + */ +CTEST(cimatcopy, c_api_rowmajor_trans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'R'; + char trans = 'T'; + float alpha[] = {3.0f, 1.0f}; + + float norm = check_cimatcopy('C', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cimatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Copy and conjugate + * alpha_r = 1.0, alpha_i = 2.0 + */ +CTEST(cimatcopy, c_api_colmajor_conj_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'C'; + char trans = 'R'; + float alpha[] = {1.0f, 2.0f}; + + float norm = check_cimatcopy('C', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cimatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Transposition and conjugate + * alpha_r = 2.0, alpha_i = 1.0 + */ +CTEST(cimatcopy, c_api_colmajor_conjtrans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'C'; + char trans = 'C'; + float alpha[] = {2.0f, 1.0f}; + + float norm = check_cimatcopy('C', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cimatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Copy only + * Square matrix + * alpha_r = 1.0, alpha_i = 1.0 + */ +CTEST(cimatcopy, c_api_rowmajor_notrans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'R'; + char trans = 'N'; + float alpha[] = {1.0f, 1.0f}; + + float norm = check_cimatcopy('C', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test cimatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Copy and conjugate + * alpha_r = 1.5, alpha_i = -1.0 + */ +CTEST(cimatcopy, c_api_rowmajor_conj_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'R'; + char trans = 'R'; + float alpha[] = {1.5f, -1.0f}; + + float norm = check_cimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test cimatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Transposition and conjugate + * alpha_r = 1.0, alpha_i = 2.0 + */ +CTEST(cimatcopy, c_api_rowmajor_conjtrans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'R'; + char trans = 'C'; + float alpha[] = {1.0f, 2.0f}; + + float norm = check_cimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Test error function for an invalid param order. + * Must be column (C) or row major (R). + */ +CTEST(cimatcopy, xerbla_invalid_order) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'O'; + char trans = 'T'; + int expected_info = 1; + + int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param trans. + * Must be trans (T/C) or no-trans (N/R). + */ +CTEST(cimatcopy, xerbla_invalid_trans) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'C'; + char trans = 'O'; + int expected_info = 2; + + int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param m. + * Must be positive. + */ +CTEST(cimatcopy, xerbla_invalid_rows) +{ + blasint m = 0, n = 100; + blasint lda_src = 0, lda_dst = 100; + char order = 'C'; + char trans = 'T'; + int expected_info = 3; + + int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param n. + * Must be positive. + */ +CTEST(cimatcopy, xerbla_invalid_cols) +{ + blasint m = 100, n = 0; + blasint lda_src = 100, lda_dst = 0; + char order = 'C'; + char trans = 'T'; + int expected_info = 4; + + int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param lda_src. + * If matrices are stored using row major layout, + * lda_src must be at least n. + */ +CTEST(cimatcopy, xerbla_rowmajor_invalid_lda) +{ + blasint m = 50, n = 100; + blasint lda_src = 50, lda_dst = 100; + char order = 'R'; + char trans = 'T'; + int expected_info = 7; + + int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param lda_src. + * If matrices are stored using column major layout, + * lda_src must be at least m. + */ +CTEST(cimatcopy, xerbla_colmajor_invalid_lda) +{ + blasint m = 100, n = 50; + blasint lda_src = 50, lda_dst = 100; + char order = 'C'; + char trans = 'T'; + int expected_info = 7; + + int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param lda_dst. + * If matrices are stored using row major layout and + * there is no transposition, lda_dst must be at least n. + */ +CTEST(cimatcopy, xerbla_rowmajor_notrans_invalid_ldb) +{ + blasint m = 50, n = 100; + blasint lda_src = 100, lda_dst = 50; + char order = 'R'; + char trans = 'N'; + int expected_info = 9; + + int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param lda_dst. + * If matrices are stored using row major layout and + * there is transposition, lda_dst must be at least m. + */ +CTEST(cimatcopy, xerbla_rowmajor_trans_invalid_ldb) +{ + blasint m = 100, n = 50; + blasint lda_src = 100, lda_dst = 50; + char order = 'R'; + char trans = 'T'; + int expected_info = 9; + + int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param lda_dst. + * If matrices are stored using column major layout and + * there is no transposition, lda_dst must be at least m. + */ +CTEST(cimatcopy, xerbla_colmajor_notrans_invalid_ldb) +{ + blasint m = 100, n = 50; + blasint lda_src = 100, lda_dst = 50; + char order = 'C'; + char trans = 'N'; + int expected_info = 9; + + int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param lda_dst. + * If matrices are stored using column major layout and + * there is transposition, lda_dst must be at least n. + */ +CTEST(cimatcopy, xerbla_colmajor_trans_invalid_ldb) +{ + blasint m = 50, n = 100; + blasint lda_src = 100, lda_dst = 50; + char order = 'C'; + char trans = 'T'; + int expected_info = 9; + + int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); + ASSERT_EQUAL(TRUE, passed); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_comatcopy.c b/utest/test_extensions/test_comatcopy.c new file mode 100644 index 000000000..8a3d5ee7b --- /dev/null +++ b/utest/test_extensions/test_comatcopy.c @@ -0,0 +1,728 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. 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. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include "common.h" + +#define DATASIZE 100 + +struct DATA_COMATCOPY { + float a_test[DATASIZE * DATASIZE * 2]; + float b_test[DATASIZE * DATASIZE * 2]; + float b_verify[DATASIZE * DATASIZE * 2]; +}; + +#ifdef BUILD_COMPLEX +static struct DATA_COMATCOPY data_comatcopy; + +/** + * Comapare results computed by comatcopy and reference func + * + * param api specifies tested api (C or Fortran) + * param order specifies row or column major order + * param trans specifies op(A), the transposition operation + * applied to the matrix A + * param rows - number of rows of A + * param cols - number of columns of A + * param alpha - scaling factor for matrix B + * param lda - leading dimension of the matrix A + * param ldb - leading dimension of the matrix B + * return norm of difference between openblas and reference func + */ +static float check_comatcopy(char api, char order, char trans, blasint rows, blasint cols, float* alpha, + blasint lda, blasint ldb) +{ + blasint b_rows, b_cols; + blasint m, n; + enum CBLAS_ORDER corder; + enum CBLAS_TRANSPOSE ctrans; + int conj = -1; + + if (order == 'C') { + m = cols; n = rows; + } + else { + m = rows; n = cols; + } + + if(trans == 'T' || trans == 'C') { + b_rows = n; b_cols = m*2; + if (trans == 'C') + conj = 1; + } + else { + b_rows = m; b_cols = n*2; + if (trans == 'R') + conj = 1; + } + + srand_generate(data_comatcopy.a_test, lda*m*2); + + if (trans == 'T' || trans == 'C') { + ctranspose(m, n, alpha, data_comatcopy.a_test, lda, data_comatcopy.b_verify, ldb, conj); + } + else { + ccopy(m, n, alpha, data_comatcopy.a_test, lda, data_comatcopy.b_verify, ldb, conj); + } + + if (api == 'F') { + BLASFUNC(comatcopy)(&order, &trans, &rows, &cols, alpha, data_comatcopy.a_test, + &lda, data_comatcopy.b_test, &ldb); + } + else { + if (order == 'C') corder = CblasColMajor; + if (order == 'R') corder = CblasRowMajor; + if (trans == 'T') ctrans = CblasTrans; + if (trans == 'N') ctrans = CblasNoTrans; + if (trans == 'C') ctrans = CblasConjTrans; + if (trans == 'R') ctrans = CblasConjNoTrans; + cblas_comatcopy(corder, ctrans, rows, cols, alpha, data_comatcopy.a_test, + lda, data_comatcopy.b_test, ldb); + } + + return smatrix_difference(data_comatcopy.b_test, data_comatcopy.b_verify, b_cols, b_rows, ldb*2); +} + +/** + * Check if error function was called with expected function name + * and param info + * + * param order specifies row or column major order + * param trans specifies op(A), the transposition operation + * applied to the matrix A + * param rows - number of rows of A + * param cols - number of columns of A + * param lda - leading dimension of the matrix A + * param ldb - leading dimension of the matrix B + * param expected_info - expected invalid parameter number + * return TRUE if everything is ok, otherwise FALSE + */ +static int check_badargs(char order, char trans, blasint rows, blasint cols, + blasint lda, blasint ldb, int expected_info) +{ + float alpha[] = {1.0f, 1.0f}; + + set_xerbla("COMATCOPY", expected_info); + + BLASFUNC(comatcopy)(&order, &trans, &rows, &cols, alpha, data_comatcopy.a_test, + &lda, data_comatcopy.b_test, &ldb); + + return check_error(); +} + +/** + * Fortran API specific test + * Test comatcopy by comparing it against refernce + * with the following options: + * + * Column Major + * Copy only + * alpha_r = 1.0, alpha_i = 2.0 + */ +CTEST(comatcopy, colmajor_notrans_col_50_row_100) +{ + blasint m = 100, n = 50; + blasint lda = 100, ldb = 100; + char order = 'C'; + char trans = 'N'; + float alpha[] = {1.0f, 2.0f}; + + float norm = check_comatcopy('F', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test comatcopy by comparing it against refernce + * with the following options: + * + * Column Major + * Transposition + * alpha_r = -1.0, alpha_i = 2.0 + */ +CTEST(comatcopy, colmajor_trans_col_50_row_100) +{ + blasint m = 100, n = 50; + blasint lda = 100, ldb = 50; + char order = 'C'; + char trans = 'T'; + float alpha[] = {-1.0f, 2.0f}; + + float norm = check_comatcopy('F', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test comatcopy by comparing it against refernce + * with the following options: + * + * Column Major + * Copy and conjugate + * alpha_r = 1.0, alpha_i = 2.0 + */ +CTEST(comatcopy, colmajor_conj_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda = 100, ldb = 100; + char order = 'C'; + char trans = 'R'; + float alpha[] = {1.0f, 2.0f}; + + float norm = check_comatcopy('F', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test comatcopy by comparing it against refernce + * with the following options: + * + * Column Major + * Transposition and conjugate + * alpha_r = 2.0, alpha_i = 1.0 + */ +CTEST(comatcopy, colmajor_conjtrnas_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda = 100, ldb = 100; + char order = 'C'; + char trans = 'C'; + float alpha[] = {2.0f, 1.0f}; + + float norm = check_comatcopy('F', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test comatcopy by comparing it against refernce + * with the following options: + * + * Row Major + * Copy only + * alpha_r = 1.5, alpha_i = -1.0 + */ +CTEST(comatcopy, rowmajor_notrans_col_50_row_100) +{ + blasint m = 100, n = 50; + blasint lda = 50, ldb = 50; + char order = 'R'; + char trans = 'N'; + float alpha[] = {1.5f, -1.0f}; + + float norm = check_comatcopy('F', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test comatcopy by comparing it against refernce + * with the following options: + * + * Row Major + * Transposition + * alpha_r = 1.5, alpha_i = -1.0 + */ +CTEST(comatcopy, rowmajor_trans_col_100_row_50) +{ + blasint m = 50, n = 100; + blasint lda = 100, ldb = 50; + char order = 'R'; + char trans = 'T'; + float alpha[] = {1.5f, -1.0f}; + + float norm = check_comatcopy('F', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test comatcopy by comparing it against refernce + * with the following options: + * + * Row Major + * Copy and conjugate + * alpha_r = 1.5, alpha_i = -1.0 + */ +CTEST(comatcopy, rowmajor_conj_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda = 100, ldb = 100; + char order = 'R'; + char trans = 'R'; + float alpha[] = {1.5f, -1.0f}; + + float norm = check_comatcopy('F', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test comatcopy by comparing it against refernce + * with the following options: + * + * Row Major + * Transposition and conjugate + * alpha_r = 1.0, alpha_i = 2.0 + */ +CTEST(comatcopy, rowmajor_conjtrans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda = 100, ldb = 100; + char order = 'R'; + char trans = 'C'; + float alpha[] = {1.0f, 2.0f}; + + float norm = check_comatcopy('F', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test comatcopy by comparing it against refernce + * with the following options: + * + * Column Major + * Copy only + * alpha_r = 1.0, alpha_i = 2.0 + */ +CTEST(comatcopy, c_api_colmajor_notrans_col_50_row_100) +{ + blasint m = 100, n = 50; + blasint lda = 100, ldb = 100; + char order = 'C'; + char trans = 'N'; + float alpha[] = {1.0f, 2.0f}; + + float norm = check_comatcopy('C', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test comatcopy by comparing it against refernce + * with the following options: + * + * Column Major + * Transposition + * alpha_r = -1.0, alpha_i = 2.0 + */ +CTEST(comatcopy, c_api_colmajor_trans_col_50_row_100) +{ + blasint m = 100, n = 50; + blasint lda = 100, ldb = 50; + char order = 'C'; + char trans = 'T'; + float alpha[] = {-1.0f, 2.0f}; + + float norm = check_comatcopy('C', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test comatcopy by comparing it against refernce + * with the following options: + * + * Column Major + * Copy and conjugate + * alpha_r = 1.0, alpha_i = 2.0 + */ +CTEST(comatcopy, c_api_colmajor_conj_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda = 100, ldb = 100; + char order = 'C'; + char trans = 'R'; + float alpha[] = {1.0f, 2.0f}; + + float norm = check_comatcopy('C', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test comatcopy by comparing it against refernce + * with the following options: + * + * Column Major + * Transposition and conjugate + * alpha_r = 2.0, alpha_i = 1.0 + */ +CTEST(comatcopy, c_api_colmajor_conjtrnas_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda = 100, ldb = 100; + char order = 'C'; + char trans = 'C'; + float alpha[] = {2.0f, 1.0f}; + + float norm = check_comatcopy('C', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test comatcopy by comparing it against refernce + * with the following options: + * + * Row Major + * Copy only + * alpha_r = 1.5, alpha_i = -1.0 + */ +CTEST(comatcopy, c_api_rowmajor_notrans_col_50_row_100) +{ + blasint m = 100, n = 50; + blasint lda = 50, ldb = 50; + char order = 'R'; + char trans = 'N'; + float alpha[] = {1.5f, -1.0f}; + + float norm = check_comatcopy('C', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test comatcopy by comparing it against refernce + * with the following options: + * + * Row Major + * Transposition + * alpha_r = 1.5, alpha_i = -1.0 + */ +CTEST(comatcopy, c_api_rowmajor_trans_col_100_row_50) +{ + blasint m = 50, n = 100; + blasint lda = 100, ldb = 50; + char order = 'R'; + char trans = 'T'; + float alpha[] = {1.5f, -1.0f}; + + float norm = check_comatcopy('C', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test comatcopy by comparing it against refernce + * with the following options: + * + * Row Major + * Copy and conjugate + * alpha_r = 1.5, alpha_i = -1.0 + */ +CTEST(comatcopy, c_api_rowmajor_conj_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda = 100, ldb = 100; + char order = 'R'; + char trans = 'R'; + float alpha[] = {1.5f, -1.0f}; + + float norm = check_comatcopy('C', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test comatcopy by comparing it against refernce + * with the following options: + * + * Row Major + * Transposition and conjugate + * alpha_r = 1.0, alpha_i = 2.0 + */ +CTEST(comatcopy, c_api_rowmajor_conjtrans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda = 100, ldb = 100; + char order = 'R'; + char trans = 'C'; + float alpha[] = {1.0f, 2.0f}; + + float norm = check_comatcopy('C', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Test error function for an invalid param order. + * Must be column (C) or row major (R). + */ +CTEST(comatcopy, xerbla_invalid_order) +{ + blasint m = 100, n = 100; + blasint lda = 100, ldb = 100; + char order = 'O'; + char trans = 'T'; + int expected_info = 1; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param trans. + * Must be trans (T/C) or no-trans (N/R). + */ +CTEST(comatcopy, xerbla_invalid_trans) +{ + blasint m = 100, n = 100; + blasint lda = 100, ldb = 100; + char order = 'C'; + char trans = 'O'; + int expected_info = 2; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param m. + * Must be positive. + */ +CTEST(comatcopy, xerbla_invalid_rows) +{ + blasint m = 0, n = 100; + blasint lda = 0, ldb = 100; + char order = 'C'; + char trans = 'T'; + int expected_info = 3; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param n. + * Must be positive. + */ +CTEST(comatcopy, xerbla_invalid_cols) +{ + blasint m = 100, n = 0; + blasint lda = 100, ldb = 0; + char order = 'C'; + char trans = 'T'; + int expected_info = 4; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param lda. + * If matrices are stored using row major layout, + * lda must be at least n. + */ +CTEST(comatcopy, xerbla_rowmajor_invalid_lda) +{ + blasint m = 50, n = 100; + blasint lda = 50, ldb = 100; + char order = 'R'; + char trans = 'T'; + int expected_info = 7; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param lda. + * If matrices are stored using column major layout, + * lda must be at least m. + */ +CTEST(comatcopy, xerbla_colmajor_invalid_lda) +{ + blasint m = 100, n = 50; + blasint lda = 50, ldb = 100; + char order = 'C'; + char trans = 'T'; + int expected_info = 7; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param ldb. + * If matrices are stored using row major layout and + * there is no transposition, ldb must be at least n. + */ +CTEST(comatcopy, xerbla_rowmajor_notrans_invalid_ldb) +{ + blasint m = 50, n = 100; + blasint lda = 100, ldb = 50; + char order = 'R'; + char trans = 'N'; + int expected_info = 9; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param ldb. + * If matrices are stored using row major layout and + * there is transposition, ldb must be at least m. + */ +CTEST(comatcopy, xerbla_rowmajor_trans_invalid_ldb) +{ + blasint m = 100, n = 50; + blasint lda = 100, ldb = 50; + char order = 'R'; + char trans = 'T'; + int expected_info = 9; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param ldb. + * If matrices are stored using row major layout and + * there is no transposition, ldb must be at least n. + */ +CTEST(comatcopy, xerbla_rowmajor_conj_invalid_ldb) +{ + blasint m = 50, n = 100; + blasint lda = 100, ldb = 50; + char order = 'R'; + char trans = 'R'; + int expected_info = 9; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param ldb. + * If matrices are stored using row major layout and + * there is transposition, ldb must be at least m. + */ +CTEST(comatcopy, xerbla_rowmajor_transconj_invalid_ldb) +{ + blasint m = 100, n = 50; + blasint lda = 100, ldb = 50; + char order = 'R'; + char trans = 'C'; + int expected_info = 9; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param ldb. + * If matrices are stored using column major layout and + * there is no transposition, ldb must be at least m. + */ +CTEST(comatcopy, xerbla_colmajor_notrans_invalid_ldb) +{ + blasint m = 100, n = 50; + blasint lda = 100, ldb = 50; + char order = 'C'; + char trans = 'N'; + int expected_info = 9; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param ldb. + * If matrices are stored using column major layout and + * there is transposition, ldb must be at least n. + */ +CTEST(comatcopy, xerbla_colmajor_trans_invalid_ldb) +{ + blasint m = 50, n = 100; + blasint lda = 100, ldb = 50; + char order = 'C'; + char trans = 'T'; + int expected_info = 9; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param ldb. + * If matrices are stored using column major layout and + * there is no transposition, ldb must be at least m. + */ +CTEST(comatcopy, xerbla_colmajor_conj_invalid_ldb) +{ + blasint m = 100, n = 50; + blasint lda = 100, ldb = 50; + char order = 'C'; + char trans = 'R'; + int expected_info = 9; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param ldb. + * If matrices are stored using column major layout and + * there is transposition, ldb must be at least n. + */ +CTEST(comatcopy, xerbla_colmajor_transconj_invalid_ldb) +{ + blasint m = 50, n = 100; + blasint lda = 100, ldb = 50; + char order = 'C'; + char trans = 'C'; + int expected_info = 9; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} +#endif diff --git a/utest/test_extensions/test_crot.c b/utest/test_extensions/test_crot.c new file mode 100644 index 000000000..1c55216d9 --- /dev/null +++ b/utest/test_extensions/test_crot.c @@ -0,0 +1,792 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. 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. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include "common.h" + + +#define DATASIZE 100 +#define INCREMENT 2 + +struct DATA_CROT { + float x_test[DATASIZE * INCREMENT * 2]; + float y_test[DATASIZE * INCREMENT * 2]; + float x_verify[DATASIZE * INCREMENT * 2]; + float y_verify[DATASIZE * INCREMENT * 2]; +}; + +#ifdef BUILD_COMPLEX +static struct DATA_CROT data_crot; + +/** + * Fortran API specific function + * Comapare results computed by csrot and caxpby + * + * param n specifies size of vector x + * param inc_x specifies increment of vector x + * param inc_y specifies increment of vector y + * param c specifies cosine + * param s specifies sine + * return norm of differences + */ +static float check_csrot(blasint n, blasint inc_x, blasint inc_y, float *c, float *s) +{ + blasint i; + float norm = 0; + float s_neg[] = {-s[0], s[1]}; + + blasint inc_x_abs = labs(inc_x); + blasint inc_y_abs = labs(inc_y); + + // Fill vectors x, y + srand_generate(data_crot.x_test, n * inc_x_abs * 2); + srand_generate(data_crot.y_test, n * inc_y_abs * 2); + + if (inc_x == 0 && inc_y == 0) { + srand_generate(data_crot.x_test, n * 2); + srand_generate(data_crot.y_test, n * 2); + } + + // Copy vector x for caxpby + for (i = 0; i < n * inc_x_abs * 2; i++) + data_crot.x_verify[i] = data_crot.x_test[i]; + + // Copy vector y for caxpby + for (i = 0; i < n * inc_y_abs * 2; i++) + data_crot.y_verify[i] = data_crot.y_test[i]; + + // Find cx = c*x + s*y + BLASFUNC(caxpby)(&n, s, data_crot.y_test, &inc_y, c, data_crot.x_verify, &inc_x); + + // Find cy = -conjg(s)*x + c*y + BLASFUNC(caxpby)(&n, s_neg, data_crot.x_test, &inc_x, c, data_crot.y_verify, &inc_y); + + BLASFUNC(csrot)(&n, data_crot.x_test, &inc_x, data_crot.y_test, &inc_y, c, s); + + // Find the differences between vector x caculated by caxpby and csrot + for (i = 0; i < n * 2 * inc_x_abs; i++) + data_crot.x_test[i] -= data_crot.x_verify[i]; + + // Find the differences between vector y caculated by caxpby and csrot + for (i = 0; i < n * 2 * inc_y_abs; i++) + data_crot.y_test[i] -= data_crot.y_verify[i]; + + // Find the norm of differences + norm += BLASFUNC(scnrm2)(&n, data_crot.x_test, &inc_x_abs); + norm += BLASFUNC(scnrm2)(&n, data_crot.y_test, &inc_y_abs); + return (norm / 2); +} + +/** + * C API specific function + * Comapare results computed by csrot and caxpby + * + * param n specifies size of vector x + * param inc_x specifies increment of vector x + * param inc_y specifies increment of vector y + * param c specifies cosine + * param s specifies sine + * return norm of differences + */ +static float c_api_check_csrot(blasint n, blasint inc_x, blasint inc_y, float *c, float *s) +{ + blasint i; + float norm = 0; + float s_neg[] = {-s[0], s[1]}; + + blasint inc_x_abs = labs(inc_x); + blasint inc_y_abs = labs(inc_y); + + // Fill vectors x, y + srand_generate(data_crot.x_test, n * inc_x_abs * 2); + srand_generate(data_crot.y_test, n * inc_y_abs * 2); + + if (inc_x == 0 && inc_y == 0) { + srand_generate(data_crot.x_test, n * 2); + srand_generate(data_crot.y_test, n * 2); + } + + // Copy vector x for caxpby + for (i = 0; i < n * inc_x_abs * 2; i++) + data_crot.x_verify[i] = data_crot.x_test[i]; + + // Copy vector y for caxpby + for (i = 0; i < n * inc_y_abs * 2; i++) + data_crot.y_verify[i] = data_crot.y_test[i]; + + // Find cx = c*x + s*y + cblas_caxpby(n, s, data_crot.y_test, inc_y, c, data_crot.x_verify, inc_x); + + // Find cy = -conjg(s)*x + c*y + cblas_caxpby(n, s_neg, data_crot.x_test, inc_x, c, data_crot.y_verify, inc_y); + + cblas_csrot(n, data_crot.x_test, inc_x, data_crot.y_test, inc_y, c[0], s[0]); + + // Find the differences between vector x caculated by caxpby and csrot + for (i = 0; i < n * 2 * inc_x_abs; i++) + data_crot.x_test[i] -= data_crot.x_verify[i]; + + // Find the differences between vector y caculated by caxpby and csrot + for (i = 0; i < n * 2 * inc_y_abs; i++) + data_crot.y_test[i] -= data_crot.y_verify[i]; + + // Find the norm of differences + norm += cblas_scnrm2(n, data_crot.x_test, inc_x_abs); + norm += cblas_scnrm2(n, data_crot.y_test, inc_y_abs); + return (norm / 2); +} + +/** + * Fortran API specific test + * Test crot by comparing it with caxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 0 + * Stride of vector y is 0 + * c = 1.0f + * s = 2.0f + */ +CTEST(crot, inc_x_0_inc_y_0) +{ + blasint n = 100; + + blasint inc_x = 0; + blasint inc_y = 0; + + // Imaginary part for caxpby + float c[] = {1.0f, 0.0f}; + float s[] = {2.0f, 0.0f}; + + float norm = check_csrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test crot by comparing it with caxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 1 + * c = 1.0f + * s = 1.0f + */ +CTEST(crot, inc_x_1_inc_y_1) +{ + blasint n = 100; + + blasint inc_x = 1; + blasint inc_y = 1; + + // Imaginary part for caxpby + float c[] = {1.0f, 0.0f}; + float s[] = {1.0f, 0.0f}; + + float norm = check_csrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test crot by comparing it with caxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is -1 + * Stride of vector y is -1 + * c = 1.0f + * s = 1.0f + */ +CTEST(crot, inc_x_neg_1_inc_y_neg_1) +{ + blasint n = 100; + + blasint inc_x = -1; + blasint inc_y = -1; + + // Imaginary part for caxpby + float c[] = {1.0f, 0.0f}; + float s[] = {1.0f, 0.0f}; + + float norm = check_csrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test crot by comparing it with caxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 1 + * c = 3.0f + * s = 2.0f + */ +CTEST(crot, inc_x_2_inc_y_1) +{ + blasint n = 100; + + blasint inc_x = 2; + blasint inc_y = 1; + + // Imaginary part for caxpby + float c[] = {3.0f, 0.0f}; + float s[] = {2.0f, 0.0f}; + + float norm = check_csrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test crot by comparing it with caxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is -2 + * Stride of vector y is 1 + * c = 1.0f + * s = 1.0f + */ +CTEST(crot, inc_x_neg_2_inc_y_1) +{ + blasint n = 100; + + blasint inc_x = -2; + blasint inc_y = 1; + + // Imaginary part for caxpby + float c[] = {1.0f, 0.0f}; + float s[] = {1.0f, 0.0f}; + + float norm = check_csrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test crot by comparing it with caxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 2 + * c = 1.0f + * s = 1.0f + */ +CTEST(crot, inc_x_1_inc_y_2) +{ + blasint n = 100; + + blasint inc_x = 1; + blasint inc_y = 2; + + // Imaginary part for caxpby + float c[] = {1.0f, 0.0f}; + float s[] = {1.0f, 0.0f}; + + float norm = check_csrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test crot by comparing it with caxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is -2 + * c = 2.0f + * s = 1.0f + */ +CTEST(crot, inc_x_1_inc_y_neg_2) +{ + blasint n = 100; + + blasint inc_x = 1; + blasint inc_y = -2; + + // Imaginary part for caxpby + float c[] = {2.0f, 0.0f}; + float s[] = {1.0f, 0.0f}; + + float norm = check_csrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test crot by comparing it with caxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 2 + * c = 1.0f + * s = 2.0f + */ +CTEST(crot, inc_x_2_inc_y_2) +{ + blasint n = 100; + + blasint inc_x = 2; + blasint inc_y = 2; + + // Imaginary part for caxpby + float c[] = {1.0f, 0.0f}; + float s[] = {2.0f, 0.0f}; + + float norm = check_csrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test crot by comparing it with caxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 2 + * c = 1.0f + * s = 1.0f + */ +CTEST(crot, inc_x_neg_2_inc_y_neg_2) +{ + blasint n = 100; + + blasint inc_x = -2; + blasint inc_y = -2; + + // Imaginary part for caxpby + float c[] = {1.0f, 0.0f}; + float s[] = {1.0f, 0.0f}; + + float norm = check_csrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test crot by comparing it with caxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 2 + * c = 0.0f + * s = 1.0f + */ +CTEST(crot, inc_x_2_inc_y_2_c_zero) +{ + blasint n = 100; + + blasint inc_x = 2; + blasint inc_y = 2; + + // Imaginary part for caxpby + float c[] = {0.0f, 0.0f}; + float s[] = {1.0f, 0.0f}; + + float norm = check_csrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test crot by comparing it with caxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 2 + * c = 1.0f + * s = 0.0f + */ +CTEST(crot, inc_x_2_inc_y_2_s_zero) +{ + blasint n = 100; + + blasint inc_x = 2; + blasint inc_y = 2; + + // Imaginary part for caxpby + float c[] = {1.0f, 0.0f}; + float s[] = {0.0f, 0.0f}; + + float norm = check_csrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test crot by comparing it with caxpby. + * Test with the following options: + * + * Size of vectors x, y is 0 + * Stride of vector x is 1 + * Stride of vector y is 1 + * c = 1.0f + * s = 1.0f + */ +CTEST(crot, check_n_zero) +{ + blasint n = 0; + + blasint inc_x = 1; + blasint inc_y = 1; + + // Imaginary part for caxpby + float c[] = {1.0f, 0.0f}; + float s[] = {1.0f, 0.0f}; + + float norm = check_csrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test crot by comparing it with caxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 0 + * Stride of vector y is 0 + * c = 1.0f + * s = 2.0f + */ +CTEST(crot, c_api_inc_x_0_inc_y_0) +{ + blasint n = 100; + + blasint inc_x = 0; + blasint inc_y = 0; + + // Imaginary part for caxpby + float c[] = {3.0f, 0.0f}; + float s[] = {2.0f, 0.0f}; + + float norm = c_api_check_csrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test crot by comparing it with caxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 1 + * c = 1.0f + * s = 1.0f + */ +CTEST(crot, c_api_inc_x_1_inc_y_1) +{ + blasint n = 100; + + blasint inc_x = 1; + blasint inc_y = 1; + + // Imaginary part for caxpby + float c[] = {1.0f, 0.0f}; + float s[] = {1.0f, 0.0f}; + + float norm = c_api_check_csrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test crot by comparing it with caxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is -1 + * Stride of vector y is -1 + * c = 1.0f + * s = 1.0f + */ +CTEST(crot, c_api_inc_x_neg_1_inc_y_neg_1) +{ + blasint n = 100; + + blasint inc_x = -1; + blasint inc_y = -1; + + // Imaginary part for caxpby + float c[] = {1.0f, 0.0f}; + float s[] = {1.0f, 0.0f}; + + float norm = c_api_check_csrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test crot by comparing it with caxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 1 + * c = 3.0f + * s = 2.0f + */ +CTEST(crot, c_api_inc_x_2_inc_y_1) +{ + blasint n = 100; + + blasint inc_x = 2; + blasint inc_y = 1; + + // Imaginary part for caxpby + float c[] = {3.0f, 0.0f}; + float s[] = {2.0f, 0.0f}; + + float norm = c_api_check_csrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test crot by comparing it with caxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is -2 + * Stride of vector y is 1 + * c = 1.0f + * s = 1.0f + */ +CTEST(crot, c_api_inc_x_neg_2_inc_y_1) +{ + blasint n = 100; + + blasint inc_x = -2; + blasint inc_y = 1; + + // Imaginary part for caxpby + float c[] = {1.0f, 0.0f}; + float s[] = {1.0f, 0.0f}; + + float norm = c_api_check_csrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test crot by comparing it with caxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 2 + * c = 1.0f + * s = 1.0f + */ +CTEST(crot, c_api_inc_x_1_inc_y_2) +{ + blasint n = 100; + + blasint inc_x = 1; + blasint inc_y = 2; + + // Imaginary part for caxpby + float c[] = {1.0f, 0.0f}; + float s[] = {1.0f, 0.0f}; + + float norm = c_api_check_csrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test crot by comparing it with caxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is -2 + * c = 2.0f + * s = 1.0f + */ +CTEST(crot, c_api_inc_x_1_inc_y_neg_2) +{ + blasint n = 100; + + blasint inc_x = 1; + blasint inc_y = -2; + + // Imaginary part for caxpby + float c[] = {2.0f, 0.0f}; + float s[] = {1.0f, 0.0f}; + + float norm = c_api_check_csrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test crot by comparing it with caxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 2 + * c = 1.0f + * s = 2.0f + */ +CTEST(crot, c_api_inc_x_2_inc_y_2) +{ + blasint n = 100; + + blasint inc_x = 2; + blasint inc_y = 2; + + // Imaginary part for caxpby + float c[] = {1.0f, 0.0f}; + float s[] = {2.0f, 0.0f}; + + float norm = c_api_check_csrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test crot by comparing it with caxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 2 + * c = 1.0f + * s = 1.0f + */ +CTEST(crot, c_api_inc_x_neg_2_inc_y_neg_2) +{ + blasint n = 100; + + blasint inc_x = -2; + blasint inc_y = -2; + + // Imaginary part for caxpby + float c[] = {1.0f, 0.0f}; + float s[] = {1.0f, 0.0f}; + + float norm = c_api_check_csrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test crot by comparing it with caxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 2 + * c = 0.0f + * s = 1.0f + */ +CTEST(crot, c_api_inc_x_2_inc_y_2_c_zero) +{ + blasint n = 100; + + blasint inc_x = 2; + blasint inc_y = 2; + + // Imaginary part for caxpby + float c[] = {0.0f, 0.0f}; + float s[] = {1.0f, 0.0f}; + + float norm = c_api_check_csrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test crot by comparing it with caxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 2 + * c = 1.0f + * s = 0.0f + */ +CTEST(crot, c_api_inc_x_2_inc_y_2_s_zero) +{ + blasint n = 100; + + blasint inc_x = 2; + blasint inc_y = 2; + + // Imaginary part for caxpby + float c[] = {1.0f, 0.0f}; + float s[] = {0.0f, 0.0f}; + + float norm = c_api_check_csrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test crot by comparing it with caxpby. + * Test with the following options: + * + * Size of vectors x, y is 0 + * Stride of vector x is 1 + * Stride of vector y is 1 + * c = 1.0f + * s = 1.0f + */ +CTEST(crot, c_api_check_n_zero) +{ + blasint n = 0; + + blasint inc_x = 1; + blasint inc_y = 1; + + // Imaginary part for caxpby + float c[] = {1.0f, 0.0f}; + float s[] = {1.0f, 0.0f}; + + float norm = c_api_check_csrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_crotg.c b/utest/test_extensions/test_crotg.c new file mode 100644 index 000000000..9db7dc7d3 --- /dev/null +++ b/utest/test_extensions/test_crotg.c @@ -0,0 +1,290 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. 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. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include + +#ifdef BUILD_COMPLEX + +/** + * Fortran API specific test + * Test crotg by comparing it against pre-calculated values + */ +CTEST(crotg, zero_a) +{ + float sa[2] = {0.0f, 0.0f}; + float sb[2] = {1.0f, 1.0f}; + float ss[2]; + float sc; + BLASFUNC(crotg)(sa, sb, &sc, ss); + ASSERT_DBL_NEAR_TOL(0.0f, sc, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(1.0f, ss[0], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(0.0f, ss[1], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(1.0f, sa[0], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(1.0f, sa[1], SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test crotg by comparing it against pre-calculated values + */ +CTEST(crotg, zero_b) +{ + float sa[2] = {1.0f, 1.0f}; + float sb[2] = {0.0f, 0.0f}; + float ss[2]; + float sc; + BLASFUNC(crotg)(sa, sb, &sc, ss); + ASSERT_DBL_NEAR_TOL(1.0f, sc, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(0.0f, ss[0], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(0.0f, ss[1], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(1.0f, sa[0], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(1.0f, sa[1], SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test crotg by comparing it against pre-calculated values + */ +CTEST(crotg, zero_real) +{ + float sa[2] = {0.0f, 1.0f}; + float sb[2] = {0.0f, 1.0f}; + float ss[2]; + float sc; + BLASFUNC(crotg)(sa, sb, &sc, ss); + ASSERT_DBL_NEAR_TOL(0.7071f, sc, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(0.7071f, ss[0], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(0.0f, ss[1], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(0.0f, sa[0], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(1.41421f, sa[1], SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test crotg by comparing it against pre-calculated values + */ +CTEST(crotg, positive_real_positive_img) +{ + float sa[2] = {3.0f, 4.0f}; + float sb[2] = {4.0f, 6.0f}; + float ss[2]; + float sc; + BLASFUNC(crotg)(sa, sb, &sc, ss); + ASSERT_DBL_NEAR_TOL(0.5698f, sc, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(0.82052f, ss[0], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(-0.04558f, ss[1], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(5.26498f, sa[0], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(7.01997f, sa[1], SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test crotg by comparing it against pre-calculated values + */ +CTEST(crotg, negative_real_positive_img) +{ + float sa[2] = {-3.0f, 4.0f}; + float sb[2] = {-4.0f, 6.0f}; + float ss[2]; + float sc; + BLASFUNC(crotg)(sa, sb, &sc, ss); + ASSERT_DBL_NEAR_TOL(0.5698f, sc, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(0.82052f, ss[0], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(0.04558f, ss[1], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(-5.26498f, sa[0], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(7.01997f, sa[1], SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test crotg by comparing it against pre-calculated values + */ +CTEST(crotg, positive_real_negative_img) +{ + float sa[2] = {3.0f, -4.0f}; + float sb[2] = {4.0f, -6.0f}; + float ss[2]; + float sc; + BLASFUNC(crotg)(sa, sb, &sc, ss); + ASSERT_DBL_NEAR_TOL(0.5698f, sc, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(0.82052f, ss[0], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(0.04558f, ss[1], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(5.26498f, sa[0], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(-7.01997f, sa[1], SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test crotg by comparing it against pre-calculated values + */ +CTEST(crotg, negative_real_negative_img) +{ + float sa[2] = {-3.0f, -4.0f}; + float sb[2] = {-4.0f, -6.0f}; + float ss[2]; + float sc; + BLASFUNC(crotg)(sa, sb, &sc, ss); + ASSERT_DBL_NEAR_TOL(0.5698f, sc, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(0.82052f, ss[0], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(-0.04558f, ss[1], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(-5.26498f, sa[0], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(-7.01997f, sa[1], SINGLE_EPS); +} + +/** + * C API specific test + * Test crotg by comparing it against pre-calculated values + */ +CTEST(crotg, c_api_zero_a) +{ + float sa[2] = {0.0f, 0.0f}; + float sb[2] = {1.0f, 1.0f}; + float ss[2]; + float sc; + cblas_crotg(sa, sb, &sc, ss); + ASSERT_DBL_NEAR_TOL(0.0f, sc, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(1.0f, ss[0], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(0.0f, ss[1], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(1.0f, sa[0], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(1.0f, sa[1], SINGLE_EPS); +} + +/** + * C API specific test + * Test crotg by comparing it against pre-calculated values + */ +CTEST(crotg, c_api_zero_b) +{ + float sa[2] = {1.0f, 1.0f}; + float sb[2] = {0.0f, 0.0f}; + float ss[2]; + float sc; + cblas_crotg(sa, sb, &sc, ss); + ASSERT_DBL_NEAR_TOL(1.0f, sc, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(0.0f, ss[0], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(0.0f, ss[1], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(1.0f, sa[0], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(1.0f, sa[1], SINGLE_EPS); +} + +/** + * C API specific test + * Test crotg by comparing it against pre-calculated values + */ +CTEST(crotg, c_api_zero_real) +{ + float sa[2] = {0.0f, 1.0f}; + float sb[2] = {0.0f, 1.0f}; + float ss[2]; + float sc; + cblas_crotg(sa, sb, &sc, ss); + ASSERT_DBL_NEAR_TOL(0.7071f, sc, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(0.7071f, ss[0], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(0.0f, ss[1], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(0.0f, sa[0], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(1.41421f, sa[1], SINGLE_EPS); +} + +/** + * C API specific test + * Test crotg by comparing it against pre-calculated values + */ +CTEST(crotg, c_api_positive_real_positive_img) +{ + float sa[2] = {3.0f, 4.0f}; + float sb[2] = {4.0f, 6.0f}; + float ss[2]; + float sc; + cblas_crotg(sa, sb, &sc, ss); + ASSERT_DBL_NEAR_TOL(0.5698f, sc, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(0.82052f, ss[0], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(-0.04558f, ss[1], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(5.26498f, sa[0], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(7.01997f, sa[1], SINGLE_EPS); +} + +/** + * C API specific test + * Test crotg by comparing it against pre-calculated values + */ +CTEST(crotg, c_api_negative_real_positive_img) +{ + float sa[2] = {-3.0f, 4.0f}; + float sb[2] = {-4.0f, 6.0f}; + float ss[2]; + float sc; + cblas_crotg(sa, sb, &sc, ss); + ASSERT_DBL_NEAR_TOL(0.5698f, sc, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(0.82052f, ss[0], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(0.04558f, ss[1], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(-5.26498f, sa[0], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(7.01997f, sa[1], SINGLE_EPS); +} + +/** + * C API specific test + * Test crotg by comparing it against pre-calculated values + */ +CTEST(crotg, c_api_positive_real_negative_img) +{ + float sa[2] = {3.0f, -4.0f}; + float sb[2] = {4.0f, -6.0f}; + float ss[2]; + float sc; + cblas_crotg(sa, sb, &sc, ss); + ASSERT_DBL_NEAR_TOL(0.5698f, sc, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(0.82052f, ss[0], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(0.04558f, ss[1], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(5.26498f, sa[0], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(-7.01997f, sa[1], SINGLE_EPS); +} + +/** + * C API specific test + * Test crotg by comparing it against pre-calculated values + */ +CTEST(crotg, c_api_negative_real_negative_img) +{ + float sa[2] = {-3.0f, -4.0f}; + float sb[2] = {-4.0f, -6.0f}; + float ss[2]; + float sc; + cblas_crotg(sa, sb, &sc, ss); + ASSERT_DBL_NEAR_TOL(0.5698f, sc, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(0.82052f, ss[0], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(-0.04558f, ss[1], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(-5.26498f, sa[0], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(-7.01997f, sa[1], SINGLE_EPS); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_csbmv.c b/utest/test_extensions/test_csbmv.c new file mode 100644 index 000000000..8e8ce4530 --- /dev/null +++ b/utest/test_extensions/test_csbmv.c @@ -0,0 +1,606 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. 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. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include "common.h" + +#define DATASIZE 100 +#define INCREMENT 2 + +struct DATA_CSBMV { + float sp_matrix[DATASIZE * (DATASIZE + 1)]; + float sb_matrix[DATASIZE * DATASIZE * 2]; + float b_test[DATASIZE * 2 * INCREMENT]; + float c_test[DATASIZE * 2 * INCREMENT]; + float c_verify[DATASIZE * 2 * INCREMENT]; +}; + +// SINGLE_EPS_ZGEMV = MAX_VAL * NUMBER OF OPERATIONS * FLT_EPSILON +// SINGLE_EPS_ZGEMV = 5.0 * O(100 * 100) * 1.19e-07 = 5*e-03 +#define SINGLE_EPS_ZGEMV 5e-03 + +#ifdef BUILD_COMPLEX +static struct DATA_CSBMV data_csbmv; + +/** + * Transform full-storage symmetric band matrix A to upper (U) or lower (L) + * band-packed storage mode. + * + * param uplo specifies whether matrix a is upper or lower band-packed. + * param n - number of rows and columns of A + * param k - number of super-diagonals of A + * output param a - buffer for holding symmetric band-packed matrix + * param lda - specifies the leading dimension of a + * param sb_matrix - buffer holding full-storage symmetric band matrix A + * param ldm - specifies the leading dimension of A + */ +static void transform_to_band_storage(char uplo, blasint n, blasint k, float* a, blasint lda, + float* sb_matrix, blasint ldm) +{ + blasint i, j, m; + if (uplo == 'L') { + for (j = 0; j < n; j++) + { + m = -j; + for (i = 2 * j; i < MIN(2 * n, 2 * (j + k + 1)); i += 2) + { + a[(2*m + i) + j * lda * 2] = sb_matrix[i + j * ldm * 2]; + a[(2*m + (i + 1)) + j * lda * 2] = sb_matrix[(i + 1) + j * ldm * 2]; + } + } + } + else { + for (j = 0; j < n; j++) + { + m = k - j; + for (i = MAX(0, 2*(j - k)); i <= j*2; i += 2) + { + a[(2*m + i) + j * lda * 2] = sb_matrix[i + j * ldm * 2]; + a[(2*m + (i + 1)) + j * lda * 2] = sb_matrix[(i + 1) + j * ldm * 2]; + } + } + } +} + +/** + * Generate full-storage symmetric band matrix A with k - super-diagonals + * from input symmetric packed matrix in lower packed mode (L) + * + * output param sb_matrix - buffer for holding full-storage symmetric band matrix. + * param sp_matrix - buffer holding input symmetric packed matrix + * param n - number of rows and columns of A + * param k - number of super-diagonals of A + */ +static void get_symmetric_band_matr(float *sb_matrix, float *sp_matrix, blasint n, blasint k) +{ + blasint m; + blasint i, j; + m = 0; + for (i = 0; i < n; i++) + { + for (j = 0; j < n * 2; j += 2) + { + // Make matrix band with k super-diagonals + if (fabs((i+1) - ceil((j+1)/2.0f)) > k) + { + sb_matrix[i * n * 2 + j] = 0.0f; + sb_matrix[i * n * 2 + j + 1] = 0.0f; + continue; + } + + if (j / 2 < i) + { + sb_matrix[i * n * 2 + j] = + sb_matrix[j * n + i * 2]; + sb_matrix[i * n * 2 + j + 1] = + sb_matrix[j * n + i * 2 + 1]; + } + else + { + sb_matrix[i * n * 2 + j] = sp_matrix[m++]; + sb_matrix[i * n * 2 + j + 1] = sp_matrix[m++]; + } + } + } +} + +/** + * Check if error function was called with expected function name + * and param info + * + * param uplo specifies whether matrix a is upper or lower band-packed. + * param n - number of rows and columns of A + * param k - number of super-diagonals of A + * param lda - specifies the leading dimension of a + * param inc_b - stride of vector b_test + * param inc_c - stride of vector c_test + * param expected_info - expected invalid parameter number in csbmv + * return TRUE if everything is ok, otherwise FALSE + */ +static int check_badargs(char uplo, blasint n, blasint k, blasint lda, blasint inc_b, + blasint inc_c, int expected_info) +{ + float alpha[] = {1.0f, 1.0f}; + float beta[] = {0.0f, 0.0f}; + + float a[2]; + srand_generate(a, 2); + + set_xerbla("CSBMV ", expected_info); + + BLASFUNC(csbmv)(&uplo, &n, &k, alpha, a, &lda, data_csbmv.b_test, + &inc_b, beta, data_csbmv.c_test, &inc_c); + + return check_error(); +} + +/** + * Comapare results computed by csbmv and cgemv + * since csbmv is cgemv for symmetric band matrix + * + * param uplo specifies whether matrix A is upper or lower triangular + * param n - number of rows and columns of A + * param k - number of super-diagonals of A + * param alpha - scaling factor for the matrix-vector product + * param lda - specifies the leading dimension of a + * param inc_b - stride of vector b_test + * param beta - scaling factor for vector c_test + * param inc_c - stride of vector c_test + * param lda - specifies the leading dimension of a + * return norm of differences + */ +static float check_csbmv(char uplo, blasint n, blasint k, float *alpha, blasint lda, + blasint inc_b, float *beta, blasint inc_c, blasint ldm) +{ + blasint i; + + // Trans param for gemv (can use any, since the input matrix is symmetric) + char trans = 'N'; + + // Symmetric band packed matrix for sbmv + float a[lda * n * 2]; + + // Fill symmetric packed matrix sp_matrix, vector b_test, vector c_test + srand_generate(data_csbmv.sp_matrix, n * (n + 1)); + srand_generate(data_csbmv.b_test, n * inc_b * 2); + srand_generate(data_csbmv.c_test, n * inc_c * 2); + + // Copy vector c_test for cgemv + for (i = 0; i < n * inc_c * 2; i++) + data_csbmv.c_verify[i] = data_csbmv.c_test[i]; + + // Generate full-storage symmetric band matrix + // with k super-diagonals from symmetric packed matrix + get_symmetric_band_matr(data_csbmv.sb_matrix, data_csbmv.sp_matrix, n, k); + + // Transform symmetric band matrix from conventional + // full matrix storage to band storage for csbmv + transform_to_band_storage(uplo, n, k, a, lda, data_csbmv.sb_matrix, ldm); + + BLASFUNC(cgemv)(&trans, &n, &n, alpha, data_csbmv.sb_matrix, &ldm, data_csbmv.b_test, + &inc_b, beta, data_csbmv.c_verify, &inc_c); + + BLASFUNC(csbmv)(&uplo, &n, &k, alpha, a, &lda, + data_csbmv.b_test, &inc_b, beta, data_csbmv.c_test, &inc_c); + + // Find the differences between output vector caculated by csbmv and cgemv + for (i = 0; i < n * inc_c * 2; i++) + data_csbmv.c_test[i] -= data_csbmv.c_verify[i]; + + // Find the norm of differences + return BLASFUNC(scnrm2)(&n, data_csbmv.c_test, &inc_c); +} + +/** + * Test csbmv by comparing it against cgemv + * with the following options: + * + * a is upper-band-packed symmetric matrix + * Number of rows and columns of A is 100 + * Stride of vector b_test is 1 + * Stride of vector c_test is 1 + * Number of super-diagonals k is 0 + */ +CTEST(csbmv, upper_k_0_inc_b_1_inc_c_1_n_100) +{ + blasint n = DATASIZE, inc_b = 1, inc_c = 1; + blasint k = 0; + blasint lda = k + 1; + blasint ldm = n; + char uplo = 'U'; + + float alpha[] = {1.0f, 1.0f}; + float beta[] = {1.0f, 1.0f}; + + float norm = check_csbmv(uplo, n, k, alpha, lda, inc_b, beta, inc_c, ldm); + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS_ZGEMV); +} + +/** + * Test csbmv by comparing it against cgemv + * with the following options: + * + * a is upper-band-packed symmetric matrix + * Number of rows and columns of A is 100 + * Stride of vector b_test is 1 + * Stride of vector c_test is 1 + * Number of super-diagonals k is 1 + */ +CTEST(csbmv, upper_k_1_inc_b_1_inc_c_1_n_100) +{ + blasint n = DATASIZE, inc_b = 1, inc_c = 1; + blasint k = 1; + blasint lda = k + 1; + blasint ldm = n; + char uplo = 'U'; + + float alpha[] = {1.0f, 1.0f}; + float beta[] = {1.0f, 1.0f}; + + float norm = check_csbmv(uplo, n, k, alpha, lda, inc_b, beta, inc_c, ldm); + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS_ZGEMV); +} + +/** + * Test csbmv by comparing it against cgemv + * with the following options: + * + * a is upper-band-packed symmetric matrix + * Number of rows and columns of A is 100 + * Stride of vector b_test is 1 + * Stride of vector c_test is 1 + * Number of super-diagonals k is 2 + */ +CTEST(csbmv, upper_k_2_inc_b_1_inc_c_1_n_100) +{ + blasint n = DATASIZE, inc_b = 1, inc_c = 1; + blasint k = 2; + blasint lda = k + 1; + blasint ldm = n; + char uplo = 'U'; + + float alpha[] = {1.0f, 1.0f}; + float beta[] = {1.0f, 1.0f}; + + float norm = check_csbmv(uplo, n, k, alpha, lda, inc_b, beta, inc_c, ldm); + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS_ZGEMV); +} + +/** + * Test csbmv by comparing it against cgemv + * with the following options: + * + * a is upper-band-packed symmetric matrix + * Number of rows and columns of A is 100 + * Stride of vector b_test is 2 + * Stride of vector c_test is 1 + * Number of super-diagonals k is 2 + */ +CTEST(csbmv, upper_k_2_inc_b_2_inc_c_1_n_100) +{ + blasint n = DATASIZE, inc_b = 2, inc_c = 1; + blasint k = 2; + blasint lda = k + 1; + blasint ldm = n; + char uplo = 'U'; + + float alpha[] = {2.0f, 1.0f}; + float beta[] = {2.0f, 1.0f}; + + float norm = check_csbmv(uplo, n, k, alpha, lda, inc_b, beta, inc_c, ldm); + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS_ZGEMV); +} + +/** + * Test csbmv by comparing it against cgemv + * with the following options: + * + * a is upper-band-packed symmetric matrix + * Number of rows and columns of A is 100 + * Stride of vector b_test is 2 + * Stride of vector c_test is 2 + * Number of super-diagonals k is 2 + */ +CTEST(csbmv, upper_k_2_inc_b_2_inc_c_2_n_100) +{ + blasint n = DATASIZE, inc_b = 2, inc_c = 2; + blasint k = 2; + blasint lda = k + 1; + blasint ldm = n; + char uplo = 'U'; + + float alpha[] = {2.0f, 1.0f}; + float beta[] = {2.0f, 1.0f}; + + float norm = check_csbmv(uplo, n, k, alpha, lda, inc_b, beta, inc_c, ldm); + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS_ZGEMV); +} + +/** + * Test csbmv by comparing it against cgemv + * with the following options: + * + * a is lower-band-packed symmetric matrix + * Number of rows and columns of A is 100 + * Stride of vector b_test is 1 + * Stride of vector c_test is 1 + * Number of super-diagonals k is 0 + */ +CTEST(csbmv, lower_k_0_inc_b_1_inc_c_1_n_100) +{ + blasint n = DATASIZE, inc_b = 1, inc_c = 1; + blasint k = 0; + blasint lda = k + 1; + blasint ldm = n; + char uplo = 'L'; + + float alpha[] = {1.0f, 1.0f}; + float beta[] = {1.0f, 1.0f}; + + float norm = check_csbmv(uplo, n, k, alpha, lda, inc_b, beta, inc_c, ldm); + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS_ZGEMV); +} + +/** + * Test csbmv by comparing it against cgemv + * with the following options: + * + * a is lower-band-packed symmetric matrix + * Number of rows and columns of A is 100 + * Stride of vector b_test is 1 + * Stride of vector c_test is 1 + * Number of super-diagonals k is 1 + */ +CTEST(csbmv, lower_k_1_inc_b_1_inc_c_1_n_100) +{ + blasint n = DATASIZE, inc_b = 1, inc_c = 1; + blasint k = 1; + blasint lda = k + 1; + blasint ldm = n; + char uplo = 'L'; + + float alpha[] = {1.0f, 1.0f}; + float beta[] = {1.0f, 1.0f}; + + float norm = check_csbmv(uplo, n, k, alpha, lda, inc_b, beta, inc_c, ldm); + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS_ZGEMV); +} + +/** + * Test csbmv by comparing it against cgemv + * with the following options: + * + * a is lower-band-packed symmetric matrix + * Number of rows and columns of A is 100 + * Stride of vector b_test is 1 + * Stride of vector c_test is 1 + * Number of super-diagonals k is 2 + */ +CTEST(csbmv, lower_k_2_inc_b_1_inc_c_1_n_100) +{ + blasint n = DATASIZE, inc_b = 1, inc_c = 1; + blasint k = 2; + blasint lda = k + 1; + blasint ldm = n; + char uplo = 'L'; + + float alpha[] = {1.0f, 1.0f}; + float beta[] = {1.0f, 1.0f}; + + float norm = check_csbmv(uplo, n, k, alpha, lda, inc_b, beta, inc_c, ldm); + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS_ZGEMV); +} + +/** + * Test csbmv by comparing it against cgemv + * with the following options: + * + * a is lower-band-packed symmetric matrix + * Number of rows and columns of A is 100 + * Stride of vector b_test is 2 + * Stride of vector c_test is 1 + * Number of super-diagonals k is 2 + */ +CTEST(csbmv, lower_k_2_inc_b_2_inc_c_1_n_100) +{ + blasint n = DATASIZE, inc_b = 2, inc_c = 1; + blasint k = 2; + blasint lda = k + 1; + blasint ldm = n; + char uplo = 'L'; + + float alpha[] = {2.0f, 1.0f}; + float beta[] = {2.0f, 1.0f}; + + float norm = check_csbmv(uplo, n, k, alpha, lda, inc_b, beta, inc_c, ldm); + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS_ZGEMV); +} + +/** + * Test csbmv by comparing it against cgemv + * with the following options: + * + * a is lower-band-packed symmetric matrix + * Number of rows and columns of A is 100 + * Stride of vector b_test is 2 + * Stride of vector c_test is 2 + * Number of super-diagonals k is 2 + */ +CTEST(csbmv, lower_k_2_inc_b_2_inc_c_2_n_100) +{ + blasint n = DATASIZE, inc_b = 2, inc_c = 2; + blasint k = 2; + blasint lda = k + 1; + blasint ldm = n; + char uplo = 'L'; + + float alpha[] = {2.0f, 1.0f}; + float beta[] = {2.0f, 1.0f}; + + float norm = check_csbmv(uplo, n, k, alpha, lda, inc_b, beta, inc_c, ldm); + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS_ZGEMV); +} + +/** + * Check if output matrix a contains any NaNs + */ +CTEST(csbmv, check_for_NaN) +{ + blasint n = DATASIZE, inc_b = 1, inc_c = 1; + blasint k = 0; + blasint lda = k + 1; + blasint ldm = n; + char uplo = 'U'; + + float alpha[] = {1.0f, 1.0f}; + float beta[] = {1.0f, 1.0f}; + + float norm = check_csbmv(uplo, n, k, alpha, lda, inc_b, beta, inc_c, ldm); + + ASSERT_TRUE(norm == norm); /* NaN == NaN is false */ +} + +/** + * Test error function for an invalid param uplo. + * Uplo specifies whether a is in upper (U) or lower (L) band-packed storage mode. + */ +CTEST(csbmv, xerbla_uplo_invalid) +{ + blasint n = 1, inc_b = 1, inc_c = 1; + char uplo = 'O'; + blasint k = 0; + blasint lda = k + 1; + int expected_info = 1; + + int passed = check_badargs(uplo, n, k, lda, inc_b, inc_c, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param N - + * number of rows and columns of A. Must be at least zero. + */ +CTEST(csbmv, xerbla_n_invalid) +{ + blasint n = INVALID, inc_b = 1, inc_c = 1; + char uplo = 'U'; + blasint k = 0; + blasint lda = k + 1; + int expected_info = 2; + + int passed = check_badargs(uplo, n, k, lda, inc_b, inc_c, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Check if n - number of rows and columns of A equal zero. + */ +CTEST(csbmv, check_n_zero) +{ + blasint n = 0, inc_b = 1, inc_c = 1; + blasint k = 0; + blasint lda = k + 1; + blasint ldm = 1; + char uplo = 'U'; + + float alpha[] = {1.0f, 1.0f}; + float beta[] = {0.0f, 0.0f}; + + float norm = check_csbmv(uplo, n, k, alpha, lda, inc_b, beta, inc_c, ldm); + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS_ZGEMV); +} + +/** + * Test error function for an invalid param inc_b - + * stride of vector b_test. Can't be zero. + */ +CTEST(csbmv, xerbla_inc_b_zero) +{ + blasint n = 1, inc_b = 0, inc_c = 1; + char uplo = 'U'; + blasint k = 0; + blasint lda = k + 1; + int expected_info = 8; + + int passed = check_badargs(uplo, n, k, lda, inc_b, inc_c, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param inc_c - + * stride of vector c_test. Can't be zero. + */ +CTEST(csbmv, xerbla_inc_c_zero) +{ + blasint n = 1, inc_b = 1, inc_c = 0; + char uplo = 'U'; + blasint k = 0; + blasint lda = k + 1; + int expected_info = 11; + + int passed = check_badargs(uplo, n, k, lda, inc_b, inc_c, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param k - + * number of super-diagonals of A. Must be at least zero. + */ +CTEST(csbmv, xerbla_k_invalid) +{ + blasint n = 1, inc_b = 1, inc_c = 1; + char uplo = 'U'; + blasint k = INVALID; + blasint lda = 1; + int expected_info = 3; + + int passed = check_badargs(uplo, n, k, lda, inc_b, inc_c, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param lda - + * specifies the leading dimension of a. Must be at least (k+1). + */ +CTEST(csbmv, xerbla_lda_invalid) +{ + blasint n = 1, inc_b = 1, inc_c = 1; + char uplo = 'U'; + blasint k = 0; + blasint lda = INVALID; + int expected_info = 6; + + int passed = check_badargs(uplo, n, k, lda, inc_b, inc_c, expected_info); + ASSERT_EQUAL(TRUE, passed); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_cscal.c b/utest/test_extensions/test_cscal.c new file mode 100644 index 000000000..009c600ad --- /dev/null +++ b/utest/test_extensions/test_cscal.c @@ -0,0 +1,164 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. 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. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include +#include "common.h" + +#define DATASIZE 100 +#define INCREMENT 2 + +struct DATA_CSCAL { + float x_test[DATASIZE * 2 * INCREMENT]; + float x_verify[DATASIZE * 2 * INCREMENT]; +}; + +#ifdef BUILD_COMPLEX +static struct DATA_CSCAL data_cscal; + +/** + * cscal reference code + * + * param n - number of elements of vector x + * param alpha - scaling factor for the vector product + * param x - buffer holding input vector x + * param inc - stride of vector x + */ +static void cscal_trusted(blasint n, float *alpha, float* x, blasint inc){ + blasint i, ip = 0; + blasint inc_x2 = 2 * inc; + float temp; + for (i = 0; i < n; i++) + { + temp = alpha[0] * x[ip] - alpha[1] * x[ip+1]; + x[ip+1] = alpha[0] * x[ip+1] + alpha[1] * x[ip]; + x[ip] = temp; + ip += inc_x2; + } +} + +/** + * Comapare results computed by cscal and cscal_trusted + * + * param api specifies tested api (C or Fortran) + * param n - number of elements of vector x + * param alpha - scaling factor for the vector product + * param inc - stride of vector x + * return norm of differences + */ +static float check_cscal(char api, blasint n, float *alpha, blasint inc) +{ + blasint i; + + // Fill vectors a + srand_generate(data_cscal.x_test, n * inc * 2); + + // Copy vector x for cscal_trusted + for (i = 0; i < n * 2 * inc; i++) + data_cscal.x_verify[i] = data_cscal.x_test[i]; + + cscal_trusted(n, alpha, data_cscal.x_verify, inc); + + if(api == 'F') + BLASFUNC(cscal)(&n, alpha, data_cscal.x_test, &inc); + else + cblas_cscal(n, alpha, data_cscal.x_test, inc); + + // Find the differences between output vector computed by cscal and cscal_trusted + for (i = 0; i < n * 2 * inc; i++) + data_cscal.x_verify[i] -= data_cscal.x_test[i]; + + // Find the norm of differences + return BLASFUNC(scnrm2)(&n, data_cscal.x_verify, &inc); +} + +/** + * Fortran API specific test + * Test cscal by comparing it against reference + */ +CTEST(cscal, alpha_r_zero_alpha_i_not_zero) +{ + blasint N = DATASIZE; + blasint inc = 1; + float alpha[2] = {0.0f, 1.0f}; + + float norm = check_cscal('F', N, alpha, inc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test cscal by comparing it against reference + */ +CTEST(cscal, alpha_r_zero_alpha_i_zero_inc_2) +{ + blasint N = DATASIZE; + blasint inc = 2; + float alpha[2] = {0.0f, 0.0f}; + + float norm = check_cscal('F', N, alpha, inc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cscal by comparing it against reference + */ +CTEST(cscal, c_api_alpha_r_zero_alpha_i_not_zero) +{ + blasint N = DATASIZE; + blasint inc = 1; + float alpha[2] = {0.0f, 1.0f}; + + float norm = check_cscal('C', N, alpha, inc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test cscal by comparing it against reference + */ +CTEST(cscal, c_api_alpha_r_zero_alpha_i_zero_inc_2) +{ + blasint N = DATASIZE; + blasint inc = 2; + float alpha[2] = {0.0f, 0.0f}; + + float norm = check_cscal('C', N, alpha, inc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_cspmv.c b/utest/test_extensions/test_cspmv.c new file mode 100644 index 000000000..b64c90e3a --- /dev/null +++ b/utest/test_extensions/test_cspmv.c @@ -0,0 +1,428 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. 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. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include "common.h" + +#define DATASIZE 100 +#define INCREMENT 2 + +struct DATA_CSPMV { + float a_verify[DATASIZE * DATASIZE * 2]; + float a_test[DATASIZE * (DATASIZE + 1)]; + float b_test[DATASIZE * 2 * INCREMENT]; + float c_test[DATASIZE * 2 * INCREMENT]; + float c_verify[DATASIZE * 2 * INCREMENT]; +}; + +#ifdef BUILD_COMPLEX +static struct DATA_CSPMV data_cspmv; + +/** + * Compute spmv via gemv since spmv is gemv for symmetric packed matrix + * + * param uplo specifies whether matrix A is upper or lower triangular + * param n - number of rows and columns of A + * param alpha - scaling factor for the matrix-vector product + * param a - buffer holding input matrix A + * param b - Buffer holding input vector b + * param inc_b - stride of vector b + * param beta - scaling factor for vector c + * param c - buffer holding input/output vector c + * param inc_c - stride of vector c + * output param data_cspmv.c_verify - matrix computed by gemv + */ +static void cspmv_trusted(char uplo, blasint n, float *alpha, float *a, + float *b, blasint inc_b, float *beta, float *c, + blasint inc_c) +{ + blasint k; + blasint i, j; + + // param for gemv (can use any, since the input matrix is symmetric) + char trans = 'N'; + + // Unpack the input symmetric packed matrix + if (uplo == 'L') + { + k = 0; + for (i = 0; i < n; i++) + { + for (j = 0; j < n * 2; j += 2) + { + if (j / 2 < i) + { + data_cspmv.a_verify[i * n * 2 + j] = + data_cspmv.a_verify[j * n + i * 2]; + data_cspmv.a_verify[i * n * 2 + j + 1] = + data_cspmv.a_verify[j * n + i * 2 + 1]; + } + else + { + data_cspmv.a_verify[i * n * 2 + j] = a[k++]; + data_cspmv.a_verify[i * n * 2 + j + 1] = a[k++]; + } + } + } + } + else + { + k = n * (n + 1) - 1; + for (j = 2 * n - 1; j >= 0; j -= 2) + { + for (i = n - 1; i >= 0; i--) + { + if (j / 2 < i) + { + data_cspmv.a_verify[i * n * 2 + j] = + data_cspmv.a_verify[(j - 1) * n + i * 2 + 1]; + data_cspmv.a_verify[i * n * 2 + j - 1] = + data_cspmv.a_verify[(j - 1) * n + i * 2]; + } + else + { + data_cspmv.a_verify[i * n * 2 + j] = a[k--]; + data_cspmv.a_verify[i * n * 2 + j - 1] = a[k--]; + } + } + } + } + + // Run gemv with the unpacked matrix + BLASFUNC(cgemv)(&trans, &n, &n, alpha, data_cspmv.a_verify, &n, b, + &inc_b, beta, data_cspmv.c_verify, &inc_c); +} + +/** + * Comapare results computed by cspmv and cspmv_trusted + * + * param uplo specifies whether matrix A is upper or lower triangular + * param n - number of rows and columns of A + * param alpha - scaling factor for the matrix-vector product + * param inc_b - stride of vector b + * param beta - scaling factor for vector c + * param inc_c - stride of vector c + * return norm of differences + */ +static float check_cspmv(char uplo, blasint n, float *alpha, blasint inc_b, + float *beta, blasint inc_c) +{ + blasint i; + + // Fill symmetric packed maxtix a, vectors b and c + srand_generate(data_cspmv.a_test, n * (n + 1)); + srand_generate(data_cspmv.b_test, 2 * n * inc_b); + srand_generate(data_cspmv.c_test, 2 * n * inc_c); + + // Copy vector c for cspmv_trusted + for (i = 0; i < n * 2 * inc_c; i++) + data_cspmv.c_verify[i] = data_cspmv.c_test[i]; + + cspmv_trusted(uplo, n, alpha, data_cspmv.a_test, data_cspmv.b_test, + inc_b, beta, data_cspmv.c_verify, inc_c); + + BLASFUNC(cspmv)(&uplo, &n, alpha, data_cspmv.a_test, data_cspmv.b_test, + &inc_b, beta, data_cspmv.c_test, &inc_c); + + // Find the differences between output vector computed by cspmv and cspmv_trusted + for (i = 0; i < n * 2 * inc_c; i++) + data_cspmv.c_test[i] -= data_cspmv.c_verify[i]; + + // Find the norm of differences + return BLASFUNC(scnrm2)(&n, data_cspmv.c_test, &inc_c); +} + +/** + * Check if error function was called with expected function name + * and param info + * + * param uplo specifies whether matrix A is upper or lower triangular + * param n - number of rows and columns of A + * param inc_b - stride of vector b + * param inc_c - stride of vector c + * param expected_info - expected invalid parameter number in cspmv + * return TRUE if everything is ok, otherwise FALSE + */ +static int check_badargs(char uplo, blasint n, blasint inc_b, + blasint inc_c, int expected_info) +{ + float alpha[] = {1.0, 1.0}; + float beta[] = {0.0, 0.0}; + + set_xerbla("CSPMV ", expected_info); + + BLASFUNC(cspmv)(&uplo, &n, alpha, data_cspmv.a_test, data_cspmv.b_test, + &inc_b, beta, data_cspmv.c_test, &inc_c); + + return check_error(); +} + +/** + * Test cspmv by comparing it against cgemv + * with the following options: + * + * A is upper triangular + * Number of rows and columns of A is 100 + * Stride of vector b is 1 + * Stride of vector c is 1 + */ +CTEST(cspmv, upper_inc_b_1_inc_c_1_N_100) +{ + blasint N = DATASIZE, inc_b = 1, inc_c = 1; + char uplo = 'U'; + float alpha[] = {1.0f, 1.0f}; + float beta[] = {0.0f, 0.0f}; + + float norm = check_cspmv(uplo, N, alpha, inc_b, beta, inc_c); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_TOL); +} + +/** + * Test cspmv by comparing it against cgemv + * with the following options: + * + * A is upper triangular + * Number of rows and columns of A is 100 + * Stride of vector b is 1 + * Stride of vector c is 2 + */ +CTEST(cspmv, upper_inc_b_1_inc_c_2_N_100) +{ + blasint N = DATASIZE, inc_b = 1, inc_c = 2; + char uplo = 'U'; + float alpha[] = {1.0f, 1.0f}; + float beta[] = {0.0f, 0.0f}; + + float norm = check_cspmv(uplo, N, alpha, inc_b, beta, inc_c); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_TOL); +} + +/** + * Test cspmv by comparing it against cgemv + * with the following options: + * + * A is upper triangular + * Number of rows and columns of A is 100 + * Stride of vector b is 2 + * Stride of vector c is 1 + */ +CTEST(cspmv, upper_inc_b_2_inc_c_1_N_100) +{ + blasint N = DATASIZE, inc_b = 2, inc_c = 1; + char uplo = 'U'; + float alpha[] = {1.0f, 0.0f}; + float beta[] = {1.0f, 0.0f}; + + float norm = check_cspmv(uplo, N, alpha, inc_b, beta, inc_c); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_TOL); +} + +/** + * Test cspmv by comparing it against cgemv + * with the following options: + * + * A is upper triangular + * Number of rows and columns of A is 100 + * Stride of vector b is 2 + * Stride of vector c is 2 + */ +CTEST(cspmv, upper_inc_b_2_inc_c_2_N_100) +{ + blasint N = DATASIZE, inc_b = 2, inc_c = 2; + char uplo = 'U'; + float alpha[] = {2.5, -2.1}; + float beta[] = {0.0f, 1.0f}; + + float norm = check_cspmv(uplo, N, alpha, inc_b, beta, inc_c); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_TOL); +} + +/** + * Test cspmv by comparing it against cgemv + * with the following options: + * + * A is lower triangular + * Number of rows and columns of A is 100 + * Stride of vector b is 1 + * Stride of vector c is 1 + */ +CTEST(cspmv, lower_inc_b_1_inc_c_1_N_100) +{ + blasint N = DATASIZE, inc_b = 1, inc_c = 1; + char uplo = 'L'; + float alpha[] = {1.0f, 1.0f}; + float beta[] = {0.0f, 0.0f}; + + float norm = check_cspmv(uplo, N, alpha, inc_b, beta, inc_c); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_TOL); +} + +/** + * Test cspmv by comparing it against cgemv + * with the following options: + * + * A is lower triangular + * Number of rows and columns of A is 100 + * Stride of vector b is 1 + * Stride of vector c is 2 + */ +CTEST(cspmv, lower_inc_b_1_inc_c_2_N_100) +{ + blasint N = DATASIZE, inc_b = 1, inc_c = 2; + char uplo = 'L'; + float alpha[] = {1.0f, 1.0f}; + float beta[] = {0.0f, 0.0f}; + + float norm = check_cspmv(uplo, N, alpha, inc_b, beta, inc_c); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_TOL); +} + +/** + * Test cspmv by comparing it against cgemv + * with the following options: + * + * A is lower triangular + * Number of rows and columns of A is 100 + * Stride of vector b is 2 + * Stride of vector c is 1 + */ +CTEST(cspmv, lower_inc_b_2_inc_c_1_N_100) +{ + blasint N = DATASIZE, inc_b = 2, inc_c = 1; + char uplo = 'L'; + float alpha[] = {1.0f, 0.0f}; + float beta[] = {1.0f, 0.0f}; + + float norm = check_cspmv(uplo, N, alpha, inc_b, beta, inc_c); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_TOL); +} + +/** + * Test cspmv by comparing it against cgemv + * with the following options: + * + * A is lower triangular + * Number of rows and columns of A is 100 + * Stride of vector b is 2 + * Stride of vector c is 2 + */ +CTEST(cspmv, lower_inc_b_2_inc_c_2_N_100) +{ + blasint N = DATASIZE, inc_b = 2, inc_c = 2; + char uplo = 'L'; + float alpha[] = {2.5, -2.1}; + float beta[] = {0.0f, 1.0f}; + + float norm = check_cspmv(uplo, N, alpha, inc_b, beta, inc_c); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_TOL); +} + +/** + * Check if output matrix A contains any NaNs + */ +CTEST(cspmv, check_for_NaN) +{ + blasint N = DATASIZE, inc_b = 1, inc_c = 1; + char uplo = 'U'; + float alpha[] = {1.0f, 1.0f}; + float beta[] = {0.0f, 0.0f}; + + float norm = check_cspmv(uplo, N, alpha, inc_b, beta, inc_c); + + ASSERT_TRUE(norm == norm); /* NaN == NaN is false */ +} + +/** + * Test error function for an invalid param uplo. + * uplo specifies whether A is upper or lower triangular. + */ +CTEST(cspmv, xerbla_uplo_invalid) +{ + blasint N = DATASIZE, inc_b = 1, inc_c = 1; + char uplo = 'O'; + int expected_info = 1; + + int passed = check_badargs(uplo, N, inc_b, inc_c, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param N - + * number of rows and columns of A. Must be at least zero. + */ +CTEST(cspmv, xerbla_N_invalid) +{ + blasint N = INVALID, inc_b = 1, inc_c = 1; + char uplo = 'U'; + int expected_info = 2; + + int passed = check_badargs(uplo, N, inc_b, inc_c, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param inc_b - + * stride of vector b. Can't be zero. + */ +CTEST(cspmv, xerbla_inc_b_zero) +{ + blasint N = DATASIZE, inc_b = 0, inc_c = 1; + char uplo = 'U'; + int expected_info = 6; + + int passed = check_badargs(uplo, N, inc_b, inc_c, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param inc_c - + * stride of vector c. Can't be zero. + */ +CTEST(cspmv, xerbla_inc_c_zero) +{ + blasint N = DATASIZE, inc_b = 1, inc_c = 0; + char uplo = 'U'; + int expected_info = 9; + + int passed = check_badargs(uplo, N, inc_b, inc_c, expected_info); + ASSERT_EQUAL(TRUE, passed); +} +#endif diff --git a/utest/test_extensions/test_ctrmv.c b/utest/test_extensions/test_ctrmv.c new file mode 100644 index 000000000..2a3f27416 --- /dev/null +++ b/utest/test_extensions/test_ctrmv.c @@ -0,0 +1,266 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. 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. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include +#include "common.h" + +#define DATASIZE 300 +#define INCREMENT 2 + +struct DATA_CTRMV { + float a_test[DATASIZE * DATASIZE * 2]; + float a_verify[DATASIZE * DATASIZE * 2]; + float x_test[DATASIZE * INCREMENT * 2]; + float x_verify[DATASIZE * INCREMENT * 2]; +}; + +#ifdef BUILD_COMPLEX +static struct DATA_CTRMV data_ctrmv; + +/** + * Test ctrmv with the conjugate and not-transposed matrix A by conjugating matrix A + * and comparing it with the non-conjugate ctrmv. + * + * param uplo specifies whether A is upper or lower triangular + * param trans specifies op(A), the transposition (conjugation) operation applied to A + * param diag specifies whether the matrix A is unit triangular or not. + * param n - numbers of rows and columns of A + * param lda - leading dimension of matrix A + * param incx - increment for the elements of x + * return norm of difference + */ +static float check_ctrmv(char uplo, char trans, char diag, blasint n, blasint lda, blasint incx) +{ + blasint i; + float alpha_conj[] = {1.0f, 0.0f}; + char trans_verify = trans; + + srand_generate(data_ctrmv.a_test, n * lda * 2); + srand_generate(data_ctrmv.x_test, n * incx * 2); + + for (i = 0; i < n * lda * 2; i++) + data_ctrmv.a_verify[i] = data_ctrmv.a_test[i]; + + for (i = 0; i < n * incx * 2; i++) + data_ctrmv.x_verify[i] = data_ctrmv.x_test[i]; + + if (trans == 'R'){ + cblas_cimatcopy(CblasColMajor, CblasConjNoTrans, n, n, alpha_conj, data_ctrmv.a_verify, lda, lda); + trans_verify = 'N'; + } + + BLASFUNC(ctrmv)(&uplo, &trans_verify, &diag, &n, data_ctrmv.a_verify, &lda, + data_ctrmv.x_verify, &incx); + + BLASFUNC(ctrmv)(&uplo, &trans, &diag, &n, data_ctrmv.a_test, &lda, + data_ctrmv.x_test, &incx); + + for (i = 0; i < n * incx * 2; i++) + data_ctrmv.x_verify[i] -= data_ctrmv.x_test[i]; + + return BLASFUNC(scnrm2)(&n, data_ctrmv.x_verify, &incx); +} + +/** + * Test ctrmv with the conjugate and not-transposed matrix A by conjugating matrix A + * and comparing it with the non-conjugate ctrmv. + * Test with the following options: + * + * matrix A is conjugate and not-trans + * matrix A is upper triangular + * matrix A is not unit triangular + */ +CTEST(ctrmv, conj_notrans_upper_not_unit_triangular) +{ + blasint n = DATASIZE, incx = 1, lda = DATASIZE; + char uplo = 'U'; + char diag = 'N'; + char trans = 'R'; + + float norm = check_ctrmv(uplo, trans, diag, n, lda, incx); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Test ctrmv with the conjugate and not-transposed matrix A by conjugating matrix A + * and comparing it with the non-conjugate ctrmv. + * Test with the following options: + * + * matrix A is conjugate and not-trans + * matrix A is upper triangular + * matrix A is unit triangular + */ +CTEST(ctrmv, conj_notrans_upper_unit_triangular) +{ + blasint n = DATASIZE, incx = 1, lda = DATASIZE; + char uplo = 'U'; + char diag = 'U'; + char trans = 'R'; + + float norm = check_ctrmv(uplo, trans, diag, n, lda, incx); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Test ctrmv with the conjugate and not-transposed matrix A by conjugating matrix A + * and comparing it with the non-conjugate ctrmv. + * Test with the following options: + * + * matrix A is conjugate and not-trans + * matrix A is lower triangular + * matrix A is not unit triangular + */ +CTEST(ctrmv, conj_notrans_lower_not_triangular) +{ + blasint n = DATASIZE, incx = 1, lda = DATASIZE; + char uplo = 'L'; + char diag = 'N'; + char trans = 'R'; + + float norm = check_ctrmv(uplo, trans, diag, n, lda, incx); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Test ctrmv with the conjugate and not-transposed matrix A by conjugating matrix A + * and comparing it with the non-conjugate ctrmv. + * Test with the following options: + * + * matrix A is conjugate and not-trans + * matrix A is lower triangular + * matrix A is unit triangular + */ +CTEST(ctrmv, conj_notrans_lower_unit_triangular) +{ + blasint n = DATASIZE, incx = 1, lda = DATASIZE; + char uplo = 'L'; + char diag = 'U'; + char trans = 'R'; + + float norm = check_ctrmv(uplo, trans, diag, n, lda, incx); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Test ctrmv with the conjugate and not-transposed matrix A by conjugating matrix A + * and comparing it with the non-conjugate ctrmv. + * Test with the following options: + * + * matrix A is conjugate and not-trans + * matrix A is upper triangular + * matrix A is not unit triangular + * vector x stride is 2 + */ +CTEST(ctrmv, conj_notrans_upper_not_unit_triangular_incx_2) +{ + blasint n = DATASIZE, incx = 2, lda = DATASIZE; + char uplo = 'U'; + char diag = 'N'; + char trans = 'R'; + + float norm = check_ctrmv(uplo, trans, diag, n, lda, incx); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Test ctrmv with the conjugate and not-transposed matrix A by conjugating matrix A + * and comparing it with the non-conjugate ctrmv. + * Test with the following options: + * + * matrix A is conjugate and not-trans + * matrix A is upper triangular + * matrix A is unit triangular + * vector x stride is 2 + */ +CTEST(ctrmv, conj_notrans_upper_unit_triangular_incx_2) +{ + blasint n = DATASIZE, incx = 2, lda = DATASIZE; + char uplo = 'U'; + char diag = 'U'; + char trans = 'R'; + + float norm = check_ctrmv(uplo, trans, diag, n, lda, incx); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Test ctrmv with the conjugate and not-transposed matrix A by conjugating matrix A + * and comparing it with the non-conjugate ctrmv. + * Test with the following options: + * + * matrix A is conjugate and not-trans + * matrix A is lower triangular + * matrix A is not unit triangular + * vector x stride is 2 + */ +CTEST(ctrmv, conj_notrans_lower_not_triangular_incx_2) +{ + blasint n = DATASIZE, incx = 2, lda = DATASIZE; + char uplo = 'L'; + char diag = 'N'; + char trans = 'R'; + + float norm = check_ctrmv(uplo, trans, diag, n, lda, incx); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Test ctrmv with the conjugate and not-transposed matrix A by conjugating matrix A + * and comparing it with the non-conjugate ctrmv. + * Test with the following options: + * + * matrix A is conjugate and not-trans + * matrix A is lower triangular + * matrix A is unit triangular + * vector x stride is 2 + */ +CTEST(ctrmv, conj_notrans_lower_unit_triangular_incx_2) +{ + blasint n = DATASIZE, incx = 2, lda = DATASIZE; + char uplo = 'L'; + char diag = 'U'; + char trans = 'R'; + + float norm = check_ctrmv(uplo, trans, diag, n, lda, incx); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_ctrsv.c b/utest/test_extensions/test_ctrsv.c new file mode 100644 index 000000000..0e639bb2a --- /dev/null +++ b/utest/test_extensions/test_ctrsv.c @@ -0,0 +1,267 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. 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. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include +#include "common.h" + +#define DATASIZE 300 +#define INCREMENT 2 + +struct DATA_CTRSV { + float a_test[DATASIZE * DATASIZE * 2]; + float a_verify[DATASIZE * DATASIZE * 2]; + float x_test[DATASIZE * INCREMENT * 2]; + float x_verify[DATASIZE * INCREMENT * 2]; +}; + +#ifdef BUILD_COMPLEX +static struct DATA_CTRSV data_ctrsv; + +/** + * Test ctrsv with the conjugate and not-transposed matrix A by conjugating matrix A + * and comparing it with the non-conjugate ctrsv. + * + * param uplo specifies whether A is upper or lower triangular + * param trans specifies op(A), the transposition (conjugation) operation applied to A + * param diag specifies whether the matrix A is unit triangular or not. + * param n - numbers of rows and columns of A + * param lda - leading dimension of matrix A + * param incx - increment for the elements of x + * return norm of difference + */ +static float check_ctrsv(char uplo, char trans, char diag, blasint n, blasint lda, blasint incx) +{ + blasint i; + float alpha_conj[] = {1.0f, 0.0f}; + char trans_verify = trans; + + srand_generate(data_ctrsv.a_test, n * lda * 2); + srand_generate(data_ctrsv.x_test, n * incx * 2); + + for (i = 0; i < n * lda * 2; i++) + data_ctrsv.a_verify[i] = data_ctrsv.a_test[i]; + + for (i = 0; i < n * incx * 2; i++) + data_ctrsv.x_verify[i] = data_ctrsv.x_test[i]; + + if (trans == 'R'){ + cblas_cimatcopy(CblasColMajor, CblasConjNoTrans, n, n, + alpha_conj, data_ctrsv.a_verify, lda, lda); + trans_verify = 'N'; + } + + BLASFUNC(ctrsv)(&uplo, &trans_verify, &diag, &n, data_ctrsv.a_verify, + &lda, data_ctrsv.x_verify, &incx); + + BLASFUNC(ctrsv)(&uplo, &trans, &diag, &n, data_ctrsv.a_test, &lda, + data_ctrsv.x_test, &incx); + + for (i = 0; i < n * incx * 2; i++) + data_ctrsv.x_verify[i] -= data_ctrsv.x_test[i]; + + return BLASFUNC(scnrm2)(&n, data_ctrsv.x_verify, &incx); +} + +/** + * Test ctrsv with the conjugate and not-transposed matrix A by conjugating matrix A + * and comparing it with the non-conjugate ctrsv. + * Test with the following options: + * + * matrix A is conjugate and not-trans + * matrix A is upper triangular + * matrix A is not unit triangular + */ +CTEST(ctrsv, conj_notrans_upper_not_unit_triangular) +{ + blasint n = DATASIZE, incx = 1, lda = DATASIZE; + char uplo = 'U'; + char diag = 'N'; + char trans = 'R'; + + float norm = check_ctrsv(uplo, trans, diag, n, lda, incx); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, DOUBLE_EPS); +} + +/** + * Test ctrsv with the conjugate and not-transposed matrix A by conjugating matrix A + * and comparing it with the non-conjugate ctrsv. + * Test with the following options: + * + * matrix A is conjugate and not-trans + * matrix A is upper triangular + * matrix A is unit triangular + */ +CTEST(ctrsv, conj_notrans_upper_unit_triangular) +{ + blasint n = DATASIZE, incx = 1, lda = DATASIZE; + char uplo = 'U'; + char diag = 'U'; + char trans = 'R'; + + float norm = check_ctrsv(uplo, trans, diag, n, lda, incx); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, DOUBLE_EPS); +} + +/** + * Test ctrsv with the conjugate and not-transposed matrix A by conjugating matrix A + * and comparing it with the non-conjugate ctrsv. + * Test with the following options: + * + * matrix A is conjugate and not-trans + * matrix A is lower triangular + * matrix A is not unit triangular + */ +CTEST(ctrsv, conj_notrans_lower_not_triangular) +{ + blasint n = DATASIZE, incx = 1, lda = DATASIZE; + char uplo = 'L'; + char diag = 'N'; + char trans = 'R'; + + float norm = check_ctrsv(uplo, trans, diag, n, lda, incx); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, DOUBLE_EPS); +} + +/** + * Test ctrsv with the conjugate and not-transposed matrix A by conjugating matrix A + * and comparing it with the non-conjugate ctrsv. + * Test with the following options: + * + * matrix A is conjugate and not-trans + * matrix A is lower triangular + * matrix A is unit triangular + */ +CTEST(ctrsv, conj_notrans_lower_unit_triangular) +{ + blasint n = DATASIZE, incx = 1, lda = DATASIZE; + char uplo = 'L'; + char diag = 'U'; + char trans = 'R'; + + float norm = check_ctrsv(uplo, trans, diag, n, lda, incx); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, DOUBLE_EPS); +} + +/** + * Test ctrsv with the conjugate and not-transposed matrix A by conjugating matrix A + * and comparing it with the non-conjugate ctrsv. + * Test with the following options: + * + * matrix A is conjugate and not-trans + * matrix A is upper triangular + * matrix A is not unit triangular + * vector x stride is 2 + */ +CTEST(ctrsv, conj_notrans_upper_not_unit_triangular_incx_2) +{ + blasint n = DATASIZE, incx = 2, lda = DATASIZE; + char uplo = 'U'; + char diag = 'N'; + char trans = 'R'; + + float norm = check_ctrsv(uplo, trans, diag, n, lda, incx); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, DOUBLE_EPS); +} + +/** + * Test ctrsv with the conjugate and not-transposed matrix A by conjugating matrix A + * and comparing it with the non-conjugate ctrsv. + * Test with the following options: + * + * matrix A is conjugate and not-trans + * matrix A is upper triangular + * matrix A is unit triangular + * vector x stride is 2 + */ +CTEST(ctrsv, conj_notrans_upper_unit_triangular_incx_2) +{ + blasint n = DATASIZE, incx = 2, lda = DATASIZE; + char uplo = 'U'; + char diag = 'U'; + char trans = 'R'; + + float norm = check_ctrsv(uplo, trans, diag, n, lda, incx); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, DOUBLE_EPS); +} + +/** + * Test ctrsv with the conjugate and not-transposed matrix A by conjugating matrix A + * and comparing it with the non-conjugate ctrsv. + * Test with the following options: + * + * matrix A is conjugate and not-trans + * matrix A is lower triangular + * matrix A is not unit triangular + * vector x stride is 2 + */ +CTEST(ctrsv, conj_notrans_lower_not_triangular_incx_2) +{ + blasint n = DATASIZE, incx = 2, lda = DATASIZE; + char uplo = 'L'; + char diag = 'N'; + char trans = 'R'; + + float norm = check_ctrsv(uplo, trans, diag, n, lda, incx); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, DOUBLE_EPS); +} + +/** + * Test ctrsv with the conjugate and not-transposed matrix A by conjugating matrix A + * and comparing it with the non-conjugate ctrsv. + * Test with the following options: + * + * matrix A is conjugate and not-trans + * matrix A is lower triangular + * matrix A is unit triangular + * vector x stride is 2 + */ +CTEST(ctrsv, conj_notrans_lower_unit_triangular_incx_2) +{ + blasint n = DATASIZE, incx = 2, lda = DATASIZE; + char uplo = 'L'; + char diag = 'U'; + char trans = 'R'; + + float norm = check_ctrsv(uplo, trans, diag, n, lda, incx); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, DOUBLE_EPS); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_damin.c b/utest/test_extensions/test_damin.c new file mode 100644 index 000000000..d492343ed --- /dev/null +++ b/utest/test_extensions/test_damin.c @@ -0,0 +1,354 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. 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. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include + +#define ELEMENTS 70 +#define INCREMENT 2 + +#ifdef BUILD_DOUBLE + +/** + * Test damin by comparing it against pre-calculated values + */ +CTEST(damin, bad_args_N_0){ + blasint i; + blasint N = 0, inc = 1; + double x[ELEMENTS]; + for (i = 0; i < ELEMENTS * inc; i ++) { + x[i] = 1000 - i; + } + double amin = BLASFUNC(damin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0, amin, DOUBLE_EPS); +} + +/** + * Test damin by comparing it against pre-calculated values + */ +CTEST(damin, step_zero){ + blasint i; + blasint N = ELEMENTS, inc = 0; + double x[ELEMENTS]; + for (i = 0; i < N * inc; i ++) { + x[i] = i + 1000; + } + x[8] = 0.0; + double amin = BLASFUNC(damin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0, amin, DOUBLE_EPS); +} + +/** + * Test damin by comparing it against pre-calculated values + */ +CTEST(damin, positive_step_1_N_1){ + blasint N = 1, inc = 1; + double x[] = {1.1}; + + double amin = BLASFUNC(damin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.1, amin, DOUBLE_EPS); +} + +/** + * Test damin by comparing it against pre-calculated values + */ +CTEST(damin, negative_step_1_N_1){ + blasint N = 1, inc = 1; + double x[] = {-1.1}; + + double amin = BLASFUNC(damin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.1, amin, DOUBLE_EPS); +} + +/** + * Test damin by comparing it against pre-calculated values + */ +CTEST(damin, positive_step_2_N_1){ + blasint N = 1, inc = 2; + double x[] = {1.1, 0.0}; + + double amin = BLASFUNC(damin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.1, amin, DOUBLE_EPS); +} + +/** + * Test damin by comparing it against pre-calculated values + */ +CTEST(damin, negative_step_2_N_1){ + blasint N = 1, inc = 2; + double x[] = {-1.1, 0.0}; + + double amin = BLASFUNC(damin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.1, amin, DOUBLE_EPS); +} + +/** + * Test damin by comparing it against pre-calculated values + */ +CTEST(damin, positive_step_1_N_2){ + blasint N = 2, inc = 1; + double x[] = {1.1, 1.0}; + + double amin = BLASFUNC(damin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.0, amin, DOUBLE_EPS); +} + +/** + * Test damin by comparing it against pre-calculated values + */ +CTEST(damin, negative_step_1_N_2){ + blasint N = 2, inc = 1; + double x[] = {-1.1, 1.0}; + + double amin = BLASFUNC(damin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.0, amin, DOUBLE_EPS); +} + +/** + * Test damin by comparing it against pre-calculated values + */ +CTEST(damin, positive_step_2_N_2){ + blasint N = 2, inc = 2; + double x[] = {1.1, 0.0, 1.0, 0.0}; + + double amin = BLASFUNC(damin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.0, amin, DOUBLE_EPS); +} + +/** + * Test damin by comparing it against pre-calculated values + */ +CTEST(damin, negative_step_2_N_2){ + blasint N = 2, inc = 2; + double x[] = {-1.1, 0.0, 1.0, 0.0}; + + double amin = BLASFUNC(damin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.0, amin, DOUBLE_EPS); +} + +/** + * Test damin by comparing it against pre-calculated values + */ +CTEST(damin, positive_step_1_N_3){ + blasint N = 3, inc = 1; + double x[] = {1.1, 1.0, 2.2}; + + double amin = BLASFUNC(damin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.0, amin, DOUBLE_EPS); +} + +/** + * Test damin by comparing it against pre-calculated values + */ +CTEST(damin, negative_step_1_N_3){ + blasint N = 3, inc = 1; + double x[] = {-1.1, 1.0, -2.2}; + + double amin = BLASFUNC(damin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.0, amin, DOUBLE_EPS); +} + +/** + * Test damin by comparing it against pre-calculated values + */ +CTEST(damin, positive_step_2_N_3){ + blasint N = 3, inc = 2; + double x[] = {1.1, 0.0, 1.0, 0.0, 2.2, 0.0}; + + double amin = BLASFUNC(damin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.0, amin, DOUBLE_EPS); +} + +/** + * Test damin by comparing it against pre-calculated values + */ +CTEST(damin, negative_step_2_N_3){ + blasint N = 3, inc = 2; + double x[] = {-1.1, 0.0, 1.0, 0.0, -2.2, 0.0}; + + double amin = BLASFUNC(damin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.0, amin, DOUBLE_EPS); +} + +/** + * Test damin by comparing it against pre-calculated values + */ +CTEST(damin, positive_step_1_N_4){ + blasint N = 4, inc = 1; + double x[] = {1.1, 1.0, 2.2, 3.3}; + + double amin = BLASFUNC(damin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.0, amin, DOUBLE_EPS); +} + +/** + * Test damin by comparing it against pre-calculated values + */ +CTEST(damin, negative_step_1_N_4){ + blasint N = 4, inc = 1; + double x[] = {-1.1, 1.0, -2.2, -3.3}; + + double amin = BLASFUNC(damin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.0, amin, DOUBLE_EPS); +} + +/** + * Test damin by comparing it against pre-calculated values + */ +CTEST(damin, positive_step_2_N_4){ + blasint N = 4, inc = 2; + double x[] = {1.1, 0.0, 1.0, 0.0, 2.2, 0.0, 3.3, 0.0}; + + double amin = BLASFUNC(damin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.0, amin, DOUBLE_EPS); +} + +/** + * Test damin by comparing it against pre-calculated values + */ +CTEST(damin, negative_step_2_N_4){ + blasint N = 4, inc = 2; + double x[] = {-1.1, 0.0, 1.0, 0.0, -2.2, 0.0, -3.3, 0.0}; + + double amin = BLASFUNC(damin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.0, amin, DOUBLE_EPS); +} + +/** + * Test damin by comparing it against pre-calculated values + */ +CTEST(damin, positive_step_1_N_5){ + blasint N = 5, inc = 1; + double x[] = {1.1, 1.0, 2.2, 3.3, 0.0}; + + double amin = BLASFUNC(damin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0, amin, DOUBLE_EPS); +} + +/** + * Test damin by comparing it against pre-calculated values + */ +CTEST(damin, negative_step_1_N_5){ + blasint N = 5, inc = 1; + double x[] = {-1.1, 1.0, -2.2, -3.3, 0.0}; + + double amin = BLASFUNC(damin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0, amin, DOUBLE_EPS); +} + +/** + * Test damin by comparing it against pre-calculated values + */ +CTEST(damin, positive_step_2_N_5){ + blasint N = 5, inc = 2; + double x[] = {1.1, 0.0, 1.0, 0.0, 2.2, 0.0, 3.3, 0.0, 0.0, 0.0}; + + double amin = BLASFUNC(damin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0, amin, DOUBLE_EPS); +} + +/** + * Test damin by comparing it against pre-calculated values + */ +CTEST(damin, negative_step_2_N_5){ + blasint N = 5, inc = 2; + double x[] = {-1.1, 0.0, 1.0, 0.0, -2.2, 0.0, -3.3, 0.0, 0.0, 0.0}; + + double amin = BLASFUNC(damin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0, amin, DOUBLE_EPS); +} + +/** + * Test damin by comparing it against pre-calculated values + */ +CTEST(damin, positive_step_1_N_70){ + blasint i; + blasint N = ELEMENTS, inc = 1; + double x[ELEMENTS]; + for (i = 0; i < N * inc; i ++) { + x[i] = i + 1000; + } + + x[8 * inc] = 0.0; + double amin = BLASFUNC(damin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0, amin, DOUBLE_EPS); +} + +/** + * Test damin by comparing it against pre-calculated values + */ +CTEST(damin, negative_step_1_N_70){ + blasint i; + blasint N = ELEMENTS, inc = 1; + double x[ELEMENTS]; + for (i = 0; i < N * inc; i ++) { + x[i] = - i - 1000; + } + + x[8 * inc] = -1.0; + double amin = BLASFUNC(damin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.0, amin, DOUBLE_EPS); +} + +/** + * Test damin by comparing it against pre-calculated values + */ +CTEST(damin, positive_step_2_N_70){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + double x[ELEMENTS * INCREMENT]; + for (i = 0; i < N * inc; i ++) { + x[i] = i + 1000; + } + + x[8 * inc] = 1.0; + double amin = BLASFUNC(damin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.0, amin, DOUBLE_EPS); +} + +/** + * Test damin by comparing it against pre-calculated values + */ +CTEST(damin, negative_step_2_N_70){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + double x[ELEMENTS * INCREMENT]; + for (i = 0; i < N * inc; i ++) { + x[i] = - i - 1000; + } + + x[8 * inc] = -1.0; + double amin = BLASFUNC(damin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.0, amin, DOUBLE_EPS); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_daxpby.c b/utest/test_extensions/test_daxpby.c new file mode 100644 index 000000000..6e77c7c7c --- /dev/null +++ b/utest/test_extensions/test_daxpby.c @@ -0,0 +1,799 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. 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. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include "common.h" + +#define DATASIZE 100 +#define INCREMENT 2 + +struct DATA_DAXPBY{ + double x_test[DATASIZE * INCREMENT]; + double x_verify[DATASIZE * INCREMENT]; + double y_test[DATASIZE * INCREMENT]; + double y_verify[DATASIZE * INCREMENT]; +}; + +#ifdef BUILD_DOUBLE +static struct DATA_DAXPBY data_daxpby; + +/** + * Fortran API specific function + * Test daxpby by comparing it with dscal and daxpy. + * Compare with the following options: + * + * param n - number of elements in vectors x and y + * param alpha - scalar alpha + * param incx - increment for the elements of x + * param beta - scalar beta + * param incy - increment for the elements of y + * return norm of difference + */ +static double check_daxpby(blasint n, double alpha, blasint incx, double beta, blasint incy) +{ + blasint i; + + // dscal accept only positive increments + blasint incx_abs = labs(incx); + blasint incy_abs = labs(incy); + + // Fill vectors x, y + drand_generate(data_daxpby.x_test, n * incx_abs); + drand_generate(data_daxpby.y_test, n * incy_abs); + + // Copy vector x for daxpy + for (i = 0; i < n * incx_abs; i++) + data_daxpby.x_verify[i] = data_daxpby.x_test[i]; + + // Copy vector y for dscal + for (i = 0; i < n * incy_abs; i++) + data_daxpby.y_verify[i] = data_daxpby.y_test[i]; + + // Find beta*y + BLASFUNC(dscal)(&n, &beta, data_daxpby.y_verify, &incy_abs); + + // Find sum of alpha*x and beta*y + BLASFUNC(daxpy)(&n, &alpha, data_daxpby.x_verify, &incx, + data_daxpby.y_verify, &incy); + + BLASFUNC(daxpby)(&n, &alpha, data_daxpby.x_test, &incx, + &beta, data_daxpby.y_test, &incy); + + // Find the differences between output vector caculated by daxpby and daxpy + for (i = 0; i < n * incy_abs; i++) + data_daxpby.y_test[i] -= data_daxpby.y_verify[i]; + + // Find the norm of differences + return BLASFUNC(dnrm2)(&n, data_daxpby.y_test, &incy_abs); +} + +/** + * C API specific function + * Test daxpby by comparing it with dscal and daxpy. + * Compare with the following options: + * + * param n - number of elements in vectors x and y + * param alpha - scalar alpha + * param incx - increment for the elements of x + * param beta - scalar beta + * param incy - increment for the elements of y + * return norm of difference + */ +static double c_api_check_daxpby(blasint n, double alpha, blasint incx, double beta, blasint incy) +{ + blasint i; + + // dscal accept only positive increments + blasint incx_abs = labs(incx); + blasint incy_abs = labs(incy); + + // Copy vector x for daxpy + for (i = 0; i < n * incx_abs; i++) + data_daxpby.x_verify[i] = data_daxpby.x_test[i]; + + // Copy vector y for dscal + for (i = 0; i < n * incy_abs; i++) + data_daxpby.y_verify[i] = data_daxpby.y_test[i]; + + // Find beta*y + cblas_dscal(n, beta, data_daxpby.y_verify, incy_abs); + + // Find sum of alpha*x and beta*y + cblas_daxpy(n, alpha, data_daxpby.x_verify, incx, + data_daxpby.y_verify, incy); + + cblas_daxpby(n, alpha, data_daxpby.x_test, incx, + beta, data_daxpby.y_test, incy); + + // Find the differences between output vector caculated by daxpby and daxpy + for (i = 0; i < n * incy_abs; i++) + data_daxpby.y_test[i] -= data_daxpby.y_verify[i]; + + // Find the norm of differences + return cblas_dnrm2(n, data_daxpby.y_test, incy_abs); +} + +/** + * Fortran API specific test + * Test daxpby by comparing it with dscal and daxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 1 + */ +CTEST(daxpby, inc_x_1_inc_y_1_N_100) +{ + blasint n = DATASIZE, incx = 1, incy = 1; + double alpha = 1.0; + double beta = 1.0; + + double norm = check_daxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test daxpby by comparing it with dscal and daxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 1 + */ +CTEST(daxpby, inc_x_2_inc_y_1_N_100) +{ + blasint n = DATASIZE, incx = 2, incy = 1; + double alpha = 2.0; + double beta = 1.0; + + double norm = check_daxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test daxpby by comparing it with dscal and daxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 2 + */ +CTEST(daxpby, inc_x_1_inc_y_2_N_100) +{ + blasint n = DATASIZE, incx = 1, incy = 2; + double alpha = 1.0; + double beta = 2.0; + + double norm = check_daxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test daxpby by comparing it with dscal and daxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 2 + */ +CTEST(daxpby, inc_x_2_inc_y_2_N_100) +{ + blasint n = DATASIZE, incx = 2, incy = 2; + double alpha = 3.0; + double beta = 4.0; + + double norm = check_daxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test daxpby by comparing it with dscal and daxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is -1 + * Stride of vector y is 2 + */ +CTEST(daxpby, inc_x_neg_1_inc_y_2_N_100) +{ + blasint n = DATASIZE, incx = -1, incy = 2; + double alpha = 5.0; + double beta = 4.0; + + double norm = check_daxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test daxpby by comparing it with dscal and daxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is -1 + */ +CTEST(daxpby, inc_x_2_inc_y_neg_1_N_100) +{ + blasint n = DATASIZE, incx = 2, incy = -1; + double alpha = 1.0; + double beta = 6.0; + + double norm = check_daxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test daxpby by comparing it with dscal and daxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is -2 + * Stride of vector y is -1 + */ +CTEST(daxpby, inc_x_neg_2_inc_y_neg_1_N_100) +{ + blasint n = DATASIZE, incx = -2, incy = -1; + double alpha = 7.0; + double beta = 3.5; + + double norm = check_daxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test daxpby by comparing it with dscal and daxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 1 + * Scalar alpha is zero + */ +CTEST(daxpby, inc_x_1_inc_y_1_N_100_alpha_zero) +{ + blasint n = DATASIZE, incx = 1, incy = 1; + double alpha = 0.0; + double beta = 1.0; + + double norm = check_daxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test daxpby by comparing it with dscal and daxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 2 + * Scalar alpha is zero +*/ +CTEST(daxpby, inc_x_1_inc_y_2_N_100_alpha_zero) +{ + blasint n = DATASIZE, incx = 1, incy = 2; + double alpha = 0.0; + double beta = 1.0; + + double norm = check_daxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test daxpby by comparing it with dscal and daxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 1 + * Scalar beta is zero + */ +CTEST(daxpby, inc_x_1_inc_y_1_N_100_beta_zero) +{ + blasint n = DATASIZE, incx = 1, incy = 1; + double alpha = 1.0; + double beta = 0.0; + + double norm = check_daxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test daxpby by comparing it with dscal and daxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 1 + * Scalar beta is zero +*/ +CTEST(daxpby, inc_x_2_inc_y_1_N_100_beta_zero) +{ + blasint n = DATASIZE, incx = 2, incy = 1; + double alpha = 1.0; + double beta = 0.0; + + double norm = check_daxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test daxpby by comparing it with dscal and daxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 2 + * Scalar beta is zero +*/ +CTEST(daxpby, inc_x_1_inc_y_2_N_100_beta_zero) +{ + blasint n = DATASIZE, incx = 1, incy = 2; + double alpha = 1.0; + double beta = 0.0; + + double norm = check_daxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test daxpby by comparing it with dscal and daxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 2 + * Scalar beta is zero +*/ +CTEST(daxpby, inc_x_2_inc_y_2_N_100_beta_zero) +{ + blasint n = DATASIZE, incx = 2, incy = 2; + double alpha = 1.0; + double beta = 0.0; + + double norm = check_daxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test daxpby by comparing it with dscal and daxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 1 + * Scalar alpha is zero + * Scalar beta is zero + */ +CTEST(daxpby, inc_x_1_inc_y_1_N_100_alpha_beta_zero) +{ + blasint n = DATASIZE, incx = 1, incy = 1; + double alpha = 0.0; + double beta = 0.0; + + double norm = check_daxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test daxpby by comparing it with dscal and daxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 2 + * Scalar alpha is zero + * Scalar beta is zero +*/ +CTEST(daxpby, inc_x_1_inc_y_2_N_100_alpha_beta_zero) +{ + blasint n = DATASIZE, incx = 1, incy = 2; + double alpha = 0.0; + double beta = 0.0; + + double norm = check_daxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Check if n - size of vectors x, y is zero + */ +CTEST(daxpby, check_n_zero) +{ + blasint n = 0, incx = 1, incy = 1; + double alpha = 1.0; + double beta = 1.0; + + double norm = check_daxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test daxpby by comparing it with dscal and daxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 1 + */ +CTEST(daxpby, c_api_inc_x_1_inc_y_1_N_100) +{ + blasint n = DATASIZE, incx = 1, incy = 1; + double alpha = 1.0; + double beta = 1.0; + + double norm = c_api_check_daxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test daxpby by comparing it with dscal and daxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 1 + */ +CTEST(daxpby, c_api_inc_x_2_inc_y_1_N_100) +{ + blasint n = DATASIZE, incx = 2, incy = 1; + double alpha = 2.0; + double beta = 1.0; + + double norm = c_api_check_daxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test daxpby by comparing it with dscal and daxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 2 + */ +CTEST(daxpby, c_api_inc_x_1_inc_y_2_N_100) +{ + blasint n = DATASIZE, incx = 1, incy = 2; + double alpha = 1.0; + double beta = 2.0; + + double norm = c_api_check_daxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test daxpby by comparing it with dscal and daxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 2 + */ +CTEST(daxpby, c_api_inc_x_2_inc_y_2_N_100) +{ + blasint n = DATASIZE, incx = 2, incy = 2; + double alpha = 3.0; + double beta = 4.0; + + double norm = c_api_check_daxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test daxpby by comparing it with dscal and daxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is -1 + * Stride of vector y is 2 + */ +CTEST(daxpby, c_api_inc_x_neg_1_inc_y_2_N_100) +{ + blasint n = DATASIZE, incx = -1, incy = 2; + double alpha = 5.0; + double beta = 4.0; + + double norm = c_api_check_daxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test daxpby by comparing it with dscal and daxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is -1 + */ +CTEST(daxpby, c_api_inc_x_2_inc_y_neg_1_N_100) +{ + blasint n = DATASIZE, incx = 2, incy = -1; + double alpha = 1.0; + double beta = 6.0; + + double norm = c_api_check_daxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test daxpby by comparing it with dscal and daxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is -2 + * Stride of vector y is -1 + */ +CTEST(daxpby, c_api_inc_x_neg_2_inc_y_neg_1_N_100) +{ + blasint n = DATASIZE, incx = -2, incy = -1; + double alpha = 7.0; + double beta = 3.5; + + double norm = c_api_check_daxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test daxpby by comparing it with dscal and daxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 1 + * Scalar alpha is zero + */ +CTEST(daxpby, c_api_inc_x_1_inc_y_1_N_100_alpha_zero) +{ + blasint n = DATASIZE, incx = 1, incy = 1; + double alpha = 0.0; + double beta = 1.0; + + double norm = c_api_check_daxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test daxpby by comparing it with dscal and daxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 2 + * Scalar alpha is zero +*/ +CTEST(daxpby, c_api_inc_x_1_inc_y_2_N_100_alpha_zero) +{ + blasint n = DATASIZE, incx = 1, incy = 2; + double alpha = 0.0; + double beta = 1.0; + + double norm = c_api_check_daxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * + * Test daxpby by comparing it with dscal and daxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 1 + * Scalar beta is zero + */ +CTEST(daxpby, c_api_inc_x_1_inc_y_1_N_100_beta_zero) +{ + blasint n = DATASIZE, incx = 1, incy = 1; + double alpha = 1.0; + double beta = 0.0; + + double norm = c_api_check_daxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test daxpby by comparing it with dscal and daxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 1 + * Scalar beta is zero +*/ +CTEST(daxpby, c_api_inc_x_2_inc_y_1_N_100_beta_zero) +{ + blasint n = DATASIZE, incx = 2, incy = 1; + double alpha = 1.0; + double beta = 0.0; + + double norm = c_api_check_daxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * + * Test daxpby by comparing it with dscal and daxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 2 + * Scalar beta is zero +*/ +CTEST(daxpby, c_api_inc_x_1_inc_y_2_N_100_beta_zero) +{ + blasint n = DATASIZE, incx = 1, incy = 2; + double alpha = 1.0; + double beta = 0.0; + + double norm = c_api_check_daxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * + * Test daxpby by comparing it with dscal and daxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 2 + * Scalar beta is zero +*/ +CTEST(daxpby, c_api_inc_x_2_inc_y_2_N_100_beta_zero) +{ + blasint n = DATASIZE, incx = 2, incy = 2; + double alpha = 1.0; + double beta = 0.0; + + double norm = c_api_check_daxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * + * Test daxpby by comparing it with dscal and daxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 1 + * Scalar alpha is zero + * Scalar beta is zero + */ +CTEST(daxpby, c_api_inc_x_1_inc_y_1_N_100_alpha_beta_zero) +{ + blasint n = DATASIZE, incx = 1, incy = 1; + double alpha = 0.0; + double beta = 0.0; + + double norm = c_api_check_daxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test daxpby by comparing it with dscal and daxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 2 + * Scalar alpha is zero + * Scalar beta is zero +*/ +CTEST(daxpby, c_api_inc_x_1_inc_y_2_N_100_alpha_beta_zero) +{ + blasint n = DATASIZE, incx = 1, incy = 2; + double alpha = 0.0; + double beta = 0.0; + + double norm = c_api_check_daxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Check if n - size of vectors x, y is zero + */ +CTEST(daxpby, c_api_check_n_zero) +{ + blasint n = 0, incx = 1, incy = 1; + double alpha = 1.0; + double beta = 1.0; + + double norm = c_api_check_daxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_dgeadd.c b/utest/test_extensions/test_dgeadd.c new file mode 100644 index 000000000..4654c51a3 --- /dev/null +++ b/utest/test_extensions/test_dgeadd.c @@ -0,0 +1,878 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. 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. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include "common.h" + +#define N 100 +#define M 100 + +struct DATA_DGEADD{ + double a_test[M * N]; + double c_test[M * N]; + double c_verify[M * N]; +}; + +#ifdef BUILD_DOUBLE +static struct DATA_DGEADD data_dgeadd; + +/** + * dgeadd reference implementation + * + * param m - number of rows of A and C + * param n - number of columns of A and C + * param alpha - scaling factor for matrix A + * param aptr - refer to matrix A + * param lda - leading dimension of A + * param beta - scaling factor for matrix C + * param cptr - refer to matrix C + * param ldc - leading dimension of C + */ +static void dgeadd_trusted(blasint m, blasint n, double alpha, double *aptr, + blasint lda, double beta, double *cptr, blasint ldc) +{ + blasint i; + + for (i = 0; i < n; i++) + { + cblas_daxpby(m, alpha, aptr, 1, beta, cptr, 1); + aptr += lda; + cptr += ldc; + } +} + +/** + * Test dgeadd by comparing it against reference + * Compare with the following options: + * + * param api - specifies Fortran or C API + * param order - specifies whether A and C stored in + * row-major order or column-major order + * param m - number of rows of A and C + * param n - number of columns of A and C + * param alpha - scaling factor for matrix A + * param lda - leading dimension of A + * param beta - scaling factor for matrix C + * param ldc - leading dimension of C + * return norm of differences + */ +static double check_dgeadd(char api, OPENBLAS_CONST enum CBLAS_ORDER order, + blasint m, blasint n, double alpha, blasint lda, + double beta, blasint ldc) +{ + blasint i; + blasint cols = m, rows = n; + + if (order == CblasRowMajor) + { + rows = m; + cols = n; + } + + // Fill matrix A, C + drand_generate(data_dgeadd.a_test, lda * rows); + drand_generate(data_dgeadd.c_test, ldc * rows); + + // Copy matrix C for dgeadd + for (i = 0; i < ldc * rows; i++) + data_dgeadd.c_verify[i] = data_dgeadd.c_test[i]; + + dgeadd_trusted(cols, rows, alpha, data_dgeadd.a_test, lda, + beta, data_dgeadd.c_verify, ldc); + + if (api == 'F') + BLASFUNC(dgeadd)(&m, &n, &alpha, data_dgeadd.a_test, &lda, + &beta, data_dgeadd.c_test, &ldc); + else + cblas_dgeadd(order, m, n, alpha, data_dgeadd.a_test, lda, + beta, data_dgeadd.c_test, ldc); + + // Find the differences between output matrix caculated by dgeadd and sgemm + return dmatrix_difference(data_dgeadd.c_test, data_dgeadd.c_verify, cols, rows, ldc); +} + +/** + * Check if error function was called with expected function name + * and param info + * + * param api - specifies Fortran or C API + * param order - specifies whether A and C stored in + * row-major order or column-major order + * param m - number of rows of A and C + * param n - number of columns of A and C + * param lda - leading dimension of A + * param ldc - leading dimension of C + * param expected_info - expected invalid parameter number in dgeadd + * return TRUE if everything is ok, otherwise FALSE + */ +static int check_badargs(char api, OPENBLAS_CONST enum CBLAS_ORDER order, + blasint m, blasint n, blasint lda, + blasint ldc, int expected_info) +{ + double alpha = 1.0; + double beta = 1.0; + + set_xerbla("DGEADD ", expected_info); + + if (api == 'F') + BLASFUNC(dgeadd)(&m, &n, &alpha, data_dgeadd.a_test, &lda, + &beta, data_dgeadd.c_test, &ldc); + else + cblas_dgeadd(order, m, n, alpha, data_dgeadd.a_test, lda, + beta, data_dgeadd.c_test, ldc); + + return check_error(); +} + +/** + * Fortran API specific test + * Test dgeadd by comparing it against reference + * with the following options: + * + * For A number of rows is 100, number of colums is 100 + * For C number of rows is 100, number of colums is 100 + */ +CTEST(dgeadd, matrix_n_100_m_100) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = N; + blasint m = M; + + blasint lda = m; + blasint ldc = m; + + double alpha = 3.0; + double beta = 3.0; + + double norm = check_dgeadd('F', order, m, n, alpha, lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dgeadd by comparing it against reference + * with the following options: + * + * For A number of rows is 100, number of colums is 100 + * For C number of rows is 100, number of colums is 100 + * Scalar alpha is zero (operation is C:=beta*C) + */ +CTEST(dgeadd, matrix_n_100_m_100_alpha_zero) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = N; + blasint m = M; + + blasint lda = m; + blasint ldc = m; + + double alpha = 0.0; + double beta = 2.5; + + double norm = check_dgeadd('F', order, m, n, alpha, lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dgeadd by comparing it against reference + * with the following options: + * + * For A number of rows is 100, number of colums is 100 + * For C number of rows is 100, number of colums is 100 + * Scalar beta is zero (operation is C:=alpha*A) + */ +CTEST(dgeadd, matrix_n_100_m_100_beta_zero) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = N; + blasint m = M; + + blasint lda = m; + blasint ldc = m; + + double alpha = 3.0; + double beta = 0.0; + + double norm = check_dgeadd('F', order, m, n, alpha, lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dgeadd by comparing it against reference + * with the following options: + * + * For A number of rows is 100, number of colums is 100 + * For C number of rows is 100, number of colums is 100 + * Scalars alpha, beta is zero (operation is C:= 0) + */ +CTEST(dgeadd, matrix_n_100_m_100_alpha_beta_zero) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = N; + blasint m = M; + + blasint lda = m; + blasint ldc = m; + + double alpha = 0.0; + double beta = 0.0; + + double norm = check_dgeadd('F', order, m, n, alpha, lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dgeadd by comparing it against reference + * with the following options: + * + * For A number of rows is 50, number of colums is 100 + * For C number of rows is 50, number of colums is 100 + */ +CTEST(dgeadd, matrix_n_100_m_50) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = N; + blasint m = M / 2; + + blasint lda = m; + blasint ldc = m; + + double alpha = 1.0; + double beta = 1.0; + + double norm = check_dgeadd('F', order, m, n, alpha, lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test error function for an invalid param n - + * number of columns of A and C + * Must be at least zero. + */ +CTEST(dgeadd, xerbla_n_invalid) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = INVALID; + blasint m = 1; + + blasint lda = m; + blasint ldc = m; + + int expected_info = 2; + + int passed = check_badargs('F', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param m - + * number of rows of A and C + * Must be at least zero. + */ +CTEST(dgeadd, xerbla_m_invalid) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = 1; + blasint m = INVALID; + + blasint lda = 1; + blasint ldc = 1; + + int expected_info = 1; + + int passed = check_badargs('F', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param lda - + * specifies the leading dimension of A. Must be at least MAX(1, m). + */ +CTEST(dgeadd, xerbla_lda_invalid) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = 1; + blasint m = 1; + + blasint lda = INVALID; + blasint ldc = 1; + + int expected_info = 6; + + int passed = check_badargs('F', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param ldc - + * specifies the leading dimension of C. Must be at least MAX(1, m). + */ +CTEST(dgeadd, xerbla_ldc_invalid) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = 1; + blasint m = 1; + + blasint lda = 1; + blasint ldc = INVALID; + + int expected_info = 8; + + int passed = check_badargs('F', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Check if n - number of columns of A, C equal zero. + */ +CTEST(dgeadd, n_zero) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = 0; + blasint m = 1; + + blasint lda = 1; + blasint ldc = 1; + + double alpha = 1.0; + double beta = 1.0; + + double norm = check_dgeadd('F', order, m, n, alpha, lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Check if m - number of rows of A and C equal zero. + */ +CTEST(dgeadd, m_zero) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = 1; + blasint m = 0; + + blasint lda = 1; + blasint ldc = 1; + + double alpha = 1.0; + double beta = 1.0; + + double norm = check_dgeadd('F', order, m, n, alpha, lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dgeadd by comparing it against reference + * with the following options: + * + * c api option order is column-major order + * + * For A number of rows is 100, number of colums is 100 + * For C number of rows is 100, number of colums is 100 + */ +CTEST(dgeadd, c_api_matrix_n_100_m_100) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = N; + blasint m = M; + + blasint lda = m; + blasint ldc = m; + + double alpha = 2.0; + double beta = 3.0; + + double norm = check_dgeadd('C', order, m, n, alpha, + lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dgeadd by comparing it against reference + * with the following options: + * + * c api option order is row-major order + * For A number of rows is 100, number of colums is 100 + * For C number of rows is 100, number of colums is 100 + */ +CTEST(dgeadd, c_api_matrix_n_100_m_100_row_major) +{ + CBLAS_ORDER order = CblasRowMajor; + + blasint n = N; + blasint m = M; + + blasint lda = m; + blasint ldc = m; + + double alpha = 4.0; + double beta = 2.0; + + double norm = check_dgeadd('C', order, m, n, alpha, + lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dgeadd by comparing it against reference + * with the following options: + * + * c api option order is row-major order + * For A number of rows is 50, number of colums is 100 + * For C number of rows is 50, number of colums is 100 + */ +CTEST(dgeadd, c_api_matrix_n_50_m_100_row_major) +{ + CBLAS_ORDER order = CblasRowMajor; + + blasint n = N / 2; + blasint m = M; + + blasint lda = n; + blasint ldc = n; + + double alpha = 3.0; + double beta = 1.0; + + double norm = check_dgeadd('C', order, m, n, alpha, + lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dgeadd by comparing it against reference + * with the following options: + * + * c api option order is column-major order + * For A number of rows is 100, number of colums is 100 + * For C number of rows is 100, number of colums is 100 + * Scalar alpha is zero (operation is C:=beta*C) + */ +CTEST(dgeadd, c_api_matrix_n_100_m_100_alpha_zero) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = N; + blasint m = M; + + blasint lda = m; + blasint ldc = m; + + double alpha = 0.0; + double beta = 1.0; + + double norm = check_dgeadd('C', order, m, n, alpha, + lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dgeadd by comparing it against reference + * with the following options: + * + * c api option order is column-major order + * For A number of rows is 100, number of colums is 100 + * For C number of rows is 100, number of colums is 100 + * Scalar beta is zero (operation is C:=alpha*A) + */ +CTEST(dgeadd, c_api_matrix_n_100_m_100_beta_zero) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = N; + blasint m = M; + + blasint lda = m; + blasint ldc = m; + + double alpha = 3.0; + double beta = 0.0; + + double norm = check_dgeadd('C', order, m, n, alpha, + lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dgeadd by comparing it against reference + * with the following options: + * + * c api option order is column-major order + * For A number of rows is 100, number of colums is 100 + * For C number of rows is 100, number of colums is 100 + * Scalars alpha, beta is zero (operation is C:= 0) + */ +CTEST(dgeadd, c_api_matrix_n_100_m_100_alpha_beta_zero) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = N; + blasint m = M; + + blasint lda = m; + blasint ldc = m; + + double alpha = 0.0; + double beta = 0.0; + + double norm = check_dgeadd('C', order, m, n, alpha, + lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dgeadd by comparing it against reference + * with the following options: + * + * For A number of rows is 50, number of colums is 100 + * For C number of rows is 50, number of colums is 100 + */ +CTEST(dgeadd, c_api_matrix_n_100_m_50) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = N; + blasint m = M / 2; + + blasint lda = m; + blasint ldc = m; + + double alpha = 3.0; + double beta = 4.0; + + double norm = check_dgeadd('C', order, m, n, alpha, + lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test error function for an invalid param order - + * specifies whether A and C stored in + * row-major order or column-major order + */ +CTEST(dgeadd, c_api_xerbla_invalid_order) +{ + CBLAS_ORDER order = INVALID; + + blasint n = 1; + blasint m = 1; + + blasint lda = 1; + blasint ldc = 1; + + int expected_info = 0; + + int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param n - + * number of columns of A and C. + * Must be at least zero. + * + * c api option order is column-major order + */ +CTEST(dgeadd, c_api_xerbla_n_invalid) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = INVALID; + blasint m = 1; + + blasint lda = 1; + blasint ldc = 1; + + int expected_info = 2; + + int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param n - + * number of columns of A and C. + * Must be at least zero. + * + * c api option order is row-major order + */ +CTEST(dgeadd, c_api_xerbla_n_invalid_row_major) +{ + CBLAS_ORDER order = CblasRowMajor; + + blasint n = INVALID; + blasint m = 1; + + blasint lda = 1; + blasint ldc = 1; + + int expected_info = 1; + + int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param m - + * number of rows of A and C + * Must be at least zero. + * + * c api option order is column-major order + */ +CTEST(dgeadd, c_api_xerbla_m_invalid) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = 1; + blasint m = INVALID; + + blasint lda = 1; + blasint ldc = 1; + + int expected_info = 1; + + int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param m - + * number of rows of A and C + * Must be at least zero. + * + * c api option order is row-major order + */ +CTEST(dgeadd, c_api_xerbla_m_invalid_row_major) +{ + CBLAS_ORDER order = CblasRowMajor; + + blasint n = 1; + blasint m = INVALID; + + blasint lda = 1; + blasint ldc = 1; + + int expected_info = 2; + + int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param lda - + * specifies the leading dimension of A. Must be at least MAX(1, m). + * + * c api option order is column-major order + */ +CTEST(dgeadd, c_api_xerbla_lda_invalid) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = 1; + blasint m = 1; + + blasint lda = INVALID; + blasint ldc = 1; + + int expected_info = 5; + + int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param lda - + * specifies the leading dimension of A. Must be at least MAX(1, m). + * + * c api option order is row-major order + */ +CTEST(dgeadd, c_api_xerbla_lda_invalid_row_major) +{ + CBLAS_ORDER order = CblasRowMajor; + + blasint n = 1; + blasint m = 1; + + blasint lda = INVALID; + blasint ldc = 1; + + int expected_info = 5; + + int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param ldc - + * specifies the leading dimension of C. Must be at least MAX(1, m). + * + * c api option order is column-major order + */ +CTEST(dgeadd, c_api_xerbla_ldc_invalid) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = 1; + blasint m = 1; + + blasint lda = 1; + blasint ldc = INVALID; + + int expected_info = 8; + + int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param ldc - + * specifies the leading dimension of C. Must be at least MAX(1, m). + * + * c api option order is row-major order + */ +CTEST(dgeadd, c_api_xerbla_ldc_invalid_row_major) +{ + CBLAS_ORDER order = CblasRowMajor; + + blasint n = 1; + blasint m = 1; + + blasint lda = 1; + blasint ldc = INVALID; + + int expected_info = 8; + + int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Check if n - number of columns of A, C equal zero. + * + * c api option order is column-major order + */ +CTEST(dgeadd, c_api_n_zero) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = 0; + blasint m = 1; + + blasint lda = 1; + blasint ldc = 1; + + double alpha = 1.0; + double beta = 1.0; + + double norm = check_dgeadd('C', order, m, n, alpha, + lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Check if m - number of rows of A and C equal zero. + * + * c api option order is column-major order + */ +CTEST(dgeadd, c_api_m_zero) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = 1; + blasint m = 0; + + blasint lda = 1; + blasint ldc = 1; + + double alpha = 1.0; + double beta = 1.0; + + double norm = check_dgeadd('C', order, m, n, alpha, + lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_dgemmt.c b/utest/test_extensions/test_dgemmt.c new file mode 100644 index 000000000..22dcaf2aa --- /dev/null +++ b/utest/test_extensions/test_dgemmt.c @@ -0,0 +1,1442 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. 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. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include "common.h" + +#define DATASIZE 100 + +struct DATA_DGEMMT { + double a_test[DATASIZE * DATASIZE]; + double b_test[DATASIZE * DATASIZE]; + double c_test[DATASIZE * DATASIZE]; + double c_verify[DATASIZE * DATASIZE]; + double c_gemm[DATASIZE * DATASIZE]; +}; + +#ifdef BUILD_DOUBLE +static struct DATA_DGEMMT data_dgemmt; + +/** + * Compute gemmt via gemm since gemmt is gemm but updates only + * the upper or lower triangular part of the result matrix + * + * param api specifies tested api (C or Fortran) + * param order specifies row or column major order (for Fortran API column major always) + * param uplo specifies whether C’s data is stored in its upper or lower triangle + * param transa specifies op(A), the transposition operation applied to A + * param transb specifies op(B), the transposition operation applied to B + * param m - number of rows of op(A), columns of op(B), and columns and rows of C + * param k - number of columns of op(A) and rows of op(B) + * param alpha - scaling factor for the matrix-matrix product + * param lda - leading dimension of A + * param ldb - leading dimension of B + * param beta - scaling factor for matrix C + * param ldc - leading dimension of C + */ +static void dgemmt_trusted(char api, enum CBLAS_ORDER order, char uplo, char transa, + char transb, blasint m, blasint k, double alpha, blasint lda, + blasint ldb, double beta, blasint ldc) +{ + blasint i, j; + + if(api == 'F') + BLASFUNC(dgemm)(&transa, &transb, &m, &m, &k, &alpha, data_dgemmt.a_test, &lda, + data_dgemmt.b_test, &ldb, &beta, data_dgemmt.c_gemm, &ldc); + else + cblas_dgemm(order, transa, transb, m, m, k, alpha, data_dgemmt.a_test, lda, + data_dgemmt.b_test, ldb, beta, data_dgemmt.c_gemm, ldc); + + if (uplo == 'L' || uplo == CblasLower) + { + for (i = 0; i < m; i++) + for (j = i; j < m; j++) + data_dgemmt.c_verify[i * ldc + j] = + data_dgemmt.c_gemm[i * ldc + j]; + } else { + for (i = 0; i < m; i++) + for (j = 0; j <= i; j++) + data_dgemmt.c_verify[i * ldc + j] = + data_dgemmt.c_gemm[i * ldc + j]; + } +} + +/** + * Comapare results computed by dgemmt and dgemmt_trusted + * + * param api specifies tested api (C or Fortran) + * param order specifies row or column major order (for Fortran API column major always) + * param uplo specifies whether C’s data is stored in its upper or lower triangle + * param transa specifies op(A), the transposition operation applied to A + * param transb specifies op(B), the transposition operation applied to B + * param m - number of rows of op(A), columns of op(B), and columns and rows of C + * param k - number of columns of op(A) and rows of op(B) + * param alpha - scaling factor for the matrix-matrix product + * param lda - leading dimension of A + * param ldb - leading dimension of B + * param beta - scaling factor for matrix C + * param ldc - leading dimension of C + * return norm of differences + */ +static double check_dgemmt(char api, enum CBLAS_ORDER order, char uplo, char transa, + char transb, blasint m, blasint k, double alpha, blasint lda, + blasint ldb, double beta, blasint ldc) +{ + blasint i; + blasint b_cols; + blasint a_cols; + blasint inc = 1; + blasint size_c = m * ldc; + + if(order == CblasColMajor){ + if (transa == 'T' || transa == 'C' || + transa == CblasTrans || transa == CblasConjTrans) + a_cols = m; + else a_cols = k; + + if (transb == 'T' || transb == 'C' || + transb == CblasTrans || transb == CblasConjTrans) + b_cols = k; + else b_cols = m; + } else { + if (transa == 'T' || transa == 'C' || + transa == CblasTrans || transa == CblasConjTrans) + a_cols = k; + else a_cols = m; + + if (transb == 'T' || transb == 'C' || + transb == CblasTrans || transb == CblasConjTrans) + b_cols = m; + else b_cols = k; + } + + drand_generate(data_dgemmt.a_test, a_cols * lda); + drand_generate(data_dgemmt.b_test, b_cols * ldb); + drand_generate(data_dgemmt.c_test, m * ldc); + + for (i = 0; i < m * ldc; i++) + data_dgemmt.c_gemm[i] = data_dgemmt.c_verify[i] = data_dgemmt.c_test[i]; + + dgemmt_trusted(api, order, uplo, transa, transb, m, k, alpha, lda, ldb, beta, ldc); + + if (api == 'F') + BLASFUNC(dgemmt)(&uplo, &transa, &transb, &m, &k, &alpha, data_dgemmt.a_test, + &lda, data_dgemmt.b_test, &ldb, &beta, data_dgemmt.c_test, &ldc); + else + cblas_dgemmt(order, uplo, transa, transb, m, k, alpha, data_dgemmt.a_test, lda, + data_dgemmt.b_test, ldb, beta, data_dgemmt.c_test, ldc); + + for (i = 0; i < m * ldc; i++) + data_dgemmt.c_verify[i] -= data_dgemmt.c_test[i]; + + return BLASFUNC(dnrm2)(&size_c, data_dgemmt.c_verify, &inc) / size_c; +} + +/** + * Check if error function was called with expected function name + * and param info + * + * param uplo specifies whether C’s data is stored in its upper or lower triangle + * param transa specifies op(A), the transposition operation applied to A + * param transb specifies op(B), the transposition operation applied to B + * param m - number of rows of op(A), columns of op(B), and columns and rows of C + * param k - number of columns of op(A) and rows of op(B) + * param lda - leading dimension of A + * param ldb - leading dimension of B + * param ldc - leading dimension of C + * param expected_info - expected invalid parameter number in dgemmt + * return TRUE if everything is ok, otherwise FALSE + */ +static int check_badargs(char api, enum CBLAS_ORDER order, char uplo, char transa, + char transb, blasint m, blasint k, blasint lda, blasint ldb, + blasint ldc, int expected_info) +{ + double alpha = 1.0; + double beta = 0.0; + + set_xerbla("DGEMMT ", expected_info); + + if (api == 'F') + BLASFUNC(dgemmt)(&uplo, &transa, &transb, &m, &k, &alpha, data_dgemmt.a_test, + &lda, data_dgemmt.b_test, &ldb, &beta, data_dgemmt.c_test, &ldc); + else + cblas_dgemmt(order, uplo, transa, transb, m, k, alpha, data_dgemmt.a_test, lda, + data_dgemmt.b_test, ldb, beta, data_dgemmt.c_test, ldc); + + return check_error(); +} + +/** + * Fortran API specific test + * Test dgemmt by comparing it against dgemm + * with the following options: + * + * C’s data is stored in its upper triangle part + * A not transposed + * B not transposed + */ +CTEST(dgemmt, upper_M_50_K_50_a_notrans_b_notrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'N'; + char uplo = 'U'; + double alpha = 1.5; + double beta = 2.0; + + double norm = check_dgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dgemmt by comparing it against dgemm + * with the following options: + * + * C’s data is stored in its upper triangle part + * A transposed + * B not transposed + */ +CTEST(dgemmt, upper_M_100_K_50_a_trans_b_notrans) +{ + blasint M = 100, K = 50; + blasint lda = 50, ldb = 50, ldc = 100; + char transa = 'T', transb = 'N'; + char uplo = 'U'; + double alpha = 1.0; + double beta = 2.0; + + double norm = check_dgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dgemmt by comparing it against dgemm + * with the following options: + * + * C’s data is stored in its upper triangle part + * A not transposed + * B transposed + */ +CTEST(dgemmt, upper_M_50_K_100_a_notrans_b_trans) +{ + blasint M = 50, K = 100; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'T'; + char uplo = 'U'; + double alpha = 1.0; + double beta = 0.0; + + double norm = check_dgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dgemmt by comparing it against dgemm + * with the following options: + * + * C’s data is stored in its upper triangle part + * A transposed + * B transposed + */ +CTEST(dgemmt, upper_M_50_K_50_a_trans_b_trans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'T', transb = 'T'; + char uplo = 'U'; + double alpha = 1.5; + double beta = 2.0; + + double norm = check_dgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dgemmt by comparing it against dgemm + * with the following options: + * + * C’s data is stored in its upper triangle part + * alpha = 0.0 + */ +CTEST(dgemmt, upper_alpha_zero) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'N'; + char uplo = 'U'; + double alpha = 0.0; + double beta = 2.0; + + double norm = check_dgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dgemmt by comparing it against dgemm + * with the following options: + * + * C’s data is stored in its upper triangle part + * beta = 1.0 + */ +CTEST(dgemmt, upper_beta_one) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'N'; + char uplo = 'U'; + double alpha = 2.0; + double beta = 1.0; + + double norm = check_dgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dgemmt by comparing it against dgemm + * with the following options: + * + * C’s data is stored in its lower triangle part + * A not transposed + * B not transposed + */ +CTEST(dgemmt, lower_M_50_K_50_a_notrans_b_notrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'N'; + char uplo = 'L'; + double alpha = 1.5; + double beta = 2.0; + + double norm = check_dgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dgemmt by comparing it against dgemm + * with the following options: + * + * C’s data is stored in its lower triangle part + * A transposed + * B not transposed + */ +CTEST(dgemmt, lower_M_100_K_50_a_trans_b_notrans) +{ + blasint M = 100, K = 50; + blasint lda = 50, ldb = 50, ldc = 100; + char transa = 'T', transb = 'N'; + char uplo = 'L'; + double alpha = 1.0; + double beta = 2.0; + + double norm = check_dgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dgemmt by comparing it against dgemm + * with the following options: + * + * C’s data is stored in its lower triangle part + * A not transposed + * B transposed + */ +CTEST(dgemmt, lower_M_50_K_100_a_notrans_b_trans) +{ + blasint M = 50, K = 100; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'T'; + char uplo = 'L'; + double alpha = 1.0; + double beta = 0.0; + + double norm = check_dgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dgemmt by comparing it against dgemm + * with the following options: + * + * C’s data is stored in its lower triangle part + * A transposed + * B transposed + */ +CTEST(dgemmt, lower_M_50_K_50_a_trans_b_trans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'T', transb = 'T'; + char uplo = 'L'; + double alpha = 1.5; + double beta = 2.0; + + double norm = check_dgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dgemmt by comparing it against dgemm + * with the following options: + * + * C’s data is stored in its lower triangle part + * alpha = 0.0 + */ +CTEST(dgemmt, lower_alpha_zero) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'N'; + char uplo = 'L'; + double alpha = 0.0; + double beta = 2.0; + + double norm = check_dgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dgemmt by comparing it against dgemm + * with the following options: + * + * C’s data is stored in its lower triangle part + * beta = 1.0 + */ +CTEST(dgemmt, lower_beta_one) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'N'; + char uplo = 'L'; + double alpha = 2.0; + double beta = 1.0; + + double norm = check_dgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dgemmt by comparing it against dgemm + * with the following options: + * + * Column Major + * C’s data is stored in its upper triangle part + * A not transposed + * B not transposed + */ +CTEST(dgemmt, c_api_colmajor_upper_M_50_K_50_a_notrans_b_notrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha = 1.5; + double beta = 2.0; + + double norm = check_dgemmt('C', CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dgemmt by comparing it against dgemm + * with the following options: + * + * Column Major + * C’s data is stored in its upper triangle part + * A transposed + * B not transposed + */ +CTEST(dgemmt, c_api_colmajor_upper_M_100_K_50_a_trans_b_notrans) +{ + blasint M = 100, K = 50; + blasint lda = 50, ldb = 50, ldc = 100; + double alpha = 1.0; + double beta = 2.0; + + double norm = check_dgemmt('C', CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dgemmt by comparing it against dgemm + * with the following options: + * + * Column Major + * C’s data is stored in its upper triangle part + * A not transposed + * B transposed + */ +CTEST(dgemmt, c_api_colmajor_upper_M_50_K_100_a_notrans_b_trans) +{ + blasint M = 50, K = 100; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha = 1.0; + double beta = 0.0; + + double norm = check_dgemmt('C', CblasColMajor, CblasUpper, CblasNoTrans, CblasTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dgemmt by comparing it against dgemm + * with the following options: + * + * Column Major + * C’s data is stored in its upper triangle part + * A transposed + * B transposed + */ +CTEST(dgemmt, c_api_colmajor_upper_M_50_K_50_a_trans_b_trans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha = 1.5; + double beta = 2.0; + + double norm = check_dgemmt('C', CblasColMajor, CblasUpper, CblasTrans, CblasTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dgemmt by comparing it against dgemm + * with the following options: + * + * Column Major + * C’s data is stored in its upper triangle part + * alpha = 0.0 + */ +CTEST(dgemmt, c_api_colmajor_upper_alpha_zero) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha = 0.0; + double beta = 2.0; + + double norm = check_dgemmt('C', CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dgemmt by comparing it against dgemm + * with the following options: + * + * Column Major + * C’s data is stored in its upper triangle part + * beta = 1.0 + */ +CTEST(dgemmt, c_api_colmajor_upper_beta_one) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha = 2.0; + double beta = 1.0; + + double norm = check_dgemmt('C', CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dgemmt by comparing it against dgemm + * with the following options: + * + * Column Major + * C’s data is stored in its lower triangle part + * A not transposed + * B not transposed + */ +CTEST(dgemmt, c_api_colmajor_lower_M_50_K_50_a_notrans_b_notrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha = 1.5; + double beta = 2.0; + + double norm = check_dgemmt('C', CblasColMajor, CblasLower, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dgemmt by comparing it against dgemm + * with the following options: + * + * Column Major + * C’s data is stored in its lower triangle part + * A transposed + * B not transposed + */ +CTEST(dgemmt, c_api_colmajor_lower_M_100_K_50_a_trans_b_notrans) +{ + blasint M = 100, K = 50; + blasint lda = 50, ldb = 50, ldc = 100; + double alpha = 1.0; + double beta = 2.0; + + double norm = check_dgemmt('C', CblasColMajor, CblasLower, CblasTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dgemmt by comparing it against dgemm + * with the following options: + * + * Column Major + * C’s data is stored in its lower triangle part + * A not transposed + * B transposed + */ +CTEST(dgemmt, c_api_colmajor_lower_M_50_K_100_a_notrans_b_trans) +{ + blasint M = 50, K = 100; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha = 1.0; + double beta = 0.0; + + double norm = check_dgemmt('C', CblasColMajor, CblasLower, CblasNoTrans, CblasTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dgemmt by comparing it against dgemm + * with the following options: + * + * Column Major + * C’s data is stored in its lower triangle part + * A transposed + * B transposed + */ +CTEST(dgemmt, c_api_colmajor_lower_M_50_K_50_a_trans_b_trans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha = 1.5; + double beta = 2.0; + + double norm = check_dgemmt('C', CblasColMajor, CblasLower, CblasTrans, CblasTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dgemmt by comparing it against dgemm + * with the following options: + * + * Column Major + * C’s data is stored in its lower triangle part + * alpha = 0.0 + */ +CTEST(dgemmt, c_api_colmajor_lower_alpha_zero) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha = 0.0; + double beta = 2.0; + + double norm = check_dgemmt('C', CblasColMajor, CblasLower, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dgemmt by comparing it against dgemm + * with the following options: + * + * Column Major + * C’s data is stored in its lower triangle part + * beta = 1.0 + */ +CTEST(dgemmt, c_api_colmajor_lower_beta_one) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha = 2.0; + double beta = 1.0; + + double norm = check_dgemmt('C', CblasColMajor, CblasLower, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dgemmt by comparing it against dgemm + * with the following options: + * + * Row Major + * C’s data is stored in its upper triangle part + * A not transposed + * B not transposed + */ +CTEST(dgemmt, c_api_rowmajor_upper_M_50_K_50_a_notrans_b_notrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha = 1.5; + double beta = 2.0; + + double norm = check_dgemmt('C', CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dgemmt by comparing it against dgemm + * with the following options: + * + * Row Major + * C’s data is stored in its upper triangle part + * A transposed + * B not transposed + */ +CTEST(dgemmt, c_api_rowmajor_upper_M_100_K_50_a_trans_b_notrans) +{ + blasint M = 100, K = 50; + blasint lda = 100, ldb = 100, ldc = 100; + double alpha = 1.0; + double beta = 2.0; + + double norm = check_dgemmt('C', CblasRowMajor, CblasUpper, CblasTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dgemmt by comparing it against dgemm + * with the following options: + * + * Row Major + * C’s data is stored in its upper triangle part + * A not transposed + * B transposed + */ +CTEST(dgemmt, c_api_rowmajor_upper_M_50_K_100_a_notrans_b_trans) +{ + blasint M = 50, K = 100; + blasint lda = 100, ldb = 100, ldc = 50; + double alpha = 1.0; + double beta = 0.0; + + double norm = check_dgemmt('C', CblasRowMajor, CblasUpper, CblasNoTrans, CblasTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dgemmt by comparing it against dgemm + * with the following options: + * + * Row Major + * C’s data is stored in its upper triangle part + * A transposed + * B transposed + */ +CTEST(dgemmt, c_api_rowmajor_upper_M_50_K_50_a_trans_b_trans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha = 1.5; + double beta = 2.0; + + double norm = check_dgemmt('C', CblasRowMajor, CblasUpper, CblasTrans, CblasTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dgemmt by comparing it against dgemm + * with the following options: + * + * Row Major + * C’s data is stored in its upper triangle part + * alpha = 0.0 + */ +CTEST(dgemmt, c_api_rowmajor_upper_alpha_zero) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha = 0.0; + double beta = 2.0; + + double norm = check_dgemmt('C', CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dgemmt by comparing it against dgemm + * with the following options: + * + * Row Major + * C’s data is stored in its upper triangle part + * beta = 1.0 + */ +CTEST(dgemmt, c_api_rowmajor_upper_beta_one) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha = 2.0; + double beta = 1.0; + + double norm = check_dgemmt('C', CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dgemmt by comparing it against dgemm + * with the following options: + * + * Row Major + * C’s data is stored in its lower triangle part + * A not transposed + * B not transposed + */ +CTEST(dgemmt, c_api_rowmajor_lower_M_50_K_50_a_notrans_b_notrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha = 1.5; + double beta = 2.0; + + double norm = check_dgemmt('C', CblasRowMajor, CblasLower, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dgemmt by comparing it against dgemm + * with the following options: + * + * Row Major + * C’s data is stored in its lower triangle part + * A transposed + * B not transposed + */ +CTEST(dgemmt, c_api_rowmajor_lower_M_100_K_50_a_trans_b_notrans) +{ + blasint M = 100, K = 50; + blasint lda = 100, ldb = 100, ldc = 100; + double alpha = 1.0; + double beta = 2.0; + + double norm = check_dgemmt('C', CblasRowMajor, CblasLower, CblasTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dgemmt by comparing it against dgemm + * with the following options: + * + * Row Major + * C’s data is stored in its lower triangle part + * A not transposed + * B transposed + */ +CTEST(dgemmt, c_api_rowmajor_lower_M_50_K_100_a_notrans_b_trans) +{ + blasint M = 50, K = 100; + blasint lda = 100, ldb = 100, ldc = 50; + double alpha = 1.0; + double beta = 0.0; + + double norm = check_dgemmt('C', CblasRowMajor, CblasLower, CblasNoTrans, CblasTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dgemmt by comparing it against dgemm + * with the following options: + * + * Row Major + * C’s data is stored in its lower triangle part + * A transposed + * B transposed + */ +CTEST(dgemmt, c_api_rowmajor_lower_M_50_K_50_a_trans_b_trans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha = 1.5; + double beta = 2.0; + + double norm = check_dgemmt('C', CblasRowMajor, CblasLower, CblasTrans, CblasTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dgemmt by comparing it against dgemm + * with the following options: + * + * Row Major + * C’s data is stored in its lower triangle part + * alpha = 0.0 + */ +CTEST(dgemmt, c_api_rowmajor_lower_alpha_zero) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha = 0.0; + double beta = 2.0; + + double norm = check_dgemmt('C', CblasRowMajor, CblasLower, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dgemmt by comparing it against dgemm + * with the following options: + * + * Row Major + * C’s data is stored in its lower triangle part + * beta = 1.0 + */ +CTEST(dgemmt, c_api_rowmajor_lower_beta_one) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha = 2.0; + double beta = 1.0; + + double norm = check_dgemmt('C', CblasRowMajor, CblasLower, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test error function for an invalid param uplo. + * Must be upper (U) or lower (L). + */ +CTEST(dgemmt, xerbla_uplo_invalid) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'N'; + char uplo = 'O'; + int expected_info = 1; + + int passed = check_badargs('F', CblasColMajor, uplo, transa, transb, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param transa. + * Must be trans (T/C) or no-trans (N/R). + */ +CTEST(dgemmt, xerbla_transa_invalid) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'O', transb = 'N'; + char uplo = 'U'; + int expected_info = 2; + + int passed = check_badargs('F', CblasColMajor, uplo, transa, transb, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param transb. + * Must be trans (T/C) or no-trans (N/R). + */ +CTEST(dgemmt, xerbla_transb_invalid) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'O'; + char uplo = 'U'; + int expected_info = 3; + + int passed = check_badargs('F', CblasColMajor, uplo, transa, transb, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param M. + * Must be positive. + */ +CTEST(dgemmt, xerbla_m_invalid) +{ + blasint M = -1, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'N'; + char uplo = 'U'; + int expected_info = 4; + + int passed = check_badargs('F', CblasColMajor, uplo, transa, transb, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param K. + * Must be positive. + */ +CTEST(dgemmt, xerbla_k_invalid) +{ + blasint M = 50, K = -1; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'N'; + char uplo = 'U'; + int expected_info = 5; + + int passed = check_badargs('F', CblasColMajor, uplo, transa, transb, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param lda. + * Must be must be at least K if matrix A transposed. + */ +CTEST(dgemmt, xerbla_lda_invalid) +{ + blasint M = 50, K = 100; + blasint lda = 50, ldb = 100, ldc = 50; + char transa = 'T', transb = 'N'; + char uplo = 'U'; + int expected_info = 8; + + int passed = check_badargs('F', CblasColMajor, uplo, transa, transb, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param ldb. + * Must be must be at least K if matrix B not transposed. + */ +CTEST(dgemmt, xerbla_ldb_invalid) +{ + blasint M = 50, K = 100; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'N'; + char uplo = 'U'; + int expected_info = 10; + + int passed = check_badargs('F', CblasColMajor, uplo, transa, transb, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param ldc. + * Must be must be at least M. + */ +CTEST(dgemmt, xerbla_ldc_invalid) +{ + blasint M = 100, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'T', transb = 'N'; + char uplo = 'U'; + int expected_info = 13; + + int passed = check_badargs('F', CblasColMajor, uplo, transa, transb, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. + * Test error function for an invalid param order. + * Must be column or row major. + */ +CTEST(dgemmt, xerbla_c_api_major_invalid) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 0; + + int passed = check_badargs('C', 'O', CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Column Major + * Test error function for an invalid param uplo. + * Must be upper or lower. + */ +CTEST(dgemmt, xerbla_c_api_colmajor_uplo_invalid) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 1; + + int passed = check_badargs('C', CblasColMajor, 'O', CblasNoTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Column Major + * Test error function for an invalid param transa. + * Must be trans or no-trans. + */ +CTEST(dgemmt, xerbla_c_api_colmajor_transa_invalid) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 2; + + int passed = check_badargs('C', CblasColMajor, CblasUpper, 'O', CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Column Major + * Test error function for an invalid param transb. + * Must be trans or no-trans. + */ +CTEST(dgemmt, xerbla_c_api_colmajor_transb_invalid) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 3; + + int passed = check_badargs('C', CblasColMajor, CblasUpper, CblasNoTrans, 'O', + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Column Major + * Test error function for an invalid param M. + * Must be positive. + */ +CTEST(dgemmt, xerbla_c_api_colmajor_m_invalid) +{ + blasint M = -1, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 4; + + int passed = check_badargs('C', CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Column Major + * Test error function for an invalid param K. + * Must be positive. + */ +CTEST(dgemmt, xerbla_c_api_colmajor_k_invalid) +{ + blasint M = 50, K = -1; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 5; + + int passed = check_badargs('C', CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Column Major + * Test error function for an invalid param lda. + * Must be must be at least K if matrix A transposed. + */ +CTEST(dgemmt, xerbla_c_api_colmajor_lda_invalid) +{ + blasint M = 50, K = 100; + blasint lda = 50, ldb = 100, ldc = 50; + int expected_info = 8; + + int passed = check_badargs('C', CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Column Major + * Test error function for an invalid param ldb. + * Must be must be at least K if matrix B not transposed. + */ +CTEST(dgemmt, xerbla_c_api_colmajor_ldb_invalid) +{ + blasint M = 50, K = 100; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 10; + + int passed = check_badargs('C', CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Column Major + * Test error function for an invalid param ldc. + * Must be must be at least M. + */ +CTEST(dgemmt, xerbla_c_api_colmajor_ldc_invalid) +{ + blasint M = 100, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 13; + + int passed = check_badargs('C', CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Row Major + * Test error function for an invalid param uplo. + * Must be upper or lower. + */ +CTEST(dgemmt, xerbla_c_api_rowmajor_uplo_invalid) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 1; + + int passed = check_badargs('C', CblasRowMajor, 'O', CblasNoTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Row Major + * Test error function for an invalid param transa. + * Must be trans or no-trans. + */ +CTEST(dgemmt, xerbla_c_api_rowmajor_transa_invalid) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 2; + + int passed = check_badargs('C', CblasRowMajor, CblasUpper, 'O', CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Row Major + * Test error function for an invalid param transb. + * Must be trans or no-trans. + */ +CTEST(dgemmt, xerbla_c_api_rowmajor_transb_invalid) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 3; + + int passed = check_badargs('C', CblasRowMajor, CblasUpper, CblasNoTrans, 'O', + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Row Major + * Test error function for an invalid param M. + * Must be positive. + */ +CTEST(dgemmt, xerbla_c_api_rowmajor_m_invalid) +{ + blasint M = -1, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 4; + + int passed = check_badargs('C', CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Row Major + * Test error function for an invalid param K. + * Must be positive. + */ +CTEST(dgemmt, xerbla_c_api_rowmajor_k_invalid) +{ + blasint M = 50, K = -1; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 5; + + int passed = check_badargs('C', CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Row Major + * Test error function for an invalid param lda. + * Must be must be at least K if matrix A transposed. + */ +CTEST(dgemmt, xerbla_c_api_rowmajor_lda_invalid) +{ + blasint M = 50, K = 100; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 8; + + int passed = check_badargs('C', CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Row Major + * Test error function for an invalid param ldb. + * Must be must be at least K if matrix B transposed. + */ +CTEST(dgemmt, xerbla_c_api_rowmajor_ldb_invalid) +{ + blasint M = 50, K = 100; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 10; + + int passed = check_badargs('C', CblasRowMajor, CblasUpper, CblasTrans, CblasTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Row Major + * Test error function for an invalid param ldc. + * Must be must be at least M. + */ +CTEST(dgemmt, xerbla_c_api_rowmajor_ldc_invalid) +{ + blasint M = 100, K = 50; + blasint lda = 100, ldb = 100, ldc = 50; + int expected_info = 13; + + int passed = check_badargs('C', CblasRowMajor, CblasUpper, CblasTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_dimatcopy.c b/utest/test_extensions/test_dimatcopy.c new file mode 100644 index 000000000..4debb50e8 --- /dev/null +++ b/utest/test_extensions/test_dimatcopy.c @@ -0,0 +1,947 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. 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. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include "common.h" + +#define DATASIZE 100 + +struct DATA_DIMATCOPY { + double a_test[DATASIZE* DATASIZE]; + double a_verify[DATASIZE* DATASIZE]; +}; + +#ifdef BUILD_DOUBLE +static struct DATA_DIMATCOPY data_dimatcopy; + +/** + * Comapare results computed by dimatcopy and reference func + * + * param api specifies tested api (C or Fortran) + * param order specifies row or column major order + * param trans specifies op(A), the transposition operation + * applied to the matrix A + * param rows specifies number of rows of A + * param cols specifies number of columns of A + * param alpha specifies scaling factor for matrix A + * param lda_src - leading dimension of the matrix A + * param lda_dst - leading dimension of output matrix A + * return norm of difference between openblas and reference func + */ +static double check_dimatcopy(char api, char order, char trans, blasint rows, blasint cols, double alpha, + blasint lda_src, blasint lda_dst) +{ + blasint m, n; + blasint rows_out, cols_out; + enum CBLAS_ORDER corder; + enum CBLAS_TRANSPOSE ctrans; + + if (order == 'C') { + n = rows; m = cols; + } + else { + m = rows; n = cols; + } + + if(trans == 'T' || trans == 'C') { + rows_out = n; cols_out = m; + } + else { + rows_out = m; cols_out = n; + } + + drand_generate(data_dimatcopy.a_test, lda_src*m); + + if (trans == 'T' || trans == 'C') { + dtranspose(m, n, alpha, data_dimatcopy.a_test, lda_src, data_dimatcopy.a_verify, lda_dst); + } + else { + dcopy(m, n, alpha, data_dimatcopy.a_test, lda_src, data_dimatcopy.a_verify, lda_dst); + } + + if (api == 'F') { + BLASFUNC(dimatcopy)(&order, &trans, &rows, &cols, &alpha, data_dimatcopy.a_test, + &lda_src, &lda_dst); + } + else { + if (order == 'C') corder = CblasColMajor; + if (order == 'R') corder = CblasRowMajor; + if (trans == 'T') ctrans = CblasTrans; + if (trans == 'N') ctrans = CblasNoTrans; + if (trans == 'C') ctrans = CblasConjTrans; + if (trans == 'R') ctrans = CblasConjNoTrans; + cblas_dimatcopy(corder, ctrans, rows, cols, alpha, data_dimatcopy.a_test, + lda_src, lda_dst); + } + + // Find the differences between output matrix computed by dimatcopy and reference func + return dmatrix_difference(data_dimatcopy.a_test, data_dimatcopy.a_verify, cols_out, rows_out, lda_dst); +} + +/** + * Check if error function was called with expected function name + * and param info + * + * param order specifies row or column major order + * param trans specifies op(A), the transposition operation + * applied to the matrix A + * param rows specifies number of rows of A + * param cols specifies number of columns of A + * param lda_src - leading dimension of the matrix A + * param lda_dst - leading dimension of output matrix A + * param expected_info - expected invalid parameter number + * return TRUE if everything is ok, otherwise FALSE + */ +static int check_badargs(char order, char trans, blasint rows, blasint cols, + blasint lda_src, blasint lda_dst, int expected_info) +{ + double alpha = 1.0; + + set_xerbla("DIMATCOPY", expected_info); + + BLASFUNC(dimatcopy)(&order, &trans, &rows, &cols, &alpha, data_dimatcopy.a_test, + &lda_src, &lda_dst); + + return check_error(); +} + +/** + * Fortran API specific test + * Test dimatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Transposition + * Square matrix + * alpha = 1.0 + */ +CTEST(dimatcopy, colmajor_trans_col_100_row_100_alpha_one) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'C'; + char trans = 'T'; + double alpha = 1.0; + + double norm = check_dimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dimatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Copy only + * Square matrix + * alpha = 1.0 + */ +CTEST(dimatcopy, colmajor_notrans_col_100_row_100_alpha_one) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'C'; + char trans = 'N'; + double alpha = 1.0; + + double norm = check_dimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dimatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Transposition + * Square matrix + * alpha = 0.0 + */ +CTEST(dimatcopy, colmajor_trans_col_100_row_100_alpha_zero) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'C'; + char trans = 'T'; + double alpha = 0.0; + + double norm = check_dimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dimatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Copy only + * Square matrix + * alpha = 0.0 + */ +CTEST(dimatcopy, colmajor_notrans_col_100_row_100_alpha_zero) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'C'; + char trans = 'N'; + double alpha = 0.0; + + double norm = check_dimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dimatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Transposition + * Square matrix + * alpha = 2.0 + */ +CTEST(dimatcopy, colmajor_trans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'C'; + char trans = 'T'; + double alpha = 2.0; + + double norm = check_dimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dimatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Copy only + * Square matrix + * alpha = 2.0 + */ +CTEST(dimatcopy, colmajor_notrans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'C'; + char trans = 'N'; + double alpha = 2.0; + + double norm = check_dimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dimatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Transposition + * Rectangular matrix + * alpha = 1.0 + */ +CTEST(dimatcopy, colmajor_trans_col_50_row_100_alpha_one) +{ + blasint m = 100, n = 50; + blasint lda_src = 100, lda_dst = 50; + char order = 'C'; + char trans = 'T'; + double alpha = 1.0; + + double norm = check_dimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dimatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Copy only + * Rectangular matrix + * alpha = 1.0 + */ +CTEST(dimatcopy, colmajor_notrans_col_50_row_100_alpha_one) +{ + blasint m = 100, n = 50; + blasint lda_src = 100, lda_dst = 100; + char order = 'C'; + char trans = 'N'; + double alpha = 1.0; + + double norm = check_dimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dimatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Transposition + * Rectangular matrix + * alpha = 0.0 + */ +CTEST(dimatcopy, colmajor_trans_col_50_row_100_alpha_zero) +{ + blasint m = 100, n = 50; + blasint lda_src = 100, lda_dst = 50; + char order = 'C'; + char trans = 'T'; + double alpha = 0.0; + + double norm = check_dimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dimatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Copy only + * Rectangular matrix + * alpha = 0.0 + */ +CTEST(dimatcopy, colmajor_notrans_col_50_row_100_alpha_zero) +{ + blasint m = 100, n = 50; + blasint lda_src = 100, lda_dst = 100; + char order = 'C'; + char trans = 'N'; + double alpha = 0.0; + + double norm = check_dimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dimatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Transposition + * Rectangular matrix + * alpha = 2.0 + */ +CTEST(dimatcopy, colmajor_trans_col_50_row_100) +{ + blasint m = 100, n = 50; + blasint lda_src = 100, lda_dst = 50; + char order = 'C'; + char trans = 'T'; + double alpha = 2.0; + + double norm = check_dimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dimatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Copy only + * Rectangular matrix + * alpha = 2.0 + */ +CTEST(dimatcopy, colmajor_notrans_col_50_row_100) +{ + blasint m = 100, n = 50; + blasint lda_src = 100, lda_dst = 100; + char order = 'C'; + char trans = 'N'; + double alpha = 2.0; + + double norm = check_dimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dimatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Transposition + * Square matrix + * alpha = 1.0 + */ +CTEST(dimatcopy, rowmajor_trans_col_100_row_100_alpha_one) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'R'; + char trans = 'T'; + double alpha = 1.0; + + double norm = check_dimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dimatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Copy only + * Square matrix + * alpha = 1.0 + */ +CTEST(dimatcopy, rowmajor_notrans_col_100_row_100_alpha_one) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'R'; + char trans = 'N'; + double alpha = 1.0; + + double norm = check_dimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dimatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Transposition + * Square matrix + * alpha = 0.0 + */ +CTEST(dimatcopy, rowmajor_trans_col_100_row_100_alpha_zero) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'R'; + char trans = 'T'; + double alpha = 0.0; + + double norm = check_dimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dimatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Copy only + * Square matrix + * alpha = 0.0 + */ +CTEST(dimatcopy, rowmajor_notrans_col_100_row_100_alpha_zero) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'R'; + char trans = 'N'; + double alpha = 0.0; + + double norm = check_dimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dimatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Transposition + * Square matrix + * alpha = 2.0 + */ +CTEST(dimatcopy, rowmajor_trans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'R'; + char trans = 'T'; + double alpha = 2.0; + + double norm = check_dimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dimatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Copy only + * Square matrix + * alpha = 2.0 + */ +CTEST(dimatcopy, rowmajor_notrans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'R'; + char trans = 'N'; + double alpha = 2.0; + + double norm = check_dimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dimatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Transposition + * Rectangular matrix + * alpha = 1.0 + */ +CTEST(dimatcopy, rowmajor_trans_col_100_row_50_alpha_one) +{ + blasint m = 50, n = 100; + blasint lda_src = 100, lda_dst = 50; + char order = 'R'; + char trans = 'C'; // same as trans for real matrix + double alpha = 1.0; + + double norm = check_dimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dimatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Copy only + * Rectangular matrix + * alpha = 1.0 + */ +CTEST(dimatcopy, rowmajor_notrans_col_100_row_50_alpha_one) +{ + blasint m = 50, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'R'; + char trans = 'N'; + double alpha = 1.0; + + double norm = check_dimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dimatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Transposition + * Rectangular matrix + * alpha = 0.0 + */ +CTEST(dimatcopy, rowmajor_trans_col_100_row_50_alpha_zero) +{ + blasint m = 50, n = 100; + blasint lda_src = 100, lda_dst = 50; + char order = 'R'; + char trans = 'C'; // same as trans for real matrix + double alpha = 0.0; + + double norm = check_dimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dimatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Copy only + * Rectangular matrix + * alpha = 0.0 + */ +CTEST(dimatcopy, rowmajor_notrans_col_100_row_50_alpha_zero) +{ + blasint m = 50, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'R'; + char trans = 'N'; + double alpha = 0.0; + + double norm = check_dimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dimatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Transposition + * Rectangular matrix + * alpha = 2.0 + */ +CTEST(dimatcopy, rowmajor_trans_col_100_row_50) +{ + blasint m = 50, n = 100; + blasint lda_src = 100, lda_dst = 50; + char order = 'R'; + char trans = 'C'; // same as trans for real matrix + double alpha = 2.0; + + double norm = check_dimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dimatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Copy only + * Rectangular matrix + * alpha = 2.0 + */ +CTEST(dimatcopy, rowmajor_notrans_col_100_row_50) +{ + blasint m = 50, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'R'; + char trans = 'N'; + double alpha = 2.0; + + double norm = check_dimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dimatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Transposition + * Square matrix + * alpha = 2.0 + */ +CTEST(dimatcopy, c_api_colmajor_trans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'C'; + char trans = 'T'; + double alpha = 2.0; + + double norm = check_dimatcopy('C', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dimatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Copy only + * Square matrix + * alpha = 2.0 + */ +CTEST(dimatcopy, c_api_colmajor_notrans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'C'; + char trans = 'N'; + double alpha = 2.0; + + double norm = check_dimatcopy('C', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dimatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Transposition + * Square matrix + * alpha = 2.0 + */ +CTEST(dimatcopy, c_api_rowmajor_trans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'R'; + char trans = 'T'; + double alpha = 2.0; + + double norm = check_dimatcopy('C', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dimatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Copy only + * Square matrix + * alpha = 2.0 + */ +CTEST(dimatcopy, c_api_rowmajor_notrans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'R'; + char trans = 'N'; + double alpha = 2.0; + + double norm = check_dimatcopy('C', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Test error function for an invalid param order. + * Must be column (C) or row major (R). + */ +CTEST(dimatcopy, xerbla_invalid_order) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'O'; + char trans = 'T'; + int expected_info = 1; + + int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param trans. + * Must be trans (T/C) or no-trans (N/R). + */ +CTEST(dimatcopy, xerbla_invalid_trans) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'C'; + char trans = 'O'; + int expected_info = 2; + + int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param m. + * Must be positive. + */ +CTEST(dimatcopy, xerbla_invalid_rows) +{ + blasint m = 0, n = 100; + blasint lda_src = 0, lda_dst = 100; + char order = 'C'; + char trans = 'T'; + int expected_info = 3; + + int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param n. + * Must be positive. + */ +CTEST(dimatcopy, xerbla_invalid_cols) +{ + blasint m = 100, n = 0; + blasint lda_src = 100, lda_dst = 0; + char order = 'C'; + char trans = 'T'; + int expected_info = 4; + + int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param lda_src. + * If matrices are stored using row major layout, + * lda_src must be at least n. + */ +CTEST(dimatcopy, xerbla_rowmajor_invalid_lda) +{ + blasint m = 50, n = 100; + blasint lda_src = 50, lda_dst = 100; + char order = 'R'; + char trans = 'T'; + int expected_info = 7; + + int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param lda_src. + * If matrices are stored using column major layout, + * lda_src must be at least m. + */ +CTEST(dimatcopy, xerbla_colmajor_invalid_lda) +{ + blasint m = 100, n = 50; + blasint lda_src = 50, lda_dst = 100; + char order = 'C'; + char trans = 'T'; + int expected_info = 7; + + int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param lda_dst. + * If matrices are stored using row major layout and + * there is no transposition, lda_dst must be at least n. + */ +CTEST(dimatcopy, xerbla_rowmajor_notrans_invalid_ldb) +{ + blasint m = 50, n = 100; + blasint lda_src = 100, lda_dst = 50; + char order = 'R'; + char trans = 'N'; + int expected_info = 9; + + int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param lda_dst. + * If matrices are stored using row major layout and + * there is transposition, lda_dst must be at least m. + */ +CTEST(dimatcopy, xerbla_rowmajor_trans_invalid_ldb) +{ + blasint m = 100, n = 50; + blasint lda_src = 100, lda_dst = 50; + char order = 'R'; + char trans = 'T'; + int expected_info = 9; + + int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param lda_dst. + * If matrices are stored using column major layout and + * there is no transposition, lda_dst must be at least m. + */ +CTEST(dimatcopy, xerbla_colmajor_notrans_invalid_ldb) +{ + blasint m = 100, n = 50; + blasint lda_src = 100, lda_dst = 50; + char order = 'C'; + char trans = 'N'; + int expected_info = 9; + + int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param lda_dst. + * If matrices are stored using column major layout and + * there is transposition, lda_dst must be at least n. + */ +CTEST(dimatcopy, xerbla_colmajor_trans_invalid_ldb) +{ + blasint m = 50, n = 100; + blasint lda_src = 100, lda_dst = 50; + char order = 'C'; + char trans = 'T'; + int expected_info = 9; + + int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); + ASSERT_EQUAL(TRUE, passed); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_domatcopy.c b/utest/test_extensions/test_domatcopy.c new file mode 100644 index 000000000..f692e8784 --- /dev/null +++ b/utest/test_extensions/test_domatcopy.c @@ -0,0 +1,672 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. 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. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include "common.h" + +#define DATASIZE 100 + +struct DATA_DOMATCOPY { + double a_test[DATASIZE * DATASIZE]; + double b_test[DATASIZE * DATASIZE]; + double b_verify[DATASIZE * DATASIZE]; +}; + +#ifdef BUILD_DOUBLE +static struct DATA_DOMATCOPY data_domatcopy; + +/** + * Comapare results computed by domatcopy and reference func + * + * param api specifies tested api (C or Fortran) + * param order specifies row or column major order + * param trans specifies op(A), the transposition operation + * applied to the matrix A + * param rows - number of rows of A + * param cols - number of columns of A + * param alpha - scaling factor for matrix B + * param lda - leading dimension of the matrix A + * param ldb - leading dimension of the matrix B + * return norm of difference between openblas and reference func + */ +static double check_domatcopy(char api, char order, char trans, blasint rows, blasint cols, double alpha, + blasint lda, blasint ldb) +{ + blasint b_rows, b_cols; + blasint m, n; + enum CBLAS_ORDER corder; + enum CBLAS_TRANSPOSE ctrans; + + if (order == 'C') { + m = cols; n = rows; + } + else { + m = rows; n = cols; + } + + if(trans == 'T' || trans == 'C') { + b_rows = n; b_cols = m; + } + else { + b_rows = m; b_cols = n; + } + + drand_generate(data_domatcopy.a_test, lda*m); + + if (trans == 'T' || trans == 'C') { + dtranspose(m, n, alpha, data_domatcopy.a_test, lda, data_domatcopy.b_verify, ldb); + } + else { + dcopy(m, n, alpha, data_domatcopy.a_test, lda, data_domatcopy.b_verify, ldb); + } + + if (api == 'F') { + BLASFUNC(domatcopy)(&order, &trans, &rows, &cols, &alpha, data_domatcopy.a_test, + &lda, data_domatcopy.b_test, &ldb); + } + else { + if (order == 'C') corder = CblasColMajor; + if (order == 'R') corder = CblasRowMajor; + if (trans == 'T') ctrans = CblasTrans; + if (trans == 'N') ctrans = CblasNoTrans; + if (trans == 'C') ctrans = CblasConjTrans; + if (trans == 'R') ctrans = CblasConjNoTrans; + cblas_domatcopy(corder, ctrans, rows, cols, alpha, data_domatcopy.a_test, + lda, data_domatcopy.b_test, ldb); + } + + return dmatrix_difference(data_domatcopy.b_test, data_domatcopy.b_verify, b_cols, b_rows, ldb); +} + +/** + * Check if error function was called with expected function name + * and param info + * + * param order specifies row or column major order + * param trans specifies op(A), the transposition operation + * applied to the matrix A + * param rows - number of rows of A + * param cols - number of columns of A + * param lda - leading dimension of the matrix A + * param ldb - leading dimension of the matrix B + * param expected_info - expected invalid parameter number + * return TRUE if everything is ok, otherwise FALSE + */ +static int check_badargs(char order, char trans, blasint rows, blasint cols, + blasint lda, blasint ldb, int expected_info) +{ + double alpha = 1.0; + + set_xerbla("DOMATCOPY", expected_info); + + BLASFUNC(domatcopy)(&order, &trans, &rows, &cols, &alpha, data_domatcopy.a_test, + &lda, data_domatcopy.b_test, &ldb); + + return check_error(); +} + +/** + * Fortran API specific test + * Test domatcopy by comparing it against refernce + * with the following options: + * + * Column Major + * Transposition + * Square matrix + * alpha = 1.0 + */ +CTEST(domatcopy, colmajor_trans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda = 100, ldb = 100; + char order = 'C'; + char trans = 'T'; + double alpha = 1.0; + + double norm = check_domatcopy('F', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test domatcopy by comparing it against refernce + * with the following options: + * + * Column Major + * Copy only + * Square matrix + * alpha = 1.0 + */ +CTEST(domatcopy, colmajor_notrans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda = 100, ldb = 100; + char order = 'C'; + char trans = 'N'; + double alpha = 1.0; + + double norm = check_domatcopy('F', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test domatcopy by comparing it against refernce + * with the following options: + * + * Column Major + * Transposition + * Rectangular matrix + * alpha = 2.0 + */ +CTEST(domatcopy, colmajor_trans_col_50_row_100) +{ + blasint m = 100, n = 50; + blasint lda = 100, ldb = 50; + char order = 'C'; + char trans = 'T'; + double alpha = 2.0; + + double norm = check_domatcopy('F', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific tests + * Test domatcopy by comparing it against refernce + * with the following options: + * + * Column Major + * Copy only + * Rectangular matrix + * alpha = 2.0 + */ +CTEST(domatcopy, colmajor_notrans_col_50_row_100) +{ + blasint m = 100, n = 50; + blasint lda = 100, ldb = 100; + char order = 'C'; + char trans = 'N'; + double alpha = 2.0; + + double norm = check_domatcopy('F', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test domatcopy by comparing it against refernce + * with the following options: + * + * Column Major + * Transposition + * Rectangular matrix + * alpha = 0.0 + */ +CTEST(domatcopy, colmajor_trans_col_100_row_50) +{ + blasint m = 50, n = 100; + blasint lda = 50, ldb = 100; + char order = 'C'; + char trans = 'T'; + double alpha = 0.0; + + double norm = check_domatcopy('F', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test domatcopy by comparing it against refernce + * with the following options: + * + * Column Major + * Copy only + * Rectangular matrix + * alpha = 0.0 + */ +CTEST(domatcopy, colmajor_notrans_col_100_row_50) +{ + blasint m = 50, n = 100; + blasint lda = 50, ldb = 50; + char order = 'C'; + char trans = 'N'; + double alpha = 0.0; + + double norm = check_domatcopy('F', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test domatcopy by comparing it against refernce + * with the following options: + * + * Row Major + * Transposition + * Square matrix + * alpha = 1.0 + */ +CTEST(domatcopy, rowmajor_trans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda = 100, ldb = 100; + char order = 'R'; + char trans = 'T'; + double alpha = 1.0; + + double norm = check_domatcopy('F', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test domatcopy by comparing it against refernce + * with the following options: + * + * Row Major + * Copy only + * Square matrix + * alpha = 1.0 + */ +CTEST(domatcopy, rowmajor_notrans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda = 100, ldb = 100; + char order = 'R'; + char trans = 'N'; + double alpha = 1.0; + + double norm = check_domatcopy('F', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test domatcopy by comparing it against refernce + * with the following options: + * + * Row Major + * Transposition + * Rectangular matrix + * alpha = 2.0 + */ +CTEST(domatcopy, rowmajor_conjtrans_col_100_row_50) +{ + blasint m = 50, n = 100; + blasint lda = 100, ldb = 50; + char order = 'R'; + char trans = 'C'; // same as trans for real matrix + double alpha = 2.0; + + double norm = check_domatcopy('F', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test domatcopy by comparing it against refernce + * with the following options: + * + * Row Major + * Copy only + * Rectangular matrix + * alpha = 2.0 + */ +CTEST(domatcopy, rowmajor_notrans_col_50_row_100) +{ + blasint m = 100, n = 50; + blasint lda = 50, ldb = 50; + char order = 'R'; + char trans = 'N'; + double alpha = 2.0; + + double norm = check_domatcopy('F', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test domatcopy by comparing it against refernce + * with the following options: + * + * Row Major + * Transposition + * Matrix dimensions leave residues from 4 and 2 (specialize + * for rt case) + * alpha = 1.5 + */ +CTEST(domatcopy, rowmajor_trans_col_27_row_27) +{ + blasint m = 27, n = 27; + blasint lda = 27, ldb = 27; + char order = 'R'; + char trans = 'T'; + double alpha = 1.5; + + double norm = check_domatcopy('F', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test domatcopy by comparing it against refernce + * with the following options: + * + * Row Major + * Copy only + * Rectangular matrix + * alpha = 0.0 + */ +CTEST(domatcopy, rowmajor_notrans_col_100_row_50) +{ + blasint m = 50, n = 100; + blasint lda = 100, ldb = 100; + char order = 'R'; + char trans = 'N'; + double alpha = 0.0; + + double norm = check_domatcopy('F', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test domatcopy by comparing it against refernce + * with the following options: + * + * Column Major + * Transposition + * Square matrix + * alpha = 1.0 + */ +CTEST(domatcopy, c_api_colmajor_trans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda = 100, ldb = 100; + char order = 'C'; + char trans = 'T'; + double alpha = 1.0; + + double norm = check_domatcopy('C', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test domatcopy by comparing it against refernce + * with the following options: + * + * Column Major + * Copy only + * Square matrix + * alpha = 1.0 + */ +CTEST(domatcopy, c_api_colmajor_notrans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda = 100, ldb = 100; + char order = 'C'; + char trans = 'N'; + double alpha = 1.0; + + double norm = check_domatcopy('C', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test domatcopy by comparing it against refernce + * with the following options: + * + * Row Major + * Transposition + * Square matrix + * alpha = 1.0 + */ +CTEST(domatcopy, c_api_rowmajor_trans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda = 100, ldb = 100; + char order = 'R'; + char trans = 'T'; + double alpha = 1.0; + + double norm = check_domatcopy('C', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test domatcopy by comparing it against refernce + * with the following options: + * + * Row Major + * Copy only + * Square matrix + * alpha = 1.0 + */ +CTEST(domatcopy, c_api_rowmajor_notrans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda = 100, ldb = 100; + char order = 'R'; + char trans = 'N'; + double alpha = 1.0; + + double norm = check_domatcopy('C', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Test error function for an invalid param order. + * Must be column (C) or row major (R). + */ +CTEST(domatcopy, xerbla_invalid_order) +{ + blasint m = 100, n = 100; + blasint lda = 100, ldb = 100; + char order = 'O'; + char trans = 'T'; + int expected_info = 1; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param trans. + * Must be trans (T/C) or no-trans (N/R). + */ +CTEST(domatcopy, xerbla_invalid_trans) +{ + blasint m = 100, n = 100; + blasint lda = 100, ldb = 100; + char order = 'C'; + char trans = 'O'; + int expected_info = 2; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param m. + * Must be positive. + */ +CTEST(domatcopy, xerbla_invalid_rows) +{ + blasint m = 0, n = 100; + blasint lda = 0, ldb = 100; + char order = 'C'; + char trans = 'T'; + int expected_info = 3; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param n. + * Must be positive. + */ +CTEST(domatcopy, xerbla_invalid_cols) +{ + blasint m = 100, n = 0; + blasint lda = 100, ldb = 0; + char order = 'C'; + char trans = 'T'; + int expected_info = 4; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param lda. + * If matrices are stored using row major layout, + * lda must be at least n. + */ +CTEST(domatcopy, xerbla_rowmajor_invalid_lda) +{ + blasint m = 50, n = 100; + blasint lda = 50, ldb = 100; + char order = 'R'; + char trans = 'T'; + int expected_info = 7; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param lda. + * If matrices are stored using column major layout, + * lda must be at least m. + */ +CTEST(domatcopy, xerbla_colmajor_invalid_lda) +{ + blasint m = 100, n = 50; + blasint lda = 50, ldb = 100; + char order = 'C'; + char trans = 'T'; + int expected_info = 7; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param ldb. + * If matrices are stored using row major layout and + * there is no transposition, ldb must be at least n. + */ +CTEST(domatcopy, xerbla_rowmajor_notrans_invalid_ldb) +{ + blasint m = 50, n = 100; + blasint lda = 100, ldb = 50; + char order = 'R'; + char trans = 'N'; + int expected_info = 9; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param ldb. + * If matrices are stored using row major layout and + * there is transposition, ldb must be at least m. + */ +CTEST(domatcopy, xerbla_rowmajor_trans_invalid_ldb) +{ + blasint m = 100, n = 50; + blasint lda = 100, ldb = 50; + char order = 'R'; + char trans = 'T'; + int expected_info = 9; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param ldb. + * If matrices are stored using column major layout and + * there is no transposition, ldb must be at least m. + */ +CTEST(domatcopy, xerbla_colmajor_notrans_invalid_ldb) +{ + blasint m = 100, n = 50; + blasint lda = 100, ldb = 50; + char order = 'C'; + char trans = 'N'; + int expected_info = 9; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param ldb. + * If matrices are stored using column major layout and + * there is transposition, ldb must be at least n. + */ +CTEST(domatcopy, xerbla_colmajor_trans_invalid_ldb) +{ + blasint m = 50, n = 100; + blasint lda = 100, ldb = 50; + char order = 'C'; + char trans = 'T'; + int expected_info = 9; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} +#endif diff --git a/utest/test_extensions/test_drotmg.c b/utest/test_extensions/test_drotmg.c new file mode 100644 index 000000000..3073c8e3e --- /dev/null +++ b/utest/test_extensions/test_drotmg.c @@ -0,0 +1,414 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. 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. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include + +#ifdef BUILD_DOUBLE + +/** + * Fortran API specific test + * Test drotmg by comparing it against pre-calculated values + */ +CTEST(drotmg, y1_zero) +{ + double te_d1, tr_d1; + double te_d2, tr_d2; + double te_x1, tr_x1; + double te_y1, tr_y1; + double te_param[5]; + double tr_param[5]; + int i = 0; + te_d1 = tr_d1 = 2.0; + te_d2 = tr_d2 = 2.0; + te_x1 = tr_x1 = 8.0; + te_y1 = tr_y1 = 0.0; + + for(i=0; i<5; i++){ + te_param[i] = tr_param[i] = 0.0; + } + + //reference values as calculated by netlib blas + tr_d1 = 2.0; + tr_d2 = 2.0; + tr_x1 = 8.0; + tr_y1 = 0.0; + + tr_param[0] = -2.0; + tr_param[1] = 0.0; + tr_param[2] = 0.0; + tr_param[3] = 0.0; + tr_param[4] = 0.0; + + //OpenBLAS + BLASFUNC(drotmg)(&te_d1, &te_d2, &te_x1, &te_y1, te_param); + + ASSERT_DBL_NEAR_TOL(tr_d1, te_d1, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_d2, te_d2, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_x1, te_x1, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_y1, te_y1, DOUBLE_EPS); + + for(i=0; i<5; i++){ + ASSERT_DBL_NEAR_TOL(tr_param[i], te_param[i], DOUBLE_EPS); + } +} + +/** + * Fortran API specific test + * Test drotmg by comparing it against pre-calculated values + */ +CTEST(drotmg, d1_negative) +{ + double te_d1, tr_d1; + double te_d2, tr_d2; + double te_x1, tr_x1; + double te_y1, tr_y1; + double te_param[5]; + double tr_param[5]; + int i = 0; + te_d1 = tr_d1 = -1.0; + te_d2 = tr_d2 = 2.0; + te_x1 = tr_x1 = 8.0; + te_y1 = tr_y1 = 8.0; + + for(i=0; i<5; i++){ + te_param[i] = tr_param[i] = 0.0; + } + + //reference values as calculated by netlib blas + tr_d1 = 0.0; + tr_d2 = 0.0; + tr_x1 = 0.0; + tr_y1 = 8.0; + + tr_param[0] = -1.0; + tr_param[1] = 0.0; + tr_param[2] = 0.0; + tr_param[3] = 0.0; + tr_param[4] = 0.0; + + //OpenBLAS + BLASFUNC(drotmg)(&te_d1, &te_d2, &te_x1, &te_y1, te_param); + + ASSERT_DBL_NEAR_TOL(tr_d1, te_d1, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_d2, te_d2, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_x1, te_x1, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_y1, te_y1, DOUBLE_EPS); + + for(i=0; i<5; i++){ + ASSERT_DBL_NEAR_TOL(tr_param[i], te_param[i], DOUBLE_EPS); + } +} + +/** + * Fortran API specific test + * Test drotmg by comparing it against pre-calculated values + */ +CTEST(drotmg, d1_positive_d2_positive_x1_zero) +{ + double te_d1, tr_d1; + double te_d2, tr_d2; + double te_x1, tr_x1; + double te_y1, tr_y1; + double te_param[5]; + double tr_param[5]; + int i = 0; + te_d1 = tr_d1 = 2.0; + te_d2 = tr_d2 = 2.0; + te_x1 = tr_x1 = 0.0; + te_y1 = tr_y1 = 8.0; + + for(i=0; i<5; i++){ + te_param[i] = tr_param[i] = 0.0; + } + + //reference values as calculated by netlib blas + tr_d1 = 2.0; + tr_d2 = 2.0; + tr_x1 = 8.0; + tr_y1 = 8.0; + + tr_param[0] = 1.0; + tr_param[1] = 0.0; + tr_param[2] = 0.0; + tr_param[3] = 0.0; + tr_param[4] = 0.0; + + //OpenBLAS + BLASFUNC(drotmg)(&te_d1, &te_d2, &te_x1, &te_y1, te_param); + + ASSERT_DBL_NEAR_TOL(tr_d1, te_d1, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_d2, te_d2, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_x1, te_x1, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_y1, te_y1, DOUBLE_EPS); + + for(i=0; i<5; i++){ + ASSERT_DBL_NEAR_TOL(tr_param[i], te_param[i], DOUBLE_EPS); + } +} + +/** + * Fortran API specific test + * Test drotmg by comparing it against pre-calculated values + */ +CTEST(drotmg, scaled_y_greater_than_scaled_x) +{ + double te_d1, tr_d1; + double te_d2, tr_d2; + double te_x1, tr_x1; + double te_y1, tr_y1; + double te_param[5]; + double tr_param[5]; + int i = 0; + te_d1 = tr_d1 = 1.0; + te_d2 = tr_d2 = -2.0; + te_x1 = tr_x1 = 8.0; + te_y1 = tr_y1 = 8.0; + + for(i=0; i<5; i++){ + te_param[i] = tr_param[i] = 0.0; + } + + //reference values as calculated by netlib blas + tr_d1 = 0.0; + tr_d2 = 0.0; + tr_x1 = 0.0; + tr_y1 = 8.0; + + tr_param[0] = -1.0; + tr_param[1] = 0.0; + tr_param[2] = 0.0; + tr_param[3] = 0.0; + tr_param[4] = 0.0; + + //OpenBLAS + BLASFUNC(drotmg)(&te_d1, &te_d2, &te_x1, &te_y1, te_param); + + ASSERT_DBL_NEAR_TOL(tr_d1, te_d1, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_d2, te_d2, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_x1, te_x1, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_y1, te_y1, DOUBLE_EPS); + + for(i=0; i<5; i++){ + ASSERT_DBL_NEAR_TOL(tr_param[i], te_param[i], DOUBLE_EPS); + } +} + +/** + * C API specific test + * Test drotmg by comparing it against pre-calculated values + */ +CTEST(drotmg, c_api_y1_zero) +{ + double te_d1, tr_d1; + double te_d2, tr_d2; + double te_x1, tr_x1; + double te_y1, tr_y1; + double te_param[5]; + double tr_param[5]; + int i = 0; + te_d1 = tr_d1 = 2.0; + te_d2 = tr_d2 = 2.0; + te_x1 = tr_x1 = 8.0; + te_y1 = tr_y1 = 0.0; + + for(i=0; i<5; i++){ + te_param[i] = tr_param[i] = 0.0; + } + + //reference values as calculated by netlib blas + tr_d1 = 2.0; + tr_d2 = 2.0; + tr_x1 = 8.0; + tr_y1 = 0.0; + + tr_param[0] = -2.0; + tr_param[1] = 0.0; + tr_param[2] = 0.0; + tr_param[3] = 0.0; + tr_param[4] = 0.0; + + //OpenBLAS + cblas_drotmg(&te_d1, &te_d2, &te_x1, te_y1, te_param); + + ASSERT_DBL_NEAR_TOL(tr_d1, te_d1, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_d2, te_d2, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_x1, te_x1, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_y1, te_y1, DOUBLE_EPS); + + for(i=0; i<5; i++){ + ASSERT_DBL_NEAR_TOL(tr_param[i], te_param[i], DOUBLE_EPS); + } +} + +/** + * C API specific test + * Test drotmg by comparing it against pre-calculated values + */ +CTEST(drotmg, c_api_d1_negative) +{ + double te_d1, tr_d1; + double te_d2, tr_d2; + double te_x1, tr_x1; + double te_y1, tr_y1; + double te_param[5]; + double tr_param[5]; + int i = 0; + te_d1 = tr_d1 = -1.0; + te_d2 = tr_d2 = 2.0; + te_x1 = tr_x1 = 8.0; + te_y1 = tr_y1 = 8.0; + + for(i=0; i<5; i++){ + te_param[i] = tr_param[i] = 0.0; + } + + //reference values as calculated by netlib blas + tr_d1 = 0.0; + tr_d2 = 0.0; + tr_x1 = 0.0; + tr_y1 = 8.0; + + tr_param[0] = -1.0; + tr_param[1] = 0.0; + tr_param[2] = 0.0; + tr_param[3] = 0.0; + tr_param[4] = 0.0; + + //OpenBLAS + cblas_drotmg(&te_d1, &te_d2, &te_x1, te_y1, te_param); + + ASSERT_DBL_NEAR_TOL(tr_d1, te_d1, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_d2, te_d2, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_x1, te_x1, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_y1, te_y1, DOUBLE_EPS); + + for(i=0; i<5; i++){ + ASSERT_DBL_NEAR_TOL(tr_param[i], te_param[i], DOUBLE_EPS); + } +} + +/** + * C API specific test + * Test drotmg by comparing it against pre-calculated values + */ +CTEST(drotmg, c_api_d1_positive_d2_positive_x1_zero) +{ + double te_d1, tr_d1; + double te_d2, tr_d2; + double te_x1, tr_x1; + double te_y1, tr_y1; + double te_param[5]; + double tr_param[5]; + int i = 0; + te_d1 = tr_d1 = 2.0; + te_d2 = tr_d2 = 2.0; + te_x1 = tr_x1 = 0.0; + te_y1 = tr_y1 = 8.0; + + for(i=0; i<5; i++){ + te_param[i] = tr_param[i] = 0.0; + } + + //reference values as calculated by netlib blas + tr_d1 = 2.0; + tr_d2 = 2.0; + tr_x1 = 8.0; + tr_y1 = 8.0; + + tr_param[0] = 1.0; + tr_param[1] = 0.0; + tr_param[2] = 0.0; + tr_param[3] = 0.0; + tr_param[4] = 0.0; + + //OpenBLAS + cblas_drotmg(&te_d1, &te_d2, &te_x1, te_y1, te_param); + + ASSERT_DBL_NEAR_TOL(tr_d1, te_d1, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_d2, te_d2, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_x1, te_x1, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_y1, te_y1, DOUBLE_EPS); + + for(i=0; i<5; i++){ + ASSERT_DBL_NEAR_TOL(tr_param[i], te_param[i], DOUBLE_EPS); + } +} + +/** + * C API specific test + * Test drotmg by comparing it against pre-calculated values + */ +CTEST(drotmg, c_api_scaled_y_greater_than_scaled_x) +{ + double te_d1, tr_d1; + double te_d2, tr_d2; + double te_x1, tr_x1; + double te_y1, tr_y1; + double te_param[5]; + double tr_param[5]; + int i = 0; + te_d1 = tr_d1 = 1.0; + te_d2 = tr_d2 = -2.0; + te_x1 = tr_x1 = 8.0; + te_y1 = tr_y1 = 8.0; + + for(i=0; i<5; i++){ + te_param[i] = tr_param[i] = 0.0; + } + + //reference values as calculated by netlib blas + tr_d1 = 0.0; + tr_d2 = 0.0; + tr_x1 = 0.0; + tr_y1 = 8.0; + + tr_param[0] = -1.0; + tr_param[1] = 0.0; + tr_param[2] = 0.0; + tr_param[3] = 0.0; + tr_param[4] = 0.0; + + //OpenBLAS + cblas_drotmg(&te_d1, &te_d2, &te_x1, te_y1, te_param); + + ASSERT_DBL_NEAR_TOL(tr_d1, te_d1, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_d2, te_d2, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_x1, te_x1, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_y1, te_y1, DOUBLE_EPS); + + for(i=0; i<5; i++){ + ASSERT_DBL_NEAR_TOL(tr_param[i], te_param[i], DOUBLE_EPS); + } +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_dsum.c b/utest/test_extensions/test_dsum.c new file mode 100644 index 000000000..e987c5a42 --- /dev/null +++ b/utest/test_extensions/test_dsum.c @@ -0,0 +1,403 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. 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. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include + +#define ELEMENTS 50 +#define INCREMENT 2 + +#ifdef BUILD_DOUBLE + +/** + * Fortran API specific test + * Test dsum by comparing it against pre-calculated values + */ +CTEST(dsum, bad_args_N_0){ + blasint i; + blasint N = 0, inc = 1; + double x[ELEMENTS]; + for (i = 0; i < ELEMENTS * inc; i ++) { + x[i] = 1000 - i; + } + double sum = BLASFUNC(dsum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0, sum, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dsum by comparing it against pre-calculated values + */ +CTEST(dsum, step_zero){ + blasint i; + blasint N = ELEMENTS, inc = 0; + double x[ELEMENTS]; + for (i = 0; i < N * inc; i ++) { + x[i] = i + 1000; + } + x[8] = 0.0; + double sum = BLASFUNC(dsum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0, sum, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dsum by comparing it against pre-calculated values + */ +CTEST(dsum, step_1_N_1){ + blasint N = 1, inc = 1; + double x[] = {1.1}; + + double sum = BLASFUNC(dsum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.1, sum, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dsum by comparing it against pre-calculated values + */ +CTEST(dsum, step_2_N_1){ + blasint N = 1, inc = 2; + double x[] = {1.1, 0.0}; + + double sum = BLASFUNC(dsum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.1, sum, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dsum by comparing it against pre-calculated values + */ +CTEST(dsum, step_1_N_2){ + blasint N = 2, inc = 1; + double x[] = {1.1, -1.0}; + + double sum = BLASFUNC(dsum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.1, sum, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dsum by comparing it against pre-calculated values + */ +CTEST(dsum, step_2_N_2){ + blasint N = 2, inc = 2; + double x[] = {1.1, -1.5, 1.0, 1.0}; + + double sum = BLASFUNC(dsum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(2.1, sum, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dsum by comparing it against pre-calculated values + */ +CTEST(dsum, step_1_N_3){ + blasint N = 3, inc = 1; + double x[] = {1.1, 1.0, 2.2}; + + double sum = BLASFUNC(dsum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(4.3, sum, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dsum by comparing it against pre-calculated values + */ +CTEST(dsum, step_2_N_3){ + blasint N = 3, inc = 2; + double x[] = {1.1, 0.0, -1.0, -3.0, 2.2, 3.0}; + + double sum = BLASFUNC(dsum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(2.3, sum, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dsum by comparing it against pre-calculated values + */ +CTEST(dsum, step_1_N_4){ + blasint N = 4, inc = 1; + double x[] = {1.1, 1.0, -2.2, 3.3}; + + double sum = BLASFUNC(dsum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(3.2, sum, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dsum by comparing it against pre-calculated values + */ +CTEST(dsum, step_2_N_4){ + blasint N = 4, inc = 2; + double x[] = {1.1, 0.0, 1.0, 2.0, 2.2, 2.7, -3.3, -5.9}; + + double sum = BLASFUNC(dsum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.0, sum, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dsum by comparing it against pre-calculated values + */ +CTEST(dsum, step_1_N_5){ + blasint N = 5, inc = 1; + double x[] = {0.0, 1.0, 2.2, 3.3, 0.0}; + + double sum = BLASFUNC(dsum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(6.5, sum, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dsum by comparing it against pre-calculated values + */ +CTEST(dsum, step_2_N_5){ + blasint N = 5, inc = 2; + double x[] = {0.0, 3.0, 1.0, -2.2, 2.2, -1.7, 3.3, 14.5, 0.0, -9.0}; + + double sum = BLASFUNC(dsum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(6.5, sum, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dsum by comparing it against pre-calculated values + */ +CTEST(dsum, step_1_N_50){ + blasint i; + blasint N = ELEMENTS, inc = 1; + double x[ELEMENTS]; + for (i = 0; i < N * inc; i ++) { + x[i] = (i & 1) ? -1.0 : 1.0; + } + double sum = BLASFUNC(dsum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0, sum, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dsum by comparing it against pre-calculated values + */ +CTEST(dsum, step_2_N_50){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + double x[ELEMENTS * INCREMENT]; + for (i = 0; i < N * inc; i ++) { + x[i] = (i & 1) ? -1.0 : 1.0; + } + double sum = BLASFUNC(dsum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(50.0, sum, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dsum by comparing it against pre-calculated values + */ +CTEST(dsum, c_api_bad_args_N_0){ + blasint i; + blasint N = 0, inc = 1; + double x[ELEMENTS]; + for (i = 0; i < ELEMENTS * inc; i ++) { + x[i] = 1000 - i; + } + double sum = cblas_dsum(N, x, inc); + ASSERT_DBL_NEAR_TOL(0.0, sum, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dsum by comparing it against pre-calculated values + */ +CTEST(dsum, c_api_step_zero){ + blasint i; + blasint N = ELEMENTS, inc = 0; + double x[ELEMENTS]; + for (i = 0; i < N * inc; i ++) { + x[i] = i + 1000; + } + x[8] = 0.0; + double sum = cblas_dsum(N, x, inc); + ASSERT_DBL_NEAR_TOL(0.0, sum, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dsum by comparing it against pre-calculated values + */ +CTEST(dsum, c_api_step_1_N_1){ + blasint N = 1, inc = 1; + double x[] = {1.1}; + + double sum = cblas_dsum(N, x, inc); + ASSERT_DBL_NEAR_TOL(1.1, sum, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dsum by comparing it against pre-calculated values + */ +CTEST(dsum, c_api_step_2_N_1){ + blasint N = 1, inc = 2; + double x[] = {1.1, 0.0}; + + double sum = cblas_dsum(N, x, inc); + ASSERT_DBL_NEAR_TOL(1.1, sum, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dsum by comparing it against pre-calculated values + */ +CTEST(dsum, c_api_step_1_N_2){ + blasint N = 2, inc = 1; + double x[] = {1.1, -1.0}; + + double sum = cblas_dsum(N, x, inc); + ASSERT_DBL_NEAR_TOL(0.1, sum, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dsum by comparing it against pre-calculated values + */ +CTEST(dsum, c_api_step_2_N_2){ + blasint N = 2, inc = 2; + double x[] = {1.1, -1.5, 1.0, 1.0}; + + double sum = cblas_dsum(N, x, inc); + ASSERT_DBL_NEAR_TOL(2.1, sum, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dsum by comparing it against pre-calculated values + */ +CTEST(dsum, c_api_step_1_N_3){ + blasint N = 3, inc = 1; + double x[] = {1.1, 1.0, 2.2}; + + double sum = cblas_dsum(N, x, inc); + ASSERT_DBL_NEAR_TOL(4.3, sum, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dsum by comparing it against pre-calculated values + */ +CTEST(dsum, c_api_step_2_N_3){ + blasint N = 3, inc = 2; + double x[] = {1.1, 0.0, -1.0, -3.0, 2.2, 3.0}; + + double sum = cblas_dsum(N, x, inc); + ASSERT_DBL_NEAR_TOL(2.3, sum, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dsum by comparing it against pre-calculated values + */ +CTEST(dsum, c_api_step_1_N_4){ + blasint N = 4, inc = 1; + double x[] = {1.1, 1.0, -2.2, 3.3}; + + double sum = cblas_dsum(N, x, inc); + ASSERT_DBL_NEAR_TOL(3.2, sum, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dsum by comparing it against pre-calculated values + */ +CTEST(dsum, c_api_step_2_N_4){ + blasint N = 4, inc = 2; + double x[] = {1.1, 0.0, 1.0, 2.0, 2.2, 2.7, -3.3, -5.9}; + + double sum = cblas_dsum(N, x, inc); + ASSERT_DBL_NEAR_TOL(1.0, sum, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dsum by comparing it against pre-calculated values + */ +CTEST(dsum, c_api_step_1_N_5){ + blasint N = 5, inc = 1; + double x[] = {0.0, 1.0, 2.2, 3.3, 0.0}; + + double sum = cblas_dsum(N, x, inc); + ASSERT_DBL_NEAR_TOL(6.5, sum, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dsum by comparing it against pre-calculated values + */ +CTEST(dsum, c_api_step_2_N_5){ + blasint N = 5, inc = 2; + double x[] = {0.0, 3.0, 1.0, -2.2, 2.2, -1.7, 3.3, 14.5, 0.0, -9.0}; + + double sum = cblas_dsum(N, x, inc); + ASSERT_DBL_NEAR_TOL(6.5, sum, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dsum by comparing it against pre-calculated values + */ +CTEST(dsum, c_api_step_1_N_50){ + blasint i; + blasint N = ELEMENTS, inc = 1; + double x[ELEMENTS]; + for (i = 0; i < N * inc; i ++) { + x[i] = (i & 1) ? -1.0 : 1.0; + } + double sum = cblas_dsum(N, x, inc); + ASSERT_DBL_NEAR_TOL(0.0, sum, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dsum by comparing it against pre-calculated values + */ +CTEST(dsum, c_api_step_2_N_50){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + double x[ELEMENTS * INCREMENT]; + for (i = 0; i < N * inc; i ++) { + x[i] = (i & 1) ? -1.0 : 1.0; + } + double sum = cblas_dsum(N, x, inc); + ASSERT_DBL_NEAR_TOL(50.0, sum, DOUBLE_EPS); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_dzamax.c b/utest/test_extensions/test_dzamax.c new file mode 100644 index 000000000..edea3de8f --- /dev/null +++ b/utest/test_extensions/test_dzamax.c @@ -0,0 +1,294 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. 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. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include + +#define ELEMENTS 70 +#define INCREMENT 2 + +#ifdef BUILD_COMPLEX16 + +/** + * Test dzamax by comparing it against pre-calculated values + */ +CTEST(dzamax, bad_args_N_0){ + blasint i; + blasint N = 0, inc = 1; + double x[ELEMENTS * 2]; + for (i = 0; i < ELEMENTS * inc * 2; i ++) { + x[i] = 1000 - i; + } + double amax = BLASFUNC(dzamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0, amax, DOUBLE_EPS); +} + +/** + * Test dzamax by comparing it against pre-calculated values + */ +CTEST(dzamax, step_zero){ + blasint i; + blasint N = ELEMENTS * 2, inc = 0; + double x[ELEMENTS]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = i + 1000; + } + x[8] = 0.0; + double amax = BLASFUNC(dzamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0, amax, DOUBLE_EPS); +} + +/** + * Test dzamax by comparing it against pre-calculated values + */ +CTEST(dzamax, positive_step_1_N_1){ + blasint N = 1, inc = 1; + double x[] = {1.0, 2.0}; + double amax = BLASFUNC(dzamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(3.0, amax, DOUBLE_EPS); +} + +/** + * Test dzamax by comparing it against pre-calculated values + */ +CTEST(dzamax, negative_step_1_N_1){ + blasint N = 1, inc = 1; + double x[] = {-1.0, -2.0}; + double amax = BLASFUNC(dzamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(3.0, amax, DOUBLE_EPS); +} + +/** + * Test dzamax by comparing it against pre-calculated values + */ +CTEST(dzamax, positive_step_2_N_1){ + blasint N = 1, inc = 2; + double x[] = {1.0, 2.0, 0.0, 0.0}; + double amax = BLASFUNC(dzamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(3.0, amax, DOUBLE_EPS); +} + +/** + * Test dzamax by comparing it against pre-calculated values + */ +CTEST(dzamax, negative_step_2_N_1){ + blasint N = 1, inc = 2; + double x[] = {-1.0, -2.0, 0.0, 0.0}; + double amax = BLASFUNC(dzamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(3.0, amax, DOUBLE_EPS); +} + +/** + * Test dzamax by comparing it against pre-calculated values + */ +CTEST(dzamax, positive_step_1_N_2){ + blasint N = 2, inc = 1; + double x[] = {1.0, 2.0, 0.0, 0.0}; + double amax = BLASFUNC(dzamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(3.0, amax, DOUBLE_EPS); +} + +/** + * Test dzamax by comparing it against pre-calculated values + */ +CTEST(dzamax, negative_step_1_N_2){ + blasint N = 2, inc = 1; + double x[] = {-1.0, -2.0, 0.0, 0.0}; + double amax = BLASFUNC(dzamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(3.0, amax, DOUBLE_EPS); +} + +/** + * Test dzamax by comparing it against pre-calculated values + */ +CTEST(dzamax, positive_step_2_N_2){ + blasint N = 2, inc = 2; + double x[] = {1.0, 2.0, 0.0, 0.0, 1.0, 1.0, 0.0, 0.0}; + double amax = BLASFUNC(dzamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(3.0, amax, DOUBLE_EPS); +} + +/** + * Test dzamax by comparing it against pre-calculated values + */ +CTEST(dzamax, negative_step_2_N_2){ + blasint N = 2, inc = 2; + double x[] = {-1.0, -2.0, 0.0, 0.0, -1.0, -1.0, 0.0, 0.0}; + double amax = BLASFUNC(dzamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(3.0, amax, DOUBLE_EPS); +} + +/** + * Test dzamax by comparing it against pre-calculated values + */ +CTEST(dzamax, positive_step_1_N_3){ + blasint N = 3, inc = 1; + double x[] = {1.0, 2.0, 0.0, 0.0, 2.0, 1.0}; + double amax = BLASFUNC(dzamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(3.0, amax, DOUBLE_EPS); +} + +/** + * Test dzamax by comparing it against pre-calculated values + */ +CTEST(dzamax, negative_step_1_N_3){ + blasint N = 3, inc = 1; + double x[] = {-1.0, -2.0, 0.0, 0.0, -3.0, -1.0}; + double amax = BLASFUNC(dzamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(4.0, amax, DOUBLE_EPS); +} + +/** + * Test dzamax by comparing it against pre-calculated values + */ +CTEST(dzamax, positive_step_2_N_3){ + blasint N = 3, inc = 2; + double x[] = {1.0, 2.0, 0.0, 0.0, 1.0, 1.0, 0.0, 0.0, 3.0, 1.0, 0.0, 0.0}; + double amax = BLASFUNC(dzamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(4.0, amax, DOUBLE_EPS); +} + +/** + * Test dzamax by comparing it against pre-calculated values + */ +CTEST(dzamax, negative_step_2_N_3){ + blasint N = 3, inc = 2; + double x[] = {-1.0, -2.0, 0.0, 0.0, -1.0, -1.0, 0.0, 0.0, -3.0, -1.0, 0.0, 0.0}; + double amax = BLASFUNC(dzamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(4.0, amax, DOUBLE_EPS); +} + +/** + * Test dzamax by comparing it against pre-calculated values + */ +CTEST(dzamax, positive_step_1_N_4){ + blasint N = 4, inc = 1; + double x[] = {1.0, 2.0, 0.0, 0.0, 2.0, 1.0, -2.0, -2.0}; + double amax = BLASFUNC(dzamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(4.0, amax, DOUBLE_EPS); +} + +/** + * Test dzamax by comparing it against pre-calculated values + */ +CTEST(dzamax, negative_step_1_N_4){ + blasint N = 4, inc = 1; + double x[] = {-1.0, -2.0, 0.0, 0.0, -2.0, -1.0, -2.0, -2.0}; + double amax = BLASFUNC(dzamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(4.0, amax, DOUBLE_EPS); +} + +/** + * Test dzamax by comparing it against pre-calculated values + */ +CTEST(dzamax, positive_step_2_N_4){ + blasint N = 4, inc = 2; + double x[] = {1.0, 2.0, 0.0, 0.0, 1.0, 1.0, 0.0, 0.0, 2.0, 1.0, 0.0, 0.0, -2.0, -2.0, 0.0, 0.0}; + double amax = BLASFUNC(dzamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(4.0, amax, DOUBLE_EPS); +} + +/** + * Test dzamax by comparing it against pre-calculated values + */ +CTEST(dzamax, negative_step_2_N_4){ + blasint N = 4, inc = 2; + double x[] = {-1.0, -2.0, 0.0, 0.0, -1.0, -1.0, 0.0, 0.0, -2.0, -1.0, 0.0, 0.0, -2.0, -2.0, 0.0, 0.0}; + double amax = BLASFUNC(dzamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(4.0, amax, DOUBLE_EPS); +} + +/** + * Test dzamax by comparing it against pre-calculated values + */ +CTEST(dzamax, positive_step_1_N_70){ + blasint i; + blasint N = ELEMENTS, inc = 1; + double x[ELEMENTS * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = i; + } + x[7 * inc * 2] = 1000.0; + x[7 * inc * 2 + 1] = 1000.0; + double amax = BLASFUNC(dzamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(2000.0, amax, DOUBLE_EPS); +} + +/** + * Test dzamax by comparing it against pre-calculated values + */ +CTEST(dzamax, negative_step_1_N_70){ + blasint i; + blasint N = ELEMENTS, inc = 1; + double x[ELEMENTS * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = -i; + } + x[7 * inc * 2] = 1000.0; + x[7 * inc * 2 + 1] = 1000.0; + double amax = BLASFUNC(dzamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(2000.0, amax, DOUBLE_EPS); +} + +/** + * Test dzamax by comparing it against pre-calculated values + */ +CTEST(dzamax, positive_step_2_N_70){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + double x[ELEMENTS * INCREMENT * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = i; + } + x[7 * inc * 2] = 1000.0; + x[7 * inc * 2 + 1] = 1000.0; + double amax = BLASFUNC(dzamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(2000.0, amax, DOUBLE_EPS); +} + +/** + * Test dzamax by comparing it against pre-calculated values + */ +CTEST(dzamax, negative_step_2_N_70){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + double x[ELEMENTS * INCREMENT * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = -i; + } + x[7 * inc * 2] = 1000.0; + x[7 * inc * 2 + 1] = 1000.0; + double amax = BLASFUNC(dzamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(2000.0, amax, DOUBLE_EPS); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_dzamin.c b/utest/test_extensions/test_dzamin.c new file mode 100644 index 000000000..916eede92 --- /dev/null +++ b/utest/test_extensions/test_dzamin.c @@ -0,0 +1,310 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. 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. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include + +#define ELEMENTS 70 +#define INCREMENT 2 + +#ifdef BUILD_COMPLEX16 + +/** + * Test dzamin by comparing it against pre-calculated values + */ +CTEST(dzamin, bad_args_N_0){ + blasint i; + blasint N = 0, inc = 1; + double x[ELEMENTS * 2]; + for (i = 0; i < ELEMENTS * inc * 2; i ++) { + x[i] = 1000 - i; + } + double amin = BLASFUNC(dzamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0, amin, DOUBLE_EPS); +} + +/** + * Test dzamin by comparing it against pre-calculated values + */ +CTEST(dzamin, step_zero){ + blasint i; + blasint N = ELEMENTS * 2, inc = 0; + double x[ELEMENTS]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = i + 1000; + } + x[8] = 0.0; + double amin = BLASFUNC(dzamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0, amin, DOUBLE_EPS); +} + +/** + * Test dzamin by comparing it against pre-calculated values + */ +CTEST(dzamin, positive_step_1_N_1){ + blasint N = 1, inc = 1; + double x[] = {1.0, 2.0}; + + double amin = BLASFUNC(dzamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(3.0, amin, DOUBLE_EPS); +} + +/** + * Test dzamin by comparing it against pre-calculated values + */ +CTEST(dzamin, negative_step_1_N_1){ + blasint N = 1, inc = 1; + double x[] = {-1.0, -2.0}; + + double amin = BLASFUNC(dzamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(3.0, amin, DOUBLE_EPS); +} + +/** + * Test dzamin by comparing it against pre-calculated values + */ +CTEST(dzamin, positive_step_2_N_1){ + blasint N = 1, inc = 2; + double x[] = {1.0, 2.0, 0.0, 0.0}; + + double amin = BLASFUNC(dzamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(3.0, amin, DOUBLE_EPS); +} + +/** + * Test dzamin by comparing it against pre-calculated values + */ +CTEST(dzamin, negative_step_2_N_1){ + blasint N = 1, inc = 2; + double x[] = {-1.0, -2.0, 0.0, 0.0}; + + double amin = BLASFUNC(dzamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(3.0, amin, DOUBLE_EPS); +} + +/** + * Test dzamin by comparing it against pre-calculated values + */ +CTEST(dzamin, positive_step_1_N_2){ + blasint N = 2, inc = 1; + double x[] = {1.0, 2.0, 0.0, 0.0}; + + double amin = BLASFUNC(dzamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0, amin, DOUBLE_EPS); +} + +/** + * Test dzamin by comparing it against pre-calculated values + */ +CTEST(dzamin, negative_step_1_N_2){ + blasint N = 2, inc = 1; + double x[] = {-1.0, -2.0, 0.0, 0.0}; + + double amin = BLASFUNC(dzamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0, amin, DOUBLE_EPS); +} + +/** + * Test dzamin by comparing it against pre-calculated values + */ +CTEST(dzamin, positive_step_2_N_2){ + blasint N = 2, inc = 2; + double x[] = {1.0, 2.0, 0.0, 0.0, 1.0, 1.0, 0.0, 0.0}; + + double amin = BLASFUNC(dzamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(2.0, amin, DOUBLE_EPS); +} + +/** + * Test dzamin by comparing it against pre-calculated values + */ +CTEST(dzamin, negative_step_2_N_2){ + blasint N = 2, inc = 2; + double x[] = {-1.0, -2.0, 0.0, 0.0, -1.0, -1.0, 0.0, 0.0}; + + double amin = BLASFUNC(dzamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(2.0, amin, DOUBLE_EPS); +} + +/** + * Test dzamin by comparing it against pre-calculated values + */ +CTEST(dzamin, positive_step_1_N_3){ + blasint N = 3, inc = 1; + double x[] = {1.0, 2.0, 0.0, 0.0, 2.0, 1.0}; + + double amin = BLASFUNC(dzamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0, amin, DOUBLE_EPS); +} + +/** + * Test dzamin by comparing it against pre-calculated values + */ +CTEST(dzamin, negative_step_1_N_3){ + blasint N = 3, inc = 1; + double x[] = {-1.0, -2.0, 0.0, 0.0, -2.0, -1.0}; + + double amin = BLASFUNC(dzamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0, amin, DOUBLE_EPS); +} + +/** + * Test dzamin by comparing it against pre-calculated values + */ +CTEST(dzamin, positive_step_2_N_3){ + blasint N = 3, inc = 2; + double x[] = {1.0, 2.0, 0.0, 0.0, 1.0, 1.0, 0.0, 0.0, 2.0, 1.0, 0.0, 0.0}; + + double amin = BLASFUNC(dzamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(2.0, amin, DOUBLE_EPS); +} + +/** + * Test dzamin by comparing it against pre-calculated values + */ +CTEST(dzamin, negative_step_2_N_3){ + blasint N = 3, inc = 2; + double x[] = {-1.0, -2.0, 0.0, 0.0, -1.0, -1.0, 0.0, 0.0, -2.0, -1.0, 0.0, 0.0}; + + double amin = BLASFUNC(dzamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(2.0, amin, DOUBLE_EPS); +} + +/** + * Test dzamin by comparing it against pre-calculated values + */ +CTEST(dzamin, positive_step_1_N_4){ + blasint N = 4, inc = 1; + double x[] = {1.0, 2.0, 0.0, 0.0, 2.0, 1.0, -2.0, -2.0}; + + double amin = BLASFUNC(dzamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0, amin, DOUBLE_EPS); +} + +/** + * Test dzamin by comparing it against pre-calculated values + */ +CTEST(dzamin, negative_step_1_N_4){ + blasint N = 4, inc = 1; + double x[] = {-1.0, -2.0, 0.0, 0.0, -2.0, -1.0, -2.0, -2.0}; + + double amin = BLASFUNC(dzamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0, amin, DOUBLE_EPS); +} + +/** + * Test dzamin by comparing it against pre-calculated values + */ +CTEST(dzamin, positive_step_2_N_4){ + blasint N = 4, inc = 2; + double x[] = {1.0, 2.0, 0.0, 0.0, 1.0, 1.0, 0.0, 0.0, 2.0, 1.0, 0.0, 0.0, -2.0, -2.0, 0.0, 0.0}; + + double amin = BLASFUNC(dzamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(2.0, amin, DOUBLE_EPS); +} + +/** + * Test dzamin by comparing it against pre-calculated values + */ +CTEST(dzamin, negative_step_2_N_4){ + blasint N = 4, inc = 2; + double x[] = {-1.0, -2.0, 0.0, 0.0, -1.0, -1.0, 0.0, 0.0, -2.0, -1.0, 0.0, 0.0, -2.0, -2.0, 0.0, 0.0}; + + double amin = BLASFUNC(dzamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(2.0, amin, DOUBLE_EPS); +} + +/** + * Test dzamin by comparing it against pre-calculated values + */ +CTEST(dzamin, positive_step_1_N_70){ + blasint i; + blasint N = ELEMENTS, inc = 1; + double x[ELEMENTS * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = i + 1000; + } + x[7 * inc * 2] = 0.0; + x[7 * inc * 2 + 1] = 0.0; + double amin = BLASFUNC(dzamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0, amin, DOUBLE_EPS); +} + +/** + * Test dzamin by comparing it against pre-calculated values + */ +CTEST(dzamin, negative_step_1_N_70){ + blasint i; + blasint N = ELEMENTS, inc = 1; + double x[ELEMENTS * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = - i - 1000; + } + x[7 * inc * 2] = 0.0; + x[7 * inc * 2 + 1] = 0.0; + double amin = BLASFUNC(dzamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0, amin, DOUBLE_EPS); +} + +/** + * Test dzamin by comparing it against pre-calculated values + */ +CTEST(dzamin, positive_step_2_N_70){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + double x[ELEMENTS * INCREMENT * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = i + 1000; + } + x[7 * inc * 2] = 0.0; + x[7 * inc * 2 + 1] = 0.0; + double amin = BLASFUNC(dzamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0, amin, DOUBLE_EPS); +} + +/** + * Test dzamin by comparing it against pre-calculated values + */ +CTEST(dzamin, negative_step_2_N_70){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + double x[ELEMENTS * INCREMENT * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = - i - 1000; + } + x[7 * inc * 2] = 0.0; + x[7 * inc * 2 + 1] = 0.0; + double amin = BLASFUNC(dzamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0, amin, DOUBLE_EPS); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_dzsum.c b/utest/test_extensions/test_dzsum.c new file mode 100644 index 000000000..5139f59cb --- /dev/null +++ b/utest/test_extensions/test_dzsum.c @@ -0,0 +1,403 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. 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. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include + +#define ELEMENTS 50 +#define INCREMENT 2 + +#ifdef BUILD_COMPLEX16 + +/** + * Fortran API specific test + * Test dzsum by comparing it against pre-calculated values + */ +CTEST(dzsum, bad_args_N_0){ + blasint i; + blasint N = 0, inc = 1; + double x[ELEMENTS * 2]; + for (i = 0; i < ELEMENTS * inc * 2; i ++) { + x[i] = 1000 - i; + } + double sum = BLASFUNC(dzsum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0, sum, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dzsum by comparing it against pre-calculated values + */ +CTEST(dzsum, step_zero){ + blasint i; + blasint N = ELEMENTS, inc = 0; + double x[ELEMENTS]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = i + 1000; + } + x[8] = 0.0; + double sum = BLASFUNC(dzsum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0, sum, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dzsum by comparing it against pre-calculated values + */ +CTEST(dzsum, step_1_N_1){ + blasint N = 1, inc = 1; + double x[] = {1.1, -1.0}; + + double sum = BLASFUNC(dzsum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.1, sum, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dzsum by comparing it against pre-calculated values + */ +CTEST(dzsum, step_2_N_1){ + blasint N = 1, inc = 2; + double x[] = {1.1, 0.0, 2.3, -1.0}; + + double sum = BLASFUNC(dzsum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.1, sum, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dzsum by comparing it against pre-calculated values + */ +CTEST(dzsum, step_1_N_2){ + blasint N = 2, inc = 1; + double x[] = {1.1, -1.0, 2.3, -1.0}; + + double sum = BLASFUNC(dzsum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.4, sum, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dzsum by comparing it against pre-calculated values + */ +CTEST(dzsum, step_2_N_2){ + blasint N = 2, inc = 2; + double x[] = {1.1, -1.5, 1.1, -1.0, 1.0, 1.0, 1.1, -1.0}; + + double sum = BLASFUNC(dzsum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.6, sum, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dzsum by comparing it against pre-calculated values + */ +CTEST(dzsum, step_1_N_3){ + blasint N = 3, inc = 1; + double x[] = {1.1, 1.0, 2.2, 1.1, -1.0, 0.0}; + + double sum = BLASFUNC(dzsum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(4.4, sum, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dzsum by comparing it against pre-calculated values + */ +CTEST(dzsum, step_2_N_3){ + blasint N = 3, inc = 2; + double x[] = {1.1, 0.0, -1.0, 0.0, -1.0, -3.0, -1.0, 0.0, 2.2, 3.0, -1.0, 0.0}; + + double sum = BLASFUNC(dzsum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(2.3, sum, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dzsum by comparing it against pre-calculated values + */ +CTEST(dzsum, step_1_N_4){ + blasint N = 4, inc = 1; + double x[] = {1.1, 1.0, -2.2, 3.3, 1.1, 1.0, -2.2, 3.3}; + + double sum = BLASFUNC(dzsum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(6.4, sum, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dzsum by comparing it against pre-calculated values + */ +CTEST(dzsum, step_2_N_4){ + blasint N = 4, inc = 2; + double x[] = {1.1, 0.0, 1.1, 1.0, 1.0, 2.0, 1.1, 1.0, 2.2, 2.7, 1.1, 1.0, -3.3, -5.9}; + + double sum = BLASFUNC(dzsum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(-0.2, sum, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dzsum by comparing it against pre-calculated values + */ +CTEST(dzsum, step_1_N_5){ + blasint N = 5, inc = 1; + double x[] = {0.0, 1.0, 2.2, 3.3, 0.0, 0.0, 1.0, 2.2, 3.3, 0.0}; + + double sum = BLASFUNC(dzsum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(13.0, sum, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dzsum by comparing it against pre-calculated values + */ +CTEST(dzsum, step_2_N_5){ + blasint N = 5, inc = 2; + double x[] = {0.0, 3.0, 1.0, 2.2, 1.0, -2.2, 1.0, 2.2, 2.2, -1.7, 1.0, 2.2, 3.3, 14.5, 1.0, 2.2, 0.0, -9.0, 1.0, 2.2}; + + double sum = BLASFUNC(dzsum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(11.1, sum, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dzsum by comparing it against pre-calculated values + */ +CTEST(dzsum, step_1_N_50){ + blasint i; + blasint N = ELEMENTS, inc = 1; + double x[ELEMENTS * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = (i & 1) ? -1.0 : 1.0; + } + double sum = BLASFUNC(dzsum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0, sum, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test dzsum by comparing it against pre-calculated values + */ +CTEST(dzsum, step_2_N_50){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + double x[ELEMENTS * INCREMENT * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = (i & 1) ? -1.0 : 1.0; + } + double sum = BLASFUNC(dzsum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0, sum, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dzsum by comparing it against pre-calculated values + */ +CTEST(dzsum, c_api_bad_args_N_0){ + blasint i; + blasint N = 0, inc = 1; + double x[ELEMENTS * 2]; + for (i = 0; i < ELEMENTS * inc * 2; i ++) { + x[i] = 1000 - i; + } + double sum = cblas_dzsum(N, x, inc); + ASSERT_DBL_NEAR_TOL(0.0, sum, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dzsum by comparing it against pre-calculated values + */ +CTEST(dzsum, c_api_step_zero){ + blasint i; + blasint N = ELEMENTS, inc = 0; + double x[ELEMENTS]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = i + 1000; + } + x[8] = 0.0; + double sum = cblas_dzsum(N, x, inc); + ASSERT_DBL_NEAR_TOL(0.0, sum, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dzsum by comparing it against pre-calculated values + */ +CTEST(dzsum, c_api_step_1_N_1){ + blasint N = 1, inc = 1; + double x[] = {1.1, -1.0}; + + double sum = cblas_dzsum(N, x, inc); + ASSERT_DBL_NEAR_TOL(0.1, sum, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dzsum by comparing it against pre-calculated values + */ +CTEST(dzsum, c_api_step_2_N_1){ + blasint N = 1, inc = 2; + double x[] = {1.1, 0.0, 2.3, -1.0}; + + double sum = cblas_dzsum(N, x, inc); + ASSERT_DBL_NEAR_TOL(1.1, sum, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dzsum by comparing it against pre-calculated values + */ +CTEST(dzsum, c_api_step_1_N_2){ + blasint N = 2, inc = 1; + double x[] = {1.1, -1.0, 2.3, -1.0}; + + double sum = cblas_dzsum(N, x, inc); + ASSERT_DBL_NEAR_TOL(1.4, sum, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dzsum by comparing it against pre-calculated values + */ +CTEST(dzsum, c_api_step_2_N_2){ + blasint N = 2, inc = 2; + double x[] = {1.1, -1.5, 1.1, -1.0, 1.0, 1.0, 1.1, -1.0}; + + double sum = cblas_dzsum(N, x, inc); + ASSERT_DBL_NEAR_TOL(1.6, sum, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dzsum by comparing it against pre-calculated values + */ +CTEST(dzsum, c_api_step_1_N_3){ + blasint N = 3, inc = 1; + double x[] = {1.1, 1.0, 2.2, 1.1, -1.0, 0.0}; + + double sum = cblas_dzsum(N, x, inc); + ASSERT_DBL_NEAR_TOL(4.4, sum, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dzsum by comparing it against pre-calculated values + */ +CTEST(dzsum, c_api_step_2_N_3){ + blasint N = 3, inc = 2; + double x[] = {1.1, 0.0, -1.0, 0.0, -1.0, -3.0, -1.0, 0.0, 2.2, 3.0, -1.0, 0.0}; + + double sum = cblas_dzsum(N, x, inc); + ASSERT_DBL_NEAR_TOL(2.3, sum, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dzsum by comparing it against pre-calculated values + */ +CTEST(dzsum, c_api_step_1_N_4){ + blasint N = 4, inc = 1; + double x[] = {1.1, 1.0, -2.2, 3.3, 1.1, 1.0, -2.2, 3.3}; + + double sum = cblas_dzsum(N, x, inc); + ASSERT_DBL_NEAR_TOL(6.4, sum, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dzsum by comparing it against pre-calculated values + */ +CTEST(dzsum, c_api_step_2_N_4){ + blasint N = 4, inc = 2; + double x[] = {1.1, 0.0, 1.1, 1.0, 1.0, 2.0, 1.1, 1.0, 2.2, 2.7, 1.1, 1.0, -3.3, -5.9}; + + double sum = cblas_dzsum(N, x, inc); + ASSERT_DBL_NEAR_TOL(-0.2, sum, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dzsum by comparing it against pre-calculated values + */ +CTEST(dzsum, c_api_step_1_N_5){ + blasint N = 5, inc = 1; + double x[] = {0.0, 1.0, 2.2, 3.3, 0.0, 0.0, 1.0, 2.2, 3.3, 0.0}; + + double sum = cblas_dzsum(N, x, inc); + ASSERT_DBL_NEAR_TOL(13.0, sum, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dzsum by comparing it against pre-calculated values + */ +CTEST(dzsum, c_api_step_2_N_5){ + blasint N = 5, inc = 2; + double x[] = {0.0, 3.0, 1.0, 2.2, 1.0, -2.2, 1.0, 2.2, 2.2, -1.7, 1.0, 2.2, 3.3, 14.5, 1.0, 2.2, 0.0, -9.0, 1.0, 2.2}; + + double sum = cblas_dzsum(N, x, inc); + ASSERT_DBL_NEAR_TOL(11.1, sum, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dzsum by comparing it against pre-calculated values + */ +CTEST(dzsum, c_api_step_1_N_50){ + blasint i; + blasint N = ELEMENTS, inc = 1; + double x[ELEMENTS * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = (i & 1) ? -1.0 : 1.0; + } + double sum = cblas_dzsum(N, x, inc); + ASSERT_DBL_NEAR_TOL(0.0, sum, DOUBLE_EPS); +} + +/** + * C API specific test + * Test dzsum by comparing it against pre-calculated values + */ +CTEST(dzsum, c_api_step_2_N_50){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + double x[ELEMENTS * INCREMENT * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = (i & 1) ? -1.0 : 1.0; + } + double sum = cblas_dzsum(N, x, inc); + ASSERT_DBL_NEAR_TOL(0.0, sum, DOUBLE_EPS); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_icamin.c b/utest/test_extensions/test_icamin.c new file mode 100644 index 000000000..cca464eac --- /dev/null +++ b/utest/test_extensions/test_icamin.c @@ -0,0 +1,625 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. 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. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include + +#define ELEMENTS 50 +#define INCREMENT 2 + +#ifdef BUILD_COMPLEX + +/** + * Fortran API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, bad_args_N_0){ + blasint i; + blasint N = 0, inc = 1; + float x[ELEMENTS * 2]; + for (i = 0; i < ELEMENTS * inc * 2; i ++) { + x[i] = 1000 - i; + } + blasint index = BLASFUNC(icamin)(&N, x, &inc); + ASSERT_EQUAL(0, index); +} + +/** + * Fortran API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, step_zero){ + blasint i; + blasint N = ELEMENTS, inc = 0; + float x[ELEMENTS * 2]; + for (i = 0; i < N * 2; i ++) { + x[i] = i - 1000; + } + blasint index = BLASFUNC(icamin)(&N, x, &inc); + ASSERT_EQUAL(0, index); +} + +/** + * Fortran API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, positive_step_1_N_1){ + blasint N = 1, inc = 1; + float x[] = {1.0f, 2.0f}; + blasint index = BLASFUNC(icamin)(&N, x, &inc); + ASSERT_EQUAL(1, index); +} + +/** + * Fortran API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, negative_step_1_N_1){ + blasint N = 1, inc = 1; + float x[] = {-1.0f, -2.0f}; + blasint index = BLASFUNC(icamin)(&N, x, &inc); + ASSERT_EQUAL(1, index); +} + +/** + * Fortran API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, positive_step_2_N_1){ + blasint N = 1, inc = 2; + float x[] = {1.0f, 2.0f, 0.0f, 0.0f}; + blasint index = BLASFUNC(icamin)(&N, x, &inc); + ASSERT_EQUAL(1, index); +} + +/** + * Fortran API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, negative_step_2_N_1){ + blasint N = 1, inc = 2; + float x[] = {-1.0f, -2.0f, 0.0f, 0.0f}; + blasint index = BLASFUNC(icamin)(&N, x, &inc); + ASSERT_EQUAL(1, index); +} + +/** + * Fortran API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, positive_step_1_N_2){ + blasint N = 2, inc = 1; + float x[] = {1.0f, 2.0f, 0.0f, 0.0f}; + blasint index = BLASFUNC(icamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, negative_step_1_N_2){ + blasint N = 2, inc = 1; + float x[] = {-1.0f, -2.0f, 0.0f, 0.0f}; + blasint index = BLASFUNC(icamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, positive_step_2_N_2){ + blasint N = 2, inc = 2; + float x[] = {1.0f, 2.0f, 0.0f, 0.0f, 1.0f, 1.0f, 0.0f, 0.0f}; + blasint index = BLASFUNC(icamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, negative_step_2_N_2){ + blasint N = 2, inc = 2; + float x[] = {-1.0f, -2.0f, 0.0f, 0.0f, -1.0f, -1.0f, 0.0f, 0.0f}; + blasint index = BLASFUNC(icamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, positive_step_1_N_3){ + blasint N = 3, inc = 1; + float x[] = {1.0f, 2.0f, 0.0f, 0.0f, 2.0f, 1.0f}; + blasint index = BLASFUNC(icamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, negative_step_1_N_3){ + blasint N = 3, inc = 1; + float x[] = {-1.0f, -2.0f, 0.0f, 0.0f, -2.0f, -1.0f}; + blasint index = BLASFUNC(icamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, positive_step_2_N_3){ + blasint N = 3, inc = 2; + float x[] = {1.0f, 2.0f, 0.0f, 0.0f, 1.0f, 1.0f, 0.0f, 0.0f, 2.0f, 1.0f, 0.0f, 0.0f}; + blasint index = BLASFUNC(icamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, negative_step_2_N_3){ + blasint N = 3, inc = 2; + float x[] = {-1.0f, -2.0f, 0.0f, 0.0f, -1.0f, -1.0f, 0.0f, 0.0f, -2.0f, -1.0f, 0.0f, 0.0f}; + blasint index = BLASFUNC(icamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, positive_step_1_N_4){ + blasint N = 4, inc = 1; + float x[] = {1.0f, 2.0f, 0.0f, 0.0f, 2.0f, 1.0f, -2.0f, -2.0f}; + blasint index = BLASFUNC(icamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, negative_step_1_N_4){ + blasint N = 4, inc = 1; + float x[] = {-1.0f, -2.0f, 0.0f, 0.0f, -2.0f, -1.0f, -2.0f, -2.0f}; + blasint index = BLASFUNC(icamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, positive_step_2_N_4){ + blasint N = 4, inc = 2; + float x[] = {1.0f, 2.0f, 0.0f, 0.0f, 1.0f, 1.0f, 0.0f, 0.0f, 2.0f, 1.0f, 0.0f, 0.0f, -2.0f, -2.0f, 0.0f, 0.0f}; + blasint index = BLASFUNC(icamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, negative_step_2_N_4){ + blasint N = 4, inc = 2; + float x[] = {-1.0f, -2.0f, 0.0f, 0.0f, -1.0f, -1.0f, 0.0f, 0.0f, -2.0f, -1.0f, 0.0f, 0.0f, -2.0f, -2.0f, 0.0f, 0.0f}; + blasint index = BLASFUNC(icamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, positive_step_1_N_50){ + blasint i; + blasint N = ELEMENTS, inc = 1; + float x[ELEMENTS * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = i + 1000; + } + x[7 * inc * 2] = 0.0f; + x[7 * inc * 2 + 1] = 0.0f; + blasint index = BLASFUNC(icamin)(&N, x, &inc); + ASSERT_EQUAL(8, index); +} + +/** + * Fortran API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, negative_step_1_N_50){ + blasint i; + blasint N = ELEMENTS, inc = 1; + float x[ELEMENTS * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = - i - 1000; + } + x[7 * inc * 2] = 0.0f; + x[7 * inc * 2 + 1] = 0.0f; + blasint index = BLASFUNC(icamin)(&N, x, &inc); + ASSERT_EQUAL(8, index); +} + +/** + * Fortran API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, positive_step_2_N_50){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + float x[ELEMENTS * INCREMENT * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = i + 1000; + } + x[7 * inc * 2] = 0.0f; + x[7 * inc * 2 + 1] = 0.0f; + blasint index = BLASFUNC(icamin)(&N, x, &inc); + ASSERT_EQUAL(8, index); +} + +/** + * Fortran API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, negative_step_2_N_50){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + float x[ELEMENTS * INCREMENT * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = - i - 1000; + } + x[7 * inc * 2] = 0.0f; + x[7 * inc * 2 + 1] = 0.0f; + blasint index = BLASFUNC(icamin)(&N, x, &inc); + ASSERT_EQUAL(8, index); +} + +/** + * Fortran API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, min_idx_in_vec_tail){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + float x[ELEMENTS * INCREMENT * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = i + 1000; + } + + x[(N - 1) * inc * 2] = 0.0f; + x[(N - 1) * inc * 2 + 1] = 0.0f; + blasint index = BLASFUNC(icamin)(&N, x, &inc); + ASSERT_EQUAL(N, index); +} + +/** + * C API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, c_api_bad_args_N_0){ + blasint i; + blasint N = 0, inc = 1; + float x[ELEMENTS * 2]; + for (i = 0; i < ELEMENTS * inc * 2; i ++) { + x[i] = 1000 - i; + } + blasint index = cblas_icamin(N, x, inc); + ASSERT_EQUAL(0, index); +} + +/** + * C API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, c_api_step_zero){ + blasint i; + blasint N = ELEMENTS, inc = 0; + float x[ELEMENTS * 2]; + for (i = 0; i < N * 2; i ++) { + x[i] = i - 1000; + } + blasint index = cblas_icamin(N, x, inc); + ASSERT_EQUAL(0, index); +} + +/** + * C API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, c_api_positive_step_1_N_1){ + blasint N = 1, inc = 1; + float x[] = {1.0f, 2.0f}; + blasint index = cblas_icamin(N, x, inc); + ASSERT_EQUAL(0, index); +} + +/** + * C API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, c_api_negative_step_1_N_1){ + blasint N = 1, inc = 1; + float x[] = {-1.0f, -2.0f}; + blasint index = cblas_icamin(N, x, inc); + ASSERT_EQUAL(0, index); +} + +/** + * C API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, c_api_positive_step_2_N_1){ + blasint N = 1, inc = 2; + float x[] = {1.0f, 2.0f, 0.0f, 0.0f}; + blasint index = cblas_icamin(N, x, inc); + ASSERT_EQUAL(0, index); +} + +/** + * C API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, c_api_negative_step_2_N_1){ + blasint N = 1, inc = 2; + float x[] = {-1.0f, -2.0f, 0.0f, 0.0f}; + blasint index = cblas_icamin(N, x, inc); + ASSERT_EQUAL(0, index); +} + +/** + * C API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, c_api_positive_step_1_N_2){ + blasint N = 2, inc = 1; + float x[] = {1.0f, 2.0f, 0.0f, 0.0f}; + blasint index = cblas_icamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, c_api_negative_step_1_N_2){ + blasint N = 2, inc = 1; + float x[] = {-1.0f, -2.0f, 0.0f, 0.0f}; + blasint index = cblas_icamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, c_api_positive_step_2_N_2){ + blasint N = 2, inc = 2; + float x[] = {1.0f, 2.0f, 0.0f, 0.0f, 1.0f, 1.0f, 0.0f, 0.0f}; + blasint index = cblas_icamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, c_api_negative_step_2_N_2){ + blasint N = 2, inc = 2; + float x[] = {-1.0f, -2.0f, 0.0f, 0.0f, -1.0f, -1.0f, 0.0f, 0.0f}; + blasint index = cblas_icamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, c_api_positive_step_1_N_3){ + blasint N = 3, inc = 1; + float x[] = {1.0f, 2.0f, 0.0f, 0.0f, 2.0f, 1.0f}; + blasint index = cblas_icamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, c_api_negative_step_1_N_3){ + blasint N = 3, inc = 1; + float x[] = {-1.0f, -2.0f, 0.0f, 0.0f, -2.0f, -1.0f}; + blasint index = cblas_icamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, c_api_positive_step_2_N_3){ + blasint N = 3, inc = 2; + float x[] = {1.0f, 2.0f, 0.0f, 0.0f, 1.0f, 1.0f, 0.0f, 0.0f, 2.0f, 1.0f, 0.0f, 0.0f}; + blasint index = cblas_icamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, c_api_negative_step_2_N_3){ + blasint N = 3, inc = 2; + float x[] = {-1.0f, -2.0f, 0.0f, 0.0f, -1.0f, -1.0f, 0.0f, 0.0f, -2.0f, -1.0f, 0.0f, 0.0f}; + blasint index = cblas_icamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, c_api_positive_step_1_N_4){ + blasint N = 4, inc = 1; + float x[] = {1.0f, 2.0f, 0.0f, 0.0f, 2.0f, 1.0f, -2.0f, -2.0f}; + blasint index = cblas_icamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, c_api_negative_step_1_N_4){ + blasint N = 4, inc = 1; + float x[] = {-1.0f, -2.0f, 0.0f, 0.0f, -2.0f, -1.0f, -2.0f, -2.0f}; + blasint index = cblas_icamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, c_api_positive_step_2_N_4){ + blasint N = 4, inc = 2; + float x[] = {1.0f, 2.0f, 0.0f, 0.0f, 1.0f, 1.0f, 0.0f, 0.0f, 2.0f, 1.0f, 0.0f, 0.0f, -2.0f, -2.0f, 0.0f, 0.0f}; + blasint index = cblas_icamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, c_api_negative_step_2_N_4){ + blasint N = 4, inc = 2; + float x[] = {-1.0f, -2.0f, 0.0f, 0.0f, -1.0f, -1.0f, 0.0f, 0.0f, -2.0f, -1.0f, 0.0f, 0.0f, -2.0f, -2.0f, 0.0f, 0.0f}; + blasint index = cblas_icamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, c_api_positive_step_1_N_50){ + blasint i; + blasint N = ELEMENTS, inc = 1; + float x[ELEMENTS * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = i + 1000; + } + x[7 * inc * 2] = 0.0f; + x[7 * inc * 2 + 1] = 0.0f; + blasint index = cblas_icamin(N, x, inc); + ASSERT_EQUAL(7, index); +} + +/** + * C API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, c_api_negative_step_1_N_50){ + blasint i; + blasint N = ELEMENTS, inc = 1; + float x[ELEMENTS * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = - i - 1000; + } + x[7 * inc * 2] = 0.0f; + x[7 * inc * 2 + 1] = 0.0f; + blasint index = cblas_icamin(N, x, inc); + ASSERT_EQUAL(7, index); +} + +/** + * C API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, c_api_positive_step_2_N_50){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + float x[ELEMENTS * INCREMENT * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = i + 1000; + } + x[7 * inc * 2] = 0.0f; + x[7 * inc * 2 + 1] = 0.0f; + blasint index = cblas_icamin(N, x, inc); + ASSERT_EQUAL(7, index); +} + +/** + * C API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, c_api_negative_step_2_N_50){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + float x[ELEMENTS * INCREMENT * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = - i - 1000; + } + x[7 * inc * 2] = 0.0f; + x[7 * inc * 2 + 1] = 0.0f; + blasint index = cblas_icamin(N, x, inc); + ASSERT_EQUAL(7, index); +} + +/** + * C API specific test + * Test icamin by comparing it against pre-calculated values + */ +CTEST(icamin, c_api_min_idx_in_vec_tail){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + float x[ELEMENTS * INCREMENT * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = i + 1000; + } + + x[(N - 1) * inc * 2] = 0.0f; + x[(N - 1) * inc * 2 + 1] = 0.0f; + blasint index = cblas_icamin(N, x, inc); + ASSERT_EQUAL(N - 1, index); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_idamin.c b/utest/test_extensions/test_idamin.c new file mode 100644 index 000000000..9f099f666 --- /dev/null +++ b/utest/test_extensions/test_idamin.c @@ -0,0 +1,787 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. 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. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include + +#define ELEMENTS 50 +#define INCREMENT 2 + +#ifdef BUILD_DOUBLE + +/** + * Fortran API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, bad_args_N_0){ + blasint i; + blasint N = 0, inc = 1; + double x[ELEMENTS]; + for (i = 0; i < ELEMENTS * inc; i ++) { + x[i] = 1000 - i; + } + blasint index = BLASFUNC(idamin)(&N, x, &inc); + ASSERT_EQUAL(0, index); +} + +/** + * Fortran API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, step_zero){ + blasint i; + blasint N = ELEMENTS, inc = 0; + double x[ELEMENTS]; + for (i = 0; i < N * inc; i ++) { + x[i] = i + 1000; + } + x[8] = 0.0; + blasint index = BLASFUNC(idamin)(&N, x, &inc); + ASSERT_EQUAL(0, index); +} + +/** + * Fortran API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, positive_step_1_N_1){ + blasint N = 1, inc = 1; + double x[] = {1.1}; + + blasint index = BLASFUNC(idamin)(&N, x, &inc); + ASSERT_EQUAL(1, index); +} + +/** + * Fortran API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, negative_step_1_N_1){ + blasint N = 1, inc = 1; + double x[] = {-1.1}; + + blasint index = BLASFUNC(idamin)(&N, x, &inc); + ASSERT_EQUAL(1, index); +} + +/** + * Fortran API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, positive_step_2_N_1){ + blasint N = 1, inc = 2; + double x[] = {1.1, 0.0}; + + blasint index = BLASFUNC(idamin)(&N, x, &inc); + ASSERT_EQUAL(1, index); +} + +/** + * Fortran API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, negative_step_2_N_1){ + blasint N = 1, inc = 2; + double x[] = {-1.1, 0.0}; + + blasint index = BLASFUNC(idamin)(&N, x, &inc); + ASSERT_EQUAL(1, index); +} + +/** + * Fortran API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, positive_step_1_N_2){ + blasint N = 2, inc = 1; + double x[] = {1.1, 1.0}; + + blasint index = BLASFUNC(idamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, negative_step_1_N_2){ + blasint N = 2, inc = 1; + double x[] = {-1.1, 1.0}; + + blasint index = BLASFUNC(idamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, positive_step_2_N_2){ + blasint N = 2, inc = 2; + double x[] = {1.1, 0.0, 1.0, 0.0}; + + blasint index = BLASFUNC(idamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, negative_step_2_N_2){ + blasint N = 2, inc = 2; + double x[] = {-1.1, 0.0, 1.0, 0.0}; + + blasint index = BLASFUNC(idamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, positive_step_1_N_3){ + blasint N = 3, inc = 1; + double x[] = {1.1, 1.0, 2.2}; + + blasint index = BLASFUNC(idamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, negative_step_1_N_3){ + blasint N = 3, inc = 1; + double x[] = {-1.1, 1.0, -2.2}; + + blasint index = BLASFUNC(idamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, positive_step_2_N_3){ + blasint N = 3, inc = 2; + double x[] = {1.1, 0.0, 1.0, 0.0, 2.2, 0.0}; + + blasint index = BLASFUNC(idamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, negative_step_2_N_3){ + blasint N = 3, inc = 2; + double x[] = {-1.1, 0.0, 1.0, 0.0, -2.2, 0.0}; + + blasint index = BLASFUNC(idamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, positive_step_1_N_4){ + blasint N = 4, inc = 1; + double x[] = {1.1, 1.0, 2.2, 3.3}; + + blasint index = BLASFUNC(idamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, negative_step_1_N_4){ + blasint N = 4, inc = 1; + double x[] = {-1.1, 1.0, -2.2, -3.3}; + + blasint index = BLASFUNC(idamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, positive_step_2_N_4){ + blasint N = 4, inc = 2; + double x[] = {1.1, 0.0, 1.0, 0.0, 2.2, 0.0, 3.3, 0.0}; + + blasint index = BLASFUNC(idamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, negative_step_2_N_4){ + blasint N = 4, inc = 2; + double x[] = {-1.1, 0.0, 1.0, 0.0, -2.2, 0.0, -3.3, 0.0}; + + blasint index = BLASFUNC(idamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, positive_step_1_N_5){ + blasint N = 5, inc = 1; + double x[] = {1.1, 1.0, 2.2, 3.3, 0.0}; + + blasint index = BLASFUNC(idamin)(&N, x, &inc); + ASSERT_EQUAL(5, index); +} + +/** + * Fortran API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, negative_step_1_N_5){ + blasint N = 5, inc = 1; + double x[] = {-1.1, 1.0, -2.2, -3.3, 0.0}; + + blasint index = BLASFUNC(idamin)(&N, x, &inc); + ASSERT_EQUAL(5, index); +} + +/** + * Fortran API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, positive_step_2_N_5){ + blasint N = 5, inc = 2; + double x[] = {1.1, 0.0, 1.0, 0.0, 2.2, 0.0, 3.3, 0.0, 0.0, 0.0}; + + blasint index = BLASFUNC(idamin)(&N, x, &inc); + ASSERT_EQUAL(5, index); +} + +/** + * Fortran API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, negative_step_2_N_5){ + blasint N = 5, inc = 2; + double x[] = {-1.1, 0.0, 1.0, 0.0, -2.2, 0.0, -3.3, 0.0, 0.0, 0.0}; + + blasint index = BLASFUNC(idamin)(&N, x, &inc); + ASSERT_EQUAL(5, index); +} + +/** + * Fortran API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, positive_step_1_N_50){ + blasint i; + blasint N = ELEMENTS, inc = 1; + double x[ELEMENTS]; + for (i = 0; i < N * inc; i ++) { + x[i] = i + 1000; + } + + x[8 * inc] = 0.0; + blasint index = BLASFUNC(idamin)(&N, x, &inc); + ASSERT_EQUAL(9, index); +} + +/** + * Fortran API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, negative_step_1_N_50){ + blasint i; + blasint N = ELEMENTS, inc = 1; + double x[ELEMENTS]; + for (i = 0; i < N * inc; i ++) { + x[i] = - i - 1000; + } + + x[8 * inc] = -1.0; + blasint index = BLASFUNC(idamin)(&N, x, &inc); + ASSERT_EQUAL(9, index); +} + +/** + * Fortran API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, positive_step_2_N_50){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + double x[ELEMENTS * INCREMENT]; + for (i = 0; i < N * inc; i ++) { + x[i] = i + 1000; + } + + x[8 * inc] = 0.0; + blasint index = BLASFUNC(idamin)(&N, x, &inc); + ASSERT_EQUAL(9, index); +} + +/** + * Fortran API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, negative_step_2_N_50){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + double x[ELEMENTS * INCREMENT]; + for (i = 0; i < N * inc; i ++) { + x[i] = - i - 1000; + } + + x[8 * inc] = -1.0; + blasint index = BLASFUNC(idamin)(&N, x, &inc); + ASSERT_EQUAL(9, index); +} + +/** + * Fortran API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, min_idx_in_vec_tail){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + double x[ELEMENTS * INCREMENT]; + for (i = 0; i < N * inc; i ++) { + x[i] = i + 1000; + } + + x[(N - 1) * inc] = 0.0; + blasint index = BLASFUNC(idamin)(&N, x, &inc); + ASSERT_EQUAL(N, index); +} + +/** + * Fortran API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, min_idx_in_vec_tail_inc_1){ + blasint i; + blasint N = ELEMENTS, inc = 1; + double x[ELEMENTS * inc]; + for (i = 0; i < N * inc; i ++) { + x[i] = i + 1000; + } + + x[(N - 1) * inc] = 0.0f; + blasint index = BLASFUNC(idamin)(&N, x, &inc); + ASSERT_EQUAL(N, index); +} + +/** + * C API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, c_api_bad_args_N_0){ + blasint i; + blasint N = 0, inc = 1; + double x[ELEMENTS]; + for (i = 0; i < ELEMENTS * inc; i ++) { + x[i] = 1000 - i; + } + blasint index = cblas_idamin(N, x, inc); + ASSERT_EQUAL(0, index); +} + +/** + * C API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, c_api_step_zero){ + blasint i; + blasint N = ELEMENTS, inc = 0; + double x[ELEMENTS]; + for (i = 0; i < N * inc; i ++) { + x[i] = i + 1000; + } + x[8] = 0.0; + blasint index = cblas_idamin(N, x, inc); + ASSERT_EQUAL(0, index); +} + +/** + * C API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, c_api_positive_step_1_N_1){ + blasint N = 1, inc = 1; + double x[] = {1.1}; + + blasint index = cblas_idamin(N, x, inc); + ASSERT_EQUAL(0, index); +} + +/** + * C API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, c_api_negative_step_1_N_1){ + blasint N = 1, inc = 1; + double x[] = {-1.1}; + + blasint index = cblas_idamin(N, x, inc); + ASSERT_EQUAL(0, index); +} + +/** + * C API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, c_api_positive_step_2_N_1){ + blasint N = 1, inc = 2; + double x[] = {1.1, 0.0}; + + blasint index = cblas_idamin(N, x, inc); + ASSERT_EQUAL(0, index); +} + +/** + * C API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, c_api_negative_step_2_N_1){ + blasint N = 1, inc = 2; + double x[] = {-1.1, 0.0}; + + blasint index = cblas_idamin(N, x, inc); + ASSERT_EQUAL(0, index); +} + +/** + * C API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, c_api_positive_step_1_N_2){ + blasint N = 2, inc = 1; + double x[] = {1.1, 1.0}; + + blasint index = cblas_idamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, c_api_negative_step_1_N_2){ + blasint N = 2, inc = 1; + double x[] = {-1.1, 1.0}; + + blasint index = cblas_idamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, c_api_positive_step_2_N_2){ + blasint N = 2, inc = 2; + double x[] = {1.1, 0.0, 1.0, 0.0}; + + blasint index = cblas_idamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, c_api_negative_step_2_N_2){ + blasint N = 2, inc = 2; + double x[] = {-1.1, 0.0, 1.0, 0.0}; + + blasint index = cblas_idamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, c_api_positive_step_1_N_3){ + blasint N = 3, inc = 1; + double x[] = {1.1, 1.0, 2.2}; + + blasint index = cblas_idamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, c_api_negative_step_1_N_3){ + blasint N = 3, inc = 1; + double x[] = {-1.1, 1.0, -2.2}; + + blasint index = cblas_idamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, c_api_positive_step_2_N_3){ + blasint N = 3, inc = 2; + double x[] = {1.1, 0.0, 1.0, 0.0, 2.2, 0.0}; + + blasint index = cblas_idamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, c_api_negative_step_2_N_3){ + blasint N = 3, inc = 2; + double x[] = {-1.1, 0.0, 1.0, 0.0, -2.2, 0.0}; + + blasint index = cblas_idamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, c_api_positive_step_1_N_4){ + blasint N = 4, inc = 1; + double x[] = {1.1, 1.0, 2.2, 3.3}; + + blasint index = cblas_idamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, c_api_negative_step_1_N_4){ + blasint N = 4, inc = 1; + double x[] = {-1.1, 1.0, -2.2, -3.3}; + + blasint index = cblas_idamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, c_api_positive_step_2_N_4){ + blasint N = 4, inc = 2; + double x[] = {1.1, 0.0, 1.0, 0.0, 2.2, 0.0, 3.3, 0.0}; + + blasint index = cblas_idamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, c_api_negative_step_2_N_4){ + blasint N = 4, inc = 2; + double x[] = {-1.1, 0.0, 1.0, 0.0, -2.2, 0.0, -3.3, 0.0}; + + blasint index = cblas_idamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, c_api_positive_step_1_N_5){ + blasint N = 5, inc = 1; + double x[] = {1.1, 1.0, 2.2, 3.3, 0.0}; + + blasint index = cblas_idamin(N, x, inc); + ASSERT_EQUAL(4, index); +} + +/** + * C API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, c_api_negative_step_1_N_5){ + blasint N = 5, inc = 1; + double x[] = {-1.1, 1.0, -2.2, -3.3, 0.0}; + + blasint index = cblas_idamin(N, x, inc); + ASSERT_EQUAL(4, index); +} + +/** + * C API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, c_api_positive_step_2_N_5){ + blasint N = 5, inc = 2; + double x[] = {1.1, 0.0, 1.0, 0.0, 2.2, 0.0, 3.3, 0.0, 0.0, 0.0}; + + blasint index = cblas_idamin(N, x, inc); + ASSERT_EQUAL(4, index); +} + +/** + * C API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, c_api_negative_step_2_N_5){ + blasint N = 5, inc = 2; + double x[] = {-1.1, 0.0, 1.0, 0.0, -2.2, 0.0, -3.3, 0.0, 0.0, 0.0}; + + blasint index = cblas_idamin(N, x, inc); + ASSERT_EQUAL(4, index); +} + +/** + * C API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, c_api_positive_step_1_N_50){ + blasint i; + blasint N = ELEMENTS, inc = 1; + double x[ELEMENTS]; + for (i = 0; i < N * inc; i ++) { + x[i] = i + 1000; + } + + x[8 * inc] = 0.0; + blasint index = cblas_idamin(N, x, inc); + ASSERT_EQUAL(8, index); +} + +/** + * C API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, c_api_negative_step_1_N_50){ + blasint i; + blasint N = ELEMENTS, inc = 1; + double x[ELEMENTS]; + for (i = 0; i < N * inc; i ++) { + x[i] = - i - 1000; + } + + x[8 * inc] = -1.0; + blasint index = cblas_idamin(N, x, inc); + ASSERT_EQUAL(8, index); +} + +/** + * C API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, c_api_positive_step_2_N_50){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + double x[ELEMENTS * INCREMENT]; + for (i = 0; i < N * inc; i ++) { + x[i] = i + 1000; + } + + x[8 * inc] = 0.0; + blasint index = cblas_idamin(N, x, inc); + ASSERT_EQUAL(8, index); +} + +/** + * C API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, c_api_negative_step_2_N_50){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + double x[ELEMENTS * INCREMENT]; + for (i = 0; i < N * inc; i ++) { + x[i] = - i - 1000; + } + + x[8 * inc] = -1.0; + blasint index = cblas_idamin(N, x, inc); + ASSERT_EQUAL(8, index); +} + +/** + * C API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, c_api_min_idx_in_vec_tail){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + double x[ELEMENTS * INCREMENT]; + for (i = 0; i < N * inc; i ++) { + x[i] = i + 1000; + } + + x[(N - 1) * inc] = 0.0; + blasint index = cblas_idamin(N, x, inc); + ASSERT_EQUAL(N - 1, index); +} + +/** + * C API specific test + * Test idamin by comparing it against pre-calculated values + */ +CTEST(idamin, c_api_min_idx_in_vec_tail_inc_1){ + blasint i; + blasint N = ELEMENTS, inc = 1; + double x[ELEMENTS * inc]; + for (i = 0; i < N * inc; i ++) { + x[i] = i + 1000; + } + + x[(N - 1) * inc] = 0.0; + blasint index = cblas_idamin(N, x, inc); + ASSERT_EQUAL(N - 1, index); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_isamin.c b/utest/test_extensions/test_isamin.c new file mode 100644 index 000000000..df8dead07 --- /dev/null +++ b/utest/test_extensions/test_isamin.c @@ -0,0 +1,787 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. 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. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include + +#define ELEMENTS 50 +#define INCREMENT 2 + +#ifdef BUILD_SINGLE + +/** + * Fortran API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, bad_args_N_0){ + blasint i; + blasint N = 0, inc = 1; + float x[ELEMENTS]; + for (i = 0; i < ELEMENTS * inc; i ++) { + x[i] = 1000 - i; + } + blasint index = BLASFUNC(isamin)(&N, x, &inc); + ASSERT_EQUAL(0, index); +} + +/** + * Fortran API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, step_zero){ + blasint i; + blasint N = ELEMENTS, inc = 0; + float x[ELEMENTS]; + for (i = 0; i < N * inc; i ++) { + x[i] = i + 1000; + } + x[8] = 0.0f; + blasint index = BLASFUNC(isamin)(&N, x, &inc); + ASSERT_EQUAL(0, index); +} + +/** + * Fortran API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, positive_step_1_N_1){ + blasint N = 1, inc = 1; + float x[] = {1.1f}; + + blasint index = BLASFUNC(isamin)(&N, x, &inc); + ASSERT_EQUAL(1, index); +} + +/** + * Fortran API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, negative_step_1_N_1){ + blasint N = 1, inc = 1; + float x[] = {-1.1f}; + + blasint index = BLASFUNC(isamin)(&N, x, &inc); + ASSERT_EQUAL(1, index); +} + +/** + * Fortran API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, positive_step_2_N_1){ + blasint N = 1, inc = 2; + float x[] = {1.1f, 0.0f}; + + blasint index = BLASFUNC(isamin)(&N, x, &inc); + ASSERT_EQUAL(1, index); +} + +/** + * Fortran API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, negative_step_2_N_1){ + blasint N = 1, inc = 2; + float x[] = {-1.1f, 0.0f}; + + blasint index = BLASFUNC(isamin)(&N, x, &inc); + ASSERT_EQUAL(1, index); +} + +/** + * Fortran API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, positive_step_1_N_2){ + blasint N = 2, inc = 1; + float x[] = {1.1f, 1.0f}; + + blasint index = BLASFUNC(isamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, negative_step_1_N_2){ + blasint N = 2, inc = 1; + float x[] = {-1.1f, 1.0f}; + + blasint index = BLASFUNC(isamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, positive_step_2_N_2){ + blasint N = 2, inc = 2; + float x[] = {1.1f, 0.0f, 1.0f, 0.0f}; + + blasint index = BLASFUNC(isamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, negative_step_2_N_2){ + blasint N = 2, inc = 2; + float x[] = {-1.1f, 0.0f, 1.0f, 0.0f}; + + blasint index = BLASFUNC(isamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, positive_step_1_N_3){ + blasint N = 3, inc = 1; + float x[] = {1.1f, 1.0f, 2.2f}; + + blasint index = BLASFUNC(isamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, negative_step_1_N_3){ + blasint N = 3, inc = 1; + float x[] = {-1.1f, 1.0f, -2.2f}; + + blasint index = BLASFUNC(isamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, positive_step_2_N_3){ + blasint N = 3, inc = 2; + float x[] = {1.1f, 0.0f, 1.0f, 0.0f, 2.2f, 0.0f}; + + blasint index = BLASFUNC(isamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, negative_step_2_N_3){ + blasint N = 3, inc = 2; + float x[] = {-1.1f, 0.0f, 1.0f, 0.0f, -2.2f, 0.0f}; + + blasint index = BLASFUNC(isamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, positive_step_1_N_4){ + blasint N = 4, inc = 1; + float x[] = {1.1f, 1.0f, 2.2f, 3.3f}; + + blasint index = BLASFUNC(isamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, negative_step_1_N_4){ + blasint N = 4, inc = 1; + float x[] = {-1.1f, 1.0f, -2.2f, -3.3f}; + + blasint index = BLASFUNC(isamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, positive_step_2_N_4){ + blasint N = 4, inc = 2; + float x[] = {1.1f, 0.0f, 1.0f, 0.0f, 2.2f, 0.0f, 3.3f, 0.0f}; + + blasint index = BLASFUNC(isamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, negative_step_2_N_4){ + blasint N = 4, inc = 2; + float x[] = {-1.1f, 0.0f, 1.0f, 0.0f, -2.2f, 0.0f, -3.3f, 0.0f}; + + blasint index = BLASFUNC(isamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, positive_step_1_N_5){ + blasint N = 5, inc = 1; + float x[] = {1.1f, 1.0f, 2.2f, 3.3f, 0.0f}; + + blasint index = BLASFUNC(isamin)(&N, x, &inc); + ASSERT_EQUAL(5, index); +} + +/** + * Fortran API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, negative_step_1_N_5){ + blasint N = 5, inc = 1; + float x[] = {-1.1f, 1.0f, -2.2f, -3.3f, 0.0f}; + + blasint index = BLASFUNC(isamin)(&N, x, &inc); + ASSERT_EQUAL(5, index); +} + +/** + * Fortran API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, positive_step_2_N_5){ + blasint N = 5, inc = 2; + float x[] = {1.1f, 0.0f, 1.0f, 0.0f, 2.2f, 0.0f, 3.3f, 0.0f, 0.0f, 0.0f}; + + blasint index = BLASFUNC(isamin)(&N, x, &inc); + ASSERT_EQUAL(5, index); +} + +/** + * Fortran API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, negative_step_2_N_5){ + blasint N = 5, inc = 2; + float x[] = {-1.1f, 0.0f, 1.0f, 0.0f, -2.2f, 0.0f, -3.3f, 0.0f, 0.0f, 0.0f}; + + blasint index = BLASFUNC(isamin)(&N, x, &inc); + ASSERT_EQUAL(5, index); +} + +/** + * Fortran API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, positive_step_1_N_50){ + blasint i; + blasint N = ELEMENTS, inc = 1; + float x[ELEMENTS]; + for (i = 0; i < N * inc; i ++) { + x[i] = i + 1000; + } + + x[8 * inc] = 0.0f; + blasint index = BLASFUNC(isamin)(&N, x, &inc); + ASSERT_EQUAL(9, index); +} + +/** + * Fortran API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, negative_step_1_N_50){ + blasint i; + blasint N = ELEMENTS, inc = 1; + float x[ELEMENTS]; + for (i = 0; i < N * inc; i ++) { + x[i] = - i - 1000; + } + + x[8 * inc] = -1.0f; + blasint index = BLASFUNC(isamin)(&N, x, &inc); + ASSERT_EQUAL(9, index); +} + +/** + * Fortran API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, positive_step_2_N_50){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + float x[ELEMENTS * INCREMENT]; + for (i = 0; i < N * inc; i ++) { + x[i] = i + 1000; + } + + x[8 * inc] = 0.0f; + blasint index = BLASFUNC(isamin)(&N, x, &inc); + ASSERT_EQUAL(9, index); +} + +/** + * Fortran API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, negative_step_2_N_50){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + float x[ELEMENTS * INCREMENT]; + for (i = 0; i < N * inc; i ++) { + x[i] = - i - 1000; + } + + x[8 * inc] = -1.0f; + blasint index = BLASFUNC(isamin)(&N, x, &inc); + ASSERT_EQUAL(9, index); +} + +/** + * Fortran API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, min_idx_in_vec_tail){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + float x[ELEMENTS * INCREMENT]; + for (i = 0; i < N * inc; i ++) { + x[i] = i + 1000; + } + + x[(N - 1) * inc] = 0.0f; + blasint index = BLASFUNC(isamin)(&N, x, &inc); + ASSERT_EQUAL(N, index); +} + +/** + * Fortran API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, min_idx_in_vec_tail_inc_1){ + blasint i; + blasint N = ELEMENTS, inc = 1; + float x[ELEMENTS * inc]; + for (i = 0; i < N * inc; i ++) { + x[i] = i + 1000; + } + + x[(N - 1) * inc] = 0.0f; + blasint index = BLASFUNC(isamin)(&N, x, &inc); + ASSERT_EQUAL(N, index); +} + +/** + * C API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, c_api_bad_args_N_0){ + blasint i; + blasint N = 0, inc = 1; + float x[ELEMENTS]; + for (i = 0; i < ELEMENTS * inc; i ++) { + x[i] = 1000 - i; + } + blasint index = cblas_isamin(N, x, inc); + ASSERT_EQUAL(0, index); +} + +/** + * C API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, c_api_step_zero){ + blasint i; + blasint N = ELEMENTS, inc = 0; + float x[ELEMENTS]; + for (i = 0; i < N * inc; i ++) { + x[i] = i + 1000; + } + x[8] = 0.0f; + blasint index = cblas_isamin(N, x, inc); + ASSERT_EQUAL(0, index); +} + +/** + * C API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, c_api_positive_step_1_N_1){ + blasint N = 1, inc = 1; + float x[] = {1.1f}; + + blasint index = cblas_isamin(N, x, inc); + ASSERT_EQUAL(0, index); +} + +/** + * C API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, c_api_negative_step_1_N_1){ + blasint N = 1, inc = 1; + float x[] = {-1.1f}; + + blasint index = cblas_isamin(N, x, inc); + ASSERT_EQUAL(0, index); +} + +/** + * C API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, c_api_positive_step_2_N_1){ + blasint N = 1, inc = 2; + float x[] = {1.1f, 0.0f}; + + blasint index = cblas_isamin(N, x, inc); + ASSERT_EQUAL(0, index); +} + +/** + * C API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, c_api_negative_step_2_N_1){ + blasint N = 1, inc = 2; + float x[] = {-1.1f, 0.0f}; + + blasint index = cblas_isamin(N, x, inc); + ASSERT_EQUAL(0, index); +} + +/** + * C API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, c_api_positive_step_1_N_2){ + blasint N = 2, inc = 1; + float x[] = {1.1f, 1.0f}; + + blasint index = cblas_isamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, c_api_negative_step_1_N_2){ + blasint N = 2, inc = 1; + float x[] = {-1.1f, 1.0f}; + + blasint index = cblas_isamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, c_api_positive_step_2_N_2){ + blasint N = 2, inc = 2; + float x[] = {1.1f, 0.0f, 1.0f, 0.0f}; + + blasint index = cblas_isamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, c_api_negative_step_2_N_2){ + blasint N = 2, inc = 2; + float x[] = {-1.1f, 0.0f, 1.0f, 0.0f}; + + blasint index = cblas_isamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, c_api_positive_step_1_N_3){ + blasint N = 3, inc = 1; + float x[] = {1.1f, 1.0f, 2.2f}; + + blasint index = cblas_isamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, c_api_negative_step_1_N_3){ + blasint N = 3, inc = 1; + float x[] = {-1.1f, 1.0f, -2.2f}; + + blasint index = cblas_isamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, c_api_positive_step_2_N_3){ + blasint N = 3, inc = 2; + float x[] = {1.1f, 0.0f, 1.0f, 0.0f, 2.2f, 0.0f}; + + blasint index = cblas_isamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, c_api_negative_step_2_N_3){ + blasint N = 3, inc = 2; + float x[] = {-1.1f, 0.0f, 1.0f, 0.0f, -2.2f, 0.0f}; + + blasint index = cblas_isamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, c_api_positive_step_1_N_4){ + blasint N = 4, inc = 1; + float x[] = {1.1f, 1.0f, 2.2f, 3.3f}; + + blasint index = cblas_isamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, c_api_negative_step_1_N_4){ + blasint N = 4, inc = 1; + float x[] = {-1.1f, 1.0f, -2.2f, -3.3f}; + + blasint index = cblas_isamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, c_api_positive_step_2_N_4){ + blasint N = 4, inc = 2; + float x[] = {1.1f, 0.0f, 1.0f, 0.0f, 2.2f, 0.0f, 3.3f, 0.0f}; + + blasint index = cblas_isamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, c_api_negative_step_2_N_4){ + blasint N = 4, inc = 2; + float x[] = {-1.1f, 0.0f, 1.0f, 0.0f, -2.2f, 0.0f, -3.3f, 0.0f}; + + blasint index = cblas_isamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, c_api_positive_step_1_N_5){ + blasint N = 5, inc = 1; + float x[] = {1.1f, 1.0f, 2.2f, 3.3f, 0.0f}; + + blasint index = cblas_isamin(N, x, inc); + ASSERT_EQUAL(4, index); +} + +/** + * C API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, c_api_negative_step_1_N_5){ + blasint N = 5, inc = 1; + float x[] = {-1.1f, 1.0f, -2.2f, -3.3f, 0.0f}; + + blasint index = cblas_isamin(N, x, inc); + ASSERT_EQUAL(4, index); +} + +/** + * C API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, c_api_positive_step_2_N_5){ + blasint N = 5, inc = 2; + float x[] = {1.1f, 0.0f, 1.0f, 0.0f, 2.2f, 0.0f, 3.3f, 0.0f, 0.0f, 0.0f}; + + blasint index = cblas_isamin(N, x, inc); + ASSERT_EQUAL(4, index); +} + +/** + * C API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, c_api_negative_step_2_N_5){ + blasint N = 5, inc = 2; + float x[] = {-1.1f, 0.0f, 1.0f, 0.0f, -2.2f, 0.0f, -3.3f, 0.0f, 0.0f, 0.0f}; + + blasint index = cblas_isamin(N, x, inc); + ASSERT_EQUAL(4, index); +} + +/** + * C API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, c_api_positive_step_1_N_50){ + blasint i; + blasint N = ELEMENTS, inc = 1; + float x[ELEMENTS]; + for (i = 0; i < N * inc; i ++) { + x[i] = i + 1000; + } + + x[8 * inc] = 0.0f; + blasint index = cblas_isamin(N, x, inc); + ASSERT_EQUAL(8, index); +} + +/** + * C API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, c_api_negative_step_1_N_50){ + blasint i; + blasint N = ELEMENTS, inc = 1; + float x[ELEMENTS]; + for (i = 0; i < N * inc; i ++) { + x[i] = - i - 1000; + } + + x[8 * inc] = -1.0f; + blasint index = cblas_isamin(N, x, inc); + ASSERT_EQUAL(8, index); +} + +/** + * C API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, c_api_positive_step_2_N_50){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + float x[ELEMENTS * INCREMENT]; + for (i = 0; i < N * inc; i ++) { + x[i] = i + 1000; + } + + x[8 * inc] = 0.0f; + blasint index = cblas_isamin(N, x, inc); + ASSERT_EQUAL(8, index); +} + +/** + * C API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, c_api_negative_step_2_N_50){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + float x[ELEMENTS * INCREMENT]; + for (i = 0; i < N * inc; i ++) { + x[i] = - i - 1000; + } + + x[8 * inc] = -1.0f; + blasint index = cblas_isamin(N, x, inc); + ASSERT_EQUAL(8, index); +} + +/** + * C API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, c_api_min_idx_in_vec_tail){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + float x[ELEMENTS * INCREMENT]; + for (i = 0; i < N * inc; i ++) { + x[i] = i + 1000; + } + + x[(N - 1) * inc] = 0.0f; + blasint index = cblas_isamin(N, x, inc); + ASSERT_EQUAL(N - 1, index); +} + +/** + * C API specific test + * Test isamin by comparing it against pre-calculated values + */ +CTEST(isamin, c_api_min_idx_in_vec_tail_inc_1){ + blasint i; + blasint N = ELEMENTS, inc = 1; + float x[ELEMENTS * inc]; + for (i = 0; i < N * inc; i ++) { + x[i] = i + 1000; + } + + x[(N - 1) * inc] = 0.0f; + blasint index = cblas_isamin(N, x, inc); + ASSERT_EQUAL(N - 1, index); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_izamin.c b/utest/test_extensions/test_izamin.c new file mode 100644 index 000000000..a0bdae8e2 --- /dev/null +++ b/utest/test_extensions/test_izamin.c @@ -0,0 +1,625 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. 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. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include + +#define ELEMENTS 50 +#define INCREMENT 2 + +#ifdef BUILD_COMPLEX16 + +/** + * Fortran API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, bad_args_N_0){ + blasint i; + blasint N = 0, inc = 1; + double x[ELEMENTS * 2]; + for (i = 0; i < ELEMENTS * inc * 2; i ++) { + x[i] = 1000 - i; + } + blasint index = BLASFUNC(izamin)(&N, x, &inc); + ASSERT_EQUAL(0, index); +} + +/** + * Fortran API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, step_zero){ + blasint i; + blasint N = ELEMENTS, inc = 0; + double x[ELEMENTS * 2]; + for (i = 0; i < N * 2; i ++) { + x[i] = i - 1000; + } + blasint index = BLASFUNC(izamin)(&N, x, &inc); + ASSERT_EQUAL(0, index); +} + +/** + * Fortran API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, positive_step_1_N_1){ + blasint N = 1, inc = 1; + double x[] = {1.0, 2.0}; + blasint index = BLASFUNC(izamin)(&N, x, &inc); + ASSERT_EQUAL(1, index); +} + +/** + * Fortran API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, negative_step_1_N_1){ + blasint N = 1, inc = 1; + double x[] = {-1.0, -2.0}; + blasint index = BLASFUNC(izamin)(&N, x, &inc); + ASSERT_EQUAL(1, index); +} + +/** + * Fortran API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, positive_step_2_N_1){ + blasint N = 1, inc = 2; + double x[] = {1.0, 2.0, 0.0, 0.0}; + blasint index = BLASFUNC(izamin)(&N, x, &inc); + ASSERT_EQUAL(1, index); +} + +/** + * Fortran API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, negative_step_2_N_1){ + blasint N = 1, inc = 2; + double x[] = {-1.0, -2.0, 0.0, 0.0}; + blasint index = BLASFUNC(izamin)(&N, x, &inc); + ASSERT_EQUAL(1, index); +} + +/** + * Fortran API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, positive_step_1_N_2){ + blasint N = 2, inc = 1; + double x[] = {1.0, 2.0, 0.0, 0.0}; + blasint index = BLASFUNC(izamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, negative_step_1_N_2){ + blasint N = 2, inc = 1; + double x[] = {-1.0, -2.0, 0.0, 0.0}; + blasint index = BLASFUNC(izamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, positive_step_2_N_2){ + blasint N = 2, inc = 2; + double x[] = {1.0, 2.0, 0.0, 0.0, 1.0, 1.0, 0.0, 0.0}; + blasint index = BLASFUNC(izamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, negative_step_2_N_2){ + blasint N = 2, inc = 2; + double x[] = {-1.0, -2.0, 0.0, 0.0, -1.0, -1.0, 0.0, 0.0}; + blasint index = BLASFUNC(izamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, positive_step_1_N_3){ + blasint N = 3, inc = 1; + double x[] = {1.0, 2.0, 0.0, 0.0, 2.0, 1.0}; + blasint index = BLASFUNC(izamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, negative_step_1_N_3){ + blasint N = 3, inc = 1; + double x[] = {-1.0, -2.0, 0.0, 0.0, -2.0, -1.0}; + blasint index = BLASFUNC(izamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, positive_step_2_N_3){ + blasint N = 3, inc = 2; + double x[] = {1.0, 2.0, 0.0, 0.0, 1.0, 1.0, 0.0, 0.0, 2.0, 1.0, 0.0, 0.0}; + blasint index = BLASFUNC(izamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, negative_step_2_N_3){ + blasint N = 3, inc = 2; + double x[] = {-1.0, -2.0, 0.0, 0.0, -1.0, -1.0, 0.0, 0.0, -2.0, -1.0, 0.0, 0.0}; + blasint index = BLASFUNC(izamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, positive_step_1_N_4){ + blasint N = 4, inc = 1; + double x[] = {1.0, 2.0, 0.0, 0.0, 2.0, 1.0, -2.0, -2.0}; + blasint index = BLASFUNC(izamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, negative_step_1_N_4){ + blasint N = 4, inc = 1; + double x[] = {-1.0, -2.0, 0.0, 0.0, -2.0, -1.0, -2.0, -2.0}; + blasint index = BLASFUNC(izamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, positive_step_2_N_4){ + blasint N = 4, inc = 2; + double x[] = {1.0, 2.0, 0.0, 0.0, 1.0, 1.0, 0.0, 0.0, 2.0, 1.0, 0.0, 0.0, -2.0, -2.0, 0.0, 0.0}; + blasint index = BLASFUNC(izamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, negative_step_2_N_4){ + blasint N = 4, inc = 2; + double x[] = {-1.0, -2.0, 0.0, 0.0, -1.0, -1.0, 0.0, 0.0, -2.0, -1.0, 0.0, 0.0, -2.0, -2.0, 0.0, 0.0}; + blasint index = BLASFUNC(izamin)(&N, x, &inc); + ASSERT_EQUAL(2, index); +} + +/** + * Fortran API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, positive_step_1_N_50){ + blasint i; + blasint N = ELEMENTS, inc = 1; + double x[ELEMENTS * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = i + 1000; + } + x[7 * inc * 2] = 0.0; + x[7 * inc * 2 + 1] = 0.0; + blasint index = BLASFUNC(izamin)(&N, x, &inc); + ASSERT_EQUAL(8, index); +} + +/** + * Fortran API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, negative_step_1_N_50){ + blasint i; + blasint N = ELEMENTS, inc = 1; + double x[ELEMENTS * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = - i - 1000; + } + x[7 * inc * 2] = 0.0; + x[7 * inc * 2 + 1] = 0.0; + blasint index = BLASFUNC(izamin)(&N, x, &inc); + ASSERT_EQUAL(8, index); +} + +/** + * Fortran API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, positive_step_2_N_50){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + double x[ELEMENTS * INCREMENT * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = i + 1000; + } + x[7 * inc * 2] = 0.0; + x[7 * inc * 2 + 1] = 0.0; + blasint index = BLASFUNC(izamin)(&N, x, &inc); + ASSERT_EQUAL(8, index); +} + +/** + * Fortran API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, negative_step_2_N_50){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + double x[ELEMENTS * INCREMENT * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = - i - 1000; + } + x[7 * inc * 2] = 0.0; + x[7 * inc * 2 + 1] = 0.0; + blasint index = BLASFUNC(izamin)(&N, x, &inc); + ASSERT_EQUAL(8, index); +} + +/** + * Fortran API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, min_idx_in_vec_tail){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + double x[ELEMENTS * INCREMENT * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = i + 1000; + } + + x[(N - 1) * inc * 2] = 0.0; + x[(N - 1) * inc * 2 + 1] = 0.0; + blasint index = BLASFUNC(izamin)(&N, x, &inc); + ASSERT_EQUAL(N, index); +} + +/** + * C API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, c_api_bad_args_N_0){ + blasint i; + blasint N = 0, inc = 1; + double x[ELEMENTS * 2]; + for (i = 0; i < ELEMENTS * inc * 2; i ++) { + x[i] = 1000 - i; + } + blasint index = cblas_izamin(N, x, inc); + ASSERT_EQUAL(0, index); +} + +/** + * C API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, c_api_step_zero){ + blasint i; + blasint N = ELEMENTS, inc = 0; + double x[ELEMENTS * 2]; + for (i = 0; i < N * 2; i ++) { + x[i] = i - 1000; + } + blasint index = cblas_izamin(N, x, inc); + ASSERT_EQUAL(0, index); +} + +/** + * C API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, c_api_positive_step_1_N_1){ + blasint N = 1, inc = 1; + double x[] = {1.0, 2.0}; + blasint index = cblas_izamin(N, x, inc); + ASSERT_EQUAL(0, index); +} + +/** + * C API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, c_api_negative_step_1_N_1){ + blasint N = 1, inc = 1; + double x[] = {-1.0, -2.0}; + blasint index = cblas_izamin(N, x, inc); + ASSERT_EQUAL(0, index); +} + +/** + * C API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, c_api_positive_step_2_N_1){ + blasint N = 1, inc = 2; + double x[] = {1.0, 2.0, 0.0, 0.0}; + blasint index = cblas_izamin(N, x, inc); + ASSERT_EQUAL(0, index); +} + +/** + * C API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, c_api_negative_step_2_N_1){ + blasint N = 1, inc = 2; + double x[] = {-1.0, -2.0, 0.0, 0.0}; + blasint index = cblas_izamin(N, x, inc); + ASSERT_EQUAL(0, index); +} + +/** + * C API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, c_api_positive_step_1_N_2){ + blasint N = 2, inc = 1; + double x[] = {1.0, 2.0, 0.0, 0.0}; + blasint index = cblas_izamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, c_api_negative_step_1_N_2){ + blasint N = 2, inc = 1; + double x[] = {-1.0, -2.0, 0.0, 0.0}; + blasint index = cblas_izamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, c_api_positive_step_2_N_2){ + blasint N = 2, inc = 2; + double x[] = {1.0, 2.0, 0.0, 0.0, 1.0, 1.0, 0.0, 0.0}; + blasint index = cblas_izamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, c_api_negative_step_2_N_2){ + blasint N = 2, inc = 2; + double x[] = {-1.0, -2.0, 0.0, 0.0, -1.0, -1.0, 0.0, 0.0}; + blasint index = cblas_izamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, c_api_positive_step_1_N_3){ + blasint N = 3, inc = 1; + double x[] = {1.0, 2.0, 0.0, 0.0, 2.0, 1.0}; + blasint index = cblas_izamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, c_api_negative_step_1_N_3){ + blasint N = 3, inc = 1; + double x[] = {-1.0, -2.0, 0.0, 0.0, -2.0, -1.0}; + blasint index = cblas_izamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, c_api_positive_step_2_N_3){ + blasint N = 3, inc = 2; + double x[] = {1.0, 2.0, 0.0, 0.0, 1.0, 1.0, 0.0, 0.0, 2.0, 1.0, 0.0, 0.0}; + blasint index = cblas_izamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, c_api_negative_step_2_N_3){ + blasint N = 3, inc = 2; + double x[] = {-1.0, -2.0, 0.0, 0.0, -1.0, -1.0, 0.0, 0.0, -2.0, -1.0, 0.0, 0.0}; + blasint index = cblas_izamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, c_api_positive_step_1_N_4){ + blasint N = 4, inc = 1; + double x[] = {1.0, 2.0, 0.0, 0.0, 2.0, 1.0, -2.0, -2.0}; + blasint index = cblas_izamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, c_api_negative_step_1_N_4){ + blasint N = 4, inc = 1; + double x[] = {-1.0, -2.0, 0.0, 0.0, -2.0, -1.0, -2.0, -2.0}; + blasint index = cblas_izamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, c_api_positive_step_2_N_4){ + blasint N = 4, inc = 2; + double x[] = {1.0, 2.0, 0.0, 0.0, 1.0, 1.0, 0.0, 0.0, 2.0, 1.0, 0.0, 0.0, -2.0, -2.0, 0.0, 0.0}; + blasint index = cblas_izamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, c_api_negative_step_2_N_4){ + blasint N = 4, inc = 2; + double x[] = {-1.0, -2.0, 0.0, 0.0, -1.0, -1.0, 0.0, 0.0, -2.0, -1.0, 0.0, 0.0, -2.0, -2.0, 0.0, 0.0}; + blasint index = cblas_izamin(N, x, inc); + ASSERT_EQUAL(1, index); +} + +/** + * C API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, c_api_positive_step_1_N_50){ + blasint i; + blasint N = ELEMENTS, inc = 1; + double x[ELEMENTS * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = i + 1000; + } + x[7 * inc * 2] = 0.0; + x[7 * inc * 2 + 1] = 0.0; + blasint index = cblas_izamin(N, x, inc); + ASSERT_EQUAL(7, index); +} + +/** + * C API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, c_api_negative_step_1_N_50){ + blasint i; + blasint N = ELEMENTS, inc = 1; + double x[ELEMENTS * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = - i - 1000; + } + x[7 * inc * 2] = 0.0; + x[7 * inc * 2 + 1] = 0.0; + blasint index = cblas_izamin(N, x, inc); + ASSERT_EQUAL(7, index); +} + +/** + * C API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, c_api_positive_step_2_N_50){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + double x[ELEMENTS * INCREMENT * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = i + 1000; + } + x[7 * inc * 2] = 0.0; + x[7 * inc * 2 + 1] = 0.0; + blasint index = cblas_izamin(N, x, inc); + ASSERT_EQUAL(7, index); +} + +/** + * C API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, c_api_negative_step_2_N_50){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + double x[ELEMENTS * INCREMENT * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = - i - 1000; + } + x[7 * inc * 2] = 0.0; + x[7 * inc * 2 + 1] = 0.0; + blasint index = cblas_izamin(N, x, inc); + ASSERT_EQUAL(7, index); +} + +/** + * C API specific test + * Test izamin by comparing it against pre-calculated values + */ +CTEST(izamin, c_api_min_idx_in_vec_tail){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + double x[ELEMENTS * INCREMENT * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = i + 1000; + } + + x[(N - 1) * inc * 2] = 0.0; + x[(N - 1) * inc * 2 + 1] = 0.0; + blasint index = cblas_izamin(N, x, inc); + ASSERT_EQUAL(N - 1, index); +} +#endif diff --git a/utest/test_extensions/test_samin.c b/utest/test_extensions/test_samin.c new file mode 100644 index 000000000..5c747a0f6 --- /dev/null +++ b/utest/test_extensions/test_samin.c @@ -0,0 +1,354 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. 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. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include + +#define ELEMENTS 70 +#define INCREMENT 2 + +#ifdef BUILD_SINGLE + +/** + * Test samin by comparing it against pre-calculated values + */ +CTEST(samin, bad_args_N_0){ + blasint i; + blasint N = 0, inc = 1; + float x[ELEMENTS]; + for (i = 0; i < ELEMENTS * inc; i ++) { + x[i] = 1000 - i; + } + float amin = BLASFUNC(samin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0f, amin, SINGLE_EPS); +} + +/** + * Test samin by comparing it against pre-calculated values + */ +CTEST(samin, step_zero){ + blasint i; + blasint N = ELEMENTS, inc = 0; + float x[ELEMENTS]; + for (i = 0; i < N * inc; i ++) { + x[i] = i + 1000; + } + x[8] = 0.0f; + float amin = BLASFUNC(samin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0f, amin, SINGLE_EPS); +} + +/** + * Test samin by comparing it against pre-calculated values + */ +CTEST(samin, positive_step_1_N_1){ + blasint N = 1, inc = 1; + float x[] = {1.1f}; + + float amin = BLASFUNC(samin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.1f, amin, SINGLE_EPS); +} + +/** + * Test samin by comparing it against pre-calculated values + */ +CTEST(samin, negative_step_1_N_1){ + blasint N = 1, inc = 1; + float x[] = {-1.1f}; + + float amin = BLASFUNC(samin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.1f, amin, SINGLE_EPS); +} + +/** + * Test samin by comparing it against pre-calculated values + */ +CTEST(samin, positive_step_2_N_1){ + blasint N = 1, inc = 2; + float x[] = {1.1f, 0.0f}; + + float amin = BLASFUNC(samin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.1f, amin, SINGLE_EPS); +} + +/** + * Test samin by comparing it against pre-calculated values + */ +CTEST(samin, negative_step_2_N_1){ + blasint N = 1, inc = 2; + float x[] = {-1.1f, 0.0f}; + + float amin = BLASFUNC(samin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.1f, amin, SINGLE_EPS); +} + +/** + * Test samin by comparing it against pre-calculated values + */ +CTEST(samin, positive_step_1_N_2){ + blasint N = 2, inc = 1; + float x[] = {1.1f, 1.0f}; + + float amin = BLASFUNC(samin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.0f, amin, SINGLE_EPS); +} + +/** + * Test samin by comparing it against pre-calculated values + */ +CTEST(samin, negative_step_1_N_2){ + blasint N = 2, inc = 1; + float x[] = {-1.1f, 1.0f}; + + float amin = BLASFUNC(samin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.0f, amin, SINGLE_EPS); +} + +/** + * Test samin by comparing it against pre-calculated values + */ +CTEST(samin, positive_step_2_N_2){ + blasint N = 2, inc = 2; + float x[] = {1.1f, 0.0f, 1.0f, 0.0f}; + + float amin = BLASFUNC(samin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.0f, amin, SINGLE_EPS); +} + +/** + * Test samin by comparing it against pre-calculated values + */ +CTEST(samin, negative_step_2_N_2){ + blasint N = 2, inc = 2; + float x[] = {-1.1f, 0.0f, 1.0f, 0.0f}; + + float amin = BLASFUNC(samin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.0f, amin, SINGLE_EPS); +} + +/** + * Test samin by comparing it against pre-calculated values + */ +CTEST(samin, positive_step_1_N_3){ + blasint N = 3, inc = 1; + float x[] = {1.1f, 1.0f, 2.2f}; + + float amin = BLASFUNC(samin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.0f, amin, SINGLE_EPS); +} + +/** + * Test samin by comparing it against pre-calculated values + */ +CTEST(samin, negative_step_1_N_3){ + blasint N = 3, inc = 1; + float x[] = {-1.1f, 1.0f, -2.2f}; + + float amin = BLASFUNC(samin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.0f, amin, SINGLE_EPS); +} + +/** + * Test samin by comparing it against pre-calculated values + */ +CTEST(samin, positive_step_2_N_3){ + blasint N = 3, inc = 2; + float x[] = {1.1f, 0.0f, 1.0f, 0.0f, 2.2f, 0.0f}; + + float amin = BLASFUNC(samin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.0f, amin, SINGLE_EPS); +} + +/** + * Test samin by comparing it against pre-calculated values + */ +CTEST(samin, negative_step_2_N_3){ + blasint N = 3, inc = 2; + float x[] = {-1.1f, 0.0f, 1.0f, 0.0f, -2.2f, 0.0f}; + + float amin = BLASFUNC(samin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.0f, amin, SINGLE_EPS); +} + +/** + * Test samin by comparing it against pre-calculated values + */ +CTEST(samin, positive_step_1_N_4){ + blasint N = 4, inc = 1; + float x[] = {1.1f, 1.0f, 2.2f, 3.3f}; + + float amin = BLASFUNC(samin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.0f, amin, SINGLE_EPS); +} + +/** + * Test samin by comparing it against pre-calculated values + */ +CTEST(samin, negative_step_1_N_4){ + blasint N = 4, inc = 1; + float x[] = {-1.1f, 1.0f, -2.2f, -3.3f}; + + float amin = BLASFUNC(samin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.0f, amin, SINGLE_EPS); +} + +/** + * Test samin by comparing it against pre-calculated values + */ +CTEST(samin, positive_step_2_N_4){ + blasint N = 4, inc = 2; + float x[] = {1.1f, 0.0f, 1.0f, 0.0f, 2.2f, 0.0f, 3.3f, 0.0f}; + + float amin = BLASFUNC(samin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.0f, amin, SINGLE_EPS); +} + +/** + * Test samin by comparing it against pre-calculated values + */ +CTEST(samin, negative_step_2_N_4){ + blasint N = 4, inc = 2; + float x[] = {-1.1f, 0.0f, 1.0f, 0.0f, -2.2f, 0.0f, -3.3f, 0.0f}; + + float amin = BLASFUNC(samin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.0f, amin, SINGLE_EPS); +} + +/** + * Test samin by comparing it against pre-calculated values + */ +CTEST(samin, positive_step_1_N_5){ + blasint N = 5, inc = 1; + float x[] = {1.1f, 1.0f, 2.2f, 3.3f, 0.0f}; + + float amin = BLASFUNC(samin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0f, amin, SINGLE_EPS); +} + +/** + * Test samin by comparing it against pre-calculated values + */ +CTEST(samin, negative_step_1_N_5){ + blasint N = 5, inc = 1; + float x[] = {-1.1f, 1.0f, -2.2f, -3.3f, 0.0f}; + + float amin = BLASFUNC(samin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0f, amin, SINGLE_EPS); +} + +/** + * Test samin by comparing it against pre-calculated values + */ +CTEST(samin, positive_step_2_N_5){ + blasint N = 5, inc = 2; + float x[] = {1.1f, 0.0f, 1.0f, 0.0f, 2.2f, 0.0f, 3.3f, 0.0f, 0.0f, 0.0f}; + + float amin = BLASFUNC(samin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0f, amin, SINGLE_EPS); +} + +/** + * Test samin by comparing it against pre-calculated values + */ +CTEST(samin, negative_step_2_N_5){ + blasint N = 5, inc = 2; + float x[] = {-1.1f, 0.0f, 1.0f, 0.0f, -2.2f, 0.0f, -3.3f, 0.0f, 0.0f, 0.0f}; + + float amin = BLASFUNC(samin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0f, amin, SINGLE_EPS); +} + +/** + * Test samin by comparing it against pre-calculated values + */ +CTEST(samin, positive_step_1_N_70){ + blasint i; + blasint N = ELEMENTS, inc = 1; + float x[ELEMENTS]; + for (i = 0; i < N * inc; i ++) { + x[i] = i + 1000; + } + + x[8 * inc] = 0.0f; + float amin = BLASFUNC(samin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0f, amin, SINGLE_EPS); +} + +/** + * Test samin by comparing it against pre-calculated values + */ +CTEST(samin, negative_step_1_N_70){ + blasint i; + blasint N = ELEMENTS, inc = 1; + float x[ELEMENTS]; + for (i = 0; i < N * inc; i ++) { + x[i] = - i - 1000; + } + + x[8 * inc] = -1.0f; + float amin = BLASFUNC(samin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.0f, amin, SINGLE_EPS); +} + +/** + * Test samin by comparing it against pre-calculated values + */ +CTEST(samin, positive_step_2_N_70){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + float x[ELEMENTS * INCREMENT]; + for (i = 0; i < N * inc; i ++) { + x[i] = i + 1000; + } + + x[8 * inc] = 1.0f; + float amin = BLASFUNC(samin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.0f, amin, SINGLE_EPS); +} + +/** + * Test samin by comparing it against pre-calculated values + */ +CTEST(samin, negative_step_2_N_70){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + float x[ELEMENTS * INCREMENT]; + for (i = 0; i < N * inc; i ++) { + x[i] = - i - 1000; + } + + x[8 * inc] = -1.0f; + float amin = BLASFUNC(samin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.0f, amin, SINGLE_EPS); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_saxpby.c b/utest/test_extensions/test_saxpby.c new file mode 100644 index 000000000..b4bd5cf0b --- /dev/null +++ b/utest/test_extensions/test_saxpby.c @@ -0,0 +1,794 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. 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. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include "common.h" + +#define DATASIZE 100 +#define INCREMENT 2 + +struct DATA_SAXPBY { + float x_test[DATASIZE * INCREMENT]; + float x_verify[DATASIZE * INCREMENT]; + float y_test[DATASIZE * INCREMENT]; + float y_verify[DATASIZE * INCREMENT]; +}; +#ifdef BUILD_SINGLE +static struct DATA_SAXPBY data_saxpby; + +/** + * Fortran API specific function + * Test saxpby by comparing it with sscal and saxpy. + * Compare with the following options: + * + * param n - number of elements in vectors x and y + * param alpha - scalar alpha + * param incx - increment for the elements of x + * param beta - scalar beta + * param incy - increment for the elements of y + * return norm of difference + */ +static float check_saxpby(blasint n, float alpha, blasint incx, float beta, blasint incy) +{ + blasint i; + + // sscal accept only positive increments + blasint incx_abs = labs(incx); + blasint incy_abs = labs(incy); + + // Fill vectors x, y + srand_generate(data_saxpby.x_test, n * incx_abs); + srand_generate(data_saxpby.y_test, n * incy_abs); + + // Copy vector x for saxpy + for (i = 0; i < n * incx_abs; i++) + data_saxpby.x_verify[i] = data_saxpby.x_test[i]; + + // Copy vector y for sscal + for (i = 0; i < n * incy_abs; i++) + data_saxpby.y_verify[i] = data_saxpby.y_test[i]; + + // Find beta*y + BLASFUNC(sscal)(&n, &beta, data_saxpby.y_verify, &incy_abs); + + // Find sum of alpha*x and beta*y + BLASFUNC(saxpy)(&n, &alpha, data_saxpby.x_verify, &incx, + data_saxpby.y_verify, &incy); + + BLASFUNC(saxpby)(&n, &alpha, data_saxpby.x_test, &incx, + &beta, data_saxpby.y_test, &incy); + + // Find the differences between output vector caculated by saxpby and saxpy + for (i = 0; i < n * incy_abs; i++) + data_saxpby.y_test[i] -= data_saxpby.y_verify[i]; + + // Find the norm of differences + return BLASFUNC(snrm2)(&n, data_saxpby.y_test, &incy_abs); +} + +/** + * C API specific function + * Test saxpby by comparing it with sscal and saxpy. + * Compare with the following options: + * + * param n - number of elements in vectors x and y + * param alpha - scalar alpha + * param incx - increment for the elements of x + * param beta - scalar beta + * param incy - increment for the elements of y + * return norm of difference + */ +static float c_api_check_saxpby(blasint n, float alpha, blasint incx, float beta, blasint incy) +{ + blasint i; + + // sscal accept only positive increments + blasint incx_abs = labs(incx); + blasint incy_abs = labs(incy); + + // Copy vector x for saxpy + for (i = 0; i < n * incx_abs; i++) + data_saxpby.x_verify[i] = data_saxpby.x_test[i]; + + // Copy vector y for sscal + for (i = 0; i < n * incy_abs; i++) + data_saxpby.y_verify[i] = data_saxpby.y_test[i]; + + // Find beta*y + cblas_sscal(n, beta, data_saxpby.y_verify, incy_abs); + + // Find sum of alpha*x and beta*y + cblas_saxpy(n, alpha, data_saxpby.x_verify, incx, + data_saxpby.y_verify, incy); + + cblas_saxpby(n, alpha, data_saxpby.x_test, incx, + beta, data_saxpby.y_test, incy); + + // Find the differences between output vector caculated by saxpby and saxpy + for (i = 0; i < n * incy_abs; i++) + data_saxpby.y_test[i] -= data_saxpby.y_verify[i]; + + // Find the norm of differences + return cblas_snrm2(n, data_saxpby.y_test, incy_abs); +} + +/** + * Fortran API specific test + * Test saxpby by comparing it with sscal and saxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 1 + */ +CTEST(saxpby, inc_x_1_inc_y_1_N_100) +{ + blasint n = DATASIZE, incx = 1, incy = 1; + float alpha = 1.0f; + float beta = 1.0f; + + float norm = check_saxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test saxpby by comparing it with sscal and saxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 1 + */ +CTEST(saxpby, inc_x_2_inc_y_1_N_100) +{ + blasint n = DATASIZE, incx = 2, incy = 1; + float alpha = 2.0f; + float beta = 1.0f; + + float norm = check_saxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test saxpby by comparing it with sscal and saxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 2 + */ +CTEST(saxpby, inc_x_1_inc_y_2_N_100) +{ + blasint n = DATASIZE, incx = 1, incy = 2; + float alpha = 1.0f; + float beta = 2.0f; + + float norm = check_saxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test saxpby by comparing it with sscal and saxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 2 + */ +CTEST(saxpby, inc_x_2_inc_y_2_N_100) +{ + blasint n = DATASIZE, incx = 2, incy = 2; + float alpha = 3.0f; + float beta = 4.0f; + + float norm = check_saxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test saxpby by comparing it with sscal and saxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is -1 + * Stride of vector y is 2 + */ +CTEST(saxpby, inc_x_neg_1_inc_y_2_N_100) +{ + blasint n = DATASIZE, incx = -1, incy = 2; + float alpha = 5.0f; + float beta = 4.0f; + + float norm = check_saxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test saxpby by comparing it with sscal and saxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is -1 + */ +CTEST(saxpby, inc_x_2_inc_y_neg_1_N_100) +{ + blasint n = DATASIZE, incx = 2, incy = -1; + float alpha = 1.0f; + float beta = 6.0f; + + float norm = check_saxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test saxpby by comparing it with sscal and saxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is -2 + * Stride of vector y is -1 + */ +CTEST(saxpby, inc_x_neg_2_inc_y_neg_1_N_100) +{ + blasint n = DATASIZE, incx = -2, incy = -1; + float alpha = 7.0f; + float beta = 3.5f; + + float norm = check_saxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test saxpby by comparing it with sscal and saxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 1 + * Scalar alpha is zero + */ +CTEST(saxpby, inc_x_1_inc_y_1_N_100_alpha_zero) +{ + blasint n = DATASIZE, incx = 1, incy = 1; + float alpha = 0.0f; + float beta = 1.0f; + + float norm = check_saxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test saxpby by comparing it with sscal and saxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 2 + * Scalar alpha is zero +*/ +CTEST(saxpby, inc_x_1_inc_y_2_N_100_alpha_zero) +{ + blasint n = DATASIZE, incx = 1, incy = 2; + float alpha = 0.0f; + float beta = 1.0f; + + float norm = check_saxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test saxpby by comparing it with sscal and saxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 1 + * Scalar beta is zero + */ +CTEST(saxpby, inc_x_1_inc_y_1_N_100_beta_zero) +{ + blasint n = DATASIZE, incx = 1, incy = 1; + float alpha = 1.0f; + float beta = 0.0f; + + float norm = check_saxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test saxpby by comparing it with sscal and saxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 1 + * Scalar beta is zero +*/ +CTEST(saxpby, inc_x_2_inc_y_1_N_100_beta_zero) +{ + blasint n = DATASIZE, incx = 2, incy = 1; + float alpha = 1.0f; + float beta = 0.0f; + + float norm = check_saxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test saxpby by comparing it with sscal and saxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 2 + * Scalar beta is zero +*/ +CTEST(saxpby, inc_x_1_inc_y_2_N_100_beta_zero) +{ + blasint n = DATASIZE, incx = 1, incy = 2; + float alpha = 1.0f; + float beta = 0.0f; + + float norm = check_saxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test saxpby by comparing it with sscal and saxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 2 + * Scalar beta is zero +*/ +CTEST(saxpby, inc_x_2_inc_y_2_N_100_beta_zero) +{ + blasint n = DATASIZE, incx = 2, incy = 2; + float alpha = 1.0f; + float beta = 0.0f; + + float norm = check_saxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test saxpby by comparing it with sscal and saxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 1 + * Scalar alpha is zero + * Scalar beta is zero + */ +CTEST(saxpby, inc_x_1_inc_y_1_N_100_alpha_beta_zero) +{ + blasint n = DATASIZE, incx = 1, incy = 1; + float alpha = 0.0f; + float beta = 0.0f; + + float norm = check_saxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test saxpby by comparing it with sscal and saxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 2 + * Scalar alpha is zero + * Scalar beta is zero +*/ +CTEST(saxpby, inc_x_1_inc_y_2_N_100_alpha_beta_zero) +{ + blasint n = DATASIZE, incx = 1, incy = 2; + float alpha = 0.0f; + float beta = 0.0f; + + float norm = check_saxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Check if n - size of vectors x, y is zero + */ +CTEST(saxpby, check_n_zero) +{ + blasint n = 0, incx = 1, incy = 1; + float alpha = 1.0f; + float beta = 1.0f; + + float norm = check_saxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test saxpby by comparing it with sscal and saxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 1 + */ +CTEST(saxpby, c_api_inc_x_1_inc_y_1_N_100) +{ + blasint n = DATASIZE, incx = 1, incy = 1; + float alpha = 1.0f; + float beta = 1.0f; + + float norm = c_api_check_saxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test saxpby by comparing it with sscal and saxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 1 + */ +CTEST(saxpby, c_api_inc_x_2_inc_y_1_N_100) +{ + blasint n = DATASIZE, incx = 2, incy = 1; + float alpha = 2.0f; + float beta = 1.0f; + + float norm = c_api_check_saxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test saxpby by comparing it with sscal and saxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 2 + */ +CTEST(saxpby, c_api_inc_x_1_inc_y_2_N_100) +{ + blasint n = DATASIZE, incx = 1, incy = 2; + float alpha = 1.0f; + float beta = 2.0f; + + float norm = c_api_check_saxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test saxpby by comparing it with sscal and saxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 2 + */ +CTEST(saxpby, c_api_inc_x_2_inc_y_2_N_100) +{ + blasint n = DATASIZE, incx = 2, incy = 2; + float alpha = 3.0f; + float beta = 4.0f; + + float norm = c_api_check_saxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test saxpby by comparing it with sscal and saxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is -1 + * Stride of vector y is 2 + */ +CTEST(saxpby, c_api_inc_x_neg_1_inc_y_2_N_100) +{ + blasint n = DATASIZE, incx = -1, incy = 2; + float alpha = 5.0f; + float beta = 4.0f; + + float norm = c_api_check_saxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test saxpby by comparing it with sscal and saxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is -1 + */ +CTEST(saxpby, c_api_inc_x_2_inc_y_neg_1_N_100) +{ + blasint n = DATASIZE, incx = 2, incy = -1; + float alpha = 1.0f; + float beta = 6.0f; + + float norm = c_api_check_saxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test saxpby by comparing it with sscal and saxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is -2 + * Stride of vector y is -1 + */ +CTEST(saxpby, c_api_inc_x_neg_2_inc_y_neg_1_N_100) +{ + blasint n = DATASIZE, incx = -2, incy = -1; + float alpha = 7.0f; + float beta = 3.5f; + + float norm = c_api_check_saxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test saxpby by comparing it with sscal and saxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 1 + * Scalar alpha is zero + */ +CTEST(saxpby, c_api_inc_x_1_inc_y_1_N_100_alpha_zero) +{ + blasint n = DATASIZE, incx = 1, incy = 1; + float alpha = 0.0f; + float beta = 1.0f; + + float norm = c_api_check_saxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test saxpby by comparing it with sscal and saxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 2 + * Scalar alpha is zero +*/ +CTEST(saxpby, c_api_inc_x_1_inc_y_2_N_100_alpha_zero) +{ + blasint n = DATASIZE, incx = 1, incy = 2; + float alpha = 0.0f; + float beta = 1.0f; + + float norm = c_api_check_saxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test saxpby by comparing it with sscal and saxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 1 + * Scalar beta is zero + */ +CTEST(saxpby, c_api_inc_x_1_inc_y_1_N_100_beta_zero) +{ + blasint n = DATASIZE, incx = 1, incy = 1; + float alpha = 1.0f; + float beta = 0.0f; + + float norm = c_api_check_saxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test saxpby by comparing it with sscal and saxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 1 + * Scalar beta is zero +*/ +CTEST(saxpby, c_api_inc_x_2_inc_y_1_N_100_beta_zero) +{ + blasint n = DATASIZE, incx = 2, incy = 1; + float alpha = 1.0f; + float beta = 0.0f; + + float norm = c_api_check_saxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test saxpby by comparing it with sscal and saxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 2 + * Scalar beta is zero +*/ +CTEST(saxpby, c_api_inc_x_1_inc_y_2_N_100_beta_zero) +{ + blasint n = DATASIZE, incx = 1, incy = 2; + float alpha = 1.0f; + float beta = 0.0f; + + float norm = c_api_check_saxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test saxpby by comparing it with sscal and saxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 2 + * Scalar beta is zero +*/ +CTEST(saxpby, c_api_inc_x_2_inc_y_2_N_100_beta_zero) +{ + blasint n = DATASIZE, incx = 2, incy = 2; + float alpha = 1.0f; + float beta = 0.0f; + + float norm = c_api_check_saxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test saxpby by comparing it with sscal and saxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 1 + * Scalar alpha is zero + * Scalar beta is zero + */ +CTEST(saxpby, c_api_inc_x_1_inc_y_1_N_100_alpha_beta_zero) +{ + blasint n = DATASIZE, incx = 1, incy = 1; + float alpha = 0.0f; + float beta = 0.0f; + + float norm = c_api_check_saxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test saxpby by comparing it with sscal and saxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 2 + * Scalar alpha is zero + * Scalar beta is zero +*/ +CTEST(saxpby, c_api_inc_x_1_inc_y_2_N_100_alpha_beta_zero) +{ + blasint n = DATASIZE, incx = 1, incy = 2; + float alpha = 0.0f; + float beta = 0.0f; + + float norm = c_api_check_saxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Check if n - size of vectors x, y is zero + */ +CTEST(saxpby, c_api_check_n_zero) +{ + blasint n = 0, incx = 1, incy = 1; + float alpha = 1.0f; + float beta = 1.0f; + + float norm = c_api_check_saxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_scamax.c b/utest/test_extensions/test_scamax.c new file mode 100644 index 000000000..39d7201ff --- /dev/null +++ b/utest/test_extensions/test_scamax.c @@ -0,0 +1,294 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. 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. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include + +#define ELEMENTS 70 +#define INCREMENT 2 + +#ifdef BUILD_COMPLEX + +/** + * Test scamax by comparing it against pre-calculated values + */ +CTEST(scamax, bad_args_N_0){ + blasint i; + blasint N = 0, inc = 1; + float x[ELEMENTS * 2]; + for (i = 0; i < ELEMENTS * inc * 2; i ++) { + x[i] = 1000 - i; + } + float amax = BLASFUNC(scamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0f, amax, SINGLE_EPS); +} + +/** + * Test scamax by comparing it against pre-calculated values + */ +CTEST(scamax, step_zero){ + blasint i; + blasint N = ELEMENTS * 2, inc = 0; + float x[ELEMENTS]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = i + 1000; + } + x[8] = 0.0f; + float amax = BLASFUNC(scamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0f, amax, SINGLE_EPS); +} + +/** + * Test scamax by comparing it against pre-calculated values + */ +CTEST(scamax, positive_step_1_N_1){ + blasint N = 1, inc = 1; + float x[] = {1.0f, 2.0f}; + float amax = BLASFUNC(scamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(3.0f, amax, SINGLE_EPS); +} + +/** + * Test scamax by comparing it against pre-calculated values + */ +CTEST(scamax, negative_step_1_N_1){ + blasint N = 1, inc = 1; + float x[] = {-1.0f, -2.0f}; + float amax = BLASFUNC(scamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(3.0f, amax, SINGLE_EPS); +} + +/** + * Test scamax by comparing it against pre-calculated values + */ +CTEST(scamax, positive_step_2_N_1){ + blasint N = 1, inc = 2; + float x[] = {1.0f, 2.0f, 0.0f, 0.0f}; + float amax = BLASFUNC(scamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(3.0f, amax, SINGLE_EPS); +} + +/** + * Test scamax by comparing it against pre-calculated values + */ +CTEST(scamax, negative_step_2_N_1){ + blasint N = 1, inc = 2; + float x[] = {-1.0f, -2.0f, 0.0f, 0.0f}; + float amax = BLASFUNC(scamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(3.0f, amax, SINGLE_EPS); +} + +/** + * Test scamax by comparing it against pre-calculated values + */ +CTEST(scamax, positive_step_1_N_2){ + blasint N = 2, inc = 1; + float x[] = {1.0f, 2.0f, 0.0f, 0.0f}; + float amax = BLASFUNC(scamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(3.0f, amax, SINGLE_EPS); +} + +/** + * Test scamax by comparing it against pre-calculated values + */ +CTEST(scamax, negative_step_1_N_2){ + blasint N = 2, inc = 1; + float x[] = {-1.0f, -2.0f, 0.0f, 0.0f}; + float amax = BLASFUNC(scamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(3.0f, amax, SINGLE_EPS); +} + +/** + * Test scamax by comparing it against pre-calculated values + */ +CTEST(scamax, positive_step_2_N_2){ + blasint N = 2, inc = 2; + float x[] = {1.0f, 2.0f, 0.0f, 0.0f, 1.0f, 1.0f, 0.0f, 0.0f}; + float amax = BLASFUNC(scamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(3.0f, amax, SINGLE_EPS); +} + +/** + * Test scamax by comparing it against pre-calculated values + */ +CTEST(scamax, negative_step_2_N_2){ + blasint N = 2, inc = 2; + float x[] = {-1.0f, -2.0f, 0.0f, 0.0f, -1.0f, -1.0f, 0.0f, 0.0f}; + float amax = BLASFUNC(scamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(3.0f, amax, SINGLE_EPS); +} + +/** + * Test scamax by comparing it against pre-calculated values + */ +CTEST(scamax, positive_step_1_N_3){ + blasint N = 3, inc = 1; + float x[] = {1.0f, 2.0f, 0.0f, 0.0f, 2.0f, 1.0f}; + float amax = BLASFUNC(scamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(3.0f, amax, SINGLE_EPS); +} + +/** + * Test scamax by comparing it against pre-calculated values + */ +CTEST(scamax, negative_step_1_N_3){ + blasint N = 3, inc = 1; + float x[] = {-1.0f, -2.0f, 0.0f, 0.0f, -3.0f, -1.0f}; + float amax = BLASFUNC(scamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(4.0f, amax, SINGLE_EPS); +} + +/** + * Test scamax by comparing it against pre-calculated values + */ +CTEST(scamax, positive_step_2_N_3){ + blasint N = 3, inc = 2; + float x[] = {1.0f, 2.0f, 0.0f, 0.0f, 1.0f, 1.0f, 0.0f, 0.0f, 3.0f, 1.0f, 0.0f, 0.0f}; + float amax = BLASFUNC(scamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(4.0f, amax, SINGLE_EPS); +} + +/** + * Test scamax by comparing it against pre-calculated values + */ +CTEST(scamax, negative_step_2_N_3){ + blasint N = 3, inc = 2; + float x[] = {-1.0f, -2.0f, 0.0f, 0.0f, -1.0f, -1.0f, 0.0f, 0.0f, -3.0f, -1.0f, 0.0f, 0.0f}; + float amax = BLASFUNC(scamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(4.0f, amax, SINGLE_EPS); +} + +/** + * Test scamax by comparing it against pre-calculated values + */ +CTEST(scamax, positive_step_1_N_4){ + blasint N = 4, inc = 1; + float x[] = {1.0f, 2.0f, 0.0f, 0.0f, 2.0f, 1.0f, -2.0f, -2.0f}; + float amax = BLASFUNC(scamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(4.0f, amax, SINGLE_EPS); +} + +/** + * Test scamax by comparing it against pre-calculated values + */ +CTEST(scamax, negative_step_1_N_4){ + blasint N = 4, inc = 1; + float x[] = {-1.0f, -2.0f, 0.0f, 0.0f, -2.0f, -1.0f, -2.0f, -2.0f}; + float amax = BLASFUNC(scamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(4.0f, amax, SINGLE_EPS); +} + +/** + * Test scamax by comparing it against pre-calculated values + */ +CTEST(scamax, positive_step_2_N_4){ + blasint N = 4, inc = 2; + float x[] = {1.0f, 2.0f, 0.0f, 0.0f, 1.0f, 1.0f, 0.0f, 0.0f, 2.0f, 1.0f, 0.0f, 0.0f, -2.0f, -2.0f, 0.0f, 0.0f}; + float amax = BLASFUNC(scamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(4.0f, amax, SINGLE_EPS); +} + +/** + * Test scamax by comparing it against pre-calculated values + */ +CTEST(scamax, negative_step_2_N_4){ + blasint N = 4, inc = 2; + float x[] = {-1.0f, -2.0f, 0.0f, 0.0f, -1.0f, -1.0f, 0.0f, 0.0f, -2.0f, -1.0f, 0.0f, 0.0f, -2.0f, -2.0f, 0.0f, 0.0f}; + float amax = BLASFUNC(scamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(4.0f, amax, SINGLE_EPS); +} + +/** + * Test scamax by comparing it against pre-calculated values + */ +CTEST(scamax, positive_step_1_N_70){ + blasint i; + blasint N = ELEMENTS, inc = 1; + float x[ELEMENTS * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = i; + } + x[7 * inc * 2] = 1000.0f; + x[7 * inc * 2 + 1] = 1000.0f; + float amax = BLASFUNC(scamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(2000.0f, amax, SINGLE_EPS); +} + +/** + * Test scamax by comparing it against pre-calculated values + */ +CTEST(scamax, negative_step_1_N_70){ + blasint i; + blasint N = ELEMENTS, inc = 1; + float x[ELEMENTS * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = -i; + } + x[7 * inc * 2] = 1000.0f; + x[7 * inc * 2 + 1] = 1000.0f; + float amax = BLASFUNC(scamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(2000.0f, amax, SINGLE_EPS); +} + +/** + * Test scamax by comparing it against pre-calculated values + */ +CTEST(scamax, positive_step_2_N_70){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + float x[ELEMENTS * INCREMENT * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = i; + } + x[7 * inc * 2] = 1000.0f; + x[7 * inc * 2 + 1] = 1000.0f; + float amax = BLASFUNC(scamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(2000.0f, amax, SINGLE_EPS); +} + +/** + * Test scamax by comparing it against pre-calculated values + */ +CTEST(scamax, negative_step_2_N_70){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + float x[ELEMENTS * INCREMENT * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = -i; + } + x[7 * inc * 2] = 1000.0f; + x[7 * inc * 2 + 1] = 1000.0f; + float amax = BLASFUNC(scamax)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(2000.0f, amax, SINGLE_EPS); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_scamin.c b/utest/test_extensions/test_scamin.c new file mode 100644 index 000000000..4baa23184 --- /dev/null +++ b/utest/test_extensions/test_scamin.c @@ -0,0 +1,310 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. 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. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include + +#define ELEMENTS 70 +#define INCREMENT 2 + +#ifdef BUILD_COMPLEX + +/** + * Test scamin by comparing it against pre-calculated values + */ +CTEST(scamin, bad_args_N_0){ + blasint i; + blasint N = 0, inc = 1; + float x[ELEMENTS * 2]; + for (i = 0; i < ELEMENTS * inc * 2; i ++) { + x[i] = 1000 - i; + } + float amin = BLASFUNC(scamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0f, amin, SINGLE_EPS); +} + +/** + * Test scamin by comparing it against pre-calculated values + */ +CTEST(scamin, step_zero){ + blasint i; + blasint N = ELEMENTS * 2, inc = 0; + float x[ELEMENTS]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = i + 1000; + } + x[8] = 0.0f; + float amin = BLASFUNC(scamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0f, amin, SINGLE_EPS); +} + +/** + * Test scamin by comparing it against pre-calculated values + */ +CTEST(scamin, positive_step_1_N_1){ + blasint N = 1, inc = 1; + float x[] = {1.0f, 2.0f}; + + float amin = BLASFUNC(scamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(3.0f, amin, SINGLE_EPS); +} + +/** + * Test scamin by comparing it against pre-calculated values + */ +CTEST(scamin, negative_step_1_N_1){ + blasint N = 1, inc = 1; + float x[] = {-1.0f, -2.0f}; + + float amin = BLASFUNC(scamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(3.0f, amin, SINGLE_EPS); +} + +/** + * Test scamin by comparing it against pre-calculated values + */ +CTEST(scamin, positive_step_2_N_1){ + blasint N = 1, inc = 2; + float x[] = {1.0f, 2.0f, 0.0f, 0.0f}; + + float amin = BLASFUNC(scamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(3.0f, amin, SINGLE_EPS); +} + +/** + * Test scamin by comparing it against pre-calculated values + */ +CTEST(scamin, negative_step_2_N_1){ + blasint N = 1, inc = 2; + float x[] = {-1.0f, -2.0f, 0.0f, 0.0f}; + + float amin = BLASFUNC(scamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(3.0f, amin, SINGLE_EPS); +} + +/** + * Test scamin by comparing it against pre-calculated values + */ +CTEST(scamin, positive_step_1_N_2){ + blasint N = 2, inc = 1; + float x[] = {1.0f, 2.0f, 0.0f, 0.0f}; + + float amin = BLASFUNC(scamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0f, amin, SINGLE_EPS); +} + +/** + * Test scamin by comparing it against pre-calculated values + */ +CTEST(scamin, negative_step_1_N_2){ + blasint N = 2, inc = 1; + float x[] = {-1.0f, -2.0f, 0.0f, 0.0f}; + + float amin = BLASFUNC(scamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0f, amin, SINGLE_EPS); +} + +/** + * Test scamin by comparing it against pre-calculated values + */ +CTEST(scamin, positive_step_2_N_2){ + blasint N = 2, inc = 2; + float x[] = {1.0f, 2.0f, 0.0f, 0.0f, 1.0f, 1.0f, 0.0f, 0.0f}; + + float amin = BLASFUNC(scamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(2.0f, amin, SINGLE_EPS); +} + +/** + * Test scamin by comparing it against pre-calculated values + */ +CTEST(scamin, negative_step_2_N_2){ + blasint N = 2, inc = 2; + float x[] = {-1.0f, -2.0f, 0.0f, 0.0f, -1.0f, -1.0f, 0.0f, 0.0f}; + + float amin = BLASFUNC(scamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(2.0f, amin, SINGLE_EPS); +} + +/** + * Test scamin by comparing it against pre-calculated values + */ +CTEST(scamin, positive_step_1_N_3){ + blasint N = 3, inc = 1; + float x[] = {1.0f, 2.0f, 0.0f, 0.0f, 2.0f, 1.0f}; + + float amin = BLASFUNC(scamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0f, amin, SINGLE_EPS); +} + +/** + * Test scamin by comparing it against pre-calculated values + */ +CTEST(scamin, negative_step_1_N_3){ + blasint N = 3, inc = 1; + float x[] = {-1.0f, -2.0f, 0.0f, 0.0f, -2.0f, -1.0f}; + + float amin = BLASFUNC(scamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0f, amin, SINGLE_EPS); +} + +/** + * Test scamin by comparing it against pre-calculated values + */ +CTEST(scamin, positive_step_2_N_3){ + blasint N = 3, inc = 2; + float x[] = {1.0f, 2.0f, 0.0f, 0.0f, 1.0f, 1.0f, 0.0f, 0.0f, 2.0f, 1.0f, 0.0f, 0.0f}; + + float amin = BLASFUNC(scamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(2.0f, amin, SINGLE_EPS); +} + +/** + * Test scamin by comparing it against pre-calculated values + */ +CTEST(scamin, negative_step_2_N_3){ + blasint N = 3, inc = 2; + float x[] = {-1.0f, -2.0f, 0.0f, 0.0f, -1.0f, -1.0f, 0.0f, 0.0f, -2.0f, -1.0f, 0.0f, 0.0f}; + + float amin = BLASFUNC(scamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(2.0f, amin, SINGLE_EPS); +} + +/** + * Test scamin by comparing it against pre-calculated values + */ +CTEST(scamin, positive_step_1_N_4){ + blasint N = 4, inc = 1; + float x[] = {1.0f, 2.0f, 0.0f, 0.0f, 2.0f, 1.0f, -2.0f, -2.0f}; + + float amin = BLASFUNC(scamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0f, amin, SINGLE_EPS); +} + +/** + * Test scamin by comparing it against pre-calculated values + */ +CTEST(scamin, negative_step_1_N_4){ + blasint N = 4, inc = 1; + float x[] = {-1.0f, -2.0f, 0.0f, 0.0f, -2.0f, -1.0f, -2.0f, -2.0f}; + + float amin = BLASFUNC(scamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0f, amin, SINGLE_EPS); +} + +/** + * Test scamin by comparing it against pre-calculated values + */ +CTEST(scamin, positive_step_2_N_4){ + blasint N = 4, inc = 2; + float x[] = {1.0f, 2.0f, 0.0f, 0.0f, 1.0f, 1.0f, 0.0f, 0.0f, 2.0f, 1.0f, 0.0f, 0.0f, -2.0f, -2.0f, 0.0f, 0.0f}; + + float amin = BLASFUNC(scamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(2.0f, amin, SINGLE_EPS); +} + +/** + * Test scamin by comparing it against pre-calculated values + */ +CTEST(scamin, negative_step_2_N_4){ + blasint N = 4, inc = 2; + float x[] = {-1.0f, -2.0f, 0.0f, 0.0f, -1.0f, -1.0f, 0.0f, 0.0f, -2.0f, -1.0f, 0.0f, 0.0f, -2.0f, -2.0f, 0.0f, 0.0f}; + + float amin = BLASFUNC(scamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(2.0f, amin, SINGLE_EPS); +} + +/** + * Test scamin by comparing it against pre-calculated values + */ +CTEST(scamin, positive_step_1_N_70){ + blasint i; + blasint N = ELEMENTS, inc = 1; + float x[ELEMENTS * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = i + 1000; + } + x[7 * inc * 2] = 0.0f; + x[7 * inc * 2 + 1] = 0.0f; + float amin = BLASFUNC(scamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0f, amin, SINGLE_EPS); +} + +/** + * Test scamin by comparing it against pre-calculated values + */ +CTEST(scamin, negative_step_1_N_70){ + blasint i; + blasint N = ELEMENTS, inc = 1; + float x[ELEMENTS * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = - i - 1000; + } + x[7 * inc * 2] = 0.0f; + x[7 * inc * 2 + 1] = 0.0f; + float amin = BLASFUNC(scamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0f, amin, SINGLE_EPS); +} + +/** + * Test scamin by comparing it against pre-calculated values + */ +CTEST(scamin, positive_step_2_N_70){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + float x[ELEMENTS * INCREMENT * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = i + 1000; + } + x[7 * inc * 2] = 0.0f; + x[7 * inc * 2 + 1] = 0.0f; + float amin = BLASFUNC(scamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0f, amin, SINGLE_EPS); +} + +/** + * Test scamin by comparing it against pre-calculated values + */ +CTEST(scamin, negative_step_2_N_70){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + float x[ELEMENTS * INCREMENT * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = - i - 1000; + } + x[7 * inc * 2] = 0.0f; + x[7 * inc * 2 + 1] = 0.0f; + float amin = BLASFUNC(scamin)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0f, amin, SINGLE_EPS); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_scsum.c b/utest/test_extensions/test_scsum.c new file mode 100644 index 000000000..492e1a4ca --- /dev/null +++ b/utest/test_extensions/test_scsum.c @@ -0,0 +1,403 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. 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. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include + +#define ELEMENTS 50 +#define INCREMENT 2 + +#ifdef BUILD_COMPLEX + +/** + * Fortran API specific test + * Test scsum by comparing it against pre-calculated values + */ +CTEST(scsum, bad_args_N_0){ + blasint i; + blasint N = 0, inc = 1; + float x[ELEMENTS * 2]; + for (i = 0; i < ELEMENTS * inc * 2; i ++) { + x[i] = 1000 - i; + } + float sum = BLASFUNC(scsum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0f, sum, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test scsum by comparing it against pre-calculated values + */ +CTEST(scsum, step_zero){ + blasint i; + blasint N = ELEMENTS, inc = 0; + float x[ELEMENTS]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = i + 1000; + } + x[8] = 0.0f; + float sum = BLASFUNC(scsum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0f, sum, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test scsum by comparing it against pre-calculated values + */ +CTEST(scsum, step_1_N_1){ + blasint N = 1, inc = 1; + float x[] = {1.1f, -1.0f}; + + float sum = BLASFUNC(scsum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.1f, sum, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test scsum by comparing it against pre-calculated values + */ +CTEST(scsum, step_2_N_1){ + blasint N = 1, inc = 2; + float x[] = {1.1f, 0.0f, 2.3f, -1.0f}; + + float sum = BLASFUNC(scsum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.1f, sum, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test scsum by comparing it against pre-calculated values + */ +CTEST(scsum, step_1_N_2){ + blasint N = 2, inc = 1; + float x[] = {1.1f, -1.0f, 2.3f, -1.0f}; + + float sum = BLASFUNC(scsum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.4f, sum, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test scsum by comparing it against pre-calculated values + */ +CTEST(scsum, step_2_N_2){ + blasint N = 2, inc = 2; + float x[] = {1.1f, -1.5f, 1.1f, -1.0f, 1.0f, 1.0f, 1.1f, -1.0f}; + + float sum = BLASFUNC(scsum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.6f, sum, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test scsum by comparing it against pre-calculated values + */ +CTEST(scsum, step_1_N_3){ + blasint N = 3, inc = 1; + float x[] = {1.1f, 1.0f, 2.2f, 1.1f, -1.0f, 0.0f}; + + float sum = BLASFUNC(scsum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(4.4f, sum, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test scsum by comparing it against pre-calculated values + */ +CTEST(scsum, step_2_N_3){ + blasint N = 3, inc = 2; + float x[] = {1.1f, 0.0f, -1.0f, 0.0f, -1.0f, -3.0f, -1.0f, 0.0f, 2.2f, 3.0f, -1.0f, 0.0f}; + + float sum = BLASFUNC(scsum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(2.3f, sum, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test scsum by comparing it against pre-calculated values + */ +CTEST(scsum, step_1_N_4){ + blasint N = 4, inc = 1; + float x[] = {1.1f, 1.0f, -2.2f, 3.3f, 1.1f, 1.0f, -2.2f, 3.3f}; + + float sum = BLASFUNC(scsum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(6.4f, sum, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test scsum by comparing it against pre-calculated values + */ +CTEST(scsum, step_2_N_4){ + blasint N = 4, inc = 2; + float x[] = {1.1f, 0.0f, 1.1f, 1.0f, 1.0f, 2.0f, 1.1f, 1.0f, 2.2f, 2.7f, 1.1f, 1.0f, -3.3f, -5.9f}; + + float sum = BLASFUNC(scsum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(-0.2f, sum, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test scsum by comparing it against pre-calculated values + */ +CTEST(scsum, step_1_N_5){ + blasint N = 5, inc = 1; + float x[] = {0.0f, 1.0f, 2.2f, 3.3f, 0.0f, 0.0f, 1.0f, 2.2f, 3.3f, 0.0f}; + + float sum = BLASFUNC(scsum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(13.0f, sum, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test scsum by comparing it against pre-calculated values + */ +CTEST(scsum, step_2_N_5){ + blasint N = 5, inc = 2; + float x[] = {0.0f, 3.0f, 1.0f, 2.2f, 1.0f, -2.2f, 1.0f, 2.2f, 2.2f, -1.7f, 1.0f, 2.2f, 3.3f, 14.5f, 1.0f, 2.2f, 0.0f, -9.0f, 1.0f, 2.2f}; + + float sum = BLASFUNC(scsum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(11.1f, sum, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test scsum by comparing it against pre-calculated values + */ +CTEST(scsum, step_1_N_50){ + blasint i; + blasint N = ELEMENTS, inc = 1; + float x[ELEMENTS * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = (i & 1) ? -1.0f : 1.0f; + } + float sum = BLASFUNC(scsum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0f, sum, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test scsum by comparing it against pre-calculated values + */ +CTEST(scsum, step_2_N_50){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + float x[ELEMENTS * INCREMENT * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = (i & 1) ? -1.0f : 1.0f; + } + float sum = BLASFUNC(scsum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0f, sum, SINGLE_EPS); +} + +/** + * C API specific test + * Test scsum by comparing it against pre-calculated values + */ +CTEST(scsum, c_api_bad_args_N_0){ + blasint i; + blasint N = 0, inc = 1; + float x[ELEMENTS * 2]; + for (i = 0; i < ELEMENTS * inc * 2; i ++) { + x[i] = 1000 - i; + } + float sum = cblas_scsum(N, x, inc); + ASSERT_DBL_NEAR_TOL(0.0f, sum, SINGLE_EPS); +} + +/** + * C API specific test + * Test scsum by comparing it against pre-calculated values + */ +CTEST(scsum, c_api_step_zero){ + blasint i; + blasint N = ELEMENTS, inc = 0; + float x[ELEMENTS]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = i + 1000; + } + x[8] = 0.0f; + float sum = cblas_scsum(N, x, inc); + ASSERT_DBL_NEAR_TOL(0.0f, sum, SINGLE_EPS); +} + +/** + * C API specific test + * Test scsum by comparing it against pre-calculated values + */ +CTEST(scsum, c_api_step_1_N_1){ + blasint N = 1, inc = 1; + float x[] = {1.1f, -1.0f}; + + float sum = cblas_scsum(N, x, inc); + ASSERT_DBL_NEAR_TOL(0.1f, sum, SINGLE_EPS); +} + +/** + * C API specific test + * Test scsum by comparing it against pre-calculated values + */ +CTEST(scsum, c_api_step_2_N_1){ + blasint N = 1, inc = 2; + float x[] = {1.1f, 0.0f, 2.3f, -1.0f}; + + float sum = cblas_scsum(N, x, inc); + ASSERT_DBL_NEAR_TOL(1.1f, sum, SINGLE_EPS); +} + +/** + * C API specific test + * Test scsum by comparing it against pre-calculated values + */ +CTEST(scsum, c_api_step_1_N_2){ + blasint N = 2, inc = 1; + float x[] = {1.1f, -1.0f, 2.3f, -1.0f}; + + float sum = cblas_scsum(N, x, inc); + ASSERT_DBL_NEAR_TOL(1.4f, sum, SINGLE_EPS); +} + +/** + * C API specific test + * Test scsum by comparing it against pre-calculated values + */ +CTEST(scsum, c_api_step_2_N_2){ + blasint N = 2, inc = 2; + float x[] = {1.1f, -1.5f, 1.1f, -1.0f, 1.0f, 1.0f, 1.1f, -1.0f}; + + float sum = cblas_scsum(N, x, inc); + ASSERT_DBL_NEAR_TOL(1.6f, sum, SINGLE_EPS); +} + +/** + * C API specific test + * Test scsum by comparing it against pre-calculated values + */ +CTEST(scsum, c_api_step_1_N_3){ + blasint N = 3, inc = 1; + float x[] = {1.1f, 1.0f, 2.2f, 1.1f, -1.0f, 0.0f}; + + float sum = cblas_scsum(N, x, inc); + ASSERT_DBL_NEAR_TOL(4.4f, sum, SINGLE_EPS); +} + +/** + * C API specific test + * Test scsum by comparing it against pre-calculated values + */ +CTEST(scsum, c_api_step_2_N_3){ + blasint N = 3, inc = 2; + float x[] = {1.1f, 0.0f, -1.0f, 0.0f, -1.0f, -3.0f, -1.0f, 0.0f, 2.2f, 3.0f, -1.0f, 0.0f}; + + float sum = cblas_scsum(N, x, inc); + ASSERT_DBL_NEAR_TOL(2.3f, sum, SINGLE_EPS); +} + +/** + * C API specific test + * Test scsum by comparing it against pre-calculated values + */ +CTEST(scsum, c_api_step_1_N_4){ + blasint N = 4, inc = 1; + float x[] = {1.1f, 1.0f, -2.2f, 3.3f, 1.1f, 1.0f, -2.2f, 3.3f}; + + float sum = cblas_scsum(N, x, inc); + ASSERT_DBL_NEAR_TOL(6.4f, sum, SINGLE_EPS); +} + +/** + * C API specific test + * Test scsum by comparing it against pre-calculated values + */ +CTEST(scsum, c_api_step_2_N_4){ + blasint N = 4, inc = 2; + float x[] = {1.1f, 0.0f, 1.1f, 1.0f, 1.0f, 2.0f, 1.1f, 1.0f, 2.2f, 2.7f, 1.1f, 1.0f, -3.3f, -5.9f}; + + float sum = cblas_scsum(N, x, inc); + ASSERT_DBL_NEAR_TOL(-0.2f, sum, SINGLE_EPS); +} + +/** + * C API specific test + * Test scsum by comparing it against pre-calculated values + */ +CTEST(scsum, c_api_step_1_N_5){ + blasint N = 5, inc = 1; + float x[] = {0.0f, 1.0f, 2.2f, 3.3f, 0.0f, 0.0f, 1.0f, 2.2f, 3.3f, 0.0f}; + + float sum = cblas_scsum(N, x, inc); + ASSERT_DBL_NEAR_TOL(13.0f, sum, SINGLE_EPS); +} + +/** + * C API specific test + * Test scsum by comparing it against pre-calculated values + */ +CTEST(scsum, c_api_step_2_N_5){ + blasint N = 5, inc = 2; + float x[] = {0.0f, 3.0f, 1.0f, 2.2f, 1.0f, -2.2f, 1.0f, 2.2f, 2.2f, -1.7f, 1.0f, 2.2f, 3.3f, 14.5f, 1.0f, 2.2f, 0.0f, -9.0f, 1.0f, 2.2f}; + + float sum = cblas_scsum(N, x, inc); + ASSERT_DBL_NEAR_TOL(11.1f, sum, SINGLE_EPS); +} + +/** + * C API specific test + * Test scsum by comparing it against pre-calculated values + */ +CTEST(scsum, c_api_step_1_N_50){ + blasint i; + blasint N = ELEMENTS, inc = 1; + float x[ELEMENTS * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = (i & 1) ? -1.0f : 1.0f; + } + float sum = cblas_scsum(N, x, inc); + ASSERT_DBL_NEAR_TOL(0.0f, sum, SINGLE_EPS); +} + +/** + * C API specific test + * Test scsum by comparing it against pre-calculated values + */ +CTEST(scsum, c_api_step_2_N_50){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + float x[ELEMENTS * INCREMENT * 2]; + for (i = 0; i < N * inc * 2; i ++) { + x[i] = (i & 1) ? -1.0f : 1.0f; + } + float sum = cblas_scsum(N, x, inc); + ASSERT_DBL_NEAR_TOL(0.0f, sum, SINGLE_EPS); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_sgeadd.c b/utest/test_extensions/test_sgeadd.c new file mode 100644 index 000000000..b42ce9c0e --- /dev/null +++ b/utest/test_extensions/test_sgeadd.c @@ -0,0 +1,880 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. 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. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include "common.h" + +#define N 100 +#define M 100 + +struct DATA_SGEADD +{ + float a_test[M * N]; + float c_test[M * N]; + float c_verify[M * N]; +}; + +#ifdef BUILD_SINGLE +static struct DATA_SGEADD data_sgeadd; + +/** + * sgeadd reference implementation + * + * param m - number of rows of A and C + * param n - number of columns of A and C + * param alpha - scaling factor for matrix A + * param aptr - refer to matrix A + * param lda - leading dimension of A + * param beta - scaling factor for matrix C + * param cptr - refer to matrix C + * param ldc - leading dimension of C + */ +static void sgeadd_trusted(blasint m, blasint n, float alpha, float *aptr, + blasint lda, float beta, float *cptr, blasint ldc) +{ + blasint i; + + for (i = 0; i < n; i++) + { + cblas_saxpby(m, alpha, aptr, 1, beta, cptr, 1); + aptr += lda; + cptr += ldc; + } +} + +/** + * Test sgeadd by comparing it against reference + * Compare with the following options: + * + * param api - specifies Fortran or C API + * param order - specifies whether A and C stored in + * row-major order or column-major order + * param m - number of rows of A and C + * param n - number of columns of A and C + * param alpha - scaling factor for matrix A + * param lda - leading dimension of A + * param beta - scaling factor for matrix C + * param ldc - leading dimension of C + * return norm of differences + */ +static float check_sgeadd(char api, OPENBLAS_CONST enum CBLAS_ORDER order, + blasint m, blasint n, float alpha, blasint lda, + float beta, blasint ldc) +{ + blasint i; + blasint cols = m, rows = n; + + if (order == CblasRowMajor) + { + rows = m; + cols = n; + } + + // Fill matrix A, C + srand_generate(data_sgeadd.a_test, lda * rows); + srand_generate(data_sgeadd.c_test, ldc * rows); + + // Copy matrix C for sgeadd + for (i = 0; i < ldc * rows; i++) + data_sgeadd.c_verify[i] = data_sgeadd.c_test[i]; + + sgeadd_trusted(cols, rows, alpha, data_sgeadd.a_test, lda, + beta, data_sgeadd.c_verify, ldc); + + if (api == 'F') + BLASFUNC(sgeadd) + (&m, &n, &alpha, data_sgeadd.a_test, &lda, + &beta, data_sgeadd.c_test, &ldc); + else + cblas_sgeadd(order, m, n, alpha, data_sgeadd.a_test, lda, + beta, data_sgeadd.c_test, ldc); + + // Find the differences between output matrix caculated by sgeadd and sgemm + return smatrix_difference(data_sgeadd.c_test, data_sgeadd.c_verify, cols, rows, ldc); +} + +/** + * Check if error function was called with expected function name + * and param info + * + * param api - specifies Fortran or C API + * param order - specifies whether A and C stored in + * row-major order or column-major order + * param m - number of rows of A and C + * param n - number of columns of A and C + * param lda - leading dimension of A + * param ldc - leading dimension of C + * param expected_info - expected invalid parameter number in sgeadd + * return TRUE if everything is ok, otherwise FALSE + */ +static int check_badargs(char api, OPENBLAS_CONST enum CBLAS_ORDER order, + blasint m, blasint n, blasint lda, + blasint ldc, int expected_info) +{ + float alpha = 1.0f; + float beta = 1.0f; + + set_xerbla("SGEADD ", expected_info); + + if (api == 'F') + BLASFUNC(sgeadd) + (&m, &n, &alpha, data_sgeadd.a_test, &lda, + &beta, data_sgeadd.c_test, &ldc); + else + cblas_sgeadd(order, m, n, alpha, data_sgeadd.a_test, lda, + beta, data_sgeadd.c_test, ldc); + + return check_error(); +} + +/** + * Fortran API specific test + * Test sgeadd by comparing it against reference + * with the following options: + * + * For A number of rows is 100, number of colums is 100 + * For C number of rows is 100, number of colums is 100 + */ +CTEST(sgeadd, matrix_n_100_m_100) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = N; + blasint m = M; + + blasint lda = m; + blasint ldc = m; + + float alpha = 3.0f; + float beta = 3.0f; + + float norm = check_sgeadd('F', order, m, n, alpha, lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test sgeadd by comparing it against reference + * with the following options: + * + * For A number of rows is 100, number of colums is 100 + * For C number of rows is 100, number of colums is 100 + * Scalar alpha is zero (operation is C:=beta*C) + */ +CTEST(sgeadd, matrix_n_100_m_100_alpha_zero) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = N; + blasint m = M; + + blasint lda = m; + blasint ldc = m; + + float alpha = 0.0f; + float beta = 2.5f; + + float norm = check_sgeadd('F', order, m, n, alpha, lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test sgeadd by comparing it against reference + * with the following options: + * + * For A number of rows is 100, number of colums is 100 + * For C number of rows is 100, number of colums is 100 + * Scalar beta is zero (operation is C:=alpha*A) + */ +CTEST(sgeadd, matrix_n_100_m_100_beta_zero) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = N; + blasint m = M; + + blasint lda = m; + blasint ldc = m; + + float alpha = 3.0f; + float beta = 0.0f; + + float norm = check_sgeadd('F', order, m, n, alpha, lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test sgeadd by comparing it against reference + * with the following options: + * + * For A number of rows is 100, number of colums is 100 + * For C number of rows is 100, number of colums is 100 + * Scalars alpha, beta is zero (operation is C:= 0) + */ +CTEST(sgeadd, matrix_n_100_m_100_alpha_beta_zero) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = N; + blasint m = M; + + blasint lda = m; + blasint ldc = m; + + float alpha = 0.0f; + float beta = 0.0f; + + float norm = check_sgeadd('F', order, m, n, alpha, lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test sgeadd by comparing it against reference + * with the following options: + * + * For A number of rows is 50, number of colums is 100 + * For C number of rows is 50, number of colums is 100 + */ +CTEST(sgeadd, matrix_n_100_m_50) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = N; + blasint m = M / 2; + + blasint lda = m; + blasint ldc = m; + + float alpha = 1.0f; + float beta = 1.0f; + + float norm = check_sgeadd('F', order, m, n, alpha, lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test error function for an invalid param n - + * number of columns of A and C + * Must be at least zero. + */ +CTEST(sgeadd, xerbla_n_invalid) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = INVALID; + blasint m = 1; + + blasint lda = m; + blasint ldc = m; + + int expected_info = 2; + + int passed = check_badargs('F', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param m - + * number of rows of A and C + * Must be at least zero. + */ +CTEST(sgeadd, xerbla_m_invalid) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = 1; + blasint m = INVALID; + + blasint lda = 1; + blasint ldc = 1; + + int expected_info = 1; + + int passed = check_badargs('F', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param lda - + * specifies the leading dimension of A. Must be at least MAX(1, m). + */ +CTEST(sgeadd, xerbla_lda_invalid) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = 1; + blasint m = 1; + + blasint lda = INVALID; + blasint ldc = 1; + + int expected_info = 6; + + int passed = check_badargs('F', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param ldc - + * specifies the leading dimension of C. Must be at least MAX(1, m). + */ +CTEST(sgeadd, xerbla_ldc_invalid) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = 1; + blasint m = 1; + + blasint lda = 1; + blasint ldc = INVALID; + + int expected_info = 8; + + int passed = check_badargs('F', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Check if n - number of columns of A, C equal zero. + */ +CTEST(sgeadd, n_zero) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = 0; + blasint m = 1; + + blasint lda = 1; + blasint ldc = 1; + + float alpha = 1.0f; + float beta = 1.0f; + + float norm = check_sgeadd('F', order, m, n, alpha, lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Check if m - number of rows of A and C equal zero. + */ +CTEST(sgeadd, m_zero) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = 1; + blasint m = 0; + + blasint lda = 1; + blasint ldc = 1; + + float alpha = 1.0f; + float beta = 1.0f; + + float norm = check_sgeadd('F', order, m, n, alpha, lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test sgeadd by comparing it against reference + * with the following options: + * + * c api option order is column-major order + * For A number of rows is 100, number of colums is 100 + * For C number of rows is 100, number of colums is 100 + */ +CTEST(sgeadd, c_api_matrix_n_100_m_100) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = N; + blasint m = M; + + blasint lda = m; + blasint ldc = m; + + float alpha = 2.0f; + float beta = 3.0f; + + float norm = check_sgeadd('C', order, m, n, alpha, + lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test sgeadd by comparing it against reference + * with the following options: + * + * c api option order is row-major order + * For A number of rows is 100, number of colums is 100 + * For C number of rows is 100, number of colums is 100 + */ +CTEST(sgeadd, c_api_matrix_n_100_m_100_row_major) +{ + CBLAS_ORDER order = CblasRowMajor; + + blasint n = N; + blasint m = M; + + blasint lda = m; + blasint ldc = m; + + float alpha = 4.0f; + float beta = 2.0f; + + float norm = check_sgeadd('C', order, m, n, alpha, + lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test sgeadd by comparing it against reference + * with the following options: + * + * c api option order is row-major order + * For A number of rows is 50, number of colums is 100 + * For C number of rows is 50, number of colums is 100 + */ +CTEST(sgeadd, c_api_matrix_n_50_m_100_row_major) +{ + CBLAS_ORDER order = CblasRowMajor; + + blasint n = N / 2; + blasint m = M; + + blasint lda = n; + blasint ldc = n; + + float alpha = 3.0f; + float beta = 1.0f; + + float norm = check_sgeadd('C', order, m, n, alpha, + lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test sgeadd by comparing it against reference + * with the following options: + * + * c api option order is column-major order + * For A number of rows is 100, number of colums is 100 + * For C number of rows is 100, number of colums is 100 + * Scalar alpha is zero (operation is C:=beta*C) + */ +CTEST(sgeadd, c_api_matrix_n_100_m_100_alpha_zero) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = N; + blasint m = M; + + blasint lda = m; + blasint ldc = m; + + float alpha = 0.0f; + float beta = 1.0f; + + float norm = check_sgeadd('C', order, m, n, alpha, + lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test sgeadd by comparing it against reference + * with the following options: + * + * c api option order is column-major order + * For A number of rows is 100, number of colums is 100 + * For C number of rows is 100, number of colums is 100 + * Scalar beta is zero (operation is C:=alpha*A) + */ +CTEST(sgeadd, c_api_matrix_n_100_m_100_beta_zero) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = N; + blasint m = M; + + blasint lda = m; + blasint ldc = m; + + float alpha = 3.0f; + float beta = 0.0f; + + float norm = check_sgeadd('C', order, m, n, alpha, + lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test sgeadd by comparing it against reference + * with the following options: + * + * c api option order is column-major order + * For A number of rows is 100, number of colums is 100 + * For C number of rows is 100, number of colums is 100 + * Scalars alpha, beta is zero (operation is C:= 0) + */ +CTEST(sgeadd, c_api_matrix_n_100_m_100_alpha_beta_zero) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = N; + blasint m = M; + + blasint lda = m; + blasint ldc = m; + + float alpha = 0.0f; + float beta = 0.0f; + + float norm = check_sgeadd('C', order, m, n, alpha, + lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test sgeadd by comparing it against reference + * with the following options: + * + * For A number of rows is 50, number of colums is 100 + * For C number of rows is 50, number of colums is 100 + */ +CTEST(sgeadd, c_api_matrix_n_100_m_50) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = N; + blasint m = M / 2; + + blasint lda = m; + blasint ldc = m; + + float alpha = 3.0f; + float beta = 4.0f; + + float norm = check_sgeadd('C', order, m, n, alpha, + lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test error function for an invalid param order - + * specifies whether A and C stored in + * row-major order or column-major order + */ +CTEST(sgeadd, c_api_xerbla_invalid_order) +{ + CBLAS_ORDER order = INVALID; + + blasint n = 1; + blasint m = 1; + + blasint lda = 1; + blasint ldc = 1; + + int expected_info = 0; + + int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param n - + * number of columns of A and C. + * Must be at least zero. + * + * c api option order is column-major order + */ +CTEST(sgeadd, c_api_xerbla_n_invalid) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = INVALID; + blasint m = 1; + + blasint lda = 1; + blasint ldc = 1; + + int expected_info = 2; + + int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param n - + * number of columns of A and C. + * Must be at least zero. + * + * c api option order is row-major order + */ +CTEST(sgeadd, c_api_xerbla_n_invalid_row_major) +{ + CBLAS_ORDER order = CblasRowMajor; + + blasint n = INVALID; + blasint m = 1; + + blasint lda = 1; + blasint ldc = 1; + + int expected_info = 1; + + int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param m - + * number of rows of A and C + * Must be at least zero. + * + * c api option order is column-major order + */ +CTEST(sgeadd, c_api_xerbla_m_invalid) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = 1; + blasint m = INVALID; + + blasint lda = 1; + blasint ldc = 1; + + int expected_info = 1; + + int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param m - + * number of rows of A and C + * Must be at least zero. + * + * c api option order is row-major order + */ +CTEST(sgeadd, c_api_xerbla_m_invalid_row_major) +{ + CBLAS_ORDER order = CblasRowMajor; + + blasint n = 1; + blasint m = INVALID; + + blasint lda = 1; + blasint ldc = 1; + + int expected_info = 2; + + int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param lda - + * specifies the leading dimension of A. Must be at least MAX(1, m). + * + * c api option order is column-major order + */ +CTEST(sgeadd, c_api_xerbla_lda_invalid) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = 1; + blasint m = 1; + + blasint lda = INVALID; + blasint ldc = 1; + + int expected_info = 5; + + int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param lda - + * specifies the leading dimension of A. Must be at least MAX(1, m). + * + * c api option order is row-major order + */ +CTEST(sgeadd, c_api_xerbla_lda_invalid_row_major) +{ + CBLAS_ORDER order = CblasRowMajor; + + blasint n = 1; + blasint m = 1; + + blasint lda = INVALID; + blasint ldc = 1; + + int expected_info = 5; + + int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param ldc - + * specifies the leading dimension of C. Must be at least MAX(1, m). + * + * c api option order is column-major order + */ +CTEST(sgeadd, c_api_xerbla_ldc_invalid) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = 1; + blasint m = 1; + + blasint lda = 1; + blasint ldc = INVALID; + + int expected_info = 8; + + int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param ldc - + * specifies the leading dimension of C. Must be at least MAX(1, m). + * + * c api option order is row-major order + */ +CTEST(sgeadd, c_api_xerbla_ldc_invalid_row_major) +{ + CBLAS_ORDER order = CblasRowMajor; + + blasint n = 1; + blasint m = 1; + + blasint lda = 1; + blasint ldc = INVALID; + + int expected_info = 8; + + int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Check if n - number of columns of A, C equal zero. + * + * c api option order is column-major order + */ +CTEST(sgeadd, c_api_n_zero) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = 0; + blasint m = 1; + + blasint lda = 1; + blasint ldc = 1; + + float alpha = 1.0f; + float beta = 1.0f; + + float norm = check_sgeadd('C', order, m, n, alpha, + lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Check if m - number of rows of A and C equal zero. + * + * c api option order is column-major order + */ +CTEST(sgeadd, c_api_m_zero) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = 1; + blasint m = 0; + + blasint lda = 1; + blasint ldc = 1; + + float alpha = 1.0f; + float beta = 1.0f; + + float norm = check_sgeadd('C', order, m, n, alpha, + lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_sgemmt.c b/utest/test_extensions/test_sgemmt.c new file mode 100644 index 000000000..5b51e3579 --- /dev/null +++ b/utest/test_extensions/test_sgemmt.c @@ -0,0 +1,1442 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. 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. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include "common.h" + +#define DATASIZE 100 + +struct DATA_SGEMMT { + float a_test[DATASIZE * DATASIZE]; + float b_test[DATASIZE * DATASIZE]; + float c_test[DATASIZE * DATASIZE]; + float c_verify[DATASIZE * DATASIZE]; + float c_gemm[DATASIZE * DATASIZE]; +}; + +#ifdef BUILD_SINGLE +static struct DATA_SGEMMT data_sgemmt; + +/** + * Compute gemmt via gemm since gemmt is gemm but updates only + * the upper or lower triangular part of the result matrix + * + * param api specifies tested api (C or Fortran) + * param order specifies row or column major order (for Fortran API column major always) + * param uplo specifies whether C’s data is stored in its upper or lower triangle + * param transa specifies op(A), the transposition operation applied to A + * param transb specifies op(B), the transposition operation applied to B + * param m - number of rows of op(A), columns of op(B), and columns and rows of C + * param k - number of columns of op(A) and rows of op(B) + * param alpha - scaling factor for the matrix-matrix product + * param lda - leading dimension of A + * param ldb - leading dimension of B + * param beta - scaling factor for matrix C + * param ldc - leading dimension of C + */ +static void sgemmt_trusted(char api, enum CBLAS_ORDER order, char uplo, char transa, + char transb, blasint m, blasint k, float alpha, blasint lda, + blasint ldb, float beta, blasint ldc) +{ + blasint i, j; + + if(api == 'F') + BLASFUNC(sgemm)(&transa, &transb, &m, &m, &k, &alpha, data_sgemmt.a_test, &lda, + data_sgemmt.b_test, &ldb, &beta, data_sgemmt.c_gemm, &ldc); + else + cblas_sgemm(order, transa, transb, m, m, k, alpha, data_sgemmt.a_test, lda, + data_sgemmt.b_test, ldb, beta, data_sgemmt.c_gemm, ldc); + + if (uplo == 'L' || uplo == CblasLower) + { + for (i = 0; i < m; i++) + for (j = i; j < m; j++) + data_sgemmt.c_verify[i * ldc + j] = + data_sgemmt.c_gemm[i * ldc + j]; + } else { + for (i = 0; i < m; i++) + for (j = 0; j <= i; j++) + data_sgemmt.c_verify[i * ldc + j] = + data_sgemmt.c_gemm[i * ldc + j]; + } +} + +/** + * Comapare results computed by sgemmt and sgemmt_trusted + * + * param api specifies tested api (C or Fortran) + * param order specifies row or column major order (for Fortran API column major always) + * param uplo specifies whether C’s data is stored in its upper or lower triangle + * param transa specifies op(A), the transposition operation applied to A + * param transb specifies op(B), the transposition operation applied to B + * param m - number of rows of op(A), columns of op(B), and columns and rows of C + * param k - number of columns of op(A) and rows of op(B) + * param alpha - scaling factor for the matrix-matrix product + * param lda - leading dimension of A + * param ldb - leading dimension of B + * param beta - scaling factor for matrix C + * param ldc - leading dimension of C + * return norm of differences + */ +static float check_sgemmt(char api, enum CBLAS_ORDER order, char uplo, char transa, + char transb, blasint m, blasint k, float alpha, blasint lda, + blasint ldb, float beta, blasint ldc) +{ + blasint i; + blasint b_cols; + blasint a_cols; + blasint inc = 1; + blasint size_c = m * ldc; + + if(order == CblasColMajor){ + if (transa == 'T' || transa == 'C' || + transa == CblasTrans || transa == CblasConjTrans) + a_cols = m; + else a_cols = k; + + if (transb == 'T' || transb == 'C' || + transb == CblasTrans || transb == CblasConjTrans) + b_cols = k; + else b_cols = m; + } else { + if (transa == 'T' || transa == 'C' || + transa == CblasTrans || transa == CblasConjTrans) + a_cols = k; + else a_cols = m; + + if (transb == 'T' || transb == 'C' || + transb == CblasTrans || transb == CblasConjTrans) + b_cols = m; + else b_cols = k; + } + + srand_generate(data_sgemmt.a_test, a_cols * lda); + srand_generate(data_sgemmt.b_test, b_cols * ldb); + srand_generate(data_sgemmt.c_test, m * ldc); + + for (i = 0; i < m * ldc; i++) + data_sgemmt.c_gemm[i] = data_sgemmt.c_verify[i] = data_sgemmt.c_test[i]; + + sgemmt_trusted(api, order, uplo, transa, transb, m, k, alpha, lda, ldb, beta, ldc); + + if (api == 'F') + BLASFUNC(sgemmt)(&uplo, &transa, &transb, &m, &k, &alpha, data_sgemmt.a_test, + &lda, data_sgemmt.b_test, &ldb, &beta, data_sgemmt.c_test, &ldc); + else + cblas_sgemmt(order, uplo, transa, transb, m, k, alpha, data_sgemmt.a_test, lda, + data_sgemmt.b_test, ldb, beta, data_sgemmt.c_test, ldc); + + for (i = 0; i < m * ldc; i++) + data_sgemmt.c_verify[i] -= data_sgemmt.c_test[i]; + + return BLASFUNC(snrm2)(&size_c, data_sgemmt.c_verify, &inc) / size_c; +} + +/** + * Check if error function was called with expected function name + * and param info + * + * param uplo specifies whether C’s data is stored in its upper or lower triangle + * param transa specifies op(A), the transposition operation applied to A + * param transb specifies op(B), the transposition operation applied to B + * param m - number of rows of op(A), columns of op(B), and columns and rows of C + * param k - number of columns of op(A) and rows of op(B) + * param lda - leading dimension of A + * param ldb - leading dimension of B + * param ldc - leading dimension of C + * param expected_info - expected invalid parameter number in sgemmt + * return TRUE if everything is ok, otherwise FALSE + */ +static int check_badargs(char api, enum CBLAS_ORDER order, char uplo, char transa, + char transb, blasint m, blasint k, blasint lda, blasint ldb, + blasint ldc, int expected_info) +{ + float alpha = 1.0f; + float beta = 0.0f; + + set_xerbla("SGEMMT ", expected_info); + + if (api == 'F') + BLASFUNC(sgemmt)(&uplo, &transa, &transb, &m, &k, &alpha, data_sgemmt.a_test, + &lda, data_sgemmt.b_test, &ldb, &beta, data_sgemmt.c_test, &ldc); + else + cblas_sgemmt(order, uplo, transa, transb, m, k, alpha, data_sgemmt.a_test, lda, + data_sgemmt.b_test, ldb, beta, data_sgemmt.c_test, ldc); + + return check_error(); +} + +/** + * Fortran API specific test + * Test sgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its upper triangle part + * A not transposed + * B not transposed + */ +CTEST(sgemmt, upper_M_50_K_50_a_notrans_b_notrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'N'; + char uplo = 'U'; + float alpha = 1.5f; + float beta = 2.0f; + + float norm = check_sgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test sgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its upper triangle part + * A transposed + * B not transposed + */ +CTEST(sgemmt, upper_M_100_K_50_a_trans_b_notrans) +{ + blasint M = 100, K = 50; + blasint lda = 50, ldb = 50, ldc = 100; + char transa = 'T', transb = 'N'; + char uplo = 'U'; + float alpha = 1.0f; + float beta = 2.0f; + + float norm = check_sgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test sgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its upper triangle part + * A not transposed + * B transposed + */ +CTEST(sgemmt, upper_M_50_K_100_a_notrans_b_trans) +{ + blasint M = 50, K = 100; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'T'; + char uplo = 'U'; + float alpha = 1.0f; + float beta = 0.0f; + + float norm = check_sgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test sgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its upper triangle part + * A transposed + * B transposed + */ +CTEST(sgemmt, upper_M_50_K_50_a_trans_b_trans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'T', transb = 'T'; + char uplo = 'U'; + float alpha = 1.5f; + float beta = 2.0f; + + float norm = check_sgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test sgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its upper triangle part + * alpha = 0.0 + */ +CTEST(sgemmt, upper_alpha_zero) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'N'; + char uplo = 'U'; + float alpha = 0.0f; + float beta = 2.0f; + + float norm = check_sgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test sgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its upper triangle part + * beta = 1.0 + */ +CTEST(sgemmt, upper_beta_one) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'N'; + char uplo = 'U'; + float alpha = 2.0f; + float beta = 1.0f; + + float norm = check_sgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test sgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its lower triangle part + * A not transposed + * B not transposed + */ +CTEST(sgemmt, lower_M_50_K_50_a_notrans_b_notrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'N'; + char uplo = 'L'; + float alpha = 1.5f; + float beta = 2.0f; + + float norm = check_sgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test sgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its lower triangle part + * A transposed + * B not transposed + */ +CTEST(sgemmt, lower_M_100_K_50_a_trans_b_notrans) +{ + blasint M = 100, K = 50; + blasint lda = 50, ldb = 50, ldc = 100; + char transa = 'T', transb = 'N'; + char uplo = 'L'; + float alpha = 1.0f; + float beta = 2.0f; + + float norm = check_sgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test sgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its lower triangle part + * A not transposed + * B transposed + */ +CTEST(sgemmt, lower_M_50_K_100_a_notrans_b_trans) +{ + blasint M = 50, K = 100; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'T'; + char uplo = 'L'; + float alpha = 1.0f; + float beta = 0.0f; + + float norm = check_sgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test sgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its lower triangle part + * A transposed + * B transposed + */ +CTEST(sgemmt, lower_M_50_K_50_a_trans_b_trans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'T', transb = 'T'; + char uplo = 'L'; + float alpha = 1.5f; + float beta = 2.0f; + + float norm = check_sgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test sgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its lower triangle part + * alpha = 0.0 + */ +CTEST(sgemmt, lower_alpha_zero) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'N'; + char uplo = 'L'; + float alpha = 0.0f; + float beta = 2.0f; + + float norm = check_sgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test sgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its lower triangle part + * beta = 1.0 + */ +CTEST(sgemmt, lower_beta_one) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'N'; + char uplo = 'L'; + float alpha = 2.0f; + float beta = 1.0f; + + float norm = check_sgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test sgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its upper triangle part + * A not transposed + * B not transposed + */ +CTEST(sgemmt, c_api_colmajor_upper_M_50_K_50_a_notrans_b_notrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha = 1.5f; + float beta = 2.0f; + + float norm = check_sgemmt('C', CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test sgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its upper triangle part + * A transposed + * B not transposed + */ +CTEST(sgemmt, c_api_colmajor_upper_M_100_K_50_a_trans_b_notrans) +{ + blasint M = 100, K = 50; + blasint lda = 50, ldb = 50, ldc = 100; + float alpha = 1.0f; + float beta = 2.0f; + + float norm = check_sgemmt('C', CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test sgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its upper triangle part + * A not transposed + * B transposed + */ +CTEST(sgemmt, c_api_colmajor_upper_M_50_K_100_a_notrans_b_trans) +{ + blasint M = 50, K = 100; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha = 1.0f; + float beta = 0.0f; + + float norm = check_sgemmt('C', CblasColMajor, CblasUpper, CblasNoTrans, CblasTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test sgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its upper triangle part + * A transposed + * B transposed + */ +CTEST(sgemmt, c_api_colmajor_upper_M_50_K_50_a_trans_b_trans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha = 1.5f; + float beta = 2.0f; + + float norm = check_sgemmt('C', CblasColMajor, CblasUpper, CblasTrans, CblasTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test sgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its upper triangle part + * alpha = 0.0 + */ +CTEST(sgemmt, c_api_colmajor_upper_alpha_zero) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha = 0.0f; + float beta = 2.0f; + + float norm = check_sgemmt('C', CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test sgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its upper triangle part + * beta = 1.0 + */ +CTEST(sgemmt, c_api_colmajor_upper_beta_one) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha = 2.0f; + float beta = 1.0f; + + float norm = check_sgemmt('C', CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test sgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its lower triangle part + * A not transposed + * B not transposed + */ +CTEST(sgemmt, c_api_colmajor_lower_M_50_K_50_a_notrans_b_notrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha = 1.5f; + float beta = 2.0f; + + float norm = check_sgemmt('C', CblasColMajor, CblasLower, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test sgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its lower triangle part + * A transposed + * B not transposed + */ +CTEST(sgemmt, c_api_colmajor_lower_M_100_K_50_a_trans_b_notrans) +{ + blasint M = 100, K = 50; + blasint lda = 50, ldb = 50, ldc = 100; + float alpha = 1.0f; + float beta = 2.0f; + + float norm = check_sgemmt('C', CblasColMajor, CblasLower, CblasTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test sgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its lower triangle part + * A not transposed + * B transposed + */ +CTEST(sgemmt, c_api_colmajor_lower_M_50_K_100_a_notrans_b_trans) +{ + blasint M = 50, K = 100; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha = 1.0f; + float beta = 0.0f; + + float norm = check_sgemmt('C', CblasColMajor, CblasLower, CblasNoTrans, CblasTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test sgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its lower triangle part + * A transposed + * B transposed + */ +CTEST(sgemmt, c_api_colmajor_lower_M_50_K_50_a_trans_b_trans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha = 1.5f; + float beta = 2.0f; + + float norm = check_sgemmt('C', CblasColMajor, CblasLower, CblasTrans, CblasTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test sgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its lower triangle part + * alpha = 0.0 + */ +CTEST(sgemmt, c_api_colmajor_lower_alpha_zero) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha = 0.0f; + float beta = 2.0f; + + float norm = check_sgemmt('C', CblasColMajor, CblasLower, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test sgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its lower triangle part + * beta = 1.0 + */ +CTEST(sgemmt, c_api_colmajor_lower_beta_one) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha = 2.0f; + float beta = 1.0f; + + float norm = check_sgemmt('C', CblasColMajor, CblasLower, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test sgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its upper triangle part + * A not transposed + * B not transposed + */ +CTEST(sgemmt, c_api_rowmajor_upper_M_50_K_50_a_notrans_b_notrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha = 1.5f; + float beta = 2.0f; + + float norm = check_sgemmt('C', CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test sgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its upper triangle part + * A transposed + * B not transposed + */ +CTEST(sgemmt, c_api_rowmajor_upper_M_100_K_50_a_trans_b_notrans) +{ + blasint M = 100, K = 50; + blasint lda = 100, ldb = 100, ldc = 100; + float alpha = 1.0f; + float beta = 2.0f; + + float norm = check_sgemmt('C', CblasRowMajor, CblasUpper, CblasTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test sgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its upper triangle part + * A not transposed + * B transposed + */ +CTEST(sgemmt, c_api_rowmajor_upper_M_50_K_100_a_notrans_b_trans) +{ + blasint M = 50, K = 100; + blasint lda = 100, ldb = 100, ldc = 50; + float alpha = 1.0f; + float beta = 0.0f; + + float norm = check_sgemmt('C', CblasRowMajor, CblasUpper, CblasNoTrans, CblasTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test sgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its upper triangle part + * A transposed + * B transposed + */ +CTEST(sgemmt, c_api_rowmajor_upper_M_50_K_50_a_trans_b_trans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha = 1.5f; + float beta = 2.0f; + + float norm = check_sgemmt('C', CblasRowMajor, CblasUpper, CblasTrans, CblasTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test sgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its upper triangle part + * alpha = 0.0 + */ +CTEST(sgemmt, c_api_rowmajor_upper_alpha_zero) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha = 0.0f; + float beta = 2.0f; + + float norm = check_sgemmt('C', CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test sgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its upper triangle part + * beta = 1.0 + */ +CTEST(sgemmt, c_api_rowmajor_upper_beta_one) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha = 2.0f; + float beta = 1.0f; + + float norm = check_sgemmt('C', CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test sgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its lower triangle part + * A not transposed + * B not transposed + */ +CTEST(sgemmt, c_api_rowmajor_lower_M_50_K_50_a_notrans_b_notrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha = 1.5f; + float beta = 2.0f; + + float norm = check_sgemmt('C', CblasRowMajor, CblasLower, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test sgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its lower triangle part + * A transposed + * B not transposed + */ +CTEST(sgemmt, c_api_rowmajor_lower_M_100_K_50_a_trans_b_notrans) +{ + blasint M = 100, K = 50; + blasint lda = 100, ldb = 100, ldc = 100; + float alpha = 1.0f; + float beta = 2.0f; + + float norm = check_sgemmt('C', CblasRowMajor, CblasLower, CblasTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test sgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its lower triangle part + * A not transposed + * B transposed + */ +CTEST(sgemmt, c_api_rowmajor_lower_M_50_K_100_a_notrans_b_trans) +{ + blasint M = 50, K = 100; + blasint lda = 100, ldb = 100, ldc = 50; + float alpha = 1.0f; + float beta = 0.0f; + + float norm = check_sgemmt('C', CblasRowMajor, CblasLower, CblasNoTrans, CblasTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test sgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its lower triangle part + * A transposed + * B transposed + */ +CTEST(sgemmt, c_api_rowmajor_lower_M_50_K_50_a_trans_b_trans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha = 1.5f; + float beta = 2.0f; + + float norm = check_sgemmt('C', CblasRowMajor, CblasLower, CblasTrans, CblasTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test sgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its lower triangle part + * alpha = 0.0 + */ +CTEST(sgemmt, c_api_rowmajor_lower_alpha_zero) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha = 0.0f; + float beta = 2.0f; + + float norm = check_sgemmt('C', CblasRowMajor, CblasLower, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test sgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its lower triangle part + * beta = 1.0 + */ +CTEST(sgemmt, c_api_rowmajor_lower_beta_one) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + float alpha = 2.0f; + float beta = 1.0f; + + float norm = check_sgemmt('C', CblasRowMajor, CblasLower, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test error function for an invalid param uplo. + * Must be upper (U) or lower (L). + */ +CTEST(sgemmt, xerbla_uplo_invalid) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'N'; + char uplo = 'O'; + int expected_info = 1; + + int passed = check_badargs('F', CblasColMajor, uplo, transa, transb, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param transa. + * Must be trans (T/C) or no-trans (N/R). + */ +CTEST(sgemmt, xerbla_transa_invalid) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'O', transb = 'N'; + char uplo = 'U'; + int expected_info = 2; + + int passed = check_badargs('F', CblasColMajor, uplo, transa, transb, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param transb. + * Must be trans (T/C) or no-trans (N/R). + */ +CTEST(sgemmt, xerbla_transb_invalid) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'O'; + char uplo = 'U'; + int expected_info = 3; + + int passed = check_badargs('F', CblasColMajor, uplo, transa, transb, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param M. + * Must be positive. + */ +CTEST(sgemmt, xerbla_m_invalid) +{ + blasint M = -1, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'N'; + char uplo = 'U'; + int expected_info = 4; + + int passed = check_badargs('F', CblasColMajor, uplo, transa, transb, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param K. + * Must be positive. + */ +CTEST(sgemmt, xerbla_k_invalid) +{ + blasint M = 50, K = -1; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'N'; + char uplo = 'U'; + int expected_info = 5; + + int passed = check_badargs('F', CblasColMajor, uplo, transa, transb, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param lda. + * Must be must be at least K if matrix A transposed. + */ +CTEST(sgemmt, xerbla_lda_invalid) +{ + blasint M = 50, K = 100; + blasint lda = 50, ldb = 100, ldc = 50; + char transa = 'T', transb = 'N'; + char uplo = 'U'; + int expected_info = 8; + + int passed = check_badargs('F', CblasColMajor, uplo, transa, transb, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param ldb. + * Must be must be at least K if matrix B not transposed. + */ +CTEST(sgemmt, xerbla_ldb_invalid) +{ + blasint M = 50, K = 100; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'N'; + char uplo = 'U'; + int expected_info = 10; + + int passed = check_badargs('F', CblasColMajor, uplo, transa, transb, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param ldc. + * Must be must be at least M. + */ +CTEST(sgemmt, xerbla_ldc_invalid) +{ + blasint M = 100, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'T', transb = 'N'; + char uplo = 'U'; + int expected_info = 13; + + int passed = check_badargs('F', CblasColMajor, uplo, transa, transb, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. + * Test error function for an invalid param order. + * Must be column or row major. + */ +CTEST(sgemmt, xerbla_c_api_major_invalid) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 0; + + int passed = check_badargs('C', 'O', CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Column Major + * Test error function for an invalid param uplo. + * Must be upper or lower. + */ +CTEST(sgemmt, xerbla_c_api_colmajor_uplo_invalid) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 1; + + int passed = check_badargs('C', CblasColMajor, 'O', CblasNoTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Column Major + * Test error function for an invalid param transa. + * Must be trans or no-trans. + */ +CTEST(sgemmt, xerbla_c_api_colmajor_transa_invalid) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 2; + + int passed = check_badargs('C', CblasColMajor, CblasUpper, 'O', CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Column Major + * Test error function for an invalid param transb. + * Must be trans or no-trans. + */ +CTEST(sgemmt, xerbla_c_api_colmajor_transb_invalid) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 3; + + int passed = check_badargs('C', CblasColMajor, CblasUpper, CblasNoTrans, 'O', + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Column Major + * Test error function for an invalid param M. + * Must be positive. + */ +CTEST(sgemmt, xerbla_c_api_colmajor_m_invalid) +{ + blasint M = -1, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 4; + + int passed = check_badargs('C', CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Column Major + * Test error function for an invalid param K. + * Must be positive. + */ +CTEST(sgemmt, xerbla_c_api_colmajor_k_invalid) +{ + blasint M = 50, K = -1; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 5; + + int passed = check_badargs('C', CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Column Major + * Test error function for an invalid param lda. + * Must be must be at least K if matrix A transposed. + */ +CTEST(sgemmt, xerbla_c_api_colmajor_lda_invalid) +{ + blasint M = 50, K = 100; + blasint lda = 50, ldb = 100, ldc = 50; + int expected_info = 8; + + int passed = check_badargs('C', CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Column Major + * Test error function for an invalid param ldb. + * Must be must be at least K if matrix B not transposed. + */ +CTEST(sgemmt, xerbla_c_api_colmajor_ldb_invalid) +{ + blasint M = 50, K = 100; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 10; + + int passed = check_badargs('C', CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Column Major + * Test error function for an invalid param ldc. + * Must be must be at least M. + */ +CTEST(sgemmt, xerbla_c_api_colmajor_ldc_invalid) +{ + blasint M = 100, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 13; + + int passed = check_badargs('C', CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Row Major + * Test error function for an invalid param uplo. + * Must be upper or lower. + */ +CTEST(sgemmt, xerbla_c_api_rowmajor_uplo_invalid) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 1; + + int passed = check_badargs('C', CblasRowMajor, 'O', CblasNoTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Row Major + * Test error function for an invalid param transa. + * Must be trans or no-trans. + */ +CTEST(sgemmt, xerbla_c_api_rowmajor_transa_invalid) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 2; + + int passed = check_badargs('C', CblasRowMajor, CblasUpper, 'O', CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Row Major + * Test error function for an invalid param transb. + * Must be trans or no-trans. + */ +CTEST(sgemmt, xerbla_c_api_rowmajor_transb_invalid) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 3; + + int passed = check_badargs('C', CblasRowMajor, CblasUpper, CblasNoTrans, 'O', + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Row Major + * Test error function for an invalid param M. + * Must be positive. + */ +CTEST(sgemmt, xerbla_c_api_rowmajor_m_invalid) +{ + blasint M = -1, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 4; + + int passed = check_badargs('C', CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Row Major + * Test error function for an invalid param K. + * Must be positive. + */ +CTEST(sgemmt, xerbla_c_api_rowmajor_k_invalid) +{ + blasint M = 50, K = -1; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 5; + + int passed = check_badargs('C', CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Row Major + * Test error function for an invalid param lda. + * Must be must be at least K if matrix A transposed. + */ +CTEST(sgemmt, xerbla_c_api_rowmajor_lda_invalid) +{ + blasint M = 50, K = 100; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 8; + + int passed = check_badargs('C', CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Row Major + * Test error function for an invalid param ldb. + * Must be must be at least K if matrix B transposed. + */ +CTEST(sgemmt, xerbla_c_api_rowmajor_ldb_invalid) +{ + blasint M = 50, K = 100; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 10; + + int passed = check_badargs('C', CblasRowMajor, CblasUpper, CblasTrans, CblasTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Row Major + * Test error function for an invalid param ldc. + * Must be must be at least M. + */ +CTEST(sgemmt, xerbla_c_api_rowmajor_ldc_invalid) +{ + blasint M = 100, K = 50; + blasint lda = 100, ldb = 100, ldc = 50; + int expected_info = 13; + + int passed = check_badargs('C', CblasRowMajor, CblasUpper, CblasTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_simatcopy.c b/utest/test_extensions/test_simatcopy.c new file mode 100644 index 000000000..0d9c44e73 --- /dev/null +++ b/utest/test_extensions/test_simatcopy.c @@ -0,0 +1,947 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. 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. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include "common.h" + +#define DATASIZE 100 + +struct DATA_SIMATCOPY { + float a_test[DATASIZE* DATASIZE]; + float a_verify[DATASIZE* DATASIZE]; +}; + +#ifdef BUILD_SINGLE +static struct DATA_SIMATCOPY data_simatcopy; + +/** + * Comapare results computed by simatcopy and reference func + * + * param api specifies tested api (C or Fortran) + * param order specifies row or column major order + * param trans specifies op(A), the transposition operation + * applied to the matrix A + * param rows specifies number of rows of A + * param cols specifies number of columns of A + * param alpha specifies scaling factor for matrix A + * param lda_src - leading dimension of the matrix A + * param lda_dst - leading dimension of output matrix A + * return norm of difference between openblas and reference func + */ +static float check_simatcopy(char api, char order, char trans, blasint rows, blasint cols, float alpha, + blasint lda_src, blasint lda_dst) +{ + blasint m, n; + blasint rows_out, cols_out; + enum CBLAS_ORDER corder; + enum CBLAS_TRANSPOSE ctrans; + + if (order == 'C') { + n = rows; m = cols; + } + else { + m = rows; n = cols; + } + + if(trans == 'T' || trans == 'C') { + rows_out = n; cols_out = m; + } + else { + rows_out = m; cols_out = n; + } + + srand_generate(data_simatcopy.a_test, lda_src*m); + + if (trans == 'T' || trans == 'C') { + stranspose(m, n, alpha, data_simatcopy.a_test, lda_src, data_simatcopy.a_verify, lda_dst); + } + else { + scopy(m, n, alpha, data_simatcopy.a_test, lda_src, data_simatcopy.a_verify, lda_dst); + } + + if (api == 'F') { + BLASFUNC(simatcopy)(&order, &trans, &rows, &cols, &alpha, data_simatcopy.a_test, + &lda_src, &lda_dst); + } + else { + if (order == 'C') corder = CblasColMajor; + if (order == 'R') corder = CblasRowMajor; + if (trans == 'T') ctrans = CblasTrans; + if (trans == 'N') ctrans = CblasNoTrans; + if (trans == 'C') ctrans = CblasConjTrans; + if (trans == 'R') ctrans = CblasConjNoTrans; + cblas_simatcopy(corder, ctrans, rows, cols, alpha, data_simatcopy.a_test, + lda_src, lda_dst); + } + + // Find the differences between output matrix computed by simatcopy and reference func + return smatrix_difference(data_simatcopy.a_test, data_simatcopy.a_verify, cols_out, rows_out, lda_dst); +} + +/** + * Check if error function was called with expected function name + * and param info + * + * param order specifies row or column major order + * param trans specifies op(A), the transposition operation + * applied to the matrix A + * param rows specifies number of rows of A + * param cols specifies number of columns of A + * param lda_src - leading dimension of the matrix A + * param lda_dst - leading dimension of output matrix A + * param expected_info - expected invalid parameter number + * return TRUE if everything is ok, otherwise FALSE + */ +static int check_badargs(char order, char trans, blasint rows, blasint cols, + blasint lda_src, blasint lda_dst, int expected_info) +{ + float alpha = 1.0f; + + set_xerbla("SIMATCOPY", expected_info); + + BLASFUNC(simatcopy)(&order, &trans, &rows, &cols, &alpha, data_simatcopy.a_test, + &lda_src, &lda_dst); + + return check_error(); +} + +/** + * Fortran API specific test + * Test simatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Transposition + * Square matrix + * alpha = 1.0f + */ +CTEST(simatcopy, colmajor_trans_col_100_row_100_alpha_one) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'C'; + char trans = 'T'; + float alpha = 1.0f; + + float norm = check_simatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test simatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Copy only + * Square matrix + * alpha = 1.0f + */ +CTEST(simatcopy, colmajor_notrans_col_100_row_100_alpha_one) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'C'; + char trans = 'N'; + float alpha = 1.0f; + + float norm = check_simatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test simatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Transposition + * Square matrix + * alpha = 0.0f + */ +CTEST(simatcopy, colmajor_trans_col_100_row_100_alpha_zero) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'C'; + char trans = 'T'; + float alpha = 0.0f; + + float norm = check_simatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test simatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Copy only + * Square matrix + * alpha = 0.0f + */ +CTEST(simatcopy, colmajor_notrans_col_100_row_100_alpha_zero) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'C'; + char trans = 'N'; + float alpha = 0.0f; + + float norm = check_simatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test simatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Transposition + * Square matrix + * alpha = 2.0f + */ +CTEST(simatcopy, colmajor_trans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'C'; + char trans = 'T'; + float alpha = 2.0f; + + float norm = check_simatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test simatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Copy only + * Square matrix + * alpha = 2.0f + */ +CTEST(simatcopy, colmajor_notrans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'C'; + char trans = 'N'; + float alpha = 2.0f; + + float norm = check_simatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test simatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Transposition + * Rectangular matrix + * alpha = 1.0f + */ +CTEST(simatcopy, colmajor_trans_col_50_row_100_alpha_one) +{ + blasint m = 100, n = 50; + blasint lda_src = 100, lda_dst = 50; + char order = 'C'; + char trans = 'T'; + float alpha = 1.0f; + + float norm = check_simatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test simatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Copy only + * Rectangular matrix + * alpha = 1.0f + */ +CTEST(simatcopy, colmajor_notrans_col_50_row_100_alpha_one) +{ + blasint m = 100, n = 50; + blasint lda_src = 100, lda_dst = 100; + char order = 'C'; + char trans = 'N'; + float alpha = 1.0f; + + float norm = check_simatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test simatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Transposition + * Rectangular matrix + * alpha = 0.0f + */ +CTEST(simatcopy, colmajor_trans_col_50_row_100_alpha_zero) +{ + blasint m = 100, n = 50; + blasint lda_src = 100, lda_dst = 50; + char order = 'C'; + char trans = 'T'; + float alpha = 0.0f; + + float norm = check_simatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test simatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Copy only + * Rectangular matrix + * alpha = 0.0f + */ +CTEST(simatcopy, colmajor_notrans_col_50_row_100_alpha_zero) +{ + blasint m = 100, n = 50; + blasint lda_src = 100, lda_dst = 100; + char order = 'C'; + char trans = 'N'; + float alpha = 0.0f; + + float norm = check_simatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test simatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Transposition + * Rectangular matrix + * alpha = 2.0f + */ +CTEST(simatcopy, colmajor_trans_col_50_row_100) +{ + blasint m = 100, n = 50; + blasint lda_src = 100, lda_dst = 50; + char order = 'C'; + char trans = 'T'; + float alpha = 2.0f; + + float norm = check_simatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test simatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Copy only + * Rectangular matrix + * alpha = 2.0f + */ +CTEST(simatcopy, colmajor_notrans_col_50_row_100) +{ + blasint m = 100, n = 50; + blasint lda_src = 100, lda_dst = 100; + char order = 'C'; + char trans = 'N'; + float alpha = 2.0f; + + float norm = check_simatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test simatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Transposition + * Square matrix + * alpha = 1.0f + */ +CTEST(simatcopy, rowmajor_trans_col_100_row_100_alpha_one) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'R'; + char trans = 'T'; + float alpha = 1.0f; + + float norm = check_simatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test simatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Copy only + * Square matrix + * alpha = 1.0f + */ +CTEST(simatcopy, rowmajor_notrans_col_100_row_100_alpha_one) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'R'; + char trans = 'N'; + float alpha = 1.0f; + + float norm = check_simatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test simatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Transposition + * Square matrix + * alpha = 0.0f + */ +CTEST(simatcopy, rowmajor_trans_col_100_row_100_alpha_zero) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'R'; + char trans = 'T'; + float alpha = 0.0f; + + float norm = check_simatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test simatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Copy only + * Square matrix + * alpha = 0.0f + */ +CTEST(simatcopy, rowmajor_notrans_col_100_row_100_alpha_zero) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'R'; + char trans = 'N'; + float alpha = 0.0f; + + float norm = check_simatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific tests + * Test simatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Transposition + * Square matrix + * alpha = 2.0f + */ +CTEST(simatcopy, rowmajor_trans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'R'; + char trans = 'T'; + float alpha = 2.0f; + + float norm = check_simatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test simatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Copy only + * Square matrix + * alpha = 2.0f + */ +CTEST(simatcopy, rowmajor_notrans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'R'; + char trans = 'N'; + float alpha = 2.0f; + + float norm = check_simatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test simatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Transposition + * Rectangular matrix + * alpha = 1.0f + */ +CTEST(simatcopy, rowmajor_trans_col_100_row_50_alpha_one) +{ + blasint m = 50, n = 100; + blasint lda_src = 100, lda_dst = 50; + char order = 'R'; + char trans = 'C'; // same as trans for real matrix + float alpha = 1.0f; + + float norm = check_simatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test simatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Copy only + * Rectangular matrix + * alpha = 1.0f + */ +CTEST(simatcopy, rowmajor_notrans_col_100_row_50_alpha_one) +{ + blasint m = 50, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'R'; + char trans = 'N'; + float alpha = 1.0f; + + float norm = check_simatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test simatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Transposition + * Rectangular matrix + * alpha = 0.0f + */ +CTEST(simatcopy, rowmajor_trans_col_100_row_50_alpha_zero) +{ + blasint m = 50, n = 100; + blasint lda_src = 100, lda_dst = 50; + char order = 'R'; + char trans = 'C'; // same as trans for real matrix + float alpha = 0.0f; + + float norm = check_simatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test simatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Copy only + * Rectangular matrix + * alpha = 0.0f + */ +CTEST(simatcopy, rowmajor_notrans_col_100_row_50_alpha_zero) +{ + blasint m = 50, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'R'; + char trans = 'N'; + float alpha = 0.0f; + + float norm = check_simatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test simatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Transposition + * Rectangular matrix + * alpha = 2.0f + */ +CTEST(simatcopy, rowmajor_trans_col_100_row_50) +{ + blasint m = 50, n = 100; + blasint lda_src = 100, lda_dst = 50; + char order = 'R'; + char trans = 'C'; // same as trans for real matrix + float alpha = 2.0f; + + float norm = check_simatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test simatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Copy only + * Rectangular matrix + * alpha = 2.0f + */ +CTEST(simatcopy, rowmajor_notrans_col_100_row_50) +{ + blasint m = 50, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'R'; + char trans = 'N'; + float alpha = 2.0f; + + float norm = check_simatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test simatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Transposition + * Square matrix + * alpha = 2.0f + */ +CTEST(simatcopy, c_api_colmajor_trans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'C'; + char trans = 'T'; + float alpha = 2.0f; + + float norm = check_simatcopy('C', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test simatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Copy only + * Square matrix + * alpha = 2.0f + */ +CTEST(simatcopy, c_api_colmajor_notrans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'C'; + char trans = 'N'; + float alpha = 2.0f; + + float norm = check_simatcopy('C', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test simatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Transposition + * Square matrix + * alpha = 2.0f + */ +CTEST(simatcopy, c_api_rowmajor_trans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'R'; + char trans = 'T'; + float alpha = 2.0f; + + float norm = check_simatcopy('C', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test simatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Copy only + * Square matrix + * alpha = 2.0f + */ +CTEST(simatcopy, c_api_rowmajor_notrans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'R'; + char trans = 'N'; + float alpha = 2.0f; + + float norm = check_simatcopy('C', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Test error function for an invalid param order. + * Must be column (C) or row major (R). + */ +CTEST(simatcopy, xerbla_invalid_order) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'O'; + char trans = 'T'; + int expected_info = 1; + + int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param trans. + * Must be trans (T/C) or no-trans (N/R). + */ +CTEST(simatcopy, xerbla_invalid_trans) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'C'; + char trans = 'O'; + int expected_info = 2; + + int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param m. + * Must be positive. + */ +CTEST(simatcopy, xerbla_invalid_rows) +{ + blasint m = 0, n = 100; + blasint lda_src = 0, lda_dst = 100; + char order = 'C'; + char trans = 'T'; + int expected_info = 3; + + int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param n. + * Must be positive. + */ +CTEST(simatcopy, xerbla_invalid_cols) +{ + blasint m = 100, n = 0; + blasint lda_src = 100, lda_dst = 0; + char order = 'C'; + char trans = 'T'; + int expected_info = 4; + + int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param lda_src. + * If matrices are stored using row major layout, + * lda_src must be at least n. + */ +CTEST(simatcopy, xerbla_rowmajor_invalid_lda) +{ + blasint m = 50, n = 100; + blasint lda_src = 50, lda_dst = 100; + char order = 'R'; + char trans = 'T'; + int expected_info = 7; + + int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param lda_src. + * If matrices are stored using column major layout, + * lda_src must be at least m. + */ +CTEST(simatcopy, xerbla_colmajor_invalid_lda) +{ + blasint m = 100, n = 50; + blasint lda_src = 50, lda_dst = 100; + char order = 'C'; + char trans = 'T'; + int expected_info = 7; + + int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param lda_dst. + * If matrices are stored using row major layout and + * there is no transposition, lda_dst must be at least n. + */ +CTEST(simatcopy, xerbla_rowmajor_notrans_invalid_ldb) +{ + blasint m = 50, n = 100; + blasint lda_src = 100, lda_dst = 50; + char order = 'R'; + char trans = 'N'; + int expected_info = 9; + + int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param lda_dst. + * If matrices are stored using row major layout and + * there is transposition, lda_dst must be at least m. + */ +CTEST(simatcopy, xerbla_rowmajor_trans_invalid_ldb) +{ + blasint m = 100, n = 50; + blasint lda_src = 100, lda_dst = 50; + char order = 'R'; + char trans = 'T'; + int expected_info = 9; + + int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param lda_dst. + * If matrices are stored using column major layout and + * there is no transposition, lda_dst must be at least m. + */ +CTEST(simatcopy, xerbla_colmajor_notrans_invalid_ldb) +{ + blasint m = 100, n = 50; + blasint lda_src = 100, lda_dst = 50; + char order = 'C'; + char trans = 'N'; + int expected_info = 9; + + int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param lda_dst. + * If matrices are stored using column major layout and + * there is transposition, lda_dst must be at least n. + */ +CTEST(simatcopy, xerbla_colmajor_trans_invalid_ldb) +{ + blasint m = 50, n = 100; + blasint lda_src = 100, lda_dst = 50; + char order = 'C'; + char trans = 'T'; + int expected_info = 9; + + int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); + ASSERT_EQUAL(TRUE, passed); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_somatcopy.c b/utest/test_extensions/test_somatcopy.c new file mode 100644 index 000000000..c75bbc75e --- /dev/null +++ b/utest/test_extensions/test_somatcopy.c @@ -0,0 +1,672 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. 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. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include "common.h" + +#define DATASIZE 100 + +struct DATA_SOMATCOPY { + float a_test[DATASIZE * DATASIZE]; + float b_test[DATASIZE * DATASIZE]; + float b_verify[DATASIZE * DATASIZE]; +}; + +#ifdef BUILD_SINGLE +static struct DATA_SOMATCOPY data_somatcopy; + +/** + * Comapare results computed by somatcopy and reference func + * + * param api specifies tested api (C or Fortran) + * param order specifies row or column major order + * param trans specifies op(A), the transposition operation + * applied to the matrix A + * param rows - number of rows of A + * param cols - number of columns of A + * param alpha - scaling factor for matrix B + * param lda - leading dimension of the matrix A + * param ldb - leading dimension of the matrix B + * return norm of difference between openblas and reference func + */ +static float check_somatcopy(char api, char order, char trans, blasint rows, blasint cols, float alpha, + blasint lda, blasint ldb) +{ + blasint b_rows, b_cols; + blasint m, n; + enum CBLAS_ORDER corder; + enum CBLAS_TRANSPOSE ctrans; + + if (order == 'C') { + m = cols; n = rows; + } + else { + m = rows; n = cols; + } + + if(trans == 'T' || trans == 'C') { + b_rows = n; b_cols = m; + } + else { + b_rows = m; b_cols = n; + } + + srand_generate(data_somatcopy.a_test, lda*m); + + if (trans == 'T' || trans == 'C') { + stranspose(m, n, alpha, data_somatcopy.a_test, lda, data_somatcopy.b_verify, ldb); + } + else { + scopy(m, n, alpha, data_somatcopy.a_test, lda, data_somatcopy.b_verify, ldb); + } + + if (api == 'F') { + BLASFUNC(somatcopy)(&order, &trans, &rows, &cols, &alpha, data_somatcopy.a_test, + &lda, data_somatcopy.b_test, &ldb); + } + else { + if (order == 'C') corder = CblasColMajor; + if (order == 'R') corder = CblasRowMajor; + if (trans == 'T') ctrans = CblasTrans; + if (trans == 'N') ctrans = CblasNoTrans; + if (trans == 'C') ctrans = CblasConjTrans; + if (trans == 'R') ctrans = CblasConjNoTrans; + cblas_somatcopy(corder, ctrans, rows, cols, alpha, data_somatcopy.a_test, + lda, data_somatcopy.b_test, ldb); + } + + return smatrix_difference(data_somatcopy.b_test, data_somatcopy.b_verify, b_cols, b_rows, ldb); +} + +/** + * Check if error function was called with expected function name + * and param info + * + * param order specifies row or column major order + * param trans specifies op(A), the transposition operation + * applied to the matrix A + * param rows - number of rows of A + * param cols - number of columns of A + * param lda - leading dimension of the matrix A + * param ldb - leading dimension of the matrix B + * param expected_info - expected invalid parameter number + * return TRUE if everything is ok, otherwise FALSE + */ +static int check_badargs(char order, char trans, blasint rows, blasint cols, + blasint lda, blasint ldb, int expected_info) +{ + float alpha = 1.0; + + set_xerbla("SOMATCOPY", expected_info); + + BLASFUNC(somatcopy)(&order, &trans, &rows, &cols, &alpha, data_somatcopy.a_test, + &lda, data_somatcopy.b_test, &ldb); + + return check_error(); +} + +/** + * Fortran API specific test + * Test somatcopy by comparing it against refernce + * with the following options: + * + * Column Major + * Transposition + * Square matrix + * alpha = 1.0 + */ +CTEST(somatcopy, colmajor_trans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda = 100, ldb = 100; + char order = 'C'; + char trans = 'T'; + float alpha = 1.0f; + + float norm = check_somatcopy('F', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test somatcopy by comparing it against refernce + * with the following options: + * + * Column Major + * Copy only + * Square matrix + * alpha = 1.0 + */ +CTEST(somatcopy, colmajor_notrans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda = 100, ldb = 100; + char order = 'C'; + char trans = 'N'; + float alpha = 1.0f; + + float norm = check_somatcopy('F', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test somatcopy by comparing it against refernce + * with the following options: + * + * Column Major + * Transposition + * Rectangular matrix + * alpha = 2.0 + */ +CTEST(somatcopy, colmajor_trans_col_50_row_100) +{ + blasint m = 100, n = 50; + blasint lda = 100, ldb = 50; + char order = 'C'; + char trans = 'T'; + float alpha = 2.0f; + + float norm = check_somatcopy('F', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test somatcopy by comparing it against refernce + * with the following options: + * + * Column Major + * Copy only + * Rectangular matrix + * alpha = 2.0 + */ +CTEST(somatcopy, colmajor_notrans_col_50_row_100) +{ + blasint m = 100, n = 50; + blasint lda = 100, ldb = 100; + char order = 'C'; + char trans = 'N'; + float alpha = 2.0f; + + float norm = check_somatcopy('F', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test somatcopy by comparing it against refernce + * with the following options: + * + * Column Major + * Transposition + * Rectangular matrix + * alpha = 0.0 + */ +CTEST(somatcopy, colmajor_trans_col_100_row_50) +{ + blasint m = 50, n = 100; + blasint lda = 50, ldb = 100; + char order = 'C'; + char trans = 'T'; + float alpha = 0.0f; + + float norm = check_somatcopy('F', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test somatcopy by comparing it against refernce + * with the following options: + * + * Column Major + * Copy only + * Rectangular matrix + * alpha = 0.0 + */ +CTEST(somatcopy, colmajor_notrans_col_100_row_50) +{ + blasint m = 50, n = 100; + blasint lda = 50, ldb = 50; + char order = 'C'; + char trans = 'N'; + float alpha = 0.0f; + + float norm = check_somatcopy('F', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test somatcopy by comparing it against refernce + * with the following options: + * + * Row Major + * Transposition + * Square matrix + * alpha = 1.0 + */ +CTEST(somatcopy, rowmajor_trans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda = 100, ldb = 100; + char order = 'R'; + char trans = 'T'; + float alpha = 1.0f; + + float norm = check_somatcopy('F', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test somatcopy by comparing it against refernce + * with the following options: + * + * Row Major + * Copy only + * Square matrix + * alpha = 1.0 + */ +CTEST(somatcopy, rowmajor_notrans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda = 100, ldb = 100; + char order = 'R'; + char trans = 'N'; + float alpha = 1.0f; + + float norm = check_somatcopy('F', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test somatcopy by comparing it against refernce + * with the following options: + * + * Row Major + * Transposition + * Rectangular matrix + * alpha = 2.0 + */ +CTEST(somatcopy, rowmajor_conjtrans_col_100_row_50) +{ + blasint m = 50, n = 100; + blasint lda = 100, ldb = 50; + char order = 'R'; + char trans = 'C'; // same as trans for real matrix + float alpha = 2.0f; + + float norm = check_somatcopy('F', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test somatcopy by comparing it against refernce + * with the following options: + * + * Row Major + * Copy only + * Rectangular matrix + * alpha = 2.0 + */ +CTEST(somatcopy, rowmajor_notrans_col_50_row_100) +{ + blasint m = 100, n = 50; + blasint lda = 50, ldb = 50; + char order = 'R'; + char trans = 'N'; + float alpha = 2.0f; + + float norm = check_somatcopy('F', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test somatcopy by comparing it against refernce + * with the following options: + * + * Row Major + * Transposition + * Matrix dimensions leave residues from 4 and 2 (specialize + * for rt case) + * alpha = 1.5 + */ +CTEST(somatcopy, rowmajor_trans_col_27_row_27) +{ + blasint m = 27, n = 27; + blasint lda = 27, ldb = 27; + char order = 'R'; + char trans = 'T'; + float alpha = 1.5f; + + float norm = check_somatcopy('F', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test somatcopy by comparing it against refernce + * with the following options: + * + * Row Major + * Copy only + * Rectangular matrix + * alpha = 0.0 + */ +CTEST(somatcopy, rowmajor_notrans_col_100_row_50) +{ + blasint m = 50, n = 100; + blasint lda = 100, ldb = 100; + char order = 'R'; + char trans = 'N'; + float alpha = 0.0f; + + float norm = check_somatcopy('F', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test somatcopy by comparing it against refernce + * with the following options: + * + * Column Major + * Transposition + * Square matrix + * alpha = 1.0 + */ +CTEST(somatcopy, c_api_colmajor_trans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda = 100, ldb = 100; + char order = 'C'; + char trans = 'T'; + float alpha = 1.0f; + + float norm = check_somatcopy('C', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test somatcopy by comparing it against refernce + * with the following options: + * + * Column Major + * Copy only + * Square matrix + * alpha = 1.0 + */ +CTEST(somatcopy, c_api_colmajor_notrans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda = 100, ldb = 100; + char order = 'C'; + char trans = 'N'; + float alpha = 1.0f; + + float norm = check_somatcopy('C', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test somatcopy by comparing it against refernce + * with the following options: + * + * Row Major + * Transposition + * Square matrix + * alpha = 1.0 + */ +CTEST(somatcopy, c_api_rowmajor_trans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda = 100, ldb = 100; + char order = 'R'; + char trans = 'T'; + float alpha = 1.0f; + + float norm = check_somatcopy('C', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * C API specific test + * Test somatcopy by comparing it against refernce + * with the following options: + * + * Row Major + * Copy only + * Square matrix + * alpha = 1.0 + */ +CTEST(somatcopy, c_api_rowmajor_notrans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda = 100, ldb = 100; + char order = 'R'; + char trans = 'N'; + float alpha = 1.0f; + + float norm = check_somatcopy('C', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS); +} + +/** + * Test error function for an invalid param order. + * Must be column (C) or row major (R). + */ +CTEST(somatcopy, xerbla_invalid_order) +{ + blasint m = 100, n = 100; + blasint lda = 100, ldb = 100; + char order = 'O'; + char trans = 'T'; + int expected_info = 1; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param trans. + * Must be trans (T/C) or no-trans (N/R). + */ +CTEST(somatcopy, xerbla_invalid_trans) +{ + blasint m = 100, n = 100; + blasint lda = 100, ldb = 100; + char order = 'C'; + char trans = 'O'; + int expected_info = 2; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param m. + * Must be positive. + */ +CTEST(somatcopy, xerbla_invalid_rows) +{ + blasint m = 0, n = 100; + blasint lda = 0, ldb = 100; + char order = 'C'; + char trans = 'T'; + int expected_info = 3; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param n. + * Must be positive. + */ +CTEST(somatcopy, xerbla_invalid_cols) +{ + blasint m = 100, n = 0; + blasint lda = 100, ldb = 0; + char order = 'C'; + char trans = 'T'; + int expected_info = 4; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param lda. + * If matrices are stored using row major layout, + * lda must be at least n. + */ +CTEST(somatcopy, xerbla_rowmajor_invalid_lda) +{ + blasint m = 50, n = 100; + blasint lda = 50, ldb = 100; + char order = 'R'; + char trans = 'T'; + int expected_info = 7; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param lda. + * If matrices are stored using column major layout, + * lda must be at least m. + */ +CTEST(somatcopy, xerbla_colmajor_invalid_lda) +{ + blasint m = 100, n = 50; + blasint lda = 50, ldb = 100; + char order = 'C'; + char trans = 'T'; + int expected_info = 7; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param ldb. + * If matrices are stored using row major layout and + * there is no transposition, ldb must be at least n. + */ +CTEST(somatcopy, xerbla_rowmajor_notrans_invalid_ldb) +{ + blasint m = 50, n = 100; + blasint lda = 100, ldb = 50; + char order = 'R'; + char trans = 'N'; + int expected_info = 9; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param ldb. + * If matrices are stored using row major layout and + * there is transposition, ldb must be at least m. + */ +CTEST(somatcopy, xerbla_rowmajor_trans_invalid_ldb) +{ + blasint m = 100, n = 50; + blasint lda = 100, ldb = 50; + char order = 'R'; + char trans = 'T'; + int expected_info = 9; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param ldb. + * If matrices are stored using column major layout and + * there is no transposition, ldb must be at least m. + */ +CTEST(somatcopy, xerbla_colmajor_notrans_invalid_ldb) +{ + blasint m = 100, n = 50; + blasint lda = 100, ldb = 50; + char order = 'C'; + char trans = 'N'; + int expected_info = 9; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param ldb. + * If matrices are stored using column major layout and + * there is transposition, ldb must be at least n. + */ +CTEST(somatcopy, xerbla_colmajor_trans_invalid_ldb) +{ + blasint m = 50, n = 100; + blasint lda = 100, ldb = 50; + char order = 'C'; + char trans = 'T'; + int expected_info = 9; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} +#endif diff --git a/utest/test_extensions/test_srotmg.c b/utest/test_extensions/test_srotmg.c new file mode 100644 index 000000000..3c97e3b4d --- /dev/null +++ b/utest/test_extensions/test_srotmg.c @@ -0,0 +1,414 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. 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. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include + +#ifdef BUILD_SINGLE + +/** + * Fortran API specific test + * Test srotmg by comparing it against pre-calculated values + */ +CTEST(srotmg, y1_zero) +{ + float te_d1, tr_d1; + float te_d2, tr_d2; + float te_x1, tr_x1; + float te_y1, tr_y1; + float te_param[5]; + float tr_param[5]; + int i = 0; + te_d1 = tr_d1 = 2.0f; + te_d2 = tr_d2 = 2.0f; + te_x1 = tr_x1 = 8.0f; + te_y1 = tr_y1 = 0.0f; + + for(i=0; i<5; i++){ + te_param[i] = tr_param[i] = 0.0f; + } + + //reference values as calculated by netlib blas + tr_d1 = 2.0f; + tr_d2 = 2.0f; + tr_x1 = 8.0f; + tr_y1 = 0.0f; + + tr_param[0] = -2.0f; + tr_param[1] = 0.0f; + tr_param[2] = 0.0f; + tr_param[3] = 0.0f; + tr_param[4] = 0.0f; + + //OpenBLAS + BLASFUNC(srotmg)(&te_d1, &te_d2, &te_x1, &te_y1, te_param); + + ASSERT_DBL_NEAR_TOL(tr_d1, te_d1, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_d2, te_d2, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_x1, te_x1, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_y1, te_y1, SINGLE_EPS); + + for(i=0; i<5; i++){ + ASSERT_DBL_NEAR_TOL(tr_param[i], te_param[i], SINGLE_EPS); + } +} + +/** + * Fortran API specific test + * Test srotmg by comparing it against pre-calculated values + */ +CTEST(srotmg, d1_negative) +{ + float te_d1, tr_d1; + float te_d2, tr_d2; + float te_x1, tr_x1; + float te_y1, tr_y1; + float te_param[5]; + float tr_param[5]; + int i = 0; + te_d1 = tr_d1 = -1.0f; + te_d2 = tr_d2 = 2.0f; + te_x1 = tr_x1 = 8.0f; + te_y1 = tr_y1 = 8.0f; + + for(i=0; i<5; i++){ + te_param[i] = tr_param[i] = 0.0f; + } + + //reference values as calculated by netlib blas + tr_d1 = 0.0f; + tr_d2 = 0.0f; + tr_x1 = 0.0f; + tr_y1 = 8.0f; + + tr_param[0] = -1.0f; + tr_param[1] = 0.0f; + tr_param[2] = 0.0f; + tr_param[3] = 0.0f; + tr_param[4] = 0.0f; + + //OpenBLAS + BLASFUNC(srotmg)(&te_d1, &te_d2, &te_x1, &te_y1, te_param); + + ASSERT_DBL_NEAR_TOL(tr_d1, te_d1, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_d2, te_d2, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_x1, te_x1, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_y1, te_y1, SINGLE_EPS); + + for(i=0; i<5; i++){ + ASSERT_DBL_NEAR_TOL(tr_param[i], te_param[i], SINGLE_EPS); + } +} + +/** + * Fortran API specific test + * Test srotmg by comparing it against pre-calculated values + */ +CTEST(srotmg, d1_positive_d2_positive_x1_zero) +{ + float te_d1, tr_d1; + float te_d2, tr_d2; + float te_x1, tr_x1; + float te_y1, tr_y1; + float te_param[5]; + float tr_param[5]; + int i = 0; + te_d1 = tr_d1 = 2.0f; + te_d2 = tr_d2 = 2.0f; + te_x1 = tr_x1 = 0.0f; + te_y1 = tr_y1 = 8.0f; + + for(i=0; i<5; i++){ + te_param[i] = tr_param[i] = 0.0f; + } + + //reference values as calculated by netlib blas + tr_d1 = 2.0f; + tr_d2 = 2.0f; + tr_x1 = 8.0f; + tr_y1 = 8.0f; + + tr_param[0] = 1.0f; + tr_param[1] = 0.0f; + tr_param[2] = 0.0f; + tr_param[3] = 0.0f; + tr_param[4] = 0.0f; + + //OpenBLAS + BLASFUNC(srotmg)(&te_d1, &te_d2, &te_x1, &te_y1, te_param); + + ASSERT_DBL_NEAR_TOL(tr_d1, te_d1, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_d2, te_d2, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_x1, te_x1, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_y1, te_y1, SINGLE_EPS); + + for(i=0; i<5; i++){ + ASSERT_DBL_NEAR_TOL(tr_param[i], te_param[i], SINGLE_EPS); + } +} + +/** + * Fortran API specific test + * Test srotmg by comparing it against pre-calculated values + */ +CTEST(srotmg, scaled_y_greater_than_scaled_x) +{ + float te_d1, tr_d1; + float te_d2, tr_d2; + float te_x1, tr_x1; + float te_y1, tr_y1; + float te_param[5]; + float tr_param[5]; + int i = 0; + te_d1 = tr_d1 = 1.0f; + te_d2 = tr_d2 = -2.0f; + te_x1 = tr_x1 = 8.0f; + te_y1 = tr_y1 = 8.0f; + + for(i=0; i<5; i++){ + te_param[i] = tr_param[i] = 0.0f; + } + + //reference values as calculated by netlib blas + tr_d1 = 0.0f; + tr_d2 = 0.0f; + tr_x1 = 0.0f; + tr_y1 = 8.0f; + + tr_param[0] = -1.0f; + tr_param[1] = 0.0f; + tr_param[2] = 0.0f; + tr_param[3] = 0.0f; + tr_param[4] = 0.0f; + + //OpenBLAS + BLASFUNC(srotmg)(&te_d1, &te_d2, &te_x1, &te_y1, te_param); + + ASSERT_DBL_NEAR_TOL(tr_d1, te_d1, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_d2, te_d2, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_x1, te_x1, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_y1, te_y1, SINGLE_EPS); + + for(i=0; i<5; i++){ + ASSERT_DBL_NEAR_TOL(tr_param[i], te_param[i], SINGLE_EPS); + } +} + +/** + * C API specific test + * Test srotmg by comparing it against pre-calculated values + */ +CTEST(srotmg, c_api_y1_zero) +{ + float te_d1, tr_d1; + float te_d2, tr_d2; + float te_x1, tr_x1; + float te_y1, tr_y1; + float te_param[5]; + float tr_param[5]; + int i = 0; + te_d1 = tr_d1 = 2.0f; + te_d2 = tr_d2 = 2.0f; + te_x1 = tr_x1 = 8.0f; + te_y1 = tr_y1 = 0.0f; + + for(i=0; i<5; i++){ + te_param[i] = tr_param[i] = 0.0f; + } + + //reference values as calculated by netlib blas + tr_d1 = 2.0f; + tr_d2 = 2.0f; + tr_x1 = 8.0f; + tr_y1 = 0.0f; + + tr_param[0] = -2.0f; + tr_param[1] = 0.0f; + tr_param[2] = 0.0f; + tr_param[3] = 0.0f; + tr_param[4] = 0.0f; + + //OpenBLAS + cblas_srotmg(&te_d1, &te_d2, &te_x1, te_y1, te_param); + + ASSERT_DBL_NEAR_TOL(tr_d1, te_d1, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_d2, te_d2, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_x1, te_x1, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_y1, te_y1, SINGLE_EPS); + + for(i=0; i<5; i++){ + ASSERT_DBL_NEAR_TOL(tr_param[i], te_param[i], SINGLE_EPS); + } +} + +/** + * C API specific test + * Test srotmg by comparing it against pre-calculated values + */ +CTEST(srotmg, c_api_d1_negative) +{ + float te_d1, tr_d1; + float te_d2, tr_d2; + float te_x1, tr_x1; + float te_y1, tr_y1; + float te_param[5]; + float tr_param[5]; + int i = 0; + te_d1 = tr_d1 = -1.0f; + te_d2 = tr_d2 = 2.0f; + te_x1 = tr_x1 = 8.0f; + te_y1 = tr_y1 = 8.0f; + + for(i=0; i<5; i++){ + te_param[i] = tr_param[i] = 0.0f; + } + + //reference values as calculated by netlib blas + tr_d1 = 0.0f; + tr_d2 = 0.0f; + tr_x1 = 0.0f; + tr_y1 = 8.0f; + + tr_param[0] = -1.0f; + tr_param[1] = 0.0f; + tr_param[2] = 0.0f; + tr_param[3] = 0.0f; + tr_param[4] = 0.0f; + + //OpenBLAS + cblas_srotmg(&te_d1, &te_d2, &te_x1, te_y1, te_param); + + ASSERT_DBL_NEAR_TOL(tr_d1, te_d1, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_d2, te_d2, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_x1, te_x1, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_y1, te_y1, SINGLE_EPS); + + for(i=0; i<5; i++){ + ASSERT_DBL_NEAR_TOL(tr_param[i], te_param[i], SINGLE_EPS); + } +} + +/** + * C API specific test + * Test srotmg by comparing it against pre-calculated values + */ +CTEST(srotmg, c_api_d1_positive_d2_positive_x1_zero) +{ + float te_d1, tr_d1; + float te_d2, tr_d2; + float te_x1, tr_x1; + float te_y1, tr_y1; + float te_param[5]; + float tr_param[5]; + int i = 0; + te_d1 = tr_d1 = 2.0f; + te_d2 = tr_d2 = 2.0f; + te_x1 = tr_x1 = 0.0f; + te_y1 = tr_y1 = 8.0f; + + for(i=0; i<5; i++){ + te_param[i] = tr_param[i] = 0.0f; + } + + //reference values as calculated by netlib blas + tr_d1 = 2.0f; + tr_d2 = 2.0f; + tr_x1 = 8.0f; + tr_y1 = 8.0f; + + tr_param[0] = 1.0f; + tr_param[1] = 0.0f; + tr_param[2] = 0.0f; + tr_param[3] = 0.0f; + tr_param[4] = 0.0f; + + //OpenBLAS + cblas_srotmg(&te_d1, &te_d2, &te_x1, te_y1, te_param); + + ASSERT_DBL_NEAR_TOL(tr_d1, te_d1, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_d2, te_d2, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_x1, te_x1, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_y1, te_y1, SINGLE_EPS); + + for(i=0; i<5; i++){ + ASSERT_DBL_NEAR_TOL(tr_param[i], te_param[i], SINGLE_EPS); + } +} + +/** + * C API specific test + * Test srotmg by comparing it against pre-calculated values + */ +CTEST(srotmg, c_api_scaled_y_greater_than_scaled_x) +{ + float te_d1, tr_d1; + float te_d2, tr_d2; + float te_x1, tr_x1; + float te_y1, tr_y1; + float te_param[5]; + float tr_param[5]; + int i = 0; + te_d1 = tr_d1 = 1.0f; + te_d2 = tr_d2 = -2.0f; + te_x1 = tr_x1 = 8.0f; + te_y1 = tr_y1 = 8.0f; + + for(i=0; i<5; i++){ + te_param[i] = tr_param[i] = 0.0f; + } + + //reference values as calculated by netlib blas + tr_d1 = 0.0f; + tr_d2 = 0.0f; + tr_x1 = 0.0f; + tr_y1 = 8.0f; + + tr_param[0] = -1.0f; + tr_param[1] = 0.0f; + tr_param[2] = 0.0f; + tr_param[3] = 0.0f; + tr_param[4] = 0.0f; + + //OpenBLAS + cblas_srotmg(&te_d1, &te_d2, &te_x1, te_y1, te_param); + + ASSERT_DBL_NEAR_TOL(tr_d1, te_d1, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_d2, te_d2, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_x1, te_x1, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(tr_y1, te_y1, SINGLE_EPS); + + for(i=0; i<5; i++){ + ASSERT_DBL_NEAR_TOL(tr_param[i], te_param[i], SINGLE_EPS); + } +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_ssum.c b/utest/test_extensions/test_ssum.c new file mode 100644 index 000000000..971a0d2e0 --- /dev/null +++ b/utest/test_extensions/test_ssum.c @@ -0,0 +1,403 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. 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. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include + +#define ELEMENTS 50 +#define INCREMENT 2 + +#ifdef BUILD_SINGLE + +/** + * Fortran API specific test + * Test ssum by comparing it against pre-calculated values + */ +CTEST(ssum, bad_args_N_0){ + blasint i; + blasint N = 0, inc = 1; + float x[ELEMENTS]; + for (i = 0; i < ELEMENTS * inc; i ++) { + x[i] = 1000 - i; + } + float sum = BLASFUNC(ssum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0f, sum, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test ssum by comparing it against pre-calculated values + */ +CTEST(ssum, step_zero){ + blasint i; + blasint N = ELEMENTS, inc = 0; + float x[ELEMENTS]; + for (i = 0; i < N * inc; i ++) { + x[i] = i + 1000; + } + x[8] = 0.0f; + float sum = BLASFUNC(ssum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0f, sum, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test ssum by comparing it against pre-calculated values + */ +CTEST(ssum, step_1_N_1){ + blasint N = 1, inc = 1; + float x[] = {1.1f}; + + float sum = BLASFUNC(ssum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.1f, sum, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test ssum by comparing it against pre-calculated values + */ +CTEST(ssum, step_2_N_1){ + blasint N = 1, inc = 2; + float x[] = {1.1f, 0.0f}; + + float sum = BLASFUNC(ssum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.1f, sum, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test ssum by comparing it against pre-calculated values + */ +CTEST(ssum, step_1_N_2){ + blasint N = 2, inc = 1; + float x[] = {1.1f, -1.0f}; + + float sum = BLASFUNC(ssum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.1f, sum, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test ssum by comparing it against pre-calculated values + */ +CTEST(ssum, step_2_N_2){ + blasint N = 2, inc = 2; + float x[] = {1.1f, -1.5f, 1.0f, 1.0f}; + + float sum = BLASFUNC(ssum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(2.1f, sum, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test ssum by comparing it against pre-calculated values + */ +CTEST(ssum, step_1_N_3){ + blasint N = 3, inc = 1; + float x[] = {1.1f, 1.0f, 2.2f}; + + float sum = BLASFUNC(ssum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(4.3f, sum, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test ssum by comparing it against pre-calculated values + */ +CTEST(ssum, step_2_N_3){ + blasint N = 3, inc = 2; + float x[] = {1.1f, 0.0f, -1.0f, -3.0f, 2.2f, 3.0f}; + + float sum = BLASFUNC(ssum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(2.3f, sum, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test ssum by comparing it against pre-calculated values + */ +CTEST(ssum, step_1_N_4){ + blasint N = 4, inc = 1; + float x[] = {1.1f, 1.0f, -2.2f, 3.3f}; + + float sum = BLASFUNC(ssum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(3.2f, sum, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test ssum by comparing it against pre-calculated values + */ +CTEST(ssum, step_2_N_4){ + blasint N = 4, inc = 2; + float x[] = {1.1f, 0.0f, 1.0f, 2.0f, 2.2f, 2.7f, -3.3f, -5.9f}; + + float sum = BLASFUNC(ssum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(1.0f, sum, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test ssum by comparing it against pre-calculated values + */ +CTEST(ssum, step_1_N_5){ + blasint N = 5, inc = 1; + float x[] = {0.0f, 1.0f, 2.2f, 3.3f, 0.0f}; + + float sum = BLASFUNC(ssum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(6.5f, sum, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test ssum by comparing it against pre-calculated values + */ +CTEST(ssum, step_2_N_5){ + blasint N = 5, inc = 2; + float x[] = {0.0f, 3.0f, 1.0f, -2.2f, 2.2f, -1.7f, 3.3f, 14.5f, 0.0f, -9.0f}; + + float sum = BLASFUNC(ssum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(6.5f, sum, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test ssum by comparing it against pre-calculated values + */ +CTEST(ssum, step_1_N_50){ + blasint i; + blasint N = ELEMENTS, inc = 1; + float x[ELEMENTS]; + for (i = 0; i < N * inc; i ++) { + x[i] = (i & 1) ? -1.0f : 1.0f; + } + float sum = BLASFUNC(ssum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(0.0f, sum, SINGLE_EPS); +} + +/** + * Fortran API specific test + * Test ssum by comparing it against pre-calculated values + */ +CTEST(ssum, step_2_N_50){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + float x[ELEMENTS * INCREMENT]; + for (i = 0; i < N * inc; i ++) { + x[i] = (i & 1) ? -1.0f : 1.0f; + } + float sum = BLASFUNC(ssum)(&N, x, &inc); + ASSERT_DBL_NEAR_TOL(50.0f, sum, SINGLE_EPS); +} + +/** + * C API specific test + * Test ssum by comparing it against pre-calculated values + */ +CTEST(ssum, c_api_bad_args_N_0){ + blasint i; + blasint N = 0, inc = 1; + float x[ELEMENTS]; + for (i = 0; i < ELEMENTS * inc; i ++) { + x[i] = 1000 - i; + } + float sum = cblas_ssum(N, x, inc); + ASSERT_DBL_NEAR_TOL(0.0f, sum, SINGLE_EPS); +} + +/** + * C API specific test + * Test ssum by comparing it against pre-calculated values + */ +CTEST(ssum, c_api_step_zero){ + blasint i; + blasint N = ELEMENTS, inc = 0; + float x[ELEMENTS]; + for (i = 0; i < N * inc; i ++) { + x[i] = i + 1000; + } + x[8] = 0.0f; + float sum = cblas_ssum(N, x, inc); + ASSERT_DBL_NEAR_TOL(0.0f, sum, SINGLE_EPS); +} + +/** + * C API specific test + * Test ssum by comparing it against pre-calculated values + */ +CTEST(ssum, c_api_step_1_N_1){ + blasint N = 1, inc = 1; + float x[] = {1.1f}; + + float sum = cblas_ssum(N, x, inc); + ASSERT_DBL_NEAR_TOL(1.1f, sum, SINGLE_EPS); +} + +/** + * C API specific test + * Test ssum by comparing it against pre-calculated values + */ +CTEST(ssum, c_api_step_2_N_1){ + blasint N = 1, inc = 2; + float x[] = {1.1f, 0.0f}; + + float sum = cblas_ssum(N, x, inc); + ASSERT_DBL_NEAR_TOL(1.1f, sum, SINGLE_EPS); +} + +/** + * C API specific test + * Test ssum by comparing it against pre-calculated values + */ +CTEST(ssum, c_api_step_1_N_2){ + blasint N = 2, inc = 1; + float x[] = {1.1f, -1.0f}; + + float sum = cblas_ssum(N, x, inc); + ASSERT_DBL_NEAR_TOL(0.1f, sum, SINGLE_EPS); +} + +/** + * C API specific test + * Test ssum by comparing it against pre-calculated values + */ +CTEST(ssum, c_api_step_2_N_2){ + blasint N = 2, inc = 2; + float x[] = {1.1f, -1.5f, 1.0f, 1.0f}; + + float sum = cblas_ssum(N, x, inc); + ASSERT_DBL_NEAR_TOL(2.1f, sum, SINGLE_EPS); +} + +/** + * C API specific test + * Test ssum by comparing it against pre-calculated values + */ +CTEST(ssum, c_api_step_1_N_3){ + blasint N = 3, inc = 1; + float x[] = {1.1f, 1.0f, 2.2f}; + + float sum = cblas_ssum(N, x, inc); + ASSERT_DBL_NEAR_TOL(4.3f, sum, SINGLE_EPS); +} + +/** + * C API specific test + * Test ssum by comparing it against pre-calculated values + */ +CTEST(ssum, c_api_step_2_N_3){ + blasint N = 3, inc = 2; + float x[] = {1.1f, 0.0f, -1.0f, -3.0f, 2.2f, 3.0f}; + + float sum = cblas_ssum(N, x, inc); + ASSERT_DBL_NEAR_TOL(2.3f, sum, SINGLE_EPS); +} + +/** + * C API specific test + * Test ssum by comparing it against pre-calculated values + */ +CTEST(ssum, c_api_step_1_N_4){ + blasint N = 4, inc = 1; + float x[] = {1.1f, 1.0f, -2.2f, 3.3f}; + + float sum = cblas_ssum(N, x, inc); + ASSERT_DBL_NEAR_TOL(3.2f, sum, SINGLE_EPS); +} + +/** + * C API specific test + * Test ssum by comparing it against pre-calculated values + */ +CTEST(ssum, c_api_step_2_N_4){ + blasint N = 4, inc = 2; + float x[] = {1.1f, 0.0f, 1.0f, 2.0f, 2.2f, 2.7f, -3.3f, -5.9f}; + + float sum = cblas_ssum(N, x, inc); + ASSERT_DBL_NEAR_TOL(1.0f, sum, SINGLE_EPS); +} + +/** + * C API specific test + * Test ssum by comparing it against pre-calculated values + */ +CTEST(ssum, c_api_step_1_N_5){ + blasint N = 5, inc = 1; + float x[] = {0.0f, 1.0f, 2.2f, 3.3f, 0.0f}; + + float sum = cblas_ssum(N, x, inc); + ASSERT_DBL_NEAR_TOL(6.5f, sum, SINGLE_EPS); +} + +/** + * C API specific test + * Test ssum by comparing it against pre-calculated values + */ +CTEST(ssum, c_api_step_2_N_5){ + blasint N = 5, inc = 2; + float x[] = {0.0f, 3.0f, 1.0f, -2.2f, 2.2f, -1.7f, 3.3f, 14.5f, 0.0f, -9.0f}; + + float sum = cblas_ssum(N, x, inc); + ASSERT_DBL_NEAR_TOL(6.5f, sum, SINGLE_EPS); +} + +/** + * C API specific test + * Test ssum by comparing it against pre-calculated values + */ +CTEST(ssum, c_api_step_1_N_50){ + blasint i; + blasint N = ELEMENTS, inc = 1; + float x[ELEMENTS]; + for (i = 0; i < N * inc; i ++) { + x[i] = (i & 1) ? -1.0f : 1.0f; + } + float sum = cblas_ssum(N, x, inc); + ASSERT_DBL_NEAR_TOL(0.0f, sum, SINGLE_EPS); +} + +/** + * C API specific test + * Test ssum by comparing it against pre-calculated values + */ +CTEST(ssum, c_api_step_2_N_50){ + blasint i; + blasint N = ELEMENTS, inc = INCREMENT; + float x[ELEMENTS * INCREMENT]; + for (i = 0; i < N * inc; i ++) { + x[i] = (i & 1) ? -1.0f : 1.0f; + } + float sum = cblas_ssum(N, x, inc); + ASSERT_DBL_NEAR_TOL(50.0f, sum, SINGLE_EPS); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_zaxpby.c b/utest/test_extensions/test_zaxpby.c new file mode 100644 index 000000000..6148f44c5 --- /dev/null +++ b/utest/test_extensions/test_zaxpby.c @@ -0,0 +1,630 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. 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. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include "common.h" + +#define DATASIZE 100 +#define INCREMENT 2 + +struct DATA_ZAXPBY { + double x_test[DATASIZE * INCREMENT * 2]; + double x_verify[DATASIZE * INCREMENT * 2]; + double y_test[DATASIZE * INCREMENT * 2]; + double y_verify[DATASIZE * INCREMENT * 2]; +}; +#ifdef BUILD_COMPLEX16 +static struct DATA_ZAXPBY data_zaxpby; + +/** + * Fortran API specific function + * Test zaxpby by comparing it with zscal and zaxpy. + * Compare with the following options: + * + * param n - number of elements in vectors x and y + * param alpha - scalar alpha + * param incx - increment for the elements of x + * param beta - scalar beta + * param incy - increment for the elements of y + * return norm of difference + */ +static double check_zaxpby(blasint n, double *alpha, blasint incx, double *beta, blasint incy) +{ + blasint i; + + // zscal accept only positive increments + blasint incx_abs = labs(incx); + blasint incy_abs = labs(incy); + + // Fill vectors x, y + drand_generate(data_zaxpby.x_test, n * incx_abs * 2); + drand_generate(data_zaxpby.y_test, n * incy_abs * 2); + + // Copy vector x for zaxpy + for (i = 0; i < n * incx_abs * 2; i++) + data_zaxpby.x_verify[i] = data_zaxpby.x_test[i]; + + // Copy vector y for zscal + for (i = 0; i < n * incy_abs * 2; i++) + data_zaxpby.y_verify[i] = data_zaxpby.y_test[i]; + + // Find beta*y + BLASFUNC(zscal)(&n, beta, data_zaxpby.y_verify, &incy_abs); + + // Find sum of alpha*x and beta*y + BLASFUNC(zaxpy)(&n, alpha, data_zaxpby.x_verify, &incx, + data_zaxpby.y_verify, &incy); + + BLASFUNC(zaxpby)(&n, alpha, data_zaxpby.x_test, &incx, + beta, data_zaxpby.y_test, &incy); + + // Find the differences between output vector caculated by zaxpby and zaxpy + for (i = 0; i < n * incy_abs * 2; i++) + data_zaxpby.y_test[i] -= data_zaxpby.y_verify[i]; + + // Find the norm of differences + return BLASFUNC(dznrm2)(&n, data_zaxpby.y_test, &incy_abs); +} + +/** + * C API specific function + * Test zaxpby by comparing it with zscal and zaxpy. + * Compare with the following options: + * + * param n - number of elements in vectors x and y + * param alpha - scalar alpha + * param incx - increment for the elements of x + * param beta - scalar beta + * param incy - increment for the elements of y + * return norm of difference + */ +static double c_api_check_zaxpby(blasint n, double *alpha, blasint incx, double *beta, blasint incy) +{ + blasint i; + + // zscal accept only positive increments + blasint incx_abs = labs(incx); + blasint incy_abs = labs(incy); + + // Fill vectors x, y + drand_generate(data_zaxpby.x_test, n * incx_abs * 2); + drand_generate(data_zaxpby.y_test, n * incy_abs * 2); + + // Copy vector x for zaxpy + for (i = 0; i < n * incx_abs * 2; i++) + data_zaxpby.x_verify[i] = data_zaxpby.x_test[i]; + + // Copy vector y for zscal + for (i = 0; i < n * incy_abs * 2; i++) + data_zaxpby.y_verify[i] = data_zaxpby.y_test[i]; + + // Find beta*y + cblas_zscal(n, beta, data_zaxpby.y_verify, incy_abs); + + // Find sum of alpha*x and beta*y + cblas_zaxpy(n, alpha, data_zaxpby.x_verify, incx, + data_zaxpby.y_verify, incy); + + cblas_zaxpby(n, alpha, data_zaxpby.x_test, incx, + beta, data_zaxpby.y_test, incy); + + // Find the differences between output vector caculated by zaxpby and zaxpy + for (i = 0; i < n * incy_abs * 2; i++) + data_zaxpby.y_test[i] -= data_zaxpby.y_verify[i]; + + // Find the norm of differences + return cblas_dznrm2(n, data_zaxpby.y_test, incy_abs); +} + +/** + * Fortran API specific test + * Test zaxpby by comparing it with zscal and zaxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 1 + */ +CTEST(zaxpby, inc_x_1_inc_y_1_N_100) +{ + blasint n = DATASIZE, incx = 1, incy = 1; + double alpha[] = {1.0, 1.0}; + double beta[] = {1.0, 1.0}; + + double norm = check_zaxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zaxpby by comparing it with zscal and zaxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 1 + */ +CTEST(zaxpby, inc_x_2_inc_y_1_N_100) +{ + blasint n = DATASIZE, incx = 2, incy = 1; + double alpha[] = {2.0, 1.0}; + double beta[] = {1.0, 1.0}; + + double norm = check_zaxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zaxpby by comparing it with zscal and zaxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 2 + */ +CTEST(zaxpby, inc_x_1_inc_y_2_N_100) +{ + blasint n = DATASIZE, incx = 1, incy = 2; + double alpha[] = {1.0, 1.0}; + double beta[] = {2.0, 1.0}; + + double norm = check_zaxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zaxpby by comparing it with zscal and zaxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 2 + */ +CTEST(zaxpby, inc_x_2_inc_y_2_N_100) +{ + blasint n = DATASIZE, incx = 2, incy = 2; + double alpha[] = {3.0, 1.0}; + double beta[] = {4.0, 3.0}; + + double norm = check_zaxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zaxpby by comparing it with zscal and zaxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is -1 + * Stride of vector y is 2 + */ +CTEST(zaxpby, inc_x_neg_1_inc_y_2_N_100) +{ + blasint n = DATASIZE, incx = -1, incy = 2; + double alpha[] = {5.0, 2.2}; + double beta[] = {4.0, 5.0}; + + double norm = check_zaxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zaxpby by comparing it with zscal and zaxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is -1 + */ +CTEST(zaxpby, inc_x_2_inc_y_neg_1_N_100) +{ + blasint n = DATASIZE, incx = 2, incy = -1; + double alpha[] = {1.0, 1.0}; + double beta[] = {6.0, 3.0}; + + double norm = check_zaxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zaxpby by comparing it with zscal and zaxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is -2 + * Stride of vector y is -1 + */ +CTEST(zaxpby, inc_x_neg_2_inc_y_neg_1_N_100) +{ + blasint n = DATASIZE, incx = -2, incy = -1; + double alpha[] = {7.0, 2.0}; + double beta[] = {3.5, 1.3}; + + double norm = check_zaxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zaxpby by comparing it with zscal and zaxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 1 + * Scalar alpha is zero + */ +CTEST(zaxpby, inc_x_1_inc_y_1_N_100_alpha_zero) +{ + blasint n = DATASIZE, incx = 1, incy = 1; + double alpha[] = {0.0, 0.0}; + double beta[] = {1.0, 1.0}; + + double norm = check_zaxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zaxpby by comparing it with zscal and zaxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 1 + * Scalar beta is zero + */ +CTEST(zaxpby, inc_x_1_inc_y_1_N_100_beta_zero) +{ + blasint n = DATASIZE, incx = 1, incy = 1; + double alpha[] = {1.0, 1.0}; + double beta[] = {0.0, 0.0}; + + double norm = check_zaxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zaxpby by comparing it with zscal and zaxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 1 + * Scalar alpha is zero + * Scalar beta is zero + */ +CTEST(zaxpby, inc_x_1_inc_y_1_N_100_alpha_beta_zero) +{ + blasint n = DATASIZE, incx = 1, incy = 1; + double alpha[] = {0.0, 0.0}; + double beta[] = {0.0, 0.0}; + + double norm = check_zaxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zaxpby by comparing it with zscal and zaxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 2 + * Scalar alpha is zero + * Scalar beta is zero +*/ +CTEST(zaxpby, inc_x_1_inc_y_2_N_100_alpha_beta_zero) +{ + blasint n = DATASIZE, incx = 1, incy = 2; + double alpha[] = {0.0, 0.0}; + double beta[] = {0.0, 0.0}; + + double norm = check_zaxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Check if n - size of vectors x, y is zero + */ +CTEST(zaxpby, check_n_zero) +{ + blasint n = 0, incx = 1, incy = 1; + double alpha[] = {1.0, 1.0}; + double beta[] = {1.0, 1.0}; + + double norm = check_zaxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zaxpby by comparing it with zscal and zaxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 1 + */ +CTEST(zaxpby, c_api_inc_x_1_inc_y_1_N_100) +{ + blasint n = DATASIZE, incx = 1, incy = 1; + double alpha[] = {1.0, 1.0}; + double beta[] = {1.0, 1.0}; + + double norm = c_api_check_zaxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zaxpby by comparing it with zscal and zaxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 1 + */ +CTEST(zaxpby, c_api_inc_x_2_inc_y_1_N_100) +{ + blasint n = DATASIZE, incx = 2, incy = 1; + double alpha[] = {2.0, 1.0}; + double beta[] = {1.0, 1.0}; + + double norm = c_api_check_zaxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zaxpby by comparing it with zscal and zaxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 2 + */ +CTEST(zaxpby, c_api_inc_x_1_inc_y_2_N_100) +{ + blasint n = DATASIZE, incx = 1, incy = 2; + double alpha[] = {1.0, 1.0}; + double beta[] = {2.0, 2.1}; + + double norm = c_api_check_zaxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zaxpby by comparing it with zscal and zaxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 2 + */ +CTEST(zaxpby, c_api_inc_x_2_inc_y_2_N_100) +{ + blasint n = DATASIZE, incx = 2, incy = 2; + double alpha[] = {3.0, 2.0}; + double beta[] = {4.0, 3.0}; + + double norm = c_api_check_zaxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zaxpby by comparing it with zscal and zaxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is -1 + * Stride of vector y is 2 + */ +CTEST(zaxpby, c_api_inc_x_neg_1_inc_y_2_N_100) +{ + blasint n = DATASIZE, incx = -1, incy = 2; + double alpha[] = {5.0, 2.0}; + double beta[] = {4.0, 3.1}; + + double norm = c_api_check_zaxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zaxpby by comparing it with zscal and zaxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is -1 + */ +CTEST(zaxpby, c_api_inc_x_2_inc_y_neg_1_N_100) +{ + blasint n = DATASIZE, incx = 2, incy = -1; + double alpha[] = {1.0, 1.0}; + double beta[] = {6.0, 2.3}; + + double norm = c_api_check_zaxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zaxpby by comparing it with zscal and zaxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is -2 + * Stride of vector y is -1 + */ +CTEST(zaxpby, c_api_inc_x_neg_2_inc_y_neg_1_N_100) +{ + blasint n = DATASIZE, incx = -2, incy = -1; + double alpha[] = {7.0, 1.0}; + double beta[] = {3.5, 1.0}; + + double norm = c_api_check_zaxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zaxpby by comparing it with zscal and zaxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 1 + * Scalar alpha is zero + */ +CTEST(zaxpby, c_api_inc_x_1_inc_y_1_N_100_alpha_zero) +{ + blasint n = DATASIZE, incx = 1, incy = 1; + double alpha[] = {0.0, 0.0}; + double beta[] = {1.0, 1.0}; + + double norm = c_api_check_zaxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zaxpby by comparing it with zscal and zaxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 1 + * Scalar beta is zero + */ +CTEST(zaxpby, c_api_inc_x_1_inc_y_1_N_100_beta_zero) +{ + blasint n = DATASIZE, incx = 1, incy = 1; + double alpha[] = {1.0, 1.0}; + double beta[] = {0.0, 0.0}; + + double norm = c_api_check_zaxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zaxpby by comparing it with zscal and zaxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 1 + * Scalar alpha is zero + * Scalar beta is zero + */ +CTEST(zaxpby, c_api_inc_x_1_inc_y_1_N_100_alpha_beta_zero) +{ + blasint n = DATASIZE, incx = 1, incy = 1; + double alpha[] = {0.0, 0.0}; + double beta[] = {0.0, 0.0}; + + double norm = c_api_check_zaxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zaxpby by comparing it with zscal and zaxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 2 + * Scalar alpha is zero + * Scalar beta is zero +*/ +CTEST(zaxpby, c_api_inc_x_1_inc_y_2_N_100_alpha_beta_zero) +{ + blasint n = DATASIZE, incx = 1, incy = 2; + double alpha[] = {0.0, 0.0}; + double beta[] = {0.0, 0.0}; + + double norm = c_api_check_zaxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Check if n - size of vectors x, y is zero + */ +CTEST(zaxpby, c_api_check_n_zero) +{ + blasint n = 0, incx = 1, incy = 1; + double alpha[] = {1.0, 1.0}; + double beta[] = {1.0, 1.0}; + + double norm = c_api_check_zaxpby(n, alpha, incx, beta, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} +#endif diff --git a/utest/test_extensions/test_zaxpyc.c b/utest/test_extensions/test_zaxpyc.c new file mode 100644 index 000000000..7c11cd920 --- /dev/null +++ b/utest/test_extensions/test_zaxpyc.c @@ -0,0 +1,159 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. 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. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include "common.h" + +#define DATASIZE 100 +#define INCREMENT 2 + +struct DATA_ZAXPYC { + double x_test[DATASIZE * INCREMENT * 2]; + double x_verify[DATASIZE * INCREMENT * 2]; + double y_test[DATASIZE * INCREMENT * 2]; + double y_verify[DATASIZE * INCREMENT * 2]; +}; +#ifdef BUILD_COMPLEX16 +static struct DATA_ZAXPYC data_zaxpyc; + +/** + * Test zaxpyc by conjugating vector x and comparing with zaxpy. + * Compare with the following options: + * + * param n - number of elements in vectors x and y + * param alpha - scalar alpha + * param incx - increment for the elements of x + * param incy - increment for the elements of y + * return norm of difference + */ +static double check_zaxpyc(blasint n, double *alpha, blasint incx, blasint incy) +{ + blasint i; + + drand_generate(data_zaxpyc.x_test, n * incx * 2); + drand_generate(data_zaxpyc.y_test, n * incy * 2); + + for (i = 0; i < n * incx * 2; i++) + data_zaxpyc.x_verify[i] = data_zaxpyc.x_test[i]; + + for (i = 0; i < n * incy * 2; i++) + data_zaxpyc.y_verify[i] = data_zaxpyc.y_test[i]; + + zconjugate_vector(n, incx, data_zaxpyc.x_verify); + + BLASFUNC(zaxpy) + (&n, alpha, data_zaxpyc.x_verify, &incx, + data_zaxpyc.y_verify, &incy); + + BLASFUNC(zaxpyc) + (&n, alpha, data_zaxpyc.x_test, &incx, + data_zaxpyc.y_test, &incy); + + for (i = 0; i < n * incy * 2; i++) + data_zaxpyc.y_verify[i] -= data_zaxpyc.y_test[i]; + + return BLASFUNC(dznrm2)(&n, data_zaxpyc.y_verify, &incy); +} + +/** + * Test zaxpyc by conjugating vector x and comparing with zaxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 1 + */ +CTEST(zaxpyc, conj_strides_one) +{ + blasint n = DATASIZE, incx = 1, incy = 1; + double alpha[] = {5.0, 2.2}; + + double norm = check_zaxpyc(n, alpha, incx, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Test zaxpyc by conjugating vector x and comparing with zaxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 2 + */ +CTEST(zaxpyc, conj_incx_one) +{ + blasint n = DATASIZE, incx = 1, incy = 2; + double alpha[] = {5.0, 2.2}; + + double norm = check_zaxpyc(n, alpha, incx, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Test zaxpyc by conjugating vector x and comparing with zaxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 1 + */ +CTEST(zaxpyc, conj_incy_one) +{ + blasint n = DATASIZE, incx = 2, incy = 1; + double alpha[] = {5.0, 2.2}; + + double norm = check_zaxpyc(n, alpha, incx, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Test zaxpyc by conjugating vector x and comparing with zaxpy. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 2 + */ +CTEST(zaxpyc, conj_strides_two) +{ + blasint n = DATASIZE, incx = 2, incy = 2; + double alpha[] = {5.0, 2.2}; + + double norm = check_zaxpyc(n, alpha, incx, incy); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} +#endif diff --git a/utest/test_extensions/test_zgbmv.c b/utest/test_extensions/test_zgbmv.c new file mode 100644 index 000000000..55473361c --- /dev/null +++ b/utest/test_extensions/test_zgbmv.c @@ -0,0 +1,280 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. 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. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include "common.h" + +#define DATASIZE 100 +#define INCREMENT 1 + +struct DATA_ZGBMV { + double a_test[DATASIZE * DATASIZE * 2]; + double a_band_storage[DATASIZE * DATASIZE * 2]; + double matrix[DATASIZE * DATASIZE * 2]; + double b_test[DATASIZE * 2 * INCREMENT]; + double c_test[DATASIZE * 2 * INCREMENT]; + double c_verify[DATASIZE * 2 * INCREMENT]; +}; + +#ifdef BUILD_COMPLEX16 + +static struct DATA_ZGBMV data_zgbmv; + +/** + * Transform full-storage band matrix A to band-packed storage mode. + * + * param m - number of rows of A + * param n - number of columns of A + * param kl - number of sub-diagonals of the matrix A + * param ku - number of super-diagonals of the matrix A + * output param a - buffer for holding band-packed matrix + * param lda - specifies the leading dimension of a + * param matrix - buffer holding full-storage band matrix A + * param ldm - specifies the leading full-storage band matrix A + */ +static void transform_to_band_storage(blasint m, blasint n, blasint kl, + blasint ku, double* a, blasint lda, + double* matrix, blasint ldm) +{ + blasint i, j, k; + for (j = 0; j < n; j++) + { + k = 2 * (ku - j); + for (i = MAX(0, 2*(j - ku)); i < MIN(m, j + kl + 1) * 2; i+=2) + { + a[(k + i) + j * lda * 2] = matrix[i + j * ldm * 2]; + a[(k + i) + j * lda * 2 + 1] = matrix[i + j * ldm * 2 + 1]; + } + } +} + +/** + * Generate full-storage band matrix A with kl sub-diagonals and ku super-diagonals + * + * param m - number of rows of A + * param n - number of columns of A + * param kl - number of sub-diagonals of the matrix A + * param ku - number of super-diagonals of the matrix A + * output param band_matrix - buffer for full-storage band matrix. + * param matrix - buffer holding input general matrix + * param ldm - specifies the leading of input general matrix + */ +static void get_band_matrix(blasint m, blasint n, blasint kl, blasint ku, + double *band_matrix, double *matrix, blasint ldm) +{ + blasint i, j; + blasint k = 0; + for (i = 0; i < n; i++) + { + for (j = 0; j < m * 2; j += 2) + { + if ((blasint)(j/2) > kl + i || i > ku + (blasint)(j/2)) + { + band_matrix[i * ldm * 2 + j] = 0.0; + band_matrix[i * ldm * 2 + j + 1] = 0.0; + continue; + } + + band_matrix[i * ldm * 2 + j] = matrix[k++]; + band_matrix[i * ldm * 2 + j + 1] = matrix[k++]; + } + } +} + +/** + * Comapare results computed by zgbmv and zgemv + * since gbmv is gemv for band matrix + * + * param trans specifies op(A), the transposition operation applied to A + * param m - number of rows of A + * param n - number of columns of A + * param kl - number of sub-diagonals of the matrix A + * param ku - number of super-diagonals of the matrix A + * param alpha - scaling factor for the matrix-vector product + * param lda - specifies the leading dimension of a + * param inc_b - stride of vector b + * param beta - scaling factor for vector c + * param inc_c - stride of vector c + * return norm of differences + */ +static double check_zgbmv(char trans, blasint m, blasint n, blasint kl, blasint ku, + double *alpha, blasint lda, blasint inc_b, double *beta, blasint inc_c) +{ + blasint i; + blasint lenb, lenc; + + if(trans == 'T' || trans == 'C' || trans == 'D' || trans == 'U'){ + lenb = m; + lenc = n; + } else { + lenb = n; + lenc = m; + } + + drand_generate(data_zgbmv.matrix, m * n * 2); + drand_generate(data_zgbmv.b_test, 2 * (1 + (lenb - 1) * inc_b)); + drand_generate(data_zgbmv.c_test, 2 * (1 + (lenc - 1) * inc_c)); + + for (i = 0; i < 2 * (1 + (lenc - 1) * inc_c); i++) + data_zgbmv.c_verify[i] = data_zgbmv.c_test[i]; + + get_band_matrix(m, n, kl, ku, data_zgbmv.a_test, data_zgbmv.matrix, m); + + transform_to_band_storage(m, n, kl, ku, data_zgbmv.a_band_storage, lda, data_zgbmv.a_test, m); + + BLASFUNC(zgemv)(&trans, &m, &n, alpha, data_zgbmv.a_test, &m, data_zgbmv.b_test, + &inc_b, beta, data_zgbmv.c_verify, &inc_c); + + BLASFUNC(zgbmv)(&trans, &m, &n, &kl, &ku, alpha, data_zgbmv.a_band_storage, &lda, data_zgbmv.b_test, + &inc_b, beta, data_zgbmv.c_test, &inc_c); + + for (i = 0; i < 2 * (1 + (lenc - 1) * inc_c); i++) + data_zgbmv.c_verify[i] -= data_zgbmv.c_test[i]; + + return BLASFUNC(dznrm2)(&lenc, data_zgbmv.c_verify, &inc_c); +} + +/** + * Test zgbmv by comparing it against zgemv + * with param trans is D + */ +CTEST(zgbmv, trans_D) +{ + blasint m = 50, n = 25; + blasint inc_b = 1, inc_c = 1; + blasint kl = 20, ku = 11; + blasint lda = 50; + char trans = 'D'; + + double alpha[] = {7.0, 1.0}; + double beta[] = {1.5, -1.5}; + + double norm = check_zgbmv(trans, m, n, kl, ku, alpha, lda, inc_b, beta, inc_c); + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_TOL); +} + +/** + * Test zgbmv by comparing it against zgemv + * with param trans is O + */ +CTEST(zgbmv, trans_O) +{ + blasint m = 50, n = 25; + blasint inc_b = 1, inc_c = 1; + blasint kl = 20, ku = 10; + blasint lda = 50; + char trans = 'O'; + + double alpha[] = {7.0, 1.0}; + double beta[] = {1.5, -1.5}; + + double norm = check_zgbmv(trans, m, n, kl, ku, alpha, lda, inc_b, beta, inc_c); + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_TOL); +} + +/** + * Test zgbmv by comparing it against zgemv + * with param trans is S + */ +CTEST(zgbmv, trans_S) +{ + blasint m = 50, n = 25; + blasint inc_b = 1, inc_c = 1; + blasint kl = 6, ku = 9; + blasint lda = 50; + char trans = 'S'; + + double alpha[] = {7.0, 1.0}; + double beta[] = {1.5, -1.5}; + + double norm = check_zgbmv(trans, m, n, kl, ku, alpha, lda, inc_b, beta, inc_c); + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_TOL); +} + +/** + * Test zgbmv by comparing it against zgemv + * with param trans is U + */ +CTEST(zgbmv, trans_U) +{ + blasint m = 25, n = 50; + blasint inc_b = 1, inc_c = 1; + blasint kl = 7, ku = 11; + blasint lda = kl + ku + 1; + char trans = 'U'; + + double alpha[] = {7.0, 1.0}; + double beta[] = {1.5, -1.5}; + + double norm = check_zgbmv(trans, m, n, kl, ku, alpha, lda, inc_b, beta, inc_c); + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_TOL); +} + +/** + * Test zgbmv by comparing it against zgemv + * with param trans is C + */ +CTEST(zgbmv, trans_C) +{ + blasint m = 50, n = 25; + blasint inc_b = 1, inc_c = 1; + blasint kl = 20, ku = 11; + blasint lda = 50; + char trans = 'C'; + + double alpha[] = {7.0, 1.0}; + double beta[] = {1.5, -1.5}; + + double norm = check_zgbmv(trans, m, n, kl, ku, alpha, lda, inc_b, beta, inc_c); + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_TOL); +} + +/** + * Test zgbmv by comparing it against zgemv + * with param trans is R + */ +CTEST(zgbmv, trans_R) +{ + blasint m = 50, n = 100; + blasint inc_b = 1, inc_c = 1; + blasint kl = 20, ku = 11; + blasint lda = 50; + char trans = 'R'; + + double alpha[] = {7.0, 1.0}; + double beta[] = {1.5, -1.5}; + + double norm = check_zgbmv(trans, m, n, kl, ku, alpha, lda, inc_b, beta, inc_c); + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_TOL); +} +#endif diff --git a/utest/test_extensions/test_zgeadd.c b/utest/test_extensions/test_zgeadd.c new file mode 100644 index 000000000..917c04829 --- /dev/null +++ b/utest/test_extensions/test_zgeadd.c @@ -0,0 +1,880 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. 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. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include "common.h" + +#define N 100 +#define M 100 + +struct DATA_ZGEADD { + double a_test[M * N * 2]; + double c_test[M * N * 2]; + double c_verify[M * N * 2]; +}; + +#ifdef BUILD_COMPLEX16 +static struct DATA_ZGEADD data_zgeadd; + +/** + * zgeadd reference implementation + * + * param m - number of rows of A and C + * param n - number of columns of A and C + * param alpha - scaling factor for matrix A + * param aptr - refer to matrix A + * param lda - leading dimension of A + * param beta - scaling factor for matrix C + * param cptr - refer to matrix C + * param ldc - leading dimension of C + */ +static void zgeadd_trusted(blasint m, blasint n, double *alpha, double *aptr, + blasint lda, double *beta, double *cptr, blasint ldc) +{ + blasint i; + + lda *= 2; + ldc *= 2; + + for (i = 0; i < n; i++) + { + cblas_zaxpby(m, alpha, aptr, 1, beta, cptr, 1); + aptr += lda; + cptr += ldc; + } +} + +/** + * Test zgeadd by comparing it against reference + * Compare with the following options: + * + * param api - specifies Fortran or C API + * param order - specifies whether A and C stored in + * row-major order or column-major order + * param m - number of rows of A and C + * param n - number of columns of A and C + * param alpha - scaling factor for matrix A + * param lda - leading dimension of A + * param beta - scaling factor for matrix C + * param ldc - leading dimension of C + * return norm of differences + */ +static double check_zgeadd(char api, OPENBLAS_CONST enum CBLAS_ORDER order, + blasint m, blasint n, double *alpha, blasint lda, + double *beta, blasint ldc) +{ + blasint i; + blasint cols = m, rows = n; + + if (order == CblasRowMajor) + { + rows = m; + cols = n; + } + + // Fill matrix A, C + srand_generate(data_zgeadd.a_test, lda * rows * 2); + srand_generate(data_zgeadd.c_test, ldc * rows * 2); + + // Copy matrix C for zgeadd + for (i = 0; i < ldc * rows * 2; i++) + data_zgeadd.c_verify[i] = data_zgeadd.c_test[i]; + + zgeadd_trusted(cols, rows, alpha, data_zgeadd.a_test, lda, + beta, data_zgeadd.c_verify, ldc); + + if (api == 'F') + BLASFUNC(zgeadd)(&m, &n, alpha, data_zgeadd.a_test, &lda, + beta, data_zgeadd.c_test, &ldc); + else + cblas_zgeadd(order, m, n, alpha, data_zgeadd.a_test, lda, + beta, data_zgeadd.c_test, ldc); + + // Find the differences between output matrix caculated by zgeadd and sgemm + return dmatrix_difference(data_zgeadd.c_test, data_zgeadd.c_verify, cols, rows, ldc * 2); +} + +/** + * Check if error function was called with expected function name + * and param info + * + * param api - specifies Fortran or C API + * param order - specifies whether A and C stored in + * row-major order or column-major order + * param m - number of rows of A and C + * param n - number of columns of A and C + * param lda - leading dimension of A + * param ldc - leading dimension of C + * param expected_info - expected invalid parameter number in zgeadd + * return TRUE if everything is ok, otherwise FALSE + */ +static int check_badargs(char api, OPENBLAS_CONST enum CBLAS_ORDER order, + blasint m, blasint n, blasint lda, + blasint ldc, int expected_info) +{ + double alpha[] = {1.0, 1.0}; + double beta[] = {1.0, 1.0}; + + set_xerbla("ZGEADD ", expected_info); + + if (api == 'F') + BLASFUNC(zgeadd)(&m, &n, alpha, data_zgeadd.a_test, &lda, + beta, data_zgeadd.c_test, &ldc); + else + cblas_zgeadd(order, m, n, alpha, data_zgeadd.a_test, lda, + beta, data_zgeadd.c_test, ldc); + + return check_error(); +} + +/** + * Fortran API specific test + * Test zgeadd by comparing it against reference + * with the following options: + * + * For A number of rows is 100, number of colums is 100 + * For C number of rows is 100, number of colums is 100 + */ +CTEST(zgeadd, matrix_n_100_m_100) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = N; + blasint m = M; + + blasint lda = m; + blasint ldc = m; + + double alpha[] = {3.0, 2.0}; + double beta[] = {1.0, 3.0}; + + double norm = check_zgeadd('F', order, m, n, alpha, lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zgeadd by comparing it against reference + * with the following options: + * + * For A number of rows is 100, number of colums is 100 + * For C number of rows is 100, number of colums is 100 + * Scalar alpha is zero (operation is C:=beta*C) + */ +CTEST(zgeadd, matrix_n_100_m_100_alpha_zero) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = N; + blasint m = M; + + blasint lda = m; + blasint ldc = m; + + double alpha[] = {0.0, 0.0}; + double beta[] = {1.0, 1.0}; + + double norm = check_zgeadd('F', order, m, n, alpha, lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zgeadd by comparing it against reference + * with the following options: + * + * For A number of rows is 100, number of colums is 100 + * For C number of rows is 100, number of colums is 100 + * Scalar beta is zero (operation is C:=alpha*A) + */ +CTEST(zgeadd, matrix_n_100_m_100_beta_zero) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = N; + blasint m = M; + + blasint lda = m; + blasint ldc = m; + + double alpha[] = {3.0, 1.5}; + double beta[] = {0.0, 0.0}; + + double norm = check_zgeadd('F', order, m, n, alpha, lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zgeadd by comparing it against reference + * with the following options: + * + * For A number of rows is 100, number of colums is 100 + * For C number of rows is 100, number of colums is 100 + * Scalars alpha, beta is zero (operation is C:= 0) + */ +CTEST(zgeadd, matrix_n_100_m_100_alpha_beta_zero) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = N; + blasint m = M; + + blasint lda = m; + blasint ldc = m; + + double alpha[] = {0.0, 0.0}; + double beta[] = {0.0, 0.0}; + + double norm = check_zgeadd('F', order, m, n, alpha, lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zgeadd by comparing it against reference + * with the following options: + * + * For A number of rows is 50, number of colums is 100 + * For C number of rows is 50, number of colums is 100 + */ +CTEST(zgeadd, matrix_n_100_m_50) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = N; + blasint m = M / 2; + + blasint lda = m; + blasint ldc = m; + + double alpha[] = {1.0, 1.0}; + double beta[] = {1.0, 1.0}; + + double norm = check_zgeadd('F', order, m, n, alpha, lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test error function for an invalid param n - + * number of columns of A and C + * Must be at least zero. + */ +CTEST(zgeadd, xerbla_n_invalid) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = INVALID; + blasint m = 1; + + blasint lda = m; + blasint ldc = m; + + int expected_info = 2; + + int passed = check_badargs('F', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param m - + * number of rows of A and C + * Must be at least zero. + */ +CTEST(zgeadd, xerbla_m_invalid) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = 1; + blasint m = INVALID; + + blasint lda = 1; + blasint ldc = 1; + + int expected_info = 1; + + int passed = check_badargs('F', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param lda - + * specifies the leading dimension of A. Must be at least MAX(1, m). + */ +CTEST(zgeadd, xerbla_lda_invalid) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = 1; + blasint m = 1; + + blasint lda = INVALID; + blasint ldc = 1; + + int expected_info = 6; + + int passed = check_badargs('F', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param ldc - + * specifies the leading dimension of C. Must be at least MAX(1, m). + */ +CTEST(zgeadd, xerbla_ldc_invalid) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = 1; + blasint m = 1; + + blasint lda = 1; + blasint ldc = INVALID; + + int expected_info = 8; + + int passed = check_badargs('F', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Check if n - number of columns of A, C equal zero. + */ +CTEST(zgeadd, n_zero) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = 0; + blasint m = 1; + + blasint lda = 1; + blasint ldc = 1; + + double alpha[] = {1.0, 1.0}; + double beta[] = {1.0, 1.0}; + + double norm = check_zgeadd('F', order, m, n, alpha, lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Check if m - number of rows of A and C equal zero. + */ +CTEST(zgeadd, m_zero) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = 1; + blasint m = 0; + + blasint lda = 1; + blasint ldc = 1; + + double alpha[] = {1.0, 1.0}; + double beta[] = {1.0, 1.0}; + + double norm = check_zgeadd('F', order, m, n, alpha, lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgeadd by comparing it against reference + * with the following options: + * + * c api option order is column-major order + * For A number of rows is 100, number of colums is 100 + * For C number of rows is 100, number of colums is 100 + */ +CTEST(zgeadd, c_api_matrix_n_100_m_100) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = N; + blasint m = M; + + blasint lda = m; + blasint ldc = m; + + double alpha[] = {2.0, 1.0}; + double beta[] = {1.0, 3.0}; + + double norm = check_zgeadd('C', order, m, n, alpha, + lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgeadd by comparing it against reference + * with the following options: + * + * c api option order is row-major order + * For A number of rows is 100, number of colums is 100 + * For C number of rows is 100, number of colums is 100 + */ +CTEST(zgeadd, c_api_matrix_n_100_m_100_row_major) +{ + CBLAS_ORDER order = CblasRowMajor; + + blasint n = N; + blasint m = M; + + blasint lda = m; + blasint ldc = m; + + double alpha[] = {4.0, 1.5}; + double beta[] = {2.0, 1.0}; + + double norm = check_zgeadd('C', order, m, n, alpha, + lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgeadd by comparing it against reference + * with the following options: + * + * c api option order is row-major order + * For A number of rows is 50, number of colums is 100 + * For C number of rows is 50, number of colums is 100 + */ +CTEST(zgeadd, c_api_matrix_n_50_m_100_row_major) +{ + CBLAS_ORDER order = CblasRowMajor; + + blasint n = N / 2; + blasint m = M; + + blasint lda = n; + blasint ldc = n; + + double alpha[] = {3.0, 2.5}; + double beta[] = {1.0, 2.0}; + + double norm = check_zgeadd('C', order, m, n, alpha, + lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgeadd by comparing it against reference + * with the following options: + * + * c api option order is column-major order + * For A number of rows is 100, number of colums is 100 + * For C number of rows is 100, number of colums is 100 + * Scalar alpha is zero (operation is C:=beta*C) + */ +CTEST(zgeadd, c_api_matrix_n_100_m_100_alpha_zero) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = N; + blasint m = M; + + blasint lda = m; + blasint ldc = m; + + double alpha[] = {0.0, 0.0}; + double beta[] = {1.0, 1.0}; + + double norm = check_zgeadd('C', order, m, n, alpha, + lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgeadd by comparing it against reference + * with the following options: + * + * c api option order is column-major order + * For A number of rows is 100, number of colums is 100 + * For C number of rows is 100, number of colums is 100 + * Scalar beta is zero (operation is C:=alpha*A) + */ +CTEST(zgeadd, c_api_matrix_n_100_m_100_beta_zero) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = N; + blasint m = M; + + blasint lda = m; + blasint ldc = m; + + double alpha[] = {3.0, 1.5}; + double beta[] = {0.0, 0.0}; + + double norm = check_zgeadd('C', order, m, n, alpha, + lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgeadd by comparing it against reference + * with the following options: + * + * c api option order is column-major order + * For A number of rows is 100, number of colums is 100 + * For C number of rows is 100, number of colums is 100 + * Scalars alpha, beta is zero (operation is C:= 0) + */ +CTEST(zgeadd, c_api_matrix_n_100_m_100_alpha_beta_zero) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = N; + blasint m = M; + + blasint lda = m; + blasint ldc = m; + + double alpha[] = {0.0, 0.0}; + double beta[] = {0.0, 0.0}; + + double norm = check_zgeadd('C', order, m, n, alpha, + lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgeadd by comparing it against reference + * with the following options: + * + * For A number of rows is 50, number of colums is 100 + * For C number of rows is 50, number of colums is 100 + */ +CTEST(zgeadd, c_api_matrix_n_100_m_50) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = N; + blasint m = M / 2; + + blasint lda = m; + blasint ldc = m; + + double alpha[] = {2.0, 3.0}; + double beta[] = {2.0, 4.0}; + + double norm = check_zgeadd('C', order, m, n, alpha, + lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test error function for an invalid param order - + * specifies whether A and C stored in + * row-major order or column-major order + */ +CTEST(zgeadd, c_api_xerbla_invalid_order) +{ + CBLAS_ORDER order = INVALID; + + blasint n = 1; + blasint m = 1; + + blasint lda = 1; + blasint ldc = 1; + + int expected_info = 0; + + int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param n - + * number of columns of A and C. + * Must be at least zero. + * + * c api option order is column-major order + */ +CTEST(zgeadd, c_api_xerbla_n_invalid) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = INVALID; + blasint m = 1; + + blasint lda = 1; + blasint ldc = 1; + + int expected_info = 2; + + int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param n - + * number of columns of A and C. + * Must be at least zero. + * + * c api option order is row-major order + */ +CTEST(zgeadd, c_api_xerbla_n_invalid_row_major) +{ + CBLAS_ORDER order = CblasRowMajor; + + blasint n = INVALID; + blasint m = 1; + + blasint lda = 1; + blasint ldc = 1; + + int expected_info = 1; + + int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param m - + * number of rows of A and C + * Must be at least zero. + * + * c api option order is column-major order + */ +CTEST(zgeadd, c_api_xerbla_m_invalid) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = 1; + blasint m = INVALID; + + blasint lda = 1; + blasint ldc = 1; + + int expected_info = 1; + + int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param m - + * number of rows of A and C + * Must be at least zero. + * + * c api option order is row-major order + */ +CTEST(zgeadd, c_api_xerbla_m_invalid_row_major) +{ + CBLAS_ORDER order = CblasRowMajor; + + blasint n = 1; + blasint m = INVALID; + + blasint lda = 1; + blasint ldc = 1; + + int expected_info = 2; + + int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param lda - + * specifies the leading dimension of A. Must be at least MAX(1, m). + * + * c api option order is column-major order + */ +CTEST(zgeadd, c_api_xerbla_lda_invalid) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = 1; + blasint m = 1; + + blasint lda = INVALID; + blasint ldc = 1; + + int expected_info = 5; + + int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param lda - + * specifies the leading dimension of A. Must be at least MAX(1, m). + * + * c api option order is row-major order + */ +CTEST(zgeadd, c_api_xerbla_lda_invalid_row_major) +{ + CBLAS_ORDER order = CblasRowMajor; + + blasint n = 1; + blasint m = 1; + + blasint lda = INVALID; + blasint ldc = 1; + + int expected_info = 5; + + int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param ldc - + * specifies the leading dimension of C. Must be at least MAX(1, m). + * + * c api option order is column-major order + */ +CTEST(zgeadd, c_api_xerbla_ldc_invalid) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = 1; + blasint m = 1; + + blasint lda = 1; + blasint ldc = INVALID; + + int expected_info = 8; + + int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param ldc - + * specifies the leading dimension of C. Must be at least MAX(1, m). + * + * c api option order is row-major order + */ +CTEST(zgeadd, c_api_xerbla_ldc_invalid_row_major) +{ + CBLAS_ORDER order = CblasRowMajor; + + blasint n = 1; + blasint m = 1; + + blasint lda = 1; + blasint ldc = INVALID; + + int expected_info = 8; + + int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Check if n - number of columns of A, C equal zero. + * + * c api option order is column-major order + */ +CTEST(zgeadd, c_api_n_zero) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = 0; + blasint m = 1; + + blasint lda = 1; + blasint ldc = 1; + + double alpha[] = {1.0, 1.0}; + double beta[] = {1.0, 1.0}; + + double norm = check_zgeadd('C', order, m, n, alpha, + lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Check if m - number of rows of A and C equal zero. + * + * c api option order is column-major order + */ +CTEST(zgeadd, c_api_m_zero) +{ + CBLAS_ORDER order = CblasColMajor; + + blasint n = 1; + blasint m = 0; + + blasint lda = 1; + blasint ldc = 1; + + double alpha[] = {1.0, 1.0}; + double beta[] = {1.0, 1.0}; + + double norm = check_zgeadd('C', order, m, n, alpha, + lda, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_zgemm.c b/utest/test_extensions/test_zgemm.c new file mode 100644 index 000000000..4160a5086 --- /dev/null +++ b/utest/test_extensions/test_zgemm.c @@ -0,0 +1,273 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. 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. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include +#include "common.h" + +#define DATASIZE 100 +#define INCREMENT 2 + +struct DATA_ZGEMM { + double a_test[DATASIZE * DATASIZE * 2]; + double a_verify[DATASIZE * DATASIZE * 2]; + double b_test[DATASIZE * DATASIZE * 2]; + double b_verify[DATASIZE * DATASIZE * 2]; + double c_test[DATASIZE * DATASIZE * 2]; + double c_verify[DATASIZE * DATASIZE * 2]; +}; + +#ifdef BUILD_COMPLEX16 +static struct DATA_ZGEMM data_zgemm; + +/** + * Test zgemm with the conjugate matrices by conjugating and not transposed matrices + * and comparing it with the non-conjugate zgemm. + * + * param transa specifies op(A), the transposition (conjugation) operation applied to A + * param transb specifies op(B), the transposition (conjugation) operation applied to B + * param m specifies the number of rows of the matrix op(A) and of the matrix C + * param n specifies the number of columns of the matrix op(B) and the number of columns of the matrix C + * param k specifies the number of columns of the matrix op(A) and the number of rows of the matrix op(B) + * param alpha - scaling factor for the matrix-matrix product + * param lda - leading dimension of matrix A + * param ldb - leading dimension of matrix B + * param beta - scaling factor for matrix C + * param ldc - leading dimension of matrix C + * return norm of difference + */ +static double check_zgemm(char transa, char transb, blasint m, blasint n, blasint k, + double *alpha, blasint lda, blasint ldb, double *beta, blasint ldc) +{ + blasint i; + double alpha_conj[] = {1.0, 0.0}; + char transa_verify = transa; + char transb_verify = transb; + + int arows = k, acols = m; + int brows = n, bcols = k; + + if (transa == 'T' || transa == 'C'){ + arows = m; acols = k; + } + + if (transb == 'T' || transb == 'C'){ + brows = k; bcols = n; + } + + drand_generate(data_zgemm.a_test, arows * lda * 2); + drand_generate(data_zgemm.b_test, brows * ldb * 2); + drand_generate(data_zgemm.c_test, n * ldc * 2); + + for (i = 0; i < arows * lda * 2; i++) + data_zgemm.a_verify[i] = data_zgemm.a_test[i]; + + for (i = 0; i < brows * ldb * 2; i++) + data_zgemm.b_verify[i] = data_zgemm.b_test[i]; + + for (i = 0; i < n * ldc * 2; i++) + data_zgemm.c_verify[i] = data_zgemm.c_test[i]; + + if (transa == 'R'){ + cblas_zimatcopy(CblasColMajor, CblasConjNoTrans, arows, acols, alpha_conj, data_zgemm.a_verify, lda, lda); + transa_verify = 'N'; + } + + if (transb == 'R'){ + cblas_zimatcopy(CblasColMajor, CblasConjNoTrans, brows, bcols, alpha_conj, data_zgemm.b_verify, ldb, ldb); + transb_verify = 'N'; + } + + BLASFUNC(zgemm)(&transa_verify, &transb_verify, &m, &n, &k, alpha, data_zgemm.a_verify, &lda, + data_zgemm.b_verify, &ldb, beta, data_zgemm.c_verify, &ldc); + + BLASFUNC(zgemm)(&transa, &transb, &m, &n, &k, alpha, data_zgemm.a_test, &lda, + data_zgemm.b_test, &ldb, beta, data_zgemm.c_test, &ldc); + + return dmatrix_difference(data_zgemm.c_test, data_zgemm.c_verify, m, n, ldc*2); +} + +/** + * Test zgemm with the conjugate matrices by conjugating and not transposed matrices + * and comparing it with the non-conjugate zgemm. + * Test with the following options: + * + * matrix A is conjugate and transposed + * matrix B is conjugate and not transposed + */ +CTEST(zgemm, conjtransa_conjnotransb) +{ + blasint n = DATASIZE, m = DATASIZE, k = DATASIZE; + blasint lda = DATASIZE, ldb = DATASIZE, ldc = DATASIZE; + char transa = 'C'; + char transb = 'R'; + double alpha[] = {-2.0, 1.0}; + double beta[] = {1.0, -1.0}; + + double norm = check_zgemm(transa, transb, m, n, k, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Test zgemm with the conjugate matrices by conjugating and not transposed matrices + * and comparing it with the non-conjugate zgemm. + * Test with the following options: + * + * matrix A is not conjugate and not transposed + * matrix B is conjugate and not transposed + */ +CTEST(zgemm, notransa_conjnotransb) +{ + blasint n = DATASIZE, m = DATASIZE, k = DATASIZE; + blasint lda = DATASIZE, ldb = DATASIZE, ldc = DATASIZE; + char transa = 'N'; + char transb = 'R'; + double alpha[] = {-2.0, 1.0}; + double beta[] = {1.0, -1.0}; + + double norm = check_zgemm(transa, transb, m, n, k, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Test zgemm with the conjugate matrices by conjugating and not transposed matrices + * and comparing it with the non-conjugate zgemm. + * Test with the following options: + * + * matrix A is conjugate and not transposed + * matrix B is conjugate and transposed + */ +CTEST(zgemm, conjnotransa_conjtransb) +{ + blasint n = DATASIZE, m = DATASIZE, k = DATASIZE; + blasint lda = DATASIZE, ldb = DATASIZE, ldc = DATASIZE; + char transa = 'R'; + char transb = 'C'; + double alpha[] = {-2.0, 1.0}; + double beta[] = {1.0, -1.0}; + + double norm = check_zgemm(transa, transb, m, n, k, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Test zgemm with the conjugate matrices by conjugating and not transposed matrices + * and comparing it with the non-conjugate zgemm. + * Test with the following options: + * + * matrix A is conjugate and not transposed + * matrix B is not conjugate and not transposed + */ +CTEST(zgemm, conjnotransa_notransb) +{ + blasint n = DATASIZE, m = DATASIZE, k = DATASIZE; + blasint lda = DATASIZE, ldb = DATASIZE, ldc = DATASIZE; + char transa = 'R'; + char transb = 'N'; + double alpha[] = {-2.0, 1.0}; + double beta[] = {1.0, -1.0}; + + double norm = check_zgemm(transa, transb, m, n, k, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Test zgemm with the conjugate matrices by conjugating and not transposed matrices + * and comparing it with the non-conjugate zgemm. + * Test with the following options: + * + * matrix A is conjugate and not transposed + * matrix B is conjugate and not transposed + */ +CTEST(zgemm, conjnotransa_conjnotransb) +{ + blasint n = DATASIZE, m = DATASIZE, k = DATASIZE; + blasint lda = DATASIZE, ldb = DATASIZE, ldc = DATASIZE; + char transa = 'R'; + char transb = 'R'; + double alpha[] = {-2.0, 1.0}; + double beta[] = {1.0, -1.0}; + + double norm = check_zgemm(transa, transb, m, n, k, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Test zgemm with the conjugate matrices by conjugating and not transposed matrices + * and comparing it with the non-conjugate zgemm. + * Test with the following options: + * + * matrix A is conjugate and not transposed + * matrix B is transposed + */ +CTEST(zgemm, conjnotransa_transb) +{ + blasint n = DATASIZE, m = DATASIZE, k = DATASIZE; + blasint lda = DATASIZE, ldb = DATASIZE, ldc = DATASIZE; + char transa = 'R'; + char transb = 'T'; + double alpha[] = {-2.0, 1.0}; + double beta[] = {1.0, -1.0}; + + double norm = check_zgemm(transa, transb, m, n, k, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Test zgemm with the conjugate matrices by conjugating and not transposed matrices + * and comparing it with the non-conjugate zgemm. + * Test with the following options: + * + * matrix A is transposed + * matrix B is conjugate and not transposed + */ +CTEST(zgemm, transa_conjnotransb) +{ + blasint n = DATASIZE, m = DATASIZE, k = DATASIZE; + blasint lda = DATASIZE, ldb = DATASIZE, ldc = DATASIZE; + char transa = 'T'; + char transb = 'R'; + double alpha[] = {-2.0, 1.0}; + double beta[] = {1.0, -1.0}; + + double norm = check_zgemm(transa, transb, m, n, k, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_zgemmt.c b/utest/test_extensions/test_zgemmt.c new file mode 100644 index 000000000..c55381008 --- /dev/null +++ b/utest/test_extensions/test_zgemmt.c @@ -0,0 +1,2010 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. 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. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include "common.h" + +#define DATASIZE 100 + +struct DATA_ZGEMMT { + double a_test[DATASIZE * DATASIZE * 2]; + double b_test[DATASIZE * DATASIZE * 2]; + double c_test[DATASIZE * DATASIZE * 2]; + double c_verify[DATASIZE * DATASIZE * 2]; + double c_gemm[DATASIZE * DATASIZE * 2]; +}; + +#ifdef BUILD_COMPLEX16 +static struct DATA_ZGEMMT data_zgemmt; + +/** + * Compute gemmt via gemm since gemmt is gemm but updates only + * the upper or lower triangular part of the result matrix + * + * param api specifies tested api (C or Fortran) + * param order specifies row or column major order (for Fortran API column major always) + * param uplo specifies whether C’s data is stored in its upper or lower triangle + * param transa specifies op(A), the transposition operation applied to A + * param transb specifies op(B), the transposition operation applied to B + * param m - number of rows of op(A), columns of op(B), and columns and rows of C + * param k - number of columns of op(A) and rows of op(B) + * param alpha - scaling factor for the matrix-matrix product + * param lda - leading dimension of A + * param ldb - leading dimension of B + * param beta - scaling factor for matrix C + * param ldc - leading dimension of C + */ +static void zgemmt_trusted(char api, enum CBLAS_ORDER order, char uplo, char transa, + char transb, blasint m, blasint k, double *alpha, blasint lda, + blasint ldb, double *beta, blasint ldc) +{ + blasint i, j; + + if(api == 'F') + BLASFUNC(zgemm)(&transa, &transb, &m, &m, &k, alpha, data_zgemmt.a_test, &lda, + data_zgemmt.b_test, &ldb, beta, data_zgemmt.c_gemm, &ldc); + else + cblas_zgemm(order, transa, transb, m, m, k, alpha, data_zgemmt.a_test, lda, + data_zgemmt.b_test, ldb, beta, data_zgemmt.c_gemm, ldc); + + ldc *= 2; + + if (uplo == 'L' || uplo == CblasLower) + { + for (i = 0; i < m; i++) + for (j = i * 2; j < m * 2; j+=2){ + data_zgemmt.c_verify[i * ldc + j] = + data_zgemmt.c_gemm[i * ldc + j]; + data_zgemmt.c_verify[i * ldc + j + 1] = + data_zgemmt.c_gemm[i * ldc + j + 1]; + } + } else { + for (i = 0; i < m; i++) + for (j = 0; j <= i * 2; j+=2){ + data_zgemmt.c_verify[i * ldc + j] = + data_zgemmt.c_gemm[i * ldc + j]; + data_zgemmt.c_verify[i * ldc + j + 1] = + data_zgemmt.c_gemm[i * ldc + j + 1]; + } + } +} + +/** + * Comapare results computed by zgemmt and zgemmt_trusted + * + * param api specifies tested api (C or Fortran) + * param order specifies row or column major order (for Fortran API column major always) + * param uplo specifies whether C’s data is stored in its upper or lower triangle + * param transa specifies op(A), the transposition operation applied to A + * param transb specifies op(B), the transposition operation applied to B + * param m - number of rows of op(A), columns of op(B), and columns and rows of C + * param k - number of columns of op(A) and rows of op(B) + * param alpha - scaling factor for the matrix-matrix product + * param lda - leading dimension of A + * param ldb - leading dimension of B + * param beta - scaling factor for matrix C + * param ldc - leading dimension of C + * return norm of differences + */ +static double check_zgemmt(char api, enum CBLAS_ORDER order, char uplo, char transa, + char transb, blasint m, blasint k, double *alpha, blasint lda, + blasint ldb, double *beta, blasint ldc) +{ + blasint i; + blasint b_cols; + blasint a_cols; + blasint inc = 1; + blasint size_c = m * ldc * 2; + + if(order == CblasColMajor){ + if (transa == 'T' || transa == 'C' || + transa == CblasTrans || transa == CblasConjTrans) + a_cols = m; + else a_cols = k; + + if (transb == 'T' || transb == 'C' || + transb == CblasTrans || transb == CblasConjTrans) + b_cols = k; + else b_cols = m; + } else { + if (transa == 'T' || transa == 'C' || + transa == CblasTrans || transa == CblasConjTrans) + a_cols = k; + else a_cols = m; + + if (transb == 'T' || transb == 'C' || + transb == CblasTrans || transb == CblasConjTrans) + b_cols = m; + else b_cols = k; + } + + drand_generate(data_zgemmt.a_test, a_cols * lda * 2); + drand_generate(data_zgemmt.b_test, b_cols * ldb * 2); + drand_generate(data_zgemmt.c_test, m * ldc * 2); + + for (i = 0; i < m * ldc * 2; i++) + data_zgemmt.c_gemm[i] = data_zgemmt.c_verify[i] = data_zgemmt.c_test[i]; + + zgemmt_trusted(api, order, uplo, transa, transb, m, k, alpha, lda, ldb, beta, ldc); + + if (api == 'F') + BLASFUNC(zgemmt)(&uplo, &transa, &transb, &m, &k, alpha, data_zgemmt.a_test, + &lda, data_zgemmt.b_test, &ldb, beta, data_zgemmt.c_test, &ldc); + else + cblas_zgemmt(order, uplo, transa, transb, m, k, alpha, data_zgemmt.a_test, lda, + data_zgemmt.b_test, ldb, beta, data_zgemmt.c_test, ldc); + + for (i = 0; i < m * ldc * 2; i++) + data_zgemmt.c_verify[i] -= data_zgemmt.c_test[i]; + + return BLASFUNC(dnrm2)(&size_c, data_zgemmt.c_verify, &inc) / size_c; +} + +/** + * Check if error function was called with expected function name + * and param info + * + * param uplo specifies whether C’s data is stored in its upper or lower triangle + * param transa specifies op(A), the transposition operation applied to A + * param transb specifies op(B), the transposition operation applied to B + * param m - number of rows of op(A), columns of op(B), and columns and rows of C + * param k - number of columns of op(A) and rows of op(B) + * param lda - leading dimension of A + * param ldb - leading dimension of B + * param ldc - leading dimension of C + * param expected_info - expected invalid parameter number in zgemmt + * return TRUE if everything is ok, otherwise FALSE + */ +static int check_badargs(char api, enum CBLAS_ORDER order, char uplo, char transa, + char transb, blasint m, blasint k, blasint lda, blasint ldb, + blasint ldc, int expected_info) +{ + double alpha[] = {1.0, 1.0}; + double beta[] = {0.0, 0.0}; + + set_xerbla("ZGEMMT ", expected_info); + + if (api == 'F') + BLASFUNC(zgemmt)(&uplo, &transa, &transb, &m, &k, alpha, data_zgemmt.a_test, + &lda, data_zgemmt.b_test, &ldb, beta, data_zgemmt.c_test, &ldc); + else + cblas_zgemmt(order, uplo, transa, transb, m, k, alpha, data_zgemmt.a_test, lda, + data_zgemmt.b_test, ldb, beta, data_zgemmt.c_test, ldc); + + return check_error(); +} + +/** + * Fortran API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its upper triangle part + * A not transposed + * B not transposed + */ +CTEST(zgemmt, upper_M_50_K_50_a_notrans_b_notrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'N'; + char uplo = 'U'; + double alpha[] = {1.5, 0.5}; + double beta[] = {2.0, 1.0}; + + double norm = check_zgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its upper triangle part + * A transposed + * B not transposed + */ +CTEST(zgemmt, upper_M_50_K_25_a_trans_b_notrans) +{ + blasint M = 50, K = 25; + blasint lda = 25, ldb = 25, ldc = 50; + char transa = 'T', transb = 'N'; + char uplo = 'U'; + double alpha[] = {1.0, 1.0}; + double beta[] = {2.0, 1.0}; + + double norm = check_zgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its upper triangle part + * A not transposed + * B transposed + */ +CTEST(zgemmt, upper_M_25_K_50_a_notrans_b_trans) +{ + blasint M = 25, K = 50; + blasint lda = 25, ldb = 25, ldc = 25; + char transa = 'N', transb = 'T'; + char uplo = 'U'; + double alpha[] = {1.0, 1.0}; + double beta[] = {0.0, 0.0}; + + double norm = check_zgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its upper triangle part + * A transposed + * B transposed + */ +CTEST(zgemmt, upper_M_50_K_50_a_trans_b_trans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'T', transb = 'T'; + char uplo = 'U'; + double alpha[] = {1.5, 0.5}; + double beta[] = {2.0, 1.0}; + + double norm = check_zgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its upper triangle part + * A conjugate not transposed + * B conjugate not transposed + */ +CTEST(zgemmt, upper_M_25_K_50_a_conjnotrans_b_conjnotrans) +{ + blasint M = 25, K = 50; + blasint lda = 25, ldb = 50, ldc = 25; + char transa = 'R', transb = 'R'; + char uplo = 'U'; + double alpha[] = {2.0, 1.0}; + double beta[] = {1.5, 2.0}; + + double norm = check_zgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its upper triangle part + * A conjugate transposed + * B conjugate not transposed + */ +CTEST(zgemmt, upper_M_50_K_50_a_conjtrans_b_conjnotrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'C', transb = 'R'; + char uplo = 'U'; + double alpha[] = {1.0, 1.0}; + double beta[] = {1.0, 1.0}; + + double norm = check_zgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its upper triangle part + * A conjugate not transposed + * B conjugate transposed + */ +CTEST(zgemmt, upper_M_50_K_50_a_conjnotrans_b_conjtrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'R', transb = 'C'; + char uplo = 'U'; + double alpha[] = {2.0, 1.0}; + double beta[] = {1.5, 2.0}; + + double norm = check_zgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its upper triangle part + * A conjugate transposed + * B conjugate transposed + */ +CTEST(zgemmt, upper_M_50_K_25_a_conjtrans_b_conjtrans) +{ + blasint M = 50, K = 25; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'C', transb = 'C'; + char uplo = 'U'; + double alpha[] = {2.0, 1.0}; + double beta[] = {1.5, 2.0}; + + double norm = check_zgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its upper triangle part + * alpha_r = 0.0, alpha_i = 0.0 + */ +CTEST(zgemmt, upper_alpha_zero) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'N'; + char uplo = 'U'; + double alpha[] = {0.0, 0.0}; + double beta[] = {2.0, 1.0}; + + double norm = check_zgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its upper triangle part + * beta_r = 1.0, beta_i = 0.0 + */ +CTEST(zgemmt, upper_beta_one) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'N'; + char uplo = 'U'; + double alpha[] = {1.0, 1.0}; + double beta[] = {1.0, 0.0}; + + double norm = check_zgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its lower triangle part + * A not transposed + * B not transposed + */ +CTEST(zgemmt, lower_M_50_K_50_a_notrans_b_notrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'N'; + char uplo = 'L'; + double alpha[] = {1.5, 0.5}; + double beta[] = {2.0, 1.0}; + + double norm = check_zgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its lower triangle part + * A transposed + * B not transposed + */ +CTEST(zgemmt, lower_M_50_K_25_a_trans_b_notrans) +{ + blasint M = 50, K = 25; + blasint lda = 25, ldb = 25, ldc = 50; + char transa = 'T', transb = 'N'; + char uplo = 'L'; + double alpha[] = {1.0, 1.0}; + double beta[] = {2.0, 1.0}; + + double norm = check_zgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its lower triangle part + * A not transposed + * B transposed + */ +CTEST(zgemmt, lower_M_25_K_50_a_notrans_b_trans) +{ + blasint M = 25, K = 50; + blasint lda = 25, ldb = 25, ldc = 25; + char transa = 'N', transb = 'T'; + char uplo = 'L'; + double alpha[] = {1.0, 1.0}; + double beta[] = {0.0, 0.0}; + + double norm = check_zgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its lower triangle part + * A transposed + * B transposed + */ +CTEST(zgemmt, lower_M_50_K_50_a_trans_b_trans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'T', transb = 'T'; + char uplo = 'L'; + double alpha[] = {1.5, 0.5}; + double beta[] = {2.0, 1.0}; + + double norm = check_zgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its lower triangle part + * A conjugate not transposed + * B conjugate not transposed + */ +CTEST(zgemmt, lower_M_25_K_50_a_conjnotrans_b_conjnotrans) +{ + blasint M = 25, K = 50; + blasint lda = 25, ldb = 50, ldc = 25; + char transa = 'R', transb = 'R'; + char uplo = 'L'; + double alpha[] = {2.0, 1.0}; + double beta[] = {1.5, 2.0}; + + double norm = check_zgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its lower triangle part + * A conjugate transposed + * B conjugate not transposed + */ +CTEST(zgemmt, lower_M_50_K_50_a_conjtrans_b_conjnotrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'C', transb = 'R'; + char uplo = 'L'; + double alpha[] = {1.0, 1.0}; + double beta[] = {1.0, 1.0}; + + double norm = check_zgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its lower triangle part + * A conjugate not transposed + * B conjugate transposed + */ +CTEST(zgemmt, lower_M_50_K_50_a_conjnotrans_b_conjtrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'R', transb = 'C'; + char uplo = 'L'; + double alpha[] = {2.0, 1.0}; + double beta[] = {1.5, 2.0}; + + double norm = check_zgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its lower triangle part + * A conjugate transposed + * B conjugate transposed + */ +CTEST(zgemmt, lower_M_50_K_25_a_conjtrans_b_conjtrans) +{ + blasint M = 50, K = 25; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'C', transb = 'C'; + char uplo = 'L'; + double alpha[] = {2.0, 1.0}; + double beta[] = {1.5, 2.0}; + + double norm = check_zgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its lower triangle part + * alpha_r = 0.0, alpha_i = 0.0 + */ +CTEST(zgemmt, lower_alpha_zero) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'N'; + char uplo = 'L'; + double alpha[] = {0.0, 0.0}; + double beta[] = {2.0, 1.0}; + + double norm = check_zgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * C’s data is stored in its lower triangle part + * beta_r = 1.0, beta_i = 0.0 + */ +CTEST(zgemmt, lower_beta_one) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'N'; + char uplo = 'L'; + double alpha[] = {1.0, 1.0}; + double beta[] = {1.0, 0.0}; + + double norm = check_zgemmt('F', CblasColMajor, uplo, transa, transb, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its upper triangle part + * A not transposed + * B not transposed + */ +CTEST(zgemmt, c_api_colmajor_upper_M_50_K_50_a_notrans_b_notrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha[] = {1.5, 0.5}; + double beta[] = {2.0, 1.0}; + + double norm = check_zgemmt('C', CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its upper triangle part + * A transposed + * B not transposed + */ +CTEST(zgemmt, c_api_colmajor_upper_M_50_K_25_a_trans_b_notrans) +{ + blasint M = 50, K = 25; + blasint lda = 25, ldb = 25, ldc = 50; + double alpha[] = {1.0, 1.0}; + double beta[] = {2.0, 1.0}; + + double norm = check_zgemmt('C', CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its upper triangle part + * A not transposed + * B transposed + */ +CTEST(zgemmt, c_api_colmajor_upper_M_25_K_50_a_notrans_b_trans) +{ + blasint M = 25, K = 50; + blasint lda = 25, ldb = 25, ldc = 25; + double alpha[] = {1.0, 1.0}; + double beta[] = {0.0, 0.0}; + + double norm = check_zgemmt('C', CblasColMajor, CblasUpper, CblasNoTrans, CblasTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its upper triangle part + * A transposed + * B transposed + */ +CTEST(zgemmt, c_api_colmajor_upper_M_50_K_50_a_trans_b_trans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha[] = {1.5, 0.5}; + double beta[] = {2.0, 1.0}; + + double norm = check_zgemmt('C', CblasColMajor, CblasUpper, CblasTrans, CblasTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its upper triangle part + * A conjugate not transposed + * B conjugate not transposed + */ +CTEST(zgemmt, c_api_colmajor_upper_M_25_K_50_a_conjnotrans_b_conjnotrans) +{ + blasint M = 25, K = 50; + blasint lda = 25, ldb = 50, ldc = 25; + double alpha[] = {2.0, 1.0}; + double beta[] = {1.5, 2.0}; + + double norm = check_zgemmt('C', CblasColMajor, CblasUpper, CblasConjNoTrans, CblasConjNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its upper triangle part + * A conjugate transposed + * B conjugate not transposed + */ +CTEST(zgemmt, c_api_colmajor_upper_M_50_K_50_a_conjtrans_b_conjnotrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha[] = {1.0, 1.0}; + double beta[] = {1.0, 1.0}; + + double norm = check_zgemmt('C', CblasColMajor, CblasUpper, CblasConjTrans, CblasConjNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its upper triangle part + * A conjugate not transposed + * B conjugate transposed + */ +CTEST(zgemmt, c_api_colmajor_upper_M_50_K_50_a_conjnotrans_b_conjtrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha[] = {2.0, 1.0}; + double beta[] = {1.5, 2.0}; + + double norm = check_zgemmt('C', CblasColMajor, CblasUpper, CblasConjNoTrans, CblasConjTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its upper triangle part + * A conjugate transposed + * B conjugate transposed + */ +CTEST(zgemmt, c_api_colmajor_upper_M_50_K_25_a_conjtrans_b_conjtrans) +{ + blasint M = 50, K = 25; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha[] = {2.0, 1.0}; + double beta[] = {1.5, 2.0}; + + double norm = check_zgemmt('C', CblasColMajor, CblasUpper, CblasConjTrans, CblasConjTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its upper triangle part + * alpha_r = 0.0, alpha_i = 0.0 + */ +CTEST(zgemmt, c_api_colmajor_upper_alpha_zero) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha[] = {0.0, 0.0}; + double beta[] = {2.0, 1.0}; + + double norm = check_zgemmt('C', CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its upper triangle part + * beta_r = 1.0, beta_i = 0.0 + */ +CTEST(zgemmt, c_api_colmajor_upper_beta_one) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha[] = {1.0, 1.0}; + double beta[] = {1.0, 0.0}; + + double norm = check_zgemmt('C', CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its lower triangle part + * A not transposed + * B not transposed + */ +CTEST(zgemmt, c_api_colmajor_lower_M_50_K_50_a_notrans_b_notrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha[] = {1.5, 0.5}; + double beta[] = {2.0, 1.0}; + + double norm = check_zgemmt('C', CblasColMajor, CblasLower, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its lower triangle part + * A transposed + * B not transposed + */ +CTEST(zgemmt, c_api_colmajor_lower_M_50_K_25_a_trans_b_notrans) +{ + blasint M = 50, K = 25; + blasint lda = 25, ldb = 25, ldc = 50; + double alpha[] = {1.0, 1.0}; + double beta[] = {2.0, 1.0}; + + double norm = check_zgemmt('C', CblasColMajor, CblasLower, CblasTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its lower triangle part + * A not transposed + * B transposed + */ +CTEST(zgemmt, c_api_colmajor_lower_M_25_K_50_a_notrans_b_trans) +{ + blasint M = 25, K = 50; + blasint lda = 25, ldb = 25, ldc = 25; + double alpha[] = {1.0, 1.0}; + double beta[] = {0.0, 0.0}; + + double norm = check_zgemmt('C', CblasColMajor, CblasLower, CblasNoTrans, CblasTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its lower triangle part + * A transposed + * B transposed + */ +CTEST(zgemmt, c_api_colmajor_lower_M_50_K_50_a_trans_b_trans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha[] = {1.5, 0.5}; + double beta[] = {2.0, 1.0}; + + double norm = check_zgemmt('C', CblasColMajor, CblasLower, CblasTrans, CblasTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its lower triangle part + * A conjugate not transposed + * B conjugate not transposed + */ +CTEST(zgemmt, c_api_colmajor_lower_M_25_K_50_a_conjnotrans_b_conjnotrans) +{ + blasint M = 25, K = 50; + blasint lda = 25, ldb = 50, ldc = 25; + double alpha[] = {2.0, 1.0}; + double beta[] = {1.5, 2.0}; + + double norm = check_zgemmt('C', CblasColMajor, CblasLower, CblasConjNoTrans, CblasConjNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its lower triangle part + * A conjugate transposed + * B conjugate not transposed + */ +CTEST(zgemmt, c_api_colmajor_lower_M_50_K_50_a_conjtrans_b_conjnotrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha[] = {2.0, 1.0}; + double beta[] = {1.5, 2.0}; + + double norm = check_zgemmt('C', CblasColMajor, CblasLower, CblasConjTrans, CblasConjNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its lower triangle part + * A conjugate not transposed + * B conjugate transposed + */ +CTEST(zgemmt, c_api_colmajor_lower_M_50_K_50_a_conjnotrans_b_conjtrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha[] = {2.0, 1.0}; + double beta[] = {1.5, 2.0}; + + double norm = check_zgemmt('C', CblasColMajor, CblasLower, CblasConjNoTrans, CblasConjTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its lower triangle part + * A conjugate transposed + * B conjugate transposed + */ +CTEST(zgemmt, c_api_colmajor_lower_M_50_K_25_a_conjtrans_b_conjtrans) +{ + blasint M = 50, K = 25; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha[] = {2.0, 1.0}; + double beta[] = {1.5, 2.0}; + + double norm = check_zgemmt('C', CblasColMajor, CblasLower, CblasConjTrans, CblasConjTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its lower triangle part + * alpha_r = 0.0, alpha_i = 0.0 + */ +CTEST(zgemmt, c_api_colmajor_lower_alpha_zero) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha[] = {0.0, 0.0}; + double beta[] = {2.0, 1.0}; + + double norm = check_zgemmt('C', CblasColMajor, CblasLower, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * Column Major + * C’s data is stored in its lower triangle part + * beta_r = 1.0, beta_i = 0.0 + */ +CTEST(zgemmt, c_api_colmajor_lower_beta_one) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha[] = {1.0, 1.0}; + double beta[] = {1.0, 0.0}; + + double norm = check_zgemmt('C', CblasColMajor, CblasLower, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its upper triangle part + * A not transposed + * B not transposed + */ +CTEST(zgemmt, c_api_rowmajor_upper_M_50_K_50_a_notrans_b_notrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha[] = {1.5, 0.5}; + double beta[] = {2.0, 1.0}; + + double norm = check_zgemmt('C', CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its upper triangle part + * A transposed + * B not transposed + */ +CTEST(zgemmt, c_api_rowmajor_upper_M_50_K_25_a_trans_b_notrans) +{ + blasint M = 50, K = 25; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha[] = {1.0, 1.0}; + double beta[] = {2.0, 1.0}; + + double norm = check_zgemmt('C', CblasRowMajor, CblasUpper, CblasTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its upper triangle part + * A not transposed + * B transposed + */ +CTEST(zgemmt, c_api_rowmajor_upper_M_25_K_50_a_notrans_b_trans) +{ + blasint M = 25, K = 50; + blasint lda = 50, ldb = 50, ldc = 25; + double alpha[] = {1.0, 1.0}; + double beta[] = {-1.0, -1.0}; + + double norm = check_zgemmt('C', CblasRowMajor, CblasUpper, CblasNoTrans, CblasTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its upper triangle part + * A transposed + * B transposed + */ +CTEST(zgemmt, c_api_rowmajor_upper_M_50_K_50_a_trans_b_trans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha[] = {1.5, 0.5}; + double beta[] = {2.0, 1.0}; + + double norm = check_zgemmt('C', CblasRowMajor, CblasUpper, CblasTrans, CblasTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its upper triangle part + * A conjugate not transposed + * B conjugate not transposed + */ +CTEST(zgemmt, c_api_rowmajor_upper_M_25_K_50_a_conjnotrans_b_conjnotrans) +{ + blasint M = 25, K = 50; + blasint lda = 50, ldb = 25, ldc = 25; + double alpha[] = {2.0, 1.0}; + double beta[] = {1.5, 2.0}; + + double norm = check_zgemmt('C', CblasRowMajor, CblasUpper, CblasConjNoTrans, CblasConjNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its upper triangle part + * A conjugate transposed + * B conjugate not transposed + */ +CTEST(zgemmt, c_api_rowmajor_upper_M_50_K_50_a_conjtrans_b_conjnotrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha[] = {2.0, 1.0}; + double beta[] = {1.5, 2.0}; + + double norm = check_zgemmt('C', CblasRowMajor, CblasUpper, CblasConjTrans, CblasConjNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its upper triangle part + * A conjugate not transposed + * B conjugate transposed + */ +CTEST(zgemmt, c_api_rowmajor_upper_M_50_K_50_a_conjnotrans_b_conjtrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha[] = {2.0, 1.0}; + double beta[] = {1.5, 2.0}; + + double norm = check_zgemmt('C', CblasRowMajor, CblasUpper, CblasConjNoTrans, CblasConjTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its upper triangle part + * A conjugate transposed + * B conjugate transposed + */ +CTEST(zgemmt, c_api_rowmajor_upper_M_25_K_50_a_conjtrans_b_conjtrans) +{ + blasint M = 25, K = 50; + blasint lda = 25, ldb = 50, ldc = 25; + double alpha[] = {2.0, 1.0}; + double beta[] = {1.5, 2.0}; + + double norm = check_zgemmt('C', CblasRowMajor, CblasUpper, CblasConjTrans, CblasConjTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its upper triangle part + * alpha_r = 0.0, alpha_i = 0.0 + */ +CTEST(zgemmt, c_api_rowmajor_upper_alpha_zero) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha[] = {0.0, 0.0}; + double beta[] = {2.0, 1.0}; + + double norm = check_zgemmt('C', CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its upper triangle part + * beta_r = 1.0, beta_i = 0.0 + */ +CTEST(zgemmt, c_api_rowmajor_upper_beta_one) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha[] = {1.0, 1.0}; + double beta[] = {1.0, 0.0}; + + double norm = check_zgemmt('C', CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its lower triangle part + * A not transposed + * B not transposed + */ +CTEST(zgemmt, c_api_rowmajor_lower_M_50_K_50_a_notrans_b_notrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha[] = {1.5, 0.5}; + double beta[] = {2.0, 1.0}; + + double norm = check_zgemmt('C', CblasRowMajor, CblasLower, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its lower triangle part + * A transposed + * B not transposed + */ +CTEST(zgemmt, c_api_rowmajor_lower_M_50_K_25_a_trans_b_notrans) +{ + blasint M = 50, K = 25; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha[] = {1.0, 1.0}; + double beta[] = {2.0, 1.0}; + + double norm = check_zgemmt('C', CblasRowMajor, CblasLower, CblasTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its lower triangle part + * A not transposed + * B transposed + */ +CTEST(zgemmt, c_api_rowmajor_lower_M_25_K_50_a_notrans_b_trans) +{ + blasint M = 25, K = 50; + blasint lda = 50, ldb = 50, ldc = 25; + double alpha[] = {1.0, 1.0}; + double beta[] = {0.0, 0.0}; + + double norm = check_zgemmt('C', CblasRowMajor, CblasLower, CblasNoTrans, CblasTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its lower triangle part + * A transposed + * B transposed + */ +CTEST(zgemmt, c_api_rowmajor_lower_M_50_K_50_a_trans_b_trans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha[] = {1.5, 0.5}; + double beta[] = {2.0, 1.0}; + + double norm = check_zgemmt('C', CblasRowMajor, CblasLower, CblasTrans, CblasTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its lower triangle part + * A conjugate not transposed + * B conjugate not transposed + */ +CTEST(zgemmt, c_api_rowmajor_lower_M_25_K_50_a_conjnotrans_b_conjnotrans) +{ + blasint M = 25, K = 50; + blasint lda = 50, ldb = 25, ldc = 25; + double alpha[] = {2.0, 1.0}; + double beta[] = {1.5, 2.0}; + + double norm = check_zgemmt('C', CblasRowMajor, CblasLower, CblasConjNoTrans, CblasConjNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its lower triangle part + * A conjugate transposed + * B conjugate not transposed + */ +CTEST(zgemmt, c_api_rowmajor_lower_M_50_K_50_a_conjtrans_b_conjnotrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha[] = {2.0, 1.0}; + double beta[] = {1.5, 2.0}; + + double norm = check_zgemmt('C', CblasRowMajor, CblasLower, CblasConjTrans, CblasConjNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its lower triangle part + * A conjugate not transposed + * B conjugate transposed + */ +CTEST(zgemmt, c_api_rowmajor_lower_M_50_K_50_a_conjnotrans_b_conjtrans) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha[] = {2.0, 1.0}; + double beta[] = {1.5, 2.0}; + + double norm = check_zgemmt('C', CblasRowMajor, CblasLower, CblasConjNoTrans, CblasConjTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its lower triangle part + * A conjugate transposed + * B conjugate transposed + */ +CTEST(zgemmt, c_api_rowmajor_lower_M_50_K_25_a_conjtrans_b_conjtrans) +{ + blasint M = 50, K = 25; + blasint lda = 50, ldb = 25, ldc = 50; + double alpha[] = {2.0, 1.0}; + double beta[] = {1.5, 2.0}; + + double norm = check_zgemmt('C', CblasRowMajor, CblasLower, CblasConjTrans, CblasConjTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its lower triangle part + * alpha_r = 0.0, alpha_i = 0.0 + */ +CTEST(zgemmt, c_api_rowmajor_lower_alpha_zero) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha[] = {0.0, 0.0}; + double beta[] = {2.0, 1.0}; + + double norm = check_zgemmt('C', CblasRowMajor, CblasLower, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zgemmt by comparing it against sgemm + * with the following options: + * + * Row Major + * C’s data is stored in its lower triangle part + * beta_r = 1.0, beta_i = 0.0 + */ +CTEST(zgemmt, c_api_rowmajor_lower_beta_one) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + double alpha[] = {1.0, 1.0}; + double beta[] = {1.0, 0.0}; + + double norm = check_zgemmt('C', CblasRowMajor, CblasLower, CblasNoTrans, CblasNoTrans, + M, K, alpha, lda, ldb, beta, ldc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test error function for an invalid param uplo. + * Must be upper (U) or lower (L). + */ +CTEST(zgemmt, xerbla_uplo_invalid) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'N'; + char uplo = 'O'; + int expected_info = 1; + + int passed = check_badargs('F', CblasColMajor, uplo, transa, transb, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param transa. + * Must be trans (T/C) or no-trans (N/R). + */ +CTEST(zgemmt, xerbla_transa_invalid) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'O', transb = 'N'; + char uplo = 'U'; + int expected_info = 2; + + int passed = check_badargs('F', CblasColMajor, uplo, transa, transb, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param transb. + * Must be trans (T/C) or no-trans (N/R). + */ +CTEST(zgemmt, xerbla_transb_invalid) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'O'; + char uplo = 'U'; + int expected_info = 3; + + int passed = check_badargs('F', CblasColMajor, uplo, transa, transb, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param M. + * Must be positive. + */ +CTEST(zgemmt, xerbla_m_invalid) +{ + blasint M = -1, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'N'; + char uplo = 'U'; + int expected_info = 4; + + int passed = check_badargs('F', CblasColMajor, uplo, transa, transb, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param K. + * Must be positive. + */ +CTEST(zgemmt, xerbla_k_invalid) +{ + blasint M = 50, K = -1; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'N'; + char uplo = 'U'; + int expected_info = 5; + + int passed = check_badargs('F', CblasColMajor, uplo, transa, transb, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param lda. + * Must be must be at least K if matrix A transposed. + */ +CTEST(zgemmt, xerbla_lda_invalid) +{ + blasint M = 50, K = 100; + blasint lda = 50, ldb = 100, ldc = 50; + char transa = 'T', transb = 'N'; + char uplo = 'U'; + int expected_info = 8; + + int passed = check_badargs('F', CblasColMajor, uplo, transa, transb, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param ldb. + * Must be must be at least K if matrix B not transposed. + */ +CTEST(zgemmt, xerbla_ldb_invalid) +{ + blasint M = 50, K = 100; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'N', transb = 'N'; + char uplo = 'U'; + int expected_info = 10; + + int passed = check_badargs('F', CblasColMajor, uplo, transa, transb, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param ldc. + * Must be must be at least M. + */ +CTEST(zgemmt, xerbla_ldc_invalid) +{ + blasint M = 100, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + char transa = 'T', transb = 'N'; + char uplo = 'U'; + int expected_info = 13; + + int passed = check_badargs('F', CblasColMajor, uplo, transa, transb, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. + * Test error function for an invalid param order. + * Must be column or row major. + */ +CTEST(zgemmt, xerbla_c_api_major_invalid) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 0; + + int passed = check_badargs('C', 'O', CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Column Major + * Test error function for an invalid param uplo. + * Must be upper or lower. + */ +CTEST(zgemmt, xerbla_c_api_colmajor_uplo_invalid) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 1; + + int passed = check_badargs('C', CblasColMajor, 'O', CblasNoTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Column Major + * Test error function for an invalid param transa. + * Must be trans or no-trans. + */ +CTEST(zgemmt, xerbla_c_api_colmajor_transa_invalid) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 2; + + int passed = check_badargs('C', CblasColMajor, CblasUpper, 'O', CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Column Major + * Test error function for an invalid param transb. + * Must be trans or no-trans. + */ +CTEST(zgemmt, xerbla_c_api_colmajor_transb_invalid) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 3; + + int passed = check_badargs('C', CblasColMajor, CblasUpper, CblasNoTrans, 'O', + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Column Major + * Test error function for an invalid param M. + * Must be positive. + */ +CTEST(zgemmt, xerbla_c_api_colmajor_m_invalid) +{ + blasint M = -1, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 4; + + int passed = check_badargs('C', CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Column Major + * Test error function for an invalid param K. + * Must be positive. + */ +CTEST(zgemmt, xerbla_c_api_colmajor_k_invalid) +{ + blasint M = 50, K = -1; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 5; + + int passed = check_badargs('C', CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Column Major + * Test error function for an invalid param lda. + * Must be must be at least K if matrix A transposed. + */ +CTEST(zgemmt, xerbla_c_api_colmajor_lda_invalid) +{ + blasint M = 50, K = 100; + blasint lda = 50, ldb = 100, ldc = 50; + int expected_info = 8; + + int passed = check_badargs('C', CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Column Major + * Test error function for an invalid param ldb. + * Must be must be at least K if matrix B not transposed. + */ +CTEST(zgemmt, xerbla_c_api_colmajor_ldb_invalid) +{ + blasint M = 50, K = 100; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 10; + + int passed = check_badargs('C', CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Column Major + * Test error function for an invalid param ldc. + * Must be must be at least M. + */ +CTEST(zgemmt, xerbla_c_api_colmajor_ldc_invalid) +{ + blasint M = 100, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 13; + + int passed = check_badargs('C', CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Row Major + * Test error function for an invalid param uplo. + * Must be upper or lower. + */ +CTEST(zgemmt, xerbla_c_api_rowmajor_uplo_invalid) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 1; + + int passed = check_badargs('C', CblasRowMajor, 'O', CblasNoTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Row Major + * Test error function for an invalid param transa. + * Must be trans or no-trans. + */ +CTEST(zgemmt, xerbla_c_api_rowmajor_transa_invalid) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 2; + + int passed = check_badargs('C', CblasRowMajor, CblasUpper, 'O', CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Row Major + * Test error function for an invalid param transb. + * Must be trans or no-trans. + */ +CTEST(zgemmt, xerbla_c_api_rowmajor_transb_invalid) +{ + blasint M = 50, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 3; + + int passed = check_badargs('C', CblasRowMajor, CblasUpper, CblasNoTrans, 'O', + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Row Major + * Test error function for an invalid param M. + * Must be positive. + */ +CTEST(zgemmt, xerbla_c_api_rowmajor_m_invalid) +{ + blasint M = -1, K = 50; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 4; + + int passed = check_badargs('C', CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Row Major + * Test error function for an invalid param K. + * Must be positive. + */ +CTEST(zgemmt, xerbla_c_api_rowmajor_k_invalid) +{ + blasint M = 50, K = -1; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 5; + + int passed = check_badargs('C', CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Row Major + * Test error function for an invalid param lda. + * Must be must be at least K if matrix A transposed. + */ +CTEST(zgemmt, xerbla_c_api_rowmajor_lda_invalid) +{ + blasint M = 50, K = 100; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 8; + + int passed = check_badargs('C', CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Row Major + * Test error function for an invalid param ldb. + * Must be must be at least K if matrix B transposed. + */ +CTEST(zgemmt, xerbla_c_api_rowmajor_ldb_invalid) +{ + blasint M = 50, K = 100; + blasint lda = 50, ldb = 50, ldc = 50; + int expected_info = 10; + + int passed = check_badargs('C', CblasRowMajor, CblasUpper, CblasTrans, CblasTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test. Row Major + * Test error function for an invalid param ldc. + * Must be must be at least M. + */ +CTEST(zgemmt, xerbla_c_api_rowmajor_ldc_invalid) +{ + blasint M = 100, K = 50; + blasint lda = 100, ldb = 100, ldc = 50; + int expected_info = 13; + + int passed = check_badargs('C', CblasRowMajor, CblasUpper, CblasTrans, CblasNoTrans, + M, K, lda, ldb, ldc, expected_info); + ASSERT_EQUAL(TRUE, passed); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_zgemv_n.c b/utest/test_extensions/test_zgemv_n.c new file mode 100644 index 000000000..903b855e1 --- /dev/null +++ b/utest/test_extensions/test_zgemv_n.c @@ -0,0 +1,341 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. 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. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include "common.h" + +#define DATASIZE 100 +#define INCREMENT 2 + +struct DATA_ZSPMV_N { + double a_test[DATASIZE * DATASIZE * 2]; + double b_test[DATASIZE * 2 * INCREMENT]; + double c_test[DATASIZE * 2 * INCREMENT]; + double c_verify[DATASIZE * 2 * INCREMENT]; +}; + +#ifdef BUILD_COMPLEX16 + +static struct DATA_ZSPMV_N data_zgemv_n; + +/** + * zgemv not transposed reference code + * + * param trans specifies whether matris A is conj or/and xconj + * param m - number of rows of A + * param n - number of columns of A + * param alpha - scaling factor for the matrib-vector product + * param a - buffer holding input matrib A + * param lda - leading dimension of matrix A + * param b - Buffer holding input vector b + * param inc_b - stride of vector b + * param beta - scaling factor for vector c + * param c - buffer holding input/output vector c + * param inc_c - stride of vector c + */ +static void zgemv_n_trusted(char trans, blasint m, blasint n, double *alpha, double *a, + blasint lda, double *b, blasint inc_b, double *beta, double *c, + blasint inc_c) +{ + blasint i, j; + blasint i2 = 0; + blasint ib = 0, ic = 0; + + double temp_r, temp_i; + + double *a_ptr = a; + blasint lda2 = 2*lda; + + blasint inc_b2 = 2 * inc_b; + blasint inc_c2 = 2 * inc_c; + + BLASFUNC(zscal)(&m, beta, c, &inc_c); + + for (j = 0; j < n; j++) + { + + if (trans == 'N' || trans == 'R') { + temp_r = alpha[0] * b[ib] - alpha[1] * b[ib+1]; + temp_i = alpha[0] * b[ib+1] + alpha[1] * b[ib]; + } else { + temp_r = alpha[0] * b[ib] + alpha[1] * b[ib+1]; + temp_i = alpha[0] * b[ib+1] - alpha[1] * b[ib]; + } + + ic = 0; + i2 = 0; + + for (i = 0; i < m; i++) + { + if (trans == 'N') { + c[ic] += temp_r * a_ptr[i2] - temp_i * a_ptr[i2+1]; + c[ic+1] += temp_r * a_ptr[i2+1] + temp_i * a_ptr[i2]; + } + if (trans == 'O') { + c[ic] += temp_r * a_ptr[i2] + temp_i * a_ptr[i2+1]; + c[ic+1] += temp_r * a_ptr[i2+1] - temp_i * a_ptr[i2]; + } + if (trans == 'R') { + c[ic] += temp_r * a_ptr[i2] + temp_i * a_ptr[i2+1]; + c[ic+1] -= temp_r * a_ptr[i2+1] - temp_i * a_ptr[i2]; + } + if (trans == 'S') { + c[ic] += temp_r * a_ptr[i2] - temp_i * a_ptr[i2+1]; + c[ic+1] -= temp_r * a_ptr[i2+1] + temp_i * a_ptr[i2]; + } + i2 += 2; + ic += inc_c2; + } + a_ptr += lda2; + ib += inc_b2; + } + +} + +/** + * Comapare results computed by zgemv and zgemv_n_trusted + * + * param trans specifies whether matris A is conj or/and xconj + * param m - number of rows of A + * param n - number of columns of A + * param alpha - scaling factor for the matrib-vector product + * param lda - leading dimension of matrix A + * param inc_b - stride of vector b + * param beta - scaling factor for vector c + * param inc_c - stride of vector c + * return norm of differences + */ +static double check_zgemv_n(char trans, blasint m, blasint n, double *alpha, blasint lda, + blasint inc_b, double *beta, blasint inc_c) +{ + blasint i; + + drand_generate(data_zgemv_n.a_test, n * lda); + drand_generate(data_zgemv_n.b_test, 2 * n * inc_b); + drand_generate(data_zgemv_n.c_test, 2 * m * inc_c); + + for (i = 0; i < m * 2 * inc_c; i++) + data_zgemv_n.c_verify[i] = data_zgemv_n.c_test[i]; + + zgemv_n_trusted(trans, m, n, alpha, data_zgemv_n.a_test, lda, data_zgemv_n.b_test, + inc_b, beta, data_zgemv_n.c_test, inc_c); + BLASFUNC(zgemv)(&trans, &m, &n, alpha, data_zgemv_n.a_test, &lda, data_zgemv_n.b_test, + &inc_b, beta, data_zgemv_n.c_verify, &inc_c); + + for (i = 0; i < m * 2 * inc_c; i++) + data_zgemv_n.c_verify[i] -= data_zgemv_n.c_test[i]; + + return BLASFUNC(dznrm2)(&n, data_zgemv_n.c_verify, &inc_c); +} + +/** + * Test zgemv by comparing it against reference + * with the following options: + * + * A is xconj + * Number of rows and columns of A is 100 + * Stride of vector b is 1 + * Stride of vector c is 1 + */ +CTEST(zgemv, trans_o_square_matrix) +{ + blasint n = 100, m = 100, lda = 100; + blasint inc_b = 1, inc_c = 1; + char trans = 'O'; + double alpha[] = {2.0, -1.0}; + double beta[] = {1.4, 5.0}; + + double norm = check_zgemv_n(trans, m, n, alpha, lda, inc_b, beta, inc_c); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_TOL); +} + +/** + * Test zgemv by comparing it against reference + * with the following options: + * + * A is xconj + * Number of rows of A is 50 + * Number of colums of A is 100 + * Stride of vector b is 1 + * Stride of vector c is 1 + */ +CTEST(zgemv, trans_o_rectangular_matrix_rows_less_then_cols) +{ + blasint n = 100, m = 50, lda = 50; + blasint inc_b = 1, inc_c = 1; + char trans = 'O'; + double alpha[] = {2.0, -1.0}; + double beta[] = {1.4, 5.0}; + + double norm = check_zgemv_n(trans, m, n, alpha, lda, inc_b, beta, inc_c); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_TOL); +} + +/** + * Test zgemv by comparing it against reference + * with the following options: + * + * A is xconj + * Number of rows of A is 100 + * Number of colums of A is 50 + * Stride of vector b is 1 + * Stride of vector c is 1 + */ +CTEST(zgemv, trans_o_rectangular_matrix_cols_less_then_rows) +{ + blasint n = 50, m = 100, lda = 100; + blasint inc_b = 1, inc_c = 1; + char trans = 'O'; + double alpha[] = {2.0, -1.0}; + double beta[] = {1.4, 5.0}; + + double norm = check_zgemv_n(trans, m, n, alpha, lda, inc_b, beta, inc_c); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_TOL); +} + +/** + * Test zgemv by comparing it against reference + * with the following options: + * + * A is xconj + * Number of rows and columns of A is 100 + * Stride of vector b is 2 + * Stride of vector c is 2 + */ +CTEST(zgemv, trans_o_double_strides) +{ + blasint n = 100, m = 100, lda = 100; + blasint inc_b = 2, inc_c = 2; + char trans = 'O'; + double alpha[] = {2.0, -1.0}; + double beta[] = {1.4, 5.0}; + + double norm = check_zgemv_n(trans, m, n, alpha, lda, inc_b, beta, inc_c); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_TOL); +} + +/** + * Test zgemv by comparing it against reference + * with the following options: + * + * A is xconj and conj + * Number of rows and columns of A is 100 + * Stride of vector b is 1 + * Stride of vector c is 1 + */ +CTEST(zgemv, trans_s_square_matrix) +{ + blasint n = 100, m = 100, lda = 100; + blasint inc_b = 1, inc_c = 1; + char trans = 'S'; + double alpha[] = {1.0, 1.0}; + double beta[] = {1.4, 5.0}; + + double norm = check_zgemv_n(trans, m, n, alpha, lda, inc_b, beta, inc_c); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_TOL); +} + +/** + * Test zgemv by comparing it against reference + * with the following options: + * + * A is xconj and conj + * Number of rows of A is 50 + * Number of colums of A is 100 + * Stride of vector b is 1 + * Stride of vector c is 1 + */ +CTEST(zgemv, trans_s_rectangular_matrix_rows_less_then_cols) +{ + blasint n = 100, m = 50, lda = 50; + blasint inc_b = 1, inc_c = 1; + char trans = 'S'; + double alpha[] = {2.0, -1.0}; + double beta[] = {1.4, 5.0}; + + double norm = check_zgemv_n(trans, m, n, alpha, lda, inc_b, beta, inc_c); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_TOL); +} + +/** + * Test zgemv by comparing it against reference + * with the following options: + * + * A is xconj and conj + * Number of rows of A is 100 + * Number of colums of A is 50 + * Stride of vector b is 1 + * Stride of vector c is 1 + */ +CTEST(zgemv, trans_s_rectangular_matrix_cols_less_then_rows) +{ + blasint n = 50, m = 100, lda = 100; + blasint inc_b = 1, inc_c = 1; + char trans = 'S'; + double alpha[] = {2.0, -1.0}; + double beta[] = {1.4, 0.0}; + + double norm = check_zgemv_n(trans, m, n, alpha, lda, inc_b, beta, inc_c); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_TOL); +} + +/** + * Test zgemv by comparing it against reference + * with the following options: + * + * A is xconj and conj + * Number of rows and columns of A is 100 + * Stride of vector b is 2 + * Stride of vector c is 2 + */ +CTEST(zgemv, trans_s_double_strides) +{ + blasint n = 100, m = 100, lda = 100; + blasint inc_b = 2, inc_c = 2; + char trans = 'S'; + double alpha[] = {2.0, -1.0}; + double beta[] = {1.0, 5.0}; + + double norm = check_zgemv_n(trans, m, n, alpha, lda, inc_b, beta, inc_c); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_TOL); +} + +#endif diff --git a/utest/test_extensions/test_zgemv_t.c b/utest/test_extensions/test_zgemv_t.c new file mode 100644 index 000000000..2e0ee65f0 --- /dev/null +++ b/utest/test_extensions/test_zgemv_t.c @@ -0,0 +1,1136 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. 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. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include "common.h" + +#define N 100 +#define M 100 +#define INCREMENT 2 + +struct DATA_ZGEMV_T { + double a_test[N * M * 2]; + double a_verify[N * M * 2]; + double y_test[M * INCREMENT * 2]; + double y_verify[M * INCREMENT * 2]; + double x_test[M * INCREMENT * 2]; + double x_verify[M * INCREMENT * 2]; +}; + +// DOUBLE_EPS_ZGEMV = MAX_VAL * NUMBER OF OPERATIONS * DBL_EPSILON +// DOUBLE_EPS_ZGEMV = 5.0 * O(100 * 100) * 2.2e-16 = 1e-11 +#define DOUBLE_EPS_ZGEMV 1e-11 + +#ifdef BUILD_COMPLEX16 +static struct DATA_ZGEMV_T data_zgemv_t; + +/** + * Find product of matrix-vector multiplication + * + * param n specifies number of columns of A + * param m specifies number of rows of A and size of vector x + * param lda specifies leading dimension of A + * param inc_x specifies increment of vector x + */ +static void matrix_vector_product(blasint n, blasint m, blasint lda, blasint inc_x) +{ + blasint i; + double *a_ptr = data_zgemv_t.a_verify; + double *x_ptr = data_zgemv_t.x_test; + double *x_res = data_zgemv_t.x_verify; + + openblas_complex_double result; + + for (i = 0; i < n * inc_x; i += inc_x) + { + result = cblas_zdotu(lda, a_ptr, 1, x_ptr, inc_x); + x_res[0] = CREAL(result); + x_res[1] = CIMAG(result); + a_ptr += lda * 2; + x_res += 2 * inc_x; + } +} + +/** + * Test zgemv by comparing it against zomatcopy, zaxpby and + * reference func matrix_vector_product + * + * zomatcopy perform operation: op(A) + * matrix_vector_product perform operation: A*x + * zaxpby perform operation: alpha*x + beta*y + * + * param api specifies tested api (C or Fortran) + * param order specifies row or column major order + * param trans specifies op(A), the transposition operation + * applied to the matrix A + * param m specifies number of rows of A + * param n specifies number of columns of A + * param alpha specifies scalar alpha + * param lda specifies leading dimension of the matrix A + * param inc_x specifies increment for vector x + * param beta specifies scalar beta + * param inc_y specifies increment for vector y + * return norm of difference between zgemv and result of reference funcs + */ +static double check_zgemv(char api, char order, char trans, blasint m, blasint n, double *alpha, + blasint lda, blasint inc_x, double *beta, blasint inc_y) +{ + blasint i; + + enum CBLAS_ORDER corder; + enum CBLAS_TRANSPOSE ctrans; + + // Transpose parameters for zomatcopy + // zgemv_t perform operation on transposed matrix, no need to transpose a_verify + char trans_copy; + char ctrans_copy; + + // Param alpha for zomatcopy, scale on alpha perform zaxpby + double alpha_one[] = {1.0, 0.0}; + + memset(data_zgemv_t.x_verify, 0.0, m * inc_x * 2 * sizeof(double)); + + // Fill matrix A, vectors x, y + drand_generate(data_zgemv_t.a_test, lda * n * 2); + drand_generate(data_zgemv_t.x_test, m * inc_x * 2); + drand_generate(data_zgemv_t.y_test, m * inc_y * 2); + + // Copy vector y for reference funcs + for (int i = 0; i < m * inc_y * 2; i++) + { + data_zgemv_t.y_verify[i] = data_zgemv_t.y_test[i]; + } + + if (api == 'F') { + if (trans == 'T') trans_copy = 'N'; + if (trans == 'C') trans_copy = 'R'; + if (trans == 'U') trans_copy = 'R'; + if (trans == 'D') trans_copy = 'N'; + + // Perform operation: op(A) + BLASFUNC(zomatcopy)(&order, &trans_copy, &m, &n, alpha_one, + data_zgemv_t.a_test, &lda, data_zgemv_t.a_verify, &lda); + + // Find A*x + matrix_vector_product(n, m, lda, inc_x); + + // Find conj(x) + if (trans == 'U' || trans == 'D') + { + zconjugate_vector(m, inc_x, data_zgemv_t.x_verify); + } + + // Find alpha*x+beta*y + BLASFUNC(zaxpby)(&n, alpha, data_zgemv_t.x_verify, &inc_x, beta, + data_zgemv_t.y_verify, &inc_y); + + BLASFUNC(zgemv)(&trans, &m, &n, alpha, data_zgemv_t.a_test, &lda, + data_zgemv_t.x_test, &inc_x, beta, data_zgemv_t.y_test, &inc_y); + } + else { + if (order == 'C') corder = CblasColMajor; + if (order == 'R') corder = CblasRowMajor; + if (trans == 'T') {ctrans = CblasTrans; ctrans_copy = (corder == CblasRowMajor) ? CblasTrans : CblasNoTrans;} + if (trans == 'N') {ctrans = CblasNoTrans; ctrans_copy = (corder == CblasRowMajor) ? CblasNoTrans : CblasTrans;} + if (trans == 'C') {ctrans = CblasConjTrans; ctrans_copy = (corder == CblasRowMajor) ? CblasConjTrans : CblasConjNoTrans;} + if (trans == 'R') {ctrans = CblasConjNoTrans; ctrans_copy = (corder == CblasRowMajor) ? CblasConjNoTrans : CblasConjTrans;} + + // Perform operation: op(A) + cblas_zomatcopy(corder, ctrans_copy, m, n, alpha_one, data_zgemv_t.a_test, lda, data_zgemv_t.a_verify, lda); + + // Find A*x + matrix_vector_product(n, m, lda, inc_x); + + // Find alpha*x+beta*y + cblas_zaxpby(n, alpha, data_zgemv_t.x_verify, inc_x, beta, data_zgemv_t.y_verify, inc_y); + + cblas_zgemv(corder, ctrans, m, n, alpha, data_zgemv_t.a_test, + lda, data_zgemv_t.x_test, inc_x, beta, data_zgemv_t.y_test, inc_y); + } + + // Find the differences between output vector caculated by zgemv and reference funcs + for (i = 0; i < m * inc_y * 2; i++) + data_zgemv_t.y_test[i] -= data_zgemv_t.y_verify[i]; + + // Find the norm of differences + return cblas_dznrm2(m, data_zgemv_t.y_test, inc_y); +} + +/** + * Check if error function was called with expected function name + * and param info + * + * param order specifies row or column major order + * param trans specifies op(A), the transposition operation + * applied to the matrix A + * param m specifies number of rows of A + * param n specifies number of columns of A + * param lda specifies leading dimension of the matrix A + * param inc_x specifies increment for vector x + * param inc_y specifies increment for vector y + * param expected_info - expected invalid parameter number + * return TRUE if everything is ok, otherwise FALSE + */ +static int check_badargs(char order, char trans, blasint m, blasint n, + blasint lda, blasint inc_x, blasint inc_y, int expected_info) +{ + double alpha[] = {1.0, 1.0}; + double a[] = {1.0, 1.0}; + double x[] = {1.0, 1.0}; + double beta[] = {1.0, 1.0}; + double y[] = {1.0, 1.0}; + + set_xerbla("ZGEMV ", expected_info); + + BLASFUNC(zgemv)(&trans, &m, &n, alpha, a, &lda, x, + &inc_x, beta, y, &inc_y); + + return check_error(); +} + +/** + * C API specific function + * Check if error function was called with expected function name + * and param info + * + * param order specifies row or column major order + * param trans specifies op(A), the transposition operation + * applied to the matrix A + * param m specifies number of rows of A + * param n specifies number of columns of A + * param lda specifies leading dimension of the matrix A + * param inc_x specifies increment for vector x + * param inc_y specifies increment for vector y + * param expected_info - expected invalid parameter number + * return TRUE if everything is ok, otherwise FALSE + */ +static int c_api_check_badargs(CBLAS_ORDER corder, CBLAS_TRANSPOSE ctrans, blasint m, blasint n, + blasint lda, blasint inc_x, blasint inc_y, int expected_info) +{ + double alpha[] = {1.0, 1.0}; + double a[] = {1.0, 1.0}; + double x[] = {1.0, 1.0}; + double beta[] = {1.0, 1.0}; + double y[] = {1.0, 1.0}; + + set_xerbla("ZGEMV ", expected_info); + + cblas_zgemv(corder, ctrans, m, n, alpha, a, lda, x, inc_x, beta, y, inc_y); + + return check_error(); +} + +/** + * Fortran API specific test + * Test zgemv by comparing it against reference + * with the following options: + * + * Column Major + * Transposition + * Square matrix + * inc x = 2, inc y = 1 + * alpha_r = 1.0, alpha_i = 1.0 + * beta_r = 2.0, beta_i = 2.0 + */ +CTEST(zgemv, colmajor_trans_col_100_row_100_inc_x_1_y_1) +{ + blasint m = 100, n = 100; + blasint lda = 100; + char order = 'C'; + char trans = 'T'; + + double alpha[] = {2.0, 1.0}; + double beta[] = {1.0, 2.0}; + + blasint inc_x = 1; + blasint inc_y = 1; + + double norm = check_zgemv('F', order, trans, m, n, alpha, lda, + inc_x, beta, inc_y); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS_ZGEMV); +} + +/** + * Fortran API specific test + * Test zgemv by comparing it against reference + * with the following options: + * + * Column Major + * Transposition + * Square matrix + * inc x = 2, inc y = 1 + * alpha_r = 1.0, alpha_i = 1.0 + * beta_r = 2.0, beta_i = 2.0 + */ +CTEST(zgemv, colmajor_trans_col_100_row_100_inc_x_2_y_1) +{ + blasint m = 100, n = 100; + blasint lda = 100; + char order = 'C'; + char trans = 'T'; + + double alpha[] = {1.0, 1.0}; + double beta[] = {2.0, 2.0}; + + blasint inc_x = 2; + blasint inc_y = 1; + + double norm = check_zgemv('F', order, trans, m, n, alpha, lda, + inc_x, beta, inc_y); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS_ZGEMV); +} + +/** + * Fortran API specific test + * Test zgemv by comparing it against reference + * with the following options: + * + * Column Major + * Transposition and conjugate A + * Square matrix + * inc x = 1, inc y = 1 + * alpha_r = 2.0, alpha_i = 1.0 + * beta_r = 2.0, beta_i = 1.0 + */ +CTEST(zgemv, colmajor_conjtrans_col_100_row_100_inc_x_1_y_1) +{ + blasint m = 100, n = 100; + blasint lda = 100; + char order = 'C'; + char trans = 'C'; + + double alpha[] = {2.0, 1.0}; + double beta[] = {2.0, 1.0}; + + blasint inc_x = 1; + blasint inc_y = 1; + + double norm = check_zgemv('F', order, trans, m, n, alpha, lda, + inc_x, beta, inc_y); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS_ZGEMV); +} + +/** + * Fortran API specific test + * Test zgemv by comparing it against reference + * with the following options: + * + * Column Major + * Transposition and conjugate A + * Square matrix + * inc x = 1, inc y = 2 + * alpha_r = 2.0, alpha_i = 1.0 + * beta_r = 2.0, beta_i = 1.0 + */ +CTEST(zgemv, colmajor_conjtrans_col_100_row_100_inc_x_1_y_2) +{ + blasint m = 100, n = 100; + blasint lda = 100; + char order = 'C'; + char trans = 'C'; + + double alpha[] = {1.0, 1.0}; + double beta[] = {1.0, 1.0}; + + blasint inc_x = 1; + blasint inc_y = 2; + + double norm = check_zgemv('F', order, trans, m, n, alpha, lda, + inc_x, beta, inc_y); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS_ZGEMV); +} + +/** + * Fortran API specific test + * Test zgemv by comparing it against reference + * with the following options: + * + * Column Major + * Transposition and x conjugate + * Square matrix + * inc x = 1, inc y = 1 + * alpha_r = 2.0, alpha_i = 1.0 + * beta_r = 2.0, beta_i = 1.0 + */ +CTEST(zgemv, colmajor_trans_x_conj_col_100_row_100_inc_x_1_y_1) +{ + blasint m = 100, n = 100; + blasint lda = 100; + char order = 'C'; + char trans = 'U'; + + double alpha[] = {1.0, 1.0}; + double beta[] = {1.0, 1.0}; + + blasint inc_x = 1; + blasint inc_y = 1; + + double norm = check_zgemv('F', order, trans, m, n, alpha, lda, + inc_x, beta, inc_y); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS_ZGEMV); +} + +/** + * Fortran API specific test + * Test zgemv by comparing it against reference + * with the following options: + * + * Column Major + * Transposition and x conjugate + * Square matrix + * inc x = 2, inc y = 2 + * alpha_r = 1.0, alpha_i = 2.0 + * beta_r = 1.0, beta_i = 1.0 + */ +CTEST(zgemv, colmajor_trans_x_conj_col_100_row_100_inc_x_2_y_2) +{ + blasint m = 100, n = 100; + blasint lda = 100; + char order = 'C'; + char trans = 'U'; + + double alpha[] = {1.0, 2.0}; + double beta[] = {1.0, 1.0}; + + blasint inc_x = 2; + blasint inc_y = 2; + + double norm = check_zgemv('F', order, trans, m, n, alpha, lda, + inc_x, beta, inc_y); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS_ZGEMV); +} + +/** + * Fortran API specific test + * Test zgemv by comparing it against reference + * with the following options: + * + * Column Major + * Transposition, conjugate A, conjugate x + * Square matrix + * inc x = 2, inc y = 2 + * alpha_r = 2.0, alpha_i = 1.0 + * beta_r = 1.0, beta_i = 2.0 + */ +CTEST(zgemv, colmajor_conjtrans_x_conj_col_100_row_100_inc_x_1_y_2) +{ + blasint m = 100, n = 100; + blasint lda = 100; + char order = 'C'; + char trans = 'D'; + + double alpha[] = {2.0, 1.0}; + double beta[] = {1.0, 2.0}; + + blasint inc_x = 1; + blasint inc_y = 2; + + double norm = check_zgemv('F', order, trans, m, n, alpha, lda, + inc_x, beta, inc_y); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS_ZGEMV); +} + +/** + * C API specific test + * Test zgemv by comparing it against reference + * with the following options: + * + * Column Major + * Transposition, conjugate A, conjugate x + * Square matrix + * inc x = 2, inc y = 1 + * alpha_r = 2.0, alpha_i = 1.0 + * beta_r = 1.0, beta_i = 2.0 + */ +CTEST(zgemv, c_api_colmajor_trans_col_100_row_100_inc_x_1_y_1) +{ + blasint m = 100, n = 100; + blasint lda = 100; + char order = 'C'; + char trans = 'T'; + + double alpha[] = {2.0, 1.0}; + double beta[] = {1.0, 2.0}; + + blasint inc_x = 1; + blasint inc_y = 1; + + double norm = check_zgemv('C', order, trans, m, n, alpha, lda, + inc_x, beta, inc_y); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS_ZGEMV); +} + +/** + * C API specific test + * Test zgemv by comparing it against reference + * with the following options: + * + * Column Major + * Transposition and conjugate A + * Square matrix + * inc x = 2, inc y = 1 + * alpha_r = 1.0, alpha_i = 1.0 + * beta_r = 1.0, beta_i = 2.0 + */ +CTEST(zgemv, c_api_colmajor_conjtrans_col_100_row_100_inc_x_1_y_1) +{ + blasint m = 100, n = 100; + blasint lda = 100; + char order = 'C'; + char trans = 'C'; + + double alpha[] = {1.0, 1.0}; + double beta[] = {1.0, 2.0}; + + blasint inc_x = 1; + blasint inc_y = 1; + + double norm = check_zgemv('C', order, trans, m, n, alpha, lda, + inc_x, beta, inc_y); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS_ZGEMV); +} + +/** + * C API specific test + * Test zgemv by comparing it against reference + * with the following options: + * + * Column Major + * Transposition and conjugate A + * Square matrix + * inc x = 1, inc y = 2 + * alpha_r = 1.0, alpha_i = 1.0 + * beta_r = 1.0, beta_i = 2.0 + */ +CTEST(zgemv, c_api_colmajor_conjtrans_col_100_row_100_inc_x_1_y_2) +{ + blasint m = 100, n = 100; + blasint lda = 100; + char order = 'C'; + char trans = 'C'; + + double alpha[] = {1.0, 1.0}; + double beta[] = {1.0, 2.0}; + + blasint inc_x = 1; + blasint inc_y = 2; + + double norm = check_zgemv('C', order, trans, m, n, alpha, lda, + inc_x, beta, inc_y); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS_ZGEMV); +} + +/** + * C API specific test + * Test zgemv by comparing it against reference + * with the following options: + * + * Row Major + * Square matrix + * inc x = 1, inc y = 1 + * alpha_r = 2.0, alpha_i = 1.0 + * beta_r = 1.0, beta_i = 1.0 + */ +CTEST(zgemv, c_api_rowmajor_notrans_col_100_row_100_inc_x_1_y_1) +{ + blasint m = 100, n = 100; + blasint lda = 100; + char order = 'R'; + char trans = 'N'; + + double alpha[] = {2.0, 1.0}; + double beta[] = {1.0, 1.0}; + + blasint inc_x = 1; + blasint inc_y = 1; + + double norm = check_zgemv('C', order, trans, m, n, alpha, lda, + inc_x, beta, inc_y); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS_ZGEMV); +} + +/** + * C API specific test + * Test zgemv by comparing it against reference + * with the following options: + * + * Row Major + * No trans + * Square matrix + * inc x = 2, inc y = 2 + * alpha_r = 1.0, alpha_i = 1.0 + * beta_r = 3.0, beta_i = 2.0 + */ +CTEST(zgemv, c_api_rowmajor_notrans_col_100_row_100_inc_x_2_y_2) +{ + blasint m = 100, n = 100; + blasint lda = 100; + char order = 'R'; + char trans = 'N'; + + double alpha[] = {1.0, 1.0}; + double beta[] = {3.0, 1.0}; + + blasint inc_x = 2; + blasint inc_y = 2; + + double norm = check_zgemv('C', order, trans, m, n, alpha, lda, + inc_x, beta, inc_y); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS_ZGEMV); +} + +/** + * C API specific test + * Test zgemv by comparing it against reference + * with the following options: + * + * Column Major + * Conjugate + * Square matrix + * inc x = 1, inc y = 1 + * alpha_r = 1.0, alpha_i = 3.0 + * beta_r = 1.0, beta_i = 2.5 + */ +CTEST(zgemv, c_api_rowmajor_conj_col_100_row_100_inc_x_1_y_1) +{ + blasint m = 100, n = 100; + blasint lda = 100; + char order = 'R'; + char trans = 'R'; + + double alpha[] = {1.0, 3.0}; + double beta[] = {1.0, 2.5}; + + blasint inc_x = 1; + blasint inc_y = 1; + + double norm = check_zgemv('C', order, trans, m, n, alpha, lda, + inc_x, beta, inc_y); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS_ZGEMV); +} + +/** + * C API specific test + * Test zgemv by comparing it against reference + * with the following options: + * + * Row Major + * Conjugate + * Square matrix + * inc x = 2, inc y = 1 + * alpha_r = 1.0, alpha_i = 1.0 + * beta_r = 1.0, beta_i = 1.5 + */ +CTEST(zgemv, c_api_rowmajor_conj_col_100_row_100_inc_x_2_y_1) +{ + blasint m = 100, n = 100; + blasint lda = 100; + char order = 'R'; + char trans = 'R'; + + double alpha[] = {1.0, 1.0}; + double beta[] = {1.0, 1.5}; + + blasint inc_x = 2; + blasint inc_y = 1; + + double norm = check_zgemv('C', order, trans, m, n, alpha, lda, + inc_x, beta, inc_y); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS_ZGEMV); +} + +/** + * Fortran API specific test + * Test error function for an invalid param inc_y. + * Must be positive + * + * Column major + */ +CTEST(zgemv, xerbla_invalid_inc_y) +{ + char order = 'C'; + char trans = 'T'; + + blasint m = 1, n = 1; + blasint lda = 1; + + blasint inc_x = 1; + blasint inc_y = 0; + + int expected_info = 11; + + int passed = check_badargs(order, trans, m, n, lda, inc_x, inc_y, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param inc_y. + * Must be positive + * + * Column major + */ +CTEST(zgemv, c_api_xerbla_invalid_inc_y_col_major) +{ + enum CBLAS_ORDER corder = CblasColMajor; + enum CBLAS_TRANSPOSE ctrans = CblasTrans; + + blasint m = 1, n = 1; + blasint lda = 1; + + blasint inc_x = 1; + blasint inc_y = 0; + + int expected_info = 11; + + int passed = c_api_check_badargs(corder, ctrans, m, n, lda, inc_x, inc_y, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param inc_y. + * Must be positive + * + * Row major + */ +CTEST(zgemv, c_api_xerbla_invalid_inc_y_row_major) +{ + enum CBLAS_ORDER corder = CblasRowMajor; + enum CBLAS_TRANSPOSE ctrans = CblasNoTrans; + + blasint m = 1, n = 1; + blasint lda = 1; + + blasint inc_x = 1; + blasint inc_y = 0; + + int expected_info = 11; + + int passed = c_api_check_badargs(corder, ctrans, m, n, lda, inc_x, inc_y, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param inc_x. + * Must be positive + * + * Column major + */ +CTEST(zgemv, xerbla_invalid_inc_x) +{ + char order = 'C'; + char trans = 'T'; + blasint m = 1, n = 1; + blasint lda = 1; + + blasint inc_x = 0; + blasint inc_y = 1; + + int expected_info = 8; + + int passed = check_badargs(order, trans, m, n, lda, inc_x, inc_y, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param inc_x. + * Must be positive + * + * Column major + */ +CTEST(zgemv, c_api_xerbla_invalid_inc_x_col_major) +{ + enum CBLAS_ORDER corder = CblasColMajor; + enum CBLAS_TRANSPOSE ctrans = CblasTrans; + + blasint m = 1, n = 1; + blasint lda = 1; + + blasint inc_x = 0; + blasint inc_y = 1; + + int expected_info = 8; + + int passed = c_api_check_badargs(corder, ctrans, m, n, lda, inc_x, inc_y, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param inc_x. + * Must be positive + * + * Row major + */ +CTEST(zgemv, c_api_xerbla_invalid_inc_x_row_major) +{ + enum CBLAS_ORDER corder = CblasColMajor; + enum CBLAS_TRANSPOSE ctrans = CblasTrans; + + blasint m = 1, n = 1; + blasint lda = 1; + + blasint inc_x = 0; + blasint inc_y = 1; + + int expected_info = 8; + + int passed = c_api_check_badargs(corder, ctrans, m, n, lda, inc_x, inc_y, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param n. + * Must be positive. + * + * Column major + */ +CTEST(zgemv, xerbla_invalid_n) +{ + char order = 'C'; + char trans = 'T'; + + blasint m = 1, n = INVALID; + blasint lda = 1; + + blasint inc_x = 1; + blasint inc_y = 1; + + int expected_info = 3; + + int passed = check_badargs(order, trans, m, n, lda, inc_x, inc_y, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param n. + * Must be positive. + * + * Column major + */ +CTEST(zgemv, c_api_xerbla_invalid_n_col_major) +{ + enum CBLAS_ORDER corder = CblasColMajor; + enum CBLAS_TRANSPOSE ctrans = CblasTrans; + + blasint m = 1, n = INVALID; + blasint lda = 1; + + blasint inc_x = 1; + blasint inc_y = 1; + + int expected_info = 3; + + int passed = c_api_check_badargs(corder, ctrans, m, n, lda, inc_x, inc_y, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param n. + * Must be positive. + * + * Row major + */ +CTEST(zgemv, c_api_xerbla_invalid_n_row_major) +{ + enum CBLAS_ORDER corder = CblasRowMajor; + enum CBLAS_TRANSPOSE ctrans = CblasNoTrans; + + blasint m = INVALID, n = 1; + blasint lda = 1; + + blasint inc_x = 1; + blasint inc_y = 1; + + int expected_info = 3; + + int passed = c_api_check_badargs(corder, ctrans, m, n, lda, inc_x, inc_y, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param m. + * Must be positive. + * + * Column major + */ +CTEST(zgemv, xerbla_invalid_m) +{ + char order = 'C'; + char trans = 'T'; + + blasint m = INVALID, n = 1; + blasint lda = 1; + + blasint inc_x = 1; + blasint inc_y = 1; + + int expected_info = 2; + + int passed = check_badargs(order, trans, m, n, lda, inc_x, inc_y, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param m. + * Must be positive. + * + * Column major + */ +CTEST(zgemv, c_api_xerbla_invalid_m_col_major) +{ + enum CBLAS_ORDER corder = CblasColMajor; + enum CBLAS_TRANSPOSE ctrans = CblasTrans; + + blasint m = INVALID, n = 1; + blasint lda = 1; + + blasint inc_x = 1; + blasint inc_y = 1; + + int expected_info = 2; + + int passed = c_api_check_badargs(corder, ctrans, m, n, lda, inc_x, inc_y, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param m. + * Must be positive. + * + * Row major + */ +CTEST(zgemv, c_api_xerbla_invalid_m_row_major) +{ + enum CBLAS_ORDER corder = CblasRowMajor; + enum CBLAS_TRANSPOSE ctrans = CblasNoTrans; + + blasint m = 1, n = INVALID; + blasint lda = 1; + + blasint inc_x = 1; + blasint inc_y = 1; + + int expected_info = 2; + + int passed = c_api_check_badargs(corder, ctrans, m, n, lda, inc_x, inc_y, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param lda. + * lda must be at least n. + * + * Column major + */ +CTEST(zgemv, xerbla_invalid_lda) +{ + char order = 'C'; + char trans = 'T'; + + blasint m = 1, n = 1; + blasint lda = INVALID; + + blasint inc_x = 1; + blasint inc_y = 1; + + int expected_info = 6; + + int passed = check_badargs(order, trans, m, n, lda, inc_x, inc_y, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param lda. + * If matrices are stored using col major layout, + * lda must be at least m. + * + * Column major + */ +CTEST(zgemv, c_api_xerbla_invalid_lda_col_major) +{ + enum CBLAS_ORDER corder = CblasColMajor; + enum CBLAS_TRANSPOSE ctrans = CblasTrans; + + blasint m = 1, n = 1; + blasint lda = INVALID; + + blasint inc_x = 1; + blasint inc_y = 1; + + int expected_info = 6; + + int passed = c_api_check_badargs(corder, ctrans, m, n, lda, inc_x, inc_y, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param lda. + * If matrices are stored using col major layout, + * lda must be at least n. + * + * Column major + */ +CTEST(zgemv, c_api_xerbla_invalid_lda_row_major) +{ + enum CBLAS_ORDER corder = CblasRowMajor; + enum CBLAS_TRANSPOSE ctrans = CblasNoTrans; + + blasint m = 1, n = 1; + blasint lda = INVALID; + + blasint inc_x = 1; + blasint inc_y = 1; + + int expected_info = 6; + + int passed = c_api_check_badargs(corder, ctrans, m, n, lda, inc_x, inc_y, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Fortran API specific test + * Test error function for an invalid param trans. + * + * Column major + */ +CTEST(zgemv, xerbla_invalid_trans) +{ + char order = 'C'; + char trans = 'Z'; + + blasint m = 1, n = 1; + blasint lda = 1; + + blasint inc_x = 1; + blasint inc_y = 1; + + int expected_info = 1; + + int passed = check_badargs(order, trans, m, n, lda, inc_x, inc_y, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param trans. + * + * Column major + */ +CTEST(zgemv, c_api_xerbla_invalid_trans_col_major) +{ + enum CBLAS_ORDER corder = CblasColMajor; + enum CBLAS_TRANSPOSE ctrans = INVALID; + + blasint m = 1, n = 1; + blasint lda = 1; + + blasint inc_x = 1; + blasint inc_y = 1; + + int expected_info = 1; + + int passed = c_api_check_badargs(corder, ctrans, m, n, lda, inc_x, inc_y, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param trans. + * + * Row major + */ +CTEST(zgemv, c_api_xerbla_invalid_trans_row_major) +{ + enum CBLAS_ORDER corder = CblasRowMajor; + enum CBLAS_TRANSPOSE ctrans = INVALID; + + blasint m = 1, n = 1; + blasint lda = 1; + + blasint inc_x = 1; + blasint inc_y = 1; + + int expected_info = 1; + + int passed = c_api_check_badargs(corder, ctrans, m, n, lda, inc_x, inc_y, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * C API specific test + * Test error function for an invalid param order. + */ +CTEST(zgemv, c_api_xerbla_invalid_order_col_major) +{ + enum CBLAS_ORDER corder = INVALID; + enum CBLAS_TRANSPOSE ctrans = CblasTrans; + + blasint m = 1, n = 1; + blasint lda = 1; + + blasint inc_x = 1; + blasint inc_y = 1; + + int expected_info = 0; + + int passed = c_api_check_badargs(corder, ctrans, m, n, lda, inc_x, inc_y, expected_info); + ASSERT_EQUAL(TRUE, passed); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_zimatcopy.c b/utest/test_extensions/test_zimatcopy.c new file mode 100644 index 000000000..6461ce88f --- /dev/null +++ b/utest/test_extensions/test_zimatcopy.c @@ -0,0 +1,850 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. 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. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include "common.h" + +#define DATASIZE 100 + +struct DATA_ZIMATCOPY { + double a_test[DATASIZE * DATASIZE * 2]; + double a_verify[DATASIZE * DATASIZE * 2]; +}; + +#ifdef BUILD_COMPLEX16 +static struct DATA_ZIMATCOPY data_zimatcopy; + +/** + * Comapare results computed by zimatcopy and reference func + * + * param api specifies tested api (C or Fortran) + * param order specifies row or column major order + * param trans specifies op(A), the transposition operation + * applied to the matrix A + * param rows specifies number of rows of A + * param cols specifies number of columns of A + * param alpha specifies scaling factor for matrix A + * param lda_src - leading dimension of the matrix A + * param lda_dst - leading dimension of output matrix A + * return norm of difference between openblas and reference func + */ +static double check_zimatcopy(char api, char order, char trans, blasint rows, blasint cols, double *alpha, + blasint lda_src, blasint lda_dst) +{ + blasint m, n; + blasint rows_out, cols_out; + enum CBLAS_ORDER corder; + enum CBLAS_TRANSPOSE ctrans; + int conj = -1; + + if (order == 'C') { + n = rows; m = cols; + } + else { + m = rows; n = cols; + } + + if(trans == 'T' || trans == 'C') { + rows_out = n; cols_out = m*2; + if (trans == 'C') + conj = 1; + } + else { + rows_out = m; cols_out = n*2; + if (trans == 'R') + conj = 1; + } + + drand_generate(data_zimatcopy.a_test, lda_src*m*2); + + if (trans == 'T' || trans == 'C') { + ztranspose(m, n, alpha, data_zimatcopy.a_test, lda_src, data_zimatcopy.a_verify, lda_dst, conj); + } + else { + zcopy(m, n, alpha, data_zimatcopy.a_test, lda_src, data_zimatcopy.a_verify, lda_dst, conj); + } + + if (api == 'F') { + BLASFUNC(zimatcopy)(&order, &trans, &rows, &cols, alpha, data_zimatcopy.a_test, + &lda_src, &lda_dst); + } + else { + if (order == 'C') corder = CblasColMajor; + if (order == 'R') corder = CblasRowMajor; + if (trans == 'T') ctrans = CblasTrans; + if (trans == 'N') ctrans = CblasNoTrans; + if (trans == 'C') ctrans = CblasConjTrans; + if (trans == 'R') ctrans = CblasConjNoTrans; + cblas_zimatcopy(corder, ctrans, rows, cols, alpha, data_zimatcopy.a_test, + lda_src, lda_dst); + } + + // Find the differences between output matrix computed by zimatcopy and reference func + return dmatrix_difference(data_zimatcopy.a_test, data_zimatcopy.a_verify, cols_out, rows_out, lda_dst*2); +} + +/** + * Check if error function was called with expected function name + * and param info + * + * param order specifies row or column major order + * param trans specifies op(A), the transposition operation + * applied to the matrix A + * param rows specifies number of rows of A + * param cols specifies number of columns of A + * param lda_src - leading dimension of the matrix A + * param lda_dst - leading dimension of output matrix A + * param expected_info - expected invalid parameter number + * return TRUE if everything is ok, otherwise FALSE + */ +static int check_badargs(char order, char trans, blasint rows, blasint cols, + blasint lda_src, blasint lda_dst, int expected_info) +{ + double alpha[] = {1.0, 1.0}; + + set_xerbla("ZIMATCOPY", expected_info); + + BLASFUNC(zimatcopy)(&order, &trans, &rows, &cols, alpha, data_zimatcopy.a_test, + &lda_src, &lda_dst); + + return check_error(); +} + +/** + * Fortran API specific test + * Test zimatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Transposition + * Square matrix + * alpha_r = 1.0, alpha_i = 2.0 + */ +CTEST(zimatcopy, colmajor_trans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'C'; + char trans = 'T'; + double alpha[] = {1.0, 2.0}; + + double norm = check_zimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zimatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Copy only + * Square matrix + * alpha_r = -3.0, alpha_i = 1.0 + */ +CTEST(zimatcopy, colmajor_notrans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'C'; + char trans = 'N'; + double alpha[] = {-3.0, 1.0}; + + double norm = check_zimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zimatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Copy and conjugate + * alpha_r = 1.0, alpha_i = 2.0 + */ +CTEST(zimatcopy, colmajor_conj_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'C'; + char trans = 'R'; + double alpha[] = {1.0, 2.0}; + + double norm = check_zimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zimatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Transposition and conjugate + * alpha_r = 2.0, alpha_i = 1.0 + */ +CTEST(zimatcopy, colmajor_conjtrans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'C'; + char trans = 'C'; + double alpha[] = {2.0, 1.0}; + + double norm = check_zimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zimatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Transposition + * Rectangular matrix + * alpha_r = 1.0, alpha_i = 2.0 + */ +CTEST(zimatcopy, colmajor_trans_col_50_row_100) +{ + blasint m = 100, n = 50; + blasint lda_src = 100, lda_dst = 50; + char order = 'C'; + char trans = 'T'; + double alpha[] = {1.0, 2.0}; + + double norm = check_zimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zimatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Copy only + * Rectangular matrix + * alpha_r = 1.0, alpha_i = 2.0 + */ +CTEST(zimatcopy, colmajor_notrans_col_100_row_50) +{ + blasint m = 50, n = 100; + blasint lda_src = 50, lda_dst = 50; + char order = 'C'; + char trans = 'N'; + double alpha[] = {1.0, 2.0}; + + double norm = check_zimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zimatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Transposition and conjugate + * Rectangular matrix + * alpha_r = 1.0, alpha_i = 1.0 + */ +CTEST(zimatcopy, colmajor_conjtrans_col_50_row_100) +{ + blasint m = 100, n = 50; + blasint lda_src = 100, lda_dst = 50; + char order = 'C'; + char trans = 'C'; + double alpha[] = {1.0, 1.0}; + + double norm = check_zimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zimatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Copy and conjugate + * Rectangular matrix + * alpha_r = 1.0, alpha_i = 2.0 + */ +CTEST(zimatcopy, colmajor_conj_col_100_row_50) +{ + blasint m = 50, n = 100; + blasint lda_src = 50, lda_dst = 50; + char order = 'C'; + char trans = 'R'; + double alpha[] = {1.0, 2.0}; + + double norm = check_zimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zimatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Transposition + * Square matrix + * alpha_r = 1.0, alpha_i = 2.0 + */ +CTEST(zimatcopy, rowmajor_trans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'R'; + char trans = 'T'; + double alpha[] = {1.0, 2.0}; + + double norm = check_zimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zimatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Copy only + * Square matrix + * alpha_r = 2.0, alpha_i = 3.0 + */ +CTEST(zimatcopy, rowmajor_notrans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'R'; + char trans = 'N'; + double alpha[] = {2.0, 3.0}; + + double norm = check_zimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zimatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Copy and conjugate + * alpha_r = 1.0, alpha_i = 2.0 + */ +CTEST(zimatcopy, rowmajor_conj_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'R'; + char trans = 'R'; + double alpha[] = {1.0, 2.0}; + + double norm = check_zimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zimatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Transposition and conjugate + * alpha_r = 2.0, alpha_i = 1.0 + */ +CTEST(zimatcopy, rowmajor_conjtrans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'R'; + char trans = 'C'; + double alpha[] = {2.0, 1.0}; + + double norm = check_zimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zimatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Copy only + * Rectangular matrix + * alpha_r = 2.0, alpha_i = 1.0 + */ +CTEST(zimatcopy, rowmajor_notrans_col_50_row_100) +{ + blasint m = 100, n = 50; + blasint lda_src = 50, lda_dst = 50; + char order = 'R'; + char trans = 'N'; + double alpha[] = {2.0, 1.0}; + + double norm = check_zimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zimatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Transposition + * Rectangular matrix + * alpha_r = 1.0, alpha_i = 2.0 + */ +CTEST(zimatcopy, rowmajor_trans_col_50_row_100) +{ + blasint m = 100, n = 50; + blasint lda_src = 50, lda_dst = 100; + char order = 'R'; + char trans = 'T'; + double alpha[] = {1.0, 2.0}; + + double norm = check_zimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zimatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Copy and conjugate + * alpha_r = 1.5, alpha_i = -1.0 + */ +CTEST(zimatcopy, rowmajor_conj_col_50_row_100) +{ + blasint m = 100, n = 50; + blasint lda_src = 50, lda_dst = 50; + char order = 'R'; + char trans = 'R'; + double alpha[] = {1.5, -1.0}; + + double norm = check_zimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zimatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Transposition and conjugate + * alpha_r = 1.0, alpha_i = 2.0 + */ +CTEST(zimatcopy, rowmajor_conjtrans_col_50_row_100) +{ + blasint m = 100, n = 50; + blasint lda_src = 50, lda_dst = 100; + char order = 'R'; + char trans = 'C'; + double alpha[] = {1.0, 2.0}; + + double norm = check_zimatcopy('F', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zimatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Transposition + * Square matrix + * alpha_r = 3.0, alpha_i = 2.0 + */ +CTEST(zimatcopy, c_api_colmajor_trans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'C'; + char trans = 'T'; + double alpha[] = {3.0, 2.0}; + + double norm = check_zimatcopy('C', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zimatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Copy only + * Square matrix + * alpha_r = 3.0, alpha_i = 1.5 + */ +CTEST(zimatcopy, c_api_colmajor_notrans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'C'; + char trans = 'N'; + double alpha[] = {3.0, 1.5}; + + double norm = check_zimatcopy('C', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zimatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Transposition + * Square matrix + * alpha_r = 3.0, alpha_i = 1.0 + */ +CTEST(zimatcopy, c_api_rowmajor_trans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'R'; + char trans = 'T'; + double alpha[] = {3.0, 1.0}; + + double norm = check_zimatcopy('C', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zimatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Copy and conjugate + * alpha_r = 1.0, alpha_i = 2.0 + */ +CTEST(zimatcopy, c_api_colmajor_conj_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'C'; + char trans = 'R'; + double alpha[] = {1.0, 2.0}; + + double norm = check_zimatcopy('C', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zimatcopy by comparing it against reference + * with the following options: + * + * Column Major + * Transposition and conjugate + * alpha_r = 2.0, alpha_i = 1.0 + */ +CTEST(zimatcopy, c_api_colmajor_conjtrans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'C'; + char trans = 'C'; + double alpha[] = {2.0, 1.0}; + + double norm = check_zimatcopy('C', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zimatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Copy only + * Square matrix + * alpha_r = 1.0, alpha_i = 1.0 + */ +CTEST(zimatcopy, c_api_rowmajor_notrans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'R'; + char trans = 'N'; + double alpha[] = {1.0, 1.0}; + + double norm = check_zimatcopy('C', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zimatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Copy and conjugate + * alpha_r = 1.5, alpha_i = -1.0 + */ +CTEST(zimatcopy, c_api_rowmajor_conj_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'R'; + char trans = 'R'; + double alpha[] = {1.5, -1.0}; + + double norm = check_zimatcopy('C', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zimatcopy by comparing it against reference + * with the following options: + * + * Row Major + * Transposition and conjugate + * alpha_r = 1.0, alpha_i = 2.0 + */ +CTEST(zimatcopy, c_api_rowmajor_conjtrans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'R'; + char trans = 'C'; + double alpha[] = {1.0, 2.0}; + + double norm = check_zimatcopy('C', order, trans, m, n, alpha, lda_src, lda_dst); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Test error function for an invalid param order. + * Must be column (C) or row major (R). + */ +CTEST(zimatcopy, xerbla_invalid_order) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'O'; + char trans = 'T'; + int expected_info = 1; + + int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param trans. + * Must be trans (T/C) or no-trans (N/R). + */ +CTEST(zimatcopy, xerbla_invalid_trans) +{ + blasint m = 100, n = 100; + blasint lda_src = 100, lda_dst = 100; + char order = 'C'; + char trans = 'O'; + int expected_info = 2; + + int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param m. + * Must be positive. + */ +CTEST(zimatcopy, xerbla_invalid_rows) +{ + blasint m = 0, n = 100; + blasint lda_src = 0, lda_dst = 100; + char order = 'C'; + char trans = 'T'; + int expected_info = 3; + + int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param n. + * Must be positive. + */ +CTEST(zimatcopy, xerbla_invalid_cols) +{ + blasint m = 100, n = 0; + blasint lda_src = 100, lda_dst = 0; + char order = 'C'; + char trans = 'T'; + int expected_info = 4; + + int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param lda_src. + * If matrices are stored using row major layout, + * lda_src must be at least n. + */ +CTEST(zimatcopy, xerbla_rowmajor_invalid_lda) +{ + blasint m = 50, n = 100; + blasint lda_src = 50, lda_dst = 100; + char order = 'R'; + char trans = 'T'; + int expected_info = 7; + + int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param lda_src. + * If matrices are stored using column major layout, + * lda_src must be at least m. + */ +CTEST(zimatcopy, xerbla_colmajor_invalid_lda) +{ + blasint m = 100, n = 50; + blasint lda_src = 50, lda_dst = 100; + char order = 'C'; + char trans = 'T'; + int expected_info = 7; + + int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param lda_dst. + * If matrices are stored using row major layout and + * there is no transposition, lda_dst must be at least n. + */ +CTEST(zimatcopy, xerbla_rowmajor_notrans_invalid_ldb) +{ + blasint m = 50, n = 100; + blasint lda_src = 100, lda_dst = 50; + char order = 'R'; + char trans = 'N'; + int expected_info = 9; + + int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param lda_dst. + * If matrices are stored using row major layout and + * there is transposition, lda_dst must be at least m. + */ +CTEST(zimatcopy, xerbla_rowmajor_trans_invalid_ldb) +{ + blasint m = 100, n = 50; + blasint lda_src = 100, lda_dst = 50; + char order = 'R'; + char trans = 'T'; + int expected_info = 9; + + int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param lda_dst. + * If matrices are stored using column major layout and + * there is no transposition, lda_dst must be at least m. + */ +CTEST(zimatcopy, xerbla_colmajor_notrans_invalid_ldb) +{ + blasint m = 100, n = 50; + blasint lda_src = 100, lda_dst = 50; + char order = 'C'; + char trans = 'N'; + int expected_info = 9; + + int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param lda_dst. + * If matrices are stored using column major layout and + * there is transposition, lda_dst must be at least n. + */ +CTEST(zimatcopy, xerbla_colmajor_trans_invalid_ldb) +{ + blasint m = 50, n = 100; + blasint lda_src = 100, lda_dst = 50; + char order = 'C'; + char trans = 'T'; + int expected_info = 9; + + int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); + ASSERT_EQUAL(TRUE, passed); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_zomatcopy.c b/utest/test_extensions/test_zomatcopy.c new file mode 100644 index 000000000..8df3dd80f --- /dev/null +++ b/utest/test_extensions/test_zomatcopy.c @@ -0,0 +1,745 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. 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. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include "common.h" + +#define DATASIZE 100 + +struct DATA_ZOMATCOPY { + double a_test[DATASIZE * DATASIZE * 2]; + double b_test[DATASIZE * DATASIZE * 2]; + double b_verify[DATASIZE * DATASIZE * 2]; +}; + +#ifdef BUILD_COMPLEX16 +static struct DATA_ZOMATCOPY data_zomatcopy; + +/** + * Comapare results computed by zomatcopy and reference func + * + * param api specifies tested api (C or Fortran) + * param order specifies row or column major order + * param trans specifies op(A), the transposition operation + * applied to the matrix A + * param rows - number of rows of A + * param cols - number of columns of A + * param alpha - scaling factor for matrix B + * param lda - leading dimension of the matrix A + * param ldb - leading dimension of the matrix B + * return norm of difference between openblas and reference func + */ +static double check_zomatcopy(char api, char order, char trans, blasint rows, blasint cols, double* alpha, + blasint lda, blasint ldb) +{ + blasint b_rows, b_cols; + blasint m, n; + enum CBLAS_ORDER corder; + enum CBLAS_TRANSPOSE ctrans; + int conj = -1; + + if (order == 'C') { + m = cols; n = rows; + } + else { + m = rows; n = cols; + } + + if(trans == 'T' || trans == 'C') { + b_rows = n; b_cols = m*2; + if (trans == 'C') + conj = 1; + } + else { + b_rows = m; b_cols = n*2; + if (trans == 'R') + conj = 1; + } + + drand_generate(data_zomatcopy.a_test, lda*m*2); + + if (trans == 'T' || trans == 'C') { + ztranspose(m, n, alpha, data_zomatcopy.a_test, lda, data_zomatcopy.b_verify, ldb, conj); + } + else { + zcopy(m, n, alpha, data_zomatcopy.a_test, lda, data_zomatcopy.b_verify, ldb, conj); + } + + if (api == 'F') { + BLASFUNC(zomatcopy)(&order, &trans, &rows, &cols, alpha, data_zomatcopy.a_test, + &lda, data_zomatcopy.b_test, &ldb); + } + else { + if (order == 'C') corder = CblasColMajor; + if (order == 'R') corder = CblasRowMajor; + if (trans == 'T') ctrans = CblasTrans; + if (trans == 'N') ctrans = CblasNoTrans; + if (trans == 'C') ctrans = CblasConjTrans; + if (trans == 'R') ctrans = CblasConjNoTrans; + cblas_zomatcopy(corder, ctrans, rows, cols, alpha, data_zomatcopy.a_test, + lda, data_zomatcopy.b_test, ldb); + } + + return dmatrix_difference(data_zomatcopy.b_test, data_zomatcopy.b_verify, b_cols, b_rows, ldb*2); +} + +/** + * Check if error function was called with expected function name + * and param info + * + * param order specifies row or column major order + * param trans specifies op(A), the transposition operation + * applied to the matrix A + * param rows - number of rows of A + * param cols - number of columns of A + * param lda - leading dimension of the matrix A + * param ldb - leading dimension of the matrix B + * param expected_info - expected invalid parameter number + * return TRUE if everything is ok, otherwise FALSE + */ +static int check_badargs(char order, char trans, blasint rows, blasint cols, + blasint lda, blasint ldb, int expected_info) +{ + double alpha[] = {1.0, 1.0}; + + set_xerbla("ZOMATCOPY", expected_info); + + BLASFUNC(zomatcopy)(&order, &trans, &rows, &cols, alpha, data_zomatcopy.a_test, + &lda, data_zomatcopy.b_test, &ldb); + + return check_error(); +} + +/** + * Fortran API specific test + * Test zomatcopy by comparing it against refernce + * with the following options: + * + * Column Major + * Copy only + * alpha_r = 1.0, alpha_i = 2.0 + */ +CTEST(zomatcopy, colmajor_notrans_col_50_row_100) +{ + blasint m = 100, n = 50; + blasint lda = 100, ldb = 100; + char order = 'C'; + char trans = 'N'; + double alpha[] = {1.0, 2.0}; + double norm; + + norm = check_zomatcopy('F', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zomatcopy by comparing it against refernce + * with the following options: + * + * Column Major + * Transposition + * alpha_r = -1.0, alpha_i = 2.0 + */ +CTEST(zomatcopy, colmajor_trans_col_50_row_100) +{ + blasint m = 100, n = 50; + blasint lda = 100, ldb = 50; + char order = 'C'; + char trans = 'T'; + double alpha[] = {-1.0, 2.0}; + double norm; + + norm = check_zomatcopy('F', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zomatcopy by comparing it against refernce + * with the following options: + * + * Column Major + * Copy and conjugate + * alpha_r = 1.0, alpha_i = 2.0 + */ +CTEST(zomatcopy, colmajor_conj_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda = 100, ldb = 100; + char order = 'C'; + char trans = 'R'; + double alpha[] = {1.0, 2.0}; + double norm; + + norm = check_zomatcopy('F', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zomatcopy by comparing it against refernce + * with the following options: + * + * Column Major + * Transposition and conjugate + * alpha_r = 2.0, alpha_i = 1.0 + */ +CTEST(zomatcopy, colmajor_conjtrnas_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda = 100, ldb = 100; + char order = 'C'; + char trans = 'C'; + double alpha[] = {2.0, 1.0}; + double norm; + + norm = check_zomatcopy('F', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Fortran API specific test + * Test zomatcopy by comparing it against refernce + * with the following options: + * + * Row Major + * Copy only + * alpha_r = 1.5, alpha_i = -1.0 + */ +CTEST(zomatcopy, rowmajor_notrans_col_50_row_100) +{ + blasint m = 100, n = 50; + blasint lda = 50, ldb = 50; + char order = 'R'; + char trans = 'N'; + double alpha[] = {1.5, -1.0}; + double norm; + + norm = check_zomatcopy('F', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zomatcopy by comparing it against refernce + * with the following options: + * + * Row Major + * Transposition + * alpha_r = 1.5, alpha_i = -1.0 + */ +CTEST(zomatcopy, rowmajor_trans_col_100_row_50) +{ + blasint m = 50, n = 100; + blasint lda = 100, ldb = 50; + char order = 'R'; + char trans = 'T'; + double alpha[] = {1.5, -1.0}; + double norm; + + norm = check_zomatcopy('F', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zomatcopy by comparing it against refernce + * with the following options: + * + * Row Major + * Copy and conjugate + * alpha_r = 1.5, alpha_i = -1.0 + */ +CTEST(zomatcopy, rowmajor_conj_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda = 100, ldb = 100; + char order = 'R'; + char trans = 'R'; + double alpha[] = {1.5, -1.0}; + double norm; + + norm = check_zomatcopy('F', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zomatcopy by comparing it against refernce + * with the following options: + * + * Row Major + * Transposition and conjugate + * alpha_r = 1.0, alpha_i = 2.0 + */ +CTEST(zomatcopy, rowmajor_conjtrans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda = 100, ldb = 100; + char order = 'R'; + char trans = 'C'; + double alpha[] = {1.0, 2.0}; + double norm; + + norm = check_zomatcopy('F', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zomatcopy by comparing it against refernce + * with the following options: + * + * Column Major + * Copy only + * alpha_r = 1.0, alpha_i = 2.0 + */ +CTEST(zomatcopy, c_api_colmajor_notrans_col_50_row_100) +{ + blasint m = 100, n = 50; + blasint lda = 100, ldb = 100; + char order = 'C'; + char trans = 'N'; + double alpha[] = {1.0, 2.0}; + double norm; + + norm = check_zomatcopy('C', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zomatcopy by comparing it against refernce + * with the following options: + * + * Column Major + * Transposition + * alpha_r = -1.0, alpha_i = 2.0 + */ +CTEST(zomatcopy, c_api_colmajor_trans_col_50_row_100) +{ + blasint m = 100, n = 50; + blasint lda = 100, ldb = 50; + char order = 'C'; + char trans = 'T'; + double alpha[] = {-1.0, 2.0}; + double norm; + + norm = check_zomatcopy('C', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zomatcopy by comparing it against refernce + * with the following options: + * + * Column Major + * Copy and conjugate + * alpha_r = 1.0, alpha_i = 2.0 + */ +CTEST(zomatcopy, c_api_colmajor_conj_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda = 100, ldb = 100; + char order = 'C'; + char trans = 'R'; + double alpha[] = {1.0, 2.0}; + double norm; + + norm = check_zomatcopy('C', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zomatcopy by comparing it against refernce + * with the following options: + * + * Column Major + * Transposition and conjugate + * alpha_r = 2.0, alpha_i = 1.0 + */ +CTEST(zomatcopy, c_api_colmajor_conjtrnas_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda = 100, ldb = 100; + char order = 'C'; + char trans = 'C'; + double alpha[] = {2.0, 1.0}; + double norm; + + norm = check_zomatcopy('C', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zomatcopy by comparing it against refernce + * with the following options: + * + * Row Major + * Copy only + * alpha_r = 1.5, alpha_i = -1.0 + */ +CTEST(zomatcopy, c_api_rowmajor_notrans_col_50_row_100) +{ + blasint m = 100, n = 50; + blasint lda = 50, ldb = 50; + char order = 'R'; + char trans = 'N'; + double alpha[] = {1.5, -1.0}; + double norm; + + norm = check_zomatcopy('C', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zomatcopy by comparing it against refernce + * with the following options: + * + * Row Major + * Transposition + * alpha_r = 1.5, alpha_i = -1.0 + */ +CTEST(zomatcopy, c_api_rowmajor_trans_col_100_row_50) +{ + blasint m = 50, n = 100; + blasint lda = 100, ldb = 50; + char order = 'R'; + char trans = 'T'; + double alpha[] = {1.5, -1.0}; + double norm; + + norm = check_zomatcopy('C', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zomatcopy by comparing it against refernce + * with the following options: + * + * Row Major + * Copy and conjugate + * alpha_r = 1.5, alpha_i = -1.0 + */ +CTEST(zomatcopy, c_api_rowmajor_conj_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda = 100, ldb = 100; + char order = 'R'; + char trans = 'R'; + double alpha[] = {1.5, -1.0}; + double norm; + + norm = check_zomatcopy('C', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zomatcopy by comparing it against refernce + * with the following options: + * + * Row Major + * Transposition and conjugate + * alpha_r = 1.0, alpha_i = 2.0 + */ +CTEST(zomatcopy, c_api_rowmajor_conjtrans_col_100_row_100) +{ + blasint m = 100, n = 100; + blasint lda = 100, ldb = 100; + char order = 'R'; + char trans = 'C'; + double alpha[] = {1.0, 2.0}; + double norm; + + norm = check_zomatcopy('C', order, trans, m, n, alpha, lda, ldb); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** +* Test error function for an invalid param order. +* Must be column (C) or row major (R). +*/ +CTEST(zomatcopy, xerbla_invalid_order) +{ + blasint m = 100, n = 100; + blasint lda = 100, ldb = 100; + char order = 'O'; + char trans = 'T'; + int expected_info = 1; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** +* Test error function for an invalid param trans. +* Must be trans (T/C) or no-trans (N/R). +*/ +CTEST(zomatcopy, xerbla_invalid_trans) +{ + blasint m = 100, n = 100; + blasint lda = 100, ldb = 100; + char order = 'C'; + char trans = 'O'; + int expected_info = 2; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** +* Test error function for an invalid param m. +* Must be positive. +*/ +CTEST(zomatcopy, xerbla_invalid_rows) +{ + blasint m = 0, n = 100; + blasint lda = 0, ldb = 100; + char order = 'C'; + char trans = 'T'; + int expected_info = 3; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** +* Test error function for an invalid param n. +* Must be positive. +*/ +CTEST(zomatcopy, xerbla_invalid_cols) +{ + blasint m = 100, n = 0; + blasint lda = 100, ldb = 0; + char order = 'C'; + char trans = 'T'; + int expected_info = 4; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** +* Test error function for an invalid param lda. +* If matrices are stored using row major layout, +* lda must be at least n. +*/ +CTEST(zomatcopy, xerbla_rowmajor_invalid_lda) +{ + blasint m = 50, n = 100; + blasint lda = 50, ldb = 100; + char order = 'R'; + char trans = 'T'; + int expected_info = 7; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** +* Test error function for an invalid param lda. +* If matrices are stored using column major layout, +* lda must be at least m. +*/ +CTEST(zomatcopy, xerbla_colmajor_invalid_lda) +{ + blasint m = 100, n = 50; + blasint lda = 50, ldb = 100; + char order = 'C'; + char trans = 'T'; + int expected_info = 7; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** +* Test error function for an invalid param ldb. +* If matrices are stored using row major layout and +* there is no transposition, ldb must be at least n. +*/ +CTEST(zomatcopy, xerbla_rowmajor_notrans_invalid_ldb) +{ + blasint m = 50, n = 100; + blasint lda = 100, ldb = 50; + char order = 'R'; + char trans = 'N'; + int expected_info = 9; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** +* Test error function for an invalid param ldb. +* If matrices are stored using row major layout and +* there is transposition, ldb must be at least m. +*/ +CTEST(zomatcopy, xerbla_rowmajor_trans_invalid_ldb) +{ + blasint m = 100, n = 50; + blasint lda = 100, ldb = 50; + char order = 'R'; + char trans = 'T'; + int expected_info = 9; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** +* Test error function for an invalid param ldb. +* If matrices are stored using row major layout and +* there is no transposition, ldb must be at least n. +*/ +CTEST(zomatcopy, xerbla_rowmajor_conj_invalid_ldb) +{ + blasint m = 50, n = 100; + blasint lda = 100, ldb = 50; + char order = 'R'; + char trans = 'R'; + int expected_info = 9; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** +* Test error function for an invalid param ldb. +* If matrices are stored using row major layout and +* there is transposition, ldb must be at least m. +*/ +CTEST(zomatcopy, xerbla_rowmajor_transconj_invalid_ldb) +{ + blasint m = 100, n = 50; + blasint lda = 100, ldb = 50; + char order = 'R'; + char trans = 'C'; + int expected_info = 9; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** +* Test error function for an invalid param ldb. +* If matrices are stored using column major layout and +* there is no transposition, ldb must be at least m. +*/ +CTEST(zomatcopy, xerbla_colmajor_notrans_invalid_ldb) +{ + blasint m = 100, n = 50; + blasint lda = 100, ldb = 50; + char order = 'C'; + char trans = 'N'; + int expected_info = 9; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** +* Test error function for an invalid param ldb. +* If matrices are stored using column major layout and +* there is transposition, ldb must be at least n. +*/ +CTEST(zomatcopy, xerbla_colmajor_trans_invalid_ldb) +{ + blasint m = 50, n = 100; + blasint lda = 100, ldb = 50; + char order = 'C'; + char trans = 'T'; + int expected_info = 9; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** +* Test error function for an invalid param ldb. +* If matrices are stored using column major layout and +* there is no transposition, ldb must be at least m. +*/ +CTEST(zomatcopy, xerbla_colmajor_conj_invalid_ldb) +{ + blasint m = 100, n = 50; + blasint lda = 100, ldb = 50; + char order = 'C'; + char trans = 'R'; + int expected_info = 9; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** +* Test error function for an invalid param ldb. +* If matrices are stored using column major layout and +* there is transposition, ldb must be at least n. +*/ +CTEST(zomatcopy, xerbla_colmajor_transconj_invalid_ldb) +{ + blasint m = 50, n = 100; + blasint lda = 100, ldb = 50; + char order = 'C'; + char trans = 'C'; + int expected_info = 9; + + int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); + ASSERT_EQUAL(TRUE, passed); +} +#endif diff --git a/utest/test_extensions/test_zrot.c b/utest/test_extensions/test_zrot.c new file mode 100644 index 000000000..5471e051a --- /dev/null +++ b/utest/test_extensions/test_zrot.c @@ -0,0 +1,790 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. 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. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include "common.h" + +#define DATASIZE 100 +#define INCREMENT 2 + +struct DATA_ZROT { + double x_test[DATASIZE * INCREMENT * 2]; + double y_test[DATASIZE * INCREMENT * 2]; + double x_verify[DATASIZE * INCREMENT * 2]; + double y_verify[DATASIZE * INCREMENT * 2]; +}; + +#ifdef BUILD_COMPLEX16 +static struct DATA_ZROT data_zrot; + +/** + * Comapare results computed by zdrot and zaxpby + * + * param n specifies size of vector x + * param inc_x specifies increment of vector x + * param inc_y specifies increment of vector y + * param c specifies cosine + * param s specifies sine + * return norm of differences + */ +static double check_zdrot(blasint n, blasint inc_x, blasint inc_y, double *c, double *s) +{ + blasint i; + double norm = 0; + double s_neg[] = {-s[0], s[1]}; + + blasint inc_x_abs = labs(inc_x); + blasint inc_y_abs = labs(inc_y); + + // Fill vectors x, y + drand_generate(data_zrot.x_test, n * inc_x_abs * 2); + drand_generate(data_zrot.y_test, n * inc_y_abs * 2); + + if (inc_x == 0 && inc_y == 0) { + drand_generate(data_zrot.x_test, n * 2); + drand_generate(data_zrot.y_test, n * 2); + } + + // Copy vector x for zaxpby + for (i = 0; i < n * inc_x_abs * 2; i++) + data_zrot.x_verify[i] = data_zrot.x_test[i]; + + // Copy vector y for zaxpby + for (i = 0; i < n * inc_y_abs * 2; i++) + data_zrot.y_verify[i] = data_zrot.y_test[i]; + + // Find cx = c*x + s*y + BLASFUNC(zaxpby)(&n, s, data_zrot.y_test, &inc_y, c, data_zrot.x_verify, &inc_x); + + // Find cy = -conjg(s)*x + c*y + BLASFUNC(zaxpby)(&n, s_neg, data_zrot.x_test, &inc_x, c, data_zrot.y_verify, &inc_y); + + BLASFUNC(zdrot)(&n, data_zrot.x_test, &inc_x, data_zrot.y_test, &inc_y, c, s); + + // Find the differences between vector x caculated by zaxpby and zdrot + for (i = 0; i < n * 2 * inc_x_abs; i++) + data_zrot.x_test[i] -= data_zrot.x_verify[i]; + + // Find the differences between vector y caculated by zaxpby and zdrot + for (i = 0; i < n * 2 * inc_y_abs; i++) + data_zrot.y_test[i] -= data_zrot.y_verify[i]; + + // Find the norm of differences + norm += BLASFUNC(dznrm2)(&n, data_zrot.x_test, &inc_x_abs); + norm += BLASFUNC(dznrm2)(&n, data_zrot.y_test, &inc_y_abs); + return (norm / 2); +} + +/** + * C API specific function + * Comapare results computed by zdrot and zaxpby + * + * param n specifies size of vector x + * param inc_x specifies increment of vector x + * param inc_y specifies increment of vector y + * param c specifies cosine + * param s specifies sine + * return norm of differences + */ +static double c_api_check_zdrot(blasint n, blasint inc_x, blasint inc_y, double *c, double *s) +{ + blasint i; + double norm = 0; + double s_neg[] = {-s[0], s[1]}; + + blasint inc_x_abs = labs(inc_x); + blasint inc_y_abs = labs(inc_y); + + // Fill vectors x, y + drand_generate(data_zrot.x_test, n * inc_x_abs * 2); + drand_generate(data_zrot.y_test, n * inc_y_abs * 2); + + if (inc_x == 0 && inc_y == 0) { + drand_generate(data_zrot.x_test, n * 2); + drand_generate(data_zrot.y_test, n * 2); + } + + // Copy vector x for zaxpby + for (i = 0; i < n * inc_x_abs * 2; i++) + data_zrot.x_verify[i] = data_zrot.x_test[i]; + + // Copy vector y for zaxpby + for (i = 0; i < n * inc_y_abs * 2; i++) + data_zrot.y_verify[i] = data_zrot.y_test[i]; + + // Find cx = c*x + s*y + cblas_zaxpby(n, s, data_zrot.y_test, inc_y, c, data_zrot.x_verify, inc_x); + + // Find cy = -conjg(s)*x + c*y + cblas_zaxpby(n, s_neg, data_zrot.x_test, inc_x, c, data_zrot.y_verify, inc_y); + + cblas_zdrot(n, data_zrot.x_test, inc_x, data_zrot.y_test, inc_y, c[0], s[0]); + + // Find the differences between vector x caculated by zaxpby and zdrot + for (i = 0; i < n * 2 * inc_x_abs; i++) + data_zrot.x_test[i] -= data_zrot.x_verify[i]; + + // Find the differences between vector y caculated by zaxpby and zdrot + for (i = 0; i < n * 2 * inc_y_abs; i++) + data_zrot.y_test[i] -= data_zrot.y_verify[i]; + + // Find the norm of differences + norm += cblas_dznrm2(n, data_zrot.x_test, inc_x_abs); + norm += cblas_dznrm2(n, data_zrot.y_test, inc_y_abs); + return (norm / 2); +} + +/** + * Fortran API specific test + * Test zrot by comparing it with zaxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 0 + * Stride of vector y is 0 + * c = 1.0 + * s = 2.0 + */ +CTEST(zrot, inc_x_0_inc_y_0) +{ + blasint n = 100; + + blasint inc_x = 0; + blasint inc_y = 0; + + // Imaginary part for zaxpby + double c[] = {1.0, 0.0}; + double s[] = {2.0, 0.0}; + + double norm = check_zdrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zrot by comparing it with zaxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 1 + * c = 1.0 + * s = 1.0 + */ +CTEST(zrot, inc_x_1_inc_y_1) +{ + blasint n = 100; + + blasint inc_x = 1; + blasint inc_y = 1; + + // Imaginary part for zaxpby + double c[] = {1.0, 0.0}; + double s[] = {1.0, 0.0}; + + double norm = check_zdrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zrot by comparing it with zaxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is -1 + * Stride of vector y is -1 + * c = 1.0 + * s = 1.0 + */ +CTEST(zrot, inc_x_neg_1_inc_y_neg_1) +{ + blasint n = 100; + + blasint inc_x = -1; + blasint inc_y = -1; + + // Imaginary part for zaxpby + double c[] = {1.0, 0.0}; + double s[] = {1.0, 0.0}; + + double norm = check_zdrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zrot by comparing it with zaxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 1 + * c = 3.0 + * s = 2.0 + */ +CTEST(zrot, inc_x_2_inc_y_1) +{ + blasint n = 100; + + blasint inc_x = 2; + blasint inc_y = 1; + + // Imaginary part for zaxpby + double c[] = {3.0, 0.0}; + double s[] = {2.0, 0.0}; + + double norm = check_zdrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zrot by comparing it with zaxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is -2 + * Stride of vector y is 1 + * c = 1.0 + * s = 1.0 + */ +CTEST(zrot, inc_x_neg_2_inc_y_1) +{ + blasint n = 100; + + blasint inc_x = -2; + blasint inc_y = 1; + + // Imaginary part for zaxpby + double c[] = {1.0, 0.0}; + double s[] = {1.0, 0.0}; + + double norm = check_zdrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zrot by comparing it with zaxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 2 + * c = 1.0 + * s = 1.0 + */ +CTEST(zrot, inc_x_1_inc_y_2) +{ + blasint n = 100; + + blasint inc_x = 1; + blasint inc_y = 2; + + // Imaginary part for zaxpby + double c[] = {1.0, 0.0}; + double s[] = {1.0, 0.0}; + + double norm = check_zdrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zrot by comparing it with zaxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is -2 + * c = 2.0 + * s = 1.0 + */ +CTEST(zrot, inc_x_1_inc_y_neg_2) +{ + blasint n = 100; + + blasint inc_x = 1; + blasint inc_y = -2; + + // Imaginary part for zaxpby + double c[] = {2.0, 0.0}; + double s[] = {1.0, 0.0}; + + double norm = check_zdrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zrot by comparing it with zaxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 2 + * c = 1.0 + * s = 2.0 + */ +CTEST(zrot, inc_x_2_inc_y_2) +{ + blasint n = 100; + + blasint inc_x = 2; + blasint inc_y = 2; + + // Imaginary part for zaxpby + double c[] = {1.0, 0.0}; + double s[] = {2.0, 0.0}; + + double norm = check_zdrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zrot by comparing it with zaxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 2 + * c = 1.0 + * s = 1.0 + */ +CTEST(zrot, inc_x_neg_2_inc_y_neg_2) +{ + blasint n = 100; + + blasint inc_x = -2; + blasint inc_y = -2; + + // Imaginary part for zaxpby + double c[] = {1.0, 0.0}; + double s[] = {1.0, 0.0}; + + double norm = check_zdrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zrot by comparing it with zaxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 2 + * c = 0.0 + * s = 1.0 + */ +CTEST(zrot, inc_x_2_inc_y_2_c_zero) +{ + blasint n = 100; + + blasint inc_x = 2; + blasint inc_y = 2; + + // Imaginary part for zaxpby + double c[] = {0.0, 0.0}; + double s[] = {1.0, 0.0}; + + double norm = check_zdrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zrot by comparing it with zaxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 2 + * c = 1.0 + * s = 0.0 + */ +CTEST(zrot, inc_x_2_inc_y_2_s_zero) +{ + blasint n = 100; + + blasint inc_x = 2; + blasint inc_y = 2; + + // Imaginary part for zaxpby + double c[] = {1.0, 0.0}; + double s[] = {0.0, 0.0}; + + double norm = check_zdrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zrot by comparing it with zaxpby. + * Test with the following options: + * + * Size of vectors x, y is 0 + * Stride of vector x is 1 + * Stride of vector y is 1 + * c = 1.0 + * s = 1.0 + */ +CTEST(zrot, check_n_zero) +{ + blasint n = 0; + + blasint inc_x = 1; + blasint inc_y = 1; + + // Imaginary part for zaxpby + double c[] = {1.0, 0.0}; + double s[] = {1.0, 0.0}; + + double norm = check_zdrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zrot by comparing it with zaxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 0 + * Stride of vector y is 0 + * c = 1.0 + * s = 2.0 + */ +CTEST(zrot, c_api_inc_x_0_inc_y_0) +{ + blasint n = 100; + + blasint inc_x = 0; + blasint inc_y = 0; + + // Imaginary part for zaxpby + double c[] = {3.0, 0.0}; + double s[] = {2.0, 0.0}; + + double norm = c_api_check_zdrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zrot by comparing it with zaxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 1 + * c = 1.0 + * s = 1.0 + */ +CTEST(zrot, c_api_inc_x_1_inc_y_1) +{ + blasint n = 100; + + blasint inc_x = 1; + blasint inc_y = 1; + + // Imaginary part for zaxpby + double c[] = {1.0, 0.0}; + double s[] = {1.0, 0.0}; + + double norm = c_api_check_zdrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zrot by comparing it with zaxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is -1 + * Stride of vector y is -1 + * c = 1.0 + * s = 1.0 + */ +CTEST(zrot, c_api_inc_x_neg_1_inc_y_neg_1) +{ + blasint n = 100; + + blasint inc_x = -1; + blasint inc_y = -1; + + // Imaginary part for zaxpby + double c[] = {1.0, 0.0}; + double s[] = {1.0, 0.0}; + + double norm = c_api_check_zdrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zrot by comparing it with zaxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 1 + * c = 3.0 + * s = 2.0 + */ +CTEST(zrot, c_api_inc_x_2_inc_y_1) +{ + blasint n = 100; + + blasint inc_x = 2; + blasint inc_y = 1; + + // Imaginary part for zaxpby + double c[] = {3.0, 0.0}; + double s[] = {2.0, 0.0}; + + double norm = c_api_check_zdrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zrot by comparing it with zaxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is -2 + * Stride of vector y is 1 + * c = 1.0 + * s = 1.0 + */ +CTEST(zrot, c_api_inc_x_neg_2_inc_y_1) +{ + blasint n = 100; + + blasint inc_x = -2; + blasint inc_y = 1; + + // Imaginary part for zaxpby + double c[] = {1.0, 0.0}; + double s[] = {1.0, 0.0}; + + double norm = c_api_check_zdrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zrot by comparing it with zaxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is 2 + * c = 1.0 + * s = 1.0 + */ +CTEST(zrot, c_api_inc_x_1_inc_y_2) +{ + blasint n = 100; + + blasint inc_x = 1; + blasint inc_y = 2; + + // Imaginary part for zaxpby + double c[] = {1.0, 0.0}; + double s[] = {1.0, 0.0}; + + double norm = c_api_check_zdrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zrot by comparing it with zaxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 1 + * Stride of vector y is -2 + * c = 2.0 + * s = 1.0 + */ +CTEST(zrot, c_api_inc_x_1_inc_y_neg_2) +{ + blasint n = 100; + + blasint inc_x = 1; + blasint inc_y = -2; + + // Imaginary part for zaxpby + double c[] = {2.0, 0.0}; + double s[] = {1.0, 0.0}; + + double norm = c_api_check_zdrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zrot by comparing it with zaxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 2 + * c = 1.0 + * s = 2.0 + */ +CTEST(zrot, c_api_inc_x_2_inc_y_2) +{ + blasint n = 100; + + blasint inc_x = 2; + blasint inc_y = 2; + + // Imaginary part for zaxpby + double c[] = {1.0, 0.0}; + double s[] = {2.0, 0.0}; + + double norm = c_api_check_zdrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zrot by comparing it with zaxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 2 + * c = 1.0 + * s = 1.0 + */ +CTEST(zrot, c_api_inc_x_neg_2_inc_y_neg_2) +{ + blasint n = 100; + + blasint inc_x = -2; + blasint inc_y = -2; + + // Imaginary part for zaxpby + double c[] = {1.0, 0.0}; + double s[] = {1.0, 0.0}; + + double norm = c_api_check_zdrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zrot by comparing it with zaxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 2 + * c = 0.0 + * s = 1.0 + */ +CTEST(zrot, c_api_inc_x_2_inc_y_2_c_zero) +{ + blasint n = 100; + + blasint inc_x = 2; + blasint inc_y = 2; + + // Imaginary part for zaxpby + double c[] = {0.0, 0.0}; + double s[] = {1.0, 0.0}; + + double norm = c_api_check_zdrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zrot by comparing it with zaxpby. + * Test with the following options: + * + * Size of vectors x, y is 100 + * Stride of vector x is 2 + * Stride of vector y is 2 + * c = 1.0 + * s = 0.0 + */ +CTEST(zrot, c_api_inc_x_2_inc_y_2_s_zero) +{ + blasint n = 100; + + blasint inc_x = 2; + blasint inc_y = 2; + + // Imaginary part for zaxpby + double c[] = {1.0, 0.0}; + double s[] = {0.0, 0.0}; + + double norm = c_api_check_zdrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zrot by comparing it with zaxpby. + * Test with the following options: + * + * Size of vectors x, y is 0 + * Stride of vector x is 1 + * Stride of vector y is 1 + * c = 1.0 + * s = 1.0 + */ +CTEST(zrot, c_api_check_n_zero) +{ + blasint n = 0; + + blasint inc_x = 1; + blasint inc_y = 1; + + // Imaginary part for zaxpby + double c[] = {1.0, 0.0}; + double s[] = {1.0, 0.0}; + + double norm = c_api_check_zdrot(n, inc_x, inc_y, c, s); + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_zrotg.c b/utest/test_extensions/test_zrotg.c new file mode 100644 index 000000000..310121422 --- /dev/null +++ b/utest/test_extensions/test_zrotg.c @@ -0,0 +1,290 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. 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. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include + +#ifdef BUILD_COMPLEX16 + +/** + * Fortran API specific test + * Test zrotg by comparing it against pre-calculated values + */ +CTEST(zrotg, zero_a) +{ + double sa[2] = {0.0, 0.0}; + double sb[2] = {1.0, 1.0}; + double ss[2]; + double sc; + BLASFUNC(zrotg)(sa, sb, &sc, ss); + ASSERT_DBL_NEAR_TOL(0.0, sc, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(1.0, ss[0], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(0.0, ss[1], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(1.0, sa[0], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(1.0, sa[1], DOUBLE_EPS); +} + +/** + * Fortran API specific tests + * Test zrotg by comparing it against pre-calculated values + */ +CTEST(zrotg, zero_b) +{ + double sa[2] = {1.0, 1.0}; + double sb[2] = {0.0, 0.0}; + double ss[2]; + double sc; + BLASFUNC(zrotg)(sa, sb, &sc, ss); + ASSERT_DBL_NEAR_TOL(1.0, sc, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(0.0, ss[0], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(0.0, ss[1], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(1.0, sa[0], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(1.0, sa[1], DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zrotg by comparing it against pre-calculated values + */ +CTEST(zrotg, zero_real) +{ + double sa[2] = {0.0, 1.0}; + double sb[2] = {0.0, 1.0}; + double ss[2]; + double sc; + BLASFUNC(zrotg)(sa, sb, &sc, ss); + ASSERT_DBL_NEAR_TOL(0.70710678118654, sc, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(0.70710678118654, ss[0], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(0.0, ss[1], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(0.0, sa[0], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(1.41421356237309, sa[1], DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zrotg by comparing it against pre-calculated values + */ +CTEST(zrotg, positive_real_positive_img) +{ + double sa[2] = {3.0, 4.0}; + double sb[2] = {4.0, 6.0}; + double ss[2]; + double sc; + BLASFUNC(zrotg)(sa, sb, &sc, ss); + ASSERT_DBL_NEAR_TOL(0.56980288229818, sc, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(0.82051615050939, ss[0], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(-0.04558423058385, ss[1], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(5.26497863243527, sa[0], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(7.01997150991369, sa[1], DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zrotg by comparing it against pre-calculated values + */ +CTEST(zrotg, negative_real_positive_img) +{ + double sa[2] = {-3.0, 4.0}; + double sb[2] = {-4.0, 6.0}; + double ss[2]; + double sc; + BLASFUNC(zrotg)(sa, sb, &sc, ss); + ASSERT_DBL_NEAR_TOL(0.56980288229818, sc, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(0.82051615050939, ss[0], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(0.04558423058385, ss[1], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(-5.26497863243527, sa[0], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(7.01997150991369, sa[1], DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zrotg by comparing it against pre-calculated values + */ +CTEST(zrotg, positive_real_negative_img) +{ + double sa[2] = {3.0, -4.0}; + double sb[2] = {4.0, -6.0}; + double ss[2]; + double sc; + BLASFUNC(zrotg)(sa, sb, &sc, ss); + ASSERT_DBL_NEAR_TOL(0.56980288229818, sc, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(0.82051615050939, ss[0], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(0.04558423058385, ss[1], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(5.26497863243527, sa[0], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(-7.01997150991369, sa[1], DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zrotg by comparing it against pre-calculated values + */ +CTEST(zrotg, negative_real_negative_img) +{ + double sa[2] = {-3.0, -4.0}; + double sb[2] = {-4.0, -6.0}; + double ss[2]; + double sc; + BLASFUNC(zrotg)(sa, sb, &sc, ss); + ASSERT_DBL_NEAR_TOL(0.56980288229818, sc, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(0.82051615050939, ss[0], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(-0.04558423058385, ss[1], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(-5.26497863243527, sa[0], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(-7.01997150991369, sa[1], DOUBLE_EPS); +} + +/** + * C API specific test + * Test zrotg by comparing it against pre-calculated values + */ +CTEST(zrotg, c_api_zero_a) +{ + double sa[2] = {0.0, 0.0}; + double sb[2] = {1.0, 1.0}; + double ss[2]; + double sc; + cblas_zrotg(sa, sb, &sc, ss); + ASSERT_DBL_NEAR_TOL(0.0, sc, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(1.0, ss[0], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(0.0, ss[1], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(1.0, sa[0], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(1.0, sa[1], DOUBLE_EPS); +} + +/** + * C API specific test + * Test zrotg by comparing it against pre-calculated values + */ +CTEST(zrotg, c_api_zero_b) +{ + double sa[2] = {1.0, 1.0}; + double sb[2] = {0.0, 0.0}; + double ss[2]; + double sc; + cblas_zrotg(sa, sb, &sc, ss); + ASSERT_DBL_NEAR_TOL(1.0, sc, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(0.0, ss[0], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(0.0, ss[1], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(1.0, sa[0], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(1.0, sa[1], DOUBLE_EPS); +} + +/** + * C API specific test + * Test zrotg by comparing it against pre-calculated values + */ +CTEST(zrotg, c_api_zero_real) +{ + double sa[2] = {0.0, 1.0}; + double sb[2] = {0.0, 1.0}; + double ss[2]; + double sc; + cblas_zrotg(sa, sb, &sc, ss); + ASSERT_DBL_NEAR_TOL(0.70710678118654, sc, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(0.70710678118654, ss[0], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(0.0, ss[1], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(0.0, sa[0], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(1.41421356237309, sa[1], DOUBLE_EPS); +} + +/** + * C API specific test + * Test zrotg by comparing it against pre-calculated values + */ +CTEST(zrotg, c_api_positive_real_positive_img) +{ + double sa[2] = {3.0, 4.0}; + double sb[2] = {4.0, 6.0}; + double ss[2]; + double sc; + cblas_zrotg(sa, sb, &sc, ss); + ASSERT_DBL_NEAR_TOL(0.56980288229818, sc, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(0.82051615050939, ss[0], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(-0.04558423058385, ss[1], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(5.26497863243527, sa[0], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(7.01997150991369, sa[1], DOUBLE_EPS); +} + +/** + * C API specific test + * Test zrotg by comparing it against pre-calculated values + */ +CTEST(zrotg, c_api_negative_real_positive_img) +{ + double sa[2] = {-3.0, 4.0}; + double sb[2] = {-4.0, 6.0}; + double ss[2]; + double sc; + cblas_zrotg(sa, sb, &sc, ss); + ASSERT_DBL_NEAR_TOL(0.56980288229818, sc, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(0.82051615050939, ss[0], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(0.04558423058385, ss[1], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(-5.26497863243527, sa[0], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(7.01997150991369, sa[1], DOUBLE_EPS); +} + +/** + * C API specific test + * Test zrotg by comparing it against pre-calculated values + */ +CTEST(zrotg, c_api_positive_real_negative_img) +{ + double sa[2] = {3.0, -4.0}; + double sb[2] = {4.0, -6.0}; + double ss[2]; + double sc; + cblas_zrotg(sa, sb, &sc, ss); + ASSERT_DBL_NEAR_TOL(0.56980288229818, sc, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(0.82051615050939, ss[0], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(0.04558423058385, ss[1], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(5.26497863243527, sa[0], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(-7.01997150991369, sa[1], DOUBLE_EPS); +} + +/** + * C API specific test + * Test zrotg by comparing it against pre-calculated values + */ +CTEST(zrotg, c_api_negative_real_negative_img) +{ + double sa[2] = {-3.0, -4.0}; + double sb[2] = {-4.0, -6.0}; + double ss[2]; + double sc; + cblas_zrotg(sa, sb, &sc, ss); + ASSERT_DBL_NEAR_TOL(0.56980288229818, sc, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(0.82051615050939, ss[0], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(-0.04558423058385, ss[1], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(-5.26497863243527, sa[0], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(-7.01997150991369, sa[1], DOUBLE_EPS); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_zsbmv.c b/utest/test_extensions/test_zsbmv.c new file mode 100644 index 000000000..afdb208c1 --- /dev/null +++ b/utest/test_extensions/test_zsbmv.c @@ -0,0 +1,606 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. 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. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include "common.h" + +#define DATASIZE 100 +#define INCREMENT 2 + +struct DATA_ZSBMV { + double sp_matrix[DATASIZE * (DATASIZE + 1)]; + double sb_matrix[DATASIZE * DATASIZE * 2]; + double b_test[DATASIZE * 2 * INCREMENT]; + double c_test[DATASIZE * 2 * INCREMENT]; + double c_verify[DATASIZE * 2 * INCREMENT]; +}; + +// DOUBLE_EPS_ZGEMV = MAX_VAL * NUMBER OF OPERATIONS * DBL_EPSILON +// DOUBLE_EPS_ZGEMV = 5.0 * O(100 * 100) * 2.2e-16 = 1e-11 +#define DOUBLE_EPS_ZGEMV 1e-11 + +#ifdef BUILD_COMPLEX16 +static struct DATA_ZSBMV data_zsbmv; + +/** + * Transform full-storage symmetric band matrix A to upper (U) or lower (L) + * band-packed storage mode. + * + * param uplo specifies whether matrix a is upper or lower band-packed. + * param n - number of rows and columns of A + * param k - number of super-diagonals of A + * output param a - buffer for holding symmetric band-packed matrix + * param lda - specifies the leading dimension of a + * param sb_matrix - buffer holding full-storage symmetric band matrix A + * param ldm - specifies the leading dimension of A + */ +static void transform_to_band_storage(char uplo, blasint n, blasint k, double* a, blasint lda, + double* sb_matrix, blasint ldm) +{ + blasint i, j, m; + if (uplo == 'L') { + for (j = 0; j < n; j++) + { + m = -j; + for (i = 2 * j; i < MIN(2 * n, 2 * (j + k + 1)); i += 2) + { + a[(2*m + i) + j * lda * 2] = sb_matrix[i + j * ldm * 2]; + a[(2*m + (i + 1)) + j * lda * 2] = sb_matrix[(i + 1) + j * ldm * 2]; + } + } + } + else { + for (j = 0; j < n; j++) + { + m = k - j; + for (i = MAX(0, 2*(j - k)); i <= j*2; i += 2) + { + a[(2*m + i) + j * lda * 2] = sb_matrix[i + j * ldm * 2]; + a[(2*m + (i + 1)) + j * lda * 2] = sb_matrix[(i + 1) + j * ldm * 2]; + } + } + } +} + +/** + * Generate full-storage symmetric band matrix A with k - super-diagonals + * from input symmetric packed matrix in lower packed mode (L) + * + * output param sb_matrix - buffer for holding full-storage symmetric band matrix. + * param sp_matrix - buffer holding input symmetric packed matrix + * param n - number of rows and columns of A + * param k - number of super-diagonals of A + */ +static void get_symmetric_band_matr(double *sb_matrix, double *sp_matrix, blasint n, blasint k) +{ + blasint m; + blasint i, j; + m = 0; + for (i = 0; i < n; i++) + { + for (j = 0; j < n * 2; j += 2) + { + // Make matrix band with k super-diagonals + if (fabs((i+1) - ceil((j+1)/2.0)) > k) + { + sb_matrix[i * n * 2 + j] = 0.0; + sb_matrix[i * n * 2 + j + 1] = 0.0; + continue; + } + + if (j / 2 < i) + { + sb_matrix[i * n * 2 + j] = + sb_matrix[j * n + i * 2]; + sb_matrix[i * n * 2 + j + 1] = + sb_matrix[j * n + i * 2 + 1]; + } + else + { + sb_matrix[i * n * 2 + j] = sp_matrix[m++]; + sb_matrix[i * n * 2 + j + 1] = sp_matrix[m++]; + } + } + } +} + +/** + * Check if error function was called with expected function name + * and param info + * + * param uplo specifies whether matrix a is upper or lower band-packed. + * param n - number of rows and columns of A + * param k - number of super-diagonals of A + * param lda - specifies the leading dimension of a + * param inc_b - stride of vector b_test + * param inc_c - stride of vector c_test + * param expected_info - expected invalid parameter number in zsbmv + * return TRUE if everything is ok, otherwise FALSE + */ +static int check_badargs(char uplo, blasint n, blasint k, blasint lda, blasint inc_b, + blasint inc_c, int expected_info) +{ + double alpha[] = {1.0, 1.0}; + double beta[] = {0.0, 0.0}; + + double a[2]; + drand_generate(a, 2); + + set_xerbla("ZSBMV ", expected_info); + + BLASFUNC(zsbmv)(&uplo, &n, &k, alpha, a, &lda, data_zsbmv.b_test, + &inc_b, beta, data_zsbmv.c_test, &inc_c); + + return check_error(); +} + +/** + * Comapare results computed by zsbmv and zgemv + * since zsbmv is zgemv for symmetric band matrix + * + * param uplo specifies whether matrix A is upper or lower triangular + * param n - number of rows and columns of A + * param k - number of super-diagonals of A + * param alpha - scaling factor for the matrix-vector product + * param lda - specifies the leading dimension of a + * param inc_b - stride of vector b_test + * param beta - scaling factor for vector c_test + * param inc_c - stride of vector c_test + * param lda - specifies the leading dimension of a + * return norm of differences + */ +static double check_zsbmv(char uplo, blasint n, blasint k, double *alpha, blasint lda, + blasint inc_b, double *beta, blasint inc_c, blasint ldm) +{ + blasint i; + + // Trans param for gemv (can use any, since the input matrix is symmetric) + char trans = 'N'; + + // Symmetric band packed matrix for sbmv + double a[lda * n * 2]; + + // Fill symmetric packed matrix sp_matrix, vector b_test, vector c_test + drand_generate(data_zsbmv.sp_matrix, n * (n + 1)); + drand_generate(data_zsbmv.b_test, n * inc_b * 2); + drand_generate(data_zsbmv.c_test, n * inc_c * 2); + + // Copy vector c_test for zgemv + for (i = 0; i < n * inc_c * 2; i++) + data_zsbmv.c_verify[i] = data_zsbmv.c_test[i]; + + // Generate full-storage symmetric band matrix + // with k super-diagonals from symmetric packed matrix + get_symmetric_band_matr(data_zsbmv.sb_matrix, data_zsbmv.sp_matrix, n, k); + + // Transform symmetric band matrix from conventional + // full matrix storage to band storage for zsbmv + transform_to_band_storage(uplo, n, k, a, lda, data_zsbmv.sb_matrix, ldm); + + BLASFUNC(zgemv)(&trans, &n, &n, alpha, data_zsbmv.sb_matrix, &ldm, data_zsbmv.b_test, + &inc_b, beta, data_zsbmv.c_verify, &inc_c); + + BLASFUNC(zsbmv)(&uplo, &n, &k, alpha, a, &lda, + data_zsbmv.b_test, &inc_b, beta, data_zsbmv.c_test, &inc_c); + + // Find the differences between output vector caculated by zsbmv and zgemv + for (i = 0; i < n * inc_c * 2; i++) + data_zsbmv.c_test[i] -= data_zsbmv.c_verify[i]; + + // Find the norm of differences + return BLASFUNC(dznrm2)(&n, data_zsbmv.c_test, &inc_c); +} + +/** + * Test zsbmv by comparing it against zgemv + * with the following options: + * + * a is upper-band-packed symmetric matrix + * Number of rows and columns of A is 100 + * Stride of vector b_test is 1 + * Stride of vector c_test is 1 + * Number of super-diagonals k is 0 + */ +CTEST(zsbmv, upper_k_0_inc_b_1_inc_c_1_n_100) +{ + blasint n = DATASIZE, inc_b = 1, inc_c = 1; + blasint k = 0; + blasint lda = k + 1; + blasint ldm = n; + char uplo = 'U'; + + double alpha[] = {1.0, 1.0}; + double beta[] = {1.0, 1.0}; + + double norm = check_zsbmv(uplo, n, k, alpha, lda, inc_b, beta, inc_c, ldm); + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS_ZGEMV); +} + +/** + * Test zsbmv by comparing it against zgemv + * with the following options: + * + * a is upper-band-packed symmetric matrix + * Number of rows and columns of A is 100 + * Stride of vector b_test is 1 + * Stride of vector c_test is 1 + * Number of super-diagonals k is 1 + */ +CTEST(zsbmv, upper_k_1_inc_b_1_inc_c_1_n_100) +{ + blasint n = DATASIZE, inc_b = 1, inc_c = 1; + blasint k = 1; + blasint lda = k + 1; + blasint ldm = n; + char uplo = 'U'; + + double alpha[] = {1.0, 1.0}; + double beta[] = {1.0, 1.0}; + + double norm = check_zsbmv(uplo, n, k, alpha, lda, inc_b, beta, inc_c, ldm); + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS_ZGEMV); +} + +/** + * Test zsbmv by comparing it against zgemv + * with the following options: + * + * a is upper-band-packed symmetric matrix + * Number of rows and columns of A is 100 + * Stride of vector b_test is 1 + * Stride of vector c_test is 1 + * Number of super-diagonals k is 2 + */ +CTEST(zsbmv, upper_k_2_inc_b_1_inc_c_1_n_100) +{ + blasint n = DATASIZE, inc_b = 1, inc_c = 1; + blasint k = 2; + blasint lda = k + 1; + blasint ldm = n; + char uplo = 'U'; + + double alpha[] = {1.0, 1.0}; + double beta[] = {1.0, 1.0}; + + double norm = check_zsbmv(uplo, n, k, alpha, lda, inc_b, beta, inc_c, ldm); + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS_ZGEMV); +} + +/** + * Test zsbmv by comparing it against zgemv + * with the following options: + * + * a is upper-band-packed symmetric matrix + * Number of rows and columns of A is 100 + * Stride of vector b_test is 2 + * Stride of vector c_test is 1 + * Number of super-diagonals k is 2 + */ +CTEST(zsbmv, upper_k_2_inc_b_2_inc_c_1_n_100) +{ + blasint n = DATASIZE, inc_b = 2, inc_c = 1; + blasint k = 2; + blasint lda = k + 1; + blasint ldm = n; + char uplo = 'U'; + + double alpha[] = {2.0, 1.0}; + double beta[] = {2.0, 1.0}; + + double norm = check_zsbmv(uplo, n, k, alpha, lda, inc_b, beta, inc_c, ldm); + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS_ZGEMV); +} + +/** + * Test zsbmv by comparing it against zgemv + * with the following options: + * + * a is upper-band-packed symmetric matrix + * Number of rows and columns of A is 100 + * Stride of vector b_test is 2 + * Stride of vector c_test is 2 + * Number of super-diagonals k is 2 + */ +CTEST(zsbmv, upper_k_2_inc_b_2_inc_c_2_n_100) +{ + blasint n = DATASIZE, inc_b = 2, inc_c = 2; + blasint k = 2; + blasint lda = k + 1; + blasint ldm = n; + char uplo = 'U'; + + double alpha[] = {2.0, 1.0}; + double beta[] = {2.0, 1.0}; + + double norm = check_zsbmv(uplo, n, k, alpha, lda, inc_b, beta, inc_c, ldm); + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS_ZGEMV); +} + +/** + * Test zsbmv by comparing it against zgemv + * with the following options: + * + * a is lower-band-packed symmetric matrix + * Number of rows and columns of A is 100 + * Stride of vector b_test is 1 + * Stride of vector c_test is 1 + * Number of super-diagonals k is 0 + */ +CTEST(zsbmv, lower_k_0_inc_b_1_inc_c_1_n_100) +{ + blasint n = DATASIZE, inc_b = 1, inc_c = 1; + blasint k = 0; + blasint lda = k + 1; + blasint ldm = n; + char uplo = 'L'; + + double alpha[] = {1.0, 1.0}; + double beta[] = {1.0, 1.0}; + + double norm = check_zsbmv(uplo, n, k, alpha, lda, inc_b, beta, inc_c, ldm); + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS_ZGEMV); +} + +/** + * Test zsbmv by comparing it against zgemv + * with the following options: + * + * a is lower-band-packed symmetric matrix + * Number of rows and columns of A is 100 + * Stride of vector b_test is 1 + * Stride of vector c_test is 1 + * Number of super-diagonals k is 1 + */ +CTEST(zsbmv, lower_k_1_inc_b_1_inc_c_1_n_100) +{ + blasint n = DATASIZE, inc_b = 1, inc_c = 1; + blasint k = 1; + blasint lda = k + 1; + blasint ldm = n; + char uplo = 'L'; + + double alpha[] = {1.0, 1.0}; + double beta[] = {1.0, 1.0}; + + double norm = check_zsbmv(uplo, n, k, alpha, lda, inc_b, beta, inc_c, ldm); + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS_ZGEMV); +} + +/** + * Test zsbmv by comparing it against zgemv + * with the following options: + * + * a is lower-band-packed symmetric matrix + * Number of rows and columns of A is 100 + * Stride of vector b_test is 1 + * Stride of vector c_test is 1 + * Number of super-diagonals k is 2 + */ +CTEST(zsbmv, lower_k_2_inc_b_1_inc_c_1_n_100) +{ + blasint n = DATASIZE, inc_b = 1, inc_c = 1; + blasint k = 2; + blasint lda = k + 1; + blasint ldm = n; + char uplo = 'L'; + + double alpha[] = {1.0, 1.0}; + double beta[] = {1.0, 1.0}; + + double norm = check_zsbmv(uplo, n, k, alpha, lda, inc_b, beta, inc_c, ldm); + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS_ZGEMV); +} + +/** + * Test zsbmv by comparing it against zgemv + * with the following options: + * + * a is lower-band-packed symmetric matrix + * Number of rows and columns of A is 100 + * Stride of vector b_test is 2 + * Stride of vector c_test is 1 + * Number of super-diagonals k is 2 + */ +CTEST(zsbmv, lower_k_2_inc_b_2_inc_c_1_n_100) +{ + blasint n = DATASIZE, inc_b = 2, inc_c = 1; + blasint k = 2; + blasint lda = k + 1; + blasint ldm = n; + char uplo = 'L'; + + double alpha[] = {2.0, 1.0}; + double beta[] = {2.0, 1.0}; + + double norm = check_zsbmv(uplo, n, k, alpha, lda, inc_b, beta, inc_c, ldm); + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS_ZGEMV); +} + +/** + * Test zsbmv by comparing it against zgemv + * with the following options: + * + * a is lower-band-packed symmetric matrix + * Number of rows and columns of A is 100 + * Stride of vector b_test is 2 + * Stride of vector c_test is 2 + * Number of super-diagonals k is 2 + */ +CTEST(zsbmv, lower_k_2_inc_b_2_inc_c_2_n_100) +{ + blasint n = DATASIZE, inc_b = 2, inc_c = 2; + blasint k = 2; + blasint lda = k + 1; + blasint ldm = n; + char uplo = 'L'; + + double alpha[] = {2.0, 1.0}; + double beta[] = {2.0, 1.0}; + + double norm = check_zsbmv(uplo, n, k, alpha, lda, inc_b, beta, inc_c, ldm); + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS_ZGEMV); +} + +/** + * Check if output matrix a contains any NaNs + */ +CTEST(zsbmv, check_for_NaN) +{ + blasint n = DATASIZE, inc_b = 1, inc_c = 1; + blasint k = 0; + blasint lda = k + 1; + blasint ldm = n; + char uplo = 'U'; + + double alpha[] = {1.0, 1.0}; + double beta[] = {1.0, 1.0}; + + double norm = check_zsbmv(uplo, n, k, alpha, lda, inc_b, beta, inc_c, ldm); + + ASSERT_TRUE(norm == norm); /* NaN == NaN is false */ +} + +/** + * Test error function for an invalid param uplo. + * Uplo specifies whether a is in upper (U) or lower (L) band-packed storage mode. + */ +CTEST(zsbmv, xerbla_uplo_invalid) +{ + blasint n = 1, inc_b = 1, inc_c = 1; + char uplo = 'O'; + blasint k = 0; + blasint lda = k + 1; + int expected_info = 1; + + int passed = check_badargs(uplo, n, k, lda, inc_b, inc_c, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param N - + * number of rows and columns of A. Must be at least zero. + */ +CTEST(zsbmv, xerbla_n_invalid) +{ + blasint n = INVALID, inc_b = 1, inc_c = 1; + char uplo = 'U'; + blasint k = 0; + blasint lda = k + 1; + int expected_info = 2; + + int passed = check_badargs(uplo, n, k, lda, inc_b, inc_c, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Check if n - number of rows and columns of A equal zero. + */ +CTEST(zsbmv, check_n_zero) +{ + blasint n = 0, inc_b = 1, inc_c = 1; + blasint k = 0; + blasint lda = k + 1; + blasint ldm = 1; + char uplo = 'U'; + + double alpha[] = {1.0, 1.0}; + double beta[] = {0.0, 0.0}; + + double norm = check_zsbmv(uplo, n, k, alpha, lda, inc_b, beta, inc_c, ldm); + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS_ZGEMV); +} + +/** + * Test error function for an invalid param inc_b - + * stride of vector b_test. Can't be zero. + */ +CTEST(zsbmv, xerbla_inc_b_zero) +{ + blasint n = 1, inc_b = 0, inc_c = 1; + char uplo = 'U'; + blasint k = 0; + blasint lda = k + 1; + int expected_info = 8; + + int passed = check_badargs(uplo, n, k, lda, inc_b, inc_c, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param inc_c - + * stride of vector c_test. Can't be zero. + */ +CTEST(zsbmv, xerbla_inc_c_zero) +{ + blasint n = 1, inc_b = 1, inc_c = 0; + char uplo = 'U'; + blasint k = 0; + blasint lda = k + 1; + int expected_info = 11; + + int passed = check_badargs(uplo, n, k, lda, inc_b, inc_c, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param k - + * number of super-diagonals of A. Must be at least zero. + */ +CTEST(zsbmv, xerbla_k_invalid) +{ + blasint n = 1, inc_b = 1, inc_c = 1; + char uplo = 'U'; + blasint k = INVALID; + blasint lda = 1; + int expected_info = 3; + + int passed = check_badargs(uplo, n, k, lda, inc_b, inc_c, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param lda - + * specifies the leading dimension of a. Must be at least (k+1). + */ +CTEST(zsbmv, xerbla_lda_invalid) +{ + blasint n = 1, inc_b = 1, inc_c = 1; + char uplo = 'U'; + blasint k = 0; + blasint lda = INVALID; + int expected_info = 6; + + int passed = check_badargs(uplo, n, k, lda, inc_b, inc_c, expected_info); + ASSERT_EQUAL(TRUE, passed); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_zscal.c b/utest/test_extensions/test_zscal.c new file mode 100644 index 000000000..132f4ee5b --- /dev/null +++ b/utest/test_extensions/test_zscal.c @@ -0,0 +1,165 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. 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. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include +#include "common.h" + +#define DATASIZE 100 +#define INCREMENT 2 + +struct DATA_ZSCAL { + double x_test[DATASIZE * 2 * INCREMENT]; + double x_verify[DATASIZE * 2 * INCREMENT]; +}; + +#ifdef BUILD_COMPLEX16 +static struct DATA_ZSCAL data_zscal; + + +/** + * zscal reference code + * + * param n - number of elements of vector x + * param alpha - scaling factor for the vector product + * param x - buffer holding input vector x + * param inc - stride of vector x + */ +static void zscal_trusted(blasint n, double *alpha, double* x, blasint inc){ + blasint i, ip = 0; + blasint inc_x2 = 2 * inc; + double temp; + for (i = 0; i < n; i++) + { + temp = alpha[0] * x[ip] - alpha[1] * x[ip+1]; + x[ip+1] = alpha[0] * x[ip+1] + alpha[1] * x[ip]; + x[ip] = temp; + ip += inc_x2; + } +} + +/** + * Comapare results computed by zscal and zscal_trusted + * + * param api specifies tested api (C or Fortran) + * param n - number of elements of vector x + * param alpha - scaling factor for the vector product + * param inc - stride of vector x + * return norm of differences + */ +static double check_zscal(char api, blasint n, double *alpha, blasint inc) +{ + blasint i; + + // Fill vectors x + drand_generate(data_zscal.x_test, n * inc * 2); + + // Copy vector x for zscal_trusted + for (i = 0; i < n * 2 * inc; i++) + data_zscal.x_verify[i] = data_zscal.x_test[i]; + + zscal_trusted(n, alpha, data_zscal.x_verify, inc); + + if(api == 'F') + BLASFUNC(zscal)(&n, alpha, data_zscal.x_test, &inc); + else + cblas_zscal(n, alpha, data_zscal.x_test, inc); + + // Find the differences between output vector computed by zscal and zscal_trusted + for (i = 0; i < n * 2 * inc; i++) + data_zscal.x_verify[i] -= data_zscal.x_test[i]; + + // Find the norm of differences + return BLASFUNC(dznrm2)(&n, data_zscal.x_verify, &inc); +} + +/** + * Fortran API specific test + * Test zscal by comparing it against reference + */ +CTEST(zscal, alpha_r_zero_alpha_i_not_zero) +{ + blasint N = DATASIZE; + blasint inc = 1; + double alpha[2] = {0.0, 1.0}; + + double norm = check_zscal('F', N, alpha, inc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Fortran API specific test + * Test zscal by comparing it against reference + */ +CTEST(zscal, alpha_r_zero_alpha_i_zero_inc_2) +{ + blasint N = DATASIZE; + blasint inc = 2; + double alpha[2] = {0.0, 0.0}; + + double norm = check_zscal('F', N, alpha, inc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zscal by comparing it against reference + */ +CTEST(zscal, c_api_alpha_r_zero_alpha_i_not_zero) +{ + blasint N = DATASIZE; + blasint inc = 1; + double alpha[2] = {0.0, 1.0}; + + double norm = check_zscal('C', N, alpha, inc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * C API specific test + * Test zscal by comparing it against reference + */ +CTEST(zscal, c_api_alpha_r_zero_alpha_i_zero_inc_2) +{ + blasint N = DATASIZE; + blasint inc = 2; + double alpha[2] = {0.0, 0.0}; + + double norm = check_zscal('C', N, alpha, inc); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_zspmv.c b/utest/test_extensions/test_zspmv.c new file mode 100644 index 000000000..510ac0579 --- /dev/null +++ b/utest/test_extensions/test_zspmv.c @@ -0,0 +1,427 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. 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. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include "common.h" + +#define DATASIZE 100 +#define INCREMENT 2 + +struct DATA_ZSPMV { + double a_verify[DATASIZE * DATASIZE * 2]; + double a_test[DATASIZE * (DATASIZE + 1)]; + double b_test[DATASIZE * 2 * INCREMENT]; + double c_test[DATASIZE * 2 * INCREMENT]; + double c_verify[DATASIZE * 2 * INCREMENT]; +}; + +#ifdef BUILD_COMPLEX16 +static struct DATA_ZSPMV data_zspmv; + +/** + * Compute spmv via gemv since spmv is gemv for symmetric packed matrix + * + * param uplo specifies whether matrix A is upper or lower triangular + * param n - number of rows and columns of A + * param alpha - scaling factor for the matrix-vector product + * param a - buffer holding input matrix A + * param b - Buffer holding input vector b + * param inc_b - stride of vector b + * param beta - scaling factor for vector c + * param c - buffer holding input/output vector c + * param inc_c - stride of vector c + * output param data_zspmv.c_verify - matrix computed by gemv + */ +static void zspmv_trusted(char uplo, blasint n, double *alpha, double *a, + double *b, blasint inc_b, double *beta, double *c, + blasint inc_c) +{ + blasint k; + blasint i, j; + + // param for gemv (can use any, since the input matrix is symmetric) + char trans = 'N'; + + // Unpack the input symmetric packed matrix + if (uplo == 'L') + { + k = 0; + for (i = 0; i < n; i++) + { + for (j = 0; j < n * 2; j += 2) + { + if (j / 2 < i) + { + data_zspmv.a_verify[i * n * 2 + j] = + data_zspmv.a_verify[j * n + i * 2]; + data_zspmv.a_verify[i * n * 2 + j + 1] = + data_zspmv.a_verify[j * n + i * 2 + 1]; + } + else + { + data_zspmv.a_verify[i * n * 2 + j] = a[k++]; + data_zspmv.a_verify[i * n * 2 + j + 1] = a[k++]; + } + } + } + } + else + { + k = n * (n + 1) - 1; + for (j = 2 * n - 1; j >= 0; j -= 2) + { + for (i = n - 1; i >= 0; i--) + { + if (j / 2 < i) + { + data_zspmv.a_verify[i * n * 2 + j] = + data_zspmv.a_verify[(j - 1) * n + i * 2 + 1]; + data_zspmv.a_verify[i * n * 2 + j - 1] = + data_zspmv.a_verify[(j - 1) * n + i * 2]; + } + else + { + data_zspmv.a_verify[i * n * 2 + j] = a[k--]; + data_zspmv.a_verify[i * n * 2 + j - 1] = a[k--]; + } + } + } + } + + // Run gemv with unpacked matrix + BLASFUNC(zgemv)(&trans, &n, &n, alpha, data_zspmv.a_verify, &n, b, + &inc_b, beta, c, &inc_c); +} + +/** + * Comapare results computed by zspmv and zspmv_trusted + * + * param uplo specifies whether matrix A is upper or lower triangular + * param n - number of rows and columns of A + * param alpha - scaling factor for the matrix-vector product + * param inc_b - stride of vector b + * param beta - scaling factor for vector c + * param inc_c - stride of vector c + * return norm of differences + */ +static double check_zspmv(char uplo, blasint n, double *alpha, blasint inc_b, + double *beta, blasint inc_c) +{ + blasint i; + + // Fill symmetric packed maxtix a, vectors b and c + drand_generate(data_zspmv.a_test, n * (n + 1)); + drand_generate(data_zspmv.b_test, 2 * n * inc_b); + drand_generate(data_zspmv.c_test, 2 * n * inc_c); + + // Copy vector c for zspmv_trusted + for (i = 0; i < n * 2 * inc_c; i++) + data_zspmv.c_verify[i] = data_zspmv.c_test[i]; + + zspmv_trusted(uplo, n, alpha, data_zspmv.a_test, data_zspmv.b_test, + inc_b, beta, data_zspmv.c_verify, inc_c); + BLASFUNC(zspmv)(&uplo, &n, alpha, data_zspmv.a_test, data_zspmv.b_test, + &inc_b, beta, data_zspmv.c_test, &inc_c); + + // Find the differences between output vector caculated by zspmv and zspmv_trusted + for (i = 0; i < n * 2 * inc_c; i++) + data_zspmv.c_test[i] -= data_zspmv.c_verify[i]; + + // Find the norm of differences + return BLASFUNC(dznrm2)(&n, data_zspmv.c_test, &inc_c); +} + +/** + * Check if error function was called with expected function name + * and param info + * + * param uplo specifies whether matrix A is upper or lower triangular + * param n - number of rows and columns of A + * param inc_b - stride of vector b + * param inc_c - stride of vector c + * param expected_info - expected invalid parameter number in zspmv + * return TRUE if everything is ok, otherwise FALSE + */ +static int check_badargs(char uplo, blasint n, blasint inc_b, + blasint inc_c, int expected_info) +{ + double alpha[] = {1.0, 1.0}; + double beta[] = {0.0, 0.0}; + + set_xerbla("ZSPMV ", expected_info); + + BLASFUNC(zspmv)(&uplo, &n, alpha, data_zspmv.a_test, data_zspmv.b_test, + &inc_b, beta, data_zspmv.c_test, &inc_c); + + return check_error(); +} + +/** + * Test zspmv by comparing it against zgemv + * with the following options: + * + * A is upper triangular + * Number of rows and columns of A is 100 + * Stride of vector b is 1 + * Stride of vector c is 1 + */ +CTEST(zspmv, upper_inc_b_1_inc_c_1_N_100) +{ + blasint N = DATASIZE, inc_b = 1, inc_c = 1; + char uplo = 'U'; + double alpha[] = {1.0, 1.0}; + double beta[] = {0.0, 0.0}; + + double norm = check_zspmv(uplo, N, alpha, inc_b, beta, inc_c); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_TOL); +} + +/** + * Test zspmv by comparing it against zgemv + * with the following options: + * + * A is upper triangular + * Number of rows and columns of A is 100 + * Stride of vector b is 1 + * Stride of vector c is 2 + */ +CTEST(zspmv, upper_inc_b_1_inc_c_2_N_100) +{ + blasint N = DATASIZE, inc_b = 1, inc_c = 2; + char uplo = 'U'; + double alpha[] = {1.0, 1.0}; + double beta[] = {0.0, 0.0}; + + double norm = check_zspmv(uplo, N, alpha, inc_b, beta, inc_c); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_TOL); +} + +/** + * Test zspmv by comparing it against zgemv + * with the following options: + * + * A is upper triangular + * Number of rows and columns of A is 100 + * Stride of vector b is 2 + * Stride of vector c is 1 + */ +CTEST(zspmv, upper_inc_b_2_inc_c_1_N_100) +{ + blasint N = DATASIZE, inc_b = 2, inc_c = 1; + char uplo = 'U'; + double alpha[] = {1.0, 0.0}; + double beta[] = {1.0, 0.0}; + + double norm = check_zspmv(uplo, N, alpha, inc_b, beta, inc_c); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_TOL); +} + +/** + * Test zspmv by comparing it against zgemv + * with the following options: + * + * A is upper triangular + * Number of rows and columns of A is 100 + * Stride of vector b is 2 + * Stride of vector c is 2 + */ +CTEST(zspmv, upper_inc_b_2_inc_c_2_N_100) +{ + blasint N = DATASIZE, inc_b = 2, inc_c = 2; + char uplo = 'U'; + double alpha[] = {2.5, -2.1}; + double beta[] = {0.0, 1.0}; + + double norm = check_zspmv(uplo, N, alpha, inc_b, beta, inc_c); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_TOL); +} + +/** + * Test zspmv by comparing it against zgemv + * with the following options: + * + * A is lower triangular + * Number of rows and columns of A is 100 + * Stride of vector b is 1 + * Stride of vector c is 1 + */ +CTEST(zspmv, lower_inc_b_1_inc_c_1_N_100) +{ + blasint N = DATASIZE, inc_b = 1, inc_c = 1; + char uplo = 'L'; + double alpha[] = {1.0, 1.0}; + double beta[] = {0.0, 0.0}; + + double norm = check_zspmv(uplo, N, alpha, inc_b, beta, inc_c); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_TOL); +} + +/** + * Test zspmv by comparing it against zgemv + * with the following options: + * + * A is lower triangular + * Number of rows and columns of A is 100 + * Stride of vector b is 1 + * Stride of vector c is 2 + */ +CTEST(zspmv, lower_inc_b_1_inc_c_2_N_100) +{ + blasint N = DATASIZE, inc_b = 1, inc_c = 2; + char uplo = 'L'; + double alpha[] = {1.0, 1.0}; + double beta[] = {0.0, 0.0}; + + double norm = check_zspmv(uplo, N, alpha, inc_b, beta, inc_c); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_TOL); +} + +/** + * Test zspmv by comparing it against zgemv + * with the following options: + * + * A is lower triangular + * Number of rows and columns of A is 100 + * Stride of vector b is 2 + * Stride of vector c is 1 + */ +CTEST(zspmv, lower_inc_b_2_inc_c_1_N_100) +{ + blasint N = DATASIZE, inc_b = 2, inc_c = 1; + char uplo = 'L'; + double alpha[] = {1.0, 0.0}; + double beta[] = {1.0, 0.0}; + + double norm = check_zspmv(uplo, N, alpha, inc_b, beta, inc_c); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_TOL); +} + +/** + * Test zspmv by comparing it against zgemv + * with the following options: + * + * A is lower triangular + * Number of rows and columns of A is 100 + * Stride of vector b is 2 + * Stride of vector c is 2 + */ +CTEST(zspmv, lower_inc_b_2_inc_c_2_N_100) +{ + blasint N = DATASIZE, inc_b = 2, inc_c = 2; + char uplo = 'L'; + double alpha[] = {2.5, -2.1}; + double beta[] = {0.0, 1.0}; + + double norm = check_zspmv(uplo, N, alpha, inc_b, beta, inc_c); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_TOL); +} + +/** + * Check if output matrix A contains any NaNs + */ +CTEST(zspmv, check_for_NaN) +{ + blasint N = DATASIZE, inc_b = 1, inc_c = 1; + char uplo = 'U'; + double alpha[] = {1.0, 1.0}; + double beta[] = {0.0, 0.0}; + + double norm = check_zspmv(uplo, N, alpha, inc_b, beta, inc_c); + + ASSERT_TRUE(norm == norm); /* NaN == NaN is false */ +} + +/** + * Test error function for an invalid param uplo. + * uplo specifies whether A is upper or lower triangular. + */ +CTEST(zspmv, xerbla_uplo_invalid) +{ + blasint N = DATASIZE, inc_b = 1, inc_c = 1; + char uplo = 'O'; + int expected_info = 1; + + int passed = check_badargs(uplo, N, inc_b, inc_c, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param N - + * number of rows and columns of A. Must be at least zero. + */ +CTEST(zspmv, xerbla_N_invalid) +{ + blasint N = INVALID, inc_b = 1, inc_c = 1; + char uplo = 'U'; + int expected_info = 2; + + int passed = check_badargs(uplo, N, inc_b, inc_c, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param inc_b - + * stride of vector b. Can't be zero. + */ +CTEST(zspmv, xerbla_inc_b_zero) +{ + blasint N = DATASIZE, inc_b = 0, inc_c = 1; + char uplo = 'U'; + int expected_info = 6; + + int passed = check_badargs(uplo, N, inc_b, inc_c, expected_info); + ASSERT_EQUAL(TRUE, passed); +} + +/** + * Test error function for an invalid param inc_c - + * stride of vector c. Can't be zero. + */ +CTEST(zspmv, xerbla_inc_c_zero) +{ + blasint N = DATASIZE, inc_b = 1, inc_c = 0; + char uplo = 'U'; + int expected_info = 9; + + int passed = check_badargs(uplo, N, inc_b, inc_c, expected_info); + ASSERT_EQUAL(TRUE, passed); +} +#endif diff --git a/utest/test_extensions/test_ztrmv.c b/utest/test_extensions/test_ztrmv.c new file mode 100644 index 000000000..aad64099e --- /dev/null +++ b/utest/test_extensions/test_ztrmv.c @@ -0,0 +1,266 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. 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. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include +#include "common.h" + +#define DATASIZE 300 +#define INCREMENT 2 + +struct DATA_ZTRMV { + double a_test[DATASIZE * DATASIZE * 2]; + double a_verify[DATASIZE * DATASIZE * 2]; + double x_test[DATASIZE * INCREMENT * 2]; + double x_verify[DATASIZE * INCREMENT * 2]; +}; + +#ifdef BUILD_COMPLEX16 +static struct DATA_ZTRMV data_ztrmv; + +/** + * Test ztrmv with the conjugate and not-transposed matrix A by conjugating matrix A + * and comparing it with the non-conjugate ztrmv. + * + * param uplo specifies whether A is upper or lower triangular + * param trans specifies op(A), the transposition (conjugation) operation applied to A + * param diag specifies whether the matrix A is unit triangular or not. + * param n - numbers of rows and columns of A + * param lda - leading dimension of matrix A + * param incx - increment for the elements of x + * return norm of difference + */ +static double check_ztrmv(char uplo, char trans, char diag, blasint n, blasint lda, blasint incx) +{ + blasint i; + double alpha_conj[] = {1.0, 0.0}; + char trans_verify = trans; + + srand_generate(data_ztrmv.a_test, n * lda * 2); + srand_generate(data_ztrmv.x_test, n * incx * 2); + + for (i = 0; i < n * lda * 2; i++) + data_ztrmv.a_verify[i] = data_ztrmv.a_test[i]; + + for (i = 0; i < n * incx * 2; i++) + data_ztrmv.x_verify[i] = data_ztrmv.x_test[i]; + + if (trans == 'R'){ + cblas_zimatcopy(CblasColMajor, CblasConjNoTrans, n, n, alpha_conj, data_ztrmv.a_verify, lda, lda); + trans_verify = 'N'; + } + + BLASFUNC(ztrmv)(&uplo, &trans_verify, &diag, &n, data_ztrmv.a_verify, &lda, + data_ztrmv.x_verify, &incx); + + BLASFUNC(ztrmv)(&uplo, &trans, &diag, &n, data_ztrmv.a_test, &lda, + data_ztrmv.x_test, &incx); + + for (i = 0; i < n * incx * 2; i++) + data_ztrmv.x_verify[i] -= data_ztrmv.x_test[i]; + + return BLASFUNC(dznrm2)(&n, data_ztrmv.x_verify, &incx); +} + +/** + * Test ztrmv with the conjugate and not-transposed matrix A by conjugating matrix A + * and comparing it with the non-conjugate ztrmv. + * Test with the following options: + * + * matrix A is conjugate and not-trans + * matrix A is upper triangular + * matrix A is not unit triangular + */ +CTEST(ztrmv, conj_notrans_upper_not_unit_triangular) +{ + blasint n = DATASIZE, incx = 1, lda = DATASIZE; + char uplo = 'U'; + char diag = 'N'; + char trans = 'R'; + + double norm = check_ztrmv(uplo, trans, diag, n, lda, incx); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Test ztrmv with the conjugate and not-transposed matrix A by conjugating matrix A + * and comparing it with the non-conjugate ztrmv. + * Test with the following options: + * + * matrix A is conjugate and not-trans + * matrix A is upper triangular + * matrix A is unit triangular + */ +CTEST(ztrmv, conj_notrans_upper_unit_triangular) +{ + blasint n = DATASIZE, incx = 1, lda = DATASIZE; + char uplo = 'U'; + char diag = 'U'; + char trans = 'R'; + + double norm = check_ztrmv(uplo, trans, diag, n, lda, incx); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Test ztrmv with the conjugate and not-transposed matrix A by conjugating matrix A + * and comparing it with the non-conjugate ztrmv. + * Test with the following options: + * + * matrix A is conjugate and not-trans + * matrix A is lower triangular + * matrix A is not unit triangular + */ +CTEST(ztrmv, conj_notrans_lower_not_triangular) +{ + blasint n = DATASIZE, incx = 1, lda = DATASIZE; + char uplo = 'L'; + char diag = 'N'; + char trans = 'R'; + + double norm = check_ztrmv(uplo, trans, diag, n, lda, incx); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Test ztrmv with the conjugate and not-transposed matrix A by conjugating matrix A + * and comparing it with the non-conjugate ztrmv. + * Test with the following options: + * + * matrix A is conjugate and not-trans + * matrix A is lower triangular + * matrix A is unit triangular + */ +CTEST(ztrmv, conj_notrans_lower_unit_triangular) +{ + blasint n = DATASIZE, incx = 1, lda = DATASIZE; + char uplo = 'L'; + char diag = 'U'; + char trans = 'R'; + + double norm = check_ztrmv(uplo, trans, diag, n, lda, incx); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Test ztrmv with the conjugate and not-transposed matrix A by conjugating matrix A + * and comparing it with the non-conjugate ztrmv. + * Test with the following options: + * + * matrix A is conjugate and not-trans + * matrix A is upper triangular + * matrix A is not unit triangular + * vector x stride is 2 + */ +CTEST(ztrmv, conj_notrans_upper_not_unit_triangular_incx_2) +{ + blasint n = DATASIZE, incx = 2, lda = DATASIZE; + char uplo = 'U'; + char diag = 'N'; + char trans = 'R'; + + double norm = check_ztrmv(uplo, trans, diag, n, lda, incx); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Test ztrmv with the conjugate and not-transposed matrix A by conjugating matrix A + * and comparing it with the non-conjugate ztrmv. + * Test with the following options: + * + * matrix A is conjugate and not-trans + * matrix A is upper triangular + * matrix A is unit triangular + * vector x stride is 2 + */ +CTEST(ztrmv, conj_notrans_upper_unit_triangular_incx_2) +{ + blasint n = DATASIZE, incx = 2, lda = DATASIZE; + char uplo = 'U'; + char diag = 'U'; + char trans = 'R'; + + double norm = check_ztrmv(uplo, trans, diag, n, lda, incx); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Test ztrmv with the conjugate and not-transposed matrix A by conjugating matrix A + * and comparing it with the non-conjugate ztrmv. + * Test with the following options: + * + * matrix A is conjugate and not-trans + * matrix A is lower triangular + * matrix A is not unit triangular + * vector x stride is 2 + */ +CTEST(ztrmv, conj_notrans_lower_not_triangular_incx_2) +{ + blasint n = DATASIZE, incx = 2, lda = DATASIZE; + char uplo = 'L'; + char diag = 'N'; + char trans = 'R'; + + double norm = check_ztrmv(uplo, trans, diag, n, lda, incx); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Test ztrmv with the conjugate and not-transposed matrix A by conjugating matrix A + * and comparing it with the non-conjugate ztrmv. + * Test with the following options: + * + * matrix A is conjugate and not-trans + * matrix A is lower triangular + * matrix A is unit triangular + * vector x stride is 2 + */ +CTEST(ztrmv, conj_notrans_lower_unit_triangular_incx_2) +{ + blasint n = DATASIZE, incx = 2, lda = DATASIZE; + char uplo = 'L'; + char diag = 'U'; + char trans = 'R'; + + double norm = check_ztrmv(uplo, trans, diag, n, lda, incx); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/test_ztrsv.c b/utest/test_extensions/test_ztrsv.c new file mode 100644 index 000000000..ae556f5e2 --- /dev/null +++ b/utest/test_extensions/test_ztrsv.c @@ -0,0 +1,267 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. 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. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "utest/openblas_utest.h" +#include +#include "common.h" + +#define DATASIZE 300 +#define INCREMENT 2 + +struct DATA_ZTRSV { + double a_test[DATASIZE * DATASIZE * 2]; + double a_verify[DATASIZE * DATASIZE * 2]; + double x_test[DATASIZE * INCREMENT * 2]; + double x_verify[DATASIZE * INCREMENT * 2]; +}; + +#ifdef BUILD_COMPLEX16 +static struct DATA_ZTRSV data_ztrsv; + +/** + * Test ztrsv with the conjugate and not-transposed matrix A by conjugating matrix A + * and comparing it with the non-conjugate ztrsv. + * + * param uplo specifies whether A is upper or lower triangular + * param trans specifies op(A), the transposition (conjugation) operation applied to A + * param diag specifies whether the matrix A is unit triangular or not. + * param n - numbers of rows and columns of A + * param lda - leading dimension of matrix A + * param incx - increment for the elements of x + * return norm of difference + */ +static double check_ztrsv(char uplo, char trans, char diag, blasint n, blasint lda, blasint incx) +{ + blasint i; + double alpha_conj[] = {1.0, 0.0}; + char trans_verify = trans; + + srand_generate(data_ztrsv.a_test, n * lda * 2); + srand_generate(data_ztrsv.x_test, n * incx * 2); + + for (i = 0; i < n * lda * 2; i++) + data_ztrsv.a_verify[i] = data_ztrsv.a_test[i]; + + for (i = 0; i < n * incx * 2; i++) + data_ztrsv.x_verify[i] = data_ztrsv.x_test[i]; + + if (trans == 'R'){ + cblas_zimatcopy(CblasColMajor, CblasConjNoTrans, n, n, + alpha_conj, data_ztrsv.a_verify, lda, lda); + trans_verify = 'N'; + } + + BLASFUNC(ztrsv)(&uplo, &trans_verify, &diag, &n, data_ztrsv.a_verify, + &lda, data_ztrsv.x_verify, &incx); + + BLASFUNC(ztrsv)(&uplo, &trans, &diag, &n, data_ztrsv.a_test, &lda, + data_ztrsv.x_test, &incx); + + for (i = 0; i < n * incx * 2; i++) + data_ztrsv.x_verify[i] -= data_ztrsv.x_test[i]; + + return BLASFUNC(dznrm2)(&n, data_ztrsv.x_verify, &incx); +} + +/** + * Test ztrsv with the conjugate and not-transposed matrix A by conjugating matrix A + * and comparing it with the non-conjugate ztrsv. + * Test with the following options: + * + * matrix A is conjugate and not-trans + * matrix A is upper triangular + * matrix A is not unit triangular + */ +CTEST(ztrsv, conj_notrans_upper_not_unit_triangular) +{ + blasint n = DATASIZE, incx = 1, lda = DATASIZE; + char uplo = 'U'; + char diag = 'N'; + char trans = 'R'; + + double norm = check_ztrsv(uplo, trans, diag, n, lda, incx); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Test ztrsv with the conjugate and not-transposed matrix A by conjugating matrix A + * and comparing it with the non-conjugate ztrsv. + * Test with the following options: + * + * matrix A is conjugate and not-trans + * matrix A is upper triangular + * matrix A is unit triangular + */ +CTEST(ztrsv, conj_notrans_upper_unit_triangular) +{ + blasint n = DATASIZE, incx = 1, lda = DATASIZE; + char uplo = 'U'; + char diag = 'U'; + char trans = 'R'; + + double norm = check_ztrsv(uplo, trans, diag, n, lda, incx); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Test ztrsv with the conjugate and not-transposed matrix A by conjugating matrix A + * and comparing it with the non-conjugate ztrsv. + * Test with the following options: + * + * matrix A is conjugate and not-trans + * matrix A is lower triangular + * matrix A is not unit triangular + */ +CTEST(ztrsv, conj_notrans_lower_not_triangular) +{ + blasint n = DATASIZE, incx = 1, lda = DATASIZE; + char uplo = 'L'; + char diag = 'N'; + char trans = 'R'; + + double norm = check_ztrsv(uplo, trans, diag, n, lda, incx); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Test ztrsv with the conjugate and not-transposed matrix A by conjugating matrix A + * and comparing it with the non-conjugate ztrsv. + * Test with the following options: + * + * matrix A is conjugate and not-trans + * matrix A is lower triangular + * matrix A is unit triangular + */ +CTEST(ztrsv, conj_notrans_lower_unit_triangular) +{ + blasint n = DATASIZE, incx = 1, lda = DATASIZE; + char uplo = 'L'; + char diag = 'U'; + char trans = 'R'; + + double norm = check_ztrsv(uplo, trans, diag, n, lda, incx); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Test ztrsv with the conjugate and not-transposed matrix A by conjugating matrix A + * and comparing it with the non-conjugate ztrsv. + * Test with the following options: + * + * matrix A is conjugate and not-trans + * matrix A is upper triangular + * matrix A is not unit triangular + * vector x stride is 2 + */ +CTEST(ztrsv, conj_notrans_upper_not_unit_triangular_incx_2) +{ + blasint n = DATASIZE, incx = 2, lda = DATASIZE; + char uplo = 'U'; + char diag = 'N'; + char trans = 'R'; + + double norm = check_ztrsv(uplo, trans, diag, n, lda, incx); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Test ztrsv with the conjugate and not-transposed matrix A by conjugating matrix A + * and comparing it with the non-conjugate ztrsv. + * Test with the following options: + * + * matrix A is conjugate and not-trans + * matrix A is upper triangular + * matrix A is unit triangular + * vector x stride is 2 + */ +CTEST(ztrsv, conj_notrans_upper_unit_triangular_incx_2) +{ + blasint n = DATASIZE, incx = 2, lda = DATASIZE; + char uplo = 'U'; + char diag = 'U'; + char trans = 'R'; + + double norm = check_ztrsv(uplo, trans, diag, n, lda, incx); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Test ztrsv with the conjugate and not-transposed matrix A by conjugating matrix A + * and comparing it with the non-conjugate ztrsv. + * Test with the following options: + * + * matrix A is conjugate and not-trans + * matrix A is lower triangular + * matrix A is not unit triangular + * vector x stride is 2 + */ +CTEST(ztrsv, conj_notrans_lower_not_triangular_incx_2) +{ + blasint n = DATASIZE, incx = 2, lda = DATASIZE; + char uplo = 'L'; + char diag = 'N'; + char trans = 'R'; + + double norm = check_ztrsv(uplo, trans, diag, n, lda, incx); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} + +/** + * Test ztrsv with the conjugate and not-transposed matrix A by conjugating matrix A + * and comparing it with the non-conjugate ztrsv. + * Test with the following options: + * + * matrix A is conjugate and not-trans + * matrix A is lower triangular + * matrix A is unit triangular + * vector x stride is 2 + */ +CTEST(ztrsv, conj_notrans_lower_unit_triangular_incx_2) +{ + blasint n = DATASIZE, incx = 2, lda = DATASIZE; + char uplo = 'L'; + char diag = 'U'; + char trans = 'R'; + + double norm = check_ztrsv(uplo, trans, diag, n, lda, incx); + + ASSERT_DBL_NEAR_TOL(0.0, norm, DOUBLE_EPS); +} +#endif \ No newline at end of file diff --git a/utest/test_extensions/xerbla.c b/utest/test_extensions/xerbla.c new file mode 100644 index 000000000..9487b20a6 --- /dev/null +++ b/utest/test_extensions/xerbla.c @@ -0,0 +1,88 @@ +/***************************************************************************** +Copyright (c) 2023, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. 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. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "common.h" + +static int link_xerbla=TRUE; +static int lerr, _info, ok; +static char *rout; + +static void F77_xerbla(char *srname, void *vinfo) +{ + int info=*(int*)vinfo; + + if (link_xerbla) + { + link_xerbla = 0; + return; + } + + if (rout != NULL && strcmp(rout, srname) != 0){ + printf("***** XERBLA WAS CALLED WITH SRNAME = <%s> INSTEAD OF <%s> *******\n", srname, rout); + ok = FALSE; + } + + if (info != _info){ + printf("***** XERBLA WAS CALLED WITH INFO = %d INSTEAD OF %d in %s *******\n",info, _info, srname); + lerr = TRUE; + ok = FALSE; + } else lerr = FALSE; +} + +/** +* error function redefinition +*/ +int BLASFUNC(xerbla)(char *name, blasint *info, blasint length) +{ + F77_xerbla(name, info); + return 0; +} + +int check_error(void) { + if (lerr == TRUE ) { + printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %d NOT DETECTED BY %s *****\n", _info, rout); + ok = FALSE; + } + lerr = TRUE; + return ok; +} + +void set_xerbla(char* current_rout, int expected_info){ + if (link_xerbla) /* call these first to link */ + F77_xerbla(rout, &_info); + + ok = TRUE; + lerr = TRUE; + _info = expected_info; + rout = current_rout; +} \ No newline at end of file From c99e231fc5bb9ae661547089b561f0a66e99431e Mon Sep 17 00:00:00 2001 From: Andrey Sokolov Date: Thu, 18 Jan 2024 23:54:51 +0300 Subject: [PATCH 077/311] Fix rand_generate --- utest/test_extensions/common.c | 4 ++-- utest/test_extensions/test_zgeadd.c | 4 ++-- utest/test_extensions/test_ztrmv.c | 4 ++-- utest/test_extensions/test_ztrsv.c | 4 ++-- 4 files changed, 8 insertions(+), 8 deletions(-) diff --git a/utest/test_extensions/common.c b/utest/test_extensions/common.c index c3bdcefc7..8a6a47795 100644 --- a/utest/test_extensions/common.c +++ b/utest/test_extensions/common.c @@ -40,14 +40,14 @@ void srand_generate(float *alpha, blasint n) { blasint i; for (i = 0; i < n; i++) - alpha[i] = (float)rand() / (float)RAND_MAX * 5.0f; + alpha[i] = (float)rand() / (float)RAND_MAX; } void drand_generate(double *alpha, blasint n) { blasint i; for (i = 0; i < n; i++) - alpha[i] = (double)rand() / (double)RAND_MAX * 5.0; + alpha[i] = (double)rand() / (double)RAND_MAX; } /** diff --git a/utest/test_extensions/test_zgeadd.c b/utest/test_extensions/test_zgeadd.c index 917c04829..e50f86de0 100644 --- a/utest/test_extensions/test_zgeadd.c +++ b/utest/test_extensions/test_zgeadd.c @@ -103,8 +103,8 @@ static double check_zgeadd(char api, OPENBLAS_CONST enum CBLAS_ORDER order, } // Fill matrix A, C - srand_generate(data_zgeadd.a_test, lda * rows * 2); - srand_generate(data_zgeadd.c_test, ldc * rows * 2); + drand_generate(data_zgeadd.a_test, lda * rows * 2); + drand_generate(data_zgeadd.c_test, ldc * rows * 2); // Copy matrix C for zgeadd for (i = 0; i < ldc * rows * 2; i++) diff --git a/utest/test_extensions/test_ztrmv.c b/utest/test_extensions/test_ztrmv.c index aad64099e..5668ec296 100644 --- a/utest/test_extensions/test_ztrmv.c +++ b/utest/test_extensions/test_ztrmv.c @@ -66,8 +66,8 @@ static double check_ztrmv(char uplo, char trans, char diag, blasint n, blasint l double alpha_conj[] = {1.0, 0.0}; char trans_verify = trans; - srand_generate(data_ztrmv.a_test, n * lda * 2); - srand_generate(data_ztrmv.x_test, n * incx * 2); + drand_generate(data_ztrmv.a_test, n * lda * 2); + drand_generate(data_ztrmv.x_test, n * incx * 2); for (i = 0; i < n * lda * 2; i++) data_ztrmv.a_verify[i] = data_ztrmv.a_test[i]; diff --git a/utest/test_extensions/test_ztrsv.c b/utest/test_extensions/test_ztrsv.c index ae556f5e2..4b7ec6aaf 100644 --- a/utest/test_extensions/test_ztrsv.c +++ b/utest/test_extensions/test_ztrsv.c @@ -66,8 +66,8 @@ static double check_ztrsv(char uplo, char trans, char diag, blasint n, blasint l double alpha_conj[] = {1.0, 0.0}; char trans_verify = trans; - srand_generate(data_ztrsv.a_test, n * lda * 2); - srand_generate(data_ztrsv.x_test, n * incx * 2); + drand_generate(data_ztrsv.a_test, n * lda * 2); + drand_generate(data_ztrsv.x_test, n * incx * 2); for (i = 0; i < n * lda * 2; i++) data_ztrsv.a_verify[i] = data_ztrsv.a_test[i]; From ccbc3f875bc87e92c1ab05f3b361f64d7fd95c87 Mon Sep 17 00:00:00 2001 From: Octavian Maghiar Date: Fri, 19 Jan 2024 12:40:00 +0000 Subject: [PATCH 078/311] [RISC-V] Add RISCV64_ZVL128B target to common_riscv64.h --- common_riscv64.h | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/common_riscv64.h b/common_riscv64.h index f11e8b75d..4b5f7dcc4 100644 --- a/common_riscv64.h +++ b/common_riscv64.h @@ -91,7 +91,7 @@ static inline int blas_quickdivide(blasint x, blasint y){ #define BUFFER_SIZE ( 32 << 20) #define SEEK_ADDRESS -#if defined(C910V) || (defined(RISCV64_ZVL256B) && (defined(__clang__) || defined(RVV_COMPATIBLE_GCC))) +#if defined(C910V) || (defined(RISCV64_ZVL256B) && (defined(__clang__) || defined(RVV_COMPATIBLE_GCC))) || defined(RISCV64_ZVL128B) # include #endif From aaf65210ccba0c53408c242a2e0f5ad5d798d532 Mon Sep 17 00:00:00 2001 From: Chris Sidebottom Date: Fri, 19 Jan 2024 19:04:21 +0000 Subject: [PATCH 079/311] Add dynamic support for Arm(R) Neoverse(TM) V2 processor Whilst I figure out how best to map the L2 parameters without duplicating all of `ARMV8SVE`, lets just map this to `NEOVERSEV1`. --- driver/others/dynamic_arm64.c | 31 +++++++++++++++++++++---------- 1 file changed, 21 insertions(+), 10 deletions(-) diff --git a/driver/others/dynamic_arm64.c b/driver/others/dynamic_arm64.c index 803e0b5eb..6b21028d1 100644 --- a/driver/others/dynamic_arm64.c +++ b/driver/others/dynamic_arm64.c @@ -1,6 +1,6 @@ /*********************************************************************/ /* Copyright 2009, 2010 The University of Texas at Austin. */ -/* Copyright 2023 The OpenBLAS Project */ +/* Copyright 2023-2024 The OpenBLAS Project */ /* All rights reserved. */ /* */ /* Redistribution and use in source and binary forms, with or */ @@ -143,12 +143,13 @@ extern gotoblas_t gotoblas_ARMV8SVE; #endif extern gotoblas_t gotoblas_THUNDERX3T110; #endif +#define gotoblas_NEOVERSEV2 gotoblas_NEOVERSEV1 extern void openblas_warning(int verbose, const char * msg); #define FALLBACK_VERBOSE 1 #define NEOVERSEN1_FALLBACK "OpenBLAS : Your OS does not support SVE instructions. OpenBLAS is using Neoverse N1 kernels as a fallback, which may give poorer performance.\n" -#define NUM_CORETYPES 16 +#define NUM_CORETYPES 17 /* * In case asm/hwcap.h is outdated on the build system, make sure @@ -178,6 +179,7 @@ static char *corename[] = { "emag8180", "neoversen1", "neoversev1", + "neoversev2", "neoversen2", "thunderx3t110", "cortexa55", @@ -198,10 +200,11 @@ char *gotoblas_corename(void) { if (gotoblas == &gotoblas_EMAG8180) return corename[ 9]; if (gotoblas == &gotoblas_NEOVERSEN1) return corename[10]; if (gotoblas == &gotoblas_NEOVERSEV1) return corename[11]; - if (gotoblas == &gotoblas_NEOVERSEN2) return corename[12]; - if (gotoblas == &gotoblas_THUNDERX3T110) return corename[13]; - if (gotoblas == &gotoblas_CORTEXA55) return corename[14]; - if (gotoblas == &gotoblas_ARMV8SVE) return corename[15]; + if (gotoblas == &gotoblas_NEOVERSEV2) return corename[12]; + if (gotoblas == &gotoblas_NEOVERSEN2) return corename[13]; + if (gotoblas == &gotoblas_THUNDERX3T110) return corename[14]; + if (gotoblas == &gotoblas_CORTEXA55) return corename[15]; + if (gotoblas == &gotoblas_ARMV8SVE) return corename[16]; return corename[NUM_CORETYPES]; } @@ -233,10 +236,11 @@ static gotoblas_t *force_coretype(char *coretype) { case 9: return (&gotoblas_EMAG8180); case 10: return (&gotoblas_NEOVERSEN1); case 11: return (&gotoblas_NEOVERSEV1); - case 12: return (&gotoblas_NEOVERSEN2); - case 13: return (&gotoblas_THUNDERX3T110); - case 14: return (&gotoblas_CORTEXA55); - case 15: return (&gotoblas_ARMV8SVE); + case 12: return (&gotoblas_NEOVERSEV2); + case 13: return (&gotoblas_NEOVERSEN2); + case 14: return (&gotoblas_THUNDERX3T110); + case 15: return (&gotoblas_CORTEXA55); + case 16: return (&gotoblas_ARMV8SVE); } snprintf(message, 128, "Core not found: %s\n", coretype); openblas_warning(1, message); @@ -312,6 +316,13 @@ static gotoblas_t *get_coretype(void) { return &gotoblas_NEOVERSEN1; }else return &gotoblas_NEOVERSEV1; + case 0xd4f: + if (!(getauxval(AT_HWCAP) & HWCAP_SVE)) { + openblas_warning(FALLBACK_VERBOSE, NEOVERSEN1_FALLBACK); + return &gotoblas_NEOVERSEN1; + } else { + return &gotoblas_NEOVERSEV2; + } #endif case 0xd05: // Cortex A55 return &gotoblas_CORTEXA55; From 304a9b60afbc79be77193cc3bdb5bb5d503aa533 Mon Sep 17 00:00:00 2001 From: Han Gao/Revy/Rabenda Date: Sun, 21 Jan 2024 14:32:52 +0000 Subject: [PATCH 080/311] Update T-Head toolchains v2.8.0 Signed-off-by: Han Gao/Revy/Rabenda --- .github/workflows/c910v.yml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/.github/workflows/c910v.yml b/.github/workflows/c910v.yml index 30cf32b34..68ba2ddd7 100644 --- a/.github/workflows/c910v.yml +++ b/.github/workflows/c910v.yml @@ -14,8 +14,8 @@ jobs: if: "github.repository == 'OpenMathLib/OpenBLAS'" runs-on: ubuntu-latest env: - xuetie_toolchain: https://occ-oss-prod.oss-cn-hangzhou.aliyuncs.com/resource//1663142514282 - toolchain_file_name: Xuantie-900-gcc-linux-5.10.4-glibc-x86_64-V2.6.1-20220906.tar.gz + xuetie_toolchain: https://occ-oss-prod.oss-cn-hangzhou.aliyuncs.com/resource//1698113812618 + toolchain_file_name: Xuantie-900-gcc-linux-5.10.4-glibc-x86_64-V2.8.0-20231018.tar.gz strategy: fail-fast: false matrix: @@ -76,7 +76,7 @@ jobs: run: | wget ${xuetie_toolchain}/${toolchain_file_name} tar -xvf ${toolchain_file_name} -C /opt - export PATH="/opt/Xuantie-900-gcc-linux-5.10.4-glibc-x86_64-V2.6.1/bin:$PATH" + export PATH="/opt/Xuantie-900-gcc-linux-5.10.4-glibc-x86_64-V2.8.0/bin:$PATH" make CC='ccache ${{ matrix.triple }}-gcc -static' FC='ccache ${{ matrix.triple }}-gfortran -static' ${{ matrix.opts }} HOSTCC='ccache gcc' -j$(nproc) From e1afb23811256b231c259ca57d7a5f6e81ac6da5 Mon Sep 17 00:00:00 2001 From: kseniyazaytseva Date: Fri, 7 Apr 2023 11:13:23 +0300 Subject: [PATCH 081/311] Fix BLAS and LAPACK tests for C910V and RISCV64_ZVL256B targets * Fixed bugs in dgemm, [a]min\max, asum kernels * Added zero checks for BLAS kernels * Added dsdot implementation for RVV 0.7.1 * Fixed bugs in _vector files for C910V and RISCV64_ZVL256B targets * Added additional definitions for RISCV64_ZVL256B target --- Makefile.prebuild | 4 + Makefile.riscv64 | 4 + TargetList.txt | 1 + getarch.c | 14 +++ kernel/riscv64/KERNEL.C910V | 1 + kernel/riscv64/amin_vector.c | 6 +- kernel/riscv64/asum_vector.c | 7 +- kernel/riscv64/axpby_vector.c | 2 +- kernel/riscv64/dgemm_kernel_8x4_c910v.c | 2 +- kernel/riscv64/dsdot_vector.c | 152 ++++++++++++++++++++++++ kernel/riscv64/iamin_vector.c | 4 +- kernel/riscv64/izamin_vector.c | 2 +- kernel/riscv64/nrm2_vector.c | 2 +- kernel/riscv64/nrm2_vector_dot.c | 2 +- kernel/riscv64/swap_vector.c | 2 +- kernel/riscv64/zamax_vector.c | 17 +-- kernel/riscv64/zamin_vector.c | 17 +-- kernel/riscv64/znrm2_vector.c | 2 +- kernel/riscv64/zswap_vector.c | 2 +- 19 files changed, 205 insertions(+), 38 deletions(-) create mode 100644 kernel/riscv64/dsdot_vector.c diff --git a/Makefile.prebuild b/Makefile.prebuild index c4f4a2602..d30275f06 100644 --- a/Makefile.prebuild +++ b/Makefile.prebuild @@ -59,6 +59,10 @@ ifeq ($(TARGET), x280) TARGET_FLAGS = -march=rv64imafdcv_zba_zbb_zfh -mabi=lp64d endif +ifeq ($(TARGET), RISCV64_ZVL256B) +TARGET_FLAGS = -march=rv64imafdcv_zba_zbb_zfh -mabi=lp64d +endif + ifeq ($(TARGET), RISCV64_GENERIC) TARGET_FLAGS = -march=rv64imafdc -mabi=lp64d endif diff --git a/Makefile.riscv64 b/Makefile.riscv64 index ce7a27141..2239a3676 100644 --- a/Makefile.riscv64 +++ b/Makefile.riscv64 @@ -6,6 +6,10 @@ ifeq ($(CORE), x280) CCOMMON_OPT += -march=rv64imafdcv_zba_zbb_zfh_zvl512b -mabi=lp64d -ffast-math FCOMMON_OPT += -march=rv64imafdcv_zba_zbb_zfh -mabi=lp64d -static endif +ifeq ($(CORE), RISCV64_ZVL256B) +CCOMMON_OPT += -march=rv64imafdcv_zba_zbb_zfh_zvl256b -mabi=lp64d +FCOMMON_OPT += -march=rv64imafdcv_zba_zbb_zfh -mabi=lp64d -static +endif ifeq ($(CORE), RISCV64_GENERIC) CCOMMON_OPT += -march=rv64imafdc -mabi=lp64d FCOMMON_OPT += -march=rv64imafdc -mabi=lp64d -static diff --git a/TargetList.txt b/TargetList.txt index f76f605cc..f65a18b50 100644 --- a/TargetList.txt +++ b/TargetList.txt @@ -121,6 +121,7 @@ Z14 RISCV64_GENERIC (e.g. PolarFire Soc/SiFive U54) C910V x280 +RISCV64_ZVL256B 11.LOONGARCH64: LOONGSONGENERIC diff --git a/getarch.c b/getarch.c index 772836347..12ea72052 100644 --- a/getarch.c +++ b/getarch.c @@ -1692,6 +1692,20 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #else #endif +#ifdef FORCE_RISCV64_ZVL256B +#define FORCE +#define ARCHITECTURE "RISCV64" +#define SUBARCHITECTURE "RISCV64_ZVL256B" +#define SUBDIRNAME "riscv64" +#define ARCHCONFIG "-DRISCV64_ZVL256B " \ + "-DL1_DATA_SIZE=64536 -DL1_DATA_LINESIZE=32 " \ + "-DL2_SIZE=262144 -DL2_LINESIZE=32 " \ + "-DDTB_DEFAULT_ENTRIES=128 -DDTB_SIZE=4096 -DL2_ASSOCIATIVE=4 " +#define LIBNAME "riscv64_zvl256b" +#define CORENAME "RISCV64_ZVL256B" +#else +#endif + #if defined(FORCE_E2K) || defined(__e2k__) #define FORCE diff --git a/kernel/riscv64/KERNEL.C910V b/kernel/riscv64/KERNEL.C910V index 0da66fa35..2798a870e 100644 --- a/kernel/riscv64/KERNEL.C910V +++ b/kernel/riscv64/KERNEL.C910V @@ -59,6 +59,7 @@ SDOTKERNEL = dot_vector.c DDOTKERNEL = dot_vector.c CDOTKERNEL = zdot_vector.c ZDOTKERNEL = zdot_vector.c +DSDOTKERNEL = dsdot_vector.c SNRM2KERNEL = nrm2_vector.c DNRM2KERNEL = nrm2_vector.c diff --git a/kernel/riscv64/amin_vector.c b/kernel/riscv64/amin_vector.c index 1c541f0fd..c4578eabf 100644 --- a/kernel/riscv64/amin_vector.c +++ b/kernel/riscv64/amin_vector.c @@ -31,15 +31,19 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. # define LMUL m2 # if defined(DOUBLE) # define ELEN 64 +# define ABS fabs # else # define ELEN 32 +# define ABS fabsf # endif #else # define LMUL m8 # if defined(DOUBLE) # define ELEN 64 +# define ABS fabs # else # define ELEN 32 +# define ABS fabsf # endif #endif @@ -69,7 +73,7 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) FLOAT minf=0.0; if (n <= 0 || inc_x <= 0) return(minf); - minf = *x; + minf = ABS(*x); x += inc_x; --n; if (n == 0) return(minf); diff --git a/kernel/riscv64/asum_vector.c b/kernel/riscv64/asum_vector.c index 995dbf9a1..a652eafdd 100644 --- a/kernel/riscv64/asum_vector.c +++ b/kernel/riscv64/asum_vector.c @@ -67,7 +67,6 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) { BLASLONG i=0, j=0; - BLASLONG ix=0; FLOAT asumf=0.0; if (n <= 0 || inc_x <= 0) return(asumf); unsigned int gvl = 0; @@ -103,17 +102,15 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) unsigned int stride_x = inc_x * sizeof(FLOAT); if(gvl <= n/2){ v_sum = VFMVVF_FLOAT(0, gvl); - BLASLONG inc_xv = inc_x * gvl; for(i=0,j=0; i 0){ + v_res = vfredusum_vs_f64m4_f64m1(v_res, vr, v_z0, gvl); + dot += (double)vfmv_f_s_f64m1_f64(v_res); + } + //tail + if(j < n){ + gvl = vsetvl_e64m4(n-j); + vx = vle32_v_f32m2(&x[j], gvl); + vy = vle32_v_f32m2(&y[j], gvl); + vfloat64m4_t vz = vfmv_v_f_f64m4(0, gvl); + //vr = vfdot_vv_f32m2(vx, vy, gvl); + vr = vfwmacc_vv_f64m4(vz, vx, vy, gvl); + v_res = vfredusum_vs_f64m4_f64m1(v_res, vr, v_z0, gvl); + dot += (double)vfmv_f_s_f64m1_f64(v_res); + } + }else if(inc_y == 1){ + gvl = vsetvl_e64m4(n); + vr = vfmv_v_f_f64m4(0, gvl); + int stride_x = inc_x * sizeof(FLOAT); + for(i=0,j=0; i 0){ + v_res = vfredusum_vs_f64m4_f64m1(v_res, vr, v_z0, gvl); + dot += (double)vfmv_f_s_f64m1_f64(v_res); + + } + //tail + if(j < n){ + gvl = vsetvl_e64m4(n-j); + vx = vlse32_v_f32m2(&x[j*inc_x], stride_x, gvl); + vy = vle32_v_f32m2(&y[j], gvl); + vfloat64m4_t vz = vfmv_v_f_f64m4(0, gvl); + //vr = vfdot_vv_f32m2(vx, vy, gvl); + vr = vfwmacc_vv_f64m4(vz, vx, vy, gvl); + v_res = vfredusum_vs_f64m4_f64m1(v_res, vr, v_z0, gvl); + dot += (double)vfmv_f_s_f64m1_f64(v_res); + + } + }else if(inc_x == 1){ + gvl = vsetvl_e64m4(n); + vr = vfmv_v_f_f64m4(0, gvl); + int stride_y = inc_y * sizeof(FLOAT); + for(i=0,j=0; i 0){ + v_res = vfredusum_vs_f64m4_f64m1(v_res, vr, v_z0, gvl); + dot += (double)vfmv_f_s_f64m1_f64(v_res); + + } + //tail + if(j < n){ + gvl = vsetvl_e64m4(n-j); + vx = vle32_v_f32m2(&x[j], gvl); + vy = vlse32_v_f32m2(&y[j*inc_y], stride_y, gvl); + vfloat64m4_t vz = vfmv_v_f_f64m4(0, gvl); + //vr = vfdot_vv_f32m2(vx, vy, gvl); + vr = vfwmacc_vv_f64m4(vz, vx, vy, gvl); + v_res = vfredusum_vs_f64m4_f64m1(v_res, vr, v_z0, gvl); + dot += (double)vfmv_f_s_f64m1_f64(v_res); + + } + }else{ + gvl = vsetvl_e64m4(n); + vr = vfmv_v_f_f64m4(0, gvl); + int stride_x = inc_x * sizeof(FLOAT); + int stride_y = inc_y * sizeof(FLOAT); + for(i=0,j=0; i 0){ + v_res = vfredusum_vs_f64m4_f64m1(v_res, vr, v_z0, gvl); + dot += (double)vfmv_f_s_f64m1_f64(v_res); + + } + //tail + if(j < n){ + gvl = vsetvl_e64m4(n-j); + vx = vlse32_v_f32m2(&x[j*inc_x], stride_x, gvl); + vy = vlse32_v_f32m2(&y[j*inc_y], stride_y, gvl); + vfloat64m4_t vz = vfmv_v_f_f64m4(0, gvl); + //vr = vfdot_vv_f32m2(vx, vy, gvl); + vr = vfwmacc_vv_f64m4(vz, vx, vy, gvl); + v_res = vfredusum_vs_f64m4_f64m1(v_res, vr, v_z0, gvl); + dot += (double)vfmv_f_s_f64m1_f64(v_res); + + } + } + return(dot); +} diff --git a/kernel/riscv64/iamin_vector.c b/kernel/riscv64/iamin_vector.c index a58872960..0e591e697 100644 --- a/kernel/riscv64/iamin_vector.c +++ b/kernel/riscv64/iamin_vector.c @@ -139,7 +139,7 @@ BLASLONG CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) v_res = VFREDMINVS_FLOAT(v_min, v_res, gvl); FLOAT cur_minf = EXTRACT_FLOAT(v_res); - if(cur_minf > minf){ + if(cur_minf < minf){ //tail index v_min_index = VIDV_UINT(gvl); v_min_index = VADDVX_UINT(v_min_index, j, gvl); @@ -185,7 +185,7 @@ BLASLONG CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) v_res = VFREDMINVS_FLOAT(v_min, v_res, gvl); FLOAT cur_minf = EXTRACT_FLOAT(v_res); - if(cur_minf > minf){ + if(cur_minf < minf){ //tail index v_min_index = VIDV_UINT(gvl); v_min_index = VADDVX_UINT(v_min_index, j, gvl); diff --git a/kernel/riscv64/izamin_vector.c b/kernel/riscv64/izamin_vector.c index a3877a46c..c76a38099 100644 --- a/kernel/riscv64/izamin_vector.c +++ b/kernel/riscv64/izamin_vector.c @@ -156,7 +156,7 @@ BLASLONG CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) v_res = VFREDMINVS_FLOAT(v_min, v_res, gvl); FLOAT cur_minf = EXTRACT_FLOAT(v_res); - if(cur_minf > minf){ + if(cur_minf < minf){ //tail index v_min_index = VIDV_UINT(gvl); v_min_index = VADDVX_UINT(v_min_index, j, gvl); diff --git a/kernel/riscv64/nrm2_vector.c b/kernel/riscv64/nrm2_vector.c index 141dffebf..5c03fbec7 100644 --- a/kernel/riscv64/nrm2_vector.c +++ b/kernel/riscv64/nrm2_vector.c @@ -104,7 +104,7 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) { BLASLONG i=0; - if(n <= 0) return(0.0); + if (n <= 0 || inc_x <= 0) return(0.0); if(n == 1) return (ABS(x[0])); unsigned int gvl = 0; diff --git a/kernel/riscv64/nrm2_vector_dot.c b/kernel/riscv64/nrm2_vector_dot.c index 06e61d695..dfa13a6f5 100644 --- a/kernel/riscv64/nrm2_vector_dot.c +++ b/kernel/riscv64/nrm2_vector_dot.c @@ -61,7 +61,7 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) BLASLONG i=0, j=0; double len = 0.0 ; - if ( n < 0 ) return(0.0); + if ( n <= 0 ) return(0.0); if(n == 1) return (ABS(x[0])); FLOAT_V_T vr, v0, v1; diff --git a/kernel/riscv64/swap_vector.c b/kernel/riscv64/swap_vector.c index 3b467a586..f583f5392 100644 --- a/kernel/riscv64/swap_vector.c +++ b/kernel/riscv64/swap_vector.c @@ -67,7 +67,7 @@ int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT dummy3, FLOAT *x, BLASLONG stride_x, stride_y; FLOAT_V_T vx0, vx1, vy0, vy1; - if (n < 0) return(0); + if (n <= 0) return(0); unsigned int gvl = VSETVL((inc_x != 0 && inc_y != 0) ? n : 1); if( inc_x == 0 && inc_y == 0 ) { n = n & 1; } diff --git a/kernel/riscv64/zamax_vector.c b/kernel/riscv64/zamax_vector.c index 2dee5ab29..ec4a5a1e9 100644 --- a/kernel/riscv64/zamax_vector.c +++ b/kernel/riscv64/zamax_vector.c @@ -60,17 +60,15 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VLSEV_FLOAT JOIN(RISCV_RVV(vlse), ELEN, _v_f, ELEN, LMUL) #ifdef RISCV_0p10_INTRINSICS #define VFREDMAXVS_FLOAT(va,vb,gvl) JOIN(RISCV_RVV(vfredmax_vs_f), ELEN, LMUL, _f, JOIN2( ELEN, m1)) (v_res, va, vb, gvl) -#define VFRSUBVF_MASK_FLOAT(va,vb,c,gvl) JOIN(RISCV_RVV(vfrsub),_vf_f, ELEN, LMUL, _m) (va, vb, vb, c, gvl) #else #define VFREDMAXVS_FLOAT JOIN(RISCV_RVV(vfredmax_vs_f), ELEN, LMUL, _f, JOIN2( ELEN, m1)) -#define VFRSUBVF_MASK_FLOAT JOIN(RISCV_RVV(vfrsub),_vf_f, ELEN, LMUL, _m) #endif #define MASK_T JOIN(vbool, MLEN, _t, _, _) -#define VMFLTVF_FLOAT JOIN(RISCV_RVV(vmflt_vf_f), ELEN, LMUL, _b, MLEN) #define VFMVVF_FLOAT JOIN(RISCV_RVV(vfmv), _v_f_f, ELEN, LMUL, _) #define VFMVVF_FLOAT_M1 JOIN(RISCV_RVV(vfmv), _v_f_f, ELEN, m1, _) #define VFMAXVV_FLOAT JOIN(RISCV_RVV(vfmax), _vv_f, ELEN, LMUL, _) #define VFADDVV_FLOAT JOIN(RISCV_RVV(vfadd), _vv_f, ELEN, LMUL, _) +#define VFABSV_FLOAT JOIN(RISCV_RVV(vfabs), _v_f, ELEN, LMUL, _) FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) { @@ -91,10 +89,9 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) for(; i Date: Tue, 23 Jan 2024 17:15:53 +0100 Subject: [PATCH 082/311] reset "mem structure overflowed" state on shutdown --- driver/others/memory.c | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/driver/others/memory.c b/driver/others/memory.c index caef3e2b7..4ee8f9a2e 100644 --- a/driver/others/memory.c +++ b/driver/others/memory.c @@ -3214,7 +3214,7 @@ void blas_shutdown(void){ #endif memory[pos].lock = 0; } - if (memory_overflowed) + if (memory_overflowed) { for (pos = 0; pos < NEW_BUFFERS; pos ++){ newmemory[pos].addr = (void *)0; newmemory[pos].used = 0; @@ -3222,6 +3222,10 @@ void blas_shutdown(void){ newmemory[pos].pos = -1; #endif newmemory[pos].lock = 0; + } + free(newmemory); + newmemory = NULL; + memory_overflowed = 0; } UNLOCK_COMMAND(&alloc_lock); From 86943afa9cb96a49ad036c1a484390967b322b5e Mon Sep 17 00:00:00 2001 From: kseniyazaytseva Date: Wed, 24 Jan 2024 10:53:13 +0300 Subject: [PATCH 083/311] Fix x280 taget include riscv_vector.h --- common_riscv64.h | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/common_riscv64.h b/common_riscv64.h index 4b5f7dcc4..ab3bfa25a 100644 --- a/common_riscv64.h +++ b/common_riscv64.h @@ -91,7 +91,7 @@ static inline int blas_quickdivide(blasint x, blasint y){ #define BUFFER_SIZE ( 32 << 20) #define SEEK_ADDRESS -#if defined(C910V) || (defined(RISCV64_ZVL256B) && (defined(__clang__) || defined(RVV_COMPATIBLE_GCC))) || defined(RISCV64_ZVL128B) +#if defined(C910V) || (defined(RISCV64_ZVL256B) && (defined(__clang__) || defined(RVV_COMPATIBLE_GCC))) || defined(RISCV64_ZVL128B) || defined(x280) # include #endif From 73530b03fa6ecd03e7ceb2b37c234a0bb1626445 Mon Sep 17 00:00:00 2001 From: Andrey Sokolov Date: Wed, 24 Jan 2024 11:38:14 +0300 Subject: [PATCH 084/311] remove RISCV64_ZVL256B additional extentions --- Makefile.prebuild | 2 +- Makefile.riscv64 | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/Makefile.prebuild b/Makefile.prebuild index 7824e15a8..98acca80e 100644 --- a/Makefile.prebuild +++ b/Makefile.prebuild @@ -60,7 +60,7 @@ TARGET_FLAGS = -march=rv64imafdcv_zba_zbb_zfh -mabi=lp64d endif ifeq ($(TARGET), RISCV64_ZVL256B) -TARGET_FLAGS = -march=rv64imafdcv_zba_zbb_zfh -mabi=lp64d +TARGET_FLAGS = -march=rv64imafdcv -mabi=lp64d endif ifeq ($(TARGET), RISCV64_ZVL128B) diff --git a/Makefile.riscv64 b/Makefile.riscv64 index 9d314d074..113cc57c5 100644 --- a/Makefile.riscv64 +++ b/Makefile.riscv64 @@ -7,8 +7,8 @@ CCOMMON_OPT += -march=rv64imafdcv_zba_zbb_zfh_zvl512b -mabi=lp64d -ffast-math FCOMMON_OPT += -march=rv64imafdcv_zba_zbb_zfh -mabi=lp64d -static endif ifeq ($(CORE), RISCV64_ZVL256B) -CCOMMON_OPT += -march=rv64imafdcv_zba_zbb_zfh_zvl256b -mabi=lp64d -FCOMMON_OPT += -march=rv64imafdcv_zba_zbb_zfh -mabi=lp64d -static +CCOMMON_OPT += -march=rv64imafdcv_zvl256b -mabi=lp64d +FCOMMON_OPT += -march=rv64imafdcv -mabi=lp64d -static endif ifeq ($(CORE), RISCV64_ZVL128B) CCOMMON_OPT += -march=rv64imafdcv -mabi=lp64d From 276e3ebf9e1405196d36c2570bce8376b8bad2fd Mon Sep 17 00:00:00 2001 From: gxw Date: Fri, 26 Jan 2024 10:03:50 +0800 Subject: [PATCH 085/311] LoongArch64: Add dzamax and dzamin opt --- kernel/loongarch64/KERNEL.LOONGSON2K1000 | 2 + kernel/loongarch64/KERNEL.LOONGSON3R5 | 2 + kernel/loongarch64/camax_lasx.S | 150 +++++++++------- kernel/loongarch64/camax_lsx.S | 195 ++++++++++++--------- kernel/loongarch64/camin_lasx.S | 164 ++++++++++-------- kernel/loongarch64/camin_lsx.S | 209 +++++++++++++---------- 6 files changed, 418 insertions(+), 304 deletions(-) diff --git a/kernel/loongarch64/KERNEL.LOONGSON2K1000 b/kernel/loongarch64/KERNEL.LOONGSON2K1000 index c365e9a75..e27ce3bee 100644 --- a/kernel/loongarch64/KERNEL.LOONGSON2K1000 +++ b/kernel/loongarch64/KERNEL.LOONGSON2K1000 @@ -14,10 +14,12 @@ ZSCALKERNEL = cscal_lsx.S SAMAXKERNEL = amax_lsx.S DAMAXKERNEL = amax_lsx.S CAMAXKERNEL = camax_lsx.S +ZAMAXKERNEL = camax_lsx.S SAMINKERNEL = amin_lsx.S DAMINKERNEL = amin_lsx.S CAMINKERNEL = camin_lsx.S +ZAMINKERNEL = camin_lsx.S SMAXKERNEL = max_lsx.S DMAXKERNEL = max_lsx.S diff --git a/kernel/loongarch64/KERNEL.LOONGSON3R5 b/kernel/loongarch64/KERNEL.LOONGSON3R5 index 68360faaf..f4429cfba 100644 --- a/kernel/loongarch64/KERNEL.LOONGSON3R5 +++ b/kernel/loongarch64/KERNEL.LOONGSON3R5 @@ -14,10 +14,12 @@ ZSCALKERNEL = cscal_lasx.S SAMAXKERNEL = amax_lasx.S DAMAXKERNEL = amax_lasx.S CAMAXKERNEL = camax_lasx.S +ZAMAXKERNEL = camax_lasx.S SAMINKERNEL = amin_lasx.S DAMINKERNEL = amin_lasx.S CAMINKERNEL = camin_lasx.S +ZAMINKERNEL = camin_lasx.S SMAXKERNEL = max_lsx.S DMAXKERNEL = max_lsx.S diff --git a/kernel/loongarch64/camax_lasx.S b/kernel/loongarch64/camax_lasx.S index 7013430cb..f9a4e9012 100644 --- a/kernel/loongarch64/camax_lasx.S +++ b/kernel/loongarch64/camax_lasx.S @@ -63,42 +63,60 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. bge $r0, N, .L999 bge $r0, INCX, .L999 li.d TEMP, 1 - li.w I, -1 slli.d TEMP, TEMP, ZBASE_SHIFT slli.d INCX, INCX, ZBASE_SHIFT - xvreplgr2vr.w neg1, I - xvffint.s.w neg1, neg1 srai.d I, N, 3 bne INCX, TEMP, .L20 bge $r0, I, .L23 .align 3 .L10: - xvld VX0, X, 0 * SIZE - xvld VX1, X, 8 * SIZE - addi.d I, I, -1 + xvld VX0, X, 0 + xvld VX1, X, 32 +#ifdef DOUBLE + xvpickev.d x1, VX1, VX0 + xvpickod.d x2, VX1, VX0 +#else xvpickev.w x1, VX1, VX0 xvpickod.w x2, VX1, VX0 - xvfmul.s x3, neg1, x1 - xvfmul.s x4, neg1, x2 - xvfcmp.clt.s VT0, x1, res0 - xvfcmp.clt.s VT1, x2, res0 - xvbitsel.v x1, x1, x3, VT0 - xvbitsel.v x2, x2, x4, VT1 +#endif + XVFSUB x3, res0, x1 + XVFSUB x4, res0, x2 + XVFMAX x1, x1, x3 + XVFMAX x2, x2, x4 + XVFADD VM1, x1, x2 + XVFMAX VM0, VM0, VM1 +#ifdef DOUBLE + xvld VX0, X, 64 + xvld VX1, X, 96 + xvpickev.d x1, VX1, VX0 + xvpickod.d x2, VX1, VX0 + XVFSUB x3, res0, x1 + XVFSUB x4, res0, x2 + XVFMAX x1, x1, x3 + XVFMAX x2, x2, x4 + XVFADD VM1, x1, x2 + XVFMAX VM0, VM0, VM1 +#endif + addi.d I, I, -1 addi.d X, X, 16 * SIZE - xvfadd.s VM1, x1, x2 - xvfmax.s VM0, VM0, VM1 blt $r0, I, .L10 .align 3 .L11: +#ifdef DOUBLE + xvpickve.d x1, VM0, 0 + xvpickve.d x2, VM0, 1 + XVFMAX VM0, x1, x2 +#else xvpickve.w x1, VM0, 0 xvpickve.w x2, VM0, 1 xvpickve.w x3, VM0, 2 xvpickve.w x4, VM0, 3 - xvfmax.s VM1, x1, x2 - xvfmax.s VM0, x3, x4 - xvfmax.s VM0, VM0, VM1 + XVFMAX VM0, x1, x2 + XVFMAX VM1, x3, x4 + XVFMAX VM0, VM0, VM1 +#endif b .L23 .align 3 @@ -107,66 +125,66 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. .align 3 .L21: - fld.s t1, X, 0 * SIZE - fld.s t2, X, 1 * SIZE + LD t1, X, 0 * SIZE + LD t2, X, 1 * SIZE add.d X, X, INCX - fld.s t3, X, 0 * SIZE - fld.s t4, X, 1 * SIZE + LD t3, X, 0 * SIZE + LD t4, X, 1 * SIZE add.d X, X, INCX - fabs.s t1, t1 - fabs.s t2, t2 - fabs.s t3, t3 - fabs.s t4, t4 - fadd.s t1, t1, t2 - fadd.s t3, t3, t4 - fmax.s s1, t1, t3 - fld.s t1, X, 0 * SIZE - fld.s t2, X, 1 * SIZE + FABS t1, t1 + FABS t2, t2 + FABS t3, t3 + FABS t4, t4 + ADD t1, t1, t2 + ADD t3, t3, t4 + FMAX s1, t1, t3 + LD t1, X, 0 * SIZE + LD t2, X, 1 * SIZE add.d X, X, INCX - fld.s t3, X, 0 * SIZE - fld.s t4, X, 1 * SIZE + LD t3, X, 0 * SIZE + LD t4, X, 1 * SIZE add.d X, X, INCX - fabs.s t1, t1 - fabs.s t2, t2 - fabs.s t3, t3 - fabs.s t4, t4 - fadd.s t1, t1, t2 - fadd.s t3, t3, t4 - fmax.s s1, t1, t3 - fld.s t1, X, 0 * SIZE - fld.s t2, X, 1 * SIZE + FABS t1, t1 + FABS t2, t2 + FABS t3, t3 + FABS t4, t4 + ADD t1, t1, t2 + ADD t3, t3, t4 + FMAX s1, t1, t3 + LD t1, X, 0 * SIZE + LD t2, X, 1 * SIZE add.d X, X, INCX - fld.s t3, X, 0 * SIZE - fld.s t4, X, 1 * SIZE + LD t3, X, 0 * SIZE + LD t4, X, 1 * SIZE add.d X, X, INCX - fabs.s t1, t1 - fabs.s t2, t2 - fabs.s t3, t3 - fabs.s t4, t4 + FABS t1, t1 + FABS t2, t2 + FABS t3, t3 + FABS t4, t4 addi.d I, I, -1 - fadd.s t1, t1, t2 - fadd.s t3, t3, t4 - fmax.s s3, t1, t3 - fld.s t1, X, 0 * SIZE - fld.s t2, X, 1 * SIZE + ADD t1, t1, t2 + ADD t3, t3, t4 + FMAX s3, t1, t3 + LD t1, X, 0 * SIZE + LD t2, X, 1 * SIZE add.d X, X, INCX - fld.s t3, X, 0 * SIZE - fld.s t4, X, 1 * SIZE + LD t3, X, 0 * SIZE + LD t4, X, 1 * SIZE add.d X, X, INCX - fabs.s t1, t1 - fabs.s t2, t2 - fabs.s t3, t3 - fabs.s t4, t4 - fadd.s t1, t1, t2 - fadd.s t3, t3, t4 - fmax.s s4, t1, t3 + FABS t1, t1 + FABS t2, t2 + FABS t3, t3 + FABS t4, t4 + ADD t1, t1, t2 + ADD t3, t3, t4 + FMAX s4, t1, t3 blt $r0, I, .L21 .align 3 .L22: - fmax.s s1, s1, s2 - fmax.s s3, s3, s4 - fmax.s s1, s1, s3 + FMAX s1, s1, s2 + FMAX s3, s3, s4 + FMAX s1, s1, s3 .align 3 .L23: //N<8 @@ -182,12 +200,12 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. FABS a1, a1 ADD a0, a0, a1 add.d X, X, INCX - fmax.s s1, a0, s1 + FMAX s1, a0, s1 blt $r0, I, .L24 .align 3 .L999: - fmov.s $f0, $f22 + MOV $f0, $f22 jirl $r0, $r1, 0x0 .align 3 diff --git a/kernel/loongarch64/camax_lsx.S b/kernel/loongarch64/camax_lsx.S index 2e55629de..cf46cb016 100644 --- a/kernel/loongarch64/camax_lsx.S +++ b/kernel/loongarch64/camax_lsx.S @@ -63,54 +63,87 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. bge $r0, N, .L999 bge $r0, INCX, .L999 li.d TEMP, 1 - li.w I, -1 slli.d TEMP, TEMP, ZBASE_SHIFT slli.d INCX, INCX, ZBASE_SHIFT - vreplgr2vr.w neg1, I - vffint.s.w neg1, neg1 srai.d I, N, 3 bne INCX, TEMP, .L20 bge $r0, I, .L23 .align 3 .L10: - vld VX0, X, 0 * SIZE - vld VX1, X, 4 * SIZE - addi.d I, I, -1 + vld VX0, X, 0 + vld VX1, X, 16 +#ifdef DOUBLE + vpickev.d x1, VX1, VX0 + vpickod.d x2, VX1, VX0 +#else vpickev.w x1, VX1, VX0 vpickod.w x2, VX1, VX0 - vfmul.s x3, neg1, x1 - vfmul.s x4, neg1, x2 - vfcmp.clt.s VT0, x1, res0 - vfcmp.clt.s VT1, x2, res0 - vld VX0, X, 8 * SIZE - vbitsel.v x1, x1, x3, VT0 - vbitsel.v x2, x2, x4, VT1 - vld VX1, X, 12 * SIZE - vfadd.s VM1, x1, x2 +#endif + VFSUB x3, res0, x1 + VFSUB x4, res0, x2 + VFMAX x1, x1, x3 + VFMAX x2, x2, x4 + VFADD VM1, x1, x2 + + vld VX0, X, 32 + vld VX1, X, 48 +#ifdef DOUBLE + vpickev.d x1, VX1, VX0 + vpickod.d x2, VX1, VX0 +#else vpickev.w x1, VX1, VX0 vpickod.w x2, VX1, VX0 - vfmul.s x3, neg1, x1 - vfmul.s x4, neg1, x2 - vfcmp.clt.s VT0, x1, res0 - vfcmp.clt.s VT1, x2, res0 +#endif + VFSUB x3, res0, x1 + VFSUB x4, res0, x2 + VFMAX x1, x1, x3 + VFMAX x2, x2, x4 + VFADD x1, x1, x2 + VFMAX VM1, x1, VM1 + VFMAX VM0, VM0, VM1 +#ifdef DOUBLE + vld VX0, X, 64 + vld VX1, X, 80 + vpickev.d x1, VX1, VX0 + vpickod.d x2, VX1, VX0 + VFSUB x3, res0, x1 + VFSUB x4, res0, x2 + VFMAX x1, x1, x3 + VFMAX x2, x2, x4 + VFADD VM1, x1, x2 + + vld VX0, X, 96 + vld VX1, X, 112 + vpickev.d x1, VX1, VX0 + vpickod.d x2, VX1, VX0 + VFSUB x3, res0, x1 + VFSUB x4, res0, x2 + VFMAX x1, x1, x3 + VFMAX x2, x2, x4 + VFADD x1, x1, x2 + VFMAX VM1, x1, VM1 + VFMAX VM0, VM0, VM1 +#endif addi.d X, X, 16 * SIZE - vbitsel.v x1, x1, x3, VT0 - vbitsel.v x2, x2, x4, VT1 - vfadd.s x1, x1, x2 - vfmax.s VM1, x1, VM1 - vfmax.s VM0, VM0, VM1 + addi.d I, I, -1 blt $r0, I, .L10 .align 3 .L11: +#ifdef DOUBLE + vreplvei.d x1, VM0, 0 + vreplvei.d x2, VM0, 1 + VFMAX VM0, x1, x2 +#else vreplvei.w x1, VM0, 0 vreplvei.w x2, VM0, 1 vreplvei.w x3, VM0, 2 vreplvei.w x4, VM0, 3 - vfmax.s VM1, x1, x2 - vfmax.s VM0, x3, x4 - vfmax.s VM0, VM0, VM1 + VFMAX VM1, x1, x2 + VFMAX VM0, x3, x4 + VFMAX VM0, VM0, VM1 +#endif b .L23 .align 3 @@ -119,66 +152,66 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. .align 3 .L21: - fld.s t1, X, 0 * SIZE - fld.s t2, X, 1 * SIZE + LD t1, X, 0 * SIZE + LD t2, X, 1 * SIZE add.d X, X, INCX - fld.s t3, X, 0 * SIZE - fld.s t4, X, 1 * SIZE + LD t3, X, 0 * SIZE + LD t4, X, 1 * SIZE add.d X, X, INCX - fabs.s t1, t1 - fabs.s t2, t2 - fabs.s t3, t3 - fabs.s t4, t4 - fadd.s t1, t1, t2 - fadd.s t3, t3, t4 - fmax.s s1, t1, t3 - fld.s t1, X, 0 * SIZE - fld.s t2, X, 1 * SIZE + FABS t1, t1 + FABS t2, t2 + FABS t3, t3 + FABS t4, t4 + ADD t1, t1, t2 + ADD t3, t3, t4 + FMAX s1, t1, t3 + LD t1, X, 0 * SIZE + LD t2, X, 1 * SIZE add.d X, X, INCX - fld.s t3, X, 0 * SIZE - fld.s t4, X, 1 * SIZE + LD t3, X, 0 * SIZE + LD t4, X, 1 * SIZE add.d X, X, INCX - fabs.s t1, t1 - fabs.s t2, t2 - fabs.s t3, t3 - fabs.s t4, t4 - fadd.s t1, t1, t2 - fadd.s t3, t3, t4 - fmax.s s1, t1, t3 - fld.s t1, X, 0 * SIZE - fld.s t2, X, 1 * SIZE + FABS t1, t1 + FABS t2, t2 + FABS t3, t3 + FABS t4, t4 + ADD t1, t1, t2 + ADD t3, t3, t4 + FMAX s1, t1, t3 + LD t1, X, 0 * SIZE + LD t2, X, 1 * SIZE add.d X, X, INCX - fld.s t3, X, 0 * SIZE - fld.s t4, X, 1 * SIZE + LD t3, X, 0 * SIZE + LD t4, X, 1 * SIZE add.d X, X, INCX - fabs.s t1, t1 - fabs.s t2, t2 - fabs.s t3, t3 - fabs.s t4, t4 + FABS t1, t1 + FABS t2, t2 + FABS t3, t3 + FABS t4, t4 addi.d I, I, -1 - fadd.s t1, t1, t2 - fadd.s t3, t3, t4 - fmax.s s3, t1, t3 - fld.s t1, X, 0 * SIZE - fld.s t2, X, 1 * SIZE + ADD t1, t1, t2 + ADD t3, t3, t4 + FMAX s3, t1, t3 + LD t1, X, 0 * SIZE + LD t2, X, 1 * SIZE add.d X, X, INCX - fld.s t3, X, 0 * SIZE - fld.s t4, X, 1 * SIZE + LD t3, X, 0 * SIZE + LD t4, X, 1 * SIZE add.d X, X, INCX - fabs.s t1, t1 - fabs.s t2, t2 - fabs.s t3, t3 - fabs.s t4, t4 - fadd.s t1, t1, t2 - fadd.s t3, t3, t4 - fmax.s s4, t1, t3 + FABS t1, t1 + FABS t2, t2 + FABS t3, t3 + FABS t4, t4 + ADD t1, t1, t2 + ADD t3, t3, t4 + FMAX s4, t1, t3 blt $r0, I, .L21 .align 3 .L22: - fmax.s s1, s1, s2 - fmax.s s3, s3, s4 - fmax.s s1, s1, s3 + FMAX s1, s1, s2 + FMAX s3, s3, s4 + FMAX s1, s1, s3 .align 3 .L23: //N<8 @@ -187,19 +220,19 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. .align 3 .L24: - fld.s a0, X, 0 * SIZE - fld.s a1, X, 1 * SIZE + LD a0, X, 0 * SIZE + LD a1, X, 1 * SIZE addi.d I, I, -1 - fabs.s a0, a0 - fabs.s a1, a1 - fadd.s a0, a0, a1 + FABS a0, a0 + FABS a1, a1 + ADD a0, a0, a1 add.d X, X, INCX - fmax.s s1, a0, s1 + FMAX s1, a0, s1 blt $r0, I, .L24 .align 3 .L999: - fmov.s $f0, $f22 + MOV $f0, $f22 jirl $r0, $r1, 0x0 .align 3 diff --git a/kernel/loongarch64/camin_lasx.S b/kernel/loongarch64/camin_lasx.S index d7931d30a..c1c4c98c8 100644 --- a/kernel/loongarch64/camin_lasx.S +++ b/kernel/loongarch64/camin_lasx.S @@ -61,49 +61,71 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. xvxor.v res0, res0, res0 bge $r0, N, .L999 bge $r0, INCX, .L999 - fld.s a0, X, 0 * SIZE - fld.s a1, X, 1 * SIZE - fabs.s a0, a0 - fabs.s a1, a1 - fadd.s s1, a1, a0 + LD a0, X, 0 * SIZE + LD a1, X, 1 * SIZE + FABS a0, a0 + FABS a1, a1 + ADD s1, a1, a0 +#ifdef DOUBLE + xvreplve0.d VM0, VM0 +#else xvreplve0.w VM0, VM0 +#endif li.d TEMP, 1 - li.w I, -1 slli.d TEMP, TEMP, ZBASE_SHIFT slli.d INCX, INCX, ZBASE_SHIFT - xvreplgr2vr.w neg1, I - xvffint.s.w neg1, neg1 srai.d I, N, 3 bne INCX, TEMP, .L20 bge $r0, I, .L23 .align 3 .L10: - xvld VX0, X, 0 * SIZE - xvld VX1, X, 8 * SIZE - addi.d I, I, -1 + xvld VX0, X, 0 + xvld VX1, X, 32 +#ifdef DOUBLE + xvpickev.d x1, VX1, VX0 + xvpickod.d x2, VX1, VX0 +#else xvpickev.w x1, VX1, VX0 xvpickod.w x2, VX1, VX0 - xvfmul.s x3, neg1, x1 - xvfmul.s x4, neg1, x2 - xvfcmp.clt.s VT0, x1, res0 - xvfcmp.clt.s VT1, x2, res0 - xvbitsel.v x1, x1, x3, VT0 - xvbitsel.v x2, x2, x4, VT1 +#endif + XVFSUB x3, res0, x1 + XVFSUB x4, res0, x2 + XVFMAX x1, x1, x3 + XVFMAX x2, x2, x4 + XVFADD VM1, x1, x2 + XVFMIN VM0, VM0, VM1 +#ifdef DOUBLE + xvld VX0, X, 64 + xvld VX1, X, 96 + xvpickev.d x1, VX1, VX0 + xvpickod.d x2, VX1, VX0 + XVFSUB x3, res0, x1 + XVFSUB x4, res0, x2 + XVFMAX x1, x1, x3 + XVFMAX x2, x2, x4 + XVFADD VM1, x1, x2 + XVFMIN VM0, VM0, VM1 +#endif + addi.d I, I, -1 addi.d X, X, 16 * SIZE - xvfadd.s VM1, x1, x2 - xvfmin.s VM0, VM0, VM1 blt $r0, I, .L10 .align 3 .L11: +#ifdef DOUBLE + xvpickve.d x1, VM0, 0 + xvpickve.d x2, VM0, 1 + XVFMIN VM0, x1, x2 +#else xvpickve.w x1, VM0, 0 xvpickve.w x2, VM0, 1 xvpickve.w x3, VM0, 2 xvpickve.w x4, VM0, 3 - xvfmin.s VM1, x1, x2 - xvfmin.s VM0, x3, x4 - xvfmin.s VM0, VM0, VM1 + XVFMIN VM0, x1, x2 + XVFMIN VM1, x3, x4 + XVFMIN VM0, VM0, VM1 +#endif b .L23 .align 3 @@ -112,66 +134,66 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. .align 3 .L21: - fld.s t1, X, 0 * SIZE - fld.s t2, X, 1 * SIZE + LD t1, X, 0 * SIZE + LD t2, X, 1 * SIZE add.d X, X, INCX - fld.s t3, X, 0 * SIZE - fld.s t4, X, 1 * SIZE + LD t3, X, 0 * SIZE + LD t4, X, 1 * SIZE add.d X, X, INCX - fabs.s t1, t1 - fabs.s t2, t2 - fabs.s t3, t3 - fabs.s t4, t4 - fadd.s t1, t1, t2 - fadd.s t3, t3, t4 - fmin.s s1, t1, t3 - fld.s t1, X, 0 * SIZE - fld.s t2, X, 1 * SIZE + FABS t1, t1 + FABS t2, t2 + FABS t3, t3 + FABS t4, t4 + ADD t1, t1, t2 + ADD t3, t3, t4 + FMIN s1, t1, t3 + LD t1, X, 0 * SIZE + LD t2, X, 1 * SIZE add.d X, X, INCX - fld.s t3, X, 0 * SIZE - fld.s t4, X, 1 * SIZE + LD t3, X, 0 * SIZE + LD t4, X, 1 * SIZE add.d X, X, INCX - fabs.s t1, t1 - fabs.s t2, t2 - fabs.s t3, t3 - fabs.s t4, t4 - fadd.s t1, t1, t2 - fadd.s t3, t3, t4 - fmin.s s1, t1, t3 - fld.s t1, X, 0 * SIZE - fld.s t2, X, 1 * SIZE + FABS t1, t1 + FABS t2, t2 + FABS t3, t3 + FABS t4, t4 + ADD t1, t1, t2 + ADD t3, t3, t4 + FMIN s1, t1, t3 + LD t1, X, 0 * SIZE + LD t2, X, 1 * SIZE add.d X, X, INCX - fld.s t3, X, 0 * SIZE - fld.s t4, X, 1 * SIZE + LD t3, X, 0 * SIZE + LD t4, X, 1 * SIZE add.d X, X, INCX - fabs.s t1, t1 - fabs.s t2, t2 - fabs.s t3, t3 - fabs.s t4, t4 + FABS t1, t1 + FABS t2, t2 + FABS t3, t3 + FABS t4, t4 addi.d I, I, -1 - fadd.s t1, t1, t2 - fadd.s t3, t3, t4 - fmin.s s3, t1, t3 - fld.s t1, X, 0 * SIZE - fld.s t2, X, 1 * SIZE + ADD t1, t1, t2 + ADD t3, t3, t4 + FMIN s3, t1, t3 + LD t1, X, 0 * SIZE + LD t2, X, 1 * SIZE add.d X, X, INCX - fld.s t3, X, 0 * SIZE - fld.s t4, X, 1 * SIZE + LD t3, X, 0 * SIZE + LD t4, X, 1 * SIZE add.d X, X, INCX - fabs.s t1, t1 - fabs.s t2, t2 - fabs.s t3, t3 - fabs.s t4, t4 - fadd.s t1, t1, t2 - fadd.s t3, t3, t4 - fmin.s s4, t1, t3 + FABS t1, t1 + FABS t2, t2 + FABS t3, t3 + FABS t4, t4 + ADD t1, t1, t2 + ADD t3, t3, t4 + FMIN s4, t1, t3 blt $r0, I, .L21 .align 3 .L22: - fmin.s s1, s1, s2 - fmin.s s3, s3, s4 - fmin.s s1, s1, s3 + FMIN s1, s1, s2 + FMIN s3, s3, s4 + FMIN s1, s1, s3 .align 3 .L23: //N<8 @@ -187,12 +209,12 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. FABS a1, a1 ADD a0, a0, a1 add.d X, X, INCX - fmin.s s1, a0, s1 + FMIN s1, a0, s1 blt $r0, I, .L24 .align 3 .L999: - fmov.s $f0, $f22 + MOV $f0, $f22 jirl $r0, $r1, 0x0 .align 3 diff --git a/kernel/loongarch64/camin_lsx.S b/kernel/loongarch64/camin_lsx.S index e9ad6b04d..ff666ea8f 100644 --- a/kernel/loongarch64/camin_lsx.S +++ b/kernel/loongarch64/camin_lsx.S @@ -61,61 +61,98 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. vxor.v res0, res0, res0 bge $r0, N, .L999 bge $r0, INCX, .L999 - fld.s a0, X, 0 * SIZE - fld.s a1, X, 1 * SIZE - fabs.s a0, a0 - fabs.s a1, a1 - fadd.s s1, a1, a0 + LD a0, X, 0 * SIZE + LD a1, X, 1 * SIZE + FABS a0, a0 + FABS a1, a1 + ADD s1, a1, a0 +#ifdef DOUBLE + vreplvei.d VM0, VM0, 0 +#else vreplvei.w VM0, VM0, 0 +#endif li.d TEMP, 1 - li.w I, -1 slli.d TEMP, TEMP, ZBASE_SHIFT slli.d INCX, INCX, ZBASE_SHIFT - vreplgr2vr.w neg1, I - vffint.s.w neg1, neg1 srai.d I, N, 3 bne INCX, TEMP, .L20 bge $r0, I, .L23 .align 3 .L10: - vld VX0, X, 0 * SIZE - vld VX1, X, 4 * SIZE - addi.d I, I, -1 + vld VX0, X, 0 + vld VX1, X, 16 +#ifdef DOUBLE + vpickev.d x1, VX1, VX0 + vpickod.d x2, VX1, VX0 +#else vpickev.w x1, VX1, VX0 vpickod.w x2, VX1, VX0 - vfmul.s x3, neg1, x1 - vfmul.s x4, neg1, x2 - vfcmp.clt.s VT0, x1, res0 - vfcmp.clt.s VT1, x2, res0 - vld VX0, X, 8 * SIZE - vbitsel.v x1, x1, x3, VT0 - vbitsel.v x2, x2, x4, VT1 - vld VX1, X, 12 * SIZE - vfadd.s VM1, x1, x2 +#endif + VFSUB x3, res0, x1 + VFSUB x4, res0, x2 + VFMAX x1, x1, x3 + VFMAX x2, x2, x4 + VFADD VM1, x1, x2 + + vld VX0, X, 32 + vld VX1, X, 48 +#ifdef DOUBLE + vpickev.d x1, VX1, VX0 + vpickod.d x2, VX1, VX0 +#else vpickev.w x1, VX1, VX0 vpickod.w x2, VX1, VX0 - vfmul.s x3, neg1, x1 - vfmul.s x4, neg1, x2 - vfcmp.clt.s VT0, x1, res0 - vfcmp.clt.s VT1, x2, res0 +#endif + VFSUB x3, res0, x1 + VFSUB x4, res0, x2 + VFMAX x1, x1, x3 + VFMAX x2, x2, x4 + VFADD x1, x1, x2 + VFMIN VM1, x1, VM1 + VFMIN VM0, VM0, VM1 +#ifdef DOUBLE + vld VX0, X, 64 + vld VX1, X, 80 + vpickev.d x1, VX1, VX0 + vpickod.d x2, VX1, VX0 + VFSUB x3, res0, x1 + VFSUB x4, res0, x2 + VFMAX x1, x1, x3 + VFMAX x2, x2, x4 + VFADD VM1, x1, x2 + + vld VX0, X, 96 + vld VX1, X, 112 + vpickev.d x1, VX1, VX0 + vpickod.d x2, VX1, VX0 + VFSUB x3, res0, x1 + VFSUB x4, res0, x2 + VFMAX x1, x1, x3 + VFMAX x2, x2, x4 + VFADD x1, x1, x2 + VFMIN VM1, x1, VM1 + VFMIN VM0, VM0, VM1 +#endif + addi.d I, I, -1 addi.d X, X, 16 * SIZE - vbitsel.v x1, x1, x3, VT0 - vbitsel.v x2, x2, x4, VT1 - vfadd.s x1, x1, x2 - vfmin.s VM1, x1, VM1 - vfmin.s VM0, VM0, VM1 blt $r0, I, .L10 .align 3 .L11: +#ifdef DOUBLE + vreplvei.d x1, VM0, 0 + vreplvei.d x2, VM0, 1 + VFMIN VM0, x1, x2 +#else vreplvei.w x1, VM0, 0 vreplvei.w x2, VM0, 1 vreplvei.w x3, VM0, 2 vreplvei.w x4, VM0, 3 - vfmin.s VM1, x1, x2 - vfmin.s VM0, x3, x4 - vfmin.s VM0, VM0, VM1 + VFMIN VM1, x1, x2 + VFMIN VM0, x3, x4 + VFMIN VM0, VM0, VM1 +#endif b .L23 .align 3 @@ -124,66 +161,66 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. .align 3 .L21: - fld.s t1, X, 0 * SIZE - fld.s t2, X, 1 * SIZE + LD t1, X, 0 * SIZE + LD t2, X, 1 * SIZE add.d X, X, INCX - fld.s t3, X, 0 * SIZE - fld.s t4, X, 1 * SIZE + LD t3, X, 0 * SIZE + LD t4, X, 1 * SIZE add.d X, X, INCX - fabs.s t1, t1 - fabs.s t2, t2 - fabs.s t3, t3 - fabs.s t4, t4 - fadd.s t1, t1, t2 - fadd.s t3, t3, t4 - fmin.s s1, t1, t3 - fld.s t1, X, 0 * SIZE - fld.s t2, X, 1 * SIZE + FABS t1, t1 + FABS t2, t2 + FABS t3, t3 + FABS t4, t4 + ADD t1, t1, t2 + ADD t3, t3, t4 + FMIN s1, t1, t3 + LD t1, X, 0 * SIZE + LD t2, X, 1 * SIZE add.d X, X, INCX - fld.s t3, X, 0 * SIZE - fld.s t4, X, 1 * SIZE + LD t3, X, 0 * SIZE + LD t4, X, 1 * SIZE add.d X, X, INCX - fabs.s t1, t1 - fabs.s t2, t2 - fabs.s t3, t3 - fabs.s t4, t4 - fadd.s t1, t1, t2 - fadd.s t3, t3, t4 - fmin.s s1, t1, t3 - fld.s t1, X, 0 * SIZE - fld.s t2, X, 1 * SIZE + FABS t1, t1 + FABS t2, t2 + FABS t3, t3 + FABS t4, t4 + ADD t1, t1, t2 + ADD t3, t3, t4 + FMIN s1, t1, t3 + LD t1, X, 0 * SIZE + LD t2, X, 1 * SIZE add.d X, X, INCX - fld.s t3, X, 0 * SIZE - fld.s t4, X, 1 * SIZE + LD t3, X, 0 * SIZE + LD t4, X, 1 * SIZE add.d X, X, INCX - fabs.s t1, t1 - fabs.s t2, t2 - fabs.s t3, t3 - fabs.s t4, t4 + FABS t1, t1 + FABS t2, t2 + FABS t3, t3 + FABS t4, t4 addi.d I, I, -1 - fadd.s t1, t1, t2 - fadd.s t3, t3, t4 - fmin.s s3, t1, t3 - fld.s t1, X, 0 * SIZE - fld.s t2, X, 1 * SIZE + ADD t1, t1, t2 + ADD t3, t3, t4 + FMIN s3, t1, t3 + LD t1, X, 0 * SIZE + LD t2, X, 1 * SIZE add.d X, X, INCX - fld.s t3, X, 0 * SIZE - fld.s t4, X, 1 * SIZE + LD t3, X, 0 * SIZE + LD t4, X, 1 * SIZE add.d X, X, INCX - fabs.s t1, t1 - fabs.s t2, t2 - fabs.s t3, t3 - fabs.s t4, t4 - fadd.s t1, t1, t2 - fadd.s t3, t3, t4 - fmin.s s4, t1, t3 + FABS t1, t1 + FABS t2, t2 + FABS t3, t3 + FABS t4, t4 + ADD t1, t1, t2 + ADD t3, t3, t4 + FMIN s4, t1, t3 blt $r0, I, .L21 .align 3 .L22: - fmin.s s1, s1, s2 - fmin.s s3, s3, s4 - fmin.s s1, s1, s3 + FMIN s1, s1, s2 + FMIN s3, s3, s4 + FMIN s1, s1, s3 .align 3 .L23: //N<8 @@ -192,19 +229,19 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. .align 3 .L24: - fld.s a0, X, 0 * SIZE - fld.s a1, X, 1 * SIZE + LD a0, X, 0 * SIZE + LD a1, X, 1 * SIZE addi.d I, I, -1 - fabs.s a0, a0 - fabs.s a1, a1 - fadd.s a0, a0, a1 + FABS a0, a0 + FABS a1, a1 + ADD a0, a0, a1 add.d X, X, INCX - fmin.s s1, a0, s1 + FMIN s1, a0, s1 blt $r0, I, .L24 .align 3 .L999: - fmov.s $f0, $f22 + MOV $f0, $f22 jirl $r0, $r1, 0x0 .align 3 From ec2aa32eb069a8aa9b2013c1f6af6b4cddb1b0dc Mon Sep 17 00:00:00 2001 From: Mark Ryan Date: Thu, 25 Jan 2024 15:20:58 +0000 Subject: [PATCH 086/311] Fix crash in cpuid_riscv64.c The crash is reproducible when building OpenBLAS without forcing a target in a riscv64 container running on an X86_64 machine with an older version of QEMU, e.g., 7.0.0, registered with binfmt_misc to run riscv64 binaries. With this setup, cat /proc/cpuinfo in the container returns the cpu information for the host, which contains a "model name" string, and we execute the buggy code. The code in question is searching in an uninitialised buffer for the ':' character and doesn't check to see whether it was found or not. This can result in pmodel containing the pointer value 1 and a crash when pmodel is defererenced. The algorithm to detect the C910V CPU has not been modified, merely fixed to prevent the crash. A few additional checks for NULL pointers are added to improve the robustness of the code and a whitespace error is corrected. --- cpuid_riscv64.c | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) diff --git a/cpuid_riscv64.c b/cpuid_riscv64.c index 894d2b873..7e08af831 100644 --- a/cpuid_riscv64.c +++ b/cpuid_riscv64.c @@ -86,23 +86,29 @@ int detect(void){ char *pmodel = NULL, *pisa = NULL; infile = fopen("/proc/cpuinfo", "r"); + if (!infile) + return CPU_GENERIC; while (fgets(buffer, sizeof(buffer), infile)){ if(!strncmp(buffer, "model name", 10)){ strcpy(model_buffer, buffer); - pmodel = strchr(isa_buffer, ':') + 1; + pmodel = strchr(model_buffer, ':'); + if (pmodel) + pmodel++; } if(!strncmp(buffer, "isa", 3)){ strcpy(isa_buffer, buffer); - pisa = strchr(isa_buffer, '4') + 1; + pisa = strchr(isa_buffer, '4'); + if (pisa) + pisa++; } } fclose(infile); - if (!pmodel) + if (!pmodel || !pisa) return(CPU_GENERIC); - + if (strstr(pmodel, check_c910_str) && strchr(pisa, 'v')) return CPU_C910V; From e0b610d01ff4cdb44fd2453b7efa7f51ea84e575 Mon Sep 17 00:00:00 2001 From: Mark Ryan Date: Fri, 26 Jan 2024 13:57:33 +0000 Subject: [PATCH 087/311] Harmonize riscv64 LIBNAME for forced and non-forced targets The forced values for LIBNAME were either riscv64_generic or c910v while the non-forced value of LIBNAME was always riscv64. --- cpuid_riscv64.c | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/cpuid_riscv64.c b/cpuid_riscv64.c index 7e08af831..13009753a 100644 --- a/cpuid_riscv64.c +++ b/cpuid_riscv64.c @@ -78,6 +78,11 @@ static char *cpuname[] = { "C910V" }; +static char *cpuname_lower[] = { + "riscv64_generic", + "c910v" +}; + int detect(void){ #ifdef __linux FILE *infile; @@ -146,5 +151,5 @@ void get_cpuconfig(void){ } void get_libname(void){ - printf("riscv64\n"); + printf("%s", cpuname_lower[detect()]); } From 48a4c4d454530d46c0143f4f9bd3f5f7a8374757 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Fri, 26 Jan 2024 16:30:52 +0100 Subject: [PATCH 088/311] Use +sve in arch declarations of the fallback paths for SVE targets --- Makefile.arm64 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/Makefile.arm64 b/Makefile.arm64 index ed52a9424..ca053b03d 100644 --- a/Makefile.arm64 +++ b/Makefile.arm64 @@ -116,13 +116,13 @@ endif endif endif else -CCOMMON_OPT += -march=armv8.2-a -mtune=cortex-a72 +CCOMMON_OPT += -march=armv8.2-a+sve -mtune=cortex-a72 ifneq ($(F_COMPILER), NAG) FCOMMON_OPT += -march=armv8.2-a -mtune=cortex-a72 endif endif else -CCOMMON_OPT += -march=armv8-a -mtune=cortex-a72 +CCOMMON_OPT += -march=armv8-a+sve -mtune=cortex-a72 ifneq ($(F_COMPILER), NAG) FCOMMON_OPT += -march=armv8-a -mtune=cortex-a72 endif @@ -138,7 +138,7 @@ ifeq (1, $(filter 1,$(GCCMINORVERSIONGTEQ4) $(GCCVERSIONGTEQ11) $(ISCLANG))) ifneq ($(OSNAME), Darwin) CCOMMON_OPT += -march=armv8.5-a+sve+sve2+bf16 -mtune=neoverse-n2 else -CCOMMON_OPT += -march=armv8.2-a -mtune=cortex-a72 +CCOMMON_OPT += -march=armv8.2-a+sve -mtune=cortex-a72 endif ifneq ($(F_COMPILER), NAG) FCOMMON_OPT += -march=armv8.5-a+sve+sve2+bf16 -mtune=neoverse-n2 @@ -156,13 +156,13 @@ endif endif endif else -CCOMMON_OPT += -march=armv8.2-a -mtune=cortex-a72 +CCOMMON_OPT += -march=armv8.2-a+sve -mtune=cortex-a72 ifneq ($(F_COMPILER), NAG) FCOMMON_OPT += -march=armv8.2-a -mtune=cortex-a72 endif endif else -CCOMMON_OPT += -march=armv8-a -mtune=cortex-a72 +CCOMMON_OPT += -march=armv8-a+sve -mtune=cortex-a72 ifneq ($(F_COMPILER), NAG) FCOMMON_OPT += -march=armv8-a -mtune=cortex-a72 endif From 519ea6e87aa357787896986836f853192c829930 Mon Sep 17 00:00:00 2001 From: gxw Date: Tue, 30 Jan 2024 10:39:22 +0800 Subject: [PATCH 089/311] utest: Add utest for the {sc/dz}amax and {s/d/sc/dz}amin --- utest/CMakeLists.txt | 1 + utest/Makefile | 3 +- utest/test_amax.c | 35 +++++++++++++++-- utest/test_amin.c | 89 ++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 123 insertions(+), 5 deletions(-) create mode 100644 utest/test_amin.c diff --git a/utest/CMakeLists.txt b/utest/CMakeLists.txt index c47954ce4..41829bd22 100644 --- a/utest/CMakeLists.txt +++ b/utest/CMakeLists.txt @@ -16,6 +16,7 @@ else () test_dnrm2.c test_swap.c test_zscal.c + test_amin.c ) endif () diff --git a/utest/Makefile b/utest/Makefile index d0715c754..8acaa3ea9 100644 --- a/utest/Makefile +++ b/utest/Makefile @@ -11,7 +11,8 @@ UTESTBIN=openblas_utest include $(TOPDIR)/Makefile.system -OBJS=utest_main.o test_min.o test_amax.o test_ismin.o test_rotmg.o test_axpy.o test_dotu.o test_dsdot.o test_swap.o test_rot.o test_dnrm2.o test_zscal.o +OBJS=utest_main.o test_min.o test_amax.o test_ismin.o test_rotmg.o test_axpy.o test_dotu.o test_dsdot.o test_swap.o test_rot.o test_dnrm2.o test_zscal.o \ + test_amin.o #test_rot.o test_swap.o test_axpy.o test_dotu.o test_dsdot.o test_fork.o ifneq ($(NO_LAPACK), 1) diff --git a/utest/test_amax.c b/utest/test_amax.c index a9e5a1c85..e9775caf0 100644 --- a/utest/test_amax.c +++ b/utest/test_amax.c @@ -1,5 +1,5 @@ /***************************************************************************** -Copyright (c) 2011-2016, The OpenBLAS Project +Copyright (c) 2011-2024, The OpenBLAS Project All rights reserved. Redistribution and use in source and binary forms, with or without @@ -13,9 +13,9 @@ met: notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. - 3. Neither the name of the OpenBLAS project nor the names of - its contributors may be used to endorse or promote products - derived from this software without specific prior written + 3. Neither the name of the OpenBLAS project 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" @@ -57,4 +57,31 @@ CTEST(amax, damax){ ASSERT_DBL_NEAR_TOL((double)(tr_max), (double)(te_max), DOUBLE_EPS); } #endif +#ifdef BUILD_COMPLEX +CTEST(amax, scamax){ + blasint N = 9, inc = 1; + float te_max = 0.0, tr_max = 0.0; + float x[] = { -1.1, 2.2, -3.3, 4.4, -5.5, 6.6, -7.7, 8.8, + -9.9, 10.10, -1.1, 2.2, -3.3, 4.4, -5.5, 6.6, + -7.7, 8.8 }; + te_max = BLASFUNC(scamax)(&N, x, &inc); + tr_max = 20.0; + + ASSERT_DBL_NEAR_TOL((double)(tr_max), (double)(te_max), SINGLE_EPS); +} +#endif +#ifdef BUILD_COMPLEX16 +CTEST(amax, dzamax){ + blasint N = 9, inc = 1; + double te_max = 0.0, tr_max = 0.0; + double x[] = { -1.1, 2.2, -3.3, 4.4, -5.5, 6.6, -7.7, 8.8, + -9.9, 10.10, -1.1, 2.2, -3.3, 4.4, -5.5, 6.6, + -7.7, 8.8 }; + + te_max = BLASFUNC(dzamax)(&N, x, &inc); + tr_max = 20.0; + + ASSERT_DBL_NEAR_TOL((double)(tr_max), (double)(te_max), DOUBLE_EPS); +} +#endif diff --git a/utest/test_amin.c b/utest/test_amin.c new file mode 100644 index 000000000..1305ab8ef --- /dev/null +++ b/utest/test_amin.c @@ -0,0 +1,89 @@ +/***************************************************************************** +Copyright (c) 2011-2024, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. 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. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "openblas_utest.h" + +#ifdef BUILD_SINGLE +CTEST(amin, samin){ + blasint N = 3, inc = 1; + float te_min = 0.0, tr_min = 0.0; + float x[] = { -1.1, 2.2, -3.3, 4.4, -5.5, 6.6, -7.7, 8.8, + -9.9 }; + + te_min = BLASFUNC(samin)(&N, x, &inc); + tr_min = 1.1; + + ASSERT_DBL_NEAR_TOL((double)(tr_min), (double)(te_min), SINGLE_EPS); +} +#endif +#ifdef BUILD_DOUBLE +CTEST(amin, damin){ + blasint N = 3, inc = 1; + double te_min = 0.0, tr_min = 0.0; + double x[] = { -1.1, 2.2, -3.3, 4.4, -5.5, 6.6, -7.7, 8.8, + -9.9 }; + + te_min = BLASFUNC(damin)(&N, x, &inc); + tr_min = 1.1; + + ASSERT_DBL_NEAR_TOL((double)(tr_min), (double)(te_min), DOUBLE_EPS); +} +#endif +#ifdef BUILD_COMPLEX +CTEST(amin, scamin){ + blasint N = 9, inc = 1; + float te_min = 0.0, tr_min = 0.0; + float x[] = { -1.1, 2.2, -3.3, 4.4, -5.5, 6.6, -7.7, 8.8, + -9.9, 10.10, -1.1, 2.2, -3.3, 4.4, -5.5, 6.6, + -7.7, 8.8 }; + + te_min = BLASFUNC(scamin)(&N, x, &inc); + tr_min = 3.3; + + ASSERT_DBL_NEAR_TOL((double)(tr_min), (double)(te_min), SINGLE_EPS); +} +#endif +#ifdef BUILD_COMPLEX16 +CTEST(amin, dzamin){ + blasint N = 9, inc = 1; + double te_min = 0.0, tr_min = 0.0; + double x[] = { -1.1, 2.2, -3.3, 4.4, -5.5, 6.6, -7.7, 8.8, + -9.9, 10.10, -1.1, 2.2, -3.3, 4.4, -5.5, 6.6, + -7.7, 8.8 }; + + te_min = BLASFUNC(dzamin)(&N, x, &inc); + tr_min = 3.3; + + ASSERT_DBL_NEAR_TOL((double)(tr_min), (double)(te_min), DOUBLE_EPS); +} +#endif From a79d11740580db13f101b76c81a02f93654de9a7 Mon Sep 17 00:00:00 2001 From: gxw Date: Tue, 30 Jan 2024 11:03:56 +0800 Subject: [PATCH 090/311] LoogArch64: Fixed bug for {s/d}amin --- kernel/loongarch64/amin_lasx.S | 1 - kernel/loongarch64/amin_lsx.S | 1 - 2 files changed, 2 deletions(-) diff --git a/kernel/loongarch64/amin_lasx.S b/kernel/loongarch64/amin_lasx.S index 0a4359002..c91a33006 100644 --- a/kernel/loongarch64/amin_lasx.S +++ b/kernel/loongarch64/amin_lasx.S @@ -66,7 +66,6 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #else xvldrepl.w VM0, X, 0 #endif - XVFSUB VM0, VM0, VM0 bne INCX, TEMP, .L20 srai.d I, N, 4 diff --git a/kernel/loongarch64/amin_lsx.S b/kernel/loongarch64/amin_lsx.S index 644caf43c..c3c3f4ae9 100644 --- a/kernel/loongarch64/amin_lsx.S +++ b/kernel/loongarch64/amin_lsx.S @@ -66,7 +66,6 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #else vldrepl.w VM0, X, 0 #endif - VFSUB VM0, VM0, VM0 bne INCX, TEMP, .L20 srai.d I, N, 3 From 3d4dfd008556b5a722162def487e0553f807e6e8 Mon Sep 17 00:00:00 2001 From: gxw Date: Tue, 30 Jan 2024 11:25:59 +0800 Subject: [PATCH 091/311] Benchmark: Rename the executable file names for {sc/dz}a{min/max} No interface named {c/z}a{min/max}, keeping it would cause ambiguity --- benchmark/Makefile | 28 ++++++++++++++-------------- 1 file changed, 14 insertions(+), 14 deletions(-) diff --git a/benchmark/Makefile b/benchmark/Makefile index d9ddb9042..6a7c54636 100644 --- a/benchmark/Makefile +++ b/benchmark/Makefile @@ -265,9 +265,9 @@ goto :: sgemm.goto dgemm.goto cgemm.goto zgemm.goto \ ismax.goto idmax.goto \ isamin.goto idamin.goto icamin.goto izamin.goto \ ismin.goto idmin.goto \ - samax.goto damax.goto camax.goto zamax.goto \ + samax.goto damax.goto scamax.goto dzamax.goto \ smax.goto dmax.goto \ - samin.goto damin.goto camin.goto zamin.goto \ + samin.goto damin.goto scamin.goto dzamin.goto \ smin.goto dmin.goto \ saxpby.goto daxpby.goto caxpby.goto zaxpby.goto \ snrm2.goto dnrm2.goto scnrm2.goto dznrm2.goto $(GOTO_LAPACK_TARGETS) $(GOTO_HALF_TARGETS) @@ -2832,12 +2832,12 @@ samax.goto : samax.$(SUFFIX) ../$(LIBNAME) damax.goto : damax.$(SUFFIX) ../$(LIBNAME) $(CC) $(CFLAGS) -o $(@F) $^ $(CEXTRALIB) $(EXTRALIB) $(FEXTRALIB) -lm -############################################## CAMAX ############################################## -camax.goto : camax.$(SUFFIX) ../$(LIBNAME) +############################################## SCAMAX ############################################## +scamax.goto : scamax.$(SUFFIX) ../$(LIBNAME) $(CC) $(CFLAGS) -o $(@F) $^ $(CEXTRALIB) $(EXTRALIB) $(FEXTRALIB) -lm -############################################## ZAMAX ############################################## -zamax.goto : zamax.$(SUFFIX) ../$(LIBNAME) +############################################## DZAMAX ############################################## +dzamax.goto : dzamax.$(SUFFIX) ../$(LIBNAME) $(CC) $(CFLAGS) -o $(@F) $^ $(CEXTRALIB) $(EXTRALIB) $(FEXTRALIB) -lm ############################################## SMAX ############################################## @@ -2856,12 +2856,12 @@ samin.goto : samin.$(SUFFIX) ../$(LIBNAME) damin.goto : damin.$(SUFFIX) ../$(LIBNAME) $(CC) $(CFLAGS) -o $(@F) $^ $(CEXTRALIB) $(EXTRALIB) $(FEXTRALIB) -lm -############################################## CAMIN ############################################## -camin.goto : camin.$(SUFFIX) ../$(LIBNAME) +############################################## SCAMIN ############################################## +scamin.goto : scamin.$(SUFFIX) ../$(LIBNAME) $(CC) $(CFLAGS) -o $(@F) $^ $(CEXTRALIB) $(EXTRALIB) $(FEXTRALIB) -lm -############################################## ZAMIN ############################################## -zamin.goto : zamin.$(SUFFIX) ../$(LIBNAME) +############################################## DZAMIN ############################################## +dzamin.goto : dzamin.$(SUFFIX) ../$(LIBNAME) $(CC) $(CFLAGS) -o $(@F) $^ $(CEXTRALIB) $(EXTRALIB) $(FEXTRALIB) -lm ############################################## SMIN ############################################## @@ -3383,10 +3383,10 @@ samax.$(SUFFIX) : amax.c damax.$(SUFFIX) : amax.c $(CC) $(CFLAGS) -c -UCOMPLEX -DDOUBLE -o $(@F) $^ -camax.$(SUFFIX) : amax.c +scamax.$(SUFFIX) : amax.c $(CC) $(CFLAGS) -c -DCOMPLEX -UDOUBLE -o $(@F) $^ -zamax.$(SUFFIX) : amax.c +dzamax.$(SUFFIX) : amax.c $(CC) $(CFLAGS) -c -DCOMPLEX -DDOUBLE -o $(@F) $^ @@ -3403,10 +3403,10 @@ samin.$(SUFFIX) : amin.c damin.$(SUFFIX) : amin.c $(CC) $(CFLAGS) -c -UCOMPLEX -DDOUBLE -o $(@F) $^ -camin.$(SUFFIX) : amin.c +scamin.$(SUFFIX) : amin.c $(CC) $(CFLAGS) -c -DCOMPLEX -UDOUBLE -o $(@F) $^ -zamin.$(SUFFIX) : amin.c +dzamin.$(SUFFIX) : amin.c $(CC) $(CFLAGS) -c -DCOMPLEX -DDOUBLE -o $(@F) $^ From 0d7fe5ea610d46afaed9f5164f6a11729e2429de Mon Sep 17 00:00:00 2001 From: Mark Seminatore Date: Mon, 29 Jan 2024 22:33:47 -0800 Subject: [PATCH 092/311] clean up whitespace --- driver/others/blas_server_win32.c | 192 +++++++++++++----------------- 1 file changed, 85 insertions(+), 107 deletions(-) diff --git a/driver/others/blas_server_win32.c b/driver/others/blas_server_win32.c index 5820a55f4..68dde584b 100644 --- a/driver/others/blas_server_win32.c +++ b/driver/others/blas_server_win32.c @@ -72,19 +72,9 @@ static HANDLE blas_threads [MAX_CPU_NUMBER]; static DWORD blas_threads_id[MAX_CPU_NUMBER]; static volatile int thread_target; // target num of live threads, volatile for cross-thread reads -#if defined (__GNUC__) && (__GNUC__ < 6) - #define WIN_CAS(dest, exch, comp) __sync_val_compare_and_swap(dest, comp, exch) -#else - #if defined(_WIN64) - #define WIN_CAS(dest, exch, comp) InterlockedCompareExchange64(dest, exch, comp) - #else - #define WIN_CAS(dest, exch, comp) InterlockedCompareExchange(dest, exch, comp) - #endif -#endif - static void legacy_exec(void *func, int mode, blas_arg_t *args, void *sb){ - if (!(mode & BLAS_COMPLEX)){ + if (!(mode & BLAS_COMPLEX)) { #ifdef EXPRECISION if ((mode & BLAS_PREC) == BLAS_XDOUBLE){ /* REAL / Extended Double */ @@ -99,7 +89,7 @@ static void legacy_exec(void *func, int mode, blas_arg_t *args, void *sb){ args -> c, args -> ldc, sb); } else #endif - if ((mode & BLAS_PREC) == BLAS_DOUBLE){ + if ((mode & BLAS_PREC) == BLAS_DOUBLE) { /* REAL / Double */ void (*afunc)(BLASLONG, BLASLONG, BLASLONG, double, double *, BLASLONG, double *, BLASLONG, @@ -110,7 +100,7 @@ static void legacy_exec(void *func, int mode, blas_arg_t *args, void *sb){ args -> a, args -> lda, args -> b, args -> ldb, args -> c, args -> ldc, sb); - } else if ((mode & BLAS_PREC) == BLAS_SINGLE){ + } else if ((mode & BLAS_PREC) == BLAS_SINGLE) { /* REAL / Single */ void (*afunc)(BLASLONG, BLASLONG, BLASLONG, float, float *, BLASLONG, float *, BLASLONG, @@ -122,7 +112,7 @@ static void legacy_exec(void *func, int mode, blas_arg_t *args, void *sb){ args -> b, args -> ldb, args -> c, args -> ldc, sb); #ifdef BUILD_BFLOAT16 - } else if ((mode & BLAS_PREC) == BLAS_BFLOAT16){ + } else if ((mode & BLAS_PREC) == BLAS_BFLOAT16) { /* REAL / BFLOAT16 */ void (*afunc)(BLASLONG, BLASLONG, BLASLONG, bfloat16, bfloat16 *, BLASLONG, bfloat16 *, BLASLONG, @@ -133,7 +123,7 @@ static void legacy_exec(void *func, int mode, blas_arg_t *args, void *sb){ args -> a, args -> lda, args -> b, args -> ldb, args -> c, args -> ldc, sb); - } else if ((mode & BLAS_PREC) == BLAS_STOBF16){ + } else if ((mode & BLAS_PREC) == BLAS_STOBF16) { /* REAL / BLAS_STOBF16 */ void (*afunc)(BLASLONG, BLASLONG, BLASLONG, float, float *, BLASLONG, bfloat16 *, BLASLONG, @@ -144,7 +134,7 @@ static void legacy_exec(void *func, int mode, blas_arg_t *args, void *sb){ args -> a, args -> lda, args -> b, args -> ldb, args -> c, args -> ldc, sb); - } else if ((mode & BLAS_PREC) == BLAS_DTOBF16){ + } else if ((mode & BLAS_PREC) == BLAS_DTOBF16) { /* REAL / BLAS_DTOBF16 */ void (*afunc)(BLASLONG, BLASLONG, BLASLONG, double, double *, BLASLONG, bfloat16 *, BLASLONG, @@ -161,7 +151,7 @@ static void legacy_exec(void *func, int mode, blas_arg_t *args, void *sb){ } } else { #ifdef EXPRECISION - if ((mode & BLAS_PREC) == BLAS_XDOUBLE){ + if ((mode & BLAS_PREC) == BLAS_XDOUBLE) { /* COMPLEX / Extended Double */ void (*afunc)(BLASLONG, BLASLONG, BLASLONG, xdouble, xdouble, xdouble *, BLASLONG, xdouble *, BLASLONG, @@ -175,7 +165,7 @@ static void legacy_exec(void *func, int mode, blas_arg_t *args, void *sb){ args -> c, args -> ldc, sb); } else #endif - if ((mode & BLAS_PREC) == BLAS_DOUBLE){ + if ((mode & BLAS_PREC) == BLAS_DOUBLE) { /* COMPLEX / Double */ void (*afunc)(BLASLONG, BLASLONG, BLASLONG, double, double, double *, BLASLONG, double *, BLASLONG, @@ -205,10 +195,9 @@ static void legacy_exec(void *func, int mode, blas_arg_t *args, void *sb){ } } -/* This is a main routine of threads. Each thread waits until job is */ -/* queued. */ - -static DWORD WINAPI blas_thread_server(void *arg){ +// This is a main routine of threads. Each thread waits until job is +// queued. +static DWORD WINAPI blas_thread_server(void *arg) { /* Thread identifier */ BLASLONG cpu = (BLASLONG)arg; @@ -221,24 +210,22 @@ static DWORD WINAPI blas_thread_server(void *arg){ MT_TRACE("Server[%2ld] Thread is started!\n", cpu); - while (1){ + while (1) { /* Waiting for Queue */ MT_TRACE("Server[%2ld] Waiting for Queue.\n", cpu); - // event raised when work is added to the queue - WaitForSingleObject(kickoff_event, INFINITE); + // event raised when work is added to the queue + WaitForSingleObject(kickoff_event, INFINITE); - if (cpu > thread_target - 2) - { - //MT_TRACE("thread [%d] exiting.\n", cpu); - break; // excess thread, so worker thread exits - } + if (cpu > thread_target - 2) { + //MT_TRACE("thread [%d] exiting.\n", cpu); + break; // excess thread, so worker thread exits + } MT_TRACE("Server[%2ld] Got it.\n", cpu); -#if 1 EnterCriticalSection(&queue_lock); queue = work_queue; @@ -246,51 +233,39 @@ static DWORD WINAPI blas_thread_server(void *arg){ work_queue = work_queue->next; LeaveCriticalSection(&queue_lock); -#else - volatile blas_queue_t* queue_next; - - INT_PTR prev_value; - do { - queue = (volatile blas_queue_t*)work_queue; - if (!queue) - break; - - queue_next = (volatile blas_queue_t*)queue->next; - prev_value = WIN_CAS((INT_PTR*)&work_queue, (INT_PTR)queue_next, (INT_PTR)queue); - } while (prev_value != queue); -#endif - if (queue) { + if (queue) { int (*routine)(blas_arg_t *, void *, void *, void *, void *, BLASLONG) = queue -> routine; sa = queue -> sa; sb = queue -> sb; -#ifdef CONSISTENT_FPCSR - __asm__ __volatile__ ("ldmxcsr %0" : : "m" (queue -> sse_mode)); - __asm__ __volatile__ ("fldcw %0" : : "m" (queue -> x87_mode)); -#endif + #ifdef CONSISTENT_FPCSR + __asm__ __volatile__ ("ldmxcsr %0" : : "m" (queue -> sse_mode)); + __asm__ __volatile__ ("fldcw %0" : : "m" (queue -> x87_mode)); + #endif MT_TRACE("Server[%2ld] Started. Mode = 0x%03x M = %3ld N=%3ld K=%3ld\n", cpu, queue->mode, queue-> args ->m, queue->args->n, queue->args->k); // fprintf(stderr, "queue start[%ld]!!!\n", cpu); -#ifdef MONITOR - main_status[cpu] = MAIN_RUNNING1; -#endif + #ifdef MONITOR + main_status[cpu] = MAIN_RUNNING1; + #endif - if (sa == NULL) sa = (void *)((BLASLONG)buffer + GEMM_OFFSET_A); + if (sa == NULL) + sa = (void *)((BLASLONG)buffer + GEMM_OFFSET_A); if (sb == NULL) { - if (!(queue -> mode & BLAS_COMPLEX)){ + if (!(queue -> mode & BLAS_COMPLEX)) { #ifdef EXPRECISION - if ((queue -> mode & BLAS_PREC) == BLAS_XDOUBLE){ + if ((queue -> mode & BLAS_PREC) == BLAS_XDOUBLE) { sb = (void *)(((BLASLONG)sa + ((XGEMM_P * XGEMM_Q * sizeof(xdouble) + GEMM_ALIGN) & ~GEMM_ALIGN)) + GEMM_OFFSET_B); } else #endif - if ((queue -> mode & BLAS_PREC) == BLAS_DOUBLE){ + if ((queue -> mode & BLAS_PREC) == BLAS_DOUBLE) { #ifdef BUILD_DOUBLE sb = (void *)(((BLASLONG)sa + ((DGEMM_P * DGEMM_Q * sizeof(double) + GEMM_ALIGN) & ~GEMM_ALIGN)) + GEMM_OFFSET_B); @@ -324,26 +299,25 @@ static DWORD WINAPI blas_thread_server(void *arg){ /* Other types in future */ } } - queue->sb=sb; + queue->sb=sb; } -#ifdef MONITOR - main_status[cpu] = MAIN_RUNNING2; -#endif + #ifdef MONITOR + main_status[cpu] = MAIN_RUNNING2; + #endif if (!(queue -> mode & BLAS_LEGACY)) { - - (routine)(queue -> args, queue -> range_m, queue -> range_n, sa, sb, queue -> position); + (routine)(queue -> args, queue -> range_m, queue -> range_n, sa, sb, queue -> position); } else { - legacy_exec(routine, queue -> mode, queue -> args, sb); + legacy_exec(routine, queue -> mode, queue -> args, sb); } - }else{ - continue; //if queue == NULL - } + } else { + continue; //if queue == NULL + } MT_TRACE("Server[%2ld] Finished!\n", cpu); - queue->finished = 1; + queue->finished = 1; } /* Shutdown procedure */ @@ -353,10 +327,12 @@ static DWORD WINAPI blas_thread_server(void *arg){ blas_memory_free(buffer); return 0; - } +} -/* Initializing routine */ -int blas_thread_init(void){ +// +// Initializing routine +// +int blas_thread_init(void) { BLASLONG i; if (blas_server_avail || (blas_cpu_number <= 1)) return 0; @@ -365,16 +341,16 @@ int blas_thread_init(void){ MT_TRACE("Initializing Thread(Num. threads = %d)\n", blas_cpu_number); - if (!blas_server_avail){ - // create the kickoff Event - kickoff_event = CreateEvent(NULL, TRUE, FALSE, NULL); + if (!blas_server_avail) { + // create the kickoff Event + kickoff_event = CreateEvent(NULL, TRUE, FALSE, NULL); - thread_target = blas_cpu_number; + thread_target = blas_cpu_number; InitializeCriticalSection(&queue_lock); - for(i = 0; i < blas_cpu_number - 1; i++){ - //MT_TRACE("thread_init: creating thread [%d]\n", i); + for(i = 0; i < blas_cpu_number - 1; i++) { + //MT_TRACE("thread_init: creating thread [%d]\n", i); blas_threads[i] = CreateThread(NULL, 0, blas_thread_server, (void *)i, @@ -391,13 +367,10 @@ int blas_thread_init(void){ /* User can call one of two routines. - exec_blas_async ... immediately returns after jobs are queued. - exec_blas ... returns after jobs are finished. */ - -int exec_blas_async(BLASLONG pos, blas_queue_t *queue){ +int exec_blas_async(BLASLONG pos, blas_queue_t *queue) { #if defined(SMP_SERVER) // Handle lazy re-init of the thread-pool after a POSIX fork @@ -417,7 +390,7 @@ int exec_blas_async(BLASLONG pos, blas_queue_t *queue){ __asm__ __volatile__ ("stmxcsr %0" : "=m" (current -> sse_mode)); #endif - current->finished = 0; + current->finished = 0; current = current -> next; pos ++; } @@ -426,18 +399,18 @@ int exec_blas_async(BLASLONG pos, blas_queue_t *queue){ if (!work_queue) { - work_queue = queue; + work_queue = queue; } else { blas_queue_t *next_item = work_queue; - // find the end of the work queue - while (next_item) - next_item = next_item->next; + // find the end of the work queue + while (next_item) + next_item = next_item->next; - // add new work to the end - next_item = queue; + // add new work to the end + next_item = queue; } LeaveCriticalSection(&queue_lock); @@ -447,20 +420,24 @@ int exec_blas_async(BLASLONG pos, blas_queue_t *queue){ return 0; } -int exec_blas_async_wait(BLASLONG num, blas_queue_t *queue){ +// +// Join. Wait for all queued tasks to complete +// +int exec_blas_async_wait(BLASLONG num, blas_queue_t *queue) { - MT_TRACE("Synchronization Waiting.\n"); + MT_TRACE("Synchronization Waiting.\n"); - while (num){ - MT_TRACE("Waiting Queue ..\n"); - while (!queue->finished) - YIELDING; + while (num) { + MT_TRACE("Waiting Queue ..\n"); - queue = queue->next; - num--; - } + while (!queue->finished) + YIELDING; - MT_TRACE("Completely Done.\n\n"); + queue = queue->next; + num--; + } + + MT_TRACE("Completely Done.\n\n"); // if work was added to the queue after this batch we can't sleep the worker threads // by resetting the event @@ -474,8 +451,10 @@ int exec_blas_async_wait(BLASLONG num, blas_queue_t *queue){ return 0; } -/* Execute Threads */ -int exec_blas(BLASLONG num, blas_queue_t *queue){ +// +// Execute Threads +// +int exec_blas(BLASLONG num, blas_queue_t *queue) { #if defined(SMP_SERVER) && defined(OS_CYGWIN_NT) // Handle lazy re-init of the thread-pool after a POSIX fork @@ -507,9 +486,8 @@ int exec_blas(BLASLONG num, blas_queue_t *queue){ return 0; } -/* Shutdown procedure, but user don't have to call this routine. The */ -/* kernel automatically kill threads. */ - +// Shutdown procedure, but user don't have to call this routine. The +// kernel automatically kill threads. int BLASFUNC(blas_thread_shutdown)(void){ int i; @@ -518,9 +496,9 @@ int BLASFUNC(blas_thread_shutdown)(void){ LOCK_COMMAND(&server_lock); - if (blas_server_avail){ + if (blas_server_avail) { - for(i = 0; i < blas_num_threads - 1; i++){ + for(i = 0; i < blas_num_threads - 1; i++) { // Could also just use WaitForMultipleObjects DWORD wait_thread_value = WaitForSingleObject(blas_threads[i], 50); @@ -555,7 +533,7 @@ void goto_set_num_threads(int num_threads) if (num_threads > MAX_CPU_NUMBER) num_threads = MAX_CPU_NUMBER; - if (blas_server_avail && num_threads < blas_num_threads) { + if (blas_server_avail && num_threads < blas_num_threads) { LOCK_COMMAND(&server_lock); thread_target = num_threads; @@ -586,7 +564,7 @@ void goto_set_num_threads(int num_threads) thread_target = num_threads; //increased_threads = 1; - if (!blas_server_avail){ + if (!blas_server_avail) { // create the kickoff Event kickoff_event = CreateEvent(NULL, TRUE, FALSE, NULL); @@ -595,7 +573,7 @@ void goto_set_num_threads(int num_threads) blas_server_avail = 1; } - for(i = (blas_num_threads > 0) ? blas_num_threads - 1 : 0; i < num_threads - 1; i++){ + for(i = (blas_num_threads > 0) ? blas_num_threads - 1 : 0; i < num_threads - 1; i++) { //MT_TRACE("set_num_threads: creating thread [%d]\n", i); blas_threads[i] = CreateThread(NULL, 0, From 83ce97a4ca44c1aedc9f825bcb11f3a999f09c60 Mon Sep 17 00:00:00 2001 From: gxw Date: Tue, 30 Jan 2024 16:54:14 +0800 Subject: [PATCH 093/311] LoongArch64: Handle NAN and INF --- kernel/loongarch64/cscal_lasx.S | 149 +------------------------------- kernel/loongarch64/cscal_lsx.S | 130 +--------------------------- 2 files changed, 4 insertions(+), 275 deletions(-) diff --git a/kernel/loongarch64/cscal_lasx.S b/kernel/loongarch64/cscal_lasx.S index 3605a6c0e..f53526663 100644 --- a/kernel/loongarch64/cscal_lasx.S +++ b/kernel/loongarch64/cscal_lasx.S @@ -99,7 +99,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. b .L113 //alpha_r != 0.0 && alpha_i == 0.0 .L14: - bceqz $fcc1, .L112 //alpha_r == 0.0 && alpha_i != 0.0 + bceqz $fcc1, .L114 //alpha_r == 0.0 && alpha_i != 0.0 b .L111 //alpha_r == 0.0 && alpha_i == 0.0 .align 3 @@ -117,38 +117,6 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. b .L997 .align 3 -.L112: //alpha_r == 0.0 && alpha_i != 0.0 - xvld VX0, X, 0 * SIZE -#ifdef DOUBLE - xvld VX1, X, 4 * SIZE - xvpickev.d x1, VX1, VX0 - xvpickod.d x2, VX1, VX0 - xvfmul.d x3, VXAI, x2 - xvfsub.d x3, VXZ, x3 - xvfmul.d x4, VXAI, x1 - xvilvl.d VX2, x4 ,x3 - xvilvh.d VX3, x4, x3 - xvst VX2, X, 0 * SIZE - xvst VX3, X, 4 * SIZE - addi.d X, X, 8 * SIZE -#else - xvld VX1, X, 8 * SIZE - xvpickev.w x1, VX1, VX0 - xvpickod.w x2, VX1, VX0 - xvfmul.s x3, VXAI, x2 - xvfsub.s x3, VXZ, x3 - xvfmul.s x4, VXAI, x1 - xvilvl.w VX2, x4 ,x3 - xvilvh.w VX3, x4, x3 - xvst VX2, X, 0 * SIZE - xvst VX3, X, 8 * SIZE - addi.d X, X, 16 * SIZE -#endif - addi.d I, I, -1 - blt $r0, I, .L112 - b .L997 - .align 3 - .L113: //alpha_r != 0.0 && alpha_i == 0.0 xvld VX0, X, 0 * SIZE #ifdef DOUBLE @@ -227,7 +195,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. b .L223 //alpha_r != 0.0 && alpha_i == 0.0 .L24: - bceqz $fcc1, .L222 //alpha_r == 0.0 && alpha_i != 0.0 + bceqz $fcc1, .L224 //alpha_r == 0.0 && alpha_i != 0.0 b .L221 //alpha_r == 0.0 && alpha_i == 0.0 .align 3 @@ -275,119 +243,6 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. b .L997 .align 3 -.L222: //alpha_r == 0.0 && alpha_i != 0.0 -#ifdef DOUBLE - ld.d t1, X, 0 * SIZE - ld.d t2, X, 1 * SIZE - add.d X, X, INCX - ld.d t3, X, 0 * SIZE - ld.d t4, X, 1 * SIZE - add.d X, X, INCX - xvinsgr2vr.d x1, t1, 0 - xvinsgr2vr.d x2, t2, 0 - xvinsgr2vr.d x1, t3, 1 - xvinsgr2vr.d x2, t4, 1 - ld.d t1, X, 0 * SIZE - ld.d t2, X, 1 * SIZE - add.d X, X, INCX - ld.d t3, X, 0 * SIZE - ld.d t4, X, 1 * SIZE - xvinsgr2vr.d x1, t1, 2 - xvinsgr2vr.d x2, t2, 2 - xvinsgr2vr.d x1, t3, 3 - xvinsgr2vr.d x2, t4, 3 - add.d X, X, INCX - - xvfmul.d x3, VXAI, x2 - xvfsub.d x3, VXZ, x3 - xvfmul.d x4, VXAI, x1 - addi.d I, I, -1 - xvstelm.d x3, XX, 0 * SIZE, 0 - xvstelm.d x4, XX, 1 * SIZE, 0 - add.d XX, XX, INCX - xvstelm.d x3, XX, 0 * SIZE, 1 - xvstelm.d x4, XX, 1 * SIZE, 1 - add.d XX, XX, INCX - xvstelm.d x3, XX, 0 * SIZE, 2 - xvstelm.d x4, XX, 1 * SIZE, 2 - add.d XX, XX, INCX - xvstelm.d x3, XX, 0 * SIZE, 3 - xvstelm.d x4, XX, 1 * SIZE, 3 -#else - ld.w t1, X, 0 * SIZE - ld.w t2, X, 1 * SIZE - add.d X, X, INCX - ld.w t3, X, 0 * SIZE - ld.w t4, X, 1 * SIZE - add.d X, X, INCX - xvinsgr2vr.w x1, t1, 0 - xvinsgr2vr.w x2, t2, 0 - xvinsgr2vr.w x1, t3, 1 - xvinsgr2vr.w x2, t4, 1 - ld.w t1, X, 0 * SIZE - ld.w t2, X, 1 * SIZE - add.d X, X, INCX - ld.w t3, X, 0 * SIZE - ld.w t4, X, 1 * SIZE - xvinsgr2vr.w x1, t1, 2 - xvinsgr2vr.w x2, t2, 2 - xvinsgr2vr.w x1, t3, 3 - xvinsgr2vr.w x2, t4, 3 - add.d X, X, INCX - ld.w t1, X, 0 * SIZE - ld.w t2, X, 1 * SIZE - add.d X, X, INCX - ld.w t3, X, 0 * SIZE - ld.w t4, X, 1 * SIZE - add.d X, X, INCX - xvinsgr2vr.w x1, t1, 4 - xvinsgr2vr.w x2, t2, 4 - xvinsgr2vr.w x1, t3, 5 - xvinsgr2vr.w x2, t4, 5 - ld.w t1, X, 0 * SIZE - ld.w t2, X, 1 * SIZE - add.d X, X, INCX - ld.w t3, X, 0 * SIZE - ld.w t4, X, 1 * SIZE - xvinsgr2vr.w x1, t1, 6 - xvinsgr2vr.w x2, t2, 6 - xvinsgr2vr.w x1, t3, 7 - xvinsgr2vr.w x2, t4, 7 - add.d X, X, INCX - - xvfmul.s x3, VXAI, x2 - xvfsub.s x3, VXZ, x3 - xvfmul.s x4, VXAI, x1 - addi.d I, I, -1 - xvstelm.w x3, XX, 0 * SIZE, 0 - xvstelm.w x4, XX, 1 * SIZE, 0 - add.d XX, XX, INCX - xvstelm.w x3, XX, 0 * SIZE, 1 - xvstelm.w x4, XX, 1 * SIZE, 1 - add.d XX, XX, INCX - xvstelm.w x3, XX, 0 * SIZE, 2 - xvstelm.w x4, XX, 1 * SIZE, 2 - add.d XX, XX, INCX - xvstelm.w x3, XX, 0 * SIZE, 3 - xvstelm.w x4, XX, 1 * SIZE, 3 - add.d XX, XX, INCX - xvstelm.w x3, XX, 0 * SIZE, 4 - xvstelm.w x4, XX, 1 * SIZE, 4 - add.d XX, XX, INCX - xvstelm.w x3, XX, 0 * SIZE, 5 - xvstelm.w x4, XX, 1 * SIZE, 5 - add.d XX, XX, INCX - xvstelm.w x3, XX, 0 * SIZE, 6 - xvstelm.w x4, XX, 1 * SIZE, 6 - add.d XX, XX, INCX - xvstelm.w x3, XX, 0 * SIZE, 7 - xvstelm.w x4, XX, 1 * SIZE, 7 -#endif - add.d XX, XX, INCX - blt $r0, I, .L222 - b .L997 - .align 3 - .L223: //alpha_r != 0.0 && alpha_i == 0.0 #ifdef DOUBLE ld.d t1, X, 0 * SIZE diff --git a/kernel/loongarch64/cscal_lsx.S b/kernel/loongarch64/cscal_lsx.S index f442a754f..241d3d16e 100644 --- a/kernel/loongarch64/cscal_lsx.S +++ b/kernel/loongarch64/cscal_lsx.S @@ -97,7 +97,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. b .L113 //alpha_r != 0.0 && alpha_i == 0.0 .L14: - bceqz $fcc1, .L112 //alpha_r == 0.0 && alpha_i != 0.0 + bceqz $fcc1, .L114 //alpha_r == 0.0 && alpha_i != 0.0 b .L111 //alpha_r == 0.0 && alpha_i == 0.0 .align 3 @@ -116,48 +116,6 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. b .L997 .align 3 -.L112: //alpha_r == 0.0 && alpha_i != 0.0 - vld VX0, X, 0 * SIZE -#ifdef DOUBLE - vld VX1, X, 2 * SIZE - vpickev.d x1, VX1, VX0 - vpickod.d x2, VX1, VX0 - vfmul.d x3, VXAI, x2 - vfsub.d x3, VXZ, x3 - vfmul.d x4, VXAI, x1 - vilvl.d VX2, x4 ,x3 - vilvh.d VX3, x4, x3 - vst VX2, X, 0 * SIZE - vst VX3, X, 2 * SIZE - vld VX0, X, 4 * SIZE - vld VX1, X, 6 * SIZE - vpickev.d x1, VX1, VX0 - vpickod.d x2, VX1, VX0 - vfmul.d x3, VXAI, x2 - vfsub.d x3, VXZ, x3 - vfmul.d x4, VXAI, x1 - vilvl.d VX2, x4 ,x3 - vilvh.d VX3, x4, x3 - vst VX2, X, 4 * SIZE - vst VX3, X, 6 * SIZE -#else - vld VX1, X, 4 * SIZE - vpickev.w x1, VX1, VX0 - vpickod.w x2, VX1, VX0 - vfmul.s x3, VXAI, x2 - vfsub.s x3, VXZ, x3 - vfmul.s x4, VXAI, x1 - vilvl.w VX2, x4 ,x3 - vilvh.w VX3, x4, x3 - vst VX2, X, 0 * SIZE - vst VX3, X, 4 * SIZE -#endif - addi.d X, X, 8 * SIZE - addi.d I, I, -1 - blt $r0, I, .L112 - b .L997 - .align 3 - .L113: //alpha_r != 0.0 && alpha_i == 0.0 vld VX0, X, 0 * SIZE #ifdef DOUBLE @@ -256,7 +214,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. b .L223 //alpha_r != 0.0 && alpha_i == 0.0 .L24: - bceqz $fcc1, .L222 //alpha_r == 0.0 && alpha_i != 0.0 + bceqz $fcc1, .L224 //alpha_r == 0.0 && alpha_i != 0.0 b .L221 //alpha_r == 0.0 && alpha_i == 0.0 .align 3 @@ -292,90 +250,6 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. b .L997 .align 3 -.L222: //alpha_r == 0.0 && alpha_i != 0.0 -#ifdef DOUBLE - ld.d t1, X, 0 * SIZE - ld.d t2, X, 1 * SIZE - add.d X, X, INCX - ld.d t3, X, 0 * SIZE - ld.d t4, X, 1 * SIZE - add.d X, X, INCX - vinsgr2vr.d x1, t1, 0 - vinsgr2vr.d x2, t2, 0 - vinsgr2vr.d x1, t3, 1 - vinsgr2vr.d x2, t4, 1 - vfmul.d x3, VXAI, x2 - vfsub.d x3, VXZ, x3 - vfmul.d x4, VXAI, x1 - vstelm.d x3, XX, 0 * SIZE, 0 - vstelm.d x4, XX, 1 * SIZE, 0 - add.d XX, XX, INCX - vstelm.d x3, XX, 0 * SIZE, 1 - vstelm.d x4, XX, 1 * SIZE, 1 - add.d XX, XX, INCX - - ld.d t1, X, 0 * SIZE - ld.d t2, X, 1 * SIZE - add.d X, X, INCX - ld.d t3, X, 0 * SIZE - ld.d t4, X, 1 * SIZE - vinsgr2vr.d x1, t1, 0 - vinsgr2vr.d x2, t2, 0 - vinsgr2vr.d x1, t3, 1 - vinsgr2vr.d x2, t4, 1 - add.d X, X, INCX - vfmul.d x3, VXAI, x2 - vfsub.d x3, VXZ, x3 - vfmul.d x4, VXAI, x1 - addi.d I, I, -1 - vstelm.d x3, XX, 0 * SIZE, 0 - vstelm.d x4, XX, 1 * SIZE, 0 - add.d XX, XX, INCX - vstelm.d x3, XX, 0 * SIZE, 1 - vstelm.d x4, XX, 1 * SIZE, 1 -#else - ld.w t1, X, 0 * SIZE - ld.w t2, X, 1 * SIZE - add.d X, X, INCX - ld.w t3, X, 0 * SIZE - ld.w t4, X, 1 * SIZE - add.d X, X, INCX - vinsgr2vr.w x1, t1, 0 - vinsgr2vr.w x2, t2, 0 - vinsgr2vr.w x1, t3, 1 - vinsgr2vr.w x2, t4, 1 - ld.w t1, X, 0 * SIZE - ld.w t2, X, 1 * SIZE - add.d X, X, INCX - ld.w t3, X, 0 * SIZE - ld.w t4, X, 1 * SIZE - vinsgr2vr.w x1, t1, 2 - vinsgr2vr.w x2, t2, 2 - vinsgr2vr.w x1, t3, 3 - vinsgr2vr.w x2, t4, 3 - add.d X, X, INCX - - vfmul.s x3, VXAI, x2 - vfsub.s x3, VXZ, x3 - vfmul.s x4, VXAI, x1 - addi.d I, I, -1 - vstelm.w x3, XX, 0 * SIZE, 0 - vstelm.w x4, XX, 1 * SIZE, 0 - add.d XX, XX, INCX - vstelm.w x3, XX, 0 * SIZE, 1 - vstelm.w x4, XX, 1 * SIZE, 1 - add.d XX, XX, INCX - vstelm.w x3, XX, 0 * SIZE, 2 - vstelm.w x4, XX, 1 * SIZE, 2 - add.d XX, XX, INCX - vstelm.w x3, XX, 0 * SIZE, 3 - vstelm.w x4, XX, 1 * SIZE, 3 -#endif - add.d XX, XX, INCX - blt $r0, I, .L222 - b .L997 - .align 3 - .L223: //alpha_r != 0.0 && alpha_i == 0.0 #ifdef DOUBLE ld.d t1, X, 0 * SIZE From bb043a021f138a3915c835776fdfe90673644db4 Mon Sep 17 00:00:00 2001 From: gxw Date: Tue, 30 Jan 2024 17:27:59 +0800 Subject: [PATCH 094/311] utest: Add tests for zscal --- utest/test_zscal.c | 52 ++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 50 insertions(+), 2 deletions(-) diff --git a/utest/test_zscal.c b/utest/test_zscal.c index 8992eee90..ffc851e8b 100644 --- a/utest/test_zscal.c +++ b/utest/test_zscal.c @@ -20,6 +20,18 @@ CTEST(zscal, i_nan) ASSERT_TRUE(isnan(nan[17])); } +CTEST(zscal, i_nan_inc_2) +{ + double i[] = {0,1, 0,1, 0,1, 0,1, 0,1, 0,1, 0,1, 0,1, 0,1 }; + double nan[] = {NAN,0, NAN,0, NAN,0, NAN,0, NAN,0, NAN,0, NAN,0, NAN,0, NAN,0, NAN,0, + NAN,0, NAN,0, NAN,0, NAN,0, NAN,0, NAN,0, NAN,0, NAN,0, NAN,0, NAN,0}; + cblas_zscal(9, i, &nan, 2); + ASSERT_TRUE(isnan(nan[0])); + ASSERT_TRUE(isnan(nan[1])); + ASSERT_TRUE(isnan(nan[16])); + ASSERT_TRUE(isnan(nan[17])); +} + CTEST(zscal, nan_i) { double i[] = {0,1, 0,1, 0,1, 0,1, 0,1, 0,1, 0,1, 0,1, 0,1 }; @@ -30,7 +42,19 @@ CTEST(zscal, nan_i) ASSERT_TRUE(isnan(i[16])); ASSERT_TRUE(isnan(i[17])); } - + +CTEST(zscal, nan_i_inc_2) +{ + double i[] = {0,1, 0,1, 0,1, 0,1, 0,1, 0,1, 0,1, 0,1, 0,1, + 0,1, 0,1, 0,1, 0,1, 0,1, 0,1, 0,1, 0,1, 0,1 }; + double nan[] = {NAN,0, NAN,0, NAN,0, NAN,0, NAN,0, NAN,0, NAN,0, NAN,0, NAN,0, NAN,0}; + cblas_zscal(9, &nan, &i, 2); + ASSERT_TRUE(isnan(i[0])); + ASSERT_TRUE(isnan(i[1])); + ASSERT_TRUE(isnan(i[16])); + ASSERT_TRUE(isnan(i[17])); +} + CTEST(zscal, i_inf) { double i[] = {0,1, 0,1, 0,1, 0,1, 0,1, 0,1, 0,1, 0,1, 0,1 }; @@ -40,7 +64,19 @@ CTEST(zscal, i_inf) ASSERT_TRUE(isinf(inf[1])); ASSERT_TRUE(isnan(inf[16])); ASSERT_TRUE(isinf(inf[17])); -} +} + +CTEST(zscal, i_inf_inc_2) +{ + double i[] = {0,1, 0,1, 0,1, 0,1, 0,1, 0,1, 0,1, 0,1, 0,1 }; + double inf[] = {INFINITY, 0, INFINITY,0, INFINITY,0, INFINITY,0, INFINITY,0, INFINITY,0, INFINITY,0, INFINITY,0, INFINITY,0, + INFINITY, 0, INFINITY,0, INFINITY,0, INFINITY,0, INFINITY,0, INFINITY,0, INFINITY,0, INFINITY,0, INFINITY,0}; + cblas_zscal(9, i, &inf, 2); + ASSERT_TRUE(isnan(inf[0])); + ASSERT_TRUE(isinf(inf[1])); + ASSERT_TRUE(isnan(inf[16])); + ASSERT_TRUE(isinf(inf[17])); +} CTEST(zscal, inf_i) { @@ -53,4 +89,16 @@ CTEST(zscal, inf_i) ASSERT_TRUE(isinf(i[17])); } +CTEST(zscal, inf_i_inc_2) +{ + double i[] = {0,1, 0,1, 0,1, 0,1, 0,1, 0,1, 0,1, 0,1, 0,1, + 0,1, 0,1, 0,1, 0,1, 0,1, 0,1, 0,1, 0,1, 0,1 }; + double inf[] = {INFINITY, 0, INFINITY,0, INFINITY,0, INFINITY,0, INFINITY,0, INFINITY,0, INFINITY,0, INFINITY,0, INFINITY,0}; + cblas_zscal(9, &inf, &i, 2); + ASSERT_TRUE(isnan(i[0])); + ASSERT_TRUE(isinf(i[1])); + ASSERT_TRUE(isnan(i[16])); + ASSERT_TRUE(isinf(i[17])); +} + #endif From 09bb48d1b97aaf60ea40707658bf6761a9637424 Mon Sep 17 00:00:00 2001 From: Chip Kerchner Date: Tue, 30 Jan 2024 09:13:16 -0600 Subject: [PATCH 095/311] Vectorize in-copy packing/copying for SGEMM - 4X faster. --- kernel/power/KERNEL.POWER10 | 2 +- kernel/power/KERNEL.POWER8 | 7 +- kernel/power/KERNEL.POWER9 | 2 +- kernel/power/sgemm_ncopy_16_power.c | 482 ++++++++++++++++++++++++++++ 4 files changed, 487 insertions(+), 6 deletions(-) create mode 100755 kernel/power/sgemm_ncopy_16_power.c diff --git a/kernel/power/KERNEL.POWER10 b/kernel/power/KERNEL.POWER10 index 9047c714c..c84cd91d2 100644 --- a/kernel/power/KERNEL.POWER10 +++ b/kernel/power/KERNEL.POWER10 @@ -25,7 +25,7 @@ ZTRMMKERNEL = zgemm_kernel_power10.S endif SGEMMKERNEL = sgemm_kernel_power10.c -SGEMMINCOPY = ../generic/gemm_ncopy_16.c +SGEMMINCOPY = sgemm_ncopy_16_power.c SGEMMITCOPY = sgemm_tcopy_16_power8.S SGEMMONCOPY = ../generic/gemm_ncopy_8.c SGEMMOTCOPY = sgemm_tcopy_8_power8.S diff --git a/kernel/power/KERNEL.POWER8 b/kernel/power/KERNEL.POWER8 index 2b8e65948..36222348a 100644 --- a/kernel/power/KERNEL.POWER8 +++ b/kernel/power/KERNEL.POWER8 @@ -1,11 +1,9 @@ # Big-endian 32bit (AIX) is supported through the POWER6 GEMM kernels, no separate TRMM ifeq ($(__BYTE_ORDER__)$(BINARY32),__ORDER_BIG_ENDIAN__1) SGEMMKERNEL = gemm_kernel_power6.S -SGEMMINCOPY = SGEMMITCOPY = SGEMMONCOPY = gemm_ncopy_4.S SGEMMOTCOPY = gemm_tcopy_4.S -SGEMMINCOPYOBJ = SGEMMITCOPYOBJ = SGEMMONCOPYOBJ = sgemm_oncopy$(TSUFFIX).$(SUFFIX) SGEMMOTCOPYOBJ = sgemm_otcopy$(TSUFFIX).$(SUFFIX) @@ -50,11 +48,9 @@ CTRMMKERNEL = ctrmm_kernel_8x4_power8.S ZTRMMKERNEL = ztrmm_kernel_8x2_power8.S SGEMMKERNEL = sgemm_kernel_16x8_power8.S -SGEMMINCOPY = ../generic/gemm_ncopy_16.c SGEMMITCOPY = sgemm_tcopy_16_power8.S SGEMMONCOPY = ../generic/gemm_ncopy_8.c SGEMMOTCOPY = sgemm_tcopy_8_power8.S -SGEMMINCOPYOBJ = sgemm_incopy$(TSUFFIX).$(SUFFIX) SGEMMITCOPYOBJ = sgemm_itcopy$(TSUFFIX).$(SUFFIX) SGEMMONCOPYOBJ = sgemm_oncopy$(TSUFFIX).$(SUFFIX) SGEMMOTCOPYOBJ = sgemm_otcopy$(TSUFFIX).$(SUFFIX) @@ -90,6 +86,9 @@ ZGEMMINCOPYOBJ = zgemm_incopy$(TSUFFIX).$(SUFFIX) ZGEMMITCOPYOBJ = zgemm_itcopy$(TSUFFIX).$(SUFFIX) endif +SGEMMINCOPY = sgemm_ncopy_16_power.c +SGEMMINCOPYOBJ = sgemm_incopy$(TSUFFIX).$(SUFFIX) + STRSMKERNEL_LN = ../generic/trsm_kernel_LN.c STRSMKERNEL_LT = ../generic/trsm_kernel_LT.c STRSMKERNEL_RN = ../generic/trsm_kernel_RN.c diff --git a/kernel/power/KERNEL.POWER9 b/kernel/power/KERNEL.POWER9 index b6b102b3e..7d007d1a2 100644 --- a/kernel/power/KERNEL.POWER9 +++ b/kernel/power/KERNEL.POWER9 @@ -13,7 +13,7 @@ CTRMMKERNEL = cgemm_kernel_power9.S ZTRMMKERNEL = zgemm_kernel_power9.S SGEMMKERNEL = sgemm_kernel_power9.S -SGEMMINCOPY = ../generic/gemm_ncopy_16.c +SGEMMINCOPY = sgemm_ncopy_16_power.c SGEMMITCOPY = sgemm_tcopy_16_power8.S SGEMMONCOPY = ../generic/gemm_ncopy_8.c SGEMMOTCOPY = sgemm_tcopy_8_power8.S diff --git a/kernel/power/sgemm_ncopy_16_power.c b/kernel/power/sgemm_ncopy_16_power.c new file mode 100755 index 000000000..babe1376e --- /dev/null +++ b/kernel/power/sgemm_ncopy_16_power.c @@ -0,0 +1,482 @@ +/*********************************************************************/ +/* Copyright 2009, 2010 The University of Texas at Austin. */ +/* All rights reserved. */ +/* */ +/* Redistribution and use in source and binary forms, with or */ +/* without modification, are permitted provided that the following */ +/* conditions are met: */ +/* */ +/* 1. Redistributions of source code must retain the above */ +/* copyright notice, this list of conditions and the following */ +/* disclaimer. */ +/* */ +/* 2. 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. */ +/* */ +/* THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY OF TEXAS AT */ +/* AUSTIN ``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 UNIVERSITY OF TEXAS AT */ +/* AUSTIN 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. */ +/* */ +/* The views and conclusions contained in the software and */ +/* documentation are those of the authors and should not be */ +/* interpreted as representing official policies, either expressed */ +/* or implied, of The University of Texas at Austin. */ +/*********************************************************************/ + +#include +#include +#include "common.h" + +int CNAME(BLASLONG m, BLASLONG n, IFLOAT *a, BLASLONG lda, IFLOAT *b){ + BLASLONG i, j; + + IFLOAT *aoffset; + IFLOAT *aoffset1, *aoffset2, *aoffset3, *aoffset4; + IFLOAT *aoffset5, *aoffset6, *aoffset7, *aoffset8; + IFLOAT *aoffset9, *aoffset10, *aoffset11, *aoffset12; + IFLOAT *aoffset13, *aoffset14, *aoffset15, *aoffset16; + + IFLOAT *boffset; + IFLOAT ctemp01, ctemp02, ctemp03, ctemp04; + IFLOAT ctemp05, ctemp06, ctemp07, ctemp08; + IFLOAT ctemp09, ctemp10, ctemp11, ctemp12; + IFLOAT ctemp13, ctemp14, ctemp15, ctemp16; + IFLOAT ctemp17, ctemp19 ; + IFLOAT ctemp21, ctemp23 ; + IFLOAT ctemp25, ctemp27 ; + IFLOAT ctemp29, ctemp31 ; + + aoffset = a; + boffset = b; + j = (n >> 4); + if (j > 0){ + do{ + aoffset1 = aoffset; + aoffset2 = aoffset1 + lda; + aoffset3 = aoffset2 + lda; + aoffset4 = aoffset3 + lda; + aoffset5 = aoffset4 + lda; + aoffset6 = aoffset5 + lda; + aoffset7 = aoffset6 + lda; + aoffset8 = aoffset7 + lda; + aoffset9 = aoffset8 + lda; + aoffset10 = aoffset9 + lda; + aoffset11 = aoffset10 + lda; + aoffset12 = aoffset11 + lda; + aoffset13 = aoffset12 + lda; + aoffset14 = aoffset13 + lda; + aoffset15 = aoffset14 + lda; + aoffset16 = aoffset15 + lda; + aoffset += 16 * lda; + i = (m >> 2); + if (i > 0){ + vector float c1, c2, c3, c4, c5, c6, c7, c8; + vector float c9, c10, c11, c12, c13, c14, c15, c16; + vector float t1, t2, t3, t4, t5, t6, t7, t8; + vector float t9, t10, t11, t12; + do{ + c1 = vec_xl(0, aoffset1); + c2 = vec_xl(0, aoffset2); + c3 = vec_xl(0, aoffset3); + c4 = vec_xl(0, aoffset4); + c5 = vec_xl(0, aoffset5); + c6 = vec_xl(0, aoffset6); + c7 = vec_xl(0, aoffset7); + c8 = vec_xl(0, aoffset8); + c9 = vec_xl(0, aoffset9); + c10 = vec_xl(0, aoffset10); + c11 = vec_xl(0, aoffset11); + c12 = vec_xl(0, aoffset12); + c13 = vec_xl(0, aoffset13); + c14 = vec_xl(0, aoffset14); + c15 = vec_xl(0, aoffset15); + c16 = vec_xl(0, aoffset16); + + t1 = vec_mergeh(c1, c2); + t2 = vec_mergeh(c3, c4); + t3 = vec_mergeh(c5, c6); + t4 = vec_mergeh(c7, c8); + t9 = vec_mergeh(c9, c10); + t10 = vec_mergeh(c11, c12); + t11 = vec_mergeh(c13, c14); + t12 = vec_mergeh(c15, c16); + + t5 = vec_xxpermdi(t1, t2, 0b00); + t6 = vec_xxpermdi(t3, t4, 0b00); + t7 = vec_xxpermdi(t9, t10, 0b00); + t8 = vec_xxpermdi(t11, t12, 0b00); + + vec_xst(t5, 0, boffset); + vec_xst(t6, 0, boffset+4); + vec_xst(t7, 0, boffset+8); + vec_xst(t8, 0, boffset+12); + t5 = vec_xxpermdi(t1, t2, 0b11); + t6 = vec_xxpermdi(t3, t4, 0b11); + t7 = vec_xxpermdi(t9, t10, 0b11); + t8 = vec_xxpermdi(t11, t12, 0b11); + vec_xst(t5, 0, boffset+16); + vec_xst(t6, 0, boffset+20); + vec_xst(t7, 0, boffset+24); + vec_xst(t8, 0, boffset+28); + + t1 = vec_mergel(c1, c2); + t2 = vec_mergel(c3, c4); + t3 = vec_mergel(c5, c6); + t4 = vec_mergel(c7, c8); + t9 = vec_mergel(c9, c10); + t10 = vec_mergel(c11, c12); + t11 = vec_mergel(c13, c14); + t12 = vec_mergel(c15, c16); + t5 = vec_xxpermdi(t1, t2, 0b00); + t6 = vec_xxpermdi(t3, t4, 0b00); + t7 = vec_xxpermdi(t9, t10, 0b00); + t8 = vec_xxpermdi(t11, t12, 0b00); + vec_xst(t5, 0, boffset+32); + vec_xst(t6, 0, boffset+36); + vec_xst(t7, 0, boffset+40); + vec_xst(t8, 0, boffset+44); + + t5 = vec_xxpermdi(t1, t2, 0b11); + t6 = vec_xxpermdi(t3, t4, 0b11); + t7 = vec_xxpermdi(t9, t10, 0b11); + t8 = vec_xxpermdi(t11, t12, 0b11); + vec_xst(t5, 0, boffset+48); + vec_xst(t6, 0, boffset+52); + vec_xst(t7, 0, boffset+56); + vec_xst(t8, 0, boffset+60); + + aoffset1 += 4; + aoffset2 += 4; + aoffset3 += 4; + aoffset4 += 4; + aoffset5 += 4; + aoffset6 += 4; + aoffset7 += 4; + aoffset8 += 4; + + aoffset9 += 4; + aoffset10 += 4; + aoffset11 += 4; + aoffset12 += 4; + aoffset13 += 4; + aoffset14 += 4; + aoffset15 += 4; + aoffset16 += 4; + boffset += 64; + + i --; + }while(i > 0); + } + i = (m & 3); + if (i > 0){ + do{ + ctemp01 = *(aoffset1 + 0); + ctemp03 = *(aoffset2 + 0); + ctemp05 = *(aoffset3 + 0); + ctemp07 = *(aoffset4 + 0); + ctemp09 = *(aoffset5 + 0); + ctemp11 = *(aoffset6 + 0); + ctemp13 = *(aoffset7 + 0); + ctemp15 = *(aoffset8 + 0); + + ctemp17 = *(aoffset9 + 0); + ctemp19 = *(aoffset10 + 0); + ctemp21 = *(aoffset11 + 0); + ctemp23 = *(aoffset12 + 0); + ctemp25 = *(aoffset13 + 0); + ctemp27 = *(aoffset14 + 0); + ctemp29 = *(aoffset15 + 0); + ctemp31 = *(aoffset16 + 0); + *(boffset + 0) = ctemp01; + *(boffset + 1) = ctemp03; + *(boffset + 2) = ctemp05; + *(boffset + 3) = ctemp07; + *(boffset + 4) = ctemp09; + *(boffset + 5) = ctemp11; + *(boffset + 6) = ctemp13; + *(boffset + 7) = ctemp15; + + *(boffset + 8) = ctemp17; + *(boffset + 9) = ctemp19; + *(boffset + 10) = ctemp21; + *(boffset + 11) = ctemp23; + *(boffset + 12) = ctemp25; + *(boffset + 13) = ctemp27; + *(boffset + 14) = ctemp29; + *(boffset + 15) = ctemp31; + aoffset1+=1; + aoffset2+=1; + aoffset3+=1; + aoffset4+=1; + aoffset5+=1; + aoffset6+=1; + aoffset7+=1; + aoffset8+=1; + aoffset9+=1; + aoffset10+=1; + aoffset11+=1; + aoffset12+=1; + aoffset13+=1; + aoffset14+=1; + aoffset15+=1; + aoffset16+=1; + boffset += 16; + i --; + }while(i > 0); + } + j--; + }while(j > 0); + } /* end of if(j > 0) */ + + if (n & 8){ + aoffset1 = aoffset; + aoffset2 = aoffset1 + lda; + aoffset3 = aoffset2 + lda; + aoffset4 = aoffset3 + lda; + aoffset5 = aoffset4 + lda; + aoffset6 = aoffset5 + lda; + aoffset7 = aoffset6 + lda; + aoffset8 = aoffset7 + lda; + aoffset += 8 * lda; + + i = (m >> 2); + if (i > 0){ + vector float c1, c2, c3, c4, c5, c6, c7, c8; + vector float t1, t2, t3, t4, t5, t6, t7, t8; + do{ + c1 = vec_xl(0, aoffset1); + c2 = vec_xl(0, aoffset2); + c3 = vec_xl(0, aoffset3); + c4 = vec_xl(0, aoffset4); + c5 = vec_xl(0, aoffset5); + c6 = vec_xl(0, aoffset6); + c7 = vec_xl(0, aoffset7); + c8 = vec_xl(0, aoffset8); + + t1 = vec_mergeh(c1, c2); + t2 = vec_mergeh(c3, c4); + t3 = vec_mergeh(c5, c6); + t4 = vec_mergeh(c7, c8); + + t5 = vec_xxpermdi(t1, t2, 0b00); + t6 = vec_xxpermdi(t3, t4, 0b00); + t7 = vec_xxpermdi(t1, t2, 0b11); + t8 = vec_xxpermdi(t3, t4, 0b11); + + vec_xst(t5, 0, boffset); + vec_xst(t6, 0, boffset+4); + vec_xst(t7, 0, boffset+8); + vec_xst(t8, 0, boffset+12); + + t1 = vec_mergel(c1, c2); + t2 = vec_mergel(c3, c4); + t3 = vec_mergel(c5, c6); + t4 = vec_mergel(c7, c8); + + t5 = vec_xxpermdi(t1, t2, 0b00); + t6 = vec_xxpermdi(t3, t4, 0b00); + t7 = vec_xxpermdi(t1, t2, 0b11); + t8 = vec_xxpermdi(t3, t4, 0b11); + + vec_xst(t5, 0, boffset+16); + vec_xst(t6, 0, boffset+20); + vec_xst(t7, 0, boffset+24); + vec_xst(t8, 0, boffset+28); + + aoffset1 += 4; + aoffset2 += 4; + aoffset3 += 4; + aoffset4 += 4; + aoffset5 += 4; + aoffset6 += 4; + aoffset7 += 4; + aoffset8 += 4; + + boffset += 32; + i--; + }while(i > 0); + } + + i = (m & 3); + if (i > 0) { + do { + ctemp01 = *(aoffset1 + 0); + ctemp03 = *(aoffset2 + 0); + ctemp05 = *(aoffset3 + 0); + ctemp07 = *(aoffset4 + 0); + ctemp09 = *(aoffset5 + 0); + ctemp11 = *(aoffset6 + 0); + ctemp13 = *(aoffset7 + 0); + ctemp15 = *(aoffset8 + 0); + + *(boffset + 0) = ctemp01; + *(boffset + 1) = ctemp03; + *(boffset + 2) = ctemp05; + *(boffset + 3) = ctemp07; + *(boffset + 4) = ctemp09; + *(boffset + 5) = ctemp11; + *(boffset + 6) = ctemp13; + *(boffset + 7) = ctemp15; + + aoffset1+=1; + aoffset2+=1; + aoffset3+=1; + aoffset4+=1; + aoffset5+=1; + aoffset6+=1; + aoffset7+=1; + aoffset8+=1; + + boffset += 8; + i--; + } while (i > 0); + } + } + + if (n & 4){ + aoffset1 = aoffset; + aoffset2 = aoffset1 + lda; + aoffset3 = aoffset2 + lda; + aoffset4 = aoffset3 + lda; + aoffset += 4 * lda; + + i = (m >> 2); + if (i > 0){ + vector float c1, c2, c3, c4; + vector float t1, t2, t3, t4; + do{ + c1 = vec_xl(0, aoffset1); + c2 = vec_xl(0, aoffset2); + c3 = vec_xl(0, aoffset3); + c4 = vec_xl(0, aoffset4); + + t1 = vec_mergeh(c1, c2); + t2 = vec_mergeh(c3, c4); + + t3 = vec_xxpermdi(t1, t2, 0b00); + t4 = vec_xxpermdi(t1, t2, 0b11); + + vec_xst(t3, 0, boffset); + vec_xst(t4, 0, boffset+4); + + t1 = vec_mergel(c1, c2); + t2 = vec_mergel(c3, c4); + + t3 = vec_xxpermdi(t1, t2, 0b00); + t4 = vec_xxpermdi(t1, t2, 0b11); + + vec_xst(t3, 0, boffset+8); + vec_xst(t4, 0, boffset+12); + + aoffset1 += 4; + aoffset2 += 4; + aoffset3 += 4; + aoffset4 += 4; + + boffset += 16; + i--; + }while(i > 0); + } + + i = (m & 3); + if (i > 0) { + do { + ctemp01 = *(aoffset1 + 0); + ctemp03 = *(aoffset2 + 0); + ctemp05 = *(aoffset3 + 0); + ctemp07 = *(aoffset4 + 0); + + *(boffset + 0) = ctemp01; + *(boffset + 1) = ctemp03; + *(boffset + 2) = ctemp05; + *(boffset + 3) = ctemp07; + + aoffset1+=1; + aoffset2+=1; + aoffset3+=1; + aoffset4+=1; + + boffset += 4; + i--; + } while (i > 0); + } + } + + if (n & 2){ + aoffset1 = aoffset; + aoffset2 = aoffset1 + lda; + aoffset += 2 * lda; + + i = (m >> 1); + if (i > 0){ + do{ + ctemp01 = *(aoffset1 + 0); + ctemp02 = *(aoffset1 + 1); + ctemp03 = *(aoffset2 + 0); + ctemp04 = *(aoffset2 + 1); + + *(boffset + 0) = ctemp01; + *(boffset + 1) = ctemp03; + *(boffset + 2) = ctemp02; + *(boffset + 3) = ctemp04; + + aoffset1 += 2; + aoffset2 += 2; + boffset += 4; + + i --; + }while(i > 0); + } + + if (m & 1){ + ctemp01 = *(aoffset1 + 0); + ctemp03 = *(aoffset2 + 0); + + *(boffset + 0) = ctemp01; + *(boffset + 1) = ctemp03; + boffset += 2; + } + } + + if (n & 1){ + aoffset1 = aoffset; + + i = (m >> 1); + if (i > 0){ + do{ + ctemp01 = *(aoffset1 + 0); + ctemp02 = *(aoffset1 + 1); + + *(boffset + 0) = ctemp01; + *(boffset + 1) = ctemp02; + + aoffset1 += 2; + boffset += 2; + + i --; + }while(i > 0); + } + + if (m & 1){ + ctemp01 = *(aoffset1 + 0); + + *(boffset + 0) = ctemp01; + // boffset += 1; + } + } + + return 0; +} From 969601a1dcfdc4c44174346b7c752fa338f00737 Mon Sep 17 00:00:00 2001 From: gxw Date: Wed, 31 Jan 2024 11:20:25 +0800 Subject: [PATCH 096/311] X86_64: Fixed bug in zscal Fixed handling of NAN and INF arguments when inc is greater than 1. --- kernel/x86_64/zscal.c | 91 ++++++++++++++++++++++++------------------- 1 file changed, 50 insertions(+), 41 deletions(-) diff --git a/kernel/x86_64/zscal.c b/kernel/x86_64/zscal.c index 66c8a0d2b..bc79c0caf 100644 --- a/kernel/x86_64/zscal.c +++ b/kernel/x86_64/zscal.c @@ -69,16 +69,16 @@ static void zscal_kernel_8( BLASLONG n, FLOAT *alpha , FLOAT *x ) for( i=0; i FLT_MAX) { + else if (da_r < -FLT_MAX || da_r > FLT_MAX) { while(j < n) { x[i]= NAN; @@ -404,7 +413,7 @@ int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT da_r, FLOAT da_i, if (x[i] < -FLT_MAX || x[i] > FLT_MAX) temp0 = NAN; x[i+1] = da_i * x[i]; - if ( x[i] == x[i]) //preserve NaN + if ( x[i] == x[i]) //preserve NaN x[i] = temp0; i += 2 ; j++; @@ -420,7 +429,7 @@ int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT da_r, FLOAT da_i, { while(j < n) { - + temp0 = da_r * x[i]; x[i+1] = da_r * x[i+1]; x[i] = temp0; @@ -442,7 +451,7 @@ int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT da_r, FLOAT da_i, } - } + } } From 1a6fdb035308370c08c740da279b769615594980 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Wed, 31 Jan 2024 15:57:57 +0100 Subject: [PATCH 097/311] Add prototypes for extensions ?AMIN/?AMAX and CAXPYC/ZAXPYC --- cblas.h | 14 +++++++++++++- 1 file changed, 13 insertions(+), 1 deletion(-) diff --git a/cblas.h b/cblas.h index ade2fca3a..3b74e25ee 100644 --- a/cblas.h +++ b/cblas.h @@ -101,6 +101,16 @@ CBLAS_INDEX cblas_idamin(OPENBLAS_CONST blasint n, OPENBLAS_CONST double *x, OPE CBLAS_INDEX cblas_icamin(OPENBLAS_CONST blasint n, OPENBLAS_CONST void *x, OPENBLAS_CONST blasint incx); CBLAS_INDEX cblas_izamin(OPENBLAS_CONST blasint n, OPENBLAS_CONST void *x, OPENBLAS_CONST blasint incx); +float cblas_samax(OPENBLAS_CONST blasint n, OPENBLAS_CONST float *x, OPENBLAS_CONST blasint incx); +double cblas_damax(OPENBLAS_CONST blasint n, OPENBLAS_CONST double *x, OPENBLAS_CONST blasint incx); +float cblas_scamax(OPENBLAS_CONST blasint n, OPENBLAS_CONST void *x, OPENBLAS_CONST blasint incx); +double cblas_dzamax(OPENBLAS_CONST blasint n, OPENBLAS_CONST void *x, OPENBLAS_CONST blasint incx); + +float cblas_samin(OPENBLAS_CONST blasint n, OPENBLAS_CONST float *x, OPENBLAS_CONST blasint incx); +double cblas_damin(OPENBLAS_CONST blasint n, OPENBLAS_CONST double *x, OPENBLAS_CONST blasint incx); +float cblas_scamin(OPENBLAS_CONST blasint n, OPENBLAS_CONST void *x, OPENBLAS_CONST blasint incx); +double cblas_dzamin(OPENBLAS_CONST blasint n, OPENBLAS_CONST void *x, OPENBLAS_CONST blasint incx); + CBLAS_INDEX cblas_ismax(OPENBLAS_CONST blasint n, OPENBLAS_CONST float *x, OPENBLAS_CONST blasint incx); CBLAS_INDEX cblas_idmax(OPENBLAS_CONST blasint n, OPENBLAS_CONST double *x, OPENBLAS_CONST blasint incx); CBLAS_INDEX cblas_icmax(OPENBLAS_CONST blasint n, OPENBLAS_CONST void *x, OPENBLAS_CONST blasint incx); @@ -116,6 +126,9 @@ void cblas_daxpy(OPENBLAS_CONST blasint n, OPENBLAS_CONST double alpha, OPENBLAS void cblas_caxpy(OPENBLAS_CONST blasint n, OPENBLAS_CONST void *alpha, OPENBLAS_CONST void *x, OPENBLAS_CONST blasint incx, void *y, OPENBLAS_CONST blasint incy); void cblas_zaxpy(OPENBLAS_CONST blasint n, OPENBLAS_CONST void *alpha, OPENBLAS_CONST void *x, OPENBLAS_CONST blasint incx, void *y, OPENBLAS_CONST blasint incy); +void cblas_caxpyc(OPENBLAS_CONST blasint n, OPENBLAS_CONST void *alpha, OPENBLAS_CONST void *x, OPENBLAS_CONST blasint incx, void *y, OPENBLAS_CONST blasint incy); +void cblas_zaxpyc(OPENBLAS_CONST blasint n, OPENBLAS_CONST void *alpha, OPENBLAS_CONST void *x, OPENBLAS_CONST blasint incx, void *y, OPENBLAS_CONST blasint incy); + void cblas_scopy(OPENBLAS_CONST blasint n, OPENBLAS_CONST float *x, OPENBLAS_CONST blasint incx, float *y, OPENBLAS_CONST blasint incy); void cblas_dcopy(OPENBLAS_CONST blasint n, OPENBLAS_CONST double *x, OPENBLAS_CONST blasint incx, double *y, OPENBLAS_CONST blasint incy); void cblas_ccopy(OPENBLAS_CONST blasint n, OPENBLAS_CONST void *x, OPENBLAS_CONST blasint incx, void *y, OPENBLAS_CONST blasint incy); @@ -290,7 +303,6 @@ void cblas_zgemm(OPENBLAS_CONST enum CBLAS_ORDER Order, OPENBLAS_CONST enum CBLA void cblas_zgemm3m(OPENBLAS_CONST enum CBLAS_ORDER Order, OPENBLAS_CONST enum CBLAS_TRANSPOSE TransA, OPENBLAS_CONST enum CBLAS_TRANSPOSE TransB, OPENBLAS_CONST blasint M, OPENBLAS_CONST blasint N, OPENBLAS_CONST blasint K, OPENBLAS_CONST void *alpha, OPENBLAS_CONST void *A, OPENBLAS_CONST blasint lda, OPENBLAS_CONST void *B, OPENBLAS_CONST blasint ldb, OPENBLAS_CONST void *beta, void *C, OPENBLAS_CONST blasint ldc); - void cblas_ssymm(OPENBLAS_CONST enum CBLAS_ORDER Order, OPENBLAS_CONST enum CBLAS_SIDE Side, OPENBLAS_CONST enum CBLAS_UPLO Uplo, OPENBLAS_CONST blasint M, OPENBLAS_CONST blasint N, OPENBLAS_CONST float alpha, OPENBLAS_CONST float *A, OPENBLAS_CONST blasint lda, OPENBLAS_CONST float *B, OPENBLAS_CONST blasint ldb, OPENBLAS_CONST float beta, float *C, OPENBLAS_CONST blasint ldc); void cblas_dsymm(OPENBLAS_CONST enum CBLAS_ORDER Order, OPENBLAS_CONST enum CBLAS_SIDE Side, OPENBLAS_CONST enum CBLAS_UPLO Uplo, OPENBLAS_CONST blasint M, OPENBLAS_CONST blasint N, From b54cda849096ade35bd2f69341e3d02fa1543512 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Wed, 31 Jan 2024 16:00:52 +0100 Subject: [PATCH 098/311] Unify creation of CBLAS interfaces for ?AMIN/?AMAX and C/ZAXPYC between gmake and cmake builds --- interface/CMakeLists.txt | 2 ++ interface/Makefile | 49 ++++++++++++++++++++++++++++++++++++---- 2 files changed, 46 insertions(+), 5 deletions(-) diff --git a/interface/CMakeLists.txt b/interface/CMakeLists.txt index 4e082928b..ed19b556a 100644 --- a/interface/CMakeLists.txt +++ b/interface/CMakeLists.txt @@ -130,6 +130,8 @@ endif () foreach (float_type ${FLOAT_TYPES}) if (${float_type} STREQUAL "COMPLEX" OR ${float_type} STREQUAL "ZCOMPLEX") + GenerateNamedObjects("zaxpy.c" "" "axpyc" ${CBLAS_FLAG} "" "" false ${float_type}) + GenerateNamedObjects("zger.c" "" "geru" ${CBLAS_FLAG} "" "" false ${float_type}) GenerateNamedObjects("zger.c" "CONJ" "gerc" ${CBLAS_FLAG} "" "" false ${float_type}) GenerateNamedObjects("zdot.c" "CONJ" "dotc" ${CBLAS_FLAG} "" "" false ${float_type}) diff --git a/interface/Makefile b/interface/Makefile index 78335357b..99859cbf5 100644 --- a/interface/Makefile +++ b/interface/Makefile @@ -270,7 +270,8 @@ CSBLAS1OBJS = \ cblas_scopy.$(SUFFIX) cblas_sdot.$(SUFFIX) cblas_sdsdot.$(SUFFIX) cblas_dsdot.$(SUFFIX) \ cblas_srot.$(SUFFIX) cblas_srotg.$(SUFFIX) cblas_srotm.$(SUFFIX) cblas_srotmg.$(SUFFIX) \ cblas_sscal.$(SUFFIX) cblas_sswap.$(SUFFIX) cblas_snrm2.$(SUFFIX) cblas_saxpby.$(SUFFIX) \ - cblas_ismin.$(SUFFIX) cblas_ismax.$(SUFFIX) cblas_ssum.$(SUFFIX) + cblas_ismin.$(SUFFIX) cblas_ismax.$(SUFFIX) cblas_ssum.$(SUFFIX) cblas_samax.$(SUFFIX) \ + cblas_samin.$(SUFFIX) CSBLAS2OBJS = \ cblas_sgemv.$(SUFFIX) cblas_sger.$(SUFFIX) cblas_ssymv.$(SUFFIX) cblas_strmv.$(SUFFIX) \ @@ -295,7 +296,8 @@ CDBLAS1OBJS = \ cblas_dcopy.$(SUFFIX) cblas_ddot.$(SUFFIX) \ cblas_drot.$(SUFFIX) cblas_drotg.$(SUFFIX) cblas_drotm.$(SUFFIX) cblas_drotmg.$(SUFFIX) \ cblas_dscal.$(SUFFIX) cblas_dswap.$(SUFFIX) cblas_dnrm2.$(SUFFIX) cblas_daxpby.$(SUFFIX) \ - cblas_idmin.$(SUFFIX) cblas_idmax.$(SUFFIX) cblas_dsum.$(SUFFIX) + cblas_idmin.$(SUFFIX) cblas_idmax.$(SUFFIX) cblas_dsum.$(SUFFIX) cblas_damax.$(SUFFIX) \ + cblas_damin.$(SUFFIX) CDBLAS2OBJS = \ cblas_dgemv.$(SUFFIX) cblas_dger.$(SUFFIX) cblas_dsymv.$(SUFFIX) cblas_dtrmv.$(SUFFIX) \ @@ -315,7 +317,7 @@ CCBLAS1OBJS = \ cblas_cdotc_sub.$(SUFFIX) cblas_cdotu_sub.$(SUFFIX) \ cblas_cscal.$(SUFFIX) cblas_csscal.$(SUFFIX) \ cblas_cswap.$(SUFFIX) cblas_scnrm2.$(SUFFIX) \ - cblas_caxpby.$(SUFFIX) \ + cblas_caxpby.$(SUFFIX) cblas_scamax.$(SUFFIX) cblas_caxpyc.$(SUFFIX) cblas_scamin.$(SUFFIX) \ cblas_icmin.$(SUFFIX) cblas_icmax.$(SUFFIX) cblas_scsum.$(SUFFIX) cblas_csrot.$(SUFFIX) cblas_crotg.$(SUFFIX) CCBLAS2OBJS = \ @@ -340,12 +342,12 @@ CXERBLAOBJ = \ CZBLAS1OBJS = \ cblas_izamax.$(SUFFIX) cblas_izamin.$(SUFFIX) cblas_dzasum.$(SUFFIX) cblas_zaxpy.$(SUFFIX) \ - cblas_zcopy.$(SUFFIX) \ + cblas_zcopy.$(SUFFIX) cblas_dzamax.$(SUFFIX) cblas_dzamin.$(SUFFIX) \ cblas_zdotc.$(SUFFIX) cblas_zdotu.$(SUFFIX) \ cblas_zdotc_sub.$(SUFFIX) cblas_zdotu_sub.$(SUFFIX) \ cblas_zscal.$(SUFFIX) cblas_zdscal.$(SUFFIX) \ cblas_zswap.$(SUFFIX) cblas_dznrm2.$(SUFFIX) \ - cblas_zaxpby.$(SUFFIX) \ + cblas_zaxpby.$(SUFFIX) cblas_zaxpyc.$(SUFFIX) \ cblas_izmin.$(SUFFIX) cblas_izmax.$(SUFFIX) cblas_dzsum.$(SUFFIX) cblas_zdrot.$(SUFFIX) cblas_zrotg.$(SUFFIX) @@ -1533,6 +1535,30 @@ cblas_icmin.$(SUFFIX) cblas_icmin.$(PSUFFIX) : imax.c cblas_izmin.$(SUFFIX) cblas_izmin.$(PSUFFIX) : imax.c $(CC) $(CFLAGS) -DCBLAS -c -UUSE_ABS -DUSE_MIN $< -o $(@F) +cblas_samax.$(SUFFIX) cblas_samax.$(PSUFFIX) : max.c + $(CC) $(CFLAGS) -DCBLAS -c -DUSE_ABS -UUSE_MIN $< -o $(@F) + +cblas_damax.$(SUFFIX) cblas_damax.$(PSUFFIX) : max.c + $(CC) $(CFLAGS) -DCBLAS -c -DUSE_ABS -UUSE_MIN $< -o $(@F) + +cblas_camax.$(SUFFIX) cblas_camax.$(PSUFFIX) : max.c + $(CC) $(CFLAGS) -DCBLAS -c -DUSE_ABS -UUSE_MIN $< -o $(@F) + +cblas_zamax.$(SUFFIX) cblas_zamax.$(PSUFFIX) : max.c + $(CC) $(CFLAGS) -DCBLAS -c -DUSE_ABS -UUSE_MIN $< -o $(@F) + +cblas_samin.$(SUFFIX) cblas_samin.$(PSUFFIX) : max.c + $(CC) $(CFLAGS) -DCBLAS -c -DUSE_ABS -DUSE_MIN $< -o $(@F) + +cblas_damin.$(SUFFIX) cblas_damin.$(PSUFFIX) : max.c + $(CC) $(CFLAGS) -DCBLAS -c -DUSE_ABS -DUSE_MIN $< -o $(@F) + +cblas_camin.$(SUFFIX) cblas_camin.$(PSUFFIX) : max.c + $(CC) $(CFLAGS) -DCBLAS -c -DUSE_ABS -DUSE_MIN $< -o $(@F) + +cblas_zamin.$(SUFFIX) cblas_zamin.$(PSUFFIX) : max.c + $(CC) $(CFLAGS) -DCBLAS -c -DUSE_ABS -DUSE_MIN $< -o $(@F) + cblas_sasum.$(SUFFIX) cblas_sasum.$(PSUFFIX) : asum.c $(CC) $(CFLAGS) -DCBLAS -c $< -o $(@F) @@ -1627,6 +1653,19 @@ cblas_daxpy.$(SUFFIX) cblas_daxpy.$(PSUFFIX) : axpy.c cblas_caxpy.$(SUFFIX) cblas_caxpy.$(PSUFFIX) : zaxpy.c $(CC) $(CFLAGS) -DCBLAS -c $< -o $(@F) +cblas_caxpyc.$(SUFFIX) cblas_caxpyc.$(PSUFFIX) : zaxpy.c + $(CC) $(CFLAGS) -DCBLAS -c -DCONJ $< -o $(@F) + +cblas_zaxpyc.$(SUFFIX) cblas_zaxpyc.$(PSUFFIX) : zaxpy.c + $(CC) $(CFLAGS) -DCBLAS -c -DCONJ $< -o $(@F) + +cblas_xaxpyc.$(SUFFIX) cblas_xaxpyc.$(PSUFFIX) : zaxpy.c + $(CC) $(CFLAGS) -DCBLAS -c -DCONJ $< -o $(@F) + +sscal.$(SUFFIX) sscal.$(PSUFFIX) : scal.c + $(CC) $(CFLAGS) -c $< -o $(@F) + +dscal.$(SUFFIX) dscal.$(PSUFFIX) : scal.c cblas_zaxpy.$(SUFFIX) cblas_zaxpy.$(PSUFFIX) : zaxpy.c $(CC) $(CFLAGS) -DCBLAS -c $< -o $(@F) From a7d004e820f1ccbc9f61b4b1353ccdb04f208690 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Wed, 31 Jan 2024 17:55:42 +0100 Subject: [PATCH 099/311] Fix CBLAS prototype --- interface/max.c | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/interface/max.c b/interface/max.c index f05977448..6c7d32bd9 100644 --- a/interface/max.c +++ b/interface/max.c @@ -145,8 +145,13 @@ FLOATRET NAME(blasint *N, FLOAT *x, blasint *INCX){ #else +#ifdef COMPLEX +FLOAT CNAME(blasint n, void *vx, blasint incx){ + FLOAT *x = (FLOAT*) vx; +#else FLOAT CNAME(blasint n, FLOAT *x, blasint incx){ - +#endif + FLOAT ret; PRINT_DEBUG_CNAME; From 47bd06476312598eea694f19a00a9191041b1586 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Wed, 31 Jan 2024 20:49:43 +0100 Subject: [PATCH 100/311] Fix names in build rules --- interface/Makefile | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/interface/Makefile b/interface/Makefile index 99859cbf5..ad4a0fb89 100644 --- a/interface/Makefile +++ b/interface/Makefile @@ -1541,10 +1541,10 @@ cblas_samax.$(SUFFIX) cblas_samax.$(PSUFFIX) : max.c cblas_damax.$(SUFFIX) cblas_damax.$(PSUFFIX) : max.c $(CC) $(CFLAGS) -DCBLAS -c -DUSE_ABS -UUSE_MIN $< -o $(@F) -cblas_camax.$(SUFFIX) cblas_camax.$(PSUFFIX) : max.c +cblas_scamax.$(SUFFIX) cblas_scamax.$(PSUFFIX) : max.c $(CC) $(CFLAGS) -DCBLAS -c -DUSE_ABS -UUSE_MIN $< -o $(@F) -cblas_zamax.$(SUFFIX) cblas_zamax.$(PSUFFIX) : max.c +cblas_dzamax.$(SUFFIX) cblas_dzamax.$(PSUFFIX) : max.c $(CC) $(CFLAGS) -DCBLAS -c -DUSE_ABS -UUSE_MIN $< -o $(@F) cblas_samin.$(SUFFIX) cblas_samin.$(PSUFFIX) : max.c @@ -1553,10 +1553,10 @@ cblas_samin.$(SUFFIX) cblas_samin.$(PSUFFIX) : max.c cblas_damin.$(SUFFIX) cblas_damin.$(PSUFFIX) : max.c $(CC) $(CFLAGS) -DCBLAS -c -DUSE_ABS -DUSE_MIN $< -o $(@F) -cblas_camin.$(SUFFIX) cblas_camin.$(PSUFFIX) : max.c +cblas_scamin.$(SUFFIX) cblas_scamin.$(PSUFFIX) : max.c $(CC) $(CFLAGS) -DCBLAS -c -DUSE_ABS -DUSE_MIN $< -o $(@F) -cblas_zamin.$(SUFFIX) cblas_zamin.$(PSUFFIX) : max.c +cblas_dzamin.$(SUFFIX) cblas_dzamin.$(PSUFFIX) : max.c $(CC) $(CFLAGS) -DCBLAS -c -DUSE_ABS -DUSE_MIN $< -o $(@F) cblas_sasum.$(SUFFIX) cblas_sasum.$(PSUFFIX) : asum.c From 42cb567f0f9f6c8ef27558e5b61251b0805aae6d Mon Sep 17 00:00:00 2001 From: Mark Seminatore Date: Wed, 31 Jan 2024 13:24:28 -0800 Subject: [PATCH 101/311] more cleanup --- driver/others/blas_server_win32.c | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) diff --git a/driver/others/blas_server_win32.c b/driver/others/blas_server_win32.c index 68dde584b..ee6d08f8c 100644 --- a/driver/others/blas_server_win32.c +++ b/driver/others/blas_server_win32.c @@ -72,7 +72,10 @@ static HANDLE blas_threads [MAX_CPU_NUMBER]; static DWORD blas_threads_id[MAX_CPU_NUMBER]; static volatile int thread_target; // target num of live threads, volatile for cross-thread reads -static void legacy_exec(void *func, int mode, blas_arg_t *args, void *sb){ +// +// +// +static void legacy_exec(void *func, int mode, blas_arg_t *args, void *sb) { if (!(mode & BLAS_COMPLEX)) { #ifdef EXPRECISION @@ -195,8 +198,9 @@ static void legacy_exec(void *func, int mode, blas_arg_t *args, void *sb){ } } -// This is a main routine of threads. Each thread waits until job is -// queued. +// +// This is a main routine of threads. Each thread waits until job is queued. +// static DWORD WINAPI blas_thread_server(void *arg) { /* Thread identifier */ @@ -488,7 +492,7 @@ int exec_blas(BLASLONG num, blas_queue_t *queue) { // Shutdown procedure, but user don't have to call this routine. The // kernel automatically kill threads. -int BLASFUNC(blas_thread_shutdown)(void){ +int BLASFUNC(blas_thread_shutdown)(void) { int i; @@ -563,7 +567,7 @@ void goto_set_num_threads(int num_threads) thread_target = num_threads; - //increased_threads = 1; + //increased_threads = 1; if (!blas_server_avail) { // create the kickoff Event kickoff_event = CreateEvent(NULL, TRUE, FALSE, NULL); From 61c8e19f95dfefe3e586d6d83f7432b7d51299fa Mon Sep 17 00:00:00 2001 From: Chip Kerchner Date: Wed, 31 Jan 2024 15:27:50 -0600 Subject: [PATCH 102/311] Fix Makefile to support OpenMP on AIX for xlc (clang) with xlf. --- ctest/Makefile | 3 +++ test/Makefile | 3 +++ utest/Makefile | 10 ++++++++++ 3 files changed, 16 insertions(+) diff --git a/ctest/Makefile b/ctest/Makefile index af5b34a36..ad960b35a 100644 --- a/ctest/Makefile +++ b/ctest/Makefile @@ -218,6 +218,9 @@ ifeq ($(F_COMPILER), IBM) ifeq ($(C_COMPILER), GCC) CEXTRALIB += -lgomp endif +ifeq ($(C_COMPILER), CLANG) +CEXTRALIB += -lomp +endif endif endif diff --git a/test/Makefile b/test/Makefile index 56acf1c5b..5a4694ce6 100644 --- a/test/Makefile +++ b/test/Makefile @@ -276,6 +276,9 @@ ifeq ($(F_COMPILER), IBM) ifeq ($(C_COMPILER), GCC) CEXTRALIB += -lgomp endif +ifeq ($(C_COMPILER), CLANG) +CEXTRALIB += -lomp +endif endif endif diff --git a/utest/Makefile b/utest/Makefile index 8acaa3ea9..ac58d6f12 100644 --- a/utest/Makefile +++ b/utest/Makefile @@ -45,8 +45,18 @@ endif all : run_test +ifeq ($(OSNAME), AIX) +ifeq ($(USE_OPENMP), 1) +$(UTESTBIN): $(OBJS) + $(CC) $(CFLAGS) $(LDFLAGS) -o $@ $^ ../$(LIBNAME) $(EXTRALIB) +else +$(UTESTBIN): $(OBJS) + $(CC) $(CFLAGS) $(LDFLAGS) -o $@ $^ ../$(LIBNAME) $(EXTRALIB) $(FEXTRALIB) +endif +else $(UTESTBIN): $(OBJS) $(CC) $(CFLAGS) $(LDFLAGS) -o $@ $^ ../$(LIBNAME) $(EXTRALIB) $(FEXTRALIB) +endif run_test: $(UTESTBIN) ifneq ($(CROSS), 1) From a3b0ef6596d51ecfb59b0a2f6a7b0d59bc4f18b4 Mon Sep 17 00:00:00 2001 From: Sergei Lewis Date: Thu, 1 Feb 2024 10:26:02 +0000 Subject: [PATCH 103/311] Restore riscv64 fixes from develop branch: dot product double precision accumulation, zscal NaN handling --- Makefile.prebuild | 1 + kernel/riscv64/dot.c | 10 ++++ kernel/riscv64/zscal_rvv.c | 90 ++++++----------------------------- kernel/riscv64/zscal_vector.c | 79 +----------------------------- 4 files changed, 26 insertions(+), 154 deletions(-) diff --git a/Makefile.prebuild b/Makefile.prebuild index b44b50039..b7d695a75 100644 --- a/Makefile.prebuild +++ b/Makefile.prebuild @@ -57,6 +57,7 @@ endif ifeq ($(TARGET), CK860FV) TARGET_FLAGS = -march=ck860v -mcpu=ck860fv -mfdivdu -mhard-float +endif ifeq ($(TARGET), x280) TARGET_FLAGS = -march=rv64imafdcv_zba_zbb_zfh -mabi=lp64d diff --git a/kernel/riscv64/dot.c b/kernel/riscv64/dot.c index bf55998ca..8ad493a2b 100644 --- a/kernel/riscv64/dot.c +++ b/kernel/riscv64/dot.c @@ -44,14 +44,24 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y) { BLASLONG i=0; BLASLONG ix=0,iy=0; + +#if defined(DSDOT) double dot = 0.0 ; +#else + FLOAT dot = 0.0 ; +#endif if ( n < 1 ) return(dot); while(i < n) { +#if defined(DSDOT) + dot += (double) y[iy] * (double) x[ix] ; +#else dot += y[iy] * x[ix] ; +#endif + ix += inc_x ; iy += inc_y ; i++ ; diff --git a/kernel/riscv64/zscal_rvv.c b/kernel/riscv64/zscal_rvv.c index 2586c6036..ae79d9f9d 100644 --- a/kernel/riscv64/zscal_rvv.c +++ b/kernel/riscv64/zscal_rvv.c @@ -69,49 +69,26 @@ int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT da_r,FLOAT da_i, F size_t vlmax = VSETVL_MAX; FLOAT_VX2_T vx2; - if(da_r == 0.0 && da_i == 0.0) { + if(inc_x == 1) { - vr = VFMVVF_FLOAT(0.0, vlmax); - vi = VFMVVF_FLOAT(0.0, vlmax); - - if(inc_x == 1) { - - for (size_t vl; n > 0; n -= vl, x += vl*2) { - vl = VSETVL(n); - vx2 = VSET_VX2(vx2, 0, vr); - vx2 = VSET_VX2(vx2, 1, vi); - VSSEG_FLOAT(x, vx2, vl); - } - - } else { - - for (size_t vl; n > 0; n -= vl, x += vl*inc_x*2) { - vl = VSETVL(n); - vx2 = VSET_VX2(vx2, 0, vr); - vx2 = VSET_VX2(vx2, 1, vi); - VSSSEG_FLOAT(x, stride_x, vx2, vl); - } - } - - } else if(da_r == 0.0) { - - for (size_t vl; n > 0; n -= vl, x += vl*inc_x*2) { + for (size_t vl; n > 0; n -= vl, x += vl*2) { vl = VSETVL(n); - - vx2 = VLSSEG_FLOAT(x, stride_x, vl); + + vx2 = VLSEG_FLOAT(x, vl); vr = VGET_VX2(vx2, 0); vi = VGET_VX2(vx2, 1); - vt = VFMULVF_FLOAT(vi, -da_i, vl); - vi = VFMULVF_FLOAT(vr, da_i, vl); + vt = VFMULVF_FLOAT(vr, da_r, vl); + vt = VFNMSACVF_FLOAT(vt, da_i, vi, vl); + vi = VFMULVF_FLOAT(vi, da_r, vl); + vi = VFMACCVF_FLOAT(vi, da_i, vr, vl); vx2 = VSET_VX2(vx2, 0, vt); vx2 = VSET_VX2(vx2, 1, vi); - - VSSSEG_FLOAT(x, stride_x, vx2, vl); + VSSEG_FLOAT(x, vx2, vl); } - } else if(da_i == 0.0) { + } else { for (size_t vl; n > 0; n -= vl, x += vl*inc_x*2) { vl = VSETVL(n); @@ -120,54 +97,15 @@ int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT da_r,FLOAT da_i, F vr = VGET_VX2(vx2, 0); vi = VGET_VX2(vx2, 1); - vr = VFMULVF_FLOAT(vr, da_r, vl); + vt = VFMULVF_FLOAT(vr, da_r, vl); + vt = VFNMSACVF_FLOAT(vt, da_i, vi, vl); vi = VFMULVF_FLOAT(vi, da_r, vl); + vi = VFMACCVF_FLOAT(vi, da_i, vr, vl); - vx2 = VSET_VX2(vx2, 0, vr); + vx2 = VSET_VX2(vx2, 0, vt); vx2 = VSET_VX2(vx2, 1, vi); VSSSEG_FLOAT(x, stride_x, vx2, vl); } - - } else { - - if(inc_x == 1) { - - for (size_t vl; n > 0; n -= vl, x += vl*2) { - vl = VSETVL(n); - - vx2 = VLSEG_FLOAT(x, vl); - vr = VGET_VX2(vx2, 0); - vi = VGET_VX2(vx2, 1); - - vt = VFMULVF_FLOAT(vr, da_r, vl); - vt = VFNMSACVF_FLOAT(vt, da_i, vi, vl); - vi = VFMULVF_FLOAT(vi, da_r, vl); - vi = VFMACCVF_FLOAT(vi, da_i, vr, vl); - - vx2 = VSET_VX2(vx2, 0, vt); - vx2 = VSET_VX2(vx2, 1, vi); - VSSEG_FLOAT(x, vx2, vl); - } - - } else { - - for (size_t vl; n > 0; n -= vl, x += vl*inc_x*2) { - vl = VSETVL(n); - - vx2 = VLSSEG_FLOAT(x, stride_x, vl); - vr = VGET_VX2(vx2, 0); - vi = VGET_VX2(vx2, 1); - - vt = VFMULVF_FLOAT(vr, da_r, vl); - vt = VFNMSACVF_FLOAT(vt, da_i, vi, vl); - vi = VFMULVF_FLOAT(vi, da_r, vl); - vi = VFMACCVF_FLOAT(vi, da_i, vr, vl); - - vx2 = VSET_VX2(vx2, 0, vt); - vx2 = VSET_VX2(vx2, 1, vi); - VSSSEG_FLOAT(x, stride_x, vx2, vl); - } - } } return(0); diff --git a/kernel/riscv64/zscal_vector.c b/kernel/riscv64/zscal_vector.c index 2034aafaa..536bbdf73 100644 --- a/kernel/riscv64/zscal_vector.c +++ b/kernel/riscv64/zscal_vector.c @@ -59,84 +59,7 @@ int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT da_r,FLOAT da_i, F unsigned int gvl = 0; FLOAT_V_T vt, v0, v1; - if(da_r == 0.0 && da_i == 0.0){ - gvl = VSETVL(n); - BLASLONG stride_x = inc_x * 2 * sizeof(FLOAT); - BLASLONG inc_xv = inc_x * 2 * gvl; - vt = VFMVVF_FLOAT(0.0, gvl); - for(i=0,j=0; i < n/(gvl*2); i++){ - VSSEV_FLOAT(&x[ix], stride_x, vt, gvl); - VSSEV_FLOAT(&x[ix+1], stride_x, vt, gvl); - VSSEV_FLOAT(&x[ix+inc_xv], stride_x, vt, gvl); - VSSEV_FLOAT(&x[ix+inc_xv+1], stride_x, vt, gvl); - - j += gvl*2; - ix += inc_xv*2; - } - for(; j < n; ){ - gvl = VSETVL(n-j); - VSSEV_FLOAT(&x[ix], stride_x, vt, gvl); - VSSEV_FLOAT(&x[ix+1], stride_x, vt, gvl); - j += gvl; - ix += inc_x * 2 * gvl; - } - }else if(da_r == 0.0){ - gvl = VSETVL(n); - BLASLONG stride_x = inc_x * 2 * sizeof(FLOAT); - BLASLONG inc_xv = inc_x * 2 * gvl; - for(i=0,j=0; i < n/gvl; i++){ - v0 = VLSEV_FLOAT(&x[ix], stride_x, gvl); - v1 = VLSEV_FLOAT(&x[ix+1], stride_x, gvl); - - vt = VFMULVF_FLOAT(v1, -da_i, gvl); - v1 = VFMULVF_FLOAT(v0, da_i, gvl); - - VSSEV_FLOAT(&x[ix], stride_x, vt, gvl); - VSSEV_FLOAT(&x[ix+1], stride_x, v1, gvl); - - j += gvl; - ix += inc_xv; - } - if(j < n){ - gvl = VSETVL(n-j); - v0 = VLSEV_FLOAT(&x[ix], stride_x, gvl); - v1 = VLSEV_FLOAT(&x[ix+1], stride_x, gvl); - - vt = VFMULVF_FLOAT(v1, -da_i, gvl); - v1 = VFMULVF_FLOAT(v0, da_i, gvl); - - VSSEV_FLOAT(&x[ix], stride_x, vt, gvl); - VSSEV_FLOAT(&x[ix+1], stride_x, v1, gvl); - } - }else if(da_i == 0.0){ - gvl = VSETVL(n); - BLASLONG stride_x = inc_x * 2 * sizeof(FLOAT); - BLASLONG inc_xv = inc_x * 2 * gvl; - for(i=0,j=0; i < n/gvl; i++){ - v0 = VLSEV_FLOAT(&x[ix], stride_x, gvl); - v1 = VLSEV_FLOAT(&x[ix+1], stride_x, gvl); - - vt = VFMULVF_FLOAT(v0, da_r, gvl); - v1 = VFMULVF_FLOAT(v1, da_r, gvl); - - VSSEV_FLOAT(&x[ix], stride_x, vt, gvl); - VSSEV_FLOAT(&x[ix+1], stride_x, v1, gvl); - - j += gvl; - ix += inc_xv; - } - if(j < n){ - gvl = VSETVL(n-j); - v0 = VLSEV_FLOAT(&x[ix], stride_x, gvl); - v1 = VLSEV_FLOAT(&x[ix+1], stride_x, gvl); - - vt = VFMULVF_FLOAT(v0, da_r, gvl); - v1 = VFMULVF_FLOAT(v1, da_r, gvl); - - VSSEV_FLOAT(&x[ix], stride_x, vt, gvl); - VSSEV_FLOAT(&x[ix+1], stride_x, v1, gvl); - } - }else{ + { gvl = VSETVL(n); BLASLONG stride_x = inc_x * 2 * sizeof(FLOAT); BLASLONG inc_xv = inc_x * 2 * gvl; From 2bb7ea64a197c04ce36927530394db5400242d20 Mon Sep 17 00:00:00 2001 From: Chip Kerchner Date: Thu, 1 Feb 2024 08:11:43 -0600 Subject: [PATCH 104/311] Only vectorize 64-bit version for Power8. --- kernel/power/KERNEL.POWER8 | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/kernel/power/KERNEL.POWER8 b/kernel/power/KERNEL.POWER8 index 36222348a..700a68e44 100644 --- a/kernel/power/KERNEL.POWER8 +++ b/kernel/power/KERNEL.POWER8 @@ -1,9 +1,11 @@ # Big-endian 32bit (AIX) is supported through the POWER6 GEMM kernels, no separate TRMM ifeq ($(__BYTE_ORDER__)$(BINARY32),__ORDER_BIG_ENDIAN__1) SGEMMKERNEL = gemm_kernel_power6.S +SGEMMINCOPY = SGEMMITCOPY = SGEMMONCOPY = gemm_ncopy_4.S SGEMMOTCOPY = gemm_tcopy_4.S +SGEMMINCOPYOBJ = SGEMMITCOPYOBJ = SGEMMONCOPYOBJ = sgemm_oncopy$(TSUFFIX).$(SUFFIX) SGEMMOTCOPYOBJ = sgemm_otcopy$(TSUFFIX).$(SUFFIX) @@ -48,9 +50,11 @@ CTRMMKERNEL = ctrmm_kernel_8x4_power8.S ZTRMMKERNEL = ztrmm_kernel_8x2_power8.S SGEMMKERNEL = sgemm_kernel_16x8_power8.S +SGEMMINCOPY = sgemm_ncopy_16_power.c SGEMMITCOPY = sgemm_tcopy_16_power8.S SGEMMONCOPY = ../generic/gemm_ncopy_8.c SGEMMOTCOPY = sgemm_tcopy_8_power8.S +SGEMMINCOPYOBJ = sgemm_incopy$(TSUFFIX).$(SUFFIX) SGEMMITCOPYOBJ = sgemm_itcopy$(TSUFFIX).$(SUFFIX) SGEMMONCOPYOBJ = sgemm_oncopy$(TSUFFIX).$(SUFFIX) SGEMMOTCOPYOBJ = sgemm_otcopy$(TSUFFIX).$(SUFFIX) @@ -86,9 +90,6 @@ ZGEMMINCOPYOBJ = zgemm_incopy$(TSUFFIX).$(SUFFIX) ZGEMMITCOPYOBJ = zgemm_itcopy$(TSUFFIX).$(SUFFIX) endif -SGEMMINCOPY = sgemm_ncopy_16_power.c -SGEMMINCOPYOBJ = sgemm_incopy$(TSUFFIX).$(SUFFIX) - STRSMKERNEL_LN = ../generic/trsm_kernel_LN.c STRSMKERNEL_LT = ../generic/trsm_kernel_LT.c STRSMKERNEL_RN = ../generic/trsm_kernel_RN.c From ddac75e0efef0deeb8ea189e69909371db13f0ef Mon Sep 17 00:00:00 2001 From: austinpagan Date: Thu, 1 Feb 2024 12:24:25 -0600 Subject: [PATCH 105/311] Adding .C versions of CGEMM and ZGEMM --- kernel/power/KERNEL.POWER10 | 24 +- kernel/power/cgemm_kernel_power10.c | 1154 +++++++++++++++++++++++++++ kernel/power/zgemm_kernel_power10.c | 761 ++++++++++++++++++ 3 files changed, 1931 insertions(+), 8 deletions(-) create mode 100644 kernel/power/cgemm_kernel_power10.c create mode 100644 kernel/power/zgemm_kernel_power10.c diff --git a/kernel/power/KERNEL.POWER10 b/kernel/power/KERNEL.POWER10 index 9047c714c..5f49b9c46 100644 --- a/kernel/power/KERNEL.POWER10 +++ b/kernel/power/KERNEL.POWER10 @@ -17,11 +17,15 @@ SBGEMMOTCOPYOBJ = sbgemm_otcopy$(TSUFFIX).$(SUFFIX) STRMMKERNEL = sgemm_kernel_power10.c DTRMMKERNEL = dgemm_kernel_power10.c ifeq ($(OSNAME), AIX) -CTRMMKERNEL = ctrmm_kernel_8x4_power8.S -ZTRMMKERNEL = ztrmm_kernel_8x2_power8.S +#CTRMMKERNEL = ctrmm_kernel_8x4_power8.S +#ZTRMMKERNEL = ztrmm_kernel_8x2_power8.S +CTRMMKERNEL = cgemm_kernel_power10.c +ZTRMMKERNEL = zgemm_kernel_power10.c else -CTRMMKERNEL = cgemm_kernel_power10.S -ZTRMMKERNEL = zgemm_kernel_power10.S +#CTRMMKERNEL = cgemm_kernel_power10.S +#ZTRMMKERNEL = zgemm_kernel_power10.S +CTRMMKERNEL = cgemm_kernel_power10.c +ZTRMMKERNEL = zgemm_kernel_power10.c endif SGEMMKERNEL = sgemm_kernel_power10.c @@ -65,9 +69,11 @@ DGEMM_SMALL_K_TN = dgemm_small_kernel_tn_power10.c DGEMM_SMALL_K_B0_TN = dgemm_small_kernel_tn_power10.c ifeq ($(OSNAME), AIX) -CGEMMKERNEL = cgemm_kernel_8x4_power8.S +#CGEMMKERNEL = cgemm_kernel_8x4_power8.S +CGEMMKERNEL = cgemm_kernel_power10.c else -CGEMMKERNEL = cgemm_kernel_power10.S +#CGEMMKERNEL = cgemm_kernel_power10.S +CGEMMKERNEL = cgemm_kernel_power10.c endif #CGEMMKERNEL = cgemm_kernel_8x4_power8.S CGEMMINCOPY = ../generic/zgemm_ncopy_8.c @@ -84,9 +90,11 @@ CGEMMINCOPYOBJ = cgemm_incopy$(TSUFFIX).$(SUFFIX) CGEMMITCOPYOBJ = cgemm_itcopy$(TSUFFIX).$(SUFFIX) ifeq ($(OSNAME), AIX) -ZGEMMKERNEL = zgemm_kernel_8x2_power8.S +#ZGEMMKERNEL = zgemm_kernel_8x2_power8.S +ZGEMMKERNEL = zgemm_kernel_power10.c else -ZGEMMKERNEL = zgemm_kernel_power10.S +#ZGEMMKERNEL = zgemm_kernel_power10.S +ZGEMMKERNEL = zgemm_kernel_power10.c endif ZGEMMONCOPY = ../generic/zgemm_ncopy_2.c ZGEMMOTCOPY = ../generic/zgemm_tcopy_2.c diff --git a/kernel/power/cgemm_kernel_power10.c b/kernel/power/cgemm_kernel_power10.c new file mode 100644 index 000000000..279c83aec --- /dev/null +++ b/kernel/power/cgemm_kernel_power10.c @@ -0,0 +1,1154 @@ +/********************************************************************************* +Copyright (c) 2020, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" +#include + +typedef __vector unsigned char vec_t; +typedef FLOAT v4sf_t __attribute__ ((vector_size (16))); +typedef FLOAT v2sf_t __attribute__ ((vector_size (8))); + +#define SET_ACC_ZERO() \ + __builtin_mma_xxsetaccz (&acc0); \ + __builtin_mma_xxsetaccz (&acc1); \ + __builtin_mma_xxsetaccz (&acc2); \ + __builtin_mma_xxsetaccz (&acc3); \ + __builtin_mma_xxsetaccz (&acc4); \ + __builtin_mma_xxsetaccz (&acc5); \ + __builtin_mma_xxsetaccz (&acc6); \ + __builtin_mma_xxsetaccz (&acc7); + +#if (defined(NN) || defined(NT) || defined(TN) || defined(TT)) +#define COMP_MUL(_real, _arbr, _aibi, _imag, _arbi, _aibr) { _real = _arbr - _aibi; _imag = _arbi + _aibr; } +#define COMP_MAC(_real, _arbr, _aibi, _imag, _arbi, _aibr) { _real += _arbr - _aibi; _imag += _arbi + _aibr; } +#endif + +#if (defined(NR) || defined(NC) || defined(TR) || defined(TC)) +#define COMP_MUL(_real, _arbr, _aibi, _imag, _arbi, _aibr) { _real = _arbr + _aibi; _imag = -_arbi + _aibr; } +#define COMP_MAC(_real, _arbr, _aibi, _imag, _arbi, _aibr) { _real += _arbr + _aibi; _imag += -_arbi + _aibr; } +#endif + +#if (defined(RN) || defined(RT) || defined(CN) || defined(CT)) +#define COMP_MUL(_real, _arbr, _aibi, _imag, _arbi, _aibr) { _real = _arbr + _aibi; _imag = _arbi - _aibr; } +#define COMP_MAC(_real, _arbr, _aibi, _imag, _arbi, _aibr) { _real += _arbr + _aibi; _imag += _arbi - _aibr; } +#endif + +#if (defined(RR) || defined(RC) || defined(CR) || defined(CC)) +#define COMP_MUL(_real, _arbr, _aibi, _imag, _arbi, _aibr) { _real = _arbr - _aibi; _imag = -_arbi - _aibr; } +#define COMP_MAC(_real, _arbr, _aibi, _imag, _arbi, _aibr) { _real += _arbr - _aibi; _imag += -_arbi - _aibr; } +#endif + +#if defined (TRMMKERNEL) +#define A_OP = +#else +#define A_OP += +#endif + +#define BUILTIN_MMA_DISASSEMBLE_ACC_8 \ + __builtin_mma_disassemble_acc ((void *)result, &acc0); \ + __builtin_mma_disassemble_acc ((void *)&result[ 4], &acc1); \ + __builtin_mma_disassemble_acc ((void *)&result[ 8], &acc2); \ + __builtin_mma_disassemble_acc ((void *)&result[12], &acc3); \ + __builtin_mma_disassemble_acc ((void *)&result[16], &acc4); \ + __builtin_mma_disassemble_acc ((void *)&result[20], &acc5); \ + __builtin_mma_disassemble_acc ((void *)&result[24], &acc6); \ + __builtin_mma_disassemble_acc ((void *)&result[28], &acc7); + +#define COMP_MUL_1 \ + COMP_MUL(tr[0], res[ 0], res[ 5], ti[0], res[ 1], res[ 4]) + +#define COMP_MAC_1(_offset) { \ + FLOAT *_ro = &res[_offset]; \ + COMP_MAC(tr[0], _ro[ 0], _ro[ 5], ti[0], _ro[ 1], _ro[ 4]) \ +} + +#define COMP_MUL_2A \ + COMP_MUL(tr[0], res[ 0], res[ 5], ti[0], res[ 1], res[ 4]) \ + COMP_MUL(tr[1], res[ 2], res[ 7], ti[1], res[ 3], res[ 6]) + +#define COMP_MAC_2A(_offset) { \ + FLOAT *_ro = &res[_offset]; \ + COMP_MAC(tr[0], _ro[ 0], _ro[ 5], ti[0], _ro[ 1], _ro[ 4]) \ + COMP_MAC(tr[1], _ro[ 2], _ro[ 7], ti[1], _ro[ 3], _ro[ 6]) \ +} + +#define COMP_MUL_2B \ + COMP_MUL(tr[0], res[ 0], res[ 5], ti[0], res[ 1], res[ 4]) \ + COMP_MUL(tr[1], res[ 8], res[13], ti[1], res[ 9], res[12]) + +#define COMP_MAC_2B(_offset) { \ + FLOAT *_ro = &res[_offset]; \ + COMP_MAC(tr[0], _ro[ 0], _ro[ 5], ti[0], _ro[ 1], _ro[ 4]) \ + COMP_MAC(tr[1], _ro[ 8], _ro[13], ti[1], _ro[ 9], _ro[12]) \ +} + +#define COMP_MUL_4A(_offset) { \ + FLOAT *_ro = &res[_offset]; \ + COMP_MUL(tr[0], _ro[ 0], _ro[ 5], ti[0], _ro[ 1], _ro[ 4]) \ + COMP_MUL(tr[1], _ro[ 8], _ro[13], ti[1], _ro[ 9], _ro[12]) \ + COMP_MUL(tr[2], _ro[16], _ro[21], ti[2], _ro[17], _ro[20]) \ + COMP_MUL(tr[3], _ro[24], _ro[29], ti[3], _ro[25], _ro[28]) \ +} + +#define COMP_MAC_4A(_offset) { \ + FLOAT *_ro = &res[_offset]; \ + COMP_MAC(tr[0], _ro[ 0], _ro[ 5], ti[0], _ro[ 1], _ro[ 4]) \ + COMP_MAC(tr[1], _ro[ 8], _ro[13], ti[1], _ro[ 9], _ro[12]) \ + COMP_MAC(tr[2], _ro[16], _ro[21], ti[2], _ro[17], _ro[20]) \ + COMP_MAC(tr[3], _ro[24], _ro[29], ti[3], _ro[25], _ro[28]) \ +} + +#define COMP_MUL_4B(_offset) { \ + FLOAT *_ro = &res[_offset]; \ + COMP_MUL(tr[0], _ro[ 0], _ro[ 5], ti[0], _ro[ 1], _ro[ 4]) \ + COMP_MUL(tr[1], _ro[ 8], _ro[13], ti[1], _ro[ 9], _ro[12]) \ + COMP_MUL(tr[2], _ro[ 2], _ro[ 7], ti[2], _ro[ 3], _ro[ 6]) \ + COMP_MUL(tr[3], _ro[10], _ro[15], ti[3], _ro[11], _ro[14]) \ +} + +#define COMP_MAC_4B(_offset) { \ + FLOAT *_ro = &res[_offset]; \ + COMP_MAC(tr[0], _ro[ 0], _ro[ 5], ti[0], _ro[ 1], _ro[ 4]) \ + COMP_MAC(tr[1], _ro[ 8], _ro[13], ti[1], _ro[ 9], _ro[12]) \ + COMP_MAC(tr[2], _ro[ 2], _ro[ 7], ti[2], _ro[ 3], _ro[ 6]) \ + COMP_MAC(tr[3], _ro[10], _ro[15], ti[3], _ro[11], _ro[14]) \ +} + + +#define SAVE_ACC_COMPLEX_11 \ + BUILTIN_MMA_DISASSEMBLE_ACC_8 \ + COMP_MUL_1 \ + COMP_MAC_1(16) \ + COMP_MAC_1(32) \ + COMP_MAC_1(48) \ + COMP_MAC_1(64) \ + COMP_MAC_1(80) \ + COMP_MAC_1(96) \ + COMP_MAC_1(112) \ + CO[0] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ + CO[1] A_OP ti[0] * alpha_r + tr[0] * alpha_i; + +#define SAVE_ACC_COMPLEX_12 \ + BUILTIN_MMA_DISASSEMBLE_ACC_8 \ + COMP_MUL_2A \ + COMP_MAC_2A(16) \ + COMP_MAC_2A(32) \ + COMP_MAC_2A(48) \ + COMP_MAC_2A(64) \ + COMP_MAC_2A(80) \ + COMP_MAC_2A(96) \ + COMP_MAC_2A(112) \ + CO[0] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ + CO[1] A_OP ti[0] * alpha_r + tr[0] * alpha_i; \ + CO[2*ldc+0] A_OP tr[1] * alpha_r - ti[1] * alpha_i; \ + CO[2*ldc+1] A_OP ti[1] * alpha_r + tr[1] * alpha_i; + +#define SAVE_ACC_COMPLEX_21_1 \ + BUILTIN_MMA_DISASSEMBLE_ACC_8 \ + COMP_MUL_2B \ + COMP_MAC_2B(16) \ + COMP_MAC_2B(32) \ + COMP_MAC_2B(48) \ + COMP_MAC_2B(64) \ + COMP_MAC_2B(80) \ + COMP_MAC_2B(96) \ + COMP_MAC_2B(112) \ + CO[0] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ + CO[1] A_OP ti[0] * alpha_r + tr[0] * alpha_i; \ + CO[2] A_OP tr[1] * alpha_r - ti[1] * alpha_i; \ + CO[3] A_OP ti[1] * alpha_r + tr[1] * alpha_i; + +#define SAVE_ACC_COMPLEX_21_2 \ + BUILTIN_MMA_DISASSEMBLE_ACC_8 \ + COMP_MUL_4A(0) \ + COMP_MAC_4A(32) \ + COMP_MAC_4A(64) \ + COMP_MAC_4A(96) \ + CO[0] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ + CO[1] A_OP ti[0] * alpha_r + tr[0] * alpha_i; \ + CO[2] A_OP tr[1] * alpha_r - ti[1] * alpha_i; \ + CO[3] A_OP ti[1] * alpha_r + tr[1] * alpha_i; \ + CO[4] A_OP tr[2] * alpha_r - ti[2] * alpha_i; \ + CO[5] A_OP ti[2] * alpha_r + tr[2] * alpha_i; \ + CO[6] A_OP tr[3] * alpha_r - ti[3] * alpha_i; \ + CO[7] A_OP ti[3] * alpha_r + tr[3] * alpha_i; + +#define SAVE_ACC_COMPLEX_21_4 \ + BUILTIN_MMA_DISASSEMBLE_ACC_8 \ + COMP_MUL_4A(0) \ + COMP_MAC_4A(64) \ + CO[ 0] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ + CO[ 1] A_OP ti[0] * alpha_r + tr[0] * alpha_i; \ + CO[ 2] A_OP tr[1] * alpha_r - ti[1] * alpha_i; \ + CO[ 3] A_OP ti[1] * alpha_r + tr[1] * alpha_i; \ + CO[ 4] A_OP tr[2] * alpha_r - ti[2] * alpha_i; \ + CO[ 5] A_OP ti[2] * alpha_r + tr[2] * alpha_i; \ + CO[ 6] A_OP tr[3] * alpha_r - ti[3] * alpha_i; \ + CO[ 7] A_OP ti[3] * alpha_r + tr[3] * alpha_i; \ + COMP_MUL_4A(32) \ + COMP_MAC_4A(96) \ + CO[ 8] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ + CO[ 9] A_OP ti[0] * alpha_r + tr[0] * alpha_i; \ + CO[10] A_OP tr[1] * alpha_r - ti[1] * alpha_i; \ + CO[11] A_OP ti[1] * alpha_r + tr[1] * alpha_i; \ + CO[12] A_OP tr[2] * alpha_r - ti[2] * alpha_i; \ + CO[13] A_OP ti[2] * alpha_r + tr[2] * alpha_i; \ + CO[14] A_OP tr[3] * alpha_r - ti[3] * alpha_i; \ + CO[15] A_OP ti[3] * alpha_r + tr[3] * alpha_i; + +#define SAVE_ACC_COMPLEX_22_4 \ + BUILTIN_MMA_DISASSEMBLE_ACC_8 \ + COMP_MUL_4B(0) \ + CO[ 0] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ + CO[ 1] A_OP ti[0] * alpha_r + tr[0] * alpha_i; \ + CO[ 2] A_OP tr[1] * alpha_r - ti[1] * alpha_i; \ + CO[ 3] A_OP ti[1] * alpha_r + tr[1] * alpha_i; \ + CO[2*ldc+ 0] A_OP tr[2] * alpha_r - ti[2] * alpha_i; \ + CO[2*ldc+ 1] A_OP ti[2] * alpha_r + tr[2] * alpha_i; \ + CO[2*ldc+ 2] A_OP tr[3] * alpha_r - ti[3] * alpha_i; \ + CO[2*ldc+ 3] A_OP ti[3] * alpha_r + tr[3] * alpha_i; \ + COMP_MUL_4B(16) \ + CO[ 4] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ + CO[ 5] A_OP ti[0] * alpha_r + tr[0] * alpha_i; \ + CO[ 6] A_OP tr[1] * alpha_r - ti[1] * alpha_i; \ + CO[ 7] A_OP ti[1] * alpha_r + tr[1] * alpha_i; \ + CO[2*ldc+ 4] A_OP tr[2] * alpha_r - ti[2] * alpha_i; \ + CO[2*ldc+ 5] A_OP ti[2] * alpha_r + tr[2] * alpha_i; \ + CO[2*ldc+ 6] A_OP tr[3] * alpha_r - ti[3] * alpha_i; \ + CO[2*ldc+ 7] A_OP ti[3] * alpha_r + tr[3] * alpha_i; \ + COMP_MUL_4B(32) \ + CO[ 8] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ + CO[ 9] A_OP ti[0] * alpha_r + tr[0] * alpha_i; \ + CO[10] A_OP tr[1] * alpha_r - ti[1] * alpha_i; \ + CO[11] A_OP ti[1] * alpha_r + tr[1] * alpha_i; \ + CO[2*ldc+ 8] A_OP tr[2] * alpha_r - ti[2] * alpha_i; \ + CO[2*ldc+ 9] A_OP ti[2] * alpha_r + tr[2] * alpha_i; \ + CO[2*ldc+10] A_OP tr[3] * alpha_r - ti[3] * alpha_i; \ + CO[2*ldc+11] A_OP ti[3] * alpha_r + tr[3] * alpha_i; \ + COMP_MUL_4B(48) \ + CO[12] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ + CO[13] A_OP ti[0] * alpha_r + tr[0] * alpha_i; \ + CO[14] A_OP tr[1] * alpha_r - ti[1] * alpha_i; \ + CO[15] A_OP ti[1] * alpha_r + tr[1] * alpha_i; \ + CO[2*ldc+12] A_OP tr[2] * alpha_r - ti[2] * alpha_i; \ + CO[2*ldc+13] A_OP ti[2] * alpha_r + tr[2] * alpha_i; \ + CO[2*ldc+14] A_OP tr[3] * alpha_r - ti[3] * alpha_i; \ + CO[2*ldc+15] A_OP ti[3] * alpha_r + tr[3] * alpha_i; + +#define SAVE_ACC_COMPLEX_22_2 \ + BUILTIN_MMA_DISASSEMBLE_ACC_8 \ + COMP_MUL_4B(0) \ + CO[0] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ + CO[1] A_OP ti[0] * alpha_r + tr[0] * alpha_i; \ + CO[2] A_OP tr[1] * alpha_r - ti[1] * alpha_i; \ + CO[3] A_OP ti[1] * alpha_r + tr[1] * alpha_i; \ + CO[2*ldc+0] A_OP tr[2] * alpha_r - ti[2] * alpha_i; \ + CO[2*ldc+1] A_OP ti[2] * alpha_r + tr[2] * alpha_i; \ + CO[2*ldc+2] A_OP tr[3] * alpha_r - ti[3] * alpha_i; \ + CO[2*ldc+3] A_OP ti[3] * alpha_r + tr[3] * alpha_i; \ + COMP_MUL_4B(16) \ + CO[4] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ + CO[5] A_OP ti[0] * alpha_r + tr[0] * alpha_i; \ + CO[6] A_OP tr[1] * alpha_r - ti[1] * alpha_i; \ + CO[7] A_OP ti[1] * alpha_r + tr[1] * alpha_i; \ + CO[2*ldc+4] A_OP tr[2] * alpha_r - ti[2] * alpha_i; \ + CO[2*ldc+5] A_OP ti[2] * alpha_r + tr[2] * alpha_i; \ + CO[2*ldc+6] A_OP tr[3] * alpha_r - ti[3] * alpha_i; \ + CO[2*ldc+7] A_OP ti[3] * alpha_r + tr[3] * alpha_i; + +#define SAVE_ACC_COMPLEX_22_1 \ + BUILTIN_MMA_DISASSEMBLE_ACC_8 \ + COMP_MUL_4B(0) \ + CO[0] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ + CO[1] A_OP ti[0] * alpha_r + tr[0] * alpha_i; \ + CO[2] A_OP tr[1] * alpha_r - ti[1] * alpha_i; \ + CO[3] A_OP ti[1] * alpha_r + tr[1] * alpha_i; \ + CO[2*ldc+0] A_OP tr[2] * alpha_r - ti[2] * alpha_i; \ + CO[2*ldc+1] A_OP ti[2] * alpha_r + tr[2] * alpha_i; \ + CO[2*ldc+2] A_OP tr[3] * alpha_r - ti[3] * alpha_i; \ + CO[2*ldc+3] A_OP ti[3] * alpha_r + tr[3] * alpha_i; + +#define SAVE_ACC_COMPLEX_24_ALL \ + __builtin_mma_disassemble_acc ((void *)result, &acc0); \ + __builtin_mma_disassemble_acc ((void *)(&result[4]), &acc4); \ + __builtin_mma_disassemble_acc ((void *)(&result[8]), &acc1); \ + __builtin_mma_disassemble_acc ((void *)(&result[12]), &acc5); \ + __builtin_mma_disassemble_acc ((void *)(&result[16]), &acc2); \ + __builtin_mma_disassemble_acc ((void *)(&result[20]), &acc6); \ + __builtin_mma_disassemble_acc ((void *)(&result[24]), &acc3); \ + __builtin_mma_disassemble_acc ((void *)(&result[28]), &acc7); \ + COMP_MUL(tr[ 0], res[ 0], res[ 5], ti[ 0], res[ 1], res[ 4]) \ + COMP_MUL(tr[ 1], res[ 8], res[ 13], ti[ 1], res[ 9], res[ 12]) \ + COMP_MUL(tr[ 2], res[ 2], res[ 7], ti[ 2], res[ 3], res[ 6]) \ + COMP_MUL(tr[ 3], res[ 10], res[ 15], ti[ 3], res[ 11], res[ 14]) \ + COMP_MUL(tr[ 4], res[ 16], res[ 21], ti[ 4], res[ 17], res[ 20]) \ + COMP_MUL(tr[ 5], res[ 24], res[ 29], ti[ 5], res[ 25], res[ 28]) \ + COMP_MUL(tr[ 6], res[ 18], res[ 23], ti[ 6], res[ 19], res[ 22]) \ + COMP_MUL(tr[ 7], res[ 26], res[ 31], ti[ 7], res[ 27], res[ 30]) \ + COMP_MUL(tr[ 8], res[ 32], res[ 37], ti[ 8], res[ 33], res[ 36]) \ + COMP_MUL(tr[ 9], res[ 40], res[ 45], ti[ 9], res[ 41], res[ 44]) \ + COMP_MUL(tr[10], res[ 34], res[ 39], ti[10], res[ 35], res[ 38]) \ + COMP_MUL(tr[11], res[ 42], res[ 47], ti[11], res[ 43], res[ 46]) \ + COMP_MUL(tr[12], res[ 48], res[ 53], ti[12], res[ 49], res[ 52]) \ + COMP_MUL(tr[13], res[ 56], res[ 61], ti[13], res[ 57], res[ 60]) \ + COMP_MUL(tr[14], res[ 50], res[ 55], ti[14], res[ 51], res[ 54]) \ + COMP_MUL(tr[15], res[ 58], res[ 63], ti[15], res[ 59], res[ 62]) \ + COMP_MUL(tr[16], res[ 64], res[ 69], ti[16], res[ 65], res[ 68]) \ + COMP_MUL(tr[17], res[ 72], res[ 77], ti[17], res[ 73], res[ 76]) \ + COMP_MUL(tr[18], res[ 66], res[ 71], ti[18], res[ 67], res[ 70]) \ + COMP_MUL(tr[19], res[ 74], res[ 79], ti[19], res[ 75], res[ 78]) \ + COMP_MUL(tr[20], res[ 80], res[ 85], ti[20], res[ 81], res[ 84]) \ + COMP_MUL(tr[21], res[ 88], res[ 93], ti[21], res[ 89], res[ 92]) \ + COMP_MUL(tr[22], res[ 82], res[ 87], ti[22], res[ 83], res[ 86]) \ + COMP_MUL(tr[23], res[ 90], res[ 95], ti[23], res[ 91], res[ 94]) \ + COMP_MUL(tr[24], res[ 96], res[101], ti[24], res[ 97], res[100]) \ + COMP_MUL(tr[25], res[104], res[109], ti[25], res[105], res[108]) \ + COMP_MUL(tr[26], res[ 98], res[103], ti[26], res[ 99], res[102]) \ + COMP_MUL(tr[27], res[106], res[111], ti[27], res[107], res[110]) \ + COMP_MUL(tr[28], res[112], res[117], ti[28], res[113], res[116]) \ + COMP_MUL(tr[29], res[120], res[125], ti[29], res[121], res[124]) \ + COMP_MUL(tr[30], res[114], res[119], ti[30], res[115], res[118]) \ + COMP_MUL(tr[31], res[122], res[127], ti[31], res[123], res[126]) \ + CO[ 0] A_OP tr[ 0] * alpha_r - ti[ 0] * alpha_i; \ + CO[ 1] A_OP ti[ 0] * alpha_r + tr[ 0] * alpha_i; \ + CO[ 2] A_OP tr[ 1] * alpha_r - ti[ 1] * alpha_i; \ + CO[ 3] A_OP ti[ 1] * alpha_r + tr[ 1] * alpha_i; \ + CO[2*ldc+ 0] A_OP tr[ 2] * alpha_r - ti[ 2] * alpha_i; \ + CO[2*ldc+ 1] A_OP ti[ 2] * alpha_r + tr[ 2] * alpha_i; \ + CO[2*ldc+ 2] A_OP tr[ 3] * alpha_r - ti[ 3] * alpha_i; \ + CO[2*ldc+ 3] A_OP ti[ 3] * alpha_r + tr[ 3] * alpha_i; \ + CO[4*ldc+ 0] A_OP tr[ 4] * alpha_r - ti[ 4] * alpha_i; \ + CO[4*ldc+ 1] A_OP ti[ 4] * alpha_r + tr[ 4] * alpha_i; \ + CO[4*ldc+ 2] A_OP tr[ 5] * alpha_r - ti[ 5] * alpha_i; \ + CO[4*ldc+ 3] A_OP ti[ 5] * alpha_r + tr[ 5] * alpha_i; \ + CO[6*ldc+ 0] A_OP tr[ 6] * alpha_r - ti[ 6] * alpha_i; \ + CO[6*ldc+ 1] A_OP ti[ 6] * alpha_r + tr[ 6] * alpha_i; \ + CO[6*ldc+ 2] A_OP tr[ 7] * alpha_r - ti[ 7] * alpha_i; \ + CO[6*ldc+ 3] A_OP ti[ 7] * alpha_r + tr[ 7] * alpha_i; \ + CO[ 4] A_OP tr[ 8] * alpha_r - ti[ 8] * alpha_i; \ + CO[ 5] A_OP ti[ 8] * alpha_r + tr[ 8] * alpha_i; \ + CO[ 6] A_OP tr[ 9] * alpha_r - ti[ 9] * alpha_i; \ + CO[ 7] A_OP ti[ 9] * alpha_r + tr[ 9] * alpha_i; \ + CO[2*ldc+ 4] A_OP tr[10] * alpha_r - ti[10] * alpha_i; \ + CO[2*ldc+ 5] A_OP ti[10] * alpha_r + tr[10] * alpha_i; \ + CO[2*ldc+ 6] A_OP tr[11] * alpha_r - ti[11] * alpha_i; \ + CO[2*ldc+ 7] A_OP ti[11] * alpha_r + tr[11] * alpha_i; \ + CO[4*ldc+ 4] A_OP tr[12] * alpha_r - ti[12] * alpha_i; \ + CO[4*ldc+ 5] A_OP ti[12] * alpha_r + tr[12] * alpha_i; \ + CO[4*ldc+ 6] A_OP tr[13] * alpha_r - ti[13] * alpha_i; \ + CO[4*ldc+ 7] A_OP ti[13] * alpha_r + tr[13] * alpha_i; \ + CO[6*ldc+ 4] A_OP tr[14] * alpha_r - ti[14] * alpha_i; \ + CO[6*ldc+ 5] A_OP ti[14] * alpha_r + tr[14] * alpha_i; \ + CO[6*ldc+ 6] A_OP tr[15] * alpha_r - ti[15] * alpha_i; \ + CO[6*ldc+ 7] A_OP ti[15] * alpha_r + tr[15] * alpha_i; \ + CO[ 8] A_OP tr[16] * alpha_r - ti[16] * alpha_i; \ + CO[ 9] A_OP ti[16] * alpha_r + tr[16] * alpha_i; \ + CO[ 10] A_OP tr[17] * alpha_r - ti[17] * alpha_i; \ + CO[ 11] A_OP ti[17] * alpha_r + tr[17] * alpha_i; \ + CO[2*ldc+ 8] A_OP tr[18] * alpha_r - ti[18] * alpha_i; \ + CO[2*ldc+ 9] A_OP ti[18] * alpha_r + tr[18] * alpha_i; \ + CO[2*ldc+10] A_OP tr[19] * alpha_r - ti[19] * alpha_i; \ + CO[2*ldc+11] A_OP ti[19] * alpha_r + tr[19] * alpha_i; \ + CO[4*ldc+ 8] A_OP tr[20] * alpha_r - ti[20] * alpha_i; \ + CO[4*ldc+ 9] A_OP ti[20] * alpha_r + tr[20] * alpha_i; \ + CO[4*ldc+10] A_OP tr[21] * alpha_r - ti[21] * alpha_i; \ + CO[4*ldc+11] A_OP ti[21] * alpha_r + tr[21] * alpha_i; \ + CO[6*ldc+ 8] A_OP tr[22] * alpha_r - ti[22] * alpha_i; \ + CO[6*ldc+ 9] A_OP ti[22] * alpha_r + tr[22] * alpha_i; \ + CO[6*ldc+10] A_OP tr[23] * alpha_r - ti[23] * alpha_i; \ + CO[6*ldc+11] A_OP ti[23] * alpha_r + tr[23] * alpha_i; \ + CO[ 12] A_OP tr[24] * alpha_r - ti[24] * alpha_i; \ + CO[ 13] A_OP ti[24] * alpha_r + tr[24] * alpha_i; \ + CO[ 14] A_OP tr[25] * alpha_r - ti[25] * alpha_i; \ + CO[ 15] A_OP ti[25] * alpha_r + tr[25] * alpha_i; \ + CO[2*ldc+12] A_OP tr[26] * alpha_r - ti[26] * alpha_i; \ + CO[2*ldc+13] A_OP ti[26] * alpha_r + tr[26] * alpha_i; \ + CO[2*ldc+14] A_OP tr[27] * alpha_r - ti[27] * alpha_i; \ + CO[2*ldc+15] A_OP ti[27] * alpha_r + tr[27] * alpha_i; \ + CO[4*ldc+12] A_OP tr[28] * alpha_r - ti[28] * alpha_i; \ + CO[4*ldc+13] A_OP ti[28] * alpha_r + tr[28] * alpha_i; \ + CO[4*ldc+14] A_OP tr[29] * alpha_r - ti[29] * alpha_i; \ + CO[4*ldc+15] A_OP ti[29] * alpha_r + tr[29] * alpha_i; \ + CO[6*ldc+12] A_OP tr[30] * alpha_r - ti[30] * alpha_i; \ + CO[6*ldc+13] A_OP ti[30] * alpha_r + tr[30] * alpha_i; \ + CO[6*ldc+14] A_OP tr[31] * alpha_r - ti[31] * alpha_i; \ + CO[6*ldc+15] A_OP ti[31] * alpha_r + tr[31] * alpha_i; + +#define SAVE_ACC_COMPLEX_24(ACC1, ACC2, CI) \ + __builtin_mma_disassemble_acc ((void *)result, ACC1); \ + __builtin_mma_disassemble_acc ((void *)(&result[4]), ACC2); \ + COMP_MUL(tr[0], res[0], res[5], ti[0], res[1], res[4]) \ + COMP_MUL(tr[1], res[8], res[13], ti[1], res[9], res[12]) \ + COMP_MUL(tr[2], res[2], res[7], ti[2], res[3], res[6]) \ + COMP_MUL(tr[3], res[10], res[15], ti[3], res[11], res[14]) \ + COMP_MUL(tr[4], res[16], res[21], ti[4], res[17], res[20]) \ + COMP_MUL(tr[5], res[24], res[29], ti[5], res[25], res[28]) \ + COMP_MUL(tr[6], res[18], res[23], ti[6], res[19], res[22]) \ + COMP_MUL(tr[7], res[26], res[31], ti[7], res[27], res[30]) \ + CO[CI+0] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ + CO[CI+1] A_OP ti[0] * alpha_r + tr[0] * alpha_i; \ + CO[CI+2] A_OP tr[1] * alpha_r - ti[1] * alpha_i; \ + CO[CI+3] A_OP ti[1] * alpha_r + tr[1] * alpha_i; \ + CO[CI+2*ldc+0] A_OP tr[2] * alpha_r - ti[2] * alpha_i; \ + CO[CI+2*ldc+1] A_OP ti[2] * alpha_r + tr[2] * alpha_i; \ + CO[CI+2*ldc+2] A_OP tr[3] * alpha_r - ti[3] * alpha_i; \ + CO[CI+2*ldc+3] A_OP ti[3] * alpha_r + tr[3] * alpha_i; \ + CO[CI+4*ldc+0] A_OP tr[4] * alpha_r - ti[4] * alpha_i; \ + CO[CI+4*ldc+1] A_OP ti[4] * alpha_r + tr[4] * alpha_i; \ + CO[CI+4*ldc+2] A_OP tr[5] * alpha_r - ti[5] * alpha_i; \ + CO[CI+4*ldc+3] A_OP ti[5] * alpha_r + tr[5] * alpha_i; \ + CO[CI+6*ldc+0] A_OP tr[6] * alpha_r - ti[6] * alpha_i; \ + CO[CI+6*ldc+1] A_OP ti[6] * alpha_r + tr[6] * alpha_i; \ + CO[CI+6*ldc+2] A_OP tr[7] * alpha_r - ti[7] * alpha_i; \ + CO[CI+6*ldc+3] A_OP ti[7] * alpha_r + tr[7] * alpha_i; + +#define SAVE_ACC_COMPLEX_14 \ + BUILTIN_MMA_DISASSEMBLE_ACC_8 \ + COMP_MUL(tr[0], res[ 0], res[ 5], ti[0], res[ 1], res[ 4]) \ + COMP_MUL(tr[1], res[ 2], res[ 7], ti[1], res[ 3], res[ 6]) \ + COMP_MUL(tr[2], res[ 16], res[ 21], ti[2], res[ 17], res[ 20]) \ + COMP_MUL(tr[3], res[ 18], res[ 23], ti[3], res[ 19], res[ 22]) \ + COMP_MAC(tr[0], res[ 32], res[ 37], ti[0], res[ 33], res[ 36]) \ + COMP_MAC(tr[1], res[ 34], res[ 39], ti[1], res[ 35], res[ 38]) \ + COMP_MAC(tr[2], res[ 48], res[ 53], ti[2], res[ 49], res[ 52]) \ + COMP_MAC(tr[3], res[ 50], res[ 55], ti[3], res[ 51], res[ 54]) \ + COMP_MAC(tr[0], res[ 64], res[ 69], ti[0], res[ 65], res[ 68]) \ + COMP_MAC(tr[1], res[ 66], res[ 71], ti[1], res[ 67], res[ 70]) \ + COMP_MAC(tr[2], res[ 80], res[ 85], ti[2], res[ 81], res[ 84]) \ + COMP_MAC(tr[3], res[ 82], res[ 87], ti[3], res[ 83], res[ 86]) \ + COMP_MAC(tr[0], res[ 96], res[101], ti[0], res[ 97], res[100]) \ + COMP_MAC(tr[1], res[ 98], res[103], ti[1], res[ 99], res[102]) \ + COMP_MAC(tr[2], res[112], res[117], ti[2], res[113], res[116]) \ + COMP_MAC(tr[3], res[114], res[119], ti[3], res[115], res[118]) \ + CO[0] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ + CO[1] A_OP ti[0] * alpha_r + tr[0] * alpha_i; \ + CO[2*ldc+0] A_OP tr[1] * alpha_r - ti[1] * alpha_i; \ + CO[2*ldc+1] A_OP ti[1] * alpha_r + tr[1] * alpha_i; \ + CO[4*ldc+0] A_OP tr[2] * alpha_r - ti[2] * alpha_i; \ + CO[4*ldc+1] A_OP ti[2] * alpha_r + tr[2] * alpha_i; \ + CO[6*ldc+0] A_OP tr[3] * alpha_r - ti[3] * alpha_i; \ + CO[6*ldc+1] A_OP ti[3] * alpha_r + tr[3] * alpha_i; + +#define PREFETCH1(x, y) asm volatile ("dcbt %0, %1" : : "r" (x), "b" (y) : "memory"); + +#if (defined(LEFT) && !defined(TRANSA)) || (!defined(LEFT) && defined(TRANSA)) +#define REFRESH_TEMP_BK(x, y) \ + temp = k - off; +#elif defined(LEFT) +#define REFRESH_TEMP_BK(x, y) \ + temp = off + x; +#else +#define REFRESH_TEMP_BK(x, y) \ + temp = off + y; +#endif +#if (defined(LEFT) && defined(TRANSA)) || (!defined(LEFT) && !defined(TRANSA)) +#define REFRESH_POINTERS(x, y) \ + BO = B; \ + REFRESH_TEMP_BK(x, y) +#else +#define REFRESH_POINTERS(x, y) \ + AO += off * (2*x); \ + BO = B + off * (2*y); \ + REFRESH_TEMP_BK(x, y) +#endif + +#ifdef LEFT +#define REFRESH_OFF(x) \ + off += x; +#else +#define REFRESH_OFF(x) +#endif + +#ifdef LEFT +#define UPDATE_TEMP(x, y) \ + temp -= x; +#else +#define UPDATE_TEMP(x, y) \ + temp -= y; +#endif + +#if (defined(LEFT) && defined(TRANSA)) || (!defined(LEFT) && !defined(TRANSA)) +#define REFRESH_TMP_AFTER_SAVE(x, y) \ + temp = k - off; \ + UPDATE_TEMP(x, y) \ + AO += temp * (2*x); \ + BO += temp * (2*y); +#else +#define REFRESH_TMP_AFTER_SAVE(x, y) +#endif + +#define REFRESH_AFTER_SAVE(x,y) \ + REFRESH_TMP_AFTER_SAVE(x, y) \ + REFRESH_OFF(x) +/************************************************************************************* +* GEMM Kernel +*************************************************************************************/ +int +CNAME (BLASLONG m, BLASLONG n, BLASLONG k, FLOAT alpha_r, FLOAT alpha_i, FLOAT * A, FLOAT * B, + FLOAT * C, BLASLONG ldc +#ifdef TRMMKERNEL + , BLASLONG offset +#endif + ) +{ + BLASLONG i1, i, l, temp; + FLOAT *AO, *BO, *CO; +#if defined(TRMMKERNEL) + BLASLONG off; +#endif +#if defined(TRMMKERNEL) && !defined(LEFT) + off = -offset; +#endif + + __vector_quad acc0, acc1, acc2, acc3, acc4, acc5, acc6, acc7; + + v4sf_t result[32]; + FLOAT *res, tr[64], ti[64]; + res = (FLOAT *) result; + + for (i1 = 0; i1 < (n >> 2); i1++) + { +#if defined(TRMMKERNEL) && defined(LEFT) + off = offset; +#endif + AO = A; + CO = C; + C += ldc << 3; + + for (i = 0; i < (m >> 3); i++) + { +#if defined(TRMMKERNEL) + REFRESH_POINTERS (8, 4); +#else + BO = B; + temp = k; +#endif + SET_ACC_ZERO() + for (l = 0; l < temp; ++l) + { + vec_t rowA1 = *(vec_t *) & AO[l<<4]; + vec_t rowB1 = *(vec_t *) & BO[l<<3]; + vec_t rowA2 = *(vec_t *) & AO[(l<<4)+4]; + vec_t rowB2 = *(vec_t *) & BO[(l<<3)+4]; + vec_t rowA3 = *(vec_t *) & AO[(l<<4)+8]; + vec_t rowA4 = *(vec_t *) & AO[(l<<4)+12]; + __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); + __builtin_mma_xvf32gerpp(&acc1, rowA2, rowB1); + __builtin_mma_xvf32gerpp(&acc2, rowA3, rowB1); + __builtin_mma_xvf32gerpp(&acc3, rowA4, rowB1); + __builtin_mma_xvf32gerpp(&acc4, rowA1, rowB2); + __builtin_mma_xvf32gerpp(&acc5, rowA2, rowB2); + __builtin_mma_xvf32gerpp(&acc6, rowA3, rowB2); + __builtin_mma_xvf32gerpp(&acc7, rowA4, rowB2); + } + SAVE_ACC_COMPLEX_24_ALL + CO += 16; + AO += temp << 4; + BO += temp << 3; +#if defined(TRMMKERNEL) + REFRESH_AFTER_SAVE (8, 4) +#endif + } + if (m & 4) + { +#if defined(TRMMKERNEL) + REFRESH_POINTERS (4, 4); +#else + BO = B; + temp = k; +#endif + SET_ACC_ZERO() + for (l = 0; l < (temp & (~1)); l+=2) + { + vec_t rowA1 = *(vec_t *) & AO[l<<3]; + vec_t rowA2 = *(vec_t *) & AO[(l<<3)+4]; + vec_t rowA3 = *(vec_t *) & AO[(l<<3)+8]; + vec_t rowA4 = *(vec_t *) & AO[(l<<3)+12]; + vec_t rowB1 = *(vec_t *) & BO[l<<3]; + vec_t rowB2 = *(vec_t *) & BO[(l<<3)+4]; + vec_t rowB3 = *(vec_t *) & BO[(l<<3)+8]; + vec_t rowB4 = *(vec_t *) & BO[(l<<3)+12]; + __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); + __builtin_mma_xvf32gerpp(&acc1, rowA2, rowB1); + __builtin_mma_xvf32gerpp(&acc2, rowA1, rowB2); + __builtin_mma_xvf32gerpp(&acc3, rowA2, rowB2); + __builtin_mma_xvf32gerpp(&acc0, rowA3, rowB3); + __builtin_mma_xvf32gerpp(&acc1, rowA4, rowB3); + __builtin_mma_xvf32gerpp(&acc2, rowA3, rowB4); + __builtin_mma_xvf32gerpp(&acc3, rowA4, rowB4); + } + for (l = (temp & (~1)); l < temp; ++l) + { + vec_t rowA1 = *(vec_t *) & AO[l<<3]; + vec_t rowA2 = *(vec_t *) & AO[(l<<3)+4]; + vec_t rowB1 = *(vec_t *) & BO[l<<3]; + vec_t rowB2 = *(vec_t *) & BO[(l<<3)+4]; + __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); + __builtin_mma_xvf32gerpp(&acc1, rowA2, rowB1); + __builtin_mma_xvf32gerpp(&acc2, rowA1, rowB2); + __builtin_mma_xvf32gerpp(&acc3, rowA2, rowB2); + } + SAVE_ACC_COMPLEX_24(&acc0, &acc2, 0) + SAVE_ACC_COMPLEX_24(&acc1, &acc3, 4) + CO += 8; + AO += temp << 3; + BO += temp << 3; +#if defined(TRMMKERNEL) + REFRESH_AFTER_SAVE (4, 4) +#endif + } + if (m & 2) + { +#if defined(TRMMKERNEL) + REFRESH_POINTERS (2, 4); +#else + BO = B; + temp = k; +#endif + SET_ACC_ZERO() + for (l = 0; l < (temp & (~3)); l+=4) + { + vec_t rowA1 = *(vec_t *) & AO[l<<2]; + vec_t rowA2 = *(vec_t *) & AO[(l<<2)+4]; + vec_t rowA3 = *(vec_t *) & AO[(l<<2)+8]; + vec_t rowA4 = *(vec_t *) & AO[(l<<2)+12]; + vec_t rowB1 = *(vec_t *) & BO[l<<3]; + vec_t rowB2 = *(vec_t *) & BO[(l<<3)+4]; + vec_t rowB3 = *(vec_t *) & BO[(l<<3)+8]; + vec_t rowB4 = *(vec_t *) & BO[(l<<3)+12]; + vec_t rowB5 = *(vec_t *) & BO[(l<<3)+16]; + vec_t rowB6 = *(vec_t *) & BO[(l<<3)+20]; + vec_t rowB7 = *(vec_t *) & BO[(l<<3)+24]; + vec_t rowB8 = *(vec_t *) & BO[(l<<3)+28]; + __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); + __builtin_mma_xvf32gerpp(&acc1, rowA1, rowB2); + __builtin_mma_xvf32gerpp(&acc0, rowA2, rowB3); + __builtin_mma_xvf32gerpp(&acc1, rowA2, rowB4); + __builtin_mma_xvf32gerpp(&acc0, rowA3, rowB5); + __builtin_mma_xvf32gerpp(&acc1, rowA3, rowB6); + __builtin_mma_xvf32gerpp(&acc0, rowA4, rowB7); + __builtin_mma_xvf32gerpp(&acc1, rowA4, rowB8); + } + for (l = (temp & (~3)); l < temp; ++l) + { + vec_t rowA1 = *(vec_t *) & AO[l<<2]; + vec_t rowB1 = *(vec_t *) & BO[l<<3]; + vec_t rowB2 = *(vec_t *) & BO[(l<<3)+4]; + __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); + __builtin_mma_xvf32gerpp(&acc1, rowA1, rowB2); + } + SAVE_ACC_COMPLEX_24(&acc0, &acc1, 0) + CO += 4; + AO += temp << 2; + BO += temp << 3; +#if defined(TRMMKERNEL) + REFRESH_AFTER_SAVE (2, 4) +#endif + } + if (m & 1) + { +#if defined(TRMMKERNEL) + REFRESH_POINTERS (1, 4) +#else + BO = B; + temp = k; +#endif + SET_ACC_ZERO() + for (l = 0; l < (temp & (~3)); l+=4) + { + vec_t rowA1 = *(vec_t *) & AO[l<<1]; + vec_t rowA2 = *(vec_t *) & AO[(l<<1)+2]; + vec_t rowA3 = *(vec_t *) & AO[(l<<1)+4]; + vec_t rowA4 = *(vec_t *) & AO[(l<<1)+6]; + vec_t rowB1 = *(vec_t *) & BO[l<<3]; + vec_t rowB2 = *(vec_t *) & BO[(l<<3)+4]; + vec_t rowB3 = *(vec_t *) & BO[(l<<3)+8]; + vec_t rowB4 = *(vec_t *) & BO[(l<<3)+12]; + vec_t rowB5 = *(vec_t *) & BO[(l<<3)+16]; + vec_t rowB6 = *(vec_t *) & BO[(l<<3)+20]; + vec_t rowB7 = *(vec_t *) & BO[(l<<3)+24]; + vec_t rowB8 = *(vec_t *) & BO[(l<<3)+28]; + __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); + __builtin_mma_xvf32gerpp(&acc1, rowA1, rowB2); + __builtin_mma_xvf32gerpp(&acc2, rowA2, rowB3); + __builtin_mma_xvf32gerpp(&acc3, rowA2, rowB4); + __builtin_mma_xvf32gerpp(&acc4, rowA3, rowB5); + __builtin_mma_xvf32gerpp(&acc5, rowA3, rowB6); + __builtin_mma_xvf32gerpp(&acc6, rowA4, rowB7); + __builtin_mma_xvf32gerpp(&acc7, rowA4, rowB8); + } + for (l = (temp & (~3)); l < temp; ++l) + { + vec_t rowA1 = *(vec_t *) & AO[l<<1]; + vec_t rowB1 = *(vec_t *) & BO[l<<3]; + vec_t rowB2 = *(vec_t *) & BO[(l<<3)+4]; + __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); + __builtin_mma_xvf32gerpp(&acc1, rowA1, rowB2); + } + SAVE_ACC_COMPLEX_14 + CO += 2; + AO += temp << 1; + BO += temp << 3; +#if defined(TRMMKERNEL) + REFRESH_AFTER_SAVE (1, 4) +#endif + } +#if defined(TRMMKERNEL) && !defined(LEFT) + off += 4; // number of values in A +#endif + + B += k << 3; + } + + if (n & 2) + { +#if defined(TRMMKERNEL) && defined(LEFT) + off = offset; +#endif + AO = A; + CO = C; + C += ldc << 2; + + for (i = 0; i < (m >> 3); i++) + { +#if defined(TRMMKERNEL) + REFRESH_POINTERS (8, 2) +#else + BO = B; + temp = k; +#endif + SET_ACC_ZERO() + for (l = 0; l < (temp & (~1)); l+=2) + { + vec_t rowA1 = *(vec_t *) & AO[l<<4]; + vec_t rowA2 = *(vec_t *) & AO[(l<<4)+4]; + vec_t rowA3 = *(vec_t *) & AO[(l<<4)+8]; + vec_t rowA4 = *(vec_t *) & AO[(l<<4)+12]; + vec_t rowA5 = *(vec_t *) & AO[(l<<4)+16]; + vec_t rowA6 = *(vec_t *) & AO[(l<<4)+20]; + vec_t rowA7 = *(vec_t *) & AO[(l<<4)+24]; + vec_t rowA8 = *(vec_t *) & AO[(l<<4)+28]; + vec_t rowB1 = *(vec_t *) & BO[l<<2]; + vec_t rowB2 = *(vec_t *) & BO[(l<<2)+4]; + __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); + __builtin_mma_xvf32gerpp(&acc1, rowA2, rowB1); + __builtin_mma_xvf32gerpp(&acc2, rowA3, rowB1); + __builtin_mma_xvf32gerpp(&acc3, rowA4, rowB1); + __builtin_mma_xvf32gerpp(&acc0, rowA5, rowB2); + __builtin_mma_xvf32gerpp(&acc1, rowA6, rowB2); + __builtin_mma_xvf32gerpp(&acc2, rowA7, rowB2); + __builtin_mma_xvf32gerpp(&acc3, rowA8, rowB2); + } + for (l = (temp & (~1)); l < temp; ++l) + { + vec_t rowA1 = *(vec_t *) & AO[l<<4]; + vec_t rowA2 = *(vec_t *) & AO[(l<<4)+4]; + vec_t rowA3 = *(vec_t *) & AO[(l<<4)+8]; + vec_t rowA4 = *(vec_t *) & AO[(l<<4)+12]; + vec_t rowB1 = *(vec_t *) & BO[l<<2]; + __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); + __builtin_mma_xvf32gerpp(&acc1, rowA2, rowB1); + __builtin_mma_xvf32gerpp(&acc2, rowA3, rowB1); + __builtin_mma_xvf32gerpp(&acc3, rowA4, rowB1); + } + SAVE_ACC_COMPLEX_22_4 + AO += temp << 4; + BO += temp << 2; + CO += 16; +#if defined(TRMMKERNEL) + REFRESH_AFTER_SAVE (8, 2) +#endif + } + if (m & 4) + { +#if defined(TRMMKERNEL) + REFRESH_POINTERS (4, 2) +#else + BO = B; + temp = k; +#endif + SET_ACC_ZERO() + for (l = 0; l < (temp & (~3)); l+=4) + { + vec_t rowA1 = *(vec_t *) & AO[l<<3]; + vec_t rowA2 = *(vec_t *) & AO[(l<<3)+4]; + vec_t rowA3 = *(vec_t *) & AO[(l<<3)+8]; + vec_t rowA4 = *(vec_t *) & AO[(l<<3)+12]; + vec_t rowA5 = *(vec_t *) & AO[(l<<3)+16]; + vec_t rowA6 = *(vec_t *) & AO[(l<<3)+20]; + vec_t rowA7 = *(vec_t *) & AO[(l<<3)+24]; + vec_t rowA8 = *(vec_t *) & AO[(l<<3)+28]; + vec_t rowB1 = *(vec_t *) & BO[l<<2]; + vec_t rowB2 = *(vec_t *) & BO[(l<<2)+4]; + vec_t rowB3 = *(vec_t *) & BO[(l<<2)+8]; + vec_t rowB4 = *(vec_t *) & BO[(l<<2)+12]; + __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); + __builtin_mma_xvf32gerpp(&acc1, rowA2, rowB1); + __builtin_mma_xvf32gerpp(&acc0, rowA3, rowB2); + __builtin_mma_xvf32gerpp(&acc1, rowA4, rowB2); + __builtin_mma_xvf32gerpp(&acc0, rowA5, rowB3); + __builtin_mma_xvf32gerpp(&acc1, rowA6, rowB3); + __builtin_mma_xvf32gerpp(&acc0, rowA7, rowB4); + __builtin_mma_xvf32gerpp(&acc1, rowA8, rowB4); + } + for (l = (temp & (~3)); l < temp; ++l) + { + vec_t rowA1 = *(vec_t *) & AO[l<<3]; + vec_t rowA2 = *(vec_t *) & AO[(l<<3)+4]; + vec_t rowB1 = *(vec_t *) & BO[l<<2]; + __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); + __builtin_mma_xvf32gerpp(&acc1, rowA2, rowB1); + } + SAVE_ACC_COMPLEX_22_2 + AO += temp << 3; + BO += temp << 2; + CO += 8; +#if defined(TRMMKERNEL) + REFRESH_AFTER_SAVE (4, 2) +#endif + } if (m & 2) + { +#if defined(TRMMKERNEL) + REFRESH_POINTERS (2, 2) +#else + BO = B; + temp = k; +#endif + SET_ACC_ZERO() + for (l = 0; l < (temp & (~7)); l+=8) + { + vec_t rowA1 = *(vec_t *) & AO[l<<2]; + vec_t rowA2 = *(vec_t *) & AO[(l<<2)+4]; + vec_t rowA3 = *(vec_t *) & AO[(l<<2)+8]; + vec_t rowA4 = *(vec_t *) & AO[(l<<2)+12]; + vec_t rowA5 = *(vec_t *) & AO[(l<<2)+16]; + vec_t rowA6 = *(vec_t *) & AO[(l<<2)+20]; + vec_t rowA7 = *(vec_t *) & AO[(l<<2)+24]; + vec_t rowA8 = *(vec_t *) & AO[(l<<2)+28]; + vec_t rowB1 = *(vec_t *) & BO[l<<2]; + vec_t rowB2 = *(vec_t *) & BO[(l<<2)+4]; + vec_t rowB3 = *(vec_t *) & BO[(l<<2)+8]; + vec_t rowB4 = *(vec_t *) & BO[(l<<2)+12]; + vec_t rowB5 = *(vec_t *) & BO[(l<<2)+16]; + vec_t rowB6 = *(vec_t *) & BO[(l<<2)+20]; + vec_t rowB7 = *(vec_t *) & BO[(l<<2)+24]; + vec_t rowB8 = *(vec_t *) & BO[(l<<2)+28]; + __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); + __builtin_mma_xvf32gerpp(&acc0, rowA2, rowB2); + __builtin_mma_xvf32gerpp(&acc0, rowA3, rowB3); + __builtin_mma_xvf32gerpp(&acc0, rowA4, rowB4); + __builtin_mma_xvf32gerpp(&acc0, rowA5, rowB5); + __builtin_mma_xvf32gerpp(&acc0, rowA6, rowB6); + __builtin_mma_xvf32gerpp(&acc0, rowA7, rowB7); + __builtin_mma_xvf32gerpp(&acc0, rowA8, rowB8); + } + for (l = (temp & (~7)); l < temp; ++l) + { + vec_t rowA1 = *(vec_t *) & AO[l<<2]; + vec_t rowB1 = *(vec_t *) & BO[l<<2]; + __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); + } + SAVE_ACC_COMPLEX_22_1 + AO += temp << 2; + BO += temp << 2; + CO += 4; +#if defined(TRMMKERNEL) + REFRESH_AFTER_SAVE (2, 2) +#endif + } + if (m & 1) + { +#if defined(TRMMKERNEL) + REFRESH_POINTERS (1, 2) +#else + BO = B; + temp = k; +#endif + // RIP OUT MMA STUFF! + SET_ACC_ZERO() + for (l = 0; l < (temp & (~7)); l+=8) + { + vec_t rowA1 = *(vec_t *) & AO[l<<1]; + vec_t rowA2 = *(vec_t *) & AO[(l<<1)+2]; + vec_t rowA3 = *(vec_t *) & AO[(l<<1)+4]; + vec_t rowA4 = *(vec_t *) & AO[(l<<1)+6]; + vec_t rowA5 = *(vec_t *) & AO[(l<<1)+8]; + vec_t rowA6 = *(vec_t *) & AO[(l<<1)+10]; + vec_t rowA7 = *(vec_t *) & AO[(l<<1)+12]; + vec_t rowA8 = *(vec_t *) & AO[(l<<1)+14]; + vec_t rowB1 = *(vec_t *) & BO[l<<2]; + vec_t rowB2 = *(vec_t *) & BO[(l<<2)+4]; + vec_t rowB3 = *(vec_t *) & BO[(l<<2)+8]; + vec_t rowB4 = *(vec_t *) & BO[(l<<2)+12]; + vec_t rowB5 = *(vec_t *) & BO[(l<<2)+16]; + vec_t rowB6 = *(vec_t *) & BO[(l<<2)+20]; + vec_t rowB7 = *(vec_t *) & BO[(l<<2)+24]; + vec_t rowB8 = *(vec_t *) & BO[(l<<2)+28]; + __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); + __builtin_mma_xvf32gerpp(&acc1, rowA2, rowB2); + __builtin_mma_xvf32gerpp(&acc2, rowA3, rowB3); + __builtin_mma_xvf32gerpp(&acc3, rowA4, rowB4); + __builtin_mma_xvf32gerpp(&acc4, rowA5, rowB5); + __builtin_mma_xvf32gerpp(&acc5, rowA6, rowB6); + __builtin_mma_xvf32gerpp(&acc6, rowA7, rowB7); + __builtin_mma_xvf32gerpp(&acc7, rowA8, rowB8); + } + for (l = (temp & (~7)); l < temp; ++l) + { + vec_t rowA1 = *(vec_t *) & AO[l<<1]; + vec_t rowB1 = *(vec_t *) & BO[l<<2]; + __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); + } + SAVE_ACC_COMPLEX_12 + AO += temp<<1; + BO += temp<<2; + CO += 2; +#if defined(TRMMKERNEL) + REFRESH_AFTER_SAVE (1, 2) +#endif + } +#if defined(TRMMKERNEL) && !defined(LEFT) + off += 2; // number of values in A +#endif + B += k << 2; + } + + if (n & 1) + { +#if defined(TRMMKERNEL) && defined(LEFT) + off = offset; +#endif + AO = A; + CO = C; + C += ldc << 1; + + for (i = 0; i < (m >> 3); i++) + { +#if defined(TRMMKERNEL) + REFRESH_POINTERS (8, 1) +#else + BO = B; + temp = k; +#endif + SET_ACC_ZERO() + for (l = 0; l < (temp & (~1)); l+=2) + { + vec_t rowA1 = *(vec_t *) & AO[l<<4]; + vec_t rowA2 = *(vec_t *) & AO[(l<<4)+4]; + vec_t rowA3 = *(vec_t *) & AO[(l<<4)+8]; + vec_t rowA4 = *(vec_t *) & AO[(l<<4)+12]; + vec_t rowA5 = *(vec_t *) & AO[(l<<4)+16]; + vec_t rowA6 = *(vec_t *) & AO[(l<<4)+20]; + vec_t rowA7 = *(vec_t *) & AO[(l<<4)+24]; + vec_t rowA8 = *(vec_t *) & AO[(l<<4)+28]; + vec_t rowB1 = *(vec_t *) & BO[l<<1]; + vec_t rowB2 = *(vec_t *) & BO[(l<<1)+2]; + __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); + __builtin_mma_xvf32gerpp(&acc1, rowA2, rowB1); + __builtin_mma_xvf32gerpp(&acc2, rowA3, rowB1); + __builtin_mma_xvf32gerpp(&acc3, rowA4, rowB1); + __builtin_mma_xvf32gerpp(&acc4, rowA5, rowB2); + __builtin_mma_xvf32gerpp(&acc5, rowA6, rowB2); + __builtin_mma_xvf32gerpp(&acc6, rowA7, rowB2); + __builtin_mma_xvf32gerpp(&acc7, rowA8, rowB2); + } + for (l = (temp & (~1)); l < temp; ++l) + { + vec_t rowA1 = *(vec_t *) & AO[l<<4]; + vec_t rowA2 = *(vec_t *) & AO[(l<<4)+4]; + vec_t rowA3 = *(vec_t *) & AO[(l<<4)+8]; + vec_t rowA4 = *(vec_t *) & AO[(l<<4)+12]; + vec_t rowB1 = *(vec_t *) & BO[l<<1]; + __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); + __builtin_mma_xvf32gerpp(&acc1, rowA2, rowB1); + __builtin_mma_xvf32gerpp(&acc2, rowA3, rowB1); + __builtin_mma_xvf32gerpp(&acc3, rowA4, rowB1); + } + SAVE_ACC_COMPLEX_21_4 + AO += temp << 4; + BO += temp << 1; + CO += 16; +#if defined(TRMMKERNEL) + REFRESH_AFTER_SAVE (8, 1) +#endif + } + if (m & 4) + { +#if defined(TRMMKERNEL) + REFRESH_POINTERS (4, 1) +#else + BO = B; + temp = k; +#endif + SET_ACC_ZERO() + for (l = 0; l < (temp & (~3)); l+=4) + { + vec_t rowA1 = *(vec_t *) & AO[l<<3]; + vec_t rowA2 = *(vec_t *) & AO[(l<<3)+4]; + vec_t rowA3 = *(vec_t *) & AO[(l<<3)+8]; + vec_t rowA4 = *(vec_t *) & AO[(l<<3)+12]; + vec_t rowA5 = *(vec_t *) & AO[(l<<3)+16]; + vec_t rowA6 = *(vec_t *) & AO[(l<<3)+20]; + vec_t rowA7 = *(vec_t *) & AO[(l<<3)+24]; + vec_t rowA8 = *(vec_t *) & AO[(l<<3)+28]; + vec_t rowB1 = *(vec_t *) & BO[l<<1]; + vec_t rowB2 = *(vec_t *) & BO[(l<<1)+2]; + vec_t rowB3 = *(vec_t *) & BO[(l<<1)+4]; + vec_t rowB4 = *(vec_t *) & BO[(l<<1)+6]; + __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); + __builtin_mma_xvf32gerpp(&acc1, rowA2, rowB1); + __builtin_mma_xvf32gerpp(&acc2, rowA3, rowB2); + __builtin_mma_xvf32gerpp(&acc3, rowA4, rowB2); + __builtin_mma_xvf32gerpp(&acc4, rowA5, rowB3); + __builtin_mma_xvf32gerpp(&acc5, rowA6, rowB3); + __builtin_mma_xvf32gerpp(&acc6, rowA7, rowB4); + __builtin_mma_xvf32gerpp(&acc7, rowA8, rowB4); + } + for (l = (temp & (~3)); l < temp; ++l) + { + vec_t rowA1 = *(vec_t *) & AO[l<<3]; + vec_t rowA2 = *(vec_t *) & AO[(l<<3)+4]; + vec_t rowB1 = *(vec_t *) & BO[l<<1]; + __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); + __builtin_mma_xvf32gerpp(&acc1, rowA2, rowB1); + } + SAVE_ACC_COMPLEX_21_2 + AO += temp << 3; + BO += temp << 1; + CO += 8; +#if defined(TRMMKERNEL) + REFRESH_AFTER_SAVE (4, 1) +#endif + } + if (m & 2) + { +#if defined(TRMMKERNEL) + REFRESH_POINTERS (2, 1) +#else + BO = B; + temp = k; +#endif + // RIP OUT MMA STUFF! + SET_ACC_ZERO() + for (l = 0; l < (temp & (~7)); l+=8) + { + vec_t rowA1 = *(vec_t *) & AO[l<<2]; + vec_t rowA2 = *(vec_t *) & AO[(l<<2)+4]; + vec_t rowA3 = *(vec_t *) & AO[(l<<2)+8]; + vec_t rowA4 = *(vec_t *) & AO[(l<<2)+12]; + vec_t rowA5 = *(vec_t *) & AO[(l<<2)+16]; + vec_t rowA6 = *(vec_t *) & AO[(l<<2)+20]; + vec_t rowA7 = *(vec_t *) & AO[(l<<2)+24]; + vec_t rowA8 = *(vec_t *) & AO[(l<<2)+28]; + vec_t rowB1 = *(vec_t *) & BO[l<<1]; + vec_t rowB2 = *(vec_t *) & BO[(l<<1)+2]; + vec_t rowB3 = *(vec_t *) & BO[(l<<1)+4]; + vec_t rowB4 = *(vec_t *) & BO[(l<<1)+6]; + vec_t rowB5 = *(vec_t *) & BO[(l<<1)+8]; + vec_t rowB6 = *(vec_t *) & BO[(l<<1)+10]; + vec_t rowB7 = *(vec_t *) & BO[(l<<1)+12]; + vec_t rowB8 = *(vec_t *) & BO[(l<<1)+14]; + __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); + __builtin_mma_xvf32gerpp(&acc1, rowA2, rowB2); + __builtin_mma_xvf32gerpp(&acc2, rowA3, rowB3); + __builtin_mma_xvf32gerpp(&acc3, rowA4, rowB4); + __builtin_mma_xvf32gerpp(&acc4, rowA5, rowB5); + __builtin_mma_xvf32gerpp(&acc5, rowA6, rowB6); + __builtin_mma_xvf32gerpp(&acc6, rowA7, rowB7); + __builtin_mma_xvf32gerpp(&acc7, rowA8, rowB8); + } + for (l = (temp & (~7)); l < temp; ++l) + { + vec_t rowA1 = *(vec_t *) & AO[l<<2]; + vec_t rowB1 = *(vec_t *) & BO[l<<1]; + __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); + } + SAVE_ACC_COMPLEX_21_1 + AO += temp << 2; + BO += temp << 1; + CO += 4; +#if defined(TRMMKERNEL) + REFRESH_AFTER_SAVE (2, 1) +#endif + } + if (m & 1) + { +#if defined(TRMMKERNEL) + REFRESH_POINTERS (1, 1) +#else + BO = B; + temp = k; +#endif + // RIP OUT MMA STUFF! + SET_ACC_ZERO() + for (l = 0; l < (temp & (~7)); l+=8) + { + vec_t rowA1 = *(vec_t *) & AO[l<<1]; + vec_t rowA2 = *(vec_t *) & AO[(l<<1)+2]; + vec_t rowA3 = *(vec_t *) & AO[(l<<1)+4]; + vec_t rowA4 = *(vec_t *) & AO[(l<<1)+6]; + vec_t rowA5 = *(vec_t *) & AO[(l<<1)+8]; + vec_t rowA6 = *(vec_t *) & AO[(l<<1)+10]; + vec_t rowA7 = *(vec_t *) & AO[(l<<1)+12]; + vec_t rowA8 = *(vec_t *) & AO[(l<<1)+14]; + vec_t rowB1 = *(vec_t *) & BO[l<<1]; + vec_t rowB2 = *(vec_t *) & BO[(l<<1)+2]; + vec_t rowB3 = *(vec_t *) & BO[(l<<1)+4]; + vec_t rowB4 = *(vec_t *) & BO[(l<<1)+6]; + vec_t rowB5 = *(vec_t *) & BO[(l<<1)+8]; + vec_t rowB6 = *(vec_t *) & BO[(l<<1)+10]; + vec_t rowB7 = *(vec_t *) & BO[(l<<1)+12]; + vec_t rowB8 = *(vec_t *) & BO[(l<<1)+14]; + __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); + __builtin_mma_xvf32gerpp(&acc1, rowA2, rowB2); + __builtin_mma_xvf32gerpp(&acc2, rowA3, rowB3); + __builtin_mma_xvf32gerpp(&acc3, rowA4, rowB4); + __builtin_mma_xvf32gerpp(&acc4, rowA5, rowB5); + __builtin_mma_xvf32gerpp(&acc5, rowA6, rowB6); + __builtin_mma_xvf32gerpp(&acc6, rowA7, rowB7); + __builtin_mma_xvf32gerpp(&acc7, rowA8, rowB8); + } + for (l = (temp & (~7)); l < temp; ++l) + { + vec_t rowA1 = *(vec_t *) & AO[l<<1]; + vec_t rowB1 = *(vec_t *) & BO[l<<1]; + __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); + } + SAVE_ACC_COMPLEX_11 + AO += temp<<1; + BO += temp<<1; + CO += 2; +#if defined(TRMMKERNEL) + REFRESH_AFTER_SAVE (1, 1) +#endif + } +#if defined(TRMMKERNEL) && !defined(LEFT) + off += 1; // number of values in A +#endif + B += k << 1; + } + return 0; +} diff --git a/kernel/power/zgemm_kernel_power10.c b/kernel/power/zgemm_kernel_power10.c new file mode 100644 index 000000000..e4e609067 --- /dev/null +++ b/kernel/power/zgemm_kernel_power10.c @@ -0,0 +1,761 @@ +/********************************************************************************* +Copyright (c) 2020, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" +#include + +typedef __vector unsigned char vec_t; +typedef FLOAT v4sf_t __attribute__ ((vector_size (16))); + +#define SET_ACC_ZERO() \ + __builtin_mma_xxsetaccz (&acc0); \ + __builtin_mma_xxsetaccz (&acc1); \ + __builtin_mma_xxsetaccz (&acc2); \ + __builtin_mma_xxsetaccz (&acc3); \ + __builtin_mma_xxsetaccz (&acc4); \ + __builtin_mma_xxsetaccz (&acc5); \ + __builtin_mma_xxsetaccz (&acc6); \ + __builtin_mma_xxsetaccz (&acc7); + +#if (defined(NN) || defined(NT) || defined(TN) || defined(TT)) +#define COMP_MUL(_real, _arbr, _aibi, _imag, _arbi, _aibr) { _real = _arbr - _aibi; _imag = _arbi + _aibr; } +#define COMP_MAC(_real, _arbr, _aibi, _imag, _arbi, _aibr) { _real += _arbr - _aibi; _imag += _arbi + _aibr; } +#endif + +#if (defined(NR) || defined(NC) || defined(TR) || defined(TC)) +#define COMP_MUL(_real, _arbr, _aibi, _imag, _arbi, _aibr) { _real = _arbr + _aibi; _imag = -_arbi + _aibr; } +#define COMP_MAC(_real, _arbr, _aibi, _imag, _arbi, _aibr) { _real += _arbr + _aibi; _imag += -_arbi + _aibr; } +#endif + +#if (defined(RN) || defined(RT) || defined(CN) || defined(CT)) +#define COMP_MUL(_real, _arbr, _aibi, _imag, _arbi, _aibr) { _real = _arbr + _aibi; _imag = _arbi - _aibr; } +#define COMP_MAC(_real, _arbr, _aibi, _imag, _arbi, _aibr) { _real += _arbr + _aibi; _imag += _arbi - _aibr; } +#endif + +#if (defined(RR) || defined(RC) || defined(CR) || defined(CC)) +#define COMP_MUL(_real, _arbr, _aibi, _imag, _arbi, _aibr) { _real = _arbr - _aibi; _imag = -_arbi - _aibr; } +#define COMP_MAC(_real, _arbr, _aibi, _imag, _arbi, _aibr) { _real += _arbr - _aibi; _imag += -_arbi - _aibr; } +#endif + +#if defined(TRMMKERNEL) +#define A_OP = +#else +#define A_OP += +#endif + +#define BUILTIN_MMA_DISASSEMBLE_ACC_8 \ + __builtin_mma_disassemble_acc ((void *)result, &acc0); \ + __builtin_mma_disassemble_acc ((void *)&result[4], &acc1); \ + __builtin_mma_disassemble_acc ((void *)&result[8], &acc2); \ + __builtin_mma_disassemble_acc ((void *)&result[12], &acc3); \ + __builtin_mma_disassemble_acc ((void *)&result[16], &acc4); \ + __builtin_mma_disassemble_acc ((void *)&result[20], &acc5); \ + __builtin_mma_disassemble_acc ((void *)&result[24], &acc6); \ + __builtin_mma_disassemble_acc ((void *)&result[28], &acc7); + +#define SAVE_ACC_COMPLEX_11 \ + BUILTIN_MMA_DISASSEMBLE_ACC_8 \ + COMP_MUL(tr[0], res[ 0], res[ 3], ti[0], res[ 1], res[ 2]) \ + COMP_MAC(tr[0], res[ 8], res[11], ti[0], res[ 9], res[10]) \ + COMP_MAC(tr[0], res[16], res[19], ti[0], res[17], res[18]) \ + COMP_MAC(tr[0], res[24], res[27], ti[0], res[25], res[26]) \ + COMP_MAC(tr[0], res[32], res[35], ti[0], res[33], res[34]) \ + COMP_MAC(tr[0], res[40], res[43], ti[0], res[41], res[42]) \ + COMP_MAC(tr[0], res[48], res[51], ti[0], res[49], res[50]) \ + COMP_MAC(tr[0], res[56], res[59], ti[0], res[57], res[58]) \ + CO[0] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ + CO[1] A_OP ti[0] * alpha_r + tr[0] * alpha_i; + +#define SAVE_ACC_COMPLEX_12 \ + BUILTIN_MMA_DISASSEMBLE_ACC_8 \ + COMP_MUL(tr[0], res[ 0], res[ 3], ti[0], res[ 1], res[ 2]) \ + COMP_MUL(tr[1], res[ 8], res[11], ti[1], res[ 9], res[10]) \ + COMP_MAC(tr[0], res[16], res[19], ti[0], res[17], res[18]) \ + COMP_MAC(tr[1], res[24], res[27], ti[1], res[25], res[26]) \ + COMP_MAC(tr[0], res[32], res[35], ti[0], res[33], res[34]) \ + COMP_MAC(tr[1], res[40], res[43], ti[1], res[41], res[42]) \ + COMP_MAC(tr[0], res[48], res[51], ti[0], res[49], res[50]) \ + COMP_MAC(tr[1], res[56], res[59], ti[1], res[57], res[58]) \ + CO[0] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ + CO[1] A_OP ti[0] * alpha_r + tr[0] * alpha_i; \ + CO[2*ldc+0] A_OP tr[1] * alpha_r - ti[1] * alpha_i; \ + CO[2*ldc+1] A_OP ti[1] * alpha_r + tr[1] * alpha_i; + +#define SAVE_ACC_COMPLEX_21_1 \ + BUILTIN_MMA_DISASSEMBLE_ACC_8 \ + COMP_MUL(tr[0], res[ 0], res[ 3], ti[0], res[ 1], res[ 2]) \ + COMP_MUL(tr[1], res[ 4], res[ 7], ti[1], res[ 5], res[ 6]) \ + COMP_MAC(tr[0], res[ 8], res[11], ti[0], res[ 9], res[10]) \ + COMP_MAC(tr[1], res[12], res[15], ti[1], res[13], res[14]) \ + COMP_MAC(tr[0], res[16], res[19], ti[0], res[17], res[18]) \ + COMP_MAC(tr[1], res[20], res[23], ti[1], res[21], res[22]) \ + COMP_MAC(tr[0], res[24], res[27], ti[0], res[25], res[26]) \ + COMP_MAC(tr[1], res[28], res[31], ti[1], res[29], res[30]) \ + COMP_MAC(tr[0], res[32], res[35], ti[0], res[33], res[34]) \ + COMP_MAC(tr[1], res[36], res[39], ti[1], res[37], res[38]) \ + COMP_MAC(tr[0], res[40], res[43], ti[0], res[41], res[42]) \ + COMP_MAC(tr[1], res[44], res[47], ti[1], res[45], res[46]) \ + COMP_MAC(tr[0], res[48], res[51], ti[0], res[49], res[50]) \ + COMP_MAC(tr[1], res[52], res[55], ti[1], res[53], res[54]) \ + COMP_MAC(tr[0], res[56], res[59], ti[0], res[57], res[58]) \ + COMP_MAC(tr[1], res[60], res[63], ti[1], res[61], res[62]) \ + CO[0] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ + CO[1] A_OP ti[0] * alpha_r + tr[0] * alpha_i; \ + CO[2] A_OP tr[1] * alpha_r - ti[1] * alpha_i; \ + CO[3] A_OP ti[1] * alpha_r + tr[1] * alpha_i; + +#define SAVE_ACC_COMPLEX_21_2 \ + BUILTIN_MMA_DISASSEMBLE_ACC_8 \ + COMP_MUL(tr[0], res[ 0], res[ 3], ti[0], res[ 1], res[ 2]) \ + COMP_MUL(tr[1], res[ 4], res[ 7], ti[1], res[ 5], res[ 6]) \ + COMP_MUL(tr[2], res[ 8], res[11], ti[2], res[ 9], res[10]) \ + COMP_MUL(tr[3], res[12], res[15], ti[3], res[13], res[14]) \ + COMP_MAC(tr[0], res[16], res[19], ti[0], res[17], res[18]) \ + COMP_MAC(tr[1], res[20], res[23], ti[1], res[21], res[22]) \ + COMP_MAC(tr[2], res[24], res[27], ti[2], res[25], res[26]) \ + COMP_MAC(tr[3], res[28], res[31], ti[3], res[29], res[30]) \ + COMP_MAC(tr[0], res[32], res[35], ti[0], res[33], res[34]) \ + COMP_MAC(tr[1], res[36], res[39], ti[1], res[37], res[38]) \ + COMP_MAC(tr[2], res[40], res[43], ti[2], res[41], res[42]) \ + COMP_MAC(tr[3], res[44], res[47], ti[3], res[45], res[46]) \ + COMP_MAC(tr[0], res[48], res[51], ti[0], res[49], res[50]) \ + COMP_MAC(tr[1], res[52], res[55], ti[1], res[53], res[54]) \ + COMP_MAC(tr[2], res[56], res[59], ti[2], res[57], res[58]) \ + COMP_MAC(tr[3], res[60], res[63], ti[3], res[61], res[62]) \ + CO[0] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ + CO[1] A_OP ti[0] * alpha_r + tr[0] * alpha_i; \ + CO[2] A_OP tr[1] * alpha_r - ti[1] * alpha_i; \ + CO[3] A_OP ti[1] * alpha_r + tr[1] * alpha_i; \ + CO[4] A_OP tr[2] * alpha_r - ti[2] * alpha_i; \ + CO[5] A_OP ti[2] * alpha_r + tr[2] * alpha_i; \ + CO[6] A_OP tr[3] * alpha_r - ti[3] * alpha_i; \ + CO[7] A_OP ti[3] * alpha_r + tr[3] * alpha_i; + +#define SAVE_ACC_COMPLEX_21_4 \ + BUILTIN_MMA_DISASSEMBLE_ACC_8 \ + COMP_MUL(tr[0], res[ 0], res[ 3], ti[0], res[ 1], res[ 2]) \ + COMP_MUL(tr[1], res[ 4], res[ 7], ti[1], res[ 5], res[ 6]) \ + COMP_MUL(tr[2], res[ 8], res[11], ti[2], res[ 9], res[10]) \ + COMP_MUL(tr[3], res[12], res[15], ti[3], res[13], res[14]) \ + COMP_MUL(tr[4], res[16], res[19], ti[4], res[17], res[18]) \ + COMP_MUL(tr[5], res[20], res[23], ti[5], res[21], res[22]) \ + COMP_MUL(tr[6], res[24], res[27], ti[6], res[25], res[26]) \ + COMP_MUL(tr[7], res[28], res[31], ti[7], res[29], res[30]) \ + COMP_MAC(tr[0], res[32], res[35], ti[0], res[33], res[34]) \ + COMP_MAC(tr[1], res[36], res[39], ti[1], res[37], res[38]) \ + COMP_MAC(tr[2], res[40], res[43], ti[2], res[41], res[42]) \ + COMP_MAC(tr[3], res[44], res[47], ti[3], res[45], res[46]) \ + COMP_MAC(tr[4], res[48], res[51], ti[4], res[49], res[50]) \ + COMP_MAC(tr[5], res[52], res[55], ti[5], res[53], res[54]) \ + COMP_MAC(tr[6], res[56], res[59], ti[6], res[57], res[58]) \ + COMP_MAC(tr[7], res[60], res[63], ti[7], res[61], res[62]) \ + CO[ 0] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ + CO[ 1] A_OP ti[0] * alpha_r + tr[0] * alpha_i; \ + CO[ 2] A_OP tr[1] * alpha_r - ti[1] * alpha_i; \ + CO[ 3] A_OP ti[1] * alpha_r + tr[1] * alpha_i; \ + CO[ 4] A_OP tr[2] * alpha_r - ti[2] * alpha_i; \ + CO[ 5] A_OP ti[2] * alpha_r + tr[2] * alpha_i; \ + CO[ 6] A_OP tr[3] * alpha_r - ti[3] * alpha_i; \ + CO[ 7] A_OP ti[3] * alpha_r + tr[3] * alpha_i; \ + CO[ 8] A_OP tr[4] * alpha_r - ti[4] * alpha_i; \ + CO[ 9] A_OP ti[4] * alpha_r + tr[4] * alpha_i; \ + CO[10] A_OP tr[5] * alpha_r - ti[5] * alpha_i; \ + CO[11] A_OP ti[5] * alpha_r + tr[5] * alpha_i; \ + CO[12] A_OP tr[6] * alpha_r - ti[6] * alpha_i; \ + CO[13] A_OP ti[6] * alpha_r + tr[6] * alpha_i; \ + CO[14] A_OP tr[7] * alpha_r - ti[7] * alpha_i; \ + CO[15] A_OP ti[7] * alpha_r + tr[7] * alpha_i; + +#define SAVE_ACC_COMPLEX_22_1 \ + __builtin_mma_disassemble_acc ((void *)result, &acc0); \ + __builtin_mma_disassemble_acc ((void *)(&result[4]), &acc1); \ + COMP_MUL(tr[0], res[0], res[3], ti[0], res[1], res[2]) \ + COMP_MUL(tr[1], res[4], res[7], ti[1], res[5], res[6]) \ + COMP_MUL(tr[2], res[8], res[11], ti[2], res[9], res[10]) \ + COMP_MUL(tr[3], res[12], res[15], ti[3], res[13], res[14] ) \ + CO[0] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ + CO[1] A_OP ti[0] * alpha_r + tr[0] * alpha_i; \ + CO[2] A_OP tr[1] * alpha_r - ti[1] * alpha_i; \ + CO[3] A_OP ti[1] * alpha_r + tr[1] * alpha_i; \ + CO[2*ldc+0] A_OP tr[2] * alpha_r - ti[2] * alpha_i; \ + CO[2*ldc+1] A_OP ti[2] * alpha_r + tr[2] * alpha_i; \ + CO[2*ldc+2] A_OP tr[3] * alpha_r - ti[3] * alpha_i; \ + CO[2*ldc+3] A_OP ti[3] * alpha_r + tr[3] * alpha_i; + +#define SAVE_ACC_COMPLEX_22_2(ACC1, ACC2, CI) \ + __builtin_mma_disassemble_acc ((void *)result, ACC1); \ + __builtin_mma_disassemble_acc ((void *)(&result[4]), ACC2); \ + COMP_MUL(tr[0], res[0], res[3], ti[0], res[1], res[2]) \ + COMP_MUL(tr[1], res[4], res[7], ti[1], res[5], res[6]) \ + COMP_MUL(tr[2], res[8], res[11], ti[2], res[9], res[10]) \ + COMP_MUL(tr[3], res[12], res[15], ti[3], res[13], res[14]) \ + CO[CI+0] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ + CO[CI+1] A_OP ti[0] * alpha_r + tr[0] * alpha_i; \ + CO[CI+2] A_OP tr[1] * alpha_r - ti[1] * alpha_i; \ + CO[CI+3] A_OP ti[1] * alpha_r + tr[1] * alpha_i; \ + CO[2*ldc+CI+0] A_OP tr[2] * alpha_r - ti[2] * alpha_i; \ + CO[2*ldc+CI+1] A_OP ti[2] * alpha_r + tr[2] * alpha_i; \ + CO[2*ldc+CI+2] A_OP tr[3] * alpha_r - ti[3] * alpha_i; \ + CO[2*ldc+CI+3] A_OP ti[3] * alpha_r + tr[3] * alpha_i; + +#define PREFETCH1(x, y) asm volatile ("dcbt %0, %1" : : "r" (x), "b" (y) : "memory"); + +#if (defined(LEFT) && !defined(TRANSA)) || (!defined(LEFT) && defined(TRANSA)) +#define REFRESH_TEMP_BK(x, y) \ + temp = k - off; +#elif defined(LEFT) +#define REFRESH_TEMP_BK(x, y) \ + temp = off + x; +#else +#define REFRESH_TEMP_BK(x, y) \ + temp = off + y; +#endif +#if (defined(LEFT) && defined(TRANSA)) || (!defined(LEFT) && !defined(TRANSA)) +#define REFRESH_POINTERS(x, y) \ + BO = B; \ + REFRESH_TEMP_BK(x, y) +#else +#define REFRESH_POINTERS(x, y) \ + AO += off * (2*x); \ + BO = B + off * (2*y); \ + REFRESH_TEMP_BK(x, y) +#endif + +#ifdef LEFT +#define REFRESH_OFF(x) \ + off += x; +#else +#define REFRESH_OFF(x) +#endif + +#ifdef LEFT +#define UPDATE_TEMP(x, y) \ + temp -= x; +#else +#define UPDATE_TEMP(x, y) \ + temp -= y; +#endif + +#if (defined(LEFT) && defined(TRANSA)) || (!defined(LEFT) && !defined(TRANSA)) +#define REFRESH_TMP_AFTER_SAVE(x, y) \ + temp = k - off; \ + UPDATE_TEMP(x, y) \ + AO += temp * (2*x); \ + BO += temp * (2*y); +#else +#define REFRESH_TMP_AFTER_SAVE(x, y) +#endif + +#define REFRESH_AFTER_SAVE(x,y) \ + REFRESH_TMP_AFTER_SAVE(x, y) \ + REFRESH_OFF(x) +/************************************************************************************* +* GEMM Kernel +*************************************************************************************/ +int +CNAME (BLASLONG m, BLASLONG n, BLASLONG k, FLOAT alpha_r, FLOAT alpha_i, FLOAT * A, FLOAT * B, + FLOAT * C, BLASLONG ldc +#ifdef TRMMKERNEL + , BLASLONG offset +#endif + ) +{ + BLASLONG i1, i, l, temp; + FLOAT *AO, *BO, *CO; +#if defined(TRMMKERNEL) + BLASLONG off; +#endif +#if defined(TRMMKERNEL) && !defined(LEFT) + off = -offset; +#endif + __vector_quad acc0, acc1, acc2, acc3, acc4, acc5, acc6, acc7; + + v4sf_t result[32]; + FLOAT *res, tr[16], ti[16]; + res = (FLOAT *) result; + + for (i1 = 0; i1 < (n >> 1); i1++) + { +#if defined(TRMMKERNEL) && defined(LEFT) + off = offset; +#endif + AO = A; + CO = C; + C += ldc<<2; + for (i = 0; i < (m >> 3); i++) + { +#if defined(TRMMKERNEL) + REFRESH_POINTERS (8, 2) +#else + BO = B; + temp = k; +#endif + SET_ACC_ZERO() + for (l = 0; l < temp; ++l) + { + __vector_pair rowA1 = *((__vector_pair *)((void *)&AO[l<<4])); + __vector_pair rowA2 = *((__vector_pair *)((void *)&AO[(l<<4)+4])); + __vector_pair rowA3 = *((__vector_pair *)((void *)&AO[(l<<4)+8])); + __vector_pair rowA4 = *((__vector_pair *)((void *)&AO[(l<<4)+12])); + vec_t rowB1 = *(vec_t *) & BO[l<<2]; + vec_t rowB2 = *(vec_t *) & BO[(l<<2)+2]; + __builtin_mma_xvf64gerpp(&acc0, rowA1, rowB1); + __builtin_mma_xvf64gerpp(&acc1, rowA2, rowB1); + __builtin_mma_xvf64gerpp(&acc2, rowA3, rowB1); + __builtin_mma_xvf64gerpp(&acc3, rowA4, rowB1); + __builtin_mma_xvf64gerpp(&acc4, rowA1, rowB2); + __builtin_mma_xvf64gerpp(&acc5, rowA2, rowB2); + __builtin_mma_xvf64gerpp(&acc6, rowA3, rowB2); + __builtin_mma_xvf64gerpp(&acc7, rowA4, rowB2); + } + __builtin_mma_disassemble_acc ((void *)result, &acc0); + __builtin_mma_disassemble_acc ((void *)(&result[ 4]), &acc1); + __builtin_mma_disassemble_acc ((void *)(&result[ 8]), &acc2); + __builtin_mma_disassemble_acc ((void *)(&result[12]), &acc3); + __builtin_mma_disassemble_acc ((void *)(&result[16]), &acc4); + __builtin_mma_disassemble_acc ((void *)(&result[20]), &acc5); + __builtin_mma_disassemble_acc ((void *)(&result[24]), &acc6); + __builtin_mma_disassemble_acc ((void *)(&result[28]), &acc7); + COMP_MUL(tr[ 0], res[ 0], res[ 3], ti[ 0], res[ 1], res[ 2]) + COMP_MUL(tr[ 1], res[ 4], res[ 7], ti[ 1], res[ 5], res[ 6]) + COMP_MUL(tr[ 2], res[ 8], res[11], ti[ 2], res[ 9], res[10]) + COMP_MUL(tr[ 3], res[12], res[15], ti[ 3], res[13], res[14]) + COMP_MUL(tr[ 4], res[16], res[19], ti[ 4], res[17], res[18]) + COMP_MUL(tr[ 5], res[20], res[23], ti[ 5], res[21], res[22]) + COMP_MUL(tr[ 6], res[24], res[27], ti[ 6], res[25], res[26]) + COMP_MUL(tr[ 7], res[28], res[31], ti[ 7], res[29], res[30]) + COMP_MUL(tr[ 8], res[32], res[35], ti[ 8], res[33], res[34]) + COMP_MUL(tr[ 9], res[36], res[39], ti[ 9], res[37], res[38]) + COMP_MUL(tr[10], res[40], res[43], ti[10], res[41], res[42]) + COMP_MUL(tr[11], res[44], res[47], ti[11], res[45], res[46]) + COMP_MUL(tr[12], res[48], res[51], ti[12], res[49], res[50]) + COMP_MUL(tr[13], res[52], res[55], ti[13], res[53], res[54]) + COMP_MUL(tr[14], res[56], res[59], ti[14], res[57], res[58]) + COMP_MUL(tr[15], res[60], res[63], ti[15], res[61], res[62]) + CO[ 0] A_OP tr[0] * alpha_r - ti[0] * alpha_i; + CO[ 1] A_OP ti[0] * alpha_r + tr[0] * alpha_i; + CO[ 2] A_OP tr[1] * alpha_r - ti[1] * alpha_i; + CO[ 3] A_OP ti[1] * alpha_r + tr[1] * alpha_i; + CO[ 4] A_OP tr[2] * alpha_r - ti[2] * alpha_i; + CO[ 5] A_OP ti[2] * alpha_r + tr[2] * alpha_i; + CO[ 6] A_OP tr[3] * alpha_r - ti[3] * alpha_i; + CO[ 7] A_OP ti[3] * alpha_r + tr[3] * alpha_i; + CO[ 8] A_OP tr[4] * alpha_r - ti[4] * alpha_i; + CO[ 9] A_OP ti[4] * alpha_r + tr[4] * alpha_i; + CO[10] A_OP tr[5] * alpha_r - ti[5] * alpha_i; + CO[11] A_OP ti[5] * alpha_r + tr[5] * alpha_i; + CO[12] A_OP tr[6] * alpha_r - ti[6] * alpha_i; + CO[13] A_OP ti[6] * alpha_r + tr[6] * alpha_i; + CO[14] A_OP tr[7] * alpha_r - ti[7] * alpha_i; + CO[15] A_OP ti[7] * alpha_r + tr[7] * alpha_i; + CO[2*ldc+ 0] A_OP tr[ 8] * alpha_r - ti[ 8] * alpha_i; + CO[2*ldc+ 1] A_OP ti[ 8] * alpha_r + tr[ 8] * alpha_i; + CO[2*ldc+ 2] A_OP tr[ 9] * alpha_r - ti[ 9] * alpha_i; + CO[2*ldc+ 3] A_OP ti[ 9] * alpha_r + tr[ 9] * alpha_i; + CO[2*ldc+ 4] A_OP tr[10] * alpha_r - ti[10] * alpha_i; + CO[2*ldc+ 5] A_OP ti[10] * alpha_r + tr[10] * alpha_i; + CO[2*ldc+ 6] A_OP tr[11] * alpha_r - ti[11] * alpha_i; + CO[2*ldc+ 7] A_OP ti[11] * alpha_r + tr[11] * alpha_i; + CO[2*ldc+ 8] A_OP tr[12] * alpha_r - ti[12] * alpha_i; + CO[2*ldc+ 9] A_OP ti[12] * alpha_r + tr[12] * alpha_i; + CO[2*ldc+10] A_OP tr[13] * alpha_r - ti[13] * alpha_i; + CO[2*ldc+11] A_OP ti[13] * alpha_r + tr[13] * alpha_i; + CO[2*ldc+12] A_OP tr[14] * alpha_r - ti[14] * alpha_i; + CO[2*ldc+13] A_OP ti[14] * alpha_r + tr[14] * alpha_i; + CO[2*ldc+14] A_OP tr[15] * alpha_r - ti[15] * alpha_i; + CO[2*ldc+15] A_OP ti[15] * alpha_r + tr[15] * alpha_i; + + AO += temp << 4; + BO += temp << 2; + CO += 16; +#if defined(TRMMKERNEL) + REFRESH_AFTER_SAVE (8, 2) +#endif + } + if (m & 4) + { +#if defined(TRMMKERNEL) + REFRESH_POINTERS (4, 2) +#else + BO = B; + temp = k; +#endif + SET_ACC_ZERO() + for (l = 0; l < (temp & (~1)); l+=2) + { + __vector_pair rowA1 = *((__vector_pair *)((void *)&AO[l<<3])); + __vector_pair rowA2 = *((__vector_pair *)((void *)&AO[(l<<3)+4])); + __vector_pair rowA3 = *((__vector_pair *)((void *)&AO[(l<<3)+8])); + __vector_pair rowA4 = *((__vector_pair *)((void *)&AO[(l<<3)+12])); + vec_t rowB1 = *(vec_t *) & BO[l<<2]; + vec_t rowB2 = *(vec_t *) & BO[(l<<2)+2]; + vec_t rowB3 = *(vec_t *) & BO[(l<<2)+4]; + vec_t rowB4 = *(vec_t *) & BO[(l<<2)+6]; + __builtin_mma_xvf64gerpp(&acc0, rowA1, rowB1); + __builtin_mma_xvf64gerpp(&acc1, rowA2, rowB1); + __builtin_mma_xvf64gerpp(&acc2, rowA1, rowB2); + __builtin_mma_xvf64gerpp(&acc3, rowA2, rowB2); + __builtin_mma_xvf64gerpp(&acc0, rowA3, rowB3); + __builtin_mma_xvf64gerpp(&acc1, rowA4, rowB3); + __builtin_mma_xvf64gerpp(&acc2, rowA3, rowB4); + __builtin_mma_xvf64gerpp(&acc3, rowA4, rowB4); + } + for (l = (temp & (~1)); l < temp; ++l) + { + __vector_pair rowA1 = *((__vector_pair *)((void *)&AO[l<<3])); + __vector_pair rowA2 = *((__vector_pair *)((void *)&AO[(l<<3)+4])); + vec_t rowB1 = *(vec_t *) & BO[l<<2]; + vec_t rowB2 = *(vec_t *) & BO[(l<<2)+2]; + __builtin_mma_xvf64gerpp(&acc0, rowA1, rowB1); + __builtin_mma_xvf64gerpp(&acc1, rowA2, rowB1); + __builtin_mma_xvf64gerpp(&acc2, rowA1, rowB2); + __builtin_mma_xvf64gerpp(&acc3, rowA2, rowB2); + } + SAVE_ACC_COMPLEX_22_2(&acc0, &acc2, 0) + SAVE_ACC_COMPLEX_22_2(&acc1, &acc3, 4) + AO += temp << 3; + BO += temp << 2; + CO += 8; +#if defined(TRMMKERNEL) + REFRESH_AFTER_SAVE (4, 2) +#endif + } + if (m & 2) + { +#if defined(TRMMKERNEL) + REFRESH_POINTERS (2, 2) +#else + BO = B; + temp = k; +#endif + SET_ACC_ZERO() + for (l = 0; l < (temp & (~3)); l+=4) + { + __vector_pair rowA1 = *((__vector_pair *)((void *)&AO[l<<2])); + __vector_pair rowA2 = *((__vector_pair *)((void *)&AO[(l<<2)+4])); + __vector_pair rowA3 = *((__vector_pair *)((void *)&AO[(l<<2)+8])); + __vector_pair rowA4 = *((__vector_pair *)((void *)&AO[(l<<2)+12])); + vec_t rowB1 = *(vec_t *) & BO[l<<2]; + vec_t rowB2 = *(vec_t *) & BO[(l<<2)+2]; + vec_t rowB3 = *(vec_t *) & BO[(l<<2)+4]; + vec_t rowB4 = *(vec_t *) & BO[(l<<2)+6]; + vec_t rowB5 = *(vec_t *) & BO[(l<<2)+8]; + vec_t rowB6 = *(vec_t *) & BO[(l<<2)+10]; + vec_t rowB7 = *(vec_t *) & BO[(l<<2)+12]; + vec_t rowB8 = *(vec_t *) & BO[(l<<2)+14]; + __builtin_mma_xvf64gerpp(&acc0, rowA1, rowB1); + __builtin_mma_xvf64gerpp(&acc1, rowA1, rowB2); + __builtin_mma_xvf64gerpp(&acc0, rowA2, rowB3); + __builtin_mma_xvf64gerpp(&acc1, rowA2, rowB4); + __builtin_mma_xvf64gerpp(&acc0, rowA3, rowB5); + __builtin_mma_xvf64gerpp(&acc1, rowA3, rowB6); + __builtin_mma_xvf64gerpp(&acc0, rowA4, rowB7); + __builtin_mma_xvf64gerpp(&acc1, rowA4, rowB8); + } + for (l = (temp & (~3)); l < temp; ++l) + { + __vector_pair rowA1 = *((__vector_pair *)((void *)&AO[l<<2])); + vec_t rowB1 = *(vec_t *) & BO[l<<2]; + vec_t rowB2 = *(vec_t *) & BO[(l<<2)+2]; + __builtin_mma_xvf64gerpp(&acc0, rowA1, rowB1); + __builtin_mma_xvf64gerpp(&acc1, rowA1, rowB2); + } + SAVE_ACC_COMPLEX_22_1 + AO += temp << 2; + BO += temp << 2; + CO += 4; +#if defined(TRMMKERNEL) + REFRESH_AFTER_SAVE (2, 2) +#endif + } + if (m & 1) + { +#if defined(TRMMKERNEL) + REFRESH_POINTERS (1, 2) +#else + BO = B; + temp = k; +#endif + // RIP OUT MMA STUFF! + SET_ACC_ZERO() + for (l = 0; l < (temp & (~3)); l+=4) + { + __vector_pair rowA1 = *((__vector_pair *)((void *)&AO[l<<1])); + __vector_pair rowA2 = *((__vector_pair *)((void *)&AO[(l<<1)+2])); + __vector_pair rowA3 = *((__vector_pair *)((void *)&AO[(l<<1)+4])); + __vector_pair rowA4 = *((__vector_pair *)((void *)&AO[(l<<1)+6])); + vec_t rowB1 = *(vec_t *) & BO[l<<2]; + vec_t rowB2 = *(vec_t *) & BO[(l<<2)+2]; + vec_t rowB3 = *(vec_t *) & BO[(l<<2)+4]; + vec_t rowB4 = *(vec_t *) & BO[(l<<2)+6]; + vec_t rowB5 = *(vec_t *) & BO[(l<<2)+8]; + vec_t rowB6 = *(vec_t *) & BO[(l<<2)+10]; + vec_t rowB7 = *(vec_t *) & BO[(l<<2)+12]; + vec_t rowB8 = *(vec_t *) & BO[(l<<2)+14]; + __builtin_mma_xvf64gerpp(&acc0, rowA1, rowB1); + __builtin_mma_xvf64gerpp(&acc1, rowA1, rowB2); + __builtin_mma_xvf64gerpp(&acc0, rowA2, rowB3); + __builtin_mma_xvf64gerpp(&acc1, rowA2, rowB4); + __builtin_mma_xvf64gerpp(&acc0, rowA3, rowB5); + __builtin_mma_xvf64gerpp(&acc1, rowA3, rowB6); + __builtin_mma_xvf64gerpp(&acc0, rowA4, rowB7); + __builtin_mma_xvf64gerpp(&acc1, rowA4, rowB8); + } + for (l = (temp & (~3)); l < temp; ++l) + { + __vector_pair rowA1 = *((__vector_pair *)((void *)&AO[l<<1])); + vec_t rowB1 = *(vec_t *) & BO[l<<2]; + vec_t rowB2 = *(vec_t *) & BO[(l<<2)+2]; + __builtin_mma_xvf64gerpp(&acc0, rowA1, rowB1); + __builtin_mma_xvf64gerpp(&acc1, rowA1, rowB2); + } + SAVE_ACC_COMPLEX_12 + AO += temp << 1; + BO += temp << 2; + CO += 2; +#if defined(TRMMKERNEL) + REFRESH_AFTER_SAVE (1, 2) +#endif + } +#if defined(TRMMKERNEL) && !defined(LEFT) + off += 2; // number of values in A +#endif + B += k << 2; + } + if (n & 1) + { +#if defined(TRMMKERNEL) && defined(LEFT) + off = offset; +#endif + AO = A; + CO = C; + C += ldc<<1; + for (i = 0; i < (m >> 3); i++) + { +#if defined(TRMMKERNEL) + REFRESH_POINTERS (8, 1) +#else + BO = B; + temp = k; +#endif + SET_ACC_ZERO() + for (l = 0; l < (temp & (~1)); l+=2) + { + __vector_pair rowA1 = *((__vector_pair *)((void *)&AO[l<<4])); + __vector_pair rowA2 = *((__vector_pair *)((void *)&AO[(l<<4)+4])); + __vector_pair rowA3 = *((__vector_pair *)((void *)&AO[(l<<4)+8])); + __vector_pair rowA4 = *((__vector_pair *)((void *)&AO[(l<<4)+12])); + __vector_pair rowA5 = *((__vector_pair *)((void *)&AO[(l<<4)+16])); + __vector_pair rowA6 = *((__vector_pair *)((void *)&AO[(l<<4)+20])); + __vector_pair rowA7 = *((__vector_pair *)((void *)&AO[(l<<4)+24])); + __vector_pair rowA8 = *((__vector_pair *)((void *)&AO[(l<<4)+28])); + vec_t rowB1 = *(vec_t *) & BO[l<<1]; + vec_t rowB2 = *(vec_t *) & BO[(l<<1)+2]; + __builtin_mma_xvf64gerpp(&acc0, rowA1, rowB1); + __builtin_mma_xvf64gerpp(&acc1, rowA2, rowB1); + __builtin_mma_xvf64gerpp(&acc2, rowA3, rowB1); + __builtin_mma_xvf64gerpp(&acc3, rowA4, rowB1); + __builtin_mma_xvf64gerpp(&acc0, rowA5, rowB2); + __builtin_mma_xvf64gerpp(&acc1, rowA6, rowB2); + __builtin_mma_xvf64gerpp(&acc2, rowA7, rowB2); + __builtin_mma_xvf64gerpp(&acc3, rowA8, rowB2); + } + for (l = (temp & (~1)); l < temp; ++l) + { + __vector_pair rowA1 = *((__vector_pair *)((void *)&AO[l<<4])); + __vector_pair rowA2 = *((__vector_pair *)((void *)&AO[(l<<4)+4])); + __vector_pair rowA3 = *((__vector_pair *)((void *)&AO[(l<<4)+8])); + __vector_pair rowA4 = *((__vector_pair *)((void *)&AO[(l<<4)+12])); + vec_t rowB1 = *(vec_t *) & BO[l<<1]; + __builtin_mma_xvf64gerpp(&acc0, rowA1, rowB1); + __builtin_mma_xvf64gerpp(&acc1, rowA2, rowB1); + __builtin_mma_xvf64gerpp(&acc2, rowA3, rowB1); + __builtin_mma_xvf64gerpp(&acc3, rowA4, rowB1); + } + SAVE_ACC_COMPLEX_21_4 + + AO += temp << 4; + BO += temp << 1; + CO += 16; +#if defined(TRMMKERNEL) + REFRESH_AFTER_SAVE (8, 1) +#endif + } + if (m & 4) + { +#if defined(TRMMKERNEL) + REFRESH_POINTERS (4, 1) +#else + BO = B; + temp = k; +#endif + SET_ACC_ZERO() + for (l = 0; l < (temp & (~3)); l+=4) + { + __vector_pair rowA1 = *((__vector_pair *)((void *)&AO[l<<3])); + __vector_pair rowA2 = *((__vector_pair *)((void *)&AO[(l<<3)+4])); + __vector_pair rowA3 = *((__vector_pair *)((void *)&AO[(l<<3)+8])); + __vector_pair rowA4 = *((__vector_pair *)((void *)&AO[(l<<3)+12])); + __vector_pair rowA5 = *((__vector_pair *)((void *)&AO[(l<<3)+16])); + __vector_pair rowA6 = *((__vector_pair *)((void *)&AO[(l<<3)+20])); + __vector_pair rowA7 = *((__vector_pair *)((void *)&AO[(l<<3)+24])); + __vector_pair rowA8 = *((__vector_pair *)((void *)&AO[(l<<3)+28])); + vec_t rowB1 = *(vec_t *) & BO[l<<1]; + vec_t rowB2 = *(vec_t *) & BO[(l<<1)+2]; + vec_t rowB3 = *(vec_t *) & BO[(l<<1)+4]; + vec_t rowB4 = *(vec_t *) & BO[(l<<1)+6]; + __builtin_mma_xvf64gerpp(&acc0, rowA1, rowB1); + __builtin_mma_xvf64gerpp(&acc1, rowA2, rowB1); + __builtin_mma_xvf64gerpp(&acc2, rowA3, rowB2); + __builtin_mma_xvf64gerpp(&acc3, rowA4, rowB2); + __builtin_mma_xvf64gerpp(&acc4, rowA5, rowB3); + __builtin_mma_xvf64gerpp(&acc5, rowA6, rowB3); + __builtin_mma_xvf64gerpp(&acc6, rowA7, rowB4); + __builtin_mma_xvf64gerpp(&acc7, rowA8, rowB4); + } + for (l = (temp & (~3)); l < temp; ++l) + { + __vector_pair rowA1 = *((__vector_pair *)((void *)&AO[l<<3])); + __vector_pair rowA2 = *((__vector_pair *)((void *)&AO[(l<<3)+4])); + vec_t rowB1 = *(vec_t *) & BO[l<<1]; + __builtin_mma_xvf64gerpp(&acc0, rowA1, rowB1); + __builtin_mma_xvf64gerpp(&acc1, rowA2, rowB1); + } + SAVE_ACC_COMPLEX_21_2 + AO += temp << 3; + BO += temp << 1; + CO += 8; +#if defined(TRMMKERNEL) + REFRESH_AFTER_SAVE (4, 1) +#endif + } if (m & 2) + { +#if defined(TRMMKERNEL) + REFRESH_POINTERS (2, 1) +#else + BO = B; + temp = k; +#endif + SET_ACC_ZERO() + for (l = 0; l < (temp & (~7)); l+=8) + { + __vector_pair rowA1 = *((__vector_pair *)((void *)&AO[l<<2])); + __vector_pair rowA2 = *((__vector_pair *)((void *)&AO[(l<<2)+4])); + __vector_pair rowA3 = *((__vector_pair *)((void *)&AO[(l<<2)+8])); + __vector_pair rowA4 = *((__vector_pair *)((void *)&AO[(l<<2)+12])); + __vector_pair rowA5 = *((__vector_pair *)((void *)&AO[(l<<2)+16])); + __vector_pair rowA6 = *((__vector_pair *)((void *)&AO[(l<<2)+20])); + __vector_pair rowA7 = *((__vector_pair *)((void *)&AO[(l<<2)+24])); + __vector_pair rowA8 = *((__vector_pair *)((void *)&AO[(l<<2)+28])); + vec_t rowB1 = *(vec_t *) & BO[l<<1]; + vec_t rowB2 = *(vec_t *) & BO[(l<<1)+2]; + vec_t rowB3 = *(vec_t *) & BO[(l<<1)+4]; + vec_t rowB4 = *(vec_t *) & BO[(l<<1)+6]; + vec_t rowB5 = *(vec_t *) & BO[(l<<1)+8]; + vec_t rowB6 = *(vec_t *) & BO[(l<<1)+10]; + vec_t rowB7 = *(vec_t *) & BO[(l<<1)+12]; + vec_t rowB8 = *(vec_t *) & BO[(l<<1)+14]; + __builtin_mma_xvf64gerpp(&acc0, rowA1, rowB1); + __builtin_mma_xvf64gerpp(&acc1, rowA2, rowB2); + __builtin_mma_xvf64gerpp(&acc2, rowA3, rowB3); + __builtin_mma_xvf64gerpp(&acc3, rowA4, rowB4); + __builtin_mma_xvf64gerpp(&acc4, rowA5, rowB5); + __builtin_mma_xvf64gerpp(&acc5, rowA6, rowB6); + __builtin_mma_xvf64gerpp(&acc6, rowA7, rowB7); + __builtin_mma_xvf64gerpp(&acc7, rowA8, rowB8); + } + for (l = (temp & (~7)); l < temp; ++l) + { + __vector_pair rowA1 = *((__vector_pair *)((void *)&AO[l<<2])); + vec_t rowB1 = *(vec_t *) & BO[l<<1]; + __builtin_mma_xvf64gerpp(&acc0, rowA1, rowB1); + } + SAVE_ACC_COMPLEX_21_1 + AO += temp << 2; + BO += temp << 1; + CO += 4; +#if defined(TRMMKERNEL) + REFRESH_AFTER_SAVE (2, 1) +#endif + } + if (m & 1) + { +#if defined(TRMMKERNEL) + REFRESH_POINTERS (1, 1) +#else + BO = B; + temp = k; +#endif + // RIP OUT MMA STUFF! + SET_ACC_ZERO() + for (l = 0; l < (temp & (~7)); l+=8) + { + __vector_pair rowA1 = *((__vector_pair *)((void *)&AO[l<<1])); + __vector_pair rowA2 = *((__vector_pair *)((void *)&AO[(l<<1)+2])); + __vector_pair rowA3 = *((__vector_pair *)((void *)&AO[(l<<1)+4])); + __vector_pair rowA4 = *((__vector_pair *)((void *)&AO[(l<<1)+6])); + __vector_pair rowA5 = *((__vector_pair *)((void *)&AO[(l<<1)+8])); + __vector_pair rowA6 = *((__vector_pair *)((void *)&AO[(l<<1)+10])); + __vector_pair rowA7 = *((__vector_pair *)((void *)&AO[(l<<1)+12])); + __vector_pair rowA8 = *((__vector_pair *)((void *)&AO[(l<<1)+14])); + vec_t rowB1 = *(vec_t *) & BO[l<<1]; + vec_t rowB2 = *(vec_t *) & BO[(l<<1)+2]; + vec_t rowB3 = *(vec_t *) & BO[(l<<1)+4]; + vec_t rowB4 = *(vec_t *) & BO[(l<<1)+6]; + vec_t rowB5 = *(vec_t *) & BO[(l<<1)+8]; + vec_t rowB6 = *(vec_t *) & BO[(l<<1)+10]; + vec_t rowB7 = *(vec_t *) & BO[(l<<1)+12]; + vec_t rowB8 = *(vec_t *) & BO[(l<<1)+14]; + __builtin_mma_xvf64gerpp(&acc0, rowA1, rowB1); + __builtin_mma_xvf64gerpp(&acc1, rowA2, rowB2); + __builtin_mma_xvf64gerpp(&acc2, rowA3, rowB3); + __builtin_mma_xvf64gerpp(&acc3, rowA4, rowB4); + __builtin_mma_xvf64gerpp(&acc4, rowA5, rowB5); + __builtin_mma_xvf64gerpp(&acc5, rowA6, rowB6); + __builtin_mma_xvf64gerpp(&acc6, rowA7, rowB7); + __builtin_mma_xvf64gerpp(&acc7, rowA8, rowB8); + } + for (l = (temp & (~7)); l < temp; ++l) + { + __vector_pair rowA1 = *((__vector_pair *)((void *)&AO[l<<1])); + vec_t rowB1 = *(vec_t *) & BO[l<<1]; + __builtin_mma_xvf64gerpp(&acc0, rowA1, rowB1); + } + SAVE_ACC_COMPLEX_11 + AO += temp << 1; + BO += temp << 1; + CO += 2; +#if defined(TRMMKERNEL) + REFRESH_AFTER_SAVE (1, 1) +#endif + } +#if defined(TRMMKERNEL) && !defined(LEFT) + off += 1; // number of values in A +#endif + B += k << 1; + } + return 0; +} From 87ba528d8b12d8debf77b5b952b7c31d2ba1bd08 Mon Sep 17 00:00:00 2001 From: austinpagan Date: Thu, 1 Feb 2024 18:46:07 -0600 Subject: [PATCH 106/311] Changed C files to straighten out indentation. Removed commented lines from other file. --- kernel/power/KERNEL.POWER10 | 21 - kernel/power/cgemm_kernel_power10.c | 1725 +++++++++++++-------------- kernel/power/zgemm_kernel_power10.c | 1161 +++++++++--------- 3 files changed, 1411 insertions(+), 1496 deletions(-) diff --git a/kernel/power/KERNEL.POWER10 b/kernel/power/KERNEL.POWER10 index 5f49b9c46..4e408e121 100644 --- a/kernel/power/KERNEL.POWER10 +++ b/kernel/power/KERNEL.POWER10 @@ -16,17 +16,8 @@ SBGEMMOTCOPYOBJ = sbgemm_otcopy$(TSUFFIX).$(SUFFIX) STRMMKERNEL = sgemm_kernel_power10.c DTRMMKERNEL = dgemm_kernel_power10.c -ifeq ($(OSNAME), AIX) -#CTRMMKERNEL = ctrmm_kernel_8x4_power8.S -#ZTRMMKERNEL = ztrmm_kernel_8x2_power8.S -CTRMMKERNEL = cgemm_kernel_power10.c -ZTRMMKERNEL = zgemm_kernel_power10.c -else -#CTRMMKERNEL = cgemm_kernel_power10.S -#ZTRMMKERNEL = zgemm_kernel_power10.S CTRMMKERNEL = cgemm_kernel_power10.c ZTRMMKERNEL = zgemm_kernel_power10.c -endif SGEMMKERNEL = sgemm_kernel_power10.c SGEMMINCOPY = ../generic/gemm_ncopy_16.c @@ -68,13 +59,7 @@ DGEMM_SMALL_K_B0_TT = dgemm_small_kernel_tt_power10.c DGEMM_SMALL_K_TN = dgemm_small_kernel_tn_power10.c DGEMM_SMALL_K_B0_TN = dgemm_small_kernel_tn_power10.c -ifeq ($(OSNAME), AIX) -#CGEMMKERNEL = cgemm_kernel_8x4_power8.S CGEMMKERNEL = cgemm_kernel_power10.c -else -#CGEMMKERNEL = cgemm_kernel_power10.S -CGEMMKERNEL = cgemm_kernel_power10.c -endif #CGEMMKERNEL = cgemm_kernel_8x4_power8.S CGEMMINCOPY = ../generic/zgemm_ncopy_8.c ifeq ($(OSNAME), AIX) @@ -89,13 +74,7 @@ CGEMMOTCOPYOBJ = cgemm_otcopy$(TSUFFIX).$(SUFFIX) CGEMMINCOPYOBJ = cgemm_incopy$(TSUFFIX).$(SUFFIX) CGEMMITCOPYOBJ = cgemm_itcopy$(TSUFFIX).$(SUFFIX) -ifeq ($(OSNAME), AIX) -#ZGEMMKERNEL = zgemm_kernel_8x2_power8.S ZGEMMKERNEL = zgemm_kernel_power10.c -else -#ZGEMMKERNEL = zgemm_kernel_power10.S -ZGEMMKERNEL = zgemm_kernel_power10.c -endif ZGEMMONCOPY = ../generic/zgemm_ncopy_2.c ZGEMMOTCOPY = ../generic/zgemm_tcopy_2.c ZGEMMINCOPY = ../generic/zgemm_ncopy_8.c diff --git a/kernel/power/cgemm_kernel_power10.c b/kernel/power/cgemm_kernel_power10.c index 279c83aec..233768cef 100644 --- a/kernel/power/cgemm_kernel_power10.c +++ b/kernel/power/cgemm_kernel_power10.c @@ -31,15 +31,15 @@ typedef __vector unsigned char vec_t; typedef FLOAT v4sf_t __attribute__ ((vector_size (16))); typedef FLOAT v2sf_t __attribute__ ((vector_size (8))); -#define SET_ACC_ZERO() \ - __builtin_mma_xxsetaccz (&acc0); \ - __builtin_mma_xxsetaccz (&acc1); \ - __builtin_mma_xxsetaccz (&acc2); \ - __builtin_mma_xxsetaccz (&acc3); \ - __builtin_mma_xxsetaccz (&acc4); \ - __builtin_mma_xxsetaccz (&acc5); \ - __builtin_mma_xxsetaccz (&acc6); \ - __builtin_mma_xxsetaccz (&acc7); +#define SET_ACC_ZERO() \ + __builtin_mma_xxsetaccz (&acc0); \ + __builtin_mma_xxsetaccz (&acc1); \ + __builtin_mma_xxsetaccz (&acc2); \ + __builtin_mma_xxsetaccz (&acc3); \ + __builtin_mma_xxsetaccz (&acc4); \ + __builtin_mma_xxsetaccz (&acc5); \ + __builtin_mma_xxsetaccz (&acc6); \ + __builtin_mma_xxsetaccz (&acc7); #if (defined(NN) || defined(NT) || defined(TN) || defined(TT)) #define COMP_MUL(_real, _arbr, _aibi, _imag, _arbi, _aibr) { _real = _arbr - _aibi; _imag = _arbi + _aibr; } @@ -67,231 +67,231 @@ typedef FLOAT v2sf_t __attribute__ ((vector_size (8))); #define A_OP += #endif -#define BUILTIN_MMA_DISASSEMBLE_ACC_8 \ - __builtin_mma_disassemble_acc ((void *)result, &acc0); \ - __builtin_mma_disassemble_acc ((void *)&result[ 4], &acc1); \ - __builtin_mma_disassemble_acc ((void *)&result[ 8], &acc2); \ - __builtin_mma_disassemble_acc ((void *)&result[12], &acc3); \ - __builtin_mma_disassemble_acc ((void *)&result[16], &acc4); \ - __builtin_mma_disassemble_acc ((void *)&result[20], &acc5); \ - __builtin_mma_disassemble_acc ((void *)&result[24], &acc6); \ - __builtin_mma_disassemble_acc ((void *)&result[28], &acc7); +#define BUILTIN_MMA_DISASSEMBLE_ACC_8 \ + __builtin_mma_disassemble_acc ((void *)result, &acc0); \ + __builtin_mma_disassemble_acc ((void *)&result[ 4], &acc1); \ + __builtin_mma_disassemble_acc ((void *)&result[ 8], &acc2); \ + __builtin_mma_disassemble_acc ((void *)&result[12], &acc3); \ + __builtin_mma_disassemble_acc ((void *)&result[16], &acc4); \ + __builtin_mma_disassemble_acc ((void *)&result[20], &acc5); \ + __builtin_mma_disassemble_acc ((void *)&result[24], &acc6); \ + __builtin_mma_disassemble_acc ((void *)&result[28], &acc7); -#define COMP_MUL_1 \ - COMP_MUL(tr[0], res[ 0], res[ 5], ti[0], res[ 1], res[ 4]) +#define COMP_MUL_1 \ + COMP_MUL(tr[0], res[ 0], res[ 5], ti[0], res[ 1], res[ 4]) -#define COMP_MAC_1(_offset) { \ - FLOAT *_ro = &res[_offset]; \ - COMP_MAC(tr[0], _ro[ 0], _ro[ 5], ti[0], _ro[ 1], _ro[ 4]) \ +#define COMP_MAC_1(_offset) { \ + FLOAT *_ro = &res[_offset]; \ + COMP_MAC(tr[0], _ro[ 0], _ro[ 5], ti[0], _ro[ 1], _ro[ 4]) \ } -#define COMP_MUL_2A \ - COMP_MUL(tr[0], res[ 0], res[ 5], ti[0], res[ 1], res[ 4]) \ - COMP_MUL(tr[1], res[ 2], res[ 7], ti[1], res[ 3], res[ 6]) +#define COMP_MUL_2A \ + COMP_MUL(tr[0], res[ 0], res[ 5], ti[0], res[ 1], res[ 4]) \ + COMP_MUL(tr[1], res[ 2], res[ 7], ti[1], res[ 3], res[ 6]) -#define COMP_MAC_2A(_offset) { \ - FLOAT *_ro = &res[_offset]; \ - COMP_MAC(tr[0], _ro[ 0], _ro[ 5], ti[0], _ro[ 1], _ro[ 4]) \ - COMP_MAC(tr[1], _ro[ 2], _ro[ 7], ti[1], _ro[ 3], _ro[ 6]) \ +#define COMP_MAC_2A(_offset) { \ + FLOAT *_ro = &res[_offset]; \ + COMP_MAC(tr[0], _ro[ 0], _ro[ 5], ti[0], _ro[ 1], _ro[ 4]) \ + COMP_MAC(tr[1], _ro[ 2], _ro[ 7], ti[1], _ro[ 3], _ro[ 6]) \ } -#define COMP_MUL_2B \ - COMP_MUL(tr[0], res[ 0], res[ 5], ti[0], res[ 1], res[ 4]) \ - COMP_MUL(tr[1], res[ 8], res[13], ti[1], res[ 9], res[12]) +#define COMP_MUL_2B \ + COMP_MUL(tr[0], res[ 0], res[ 5], ti[0], res[ 1], res[ 4]) \ + COMP_MUL(tr[1], res[ 8], res[13], ti[1], res[ 9], res[12]) -#define COMP_MAC_2B(_offset) { \ - FLOAT *_ro = &res[_offset]; \ - COMP_MAC(tr[0], _ro[ 0], _ro[ 5], ti[0], _ro[ 1], _ro[ 4]) \ - COMP_MAC(tr[1], _ro[ 8], _ro[13], ti[1], _ro[ 9], _ro[12]) \ +#define COMP_MAC_2B(_offset) { \ + FLOAT *_ro = &res[_offset]; \ + COMP_MAC(tr[0], _ro[ 0], _ro[ 5], ti[0], _ro[ 1], _ro[ 4]) \ + COMP_MAC(tr[1], _ro[ 8], _ro[13], ti[1], _ro[ 9], _ro[12]) \ } -#define COMP_MUL_4A(_offset) { \ - FLOAT *_ro = &res[_offset]; \ - COMP_MUL(tr[0], _ro[ 0], _ro[ 5], ti[0], _ro[ 1], _ro[ 4]) \ - COMP_MUL(tr[1], _ro[ 8], _ro[13], ti[1], _ro[ 9], _ro[12]) \ - COMP_MUL(tr[2], _ro[16], _ro[21], ti[2], _ro[17], _ro[20]) \ - COMP_MUL(tr[3], _ro[24], _ro[29], ti[3], _ro[25], _ro[28]) \ +#define COMP_MUL_4A(_offset) { \ + FLOAT *_ro = &res[_offset]; \ + COMP_MUL(tr[0], _ro[ 0], _ro[ 5], ti[0], _ro[ 1], _ro[ 4]) \ + COMP_MUL(tr[1], _ro[ 8], _ro[13], ti[1], _ro[ 9], _ro[12]) \ + COMP_MUL(tr[2], _ro[16], _ro[21], ti[2], _ro[17], _ro[20]) \ + COMP_MUL(tr[3], _ro[24], _ro[29], ti[3], _ro[25], _ro[28]) \ } -#define COMP_MAC_4A(_offset) { \ - FLOAT *_ro = &res[_offset]; \ - COMP_MAC(tr[0], _ro[ 0], _ro[ 5], ti[0], _ro[ 1], _ro[ 4]) \ - COMP_MAC(tr[1], _ro[ 8], _ro[13], ti[1], _ro[ 9], _ro[12]) \ - COMP_MAC(tr[2], _ro[16], _ro[21], ti[2], _ro[17], _ro[20]) \ - COMP_MAC(tr[3], _ro[24], _ro[29], ti[3], _ro[25], _ro[28]) \ +#define COMP_MAC_4A(_offset) { \ + FLOAT *_ro = &res[_offset]; \ + COMP_MAC(tr[0], _ro[ 0], _ro[ 5], ti[0], _ro[ 1], _ro[ 4]) \ + COMP_MAC(tr[1], _ro[ 8], _ro[13], ti[1], _ro[ 9], _ro[12]) \ + COMP_MAC(tr[2], _ro[16], _ro[21], ti[2], _ro[17], _ro[20]) \ + COMP_MAC(tr[3], _ro[24], _ro[29], ti[3], _ro[25], _ro[28]) \ } -#define COMP_MUL_4B(_offset) { \ - FLOAT *_ro = &res[_offset]; \ - COMP_MUL(tr[0], _ro[ 0], _ro[ 5], ti[0], _ro[ 1], _ro[ 4]) \ - COMP_MUL(tr[1], _ro[ 8], _ro[13], ti[1], _ro[ 9], _ro[12]) \ - COMP_MUL(tr[2], _ro[ 2], _ro[ 7], ti[2], _ro[ 3], _ro[ 6]) \ - COMP_MUL(tr[3], _ro[10], _ro[15], ti[3], _ro[11], _ro[14]) \ +#define COMP_MUL_4B(_offset) { \ + FLOAT *_ro = &res[_offset]; \ + COMP_MUL(tr[0], _ro[ 0], _ro[ 5], ti[0], _ro[ 1], _ro[ 4]) \ + COMP_MUL(tr[1], _ro[ 8], _ro[13], ti[1], _ro[ 9], _ro[12]) \ + COMP_MUL(tr[2], _ro[ 2], _ro[ 7], ti[2], _ro[ 3], _ro[ 6]) \ + COMP_MUL(tr[3], _ro[10], _ro[15], ti[3], _ro[11], _ro[14]) \ } -#define COMP_MAC_4B(_offset) { \ - FLOAT *_ro = &res[_offset]; \ - COMP_MAC(tr[0], _ro[ 0], _ro[ 5], ti[0], _ro[ 1], _ro[ 4]) \ - COMP_MAC(tr[1], _ro[ 8], _ro[13], ti[1], _ro[ 9], _ro[12]) \ - COMP_MAC(tr[2], _ro[ 2], _ro[ 7], ti[2], _ro[ 3], _ro[ 6]) \ - COMP_MAC(tr[3], _ro[10], _ro[15], ti[3], _ro[11], _ro[14]) \ +#define COMP_MAC_4B(_offset) { \ + FLOAT *_ro = &res[_offset]; \ + COMP_MAC(tr[0], _ro[ 0], _ro[ 5], ti[0], _ro[ 1], _ro[ 4]) \ + COMP_MAC(tr[1], _ro[ 8], _ro[13], ti[1], _ro[ 9], _ro[12]) \ + COMP_MAC(tr[2], _ro[ 2], _ro[ 7], ti[2], _ro[ 3], _ro[ 6]) \ + COMP_MAC(tr[3], _ro[10], _ro[15], ti[3], _ro[11], _ro[14]) \ } -#define SAVE_ACC_COMPLEX_11 \ - BUILTIN_MMA_DISASSEMBLE_ACC_8 \ - COMP_MUL_1 \ - COMP_MAC_1(16) \ - COMP_MAC_1(32) \ - COMP_MAC_1(48) \ - COMP_MAC_1(64) \ - COMP_MAC_1(80) \ - COMP_MAC_1(96) \ - COMP_MAC_1(112) \ - CO[0] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ - CO[1] A_OP ti[0] * alpha_r + tr[0] * alpha_i; +#define SAVE_ACC_COMPLEX_11 \ + BUILTIN_MMA_DISASSEMBLE_ACC_8 \ + COMP_MUL_1 \ + COMP_MAC_1(16) \ + COMP_MAC_1(32) \ + COMP_MAC_1(48) \ + COMP_MAC_1(64) \ + COMP_MAC_1(80) \ + COMP_MAC_1(96) \ + COMP_MAC_1(112) \ + CO[0] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ + CO[1] A_OP ti[0] * alpha_r + tr[0] * alpha_i; -#define SAVE_ACC_COMPLEX_12 \ - BUILTIN_MMA_DISASSEMBLE_ACC_8 \ - COMP_MUL_2A \ - COMP_MAC_2A(16) \ - COMP_MAC_2A(32) \ - COMP_MAC_2A(48) \ - COMP_MAC_2A(64) \ - COMP_MAC_2A(80) \ - COMP_MAC_2A(96) \ - COMP_MAC_2A(112) \ - CO[0] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ - CO[1] A_OP ti[0] * alpha_r + tr[0] * alpha_i; \ - CO[2*ldc+0] A_OP tr[1] * alpha_r - ti[1] * alpha_i; \ - CO[2*ldc+1] A_OP ti[1] * alpha_r + tr[1] * alpha_i; +#define SAVE_ACC_COMPLEX_12 \ + BUILTIN_MMA_DISASSEMBLE_ACC_8 \ + COMP_MUL_2A \ + COMP_MAC_2A(16) \ + COMP_MAC_2A(32) \ + COMP_MAC_2A(48) \ + COMP_MAC_2A(64) \ + COMP_MAC_2A(80) \ + COMP_MAC_2A(96) \ + COMP_MAC_2A(112) \ + CO[0] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ + CO[1] A_OP ti[0] * alpha_r + tr[0] * alpha_i; \ + CO[2*ldc+0] A_OP tr[1] * alpha_r - ti[1] * alpha_i; \ + CO[2*ldc+1] A_OP ti[1] * alpha_r + tr[1] * alpha_i; -#define SAVE_ACC_COMPLEX_21_1 \ - BUILTIN_MMA_DISASSEMBLE_ACC_8 \ - COMP_MUL_2B \ - COMP_MAC_2B(16) \ - COMP_MAC_2B(32) \ - COMP_MAC_2B(48) \ - COMP_MAC_2B(64) \ - COMP_MAC_2B(80) \ - COMP_MAC_2B(96) \ - COMP_MAC_2B(112) \ - CO[0] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ - CO[1] A_OP ti[0] * alpha_r + tr[0] * alpha_i; \ - CO[2] A_OP tr[1] * alpha_r - ti[1] * alpha_i; \ - CO[3] A_OP ti[1] * alpha_r + tr[1] * alpha_i; +#define SAVE_ACC_COMPLEX_21_1 \ + BUILTIN_MMA_DISASSEMBLE_ACC_8 \ + COMP_MUL_2B \ + COMP_MAC_2B(16) \ + COMP_MAC_2B(32) \ + COMP_MAC_2B(48) \ + COMP_MAC_2B(64) \ + COMP_MAC_2B(80) \ + COMP_MAC_2B(96) \ + COMP_MAC_2B(112) \ + CO[0] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ + CO[1] A_OP ti[0] * alpha_r + tr[0] * alpha_i; \ + CO[2] A_OP tr[1] * alpha_r - ti[1] * alpha_i; \ + CO[3] A_OP ti[1] * alpha_r + tr[1] * alpha_i; -#define SAVE_ACC_COMPLEX_21_2 \ - BUILTIN_MMA_DISASSEMBLE_ACC_8 \ - COMP_MUL_4A(0) \ - COMP_MAC_4A(32) \ - COMP_MAC_4A(64) \ - COMP_MAC_4A(96) \ - CO[0] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ - CO[1] A_OP ti[0] * alpha_r + tr[0] * alpha_i; \ - CO[2] A_OP tr[1] * alpha_r - ti[1] * alpha_i; \ - CO[3] A_OP ti[1] * alpha_r + tr[1] * alpha_i; \ - CO[4] A_OP tr[2] * alpha_r - ti[2] * alpha_i; \ - CO[5] A_OP ti[2] * alpha_r + tr[2] * alpha_i; \ - CO[6] A_OP tr[3] * alpha_r - ti[3] * alpha_i; \ - CO[7] A_OP ti[3] * alpha_r + tr[3] * alpha_i; +#define SAVE_ACC_COMPLEX_21_2 \ + BUILTIN_MMA_DISASSEMBLE_ACC_8 \ + COMP_MUL_4A(0) \ + COMP_MAC_4A(32) \ + COMP_MAC_4A(64) \ + COMP_MAC_4A(96) \ + CO[0] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ + CO[1] A_OP ti[0] * alpha_r + tr[0] * alpha_i; \ + CO[2] A_OP tr[1] * alpha_r - ti[1] * alpha_i; \ + CO[3] A_OP ti[1] * alpha_r + tr[1] * alpha_i; \ + CO[4] A_OP tr[2] * alpha_r - ti[2] * alpha_i; \ + CO[5] A_OP ti[2] * alpha_r + tr[2] * alpha_i; \ + CO[6] A_OP tr[3] * alpha_r - ti[3] * alpha_i; \ + CO[7] A_OP ti[3] * alpha_r + tr[3] * alpha_i; -#define SAVE_ACC_COMPLEX_21_4 \ - BUILTIN_MMA_DISASSEMBLE_ACC_8 \ - COMP_MUL_4A(0) \ - COMP_MAC_4A(64) \ - CO[ 0] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ - CO[ 1] A_OP ti[0] * alpha_r + tr[0] * alpha_i; \ - CO[ 2] A_OP tr[1] * alpha_r - ti[1] * alpha_i; \ - CO[ 3] A_OP ti[1] * alpha_r + tr[1] * alpha_i; \ - CO[ 4] A_OP tr[2] * alpha_r - ti[2] * alpha_i; \ - CO[ 5] A_OP ti[2] * alpha_r + tr[2] * alpha_i; \ - CO[ 6] A_OP tr[3] * alpha_r - ti[3] * alpha_i; \ - CO[ 7] A_OP ti[3] * alpha_r + tr[3] * alpha_i; \ - COMP_MUL_4A(32) \ - COMP_MAC_4A(96) \ - CO[ 8] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ - CO[ 9] A_OP ti[0] * alpha_r + tr[0] * alpha_i; \ - CO[10] A_OP tr[1] * alpha_r - ti[1] * alpha_i; \ - CO[11] A_OP ti[1] * alpha_r + tr[1] * alpha_i; \ - CO[12] A_OP tr[2] * alpha_r - ti[2] * alpha_i; \ - CO[13] A_OP ti[2] * alpha_r + tr[2] * alpha_i; \ - CO[14] A_OP tr[3] * alpha_r - ti[3] * alpha_i; \ - CO[15] A_OP ti[3] * alpha_r + tr[3] * alpha_i; +#define SAVE_ACC_COMPLEX_21_4 \ + BUILTIN_MMA_DISASSEMBLE_ACC_8 \ + COMP_MUL_4A(0) \ + COMP_MAC_4A(64) \ + CO[ 0] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ + CO[ 1] A_OP ti[0] * alpha_r + tr[0] * alpha_i; \ + CO[ 2] A_OP tr[1] * alpha_r - ti[1] * alpha_i; \ + CO[ 3] A_OP ti[1] * alpha_r + tr[1] * alpha_i; \ + CO[ 4] A_OP tr[2] * alpha_r - ti[2] * alpha_i; \ + CO[ 5] A_OP ti[2] * alpha_r + tr[2] * alpha_i; \ + CO[ 6] A_OP tr[3] * alpha_r - ti[3] * alpha_i; \ + CO[ 7] A_OP ti[3] * alpha_r + tr[3] * alpha_i; \ + COMP_MUL_4A(32) \ + COMP_MAC_4A(96) \ + CO[ 8] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ + CO[ 9] A_OP ti[0] * alpha_r + tr[0] * alpha_i; \ + CO[10] A_OP tr[1] * alpha_r - ti[1] * alpha_i; \ + CO[11] A_OP ti[1] * alpha_r + tr[1] * alpha_i; \ + CO[12] A_OP tr[2] * alpha_r - ti[2] * alpha_i; \ + CO[13] A_OP ti[2] * alpha_r + tr[2] * alpha_i; \ + CO[14] A_OP tr[3] * alpha_r - ti[3] * alpha_i; \ + CO[15] A_OP ti[3] * alpha_r + tr[3] * alpha_i; -#define SAVE_ACC_COMPLEX_22_4 \ - BUILTIN_MMA_DISASSEMBLE_ACC_8 \ - COMP_MUL_4B(0) \ - CO[ 0] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ - CO[ 1] A_OP ti[0] * alpha_r + tr[0] * alpha_i; \ - CO[ 2] A_OP tr[1] * alpha_r - ti[1] * alpha_i; \ - CO[ 3] A_OP ti[1] * alpha_r + tr[1] * alpha_i; \ - CO[2*ldc+ 0] A_OP tr[2] * alpha_r - ti[2] * alpha_i; \ - CO[2*ldc+ 1] A_OP ti[2] * alpha_r + tr[2] * alpha_i; \ - CO[2*ldc+ 2] A_OP tr[3] * alpha_r - ti[3] * alpha_i; \ - CO[2*ldc+ 3] A_OP ti[3] * alpha_r + tr[3] * alpha_i; \ - COMP_MUL_4B(16) \ - CO[ 4] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ - CO[ 5] A_OP ti[0] * alpha_r + tr[0] * alpha_i; \ - CO[ 6] A_OP tr[1] * alpha_r - ti[1] * alpha_i; \ - CO[ 7] A_OP ti[1] * alpha_r + tr[1] * alpha_i; \ - CO[2*ldc+ 4] A_OP tr[2] * alpha_r - ti[2] * alpha_i; \ - CO[2*ldc+ 5] A_OP ti[2] * alpha_r + tr[2] * alpha_i; \ - CO[2*ldc+ 6] A_OP tr[3] * alpha_r - ti[3] * alpha_i; \ - CO[2*ldc+ 7] A_OP ti[3] * alpha_r + tr[3] * alpha_i; \ - COMP_MUL_4B(32) \ - CO[ 8] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ - CO[ 9] A_OP ti[0] * alpha_r + tr[0] * alpha_i; \ - CO[10] A_OP tr[1] * alpha_r - ti[1] * alpha_i; \ - CO[11] A_OP ti[1] * alpha_r + tr[1] * alpha_i; \ - CO[2*ldc+ 8] A_OP tr[2] * alpha_r - ti[2] * alpha_i; \ - CO[2*ldc+ 9] A_OP ti[2] * alpha_r + tr[2] * alpha_i; \ - CO[2*ldc+10] A_OP tr[3] * alpha_r - ti[3] * alpha_i; \ - CO[2*ldc+11] A_OP ti[3] * alpha_r + tr[3] * alpha_i; \ - COMP_MUL_4B(48) \ - CO[12] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ - CO[13] A_OP ti[0] * alpha_r + tr[0] * alpha_i; \ - CO[14] A_OP tr[1] * alpha_r - ti[1] * alpha_i; \ - CO[15] A_OP ti[1] * alpha_r + tr[1] * alpha_i; \ - CO[2*ldc+12] A_OP tr[2] * alpha_r - ti[2] * alpha_i; \ - CO[2*ldc+13] A_OP ti[2] * alpha_r + tr[2] * alpha_i; \ - CO[2*ldc+14] A_OP tr[3] * alpha_r - ti[3] * alpha_i; \ - CO[2*ldc+15] A_OP ti[3] * alpha_r + tr[3] * alpha_i; +#define SAVE_ACC_COMPLEX_22_4 \ + BUILTIN_MMA_DISASSEMBLE_ACC_8 \ + COMP_MUL_4B(0) \ + CO[ 0] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ + CO[ 1] A_OP ti[0] * alpha_r + tr[0] * alpha_i; \ + CO[ 2] A_OP tr[1] * alpha_r - ti[1] * alpha_i; \ + CO[ 3] A_OP ti[1] * alpha_r + tr[1] * alpha_i; \ + CO[2*ldc+ 0] A_OP tr[2] * alpha_r - ti[2] * alpha_i; \ + CO[2*ldc+ 1] A_OP ti[2] * alpha_r + tr[2] * alpha_i; \ + CO[2*ldc+ 2] A_OP tr[3] * alpha_r - ti[3] * alpha_i; \ + CO[2*ldc+ 3] A_OP ti[3] * alpha_r + tr[3] * alpha_i; \ + COMP_MUL_4B(16) \ + CO[ 4] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ + CO[ 5] A_OP ti[0] * alpha_r + tr[0] * alpha_i; \ + CO[ 6] A_OP tr[1] * alpha_r - ti[1] * alpha_i; \ + CO[ 7] A_OP ti[1] * alpha_r + tr[1] * alpha_i; \ + CO[2*ldc+ 4] A_OP tr[2] * alpha_r - ti[2] * alpha_i; \ + CO[2*ldc+ 5] A_OP ti[2] * alpha_r + tr[2] * alpha_i; \ + CO[2*ldc+ 6] A_OP tr[3] * alpha_r - ti[3] * alpha_i; \ + CO[2*ldc+ 7] A_OP ti[3] * alpha_r + tr[3] * alpha_i; \ + COMP_MUL_4B(32) \ + CO[ 8] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ + CO[ 9] A_OP ti[0] * alpha_r + tr[0] * alpha_i; \ + CO[10] A_OP tr[1] * alpha_r - ti[1] * alpha_i; \ + CO[11] A_OP ti[1] * alpha_r + tr[1] * alpha_i; \ + CO[2*ldc+ 8] A_OP tr[2] * alpha_r - ti[2] * alpha_i; \ + CO[2*ldc+ 9] A_OP ti[2] * alpha_r + tr[2] * alpha_i; \ + CO[2*ldc+10] A_OP tr[3] * alpha_r - ti[3] * alpha_i; \ + CO[2*ldc+11] A_OP ti[3] * alpha_r + tr[3] * alpha_i; \ + COMP_MUL_4B(48) \ + CO[12] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ + CO[13] A_OP ti[0] * alpha_r + tr[0] * alpha_i; \ + CO[14] A_OP tr[1] * alpha_r - ti[1] * alpha_i; \ + CO[15] A_OP ti[1] * alpha_r + tr[1] * alpha_i; \ + CO[2*ldc+12] A_OP tr[2] * alpha_r - ti[2] * alpha_i; \ + CO[2*ldc+13] A_OP ti[2] * alpha_r + tr[2] * alpha_i; \ + CO[2*ldc+14] A_OP tr[3] * alpha_r - ti[3] * alpha_i; \ + CO[2*ldc+15] A_OP ti[3] * alpha_r + tr[3] * alpha_i; -#define SAVE_ACC_COMPLEX_22_2 \ - BUILTIN_MMA_DISASSEMBLE_ACC_8 \ - COMP_MUL_4B(0) \ - CO[0] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ - CO[1] A_OP ti[0] * alpha_r + tr[0] * alpha_i; \ - CO[2] A_OP tr[1] * alpha_r - ti[1] * alpha_i; \ - CO[3] A_OP ti[1] * alpha_r + tr[1] * alpha_i; \ - CO[2*ldc+0] A_OP tr[2] * alpha_r - ti[2] * alpha_i; \ - CO[2*ldc+1] A_OP ti[2] * alpha_r + tr[2] * alpha_i; \ - CO[2*ldc+2] A_OP tr[3] * alpha_r - ti[3] * alpha_i; \ - CO[2*ldc+3] A_OP ti[3] * alpha_r + tr[3] * alpha_i; \ - COMP_MUL_4B(16) \ - CO[4] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ - CO[5] A_OP ti[0] * alpha_r + tr[0] * alpha_i; \ - CO[6] A_OP tr[1] * alpha_r - ti[1] * alpha_i; \ - CO[7] A_OP ti[1] * alpha_r + tr[1] * alpha_i; \ - CO[2*ldc+4] A_OP tr[2] * alpha_r - ti[2] * alpha_i; \ - CO[2*ldc+5] A_OP ti[2] * alpha_r + tr[2] * alpha_i; \ - CO[2*ldc+6] A_OP tr[3] * alpha_r - ti[3] * alpha_i; \ - CO[2*ldc+7] A_OP ti[3] * alpha_r + tr[3] * alpha_i; +#define SAVE_ACC_COMPLEX_22_2 \ + BUILTIN_MMA_DISASSEMBLE_ACC_8 \ + COMP_MUL_4B(0) \ + CO[0] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ + CO[1] A_OP ti[0] * alpha_r + tr[0] * alpha_i; \ + CO[2] A_OP tr[1] * alpha_r - ti[1] * alpha_i; \ + CO[3] A_OP ti[1] * alpha_r + tr[1] * alpha_i; \ + CO[2*ldc+0] A_OP tr[2] * alpha_r - ti[2] * alpha_i; \ + CO[2*ldc+1] A_OP ti[2] * alpha_r + tr[2] * alpha_i; \ + CO[2*ldc+2] A_OP tr[3] * alpha_r - ti[3] * alpha_i; \ + CO[2*ldc+3] A_OP ti[3] * alpha_r + tr[3] * alpha_i; \ + COMP_MUL_4B(16) \ + CO[4] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ + CO[5] A_OP ti[0] * alpha_r + tr[0] * alpha_i; \ + CO[6] A_OP tr[1] * alpha_r - ti[1] * alpha_i; \ + CO[7] A_OP ti[1] * alpha_r + tr[1] * alpha_i; \ + CO[2*ldc+4] A_OP tr[2] * alpha_r - ti[2] * alpha_i; \ + CO[2*ldc+5] A_OP ti[2] * alpha_r + tr[2] * alpha_i; \ + CO[2*ldc+6] A_OP tr[3] * alpha_r - ti[3] * alpha_i; \ + CO[2*ldc+7] A_OP ti[3] * alpha_r + tr[3] * alpha_i; -#define SAVE_ACC_COMPLEX_22_1 \ - BUILTIN_MMA_DISASSEMBLE_ACC_8 \ - COMP_MUL_4B(0) \ - CO[0] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ - CO[1] A_OP ti[0] * alpha_r + tr[0] * alpha_i; \ - CO[2] A_OP tr[1] * alpha_r - ti[1] * alpha_i; \ - CO[3] A_OP ti[1] * alpha_r + tr[1] * alpha_i; \ - CO[2*ldc+0] A_OP tr[2] * alpha_r - ti[2] * alpha_i; \ - CO[2*ldc+1] A_OP ti[2] * alpha_r + tr[2] * alpha_i; \ - CO[2*ldc+2] A_OP tr[3] * alpha_r - ti[3] * alpha_i; \ - CO[2*ldc+3] A_OP ti[3] * alpha_r + tr[3] * alpha_i; +#define SAVE_ACC_COMPLEX_22_1 \ + BUILTIN_MMA_DISASSEMBLE_ACC_8 \ + COMP_MUL_4B(0) \ + CO[0] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ + CO[1] A_OP ti[0] * alpha_r + tr[0] * alpha_i; \ + CO[2] A_OP tr[1] * alpha_r - ti[1] * alpha_i; \ + CO[3] A_OP ti[1] * alpha_r + tr[1] * alpha_i; \ + CO[2*ldc+0] A_OP tr[2] * alpha_r - ti[2] * alpha_i; \ + CO[2*ldc+1] A_OP ti[2] * alpha_r + tr[2] * alpha_i; \ + CO[2*ldc+2] A_OP tr[3] * alpha_r - ti[3] * alpha_i; \ + CO[2*ldc+3] A_OP ti[3] * alpha_r + tr[3] * alpha_i; -#define SAVE_ACC_COMPLEX_24_ALL \ +#define SAVE_ACC_COMPLEX_24_ALL \ __builtin_mma_disassemble_acc ((void *)result, &acc0); \ __builtin_mma_disassemble_acc ((void *)(&result[4]), &acc4); \ __builtin_mma_disassemble_acc ((void *)(&result[8]), &acc1); \ @@ -332,205 +332,205 @@ typedef FLOAT v2sf_t __attribute__ ((vector_size (8))); COMP_MUL(tr[29], res[120], res[125], ti[29], res[121], res[124]) \ COMP_MUL(tr[30], res[114], res[119], ti[30], res[115], res[118]) \ COMP_MUL(tr[31], res[122], res[127], ti[31], res[123], res[126]) \ - CO[ 0] A_OP tr[ 0] * alpha_r - ti[ 0] * alpha_i; \ - CO[ 1] A_OP ti[ 0] * alpha_r + tr[ 0] * alpha_i; \ - CO[ 2] A_OP tr[ 1] * alpha_r - ti[ 1] * alpha_i; \ - CO[ 3] A_OP ti[ 1] * alpha_r + tr[ 1] * alpha_i; \ - CO[2*ldc+ 0] A_OP tr[ 2] * alpha_r - ti[ 2] * alpha_i; \ - CO[2*ldc+ 1] A_OP ti[ 2] * alpha_r + tr[ 2] * alpha_i; \ - CO[2*ldc+ 2] A_OP tr[ 3] * alpha_r - ti[ 3] * alpha_i; \ - CO[2*ldc+ 3] A_OP ti[ 3] * alpha_r + tr[ 3] * alpha_i; \ - CO[4*ldc+ 0] A_OP tr[ 4] * alpha_r - ti[ 4] * alpha_i; \ - CO[4*ldc+ 1] A_OP ti[ 4] * alpha_r + tr[ 4] * alpha_i; \ - CO[4*ldc+ 2] A_OP tr[ 5] * alpha_r - ti[ 5] * alpha_i; \ - CO[4*ldc+ 3] A_OP ti[ 5] * alpha_r + tr[ 5] * alpha_i; \ - CO[6*ldc+ 0] A_OP tr[ 6] * alpha_r - ti[ 6] * alpha_i; \ - CO[6*ldc+ 1] A_OP ti[ 6] * alpha_r + tr[ 6] * alpha_i; \ - CO[6*ldc+ 2] A_OP tr[ 7] * alpha_r - ti[ 7] * alpha_i; \ - CO[6*ldc+ 3] A_OP ti[ 7] * alpha_r + tr[ 7] * alpha_i; \ - CO[ 4] A_OP tr[ 8] * alpha_r - ti[ 8] * alpha_i; \ - CO[ 5] A_OP ti[ 8] * alpha_r + tr[ 8] * alpha_i; \ - CO[ 6] A_OP tr[ 9] * alpha_r - ti[ 9] * alpha_i; \ - CO[ 7] A_OP ti[ 9] * alpha_r + tr[ 9] * alpha_i; \ - CO[2*ldc+ 4] A_OP tr[10] * alpha_r - ti[10] * alpha_i; \ - CO[2*ldc+ 5] A_OP ti[10] * alpha_r + tr[10] * alpha_i; \ - CO[2*ldc+ 6] A_OP tr[11] * alpha_r - ti[11] * alpha_i; \ - CO[2*ldc+ 7] A_OP ti[11] * alpha_r + tr[11] * alpha_i; \ - CO[4*ldc+ 4] A_OP tr[12] * alpha_r - ti[12] * alpha_i; \ - CO[4*ldc+ 5] A_OP ti[12] * alpha_r + tr[12] * alpha_i; \ - CO[4*ldc+ 6] A_OP tr[13] * alpha_r - ti[13] * alpha_i; \ - CO[4*ldc+ 7] A_OP ti[13] * alpha_r + tr[13] * alpha_i; \ - CO[6*ldc+ 4] A_OP tr[14] * alpha_r - ti[14] * alpha_i; \ - CO[6*ldc+ 5] A_OP ti[14] * alpha_r + tr[14] * alpha_i; \ - CO[6*ldc+ 6] A_OP tr[15] * alpha_r - ti[15] * alpha_i; \ - CO[6*ldc+ 7] A_OP ti[15] * alpha_r + tr[15] * alpha_i; \ - CO[ 8] A_OP tr[16] * alpha_r - ti[16] * alpha_i; \ - CO[ 9] A_OP ti[16] * alpha_r + tr[16] * alpha_i; \ - CO[ 10] A_OP tr[17] * alpha_r - ti[17] * alpha_i; \ - CO[ 11] A_OP ti[17] * alpha_r + tr[17] * alpha_i; \ - CO[2*ldc+ 8] A_OP tr[18] * alpha_r - ti[18] * alpha_i; \ - CO[2*ldc+ 9] A_OP ti[18] * alpha_r + tr[18] * alpha_i; \ - CO[2*ldc+10] A_OP tr[19] * alpha_r - ti[19] * alpha_i; \ - CO[2*ldc+11] A_OP ti[19] * alpha_r + tr[19] * alpha_i; \ - CO[4*ldc+ 8] A_OP tr[20] * alpha_r - ti[20] * alpha_i; \ - CO[4*ldc+ 9] A_OP ti[20] * alpha_r + tr[20] * alpha_i; \ - CO[4*ldc+10] A_OP tr[21] * alpha_r - ti[21] * alpha_i; \ - CO[4*ldc+11] A_OP ti[21] * alpha_r + tr[21] * alpha_i; \ - CO[6*ldc+ 8] A_OP tr[22] * alpha_r - ti[22] * alpha_i; \ - CO[6*ldc+ 9] A_OP ti[22] * alpha_r + tr[22] * alpha_i; \ - CO[6*ldc+10] A_OP tr[23] * alpha_r - ti[23] * alpha_i; \ - CO[6*ldc+11] A_OP ti[23] * alpha_r + tr[23] * alpha_i; \ - CO[ 12] A_OP tr[24] * alpha_r - ti[24] * alpha_i; \ - CO[ 13] A_OP ti[24] * alpha_r + tr[24] * alpha_i; \ - CO[ 14] A_OP tr[25] * alpha_r - ti[25] * alpha_i; \ - CO[ 15] A_OP ti[25] * alpha_r + tr[25] * alpha_i; \ - CO[2*ldc+12] A_OP tr[26] * alpha_r - ti[26] * alpha_i; \ - CO[2*ldc+13] A_OP ti[26] * alpha_r + tr[26] * alpha_i; \ - CO[2*ldc+14] A_OP tr[27] * alpha_r - ti[27] * alpha_i; \ - CO[2*ldc+15] A_OP ti[27] * alpha_r + tr[27] * alpha_i; \ - CO[4*ldc+12] A_OP tr[28] * alpha_r - ti[28] * alpha_i; \ - CO[4*ldc+13] A_OP ti[28] * alpha_r + tr[28] * alpha_i; \ - CO[4*ldc+14] A_OP tr[29] * alpha_r - ti[29] * alpha_i; \ - CO[4*ldc+15] A_OP ti[29] * alpha_r + tr[29] * alpha_i; \ - CO[6*ldc+12] A_OP tr[30] * alpha_r - ti[30] * alpha_i; \ - CO[6*ldc+13] A_OP ti[30] * alpha_r + tr[30] * alpha_i; \ - CO[6*ldc+14] A_OP tr[31] * alpha_r - ti[31] * alpha_i; \ - CO[6*ldc+15] A_OP ti[31] * alpha_r + tr[31] * alpha_i; + CO[ 0] A_OP tr[ 0] * alpha_r - ti[ 0] * alpha_i; \ + CO[ 1] A_OP ti[ 0] * alpha_r + tr[ 0] * alpha_i; \ + CO[ 2] A_OP tr[ 1] * alpha_r - ti[ 1] * alpha_i; \ + CO[ 3] A_OP ti[ 1] * alpha_r + tr[ 1] * alpha_i; \ + CO[2*ldc+ 0] A_OP tr[ 2] * alpha_r - ti[ 2] * alpha_i; \ + CO[2*ldc+ 1] A_OP ti[ 2] * alpha_r + tr[ 2] * alpha_i; \ + CO[2*ldc+ 2] A_OP tr[ 3] * alpha_r - ti[ 3] * alpha_i; \ + CO[2*ldc+ 3] A_OP ti[ 3] * alpha_r + tr[ 3] * alpha_i; \ + CO[4*ldc+ 0] A_OP tr[ 4] * alpha_r - ti[ 4] * alpha_i; \ + CO[4*ldc+ 1] A_OP ti[ 4] * alpha_r + tr[ 4] * alpha_i; \ + CO[4*ldc+ 2] A_OP tr[ 5] * alpha_r - ti[ 5] * alpha_i; \ + CO[4*ldc+ 3] A_OP ti[ 5] * alpha_r + tr[ 5] * alpha_i; \ + CO[6*ldc+ 0] A_OP tr[ 6] * alpha_r - ti[ 6] * alpha_i; \ + CO[6*ldc+ 1] A_OP ti[ 6] * alpha_r + tr[ 6] * alpha_i; \ + CO[6*ldc+ 2] A_OP tr[ 7] * alpha_r - ti[ 7] * alpha_i; \ + CO[6*ldc+ 3] A_OP ti[ 7] * alpha_r + tr[ 7] * alpha_i; \ + CO[ 4] A_OP tr[ 8] * alpha_r - ti[ 8] * alpha_i; \ + CO[ 5] A_OP ti[ 8] * alpha_r + tr[ 8] * alpha_i; \ + CO[ 6] A_OP tr[ 9] * alpha_r - ti[ 9] * alpha_i; \ + CO[ 7] A_OP ti[ 9] * alpha_r + tr[ 9] * alpha_i; \ + CO[2*ldc+ 4] A_OP tr[10] * alpha_r - ti[10] * alpha_i; \ + CO[2*ldc+ 5] A_OP ti[10] * alpha_r + tr[10] * alpha_i; \ + CO[2*ldc+ 6] A_OP tr[11] * alpha_r - ti[11] * alpha_i; \ + CO[2*ldc+ 7] A_OP ti[11] * alpha_r + tr[11] * alpha_i; \ + CO[4*ldc+ 4] A_OP tr[12] * alpha_r - ti[12] * alpha_i; \ + CO[4*ldc+ 5] A_OP ti[12] * alpha_r + tr[12] * alpha_i; \ + CO[4*ldc+ 6] A_OP tr[13] * alpha_r - ti[13] * alpha_i; \ + CO[4*ldc+ 7] A_OP ti[13] * alpha_r + tr[13] * alpha_i; \ + CO[6*ldc+ 4] A_OP tr[14] * alpha_r - ti[14] * alpha_i; \ + CO[6*ldc+ 5] A_OP ti[14] * alpha_r + tr[14] * alpha_i; \ + CO[6*ldc+ 6] A_OP tr[15] * alpha_r - ti[15] * alpha_i; \ + CO[6*ldc+ 7] A_OP ti[15] * alpha_r + tr[15] * alpha_i; \ + CO[ 8] A_OP tr[16] * alpha_r - ti[16] * alpha_i; \ + CO[ 9] A_OP ti[16] * alpha_r + tr[16] * alpha_i; \ + CO[ 10] A_OP tr[17] * alpha_r - ti[17] * alpha_i; \ + CO[ 11] A_OP ti[17] * alpha_r + tr[17] * alpha_i; \ + CO[2*ldc+ 8] A_OP tr[18] * alpha_r - ti[18] * alpha_i; \ + CO[2*ldc+ 9] A_OP ti[18] * alpha_r + tr[18] * alpha_i; \ + CO[2*ldc+10] A_OP tr[19] * alpha_r - ti[19] * alpha_i; \ + CO[2*ldc+11] A_OP ti[19] * alpha_r + tr[19] * alpha_i; \ + CO[4*ldc+ 8] A_OP tr[20] * alpha_r - ti[20] * alpha_i; \ + CO[4*ldc+ 9] A_OP ti[20] * alpha_r + tr[20] * alpha_i; \ + CO[4*ldc+10] A_OP tr[21] * alpha_r - ti[21] * alpha_i; \ + CO[4*ldc+11] A_OP ti[21] * alpha_r + tr[21] * alpha_i; \ + CO[6*ldc+ 8] A_OP tr[22] * alpha_r - ti[22] * alpha_i; \ + CO[6*ldc+ 9] A_OP ti[22] * alpha_r + tr[22] * alpha_i; \ + CO[6*ldc+10] A_OP tr[23] * alpha_r - ti[23] * alpha_i; \ + CO[6*ldc+11] A_OP ti[23] * alpha_r + tr[23] * alpha_i; \ + CO[ 12] A_OP tr[24] * alpha_r - ti[24] * alpha_i; \ + CO[ 13] A_OP ti[24] * alpha_r + tr[24] * alpha_i; \ + CO[ 14] A_OP tr[25] * alpha_r - ti[25] * alpha_i; \ + CO[ 15] A_OP ti[25] * alpha_r + tr[25] * alpha_i; \ + CO[2*ldc+12] A_OP tr[26] * alpha_r - ti[26] * alpha_i; \ + CO[2*ldc+13] A_OP ti[26] * alpha_r + tr[26] * alpha_i; \ + CO[2*ldc+14] A_OP tr[27] * alpha_r - ti[27] * alpha_i; \ + CO[2*ldc+15] A_OP ti[27] * alpha_r + tr[27] * alpha_i; \ + CO[4*ldc+12] A_OP tr[28] * alpha_r - ti[28] * alpha_i; \ + CO[4*ldc+13] A_OP ti[28] * alpha_r + tr[28] * alpha_i; \ + CO[4*ldc+14] A_OP tr[29] * alpha_r - ti[29] * alpha_i; \ + CO[4*ldc+15] A_OP ti[29] * alpha_r + tr[29] * alpha_i; \ + CO[6*ldc+12] A_OP tr[30] * alpha_r - ti[30] * alpha_i; \ + CO[6*ldc+13] A_OP ti[30] * alpha_r + tr[30] * alpha_i; \ + CO[6*ldc+14] A_OP tr[31] * alpha_r - ti[31] * alpha_i; \ + CO[6*ldc+15] A_OP ti[31] * alpha_r + tr[31] * alpha_i; -#define SAVE_ACC_COMPLEX_24(ACC1, ACC2, CI) \ - __builtin_mma_disassemble_acc ((void *)result, ACC1); \ - __builtin_mma_disassemble_acc ((void *)(&result[4]), ACC2); \ - COMP_MUL(tr[0], res[0], res[5], ti[0], res[1], res[4]) \ - COMP_MUL(tr[1], res[8], res[13], ti[1], res[9], res[12]) \ - COMP_MUL(tr[2], res[2], res[7], ti[2], res[3], res[6]) \ - COMP_MUL(tr[3], res[10], res[15], ti[3], res[11], res[14]) \ - COMP_MUL(tr[4], res[16], res[21], ti[4], res[17], res[20]) \ - COMP_MUL(tr[5], res[24], res[29], ti[5], res[25], res[28]) \ - COMP_MUL(tr[6], res[18], res[23], ti[6], res[19], res[22]) \ - COMP_MUL(tr[7], res[26], res[31], ti[7], res[27], res[30]) \ - CO[CI+0] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ - CO[CI+1] A_OP ti[0] * alpha_r + tr[0] * alpha_i; \ - CO[CI+2] A_OP tr[1] * alpha_r - ti[1] * alpha_i; \ - CO[CI+3] A_OP ti[1] * alpha_r + tr[1] * alpha_i; \ - CO[CI+2*ldc+0] A_OP tr[2] * alpha_r - ti[2] * alpha_i; \ - CO[CI+2*ldc+1] A_OP ti[2] * alpha_r + tr[2] * alpha_i; \ - CO[CI+2*ldc+2] A_OP tr[3] * alpha_r - ti[3] * alpha_i; \ - CO[CI+2*ldc+3] A_OP ti[3] * alpha_r + tr[3] * alpha_i; \ - CO[CI+4*ldc+0] A_OP tr[4] * alpha_r - ti[4] * alpha_i; \ - CO[CI+4*ldc+1] A_OP ti[4] * alpha_r + tr[4] * alpha_i; \ - CO[CI+4*ldc+2] A_OP tr[5] * alpha_r - ti[5] * alpha_i; \ - CO[CI+4*ldc+3] A_OP ti[5] * alpha_r + tr[5] * alpha_i; \ - CO[CI+6*ldc+0] A_OP tr[6] * alpha_r - ti[6] * alpha_i; \ - CO[CI+6*ldc+1] A_OP ti[6] * alpha_r + tr[6] * alpha_i; \ - CO[CI+6*ldc+2] A_OP tr[7] * alpha_r - ti[7] * alpha_i; \ - CO[CI+6*ldc+3] A_OP ti[7] * alpha_r + tr[7] * alpha_i; +#define SAVE_ACC_COMPLEX_24(ACC1, ACC2, CI) \ + __builtin_mma_disassemble_acc ((void *)result, ACC1); \ + __builtin_mma_disassemble_acc ((void *)(&result[4]), ACC2); \ + COMP_MUL(tr[0], res[0], res[5], ti[0], res[1], res[4]) \ + COMP_MUL(tr[1], res[8], res[13], ti[1], res[9], res[12]) \ + COMP_MUL(tr[2], res[2], res[7], ti[2], res[3], res[6]) \ + COMP_MUL(tr[3], res[10], res[15], ti[3], res[11], res[14]) \ + COMP_MUL(tr[4], res[16], res[21], ti[4], res[17], res[20]) \ + COMP_MUL(tr[5], res[24], res[29], ti[5], res[25], res[28]) \ + COMP_MUL(tr[6], res[18], res[23], ti[6], res[19], res[22]) \ + COMP_MUL(tr[7], res[26], res[31], ti[7], res[27], res[30]) \ + CO[CI+0] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ + CO[CI+1] A_OP ti[0] * alpha_r + tr[0] * alpha_i; \ + CO[CI+2] A_OP tr[1] * alpha_r - ti[1] * alpha_i; \ + CO[CI+3] A_OP ti[1] * alpha_r + tr[1] * alpha_i; \ + CO[CI+2*ldc+0] A_OP tr[2] * alpha_r - ti[2] * alpha_i; \ + CO[CI+2*ldc+1] A_OP ti[2] * alpha_r + tr[2] * alpha_i; \ + CO[CI+2*ldc+2] A_OP tr[3] * alpha_r - ti[3] * alpha_i; \ + CO[CI+2*ldc+3] A_OP ti[3] * alpha_r + tr[3] * alpha_i; \ + CO[CI+4*ldc+0] A_OP tr[4] * alpha_r - ti[4] * alpha_i; \ + CO[CI+4*ldc+1] A_OP ti[4] * alpha_r + tr[4] * alpha_i; \ + CO[CI+4*ldc+2] A_OP tr[5] * alpha_r - ti[5] * alpha_i; \ + CO[CI+4*ldc+3] A_OP ti[5] * alpha_r + tr[5] * alpha_i; \ + CO[CI+6*ldc+0] A_OP tr[6] * alpha_r - ti[6] * alpha_i; \ + CO[CI+6*ldc+1] A_OP ti[6] * alpha_r + tr[6] * alpha_i; \ + CO[CI+6*ldc+2] A_OP tr[7] * alpha_r - ti[7] * alpha_i; \ + CO[CI+6*ldc+3] A_OP ti[7] * alpha_r + tr[7] * alpha_i; -#define SAVE_ACC_COMPLEX_14 \ - BUILTIN_MMA_DISASSEMBLE_ACC_8 \ - COMP_MUL(tr[0], res[ 0], res[ 5], ti[0], res[ 1], res[ 4]) \ - COMP_MUL(tr[1], res[ 2], res[ 7], ti[1], res[ 3], res[ 6]) \ - COMP_MUL(tr[2], res[ 16], res[ 21], ti[2], res[ 17], res[ 20]) \ - COMP_MUL(tr[3], res[ 18], res[ 23], ti[3], res[ 19], res[ 22]) \ - COMP_MAC(tr[0], res[ 32], res[ 37], ti[0], res[ 33], res[ 36]) \ - COMP_MAC(tr[1], res[ 34], res[ 39], ti[1], res[ 35], res[ 38]) \ - COMP_MAC(tr[2], res[ 48], res[ 53], ti[2], res[ 49], res[ 52]) \ - COMP_MAC(tr[3], res[ 50], res[ 55], ti[3], res[ 51], res[ 54]) \ - COMP_MAC(tr[0], res[ 64], res[ 69], ti[0], res[ 65], res[ 68]) \ - COMP_MAC(tr[1], res[ 66], res[ 71], ti[1], res[ 67], res[ 70]) \ - COMP_MAC(tr[2], res[ 80], res[ 85], ti[2], res[ 81], res[ 84]) \ - COMP_MAC(tr[3], res[ 82], res[ 87], ti[3], res[ 83], res[ 86]) \ - COMP_MAC(tr[0], res[ 96], res[101], ti[0], res[ 97], res[100]) \ - COMP_MAC(tr[1], res[ 98], res[103], ti[1], res[ 99], res[102]) \ - COMP_MAC(tr[2], res[112], res[117], ti[2], res[113], res[116]) \ - COMP_MAC(tr[3], res[114], res[119], ti[3], res[115], res[118]) \ - CO[0] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ - CO[1] A_OP ti[0] * alpha_r + tr[0] * alpha_i; \ - CO[2*ldc+0] A_OP tr[1] * alpha_r - ti[1] * alpha_i; \ - CO[2*ldc+1] A_OP ti[1] * alpha_r + tr[1] * alpha_i; \ - CO[4*ldc+0] A_OP tr[2] * alpha_r - ti[2] * alpha_i; \ - CO[4*ldc+1] A_OP ti[2] * alpha_r + tr[2] * alpha_i; \ - CO[6*ldc+0] A_OP tr[3] * alpha_r - ti[3] * alpha_i; \ - CO[6*ldc+1] A_OP ti[3] * alpha_r + tr[3] * alpha_i; +#define SAVE_ACC_COMPLEX_14 \ + BUILTIN_MMA_DISASSEMBLE_ACC_8 \ + COMP_MUL(tr[0], res[ 0], res[ 5], ti[0], res[ 1], res[ 4]) \ + COMP_MUL(tr[1], res[ 2], res[ 7], ti[1], res[ 3], res[ 6]) \ + COMP_MUL(tr[2], res[ 16], res[ 21], ti[2], res[ 17], res[ 20]) \ + COMP_MUL(tr[3], res[ 18], res[ 23], ti[3], res[ 19], res[ 22]) \ + COMP_MAC(tr[0], res[ 32], res[ 37], ti[0], res[ 33], res[ 36]) \ + COMP_MAC(tr[1], res[ 34], res[ 39], ti[1], res[ 35], res[ 38]) \ + COMP_MAC(tr[2], res[ 48], res[ 53], ti[2], res[ 49], res[ 52]) \ + COMP_MAC(tr[3], res[ 50], res[ 55], ti[3], res[ 51], res[ 54]) \ + COMP_MAC(tr[0], res[ 64], res[ 69], ti[0], res[ 65], res[ 68]) \ + COMP_MAC(tr[1], res[ 66], res[ 71], ti[1], res[ 67], res[ 70]) \ + COMP_MAC(tr[2], res[ 80], res[ 85], ti[2], res[ 81], res[ 84]) \ + COMP_MAC(tr[3], res[ 82], res[ 87], ti[3], res[ 83], res[ 86]) \ + COMP_MAC(tr[0], res[ 96], res[101], ti[0], res[ 97], res[100]) \ + COMP_MAC(tr[1], res[ 98], res[103], ti[1], res[ 99], res[102]) \ + COMP_MAC(tr[2], res[112], res[117], ti[2], res[113], res[116]) \ + COMP_MAC(tr[3], res[114], res[119], ti[3], res[115], res[118]) \ + CO[0] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ + CO[1] A_OP ti[0] * alpha_r + tr[0] * alpha_i; \ + CO[2*ldc+0] A_OP tr[1] * alpha_r - ti[1] * alpha_i; \ + CO[2*ldc+1] A_OP ti[1] * alpha_r + tr[1] * alpha_i; \ + CO[4*ldc+0] A_OP tr[2] * alpha_r - ti[2] * alpha_i; \ + CO[4*ldc+1] A_OP ti[2] * alpha_r + tr[2] * alpha_i; \ + CO[6*ldc+0] A_OP tr[3] * alpha_r - ti[3] * alpha_i; \ + CO[6*ldc+1] A_OP ti[3] * alpha_r + tr[3] * alpha_i; #define PREFETCH1(x, y) asm volatile ("dcbt %0, %1" : : "r" (x), "b" (y) : "memory"); #if (defined(LEFT) && !defined(TRANSA)) || (!defined(LEFT) && defined(TRANSA)) #define REFRESH_TEMP_BK(x, y) \ - temp = k - off; + temp = k - off; #elif defined(LEFT) #define REFRESH_TEMP_BK(x, y) \ - temp = off + x; + temp = off + x; #else #define REFRESH_TEMP_BK(x, y) \ - temp = off + y; + temp = off + y; #endif #if (defined(LEFT) && defined(TRANSA)) || (!defined(LEFT) && !defined(TRANSA)) #define REFRESH_POINTERS(x, y) \ - BO = B; \ - REFRESH_TEMP_BK(x, y) + BO = B; \ + REFRESH_TEMP_BK(x, y) #else #define REFRESH_POINTERS(x, y) \ - AO += off * (2*x); \ - BO = B + off * (2*y); \ - REFRESH_TEMP_BK(x, y) + AO += off * (2*x); \ + BO = B + off * (2*y); \ + REFRESH_TEMP_BK(x, y) #endif #ifdef LEFT #define REFRESH_OFF(x) \ - off += x; + off += x; #else #define REFRESH_OFF(x) #endif #ifdef LEFT #define UPDATE_TEMP(x, y) \ - temp -= x; + temp -= x; #else #define UPDATE_TEMP(x, y) \ - temp -= y; + temp -= y; #endif #if (defined(LEFT) && defined(TRANSA)) || (!defined(LEFT) && !defined(TRANSA)) #define REFRESH_TMP_AFTER_SAVE(x, y) \ - temp = k - off; \ - UPDATE_TEMP(x, y) \ - AO += temp * (2*x); \ - BO += temp * (2*y); + temp = k - off; \ + UPDATE_TEMP(x, y) \ + AO += temp * (2*x); \ + BO += temp * (2*y); #else #define REFRESH_TMP_AFTER_SAVE(x, y) #endif -#define REFRESH_AFTER_SAVE(x,y) \ - REFRESH_TMP_AFTER_SAVE(x, y) \ - REFRESH_OFF(x) +#define REFRESH_AFTER_SAVE(x,y) \ + REFRESH_TMP_AFTER_SAVE(x, y) \ + REFRESH_OFF(x) /************************************************************************************* * GEMM Kernel *************************************************************************************/ int -CNAME (BLASLONG m, BLASLONG n, BLASLONG k, FLOAT alpha_r, FLOAT alpha_i, FLOAT * A, FLOAT * B, - FLOAT * C, BLASLONG ldc #ifdef TRMMKERNEL - , BLASLONG offset +CNAME (BLASLONG m, BLASLONG n, BLASLONG k, FLOAT alpha_r, FLOAT alpha_i, + FLOAT * A, FLOAT * B, FLOAT * C, BLASLONG ldc, BLASLONG offset) +#else +CNAME (BLASLONG m, BLASLONG n, BLASLONG k, FLOAT alpha_r, FLOAT alpha_i, + FLOAT * A, FLOAT * B, FLOAT * C, BLASLONG ldc) #endif - ) { - BLASLONG i1, i, l, temp; - FLOAT *AO, *BO, *CO; + BLASLONG i1, i, l, temp; + FLOAT *AO, *BO, *CO; #if defined(TRMMKERNEL) - BLASLONG off; + BLASLONG off; #endif #if defined(TRMMKERNEL) && !defined(LEFT) - off = -offset; + off = -offset; #endif - __vector_quad acc0, acc1, acc2, acc3, acc4, acc5, acc6, acc7; + __vector_quad acc0, acc1, acc2, acc3, acc4, acc5, acc6, acc7; - v4sf_t result[32]; - FLOAT *res, tr[64], ti[64]; - res = (FLOAT *) result; + v4sf_t result[32]; + FLOAT *res, tr[64], ti[64]; + res = (FLOAT *) result; - for (i1 = 0; i1 < (n >> 2); i1++) - { + for (i1 = 0; i1 < (n >> 2); i1++) { #if defined(TRMMKERNEL) && defined(LEFT) off = offset; #endif @@ -538,193 +538,181 @@ CNAME (BLASLONG m, BLASLONG n, BLASLONG k, FLOAT alpha_r, FLOAT alpha_i, FLOAT * CO = C; C += ldc << 3; - for (i = 0; i < (m >> 3); i++) - { + for (i = 0; i < (m >> 3); i++) { #if defined(TRMMKERNEL) - REFRESH_POINTERS (8, 4); + REFRESH_POINTERS (8, 4); #else - BO = B; - temp = k; + BO = B; + temp = k; #endif - SET_ACC_ZERO() - for (l = 0; l < temp; ++l) - { - vec_t rowA1 = *(vec_t *) & AO[l<<4]; - vec_t rowB1 = *(vec_t *) & BO[l<<3]; - vec_t rowA2 = *(vec_t *) & AO[(l<<4)+4]; - vec_t rowB2 = *(vec_t *) & BO[(l<<3)+4]; - vec_t rowA3 = *(vec_t *) & AO[(l<<4)+8]; - vec_t rowA4 = *(vec_t *) & AO[(l<<4)+12]; - __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); - __builtin_mma_xvf32gerpp(&acc1, rowA2, rowB1); - __builtin_mma_xvf32gerpp(&acc2, rowA3, rowB1); - __builtin_mma_xvf32gerpp(&acc3, rowA4, rowB1); - __builtin_mma_xvf32gerpp(&acc4, rowA1, rowB2); - __builtin_mma_xvf32gerpp(&acc5, rowA2, rowB2); - __builtin_mma_xvf32gerpp(&acc6, rowA3, rowB2); - __builtin_mma_xvf32gerpp(&acc7, rowA4, rowB2); - } + SET_ACC_ZERO() + for (l = 0; l < temp; ++l) { + vec_t rowA1 = *(vec_t *) & AO[l<<4]; + vec_t rowB1 = *(vec_t *) & BO[l<<3]; + vec_t rowA2 = *(vec_t *) & AO[(l<<4)+4]; + vec_t rowB2 = *(vec_t *) & BO[(l<<3)+4]; + vec_t rowA3 = *(vec_t *) & AO[(l<<4)+8]; + vec_t rowA4 = *(vec_t *) & AO[(l<<4)+12]; + __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); + __builtin_mma_xvf32gerpp(&acc1, rowA2, rowB1); + __builtin_mma_xvf32gerpp(&acc2, rowA3, rowB1); + __builtin_mma_xvf32gerpp(&acc3, rowA4, rowB1); + __builtin_mma_xvf32gerpp(&acc4, rowA1, rowB2); + __builtin_mma_xvf32gerpp(&acc5, rowA2, rowB2); + __builtin_mma_xvf32gerpp(&acc6, rowA3, rowB2); + __builtin_mma_xvf32gerpp(&acc7, rowA4, rowB2); + } SAVE_ACC_COMPLEX_24_ALL - CO += 16; - AO += temp << 4; - BO += temp << 3; + CO += 16; + AO += temp << 4; + BO += temp << 3; #if defined(TRMMKERNEL) - REFRESH_AFTER_SAVE (8, 4) + REFRESH_AFTER_SAVE (8, 4) #endif - } - if (m & 4) - { + } + if (m & 4) { #if defined(TRMMKERNEL) - REFRESH_POINTERS (4, 4); + REFRESH_POINTERS (4, 4); #else - BO = B; - temp = k; + BO = B; + temp = k; #endif - SET_ACC_ZERO() - for (l = 0; l < (temp & (~1)); l+=2) - { - vec_t rowA1 = *(vec_t *) & AO[l<<3]; - vec_t rowA2 = *(vec_t *) & AO[(l<<3)+4]; - vec_t rowA3 = *(vec_t *) & AO[(l<<3)+8]; - vec_t rowA4 = *(vec_t *) & AO[(l<<3)+12]; - vec_t rowB1 = *(vec_t *) & BO[l<<3]; - vec_t rowB2 = *(vec_t *) & BO[(l<<3)+4]; - vec_t rowB3 = *(vec_t *) & BO[(l<<3)+8]; - vec_t rowB4 = *(vec_t *) & BO[(l<<3)+12]; - __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); - __builtin_mma_xvf32gerpp(&acc1, rowA2, rowB1); - __builtin_mma_xvf32gerpp(&acc2, rowA1, rowB2); - __builtin_mma_xvf32gerpp(&acc3, rowA2, rowB2); - __builtin_mma_xvf32gerpp(&acc0, rowA3, rowB3); - __builtin_mma_xvf32gerpp(&acc1, rowA4, rowB3); - __builtin_mma_xvf32gerpp(&acc2, rowA3, rowB4); - __builtin_mma_xvf32gerpp(&acc3, rowA4, rowB4); - } - for (l = (temp & (~1)); l < temp; ++l) - { - vec_t rowA1 = *(vec_t *) & AO[l<<3]; - vec_t rowA2 = *(vec_t *) & AO[(l<<3)+4]; - vec_t rowB1 = *(vec_t *) & BO[l<<3]; - vec_t rowB2 = *(vec_t *) & BO[(l<<3)+4]; - __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); - __builtin_mma_xvf32gerpp(&acc1, rowA2, rowB1); - __builtin_mma_xvf32gerpp(&acc2, rowA1, rowB2); - __builtin_mma_xvf32gerpp(&acc3, rowA2, rowB2); - } - SAVE_ACC_COMPLEX_24(&acc0, &acc2, 0) - SAVE_ACC_COMPLEX_24(&acc1, &acc3, 4) - CO += 8; - AO += temp << 3; - BO += temp << 3; + SET_ACC_ZERO() + for (l = 0; l < (temp & (~1)); l+=2) { + vec_t rowA1 = *(vec_t *) & AO[l<<3]; + vec_t rowA2 = *(vec_t *) & AO[(l<<3)+4]; + vec_t rowA3 = *(vec_t *) & AO[(l<<3)+8]; + vec_t rowA4 = *(vec_t *) & AO[(l<<3)+12]; + vec_t rowB1 = *(vec_t *) & BO[l<<3]; + vec_t rowB2 = *(vec_t *) & BO[(l<<3)+4]; + vec_t rowB3 = *(vec_t *) & BO[(l<<3)+8]; + vec_t rowB4 = *(vec_t *) & BO[(l<<3)+12]; + __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); + __builtin_mma_xvf32gerpp(&acc1, rowA2, rowB1); + __builtin_mma_xvf32gerpp(&acc2, rowA1, rowB2); + __builtin_mma_xvf32gerpp(&acc3, rowA2, rowB2); + __builtin_mma_xvf32gerpp(&acc0, rowA3, rowB3); + __builtin_mma_xvf32gerpp(&acc1, rowA4, rowB3); + __builtin_mma_xvf32gerpp(&acc2, rowA3, rowB4); + __builtin_mma_xvf32gerpp(&acc3, rowA4, rowB4); + } + for (l = (temp & (~1)); l < temp; ++l) { + vec_t rowA1 = *(vec_t *) & AO[l<<3]; + vec_t rowA2 = *(vec_t *) & AO[(l<<3)+4]; + vec_t rowB1 = *(vec_t *) & BO[l<<3]; + vec_t rowB2 = *(vec_t *) & BO[(l<<3)+4]; + __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); + __builtin_mma_xvf32gerpp(&acc1, rowA2, rowB1); + __builtin_mma_xvf32gerpp(&acc2, rowA1, rowB2); + __builtin_mma_xvf32gerpp(&acc3, rowA2, rowB2); + } + SAVE_ACC_COMPLEX_24(&acc0, &acc2, 0) + SAVE_ACC_COMPLEX_24(&acc1, &acc3, 4) + CO += 8; + AO += temp << 3; + BO += temp << 3; #if defined(TRMMKERNEL) - REFRESH_AFTER_SAVE (4, 4) + REFRESH_AFTER_SAVE (4, 4) #endif - } - if (m & 2) - { + } + if (m & 2) { #if defined(TRMMKERNEL) - REFRESH_POINTERS (2, 4); + REFRESH_POINTERS (2, 4); #else - BO = B; - temp = k; + BO = B; + temp = k; #endif - SET_ACC_ZERO() - for (l = 0; l < (temp & (~3)); l+=4) - { - vec_t rowA1 = *(vec_t *) & AO[l<<2]; - vec_t rowA2 = *(vec_t *) & AO[(l<<2)+4]; - vec_t rowA3 = *(vec_t *) & AO[(l<<2)+8]; - vec_t rowA4 = *(vec_t *) & AO[(l<<2)+12]; - vec_t rowB1 = *(vec_t *) & BO[l<<3]; - vec_t rowB2 = *(vec_t *) & BO[(l<<3)+4]; - vec_t rowB3 = *(vec_t *) & BO[(l<<3)+8]; - vec_t rowB4 = *(vec_t *) & BO[(l<<3)+12]; - vec_t rowB5 = *(vec_t *) & BO[(l<<3)+16]; - vec_t rowB6 = *(vec_t *) & BO[(l<<3)+20]; - vec_t rowB7 = *(vec_t *) & BO[(l<<3)+24]; - vec_t rowB8 = *(vec_t *) & BO[(l<<3)+28]; - __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); - __builtin_mma_xvf32gerpp(&acc1, rowA1, rowB2); - __builtin_mma_xvf32gerpp(&acc0, rowA2, rowB3); - __builtin_mma_xvf32gerpp(&acc1, rowA2, rowB4); - __builtin_mma_xvf32gerpp(&acc0, rowA3, rowB5); - __builtin_mma_xvf32gerpp(&acc1, rowA3, rowB6); - __builtin_mma_xvf32gerpp(&acc0, rowA4, rowB7); - __builtin_mma_xvf32gerpp(&acc1, rowA4, rowB8); - } - for (l = (temp & (~3)); l < temp; ++l) - { - vec_t rowA1 = *(vec_t *) & AO[l<<2]; - vec_t rowB1 = *(vec_t *) & BO[l<<3]; - vec_t rowB2 = *(vec_t *) & BO[(l<<3)+4]; - __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); - __builtin_mma_xvf32gerpp(&acc1, rowA1, rowB2); - } - SAVE_ACC_COMPLEX_24(&acc0, &acc1, 0) - CO += 4; - AO += temp << 2; - BO += temp << 3; + SET_ACC_ZERO() + for (l = 0; l < (temp & (~3)); l+=4) { + vec_t rowA1 = *(vec_t *) & AO[l<<2]; + vec_t rowA2 = *(vec_t *) & AO[(l<<2)+4]; + vec_t rowA3 = *(vec_t *) & AO[(l<<2)+8]; + vec_t rowA4 = *(vec_t *) & AO[(l<<2)+12]; + vec_t rowB1 = *(vec_t *) & BO[l<<3]; + vec_t rowB2 = *(vec_t *) & BO[(l<<3)+4]; + vec_t rowB3 = *(vec_t *) & BO[(l<<3)+8]; + vec_t rowB4 = *(vec_t *) & BO[(l<<3)+12]; + vec_t rowB5 = *(vec_t *) & BO[(l<<3)+16]; + vec_t rowB6 = *(vec_t *) & BO[(l<<3)+20]; + vec_t rowB7 = *(vec_t *) & BO[(l<<3)+24]; + vec_t rowB8 = *(vec_t *) & BO[(l<<3)+28]; + __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); + __builtin_mma_xvf32gerpp(&acc1, rowA1, rowB2); + __builtin_mma_xvf32gerpp(&acc0, rowA2, rowB3); + __builtin_mma_xvf32gerpp(&acc1, rowA2, rowB4); + __builtin_mma_xvf32gerpp(&acc0, rowA3, rowB5); + __builtin_mma_xvf32gerpp(&acc1, rowA3, rowB6); + __builtin_mma_xvf32gerpp(&acc0, rowA4, rowB7); + __builtin_mma_xvf32gerpp(&acc1, rowA4, rowB8); + } + for (l = (temp & (~3)); l < temp; ++l) { + vec_t rowA1 = *(vec_t *) & AO[l<<2]; + vec_t rowB1 = *(vec_t *) & BO[l<<3]; + vec_t rowB2 = *(vec_t *) & BO[(l<<3)+4]; + __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); + __builtin_mma_xvf32gerpp(&acc1, rowA1, rowB2); + } + SAVE_ACC_COMPLEX_24(&acc0, &acc1, 0) + CO += 4; + AO += temp << 2; + BO += temp << 3; #if defined(TRMMKERNEL) - REFRESH_AFTER_SAVE (2, 4) + REFRESH_AFTER_SAVE (2, 4) #endif - } - if (m & 1) - { + } + if (m & 1) { #if defined(TRMMKERNEL) - REFRESH_POINTERS (1, 4) + REFRESH_POINTERS (1, 4) #else - BO = B; - temp = k; + BO = B; + temp = k; #endif - SET_ACC_ZERO() - for (l = 0; l < (temp & (~3)); l+=4) - { - vec_t rowA1 = *(vec_t *) & AO[l<<1]; - vec_t rowA2 = *(vec_t *) & AO[(l<<1)+2]; - vec_t rowA3 = *(vec_t *) & AO[(l<<1)+4]; - vec_t rowA4 = *(vec_t *) & AO[(l<<1)+6]; - vec_t rowB1 = *(vec_t *) & BO[l<<3]; - vec_t rowB2 = *(vec_t *) & BO[(l<<3)+4]; - vec_t rowB3 = *(vec_t *) & BO[(l<<3)+8]; - vec_t rowB4 = *(vec_t *) & BO[(l<<3)+12]; - vec_t rowB5 = *(vec_t *) & BO[(l<<3)+16]; - vec_t rowB6 = *(vec_t *) & BO[(l<<3)+20]; - vec_t rowB7 = *(vec_t *) & BO[(l<<3)+24]; - vec_t rowB8 = *(vec_t *) & BO[(l<<3)+28]; - __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); - __builtin_mma_xvf32gerpp(&acc1, rowA1, rowB2); - __builtin_mma_xvf32gerpp(&acc2, rowA2, rowB3); - __builtin_mma_xvf32gerpp(&acc3, rowA2, rowB4); - __builtin_mma_xvf32gerpp(&acc4, rowA3, rowB5); - __builtin_mma_xvf32gerpp(&acc5, rowA3, rowB6); - __builtin_mma_xvf32gerpp(&acc6, rowA4, rowB7); - __builtin_mma_xvf32gerpp(&acc7, rowA4, rowB8); - } - for (l = (temp & (~3)); l < temp; ++l) - { - vec_t rowA1 = *(vec_t *) & AO[l<<1]; - vec_t rowB1 = *(vec_t *) & BO[l<<3]; - vec_t rowB2 = *(vec_t *) & BO[(l<<3)+4]; - __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); - __builtin_mma_xvf32gerpp(&acc1, rowA1, rowB2); - } - SAVE_ACC_COMPLEX_14 - CO += 2; - AO += temp << 1; - BO += temp << 3; + SET_ACC_ZERO() + for (l = 0; l < (temp & (~3)); l+=4) { + vec_t rowA1 = *(vec_t *) & AO[l<<1]; + vec_t rowA2 = *(vec_t *) & AO[(l<<1)+2]; + vec_t rowA3 = *(vec_t *) & AO[(l<<1)+4]; + vec_t rowA4 = *(vec_t *) & AO[(l<<1)+6]; + vec_t rowB1 = *(vec_t *) & BO[l<<3]; + vec_t rowB2 = *(vec_t *) & BO[(l<<3)+4]; + vec_t rowB3 = *(vec_t *) & BO[(l<<3)+8]; + vec_t rowB4 = *(vec_t *) & BO[(l<<3)+12]; + vec_t rowB5 = *(vec_t *) & BO[(l<<3)+16]; + vec_t rowB6 = *(vec_t *) & BO[(l<<3)+20]; + vec_t rowB7 = *(vec_t *) & BO[(l<<3)+24]; + vec_t rowB8 = *(vec_t *) & BO[(l<<3)+28]; + __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); + __builtin_mma_xvf32gerpp(&acc1, rowA1, rowB2); + __builtin_mma_xvf32gerpp(&acc2, rowA2, rowB3); + __builtin_mma_xvf32gerpp(&acc3, rowA2, rowB4); + __builtin_mma_xvf32gerpp(&acc4, rowA3, rowB5); + __builtin_mma_xvf32gerpp(&acc5, rowA3, rowB6); + __builtin_mma_xvf32gerpp(&acc6, rowA4, rowB7); + __builtin_mma_xvf32gerpp(&acc7, rowA4, rowB8); + } + for (l = (temp & (~3)); l < temp; ++l) { + vec_t rowA1 = *(vec_t *) & AO[l<<1]; + vec_t rowB1 = *(vec_t *) & BO[l<<3]; + vec_t rowB2 = *(vec_t *) & BO[(l<<3)+4]; + __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); + __builtin_mma_xvf32gerpp(&acc1, rowA1, rowB2); + } + SAVE_ACC_COMPLEX_14 + CO += 2; + AO += temp << 1; + BO += temp << 3; #if defined(TRMMKERNEL) - REFRESH_AFTER_SAVE (1, 4) + REFRESH_AFTER_SAVE (1, 4) #endif - } + } #if defined(TRMMKERNEL) && !defined(LEFT) - off += 4; // number of values in A + off += 4; // number of values in A #endif B += k << 3; - } + } - if (n & 2) - { + if (n & 2) { #if defined(TRMMKERNEL) && defined(LEFT) off = offset; #endif @@ -732,212 +720,199 @@ CNAME (BLASLONG m, BLASLONG n, BLASLONG k, FLOAT alpha_r, FLOAT alpha_i, FLOAT * CO = C; C += ldc << 2; - for (i = 0; i < (m >> 3); i++) - { + for (i = 0; i < (m >> 3); i++) { #if defined(TRMMKERNEL) - REFRESH_POINTERS (8, 2) + REFRESH_POINTERS (8, 2) #else - BO = B; - temp = k; + BO = B; + temp = k; #endif - SET_ACC_ZERO() - for (l = 0; l < (temp & (~1)); l+=2) - { - vec_t rowA1 = *(vec_t *) & AO[l<<4]; - vec_t rowA2 = *(vec_t *) & AO[(l<<4)+4]; - vec_t rowA3 = *(vec_t *) & AO[(l<<4)+8]; - vec_t rowA4 = *(vec_t *) & AO[(l<<4)+12]; - vec_t rowA5 = *(vec_t *) & AO[(l<<4)+16]; - vec_t rowA6 = *(vec_t *) & AO[(l<<4)+20]; - vec_t rowA7 = *(vec_t *) & AO[(l<<4)+24]; - vec_t rowA8 = *(vec_t *) & AO[(l<<4)+28]; - vec_t rowB1 = *(vec_t *) & BO[l<<2]; - vec_t rowB2 = *(vec_t *) & BO[(l<<2)+4]; - __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); - __builtin_mma_xvf32gerpp(&acc1, rowA2, rowB1); - __builtin_mma_xvf32gerpp(&acc2, rowA3, rowB1); - __builtin_mma_xvf32gerpp(&acc3, rowA4, rowB1); - __builtin_mma_xvf32gerpp(&acc0, rowA5, rowB2); - __builtin_mma_xvf32gerpp(&acc1, rowA6, rowB2); - __builtin_mma_xvf32gerpp(&acc2, rowA7, rowB2); - __builtin_mma_xvf32gerpp(&acc3, rowA8, rowB2); - } - for (l = (temp & (~1)); l < temp; ++l) - { - vec_t rowA1 = *(vec_t *) & AO[l<<4]; - vec_t rowA2 = *(vec_t *) & AO[(l<<4)+4]; - vec_t rowA3 = *(vec_t *) & AO[(l<<4)+8]; - vec_t rowA4 = *(vec_t *) & AO[(l<<4)+12]; - vec_t rowB1 = *(vec_t *) & BO[l<<2]; - __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); - __builtin_mma_xvf32gerpp(&acc1, rowA2, rowB1); - __builtin_mma_xvf32gerpp(&acc2, rowA3, rowB1); - __builtin_mma_xvf32gerpp(&acc3, rowA4, rowB1); - } - SAVE_ACC_COMPLEX_22_4 - AO += temp << 4; - BO += temp << 2; - CO += 16; + SET_ACC_ZERO() + for (l = 0; l < (temp & (~1)); l+=2) { + vec_t rowA1 = *(vec_t *) & AO[l<<4]; + vec_t rowA2 = *(vec_t *) & AO[(l<<4)+4]; + vec_t rowA3 = *(vec_t *) & AO[(l<<4)+8]; + vec_t rowA4 = *(vec_t *) & AO[(l<<4)+12]; + vec_t rowA5 = *(vec_t *) & AO[(l<<4)+16]; + vec_t rowA6 = *(vec_t *) & AO[(l<<4)+20]; + vec_t rowA7 = *(vec_t *) & AO[(l<<4)+24]; + vec_t rowA8 = *(vec_t *) & AO[(l<<4)+28]; + vec_t rowB1 = *(vec_t *) & BO[l<<2]; + vec_t rowB2 = *(vec_t *) & BO[(l<<2)+4]; + __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); + __builtin_mma_xvf32gerpp(&acc1, rowA2, rowB1); + __builtin_mma_xvf32gerpp(&acc2, rowA3, rowB1); + __builtin_mma_xvf32gerpp(&acc3, rowA4, rowB1); + __builtin_mma_xvf32gerpp(&acc0, rowA5, rowB2); + __builtin_mma_xvf32gerpp(&acc1, rowA6, rowB2); + __builtin_mma_xvf32gerpp(&acc2, rowA7, rowB2); + __builtin_mma_xvf32gerpp(&acc3, rowA8, rowB2); + } + for (l = (temp & (~1)); l < temp; ++l) { + vec_t rowA1 = *(vec_t *) & AO[l<<4]; + vec_t rowA2 = *(vec_t *) & AO[(l<<4)+4]; + vec_t rowA3 = *(vec_t *) & AO[(l<<4)+8]; + vec_t rowA4 = *(vec_t *) & AO[(l<<4)+12]; + vec_t rowB1 = *(vec_t *) & BO[l<<2]; + __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); + __builtin_mma_xvf32gerpp(&acc1, rowA2, rowB1); + __builtin_mma_xvf32gerpp(&acc2, rowA3, rowB1); + __builtin_mma_xvf32gerpp(&acc3, rowA4, rowB1); + } + SAVE_ACC_COMPLEX_22_4 + AO += temp << 4; + BO += temp << 2; + CO += 16; #if defined(TRMMKERNEL) - REFRESH_AFTER_SAVE (8, 2) + REFRESH_AFTER_SAVE (8, 2) #endif - } - if (m & 4) - { + } + if (m & 4) { #if defined(TRMMKERNEL) - REFRESH_POINTERS (4, 2) + REFRESH_POINTERS (4, 2) #else - BO = B; - temp = k; + BO = B; + temp = k; #endif - SET_ACC_ZERO() - for (l = 0; l < (temp & (~3)); l+=4) - { - vec_t rowA1 = *(vec_t *) & AO[l<<3]; - vec_t rowA2 = *(vec_t *) & AO[(l<<3)+4]; - vec_t rowA3 = *(vec_t *) & AO[(l<<3)+8]; - vec_t rowA4 = *(vec_t *) & AO[(l<<3)+12]; - vec_t rowA5 = *(vec_t *) & AO[(l<<3)+16]; - vec_t rowA6 = *(vec_t *) & AO[(l<<3)+20]; - vec_t rowA7 = *(vec_t *) & AO[(l<<3)+24]; - vec_t rowA8 = *(vec_t *) & AO[(l<<3)+28]; - vec_t rowB1 = *(vec_t *) & BO[l<<2]; - vec_t rowB2 = *(vec_t *) & BO[(l<<2)+4]; - vec_t rowB3 = *(vec_t *) & BO[(l<<2)+8]; - vec_t rowB4 = *(vec_t *) & BO[(l<<2)+12]; - __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); - __builtin_mma_xvf32gerpp(&acc1, rowA2, rowB1); - __builtin_mma_xvf32gerpp(&acc0, rowA3, rowB2); - __builtin_mma_xvf32gerpp(&acc1, rowA4, rowB2); - __builtin_mma_xvf32gerpp(&acc0, rowA5, rowB3); - __builtin_mma_xvf32gerpp(&acc1, rowA6, rowB3); - __builtin_mma_xvf32gerpp(&acc0, rowA7, rowB4); - __builtin_mma_xvf32gerpp(&acc1, rowA8, rowB4); - } - for (l = (temp & (~3)); l < temp; ++l) - { - vec_t rowA1 = *(vec_t *) & AO[l<<3]; - vec_t rowA2 = *(vec_t *) & AO[(l<<3)+4]; - vec_t rowB1 = *(vec_t *) & BO[l<<2]; - __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); - __builtin_mma_xvf32gerpp(&acc1, rowA2, rowB1); - } - SAVE_ACC_COMPLEX_22_2 - AO += temp << 3; - BO += temp << 2; - CO += 8; + SET_ACC_ZERO() + for (l = 0; l < (temp & (~3)); l+=4) { + vec_t rowA1 = *(vec_t *) & AO[l<<3]; + vec_t rowA2 = *(vec_t *) & AO[(l<<3)+4]; + vec_t rowA3 = *(vec_t *) & AO[(l<<3)+8]; + vec_t rowA4 = *(vec_t *) & AO[(l<<3)+12]; + vec_t rowA5 = *(vec_t *) & AO[(l<<3)+16]; + vec_t rowA6 = *(vec_t *) & AO[(l<<3)+20]; + vec_t rowA7 = *(vec_t *) & AO[(l<<3)+24]; + vec_t rowA8 = *(vec_t *) & AO[(l<<3)+28]; + vec_t rowB1 = *(vec_t *) & BO[l<<2]; + vec_t rowB2 = *(vec_t *) & BO[(l<<2)+4]; + vec_t rowB3 = *(vec_t *) & BO[(l<<2)+8]; + vec_t rowB4 = *(vec_t *) & BO[(l<<2)+12]; + __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); + __builtin_mma_xvf32gerpp(&acc1, rowA2, rowB1); + __builtin_mma_xvf32gerpp(&acc0, rowA3, rowB2); + __builtin_mma_xvf32gerpp(&acc1, rowA4, rowB2); + __builtin_mma_xvf32gerpp(&acc0, rowA5, rowB3); + __builtin_mma_xvf32gerpp(&acc1, rowA6, rowB3); + __builtin_mma_xvf32gerpp(&acc0, rowA7, rowB4); + __builtin_mma_xvf32gerpp(&acc1, rowA8, rowB4); + } + for (l = (temp & (~3)); l < temp; ++l) { + vec_t rowA1 = *(vec_t *) & AO[l<<3]; + vec_t rowA2 = *(vec_t *) & AO[(l<<3)+4]; + vec_t rowB1 = *(vec_t *) & BO[l<<2]; + __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); + __builtin_mma_xvf32gerpp(&acc1, rowA2, rowB1); + } + SAVE_ACC_COMPLEX_22_2 + AO += temp << 3; + BO += temp << 2; + CO += 8; #if defined(TRMMKERNEL) - REFRESH_AFTER_SAVE (4, 2) + REFRESH_AFTER_SAVE (4, 2) #endif - } if (m & 2) - { + } + if (m & 2) { #if defined(TRMMKERNEL) - REFRESH_POINTERS (2, 2) + REFRESH_POINTERS (2, 2) #else - BO = B; - temp = k; + BO = B; + temp = k; #endif - SET_ACC_ZERO() - for (l = 0; l < (temp & (~7)); l+=8) - { - vec_t rowA1 = *(vec_t *) & AO[l<<2]; - vec_t rowA2 = *(vec_t *) & AO[(l<<2)+4]; - vec_t rowA3 = *(vec_t *) & AO[(l<<2)+8]; - vec_t rowA4 = *(vec_t *) & AO[(l<<2)+12]; - vec_t rowA5 = *(vec_t *) & AO[(l<<2)+16]; - vec_t rowA6 = *(vec_t *) & AO[(l<<2)+20]; - vec_t rowA7 = *(vec_t *) & AO[(l<<2)+24]; - vec_t rowA8 = *(vec_t *) & AO[(l<<2)+28]; - vec_t rowB1 = *(vec_t *) & BO[l<<2]; - vec_t rowB2 = *(vec_t *) & BO[(l<<2)+4]; - vec_t rowB3 = *(vec_t *) & BO[(l<<2)+8]; - vec_t rowB4 = *(vec_t *) & BO[(l<<2)+12]; - vec_t rowB5 = *(vec_t *) & BO[(l<<2)+16]; - vec_t rowB6 = *(vec_t *) & BO[(l<<2)+20]; - vec_t rowB7 = *(vec_t *) & BO[(l<<2)+24]; - vec_t rowB8 = *(vec_t *) & BO[(l<<2)+28]; - __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); - __builtin_mma_xvf32gerpp(&acc0, rowA2, rowB2); - __builtin_mma_xvf32gerpp(&acc0, rowA3, rowB3); - __builtin_mma_xvf32gerpp(&acc0, rowA4, rowB4); - __builtin_mma_xvf32gerpp(&acc0, rowA5, rowB5); - __builtin_mma_xvf32gerpp(&acc0, rowA6, rowB6); - __builtin_mma_xvf32gerpp(&acc0, rowA7, rowB7); - __builtin_mma_xvf32gerpp(&acc0, rowA8, rowB8); - } - for (l = (temp & (~7)); l < temp; ++l) - { - vec_t rowA1 = *(vec_t *) & AO[l<<2]; - vec_t rowB1 = *(vec_t *) & BO[l<<2]; - __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); - } - SAVE_ACC_COMPLEX_22_1 - AO += temp << 2; - BO += temp << 2; - CO += 4; + SET_ACC_ZERO() + for (l = 0; l < (temp & (~7)); l+=8) { + vec_t rowA1 = *(vec_t *) & AO[l<<2]; + vec_t rowA2 = *(vec_t *) & AO[(l<<2)+4]; + vec_t rowA3 = *(vec_t *) & AO[(l<<2)+8]; + vec_t rowA4 = *(vec_t *) & AO[(l<<2)+12]; + vec_t rowA5 = *(vec_t *) & AO[(l<<2)+16]; + vec_t rowA6 = *(vec_t *) & AO[(l<<2)+20]; + vec_t rowA7 = *(vec_t *) & AO[(l<<2)+24]; + vec_t rowA8 = *(vec_t *) & AO[(l<<2)+28]; + vec_t rowB1 = *(vec_t *) & BO[l<<2]; + vec_t rowB2 = *(vec_t *) & BO[(l<<2)+4]; + vec_t rowB3 = *(vec_t *) & BO[(l<<2)+8]; + vec_t rowB4 = *(vec_t *) & BO[(l<<2)+12]; + vec_t rowB5 = *(vec_t *) & BO[(l<<2)+16]; + vec_t rowB6 = *(vec_t *) & BO[(l<<2)+20]; + vec_t rowB7 = *(vec_t *) & BO[(l<<2)+24]; + vec_t rowB8 = *(vec_t *) & BO[(l<<2)+28]; + __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); + __builtin_mma_xvf32gerpp(&acc0, rowA2, rowB2); + __builtin_mma_xvf32gerpp(&acc0, rowA3, rowB3); + __builtin_mma_xvf32gerpp(&acc0, rowA4, rowB4); + __builtin_mma_xvf32gerpp(&acc0, rowA5, rowB5); + __builtin_mma_xvf32gerpp(&acc0, rowA6, rowB6); + __builtin_mma_xvf32gerpp(&acc0, rowA7, rowB7); + __builtin_mma_xvf32gerpp(&acc0, rowA8, rowB8); + } + for (l = (temp & (~7)); l < temp; ++l) { + vec_t rowA1 = *(vec_t *) & AO[l<<2]; + vec_t rowB1 = *(vec_t *) & BO[l<<2]; + __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); + } + SAVE_ACC_COMPLEX_22_1 + AO += temp << 2; + BO += temp << 2; + CO += 4; #if defined(TRMMKERNEL) - REFRESH_AFTER_SAVE (2, 2) + REFRESH_AFTER_SAVE (2, 2) #endif - } - if (m & 1) - { + } + if (m & 1) { #if defined(TRMMKERNEL) - REFRESH_POINTERS (1, 2) + REFRESH_POINTERS (1, 2) #else - BO = B; - temp = k; + BO = B; + temp = k; #endif - // RIP OUT MMA STUFF! - SET_ACC_ZERO() - for (l = 0; l < (temp & (~7)); l+=8) - { - vec_t rowA1 = *(vec_t *) & AO[l<<1]; - vec_t rowA2 = *(vec_t *) & AO[(l<<1)+2]; - vec_t rowA3 = *(vec_t *) & AO[(l<<1)+4]; - vec_t rowA4 = *(vec_t *) & AO[(l<<1)+6]; - vec_t rowA5 = *(vec_t *) & AO[(l<<1)+8]; - vec_t rowA6 = *(vec_t *) & AO[(l<<1)+10]; - vec_t rowA7 = *(vec_t *) & AO[(l<<1)+12]; - vec_t rowA8 = *(vec_t *) & AO[(l<<1)+14]; - vec_t rowB1 = *(vec_t *) & BO[l<<2]; - vec_t rowB2 = *(vec_t *) & BO[(l<<2)+4]; - vec_t rowB3 = *(vec_t *) & BO[(l<<2)+8]; - vec_t rowB4 = *(vec_t *) & BO[(l<<2)+12]; - vec_t rowB5 = *(vec_t *) & BO[(l<<2)+16]; - vec_t rowB6 = *(vec_t *) & BO[(l<<2)+20]; - vec_t rowB7 = *(vec_t *) & BO[(l<<2)+24]; - vec_t rowB8 = *(vec_t *) & BO[(l<<2)+28]; - __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); - __builtin_mma_xvf32gerpp(&acc1, rowA2, rowB2); - __builtin_mma_xvf32gerpp(&acc2, rowA3, rowB3); - __builtin_mma_xvf32gerpp(&acc3, rowA4, rowB4); - __builtin_mma_xvf32gerpp(&acc4, rowA5, rowB5); - __builtin_mma_xvf32gerpp(&acc5, rowA6, rowB6); - __builtin_mma_xvf32gerpp(&acc6, rowA7, rowB7); - __builtin_mma_xvf32gerpp(&acc7, rowA8, rowB8); - } - for (l = (temp & (~7)); l < temp; ++l) - { - vec_t rowA1 = *(vec_t *) & AO[l<<1]; - vec_t rowB1 = *(vec_t *) & BO[l<<2]; - __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); - } - SAVE_ACC_COMPLEX_12 - AO += temp<<1; - BO += temp<<2; - CO += 2; + SET_ACC_ZERO() + for (l = 0; l < (temp & (~7)); l+=8) { + vec_t rowA1 = *(vec_t *) & AO[l<<1]; + vec_t rowA2 = *(vec_t *) & AO[(l<<1)+2]; + vec_t rowA3 = *(vec_t *) & AO[(l<<1)+4]; + vec_t rowA4 = *(vec_t *) & AO[(l<<1)+6]; + vec_t rowA5 = *(vec_t *) & AO[(l<<1)+8]; + vec_t rowA6 = *(vec_t *) & AO[(l<<1)+10]; + vec_t rowA7 = *(vec_t *) & AO[(l<<1)+12]; + vec_t rowA8 = *(vec_t *) & AO[(l<<1)+14]; + vec_t rowB1 = *(vec_t *) & BO[l<<2]; + vec_t rowB2 = *(vec_t *) & BO[(l<<2)+4]; + vec_t rowB3 = *(vec_t *) & BO[(l<<2)+8]; + vec_t rowB4 = *(vec_t *) & BO[(l<<2)+12]; + vec_t rowB5 = *(vec_t *) & BO[(l<<2)+16]; + vec_t rowB6 = *(vec_t *) & BO[(l<<2)+20]; + vec_t rowB7 = *(vec_t *) & BO[(l<<2)+24]; + vec_t rowB8 = *(vec_t *) & BO[(l<<2)+28]; + __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); + __builtin_mma_xvf32gerpp(&acc1, rowA2, rowB2); + __builtin_mma_xvf32gerpp(&acc2, rowA3, rowB3); + __builtin_mma_xvf32gerpp(&acc3, rowA4, rowB4); + __builtin_mma_xvf32gerpp(&acc4, rowA5, rowB5); + __builtin_mma_xvf32gerpp(&acc5, rowA6, rowB6); + __builtin_mma_xvf32gerpp(&acc6, rowA7, rowB7); + __builtin_mma_xvf32gerpp(&acc7, rowA8, rowB8); + } + for (l = (temp & (~7)); l < temp; ++l) { + vec_t rowA1 = *(vec_t *) & AO[l<<1]; + vec_t rowB1 = *(vec_t *) & BO[l<<2]; + __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); + } + SAVE_ACC_COMPLEX_12 + AO += temp<<1; + BO += temp<<2; + CO += 2; #if defined(TRMMKERNEL) - REFRESH_AFTER_SAVE (1, 2) + REFRESH_AFTER_SAVE (1, 2) #endif - } + } #if defined(TRMMKERNEL) && !defined(LEFT) - off += 2; // number of values in A + off += 2; // number of values in A #endif B += k << 2; - } + } - if (n & 1) - { + if (n & 1) { #if defined(TRMMKERNEL) && defined(LEFT) off = offset; #endif @@ -945,210 +920,196 @@ CNAME (BLASLONG m, BLASLONG n, BLASLONG k, FLOAT alpha_r, FLOAT alpha_i, FLOAT * CO = C; C += ldc << 1; - for (i = 0; i < (m >> 3); i++) - { + for (i = 0; i < (m >> 3); i++) { #if defined(TRMMKERNEL) - REFRESH_POINTERS (8, 1) + REFRESH_POINTERS (8, 1) #else - BO = B; - temp = k; + BO = B; + temp = k; #endif - SET_ACC_ZERO() - for (l = 0; l < (temp & (~1)); l+=2) - { - vec_t rowA1 = *(vec_t *) & AO[l<<4]; - vec_t rowA2 = *(vec_t *) & AO[(l<<4)+4]; - vec_t rowA3 = *(vec_t *) & AO[(l<<4)+8]; - vec_t rowA4 = *(vec_t *) & AO[(l<<4)+12]; - vec_t rowA5 = *(vec_t *) & AO[(l<<4)+16]; - vec_t rowA6 = *(vec_t *) & AO[(l<<4)+20]; - vec_t rowA7 = *(vec_t *) & AO[(l<<4)+24]; - vec_t rowA8 = *(vec_t *) & AO[(l<<4)+28]; - vec_t rowB1 = *(vec_t *) & BO[l<<1]; - vec_t rowB2 = *(vec_t *) & BO[(l<<1)+2]; - __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); - __builtin_mma_xvf32gerpp(&acc1, rowA2, rowB1); - __builtin_mma_xvf32gerpp(&acc2, rowA3, rowB1); - __builtin_mma_xvf32gerpp(&acc3, rowA4, rowB1); - __builtin_mma_xvf32gerpp(&acc4, rowA5, rowB2); - __builtin_mma_xvf32gerpp(&acc5, rowA6, rowB2); - __builtin_mma_xvf32gerpp(&acc6, rowA7, rowB2); - __builtin_mma_xvf32gerpp(&acc7, rowA8, rowB2); - } - for (l = (temp & (~1)); l < temp; ++l) - { - vec_t rowA1 = *(vec_t *) & AO[l<<4]; - vec_t rowA2 = *(vec_t *) & AO[(l<<4)+4]; - vec_t rowA3 = *(vec_t *) & AO[(l<<4)+8]; - vec_t rowA4 = *(vec_t *) & AO[(l<<4)+12]; - vec_t rowB1 = *(vec_t *) & BO[l<<1]; - __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); - __builtin_mma_xvf32gerpp(&acc1, rowA2, rowB1); - __builtin_mma_xvf32gerpp(&acc2, rowA3, rowB1); - __builtin_mma_xvf32gerpp(&acc3, rowA4, rowB1); - } - SAVE_ACC_COMPLEX_21_4 - AO += temp << 4; - BO += temp << 1; - CO += 16; + SET_ACC_ZERO() + for (l = 0; l < (temp & (~1)); l+=2) { + vec_t rowA1 = *(vec_t *) & AO[l<<4]; + vec_t rowA2 = *(vec_t *) & AO[(l<<4)+4]; + vec_t rowA3 = *(vec_t *) & AO[(l<<4)+8]; + vec_t rowA4 = *(vec_t *) & AO[(l<<4)+12]; + vec_t rowA5 = *(vec_t *) & AO[(l<<4)+16]; + vec_t rowA6 = *(vec_t *) & AO[(l<<4)+20]; + vec_t rowA7 = *(vec_t *) & AO[(l<<4)+24]; + vec_t rowA8 = *(vec_t *) & AO[(l<<4)+28]; + vec_t rowB1 = *(vec_t *) & BO[l<<1]; + vec_t rowB2 = *(vec_t *) & BO[(l<<1)+2]; + __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); + __builtin_mma_xvf32gerpp(&acc1, rowA2, rowB1); + __builtin_mma_xvf32gerpp(&acc2, rowA3, rowB1); + __builtin_mma_xvf32gerpp(&acc3, rowA4, rowB1); + __builtin_mma_xvf32gerpp(&acc4, rowA5, rowB2); + __builtin_mma_xvf32gerpp(&acc5, rowA6, rowB2); + __builtin_mma_xvf32gerpp(&acc6, rowA7, rowB2); + __builtin_mma_xvf32gerpp(&acc7, rowA8, rowB2); + } + for (l = (temp & (~1)); l < temp; ++l) { + vec_t rowA1 = *(vec_t *) & AO[l<<4]; + vec_t rowA2 = *(vec_t *) & AO[(l<<4)+4]; + vec_t rowA3 = *(vec_t *) & AO[(l<<4)+8]; + vec_t rowA4 = *(vec_t *) & AO[(l<<4)+12]; + vec_t rowB1 = *(vec_t *) & BO[l<<1]; + __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); + __builtin_mma_xvf32gerpp(&acc1, rowA2, rowB1); + __builtin_mma_xvf32gerpp(&acc2, rowA3, rowB1); + __builtin_mma_xvf32gerpp(&acc3, rowA4, rowB1); + } + SAVE_ACC_COMPLEX_21_4 + AO += temp << 4; + BO += temp << 1; + CO += 16; #if defined(TRMMKERNEL) - REFRESH_AFTER_SAVE (8, 1) + REFRESH_AFTER_SAVE (8, 1) #endif - } - if (m & 4) - { + } + if (m & 4) { #if defined(TRMMKERNEL) - REFRESH_POINTERS (4, 1) + REFRESH_POINTERS (4, 1) #else - BO = B; - temp = k; + BO = B; + temp = k; #endif - SET_ACC_ZERO() - for (l = 0; l < (temp & (~3)); l+=4) - { - vec_t rowA1 = *(vec_t *) & AO[l<<3]; - vec_t rowA2 = *(vec_t *) & AO[(l<<3)+4]; - vec_t rowA3 = *(vec_t *) & AO[(l<<3)+8]; - vec_t rowA4 = *(vec_t *) & AO[(l<<3)+12]; - vec_t rowA5 = *(vec_t *) & AO[(l<<3)+16]; - vec_t rowA6 = *(vec_t *) & AO[(l<<3)+20]; - vec_t rowA7 = *(vec_t *) & AO[(l<<3)+24]; - vec_t rowA8 = *(vec_t *) & AO[(l<<3)+28]; - vec_t rowB1 = *(vec_t *) & BO[l<<1]; - vec_t rowB2 = *(vec_t *) & BO[(l<<1)+2]; - vec_t rowB3 = *(vec_t *) & BO[(l<<1)+4]; - vec_t rowB4 = *(vec_t *) & BO[(l<<1)+6]; - __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); - __builtin_mma_xvf32gerpp(&acc1, rowA2, rowB1); - __builtin_mma_xvf32gerpp(&acc2, rowA3, rowB2); - __builtin_mma_xvf32gerpp(&acc3, rowA4, rowB2); - __builtin_mma_xvf32gerpp(&acc4, rowA5, rowB3); - __builtin_mma_xvf32gerpp(&acc5, rowA6, rowB3); - __builtin_mma_xvf32gerpp(&acc6, rowA7, rowB4); - __builtin_mma_xvf32gerpp(&acc7, rowA8, rowB4); - } - for (l = (temp & (~3)); l < temp; ++l) - { - vec_t rowA1 = *(vec_t *) & AO[l<<3]; - vec_t rowA2 = *(vec_t *) & AO[(l<<3)+4]; - vec_t rowB1 = *(vec_t *) & BO[l<<1]; - __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); - __builtin_mma_xvf32gerpp(&acc1, rowA2, rowB1); - } - SAVE_ACC_COMPLEX_21_2 - AO += temp << 3; - BO += temp << 1; - CO += 8; + SET_ACC_ZERO() + for (l = 0; l < (temp & (~3)); l+=4) { + vec_t rowA1 = *(vec_t *) & AO[l<<3]; + vec_t rowA2 = *(vec_t *) & AO[(l<<3)+4]; + vec_t rowA3 = *(vec_t *) & AO[(l<<3)+8]; + vec_t rowA4 = *(vec_t *) & AO[(l<<3)+12]; + vec_t rowA5 = *(vec_t *) & AO[(l<<3)+16]; + vec_t rowA6 = *(vec_t *) & AO[(l<<3)+20]; + vec_t rowA7 = *(vec_t *) & AO[(l<<3)+24]; + vec_t rowA8 = *(vec_t *) & AO[(l<<3)+28]; + vec_t rowB1 = *(vec_t *) & BO[l<<1]; + vec_t rowB2 = *(vec_t *) & BO[(l<<1)+2]; + vec_t rowB3 = *(vec_t *) & BO[(l<<1)+4]; + vec_t rowB4 = *(vec_t *) & BO[(l<<1)+6]; + __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); + __builtin_mma_xvf32gerpp(&acc1, rowA2, rowB1); + __builtin_mma_xvf32gerpp(&acc2, rowA3, rowB2); + __builtin_mma_xvf32gerpp(&acc3, rowA4, rowB2); + __builtin_mma_xvf32gerpp(&acc4, rowA5, rowB3); + __builtin_mma_xvf32gerpp(&acc5, rowA6, rowB3); + __builtin_mma_xvf32gerpp(&acc6, rowA7, rowB4); + __builtin_mma_xvf32gerpp(&acc7, rowA8, rowB4); + } + for (l = (temp & (~3)); l < temp; ++l) { + vec_t rowA1 = *(vec_t *) & AO[l<<3]; + vec_t rowA2 = *(vec_t *) & AO[(l<<3)+4]; + vec_t rowB1 = *(vec_t *) & BO[l<<1]; + __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); + __builtin_mma_xvf32gerpp(&acc1, rowA2, rowB1); + } + SAVE_ACC_COMPLEX_21_2 + AO += temp << 3; + BO += temp << 1; + CO += 8; #if defined(TRMMKERNEL) - REFRESH_AFTER_SAVE (4, 1) + REFRESH_AFTER_SAVE (4, 1) #endif - } - if (m & 2) - { + } + if (m & 2) { #if defined(TRMMKERNEL) - REFRESH_POINTERS (2, 1) + REFRESH_POINTERS (2, 1) #else - BO = B; - temp = k; + BO = B; + temp = k; #endif - // RIP OUT MMA STUFF! - SET_ACC_ZERO() - for (l = 0; l < (temp & (~7)); l+=8) - { - vec_t rowA1 = *(vec_t *) & AO[l<<2]; - vec_t rowA2 = *(vec_t *) & AO[(l<<2)+4]; - vec_t rowA3 = *(vec_t *) & AO[(l<<2)+8]; - vec_t rowA4 = *(vec_t *) & AO[(l<<2)+12]; - vec_t rowA5 = *(vec_t *) & AO[(l<<2)+16]; - vec_t rowA6 = *(vec_t *) & AO[(l<<2)+20]; - vec_t rowA7 = *(vec_t *) & AO[(l<<2)+24]; - vec_t rowA8 = *(vec_t *) & AO[(l<<2)+28]; - vec_t rowB1 = *(vec_t *) & BO[l<<1]; - vec_t rowB2 = *(vec_t *) & BO[(l<<1)+2]; - vec_t rowB3 = *(vec_t *) & BO[(l<<1)+4]; - vec_t rowB4 = *(vec_t *) & BO[(l<<1)+6]; - vec_t rowB5 = *(vec_t *) & BO[(l<<1)+8]; - vec_t rowB6 = *(vec_t *) & BO[(l<<1)+10]; - vec_t rowB7 = *(vec_t *) & BO[(l<<1)+12]; - vec_t rowB8 = *(vec_t *) & BO[(l<<1)+14]; - __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); - __builtin_mma_xvf32gerpp(&acc1, rowA2, rowB2); - __builtin_mma_xvf32gerpp(&acc2, rowA3, rowB3); - __builtin_mma_xvf32gerpp(&acc3, rowA4, rowB4); - __builtin_mma_xvf32gerpp(&acc4, rowA5, rowB5); - __builtin_mma_xvf32gerpp(&acc5, rowA6, rowB6); - __builtin_mma_xvf32gerpp(&acc6, rowA7, rowB7); - __builtin_mma_xvf32gerpp(&acc7, rowA8, rowB8); - } - for (l = (temp & (~7)); l < temp; ++l) - { - vec_t rowA1 = *(vec_t *) & AO[l<<2]; - vec_t rowB1 = *(vec_t *) & BO[l<<1]; - __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); - } - SAVE_ACC_COMPLEX_21_1 - AO += temp << 2; - BO += temp << 1; - CO += 4; + SET_ACC_ZERO() + for (l = 0; l < (temp & (~7)); l+=8) { + vec_t rowA1 = *(vec_t *) & AO[l<<2]; + vec_t rowA2 = *(vec_t *) & AO[(l<<2)+4]; + vec_t rowA3 = *(vec_t *) & AO[(l<<2)+8]; + vec_t rowA4 = *(vec_t *) & AO[(l<<2)+12]; + vec_t rowA5 = *(vec_t *) & AO[(l<<2)+16]; + vec_t rowA6 = *(vec_t *) & AO[(l<<2)+20]; + vec_t rowA7 = *(vec_t *) & AO[(l<<2)+24]; + vec_t rowA8 = *(vec_t *) & AO[(l<<2)+28]; + vec_t rowB1 = *(vec_t *) & BO[l<<1]; + vec_t rowB2 = *(vec_t *) & BO[(l<<1)+2]; + vec_t rowB3 = *(vec_t *) & BO[(l<<1)+4]; + vec_t rowB4 = *(vec_t *) & BO[(l<<1)+6]; + vec_t rowB5 = *(vec_t *) & BO[(l<<1)+8]; + vec_t rowB6 = *(vec_t *) & BO[(l<<1)+10]; + vec_t rowB7 = *(vec_t *) & BO[(l<<1)+12]; + vec_t rowB8 = *(vec_t *) & BO[(l<<1)+14]; + __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); + __builtin_mma_xvf32gerpp(&acc1, rowA2, rowB2); + __builtin_mma_xvf32gerpp(&acc2, rowA3, rowB3); + __builtin_mma_xvf32gerpp(&acc3, rowA4, rowB4); + __builtin_mma_xvf32gerpp(&acc4, rowA5, rowB5); + __builtin_mma_xvf32gerpp(&acc5, rowA6, rowB6); + __builtin_mma_xvf32gerpp(&acc6, rowA7, rowB7); + __builtin_mma_xvf32gerpp(&acc7, rowA8, rowB8); + } + for (l = (temp & (~7)); l < temp; ++l) { + vec_t rowA1 = *(vec_t *) & AO[l<<2]; + vec_t rowB1 = *(vec_t *) & BO[l<<1]; + __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); + } + SAVE_ACC_COMPLEX_21_1 + AO += temp << 2; + BO += temp << 1; + CO += 4; #if defined(TRMMKERNEL) - REFRESH_AFTER_SAVE (2, 1) + REFRESH_AFTER_SAVE (2, 1) #endif - } - if (m & 1) - { + } + if (m & 1) { #if defined(TRMMKERNEL) - REFRESH_POINTERS (1, 1) + REFRESH_POINTERS (1, 1) #else - BO = B; - temp = k; + BO = B; + temp = k; #endif - // RIP OUT MMA STUFF! - SET_ACC_ZERO() - for (l = 0; l < (temp & (~7)); l+=8) - { - vec_t rowA1 = *(vec_t *) & AO[l<<1]; - vec_t rowA2 = *(vec_t *) & AO[(l<<1)+2]; - vec_t rowA3 = *(vec_t *) & AO[(l<<1)+4]; - vec_t rowA4 = *(vec_t *) & AO[(l<<1)+6]; - vec_t rowA5 = *(vec_t *) & AO[(l<<1)+8]; - vec_t rowA6 = *(vec_t *) & AO[(l<<1)+10]; - vec_t rowA7 = *(vec_t *) & AO[(l<<1)+12]; - vec_t rowA8 = *(vec_t *) & AO[(l<<1)+14]; - vec_t rowB1 = *(vec_t *) & BO[l<<1]; - vec_t rowB2 = *(vec_t *) & BO[(l<<1)+2]; - vec_t rowB3 = *(vec_t *) & BO[(l<<1)+4]; - vec_t rowB4 = *(vec_t *) & BO[(l<<1)+6]; - vec_t rowB5 = *(vec_t *) & BO[(l<<1)+8]; - vec_t rowB6 = *(vec_t *) & BO[(l<<1)+10]; - vec_t rowB7 = *(vec_t *) & BO[(l<<1)+12]; - vec_t rowB8 = *(vec_t *) & BO[(l<<1)+14]; - __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); - __builtin_mma_xvf32gerpp(&acc1, rowA2, rowB2); - __builtin_mma_xvf32gerpp(&acc2, rowA3, rowB3); - __builtin_mma_xvf32gerpp(&acc3, rowA4, rowB4); - __builtin_mma_xvf32gerpp(&acc4, rowA5, rowB5); - __builtin_mma_xvf32gerpp(&acc5, rowA6, rowB6); - __builtin_mma_xvf32gerpp(&acc6, rowA7, rowB7); - __builtin_mma_xvf32gerpp(&acc7, rowA8, rowB8); - } - for (l = (temp & (~7)); l < temp; ++l) - { - vec_t rowA1 = *(vec_t *) & AO[l<<1]; - vec_t rowB1 = *(vec_t *) & BO[l<<1]; - __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); - } - SAVE_ACC_COMPLEX_11 - AO += temp<<1; - BO += temp<<1; - CO += 2; + SET_ACC_ZERO() + for (l = 0; l < (temp & (~7)); l+=8) { + vec_t rowA1 = *(vec_t *) & AO[l<<1]; + vec_t rowA2 = *(vec_t *) & AO[(l<<1)+2]; + vec_t rowA3 = *(vec_t *) & AO[(l<<1)+4]; + vec_t rowA4 = *(vec_t *) & AO[(l<<1)+6]; + vec_t rowA5 = *(vec_t *) & AO[(l<<1)+8]; + vec_t rowA6 = *(vec_t *) & AO[(l<<1)+10]; + vec_t rowA7 = *(vec_t *) & AO[(l<<1)+12]; + vec_t rowA8 = *(vec_t *) & AO[(l<<1)+14]; + vec_t rowB1 = *(vec_t *) & BO[l<<1]; + vec_t rowB2 = *(vec_t *) & BO[(l<<1)+2]; + vec_t rowB3 = *(vec_t *) & BO[(l<<1)+4]; + vec_t rowB4 = *(vec_t *) & BO[(l<<1)+6]; + vec_t rowB5 = *(vec_t *) & BO[(l<<1)+8]; + vec_t rowB6 = *(vec_t *) & BO[(l<<1)+10]; + vec_t rowB7 = *(vec_t *) & BO[(l<<1)+12]; + vec_t rowB8 = *(vec_t *) & BO[(l<<1)+14]; + __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); + __builtin_mma_xvf32gerpp(&acc1, rowA2, rowB2); + __builtin_mma_xvf32gerpp(&acc2, rowA3, rowB3); + __builtin_mma_xvf32gerpp(&acc3, rowA4, rowB4); + __builtin_mma_xvf32gerpp(&acc4, rowA5, rowB5); + __builtin_mma_xvf32gerpp(&acc5, rowA6, rowB6); + __builtin_mma_xvf32gerpp(&acc6, rowA7, rowB7); + __builtin_mma_xvf32gerpp(&acc7, rowA8, rowB8); + } + for (l = (temp & (~7)); l < temp; ++l) { + vec_t rowA1 = *(vec_t *) & AO[l<<1]; + vec_t rowB1 = *(vec_t *) & BO[l<<1]; + __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); + } + SAVE_ACC_COMPLEX_11 + AO += temp<<1; + BO += temp<<1; + CO += 2; #if defined(TRMMKERNEL) - REFRESH_AFTER_SAVE (1, 1) + REFRESH_AFTER_SAVE (1, 1) #endif - } + } #if defined(TRMMKERNEL) && !defined(LEFT) - off += 1; // number of values in A + off += 1; // number of values in A #endif B += k << 1; - } - return 0; + } + return 0; } diff --git a/kernel/power/zgemm_kernel_power10.c b/kernel/power/zgemm_kernel_power10.c index e4e609067..370d12af3 100644 --- a/kernel/power/zgemm_kernel_power10.c +++ b/kernel/power/zgemm_kernel_power10.c @@ -30,15 +30,15 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. typedef __vector unsigned char vec_t; typedef FLOAT v4sf_t __attribute__ ((vector_size (16))); -#define SET_ACC_ZERO() \ - __builtin_mma_xxsetaccz (&acc0); \ - __builtin_mma_xxsetaccz (&acc1); \ - __builtin_mma_xxsetaccz (&acc2); \ - __builtin_mma_xxsetaccz (&acc3); \ - __builtin_mma_xxsetaccz (&acc4); \ - __builtin_mma_xxsetaccz (&acc5); \ - __builtin_mma_xxsetaccz (&acc6); \ - __builtin_mma_xxsetaccz (&acc7); +#define SET_ACC_ZERO() \ + __builtin_mma_xxsetaccz (&acc0); \ + __builtin_mma_xxsetaccz (&acc1); \ + __builtin_mma_xxsetaccz (&acc2); \ + __builtin_mma_xxsetaccz (&acc3); \ + __builtin_mma_xxsetaccz (&acc4); \ + __builtin_mma_xxsetaccz (&acc5); \ + __builtin_mma_xxsetaccz (&acc6); \ + __builtin_mma_xxsetaccz (&acc7); #if (defined(NN) || defined(NT) || defined(TN) || defined(TT)) #define COMP_MUL(_real, _arbr, _aibi, _imag, _arbi, _aibr) { _real = _arbr - _aibi; _imag = _arbi + _aibr; } @@ -66,696 +66,671 @@ typedef FLOAT v4sf_t __attribute__ ((vector_size (16))); #define A_OP += #endif -#define BUILTIN_MMA_DISASSEMBLE_ACC_8 \ - __builtin_mma_disassemble_acc ((void *)result, &acc0); \ - __builtin_mma_disassemble_acc ((void *)&result[4], &acc1); \ - __builtin_mma_disassemble_acc ((void *)&result[8], &acc2); \ - __builtin_mma_disassemble_acc ((void *)&result[12], &acc3); \ - __builtin_mma_disassemble_acc ((void *)&result[16], &acc4); \ - __builtin_mma_disassemble_acc ((void *)&result[20], &acc5); \ - __builtin_mma_disassemble_acc ((void *)&result[24], &acc6); \ - __builtin_mma_disassemble_acc ((void *)&result[28], &acc7); +#define BUILTIN_MMA_DISASSEMBLE_ACC_8 \ + __builtin_mma_disassemble_acc ((void *)result, &acc0); \ + __builtin_mma_disassemble_acc ((void *)&result[4], &acc1); \ + __builtin_mma_disassemble_acc ((void *)&result[8], &acc2); \ + __builtin_mma_disassemble_acc ((void *)&result[12], &acc3); \ + __builtin_mma_disassemble_acc ((void *)&result[16], &acc4); \ + __builtin_mma_disassemble_acc ((void *)&result[20], &acc5); \ + __builtin_mma_disassemble_acc ((void *)&result[24], &acc6); \ + __builtin_mma_disassemble_acc ((void *)&result[28], &acc7); -#define SAVE_ACC_COMPLEX_11 \ - BUILTIN_MMA_DISASSEMBLE_ACC_8 \ - COMP_MUL(tr[0], res[ 0], res[ 3], ti[0], res[ 1], res[ 2]) \ - COMP_MAC(tr[0], res[ 8], res[11], ti[0], res[ 9], res[10]) \ - COMP_MAC(tr[0], res[16], res[19], ti[0], res[17], res[18]) \ - COMP_MAC(tr[0], res[24], res[27], ti[0], res[25], res[26]) \ - COMP_MAC(tr[0], res[32], res[35], ti[0], res[33], res[34]) \ - COMP_MAC(tr[0], res[40], res[43], ti[0], res[41], res[42]) \ - COMP_MAC(tr[0], res[48], res[51], ti[0], res[49], res[50]) \ - COMP_MAC(tr[0], res[56], res[59], ti[0], res[57], res[58]) \ - CO[0] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ - CO[1] A_OP ti[0] * alpha_r + tr[0] * alpha_i; +#define SAVE_ACC_COMPLEX_11 \ + BUILTIN_MMA_DISASSEMBLE_ACC_8 \ + COMP_MUL(tr[0], res[ 0], res[ 3], ti[0], res[ 1], res[ 2]) \ + COMP_MAC(tr[0], res[ 8], res[11], ti[0], res[ 9], res[10]) \ + COMP_MAC(tr[0], res[16], res[19], ti[0], res[17], res[18]) \ + COMP_MAC(tr[0], res[24], res[27], ti[0], res[25], res[26]) \ + COMP_MAC(tr[0], res[32], res[35], ti[0], res[33], res[34]) \ + COMP_MAC(tr[0], res[40], res[43], ti[0], res[41], res[42]) \ + COMP_MAC(tr[0], res[48], res[51], ti[0], res[49], res[50]) \ + COMP_MAC(tr[0], res[56], res[59], ti[0], res[57], res[58]) \ + CO[0] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ + CO[1] A_OP ti[0] * alpha_r + tr[0] * alpha_i; -#define SAVE_ACC_COMPLEX_12 \ - BUILTIN_MMA_DISASSEMBLE_ACC_8 \ - COMP_MUL(tr[0], res[ 0], res[ 3], ti[0], res[ 1], res[ 2]) \ - COMP_MUL(tr[1], res[ 8], res[11], ti[1], res[ 9], res[10]) \ - COMP_MAC(tr[0], res[16], res[19], ti[0], res[17], res[18]) \ - COMP_MAC(tr[1], res[24], res[27], ti[1], res[25], res[26]) \ - COMP_MAC(tr[0], res[32], res[35], ti[0], res[33], res[34]) \ - COMP_MAC(tr[1], res[40], res[43], ti[1], res[41], res[42]) \ - COMP_MAC(tr[0], res[48], res[51], ti[0], res[49], res[50]) \ - COMP_MAC(tr[1], res[56], res[59], ti[1], res[57], res[58]) \ - CO[0] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ - CO[1] A_OP ti[0] * alpha_r + tr[0] * alpha_i; \ - CO[2*ldc+0] A_OP tr[1] * alpha_r - ti[1] * alpha_i; \ - CO[2*ldc+1] A_OP ti[1] * alpha_r + tr[1] * alpha_i; +#define SAVE_ACC_COMPLEX_12 \ + BUILTIN_MMA_DISASSEMBLE_ACC_8 \ + COMP_MUL(tr[0], res[ 0], res[ 3], ti[0], res[ 1], res[ 2]) \ + COMP_MUL(tr[1], res[ 8], res[11], ti[1], res[ 9], res[10]) \ + COMP_MAC(tr[0], res[16], res[19], ti[0], res[17], res[18]) \ + COMP_MAC(tr[1], res[24], res[27], ti[1], res[25], res[26]) \ + COMP_MAC(tr[0], res[32], res[35], ti[0], res[33], res[34]) \ + COMP_MAC(tr[1], res[40], res[43], ti[1], res[41], res[42]) \ + COMP_MAC(tr[0], res[48], res[51], ti[0], res[49], res[50]) \ + COMP_MAC(tr[1], res[56], res[59], ti[1], res[57], res[58]) \ + CO[0] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ + CO[1] A_OP ti[0] * alpha_r + tr[0] * alpha_i; \ + CO[2*ldc+0] A_OP tr[1] * alpha_r - ti[1] * alpha_i; \ + CO[2*ldc+1] A_OP ti[1] * alpha_r + tr[1] * alpha_i; -#define SAVE_ACC_COMPLEX_21_1 \ - BUILTIN_MMA_DISASSEMBLE_ACC_8 \ - COMP_MUL(tr[0], res[ 0], res[ 3], ti[0], res[ 1], res[ 2]) \ - COMP_MUL(tr[1], res[ 4], res[ 7], ti[1], res[ 5], res[ 6]) \ - COMP_MAC(tr[0], res[ 8], res[11], ti[0], res[ 9], res[10]) \ - COMP_MAC(tr[1], res[12], res[15], ti[1], res[13], res[14]) \ - COMP_MAC(tr[0], res[16], res[19], ti[0], res[17], res[18]) \ - COMP_MAC(tr[1], res[20], res[23], ti[1], res[21], res[22]) \ - COMP_MAC(tr[0], res[24], res[27], ti[0], res[25], res[26]) \ - COMP_MAC(tr[1], res[28], res[31], ti[1], res[29], res[30]) \ - COMP_MAC(tr[0], res[32], res[35], ti[0], res[33], res[34]) \ - COMP_MAC(tr[1], res[36], res[39], ti[1], res[37], res[38]) \ - COMP_MAC(tr[0], res[40], res[43], ti[0], res[41], res[42]) \ - COMP_MAC(tr[1], res[44], res[47], ti[1], res[45], res[46]) \ - COMP_MAC(tr[0], res[48], res[51], ti[0], res[49], res[50]) \ - COMP_MAC(tr[1], res[52], res[55], ti[1], res[53], res[54]) \ - COMP_MAC(tr[0], res[56], res[59], ti[0], res[57], res[58]) \ - COMP_MAC(tr[1], res[60], res[63], ti[1], res[61], res[62]) \ - CO[0] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ - CO[1] A_OP ti[0] * alpha_r + tr[0] * alpha_i; \ - CO[2] A_OP tr[1] * alpha_r - ti[1] * alpha_i; \ - CO[3] A_OP ti[1] * alpha_r + tr[1] * alpha_i; +#define SAVE_ACC_COMPLEX_21_1 \ + BUILTIN_MMA_DISASSEMBLE_ACC_8 \ + COMP_MUL(tr[0], res[ 0], res[ 3], ti[0], res[ 1], res[ 2]) \ + COMP_MUL(tr[1], res[ 4], res[ 7], ti[1], res[ 5], res[ 6]) \ + COMP_MAC(tr[0], res[ 8], res[11], ti[0], res[ 9], res[10]) \ + COMP_MAC(tr[1], res[12], res[15], ti[1], res[13], res[14]) \ + COMP_MAC(tr[0], res[16], res[19], ti[0], res[17], res[18]) \ + COMP_MAC(tr[1], res[20], res[23], ti[1], res[21], res[22]) \ + COMP_MAC(tr[0], res[24], res[27], ti[0], res[25], res[26]) \ + COMP_MAC(tr[1], res[28], res[31], ti[1], res[29], res[30]) \ + COMP_MAC(tr[0], res[32], res[35], ti[0], res[33], res[34]) \ + COMP_MAC(tr[1], res[36], res[39], ti[1], res[37], res[38]) \ + COMP_MAC(tr[0], res[40], res[43], ti[0], res[41], res[42]) \ + COMP_MAC(tr[1], res[44], res[47], ti[1], res[45], res[46]) \ + COMP_MAC(tr[0], res[48], res[51], ti[0], res[49], res[50]) \ + COMP_MAC(tr[1], res[52], res[55], ti[1], res[53], res[54]) \ + COMP_MAC(tr[0], res[56], res[59], ti[0], res[57], res[58]) \ + COMP_MAC(tr[1], res[60], res[63], ti[1], res[61], res[62]) \ + CO[0] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ + CO[1] A_OP ti[0] * alpha_r + tr[0] * alpha_i; \ + CO[2] A_OP tr[1] * alpha_r - ti[1] * alpha_i; \ + CO[3] A_OP ti[1] * alpha_r + tr[1] * alpha_i; -#define SAVE_ACC_COMPLEX_21_2 \ - BUILTIN_MMA_DISASSEMBLE_ACC_8 \ - COMP_MUL(tr[0], res[ 0], res[ 3], ti[0], res[ 1], res[ 2]) \ - COMP_MUL(tr[1], res[ 4], res[ 7], ti[1], res[ 5], res[ 6]) \ - COMP_MUL(tr[2], res[ 8], res[11], ti[2], res[ 9], res[10]) \ - COMP_MUL(tr[3], res[12], res[15], ti[3], res[13], res[14]) \ - COMP_MAC(tr[0], res[16], res[19], ti[0], res[17], res[18]) \ - COMP_MAC(tr[1], res[20], res[23], ti[1], res[21], res[22]) \ - COMP_MAC(tr[2], res[24], res[27], ti[2], res[25], res[26]) \ - COMP_MAC(tr[3], res[28], res[31], ti[3], res[29], res[30]) \ - COMP_MAC(tr[0], res[32], res[35], ti[0], res[33], res[34]) \ - COMP_MAC(tr[1], res[36], res[39], ti[1], res[37], res[38]) \ - COMP_MAC(tr[2], res[40], res[43], ti[2], res[41], res[42]) \ - COMP_MAC(tr[3], res[44], res[47], ti[3], res[45], res[46]) \ - COMP_MAC(tr[0], res[48], res[51], ti[0], res[49], res[50]) \ - COMP_MAC(tr[1], res[52], res[55], ti[1], res[53], res[54]) \ - COMP_MAC(tr[2], res[56], res[59], ti[2], res[57], res[58]) \ - COMP_MAC(tr[3], res[60], res[63], ti[3], res[61], res[62]) \ - CO[0] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ - CO[1] A_OP ti[0] * alpha_r + tr[0] * alpha_i; \ - CO[2] A_OP tr[1] * alpha_r - ti[1] * alpha_i; \ - CO[3] A_OP ti[1] * alpha_r + tr[1] * alpha_i; \ - CO[4] A_OP tr[2] * alpha_r - ti[2] * alpha_i; \ - CO[5] A_OP ti[2] * alpha_r + tr[2] * alpha_i; \ - CO[6] A_OP tr[3] * alpha_r - ti[3] * alpha_i; \ - CO[7] A_OP ti[3] * alpha_r + tr[3] * alpha_i; +#define SAVE_ACC_COMPLEX_21_2 \ + BUILTIN_MMA_DISASSEMBLE_ACC_8 \ + COMP_MUL(tr[0], res[ 0], res[ 3], ti[0], res[ 1], res[ 2]) \ + COMP_MUL(tr[1], res[ 4], res[ 7], ti[1], res[ 5], res[ 6]) \ + COMP_MUL(tr[2], res[ 8], res[11], ti[2], res[ 9], res[10]) \ + COMP_MUL(tr[3], res[12], res[15], ti[3], res[13], res[14]) \ + COMP_MAC(tr[0], res[16], res[19], ti[0], res[17], res[18]) \ + COMP_MAC(tr[1], res[20], res[23], ti[1], res[21], res[22]) \ + COMP_MAC(tr[2], res[24], res[27], ti[2], res[25], res[26]) \ + COMP_MAC(tr[3], res[28], res[31], ti[3], res[29], res[30]) \ + COMP_MAC(tr[0], res[32], res[35], ti[0], res[33], res[34]) \ + COMP_MAC(tr[1], res[36], res[39], ti[1], res[37], res[38]) \ + COMP_MAC(tr[2], res[40], res[43], ti[2], res[41], res[42]) \ + COMP_MAC(tr[3], res[44], res[47], ti[3], res[45], res[46]) \ + COMP_MAC(tr[0], res[48], res[51], ti[0], res[49], res[50]) \ + COMP_MAC(tr[1], res[52], res[55], ti[1], res[53], res[54]) \ + COMP_MAC(tr[2], res[56], res[59], ti[2], res[57], res[58]) \ + COMP_MAC(tr[3], res[60], res[63], ti[3], res[61], res[62]) \ + CO[0] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ + CO[1] A_OP ti[0] * alpha_r + tr[0] * alpha_i; \ + CO[2] A_OP tr[1] * alpha_r - ti[1] * alpha_i; \ + CO[3] A_OP ti[1] * alpha_r + tr[1] * alpha_i; \ + CO[4] A_OP tr[2] * alpha_r - ti[2] * alpha_i; \ + CO[5] A_OP ti[2] * alpha_r + tr[2] * alpha_i; \ + CO[6] A_OP tr[3] * alpha_r - ti[3] * alpha_i; \ + CO[7] A_OP ti[3] * alpha_r + tr[3] * alpha_i; -#define SAVE_ACC_COMPLEX_21_4 \ - BUILTIN_MMA_DISASSEMBLE_ACC_8 \ - COMP_MUL(tr[0], res[ 0], res[ 3], ti[0], res[ 1], res[ 2]) \ - COMP_MUL(tr[1], res[ 4], res[ 7], ti[1], res[ 5], res[ 6]) \ - COMP_MUL(tr[2], res[ 8], res[11], ti[2], res[ 9], res[10]) \ - COMP_MUL(tr[3], res[12], res[15], ti[3], res[13], res[14]) \ - COMP_MUL(tr[4], res[16], res[19], ti[4], res[17], res[18]) \ - COMP_MUL(tr[5], res[20], res[23], ti[5], res[21], res[22]) \ - COMP_MUL(tr[6], res[24], res[27], ti[6], res[25], res[26]) \ - COMP_MUL(tr[7], res[28], res[31], ti[7], res[29], res[30]) \ - COMP_MAC(tr[0], res[32], res[35], ti[0], res[33], res[34]) \ - COMP_MAC(tr[1], res[36], res[39], ti[1], res[37], res[38]) \ - COMP_MAC(tr[2], res[40], res[43], ti[2], res[41], res[42]) \ - COMP_MAC(tr[3], res[44], res[47], ti[3], res[45], res[46]) \ - COMP_MAC(tr[4], res[48], res[51], ti[4], res[49], res[50]) \ - COMP_MAC(tr[5], res[52], res[55], ti[5], res[53], res[54]) \ - COMP_MAC(tr[6], res[56], res[59], ti[6], res[57], res[58]) \ - COMP_MAC(tr[7], res[60], res[63], ti[7], res[61], res[62]) \ - CO[ 0] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ - CO[ 1] A_OP ti[0] * alpha_r + tr[0] * alpha_i; \ - CO[ 2] A_OP tr[1] * alpha_r - ti[1] * alpha_i; \ - CO[ 3] A_OP ti[1] * alpha_r + tr[1] * alpha_i; \ - CO[ 4] A_OP tr[2] * alpha_r - ti[2] * alpha_i; \ - CO[ 5] A_OP ti[2] * alpha_r + tr[2] * alpha_i; \ - CO[ 6] A_OP tr[3] * alpha_r - ti[3] * alpha_i; \ - CO[ 7] A_OP ti[3] * alpha_r + tr[3] * alpha_i; \ - CO[ 8] A_OP tr[4] * alpha_r - ti[4] * alpha_i; \ - CO[ 9] A_OP ti[4] * alpha_r + tr[4] * alpha_i; \ - CO[10] A_OP tr[5] * alpha_r - ti[5] * alpha_i; \ - CO[11] A_OP ti[5] * alpha_r + tr[5] * alpha_i; \ - CO[12] A_OP tr[6] * alpha_r - ti[6] * alpha_i; \ - CO[13] A_OP ti[6] * alpha_r + tr[6] * alpha_i; \ - CO[14] A_OP tr[7] * alpha_r - ti[7] * alpha_i; \ - CO[15] A_OP ti[7] * alpha_r + tr[7] * alpha_i; +#define SAVE_ACC_COMPLEX_21_4 \ + BUILTIN_MMA_DISASSEMBLE_ACC_8 \ + COMP_MUL(tr[0], res[ 0], res[ 3], ti[0], res[ 1], res[ 2]) \ + COMP_MUL(tr[1], res[ 4], res[ 7], ti[1], res[ 5], res[ 6]) \ + COMP_MUL(tr[2], res[ 8], res[11], ti[2], res[ 9], res[10]) \ + COMP_MUL(tr[3], res[12], res[15], ti[3], res[13], res[14]) \ + COMP_MUL(tr[4], res[16], res[19], ti[4], res[17], res[18]) \ + COMP_MUL(tr[5], res[20], res[23], ti[5], res[21], res[22]) \ + COMP_MUL(tr[6], res[24], res[27], ti[6], res[25], res[26]) \ + COMP_MUL(tr[7], res[28], res[31], ti[7], res[29], res[30]) \ + COMP_MAC(tr[0], res[32], res[35], ti[0], res[33], res[34]) \ + COMP_MAC(tr[1], res[36], res[39], ti[1], res[37], res[38]) \ + COMP_MAC(tr[2], res[40], res[43], ti[2], res[41], res[42]) \ + COMP_MAC(tr[3], res[44], res[47], ti[3], res[45], res[46]) \ + COMP_MAC(tr[4], res[48], res[51], ti[4], res[49], res[50]) \ + COMP_MAC(tr[5], res[52], res[55], ti[5], res[53], res[54]) \ + COMP_MAC(tr[6], res[56], res[59], ti[6], res[57], res[58]) \ + COMP_MAC(tr[7], res[60], res[63], ti[7], res[61], res[62]) \ + CO[ 0] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ + CO[ 1] A_OP ti[0] * alpha_r + tr[0] * alpha_i; \ + CO[ 2] A_OP tr[1] * alpha_r - ti[1] * alpha_i; \ + CO[ 3] A_OP ti[1] * alpha_r + tr[1] * alpha_i; \ + CO[ 4] A_OP tr[2] * alpha_r - ti[2] * alpha_i; \ + CO[ 5] A_OP ti[2] * alpha_r + tr[2] * alpha_i; \ + CO[ 6] A_OP tr[3] * alpha_r - ti[3] * alpha_i; \ + CO[ 7] A_OP ti[3] * alpha_r + tr[3] * alpha_i; \ + CO[ 8] A_OP tr[4] * alpha_r - ti[4] * alpha_i; \ + CO[ 9] A_OP ti[4] * alpha_r + tr[4] * alpha_i; \ + CO[10] A_OP tr[5] * alpha_r - ti[5] * alpha_i; \ + CO[11] A_OP ti[5] * alpha_r + tr[5] * alpha_i; \ + CO[12] A_OP tr[6] * alpha_r - ti[6] * alpha_i; \ + CO[13] A_OP ti[6] * alpha_r + tr[6] * alpha_i; \ + CO[14] A_OP tr[7] * alpha_r - ti[7] * alpha_i; \ + CO[15] A_OP ti[7] * alpha_r + tr[7] * alpha_i; -#define SAVE_ACC_COMPLEX_22_1 \ - __builtin_mma_disassemble_acc ((void *)result, &acc0); \ - __builtin_mma_disassemble_acc ((void *)(&result[4]), &acc1); \ - COMP_MUL(tr[0], res[0], res[3], ti[0], res[1], res[2]) \ - COMP_MUL(tr[1], res[4], res[7], ti[1], res[5], res[6]) \ - COMP_MUL(tr[2], res[8], res[11], ti[2], res[9], res[10]) \ - COMP_MUL(tr[3], res[12], res[15], ti[3], res[13], res[14] ) \ - CO[0] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ - CO[1] A_OP ti[0] * alpha_r + tr[0] * alpha_i; \ - CO[2] A_OP tr[1] * alpha_r - ti[1] * alpha_i; \ - CO[3] A_OP ti[1] * alpha_r + tr[1] * alpha_i; \ - CO[2*ldc+0] A_OP tr[2] * alpha_r - ti[2] * alpha_i; \ - CO[2*ldc+1] A_OP ti[2] * alpha_r + tr[2] * alpha_i; \ - CO[2*ldc+2] A_OP tr[3] * alpha_r - ti[3] * alpha_i; \ - CO[2*ldc+3] A_OP ti[3] * alpha_r + tr[3] * alpha_i; +#define SAVE_ACC_COMPLEX_22_1 \ + __builtin_mma_disassemble_acc ((void *)result, &acc0); \ + __builtin_mma_disassemble_acc ((void *)(&result[4]), &acc1); \ + COMP_MUL(tr[0], res[0], res[3], ti[0], res[1], res[2]) \ + COMP_MUL(tr[1], res[4], res[7], ti[1], res[5], res[6]) \ + COMP_MUL(tr[2], res[8], res[11], ti[2], res[9], res[10]) \ + COMP_MUL(tr[3], res[12], res[15], ti[3], res[13], res[14] ) \ + CO[0] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ + CO[1] A_OP ti[0] * alpha_r + tr[0] * alpha_i; \ + CO[2] A_OP tr[1] * alpha_r - ti[1] * alpha_i; \ + CO[3] A_OP ti[1] * alpha_r + tr[1] * alpha_i; \ + CO[2*ldc+0] A_OP tr[2] * alpha_r - ti[2] * alpha_i; \ + CO[2*ldc+1] A_OP ti[2] * alpha_r + tr[2] * alpha_i; \ + CO[2*ldc+2] A_OP tr[3] * alpha_r - ti[3] * alpha_i; \ + CO[2*ldc+3] A_OP ti[3] * alpha_r + tr[3] * alpha_i; -#define SAVE_ACC_COMPLEX_22_2(ACC1, ACC2, CI) \ - __builtin_mma_disassemble_acc ((void *)result, ACC1); \ - __builtin_mma_disassemble_acc ((void *)(&result[4]), ACC2); \ - COMP_MUL(tr[0], res[0], res[3], ti[0], res[1], res[2]) \ - COMP_MUL(tr[1], res[4], res[7], ti[1], res[5], res[6]) \ - COMP_MUL(tr[2], res[8], res[11], ti[2], res[9], res[10]) \ - COMP_MUL(tr[3], res[12], res[15], ti[3], res[13], res[14]) \ - CO[CI+0] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ - CO[CI+1] A_OP ti[0] * alpha_r + tr[0] * alpha_i; \ - CO[CI+2] A_OP tr[1] * alpha_r - ti[1] * alpha_i; \ - CO[CI+3] A_OP ti[1] * alpha_r + tr[1] * alpha_i; \ - CO[2*ldc+CI+0] A_OP tr[2] * alpha_r - ti[2] * alpha_i; \ - CO[2*ldc+CI+1] A_OP ti[2] * alpha_r + tr[2] * alpha_i; \ - CO[2*ldc+CI+2] A_OP tr[3] * alpha_r - ti[3] * alpha_i; \ - CO[2*ldc+CI+3] A_OP ti[3] * alpha_r + tr[3] * alpha_i; +#define SAVE_ACC_COMPLEX_22_2(ACC1, ACC2, CI) \ + __builtin_mma_disassemble_acc ((void *)result, ACC1); \ + __builtin_mma_disassemble_acc ((void *)(&result[4]), ACC2); \ + COMP_MUL(tr[0], res[0], res[3], ti[0], res[1], res[2]) \ + COMP_MUL(tr[1], res[4], res[7], ti[1], res[5], res[6]) \ + COMP_MUL(tr[2], res[8], res[11], ti[2], res[9], res[10]) \ + COMP_MUL(tr[3], res[12], res[15], ti[3], res[13], res[14]) \ + CO[CI+0] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ + CO[CI+1] A_OP ti[0] * alpha_r + tr[0] * alpha_i; \ + CO[CI+2] A_OP tr[1] * alpha_r - ti[1] * alpha_i; \ + CO[CI+3] A_OP ti[1] * alpha_r + tr[1] * alpha_i; \ + CO[2*ldc+CI+0] A_OP tr[2] * alpha_r - ti[2] * alpha_i; \ + CO[2*ldc+CI+1] A_OP ti[2] * alpha_r + tr[2] * alpha_i; \ + CO[2*ldc+CI+2] A_OP tr[3] * alpha_r - ti[3] * alpha_i; \ + CO[2*ldc+CI+3] A_OP ti[3] * alpha_r + tr[3] * alpha_i; #define PREFETCH1(x, y) asm volatile ("dcbt %0, %1" : : "r" (x), "b" (y) : "memory"); #if (defined(LEFT) && !defined(TRANSA)) || (!defined(LEFT) && defined(TRANSA)) #define REFRESH_TEMP_BK(x, y) \ - temp = k - off; + temp = k - off; #elif defined(LEFT) #define REFRESH_TEMP_BK(x, y) \ - temp = off + x; + temp = off + x; #else #define REFRESH_TEMP_BK(x, y) \ - temp = off + y; + temp = off + y; #endif #if (defined(LEFT) && defined(TRANSA)) || (!defined(LEFT) && !defined(TRANSA)) #define REFRESH_POINTERS(x, y) \ - BO = B; \ - REFRESH_TEMP_BK(x, y) + BO = B; \ + REFRESH_TEMP_BK(x, y) #else #define REFRESH_POINTERS(x, y) \ - AO += off * (2*x); \ - BO = B + off * (2*y); \ - REFRESH_TEMP_BK(x, y) + AO += off * (2*x); \ + BO = B + off * (2*y); \ + REFRESH_TEMP_BK(x, y) #endif #ifdef LEFT #define REFRESH_OFF(x) \ - off += x; + off += x; #else #define REFRESH_OFF(x) #endif #ifdef LEFT #define UPDATE_TEMP(x, y) \ - temp -= x; + temp -= x; #else #define UPDATE_TEMP(x, y) \ - temp -= y; + temp -= y; #endif #if (defined(LEFT) && defined(TRANSA)) || (!defined(LEFT) && !defined(TRANSA)) #define REFRESH_TMP_AFTER_SAVE(x, y) \ - temp = k - off; \ - UPDATE_TEMP(x, y) \ - AO += temp * (2*x); \ - BO += temp * (2*y); + temp = k - off; \ + UPDATE_TEMP(x, y) \ + AO += temp * (2*x); \ + BO += temp * (2*y); #else #define REFRESH_TMP_AFTER_SAVE(x, y) #endif -#define REFRESH_AFTER_SAVE(x,y) \ - REFRESH_TMP_AFTER_SAVE(x, y) \ - REFRESH_OFF(x) +#define REFRESH_AFTER_SAVE(x,y) \ + REFRESH_TMP_AFTER_SAVE(x, y) \ + REFRESH_OFF(x) /************************************************************************************* * GEMM Kernel *************************************************************************************/ int -CNAME (BLASLONG m, BLASLONG n, BLASLONG k, FLOAT alpha_r, FLOAT alpha_i, FLOAT * A, FLOAT * B, - FLOAT * C, BLASLONG ldc #ifdef TRMMKERNEL - , BLASLONG offset +CNAME (BLASLONG m, BLASLONG n, BLASLONG k, FLOAT alpha_r, FLOAT alpha_i, + FLOAT * A, FLOAT * B, FLOAT * C, BLASLONG ldc, BLASLONG offset) +#else +CNAME (BLASLONG m, BLASLONG n, BLASLONG k, FLOAT alpha_r, FLOAT alpha_i, + FLOAT * A, FLOAT * B, FLOAT * C, BLASLONG ldc) #endif - ) { - BLASLONG i1, i, l, temp; - FLOAT *AO, *BO, *CO; + BLASLONG i1, i, l, temp; + FLOAT *AO, *BO, *CO; #if defined(TRMMKERNEL) - BLASLONG off; + BLASLONG off; #endif #if defined(TRMMKERNEL) && !defined(LEFT) - off = -offset; + off = -offset; #endif - __vector_quad acc0, acc1, acc2, acc3, acc4, acc5, acc6, acc7; + __vector_quad acc0, acc1, acc2, acc3, acc4, acc5, acc6, acc7; - v4sf_t result[32]; - FLOAT *res, tr[16], ti[16]; - res = (FLOAT *) result; + v4sf_t result[32]; + FLOAT *res, tr[16], ti[16]; + res = (FLOAT *) result; - for (i1 = 0; i1 < (n >> 1); i1++) - { + for (i1 = 0; i1 < (n >> 1); i1++) { #if defined(TRMMKERNEL) && defined(LEFT) off = offset; #endif AO = A; CO = C; C += ldc<<2; - for (i = 0; i < (m >> 3); i++) - { + for (i = 0; i < (m >> 3); i++) { #if defined(TRMMKERNEL) - REFRESH_POINTERS (8, 2) + REFRESH_POINTERS (8, 2) #else - BO = B; - temp = k; -#endif - SET_ACC_ZERO() - for (l = 0; l < temp; ++l) - { - __vector_pair rowA1 = *((__vector_pair *)((void *)&AO[l<<4])); - __vector_pair rowA2 = *((__vector_pair *)((void *)&AO[(l<<4)+4])); - __vector_pair rowA3 = *((__vector_pair *)((void *)&AO[(l<<4)+8])); - __vector_pair rowA4 = *((__vector_pair *)((void *)&AO[(l<<4)+12])); - vec_t rowB1 = *(vec_t *) & BO[l<<2]; - vec_t rowB2 = *(vec_t *) & BO[(l<<2)+2]; - __builtin_mma_xvf64gerpp(&acc0, rowA1, rowB1); - __builtin_mma_xvf64gerpp(&acc1, rowA2, rowB1); - __builtin_mma_xvf64gerpp(&acc2, rowA3, rowB1); - __builtin_mma_xvf64gerpp(&acc3, rowA4, rowB1); - __builtin_mma_xvf64gerpp(&acc4, rowA1, rowB2); - __builtin_mma_xvf64gerpp(&acc5, rowA2, rowB2); - __builtin_mma_xvf64gerpp(&acc6, rowA3, rowB2); - __builtin_mma_xvf64gerpp(&acc7, rowA4, rowB2); - } - __builtin_mma_disassemble_acc ((void *)result, &acc0); - __builtin_mma_disassemble_acc ((void *)(&result[ 4]), &acc1); - __builtin_mma_disassemble_acc ((void *)(&result[ 8]), &acc2); - __builtin_mma_disassemble_acc ((void *)(&result[12]), &acc3); - __builtin_mma_disassemble_acc ((void *)(&result[16]), &acc4); - __builtin_mma_disassemble_acc ((void *)(&result[20]), &acc5); - __builtin_mma_disassemble_acc ((void *)(&result[24]), &acc6); - __builtin_mma_disassemble_acc ((void *)(&result[28]), &acc7); - COMP_MUL(tr[ 0], res[ 0], res[ 3], ti[ 0], res[ 1], res[ 2]) - COMP_MUL(tr[ 1], res[ 4], res[ 7], ti[ 1], res[ 5], res[ 6]) - COMP_MUL(tr[ 2], res[ 8], res[11], ti[ 2], res[ 9], res[10]) - COMP_MUL(tr[ 3], res[12], res[15], ti[ 3], res[13], res[14]) - COMP_MUL(tr[ 4], res[16], res[19], ti[ 4], res[17], res[18]) - COMP_MUL(tr[ 5], res[20], res[23], ti[ 5], res[21], res[22]) - COMP_MUL(tr[ 6], res[24], res[27], ti[ 6], res[25], res[26]) - COMP_MUL(tr[ 7], res[28], res[31], ti[ 7], res[29], res[30]) - COMP_MUL(tr[ 8], res[32], res[35], ti[ 8], res[33], res[34]) - COMP_MUL(tr[ 9], res[36], res[39], ti[ 9], res[37], res[38]) - COMP_MUL(tr[10], res[40], res[43], ti[10], res[41], res[42]) - COMP_MUL(tr[11], res[44], res[47], ti[11], res[45], res[46]) - COMP_MUL(tr[12], res[48], res[51], ti[12], res[49], res[50]) - COMP_MUL(tr[13], res[52], res[55], ti[13], res[53], res[54]) - COMP_MUL(tr[14], res[56], res[59], ti[14], res[57], res[58]) - COMP_MUL(tr[15], res[60], res[63], ti[15], res[61], res[62]) - CO[ 0] A_OP tr[0] * alpha_r - ti[0] * alpha_i; - CO[ 1] A_OP ti[0] * alpha_r + tr[0] * alpha_i; - CO[ 2] A_OP tr[1] * alpha_r - ti[1] * alpha_i; - CO[ 3] A_OP ti[1] * alpha_r + tr[1] * alpha_i; - CO[ 4] A_OP tr[2] * alpha_r - ti[2] * alpha_i; - CO[ 5] A_OP ti[2] * alpha_r + tr[2] * alpha_i; - CO[ 6] A_OP tr[3] * alpha_r - ti[3] * alpha_i; - CO[ 7] A_OP ti[3] * alpha_r + tr[3] * alpha_i; - CO[ 8] A_OP tr[4] * alpha_r - ti[4] * alpha_i; - CO[ 9] A_OP ti[4] * alpha_r + tr[4] * alpha_i; - CO[10] A_OP tr[5] * alpha_r - ti[5] * alpha_i; - CO[11] A_OP ti[5] * alpha_r + tr[5] * alpha_i; - CO[12] A_OP tr[6] * alpha_r - ti[6] * alpha_i; - CO[13] A_OP ti[6] * alpha_r + tr[6] * alpha_i; - CO[14] A_OP tr[7] * alpha_r - ti[7] * alpha_i; - CO[15] A_OP ti[7] * alpha_r + tr[7] * alpha_i; - CO[2*ldc+ 0] A_OP tr[ 8] * alpha_r - ti[ 8] * alpha_i; - CO[2*ldc+ 1] A_OP ti[ 8] * alpha_r + tr[ 8] * alpha_i; - CO[2*ldc+ 2] A_OP tr[ 9] * alpha_r - ti[ 9] * alpha_i; - CO[2*ldc+ 3] A_OP ti[ 9] * alpha_r + tr[ 9] * alpha_i; - CO[2*ldc+ 4] A_OP tr[10] * alpha_r - ti[10] * alpha_i; - CO[2*ldc+ 5] A_OP ti[10] * alpha_r + tr[10] * alpha_i; - CO[2*ldc+ 6] A_OP tr[11] * alpha_r - ti[11] * alpha_i; - CO[2*ldc+ 7] A_OP ti[11] * alpha_r + tr[11] * alpha_i; - CO[2*ldc+ 8] A_OP tr[12] * alpha_r - ti[12] * alpha_i; - CO[2*ldc+ 9] A_OP ti[12] * alpha_r + tr[12] * alpha_i; - CO[2*ldc+10] A_OP tr[13] * alpha_r - ti[13] * alpha_i; - CO[2*ldc+11] A_OP ti[13] * alpha_r + tr[13] * alpha_i; - CO[2*ldc+12] A_OP tr[14] * alpha_r - ti[14] * alpha_i; - CO[2*ldc+13] A_OP ti[14] * alpha_r + tr[14] * alpha_i; - CO[2*ldc+14] A_OP tr[15] * alpha_r - ti[15] * alpha_i; - CO[2*ldc+15] A_OP ti[15] * alpha_r + tr[15] * alpha_i; + BO = B; + temp = k; +#endif + SET_ACC_ZERO() + for (l = 0; l < temp; ++l) { + __vector_pair rowA1 = *((__vector_pair *)((void *)&AO[l<<4])); + __vector_pair rowA2 = *((__vector_pair *)((void *)&AO[(l<<4)+4])); + __vector_pair rowA3 = *((__vector_pair *)((void *)&AO[(l<<4)+8])); + __vector_pair rowA4 = *((__vector_pair *)((void *)&AO[(l<<4)+12])); + vec_t rowB1 = *(vec_t *) & BO[l<<2]; + vec_t rowB2 = *(vec_t *) & BO[(l<<2)+2]; + __builtin_mma_xvf64gerpp(&acc0, rowA1, rowB1); + __builtin_mma_xvf64gerpp(&acc1, rowA2, rowB1); + __builtin_mma_xvf64gerpp(&acc2, rowA3, rowB1); + __builtin_mma_xvf64gerpp(&acc3, rowA4, rowB1); + __builtin_mma_xvf64gerpp(&acc4, rowA1, rowB2); + __builtin_mma_xvf64gerpp(&acc5, rowA2, rowB2); + __builtin_mma_xvf64gerpp(&acc6, rowA3, rowB2); + __builtin_mma_xvf64gerpp(&acc7, rowA4, rowB2); + } + __builtin_mma_disassemble_acc ((void *)result, &acc0); + __builtin_mma_disassemble_acc ((void *)(&result[ 4]), &acc1); + __builtin_mma_disassemble_acc ((void *)(&result[ 8]), &acc2); + __builtin_mma_disassemble_acc ((void *)(&result[12]), &acc3); + __builtin_mma_disassemble_acc ((void *)(&result[16]), &acc4); + __builtin_mma_disassemble_acc ((void *)(&result[20]), &acc5); + __builtin_mma_disassemble_acc ((void *)(&result[24]), &acc6); + __builtin_mma_disassemble_acc ((void *)(&result[28]), &acc7); + COMP_MUL(tr[ 0], res[ 0], res[ 3], ti[ 0], res[ 1], res[ 2]) + COMP_MUL(tr[ 1], res[ 4], res[ 7], ti[ 1], res[ 5], res[ 6]) + COMP_MUL(tr[ 2], res[ 8], res[11], ti[ 2], res[ 9], res[10]) + COMP_MUL(tr[ 3], res[12], res[15], ti[ 3], res[13], res[14]) + COMP_MUL(tr[ 4], res[16], res[19], ti[ 4], res[17], res[18]) + COMP_MUL(tr[ 5], res[20], res[23], ti[ 5], res[21], res[22]) + COMP_MUL(tr[ 6], res[24], res[27], ti[ 6], res[25], res[26]) + COMP_MUL(tr[ 7], res[28], res[31], ti[ 7], res[29], res[30]) + COMP_MUL(tr[ 8], res[32], res[35], ti[ 8], res[33], res[34]) + COMP_MUL(tr[ 9], res[36], res[39], ti[ 9], res[37], res[38]) + COMP_MUL(tr[10], res[40], res[43], ti[10], res[41], res[42]) + COMP_MUL(tr[11], res[44], res[47], ti[11], res[45], res[46]) + COMP_MUL(tr[12], res[48], res[51], ti[12], res[49], res[50]) + COMP_MUL(tr[13], res[52], res[55], ti[13], res[53], res[54]) + COMP_MUL(tr[14], res[56], res[59], ti[14], res[57], res[58]) + COMP_MUL(tr[15], res[60], res[63], ti[15], res[61], res[62]) + CO[ 0] A_OP tr[0] * alpha_r - ti[0] * alpha_i; + CO[ 1] A_OP ti[0] * alpha_r + tr[0] * alpha_i; + CO[ 2] A_OP tr[1] * alpha_r - ti[1] * alpha_i; + CO[ 3] A_OP ti[1] * alpha_r + tr[1] * alpha_i; + CO[ 4] A_OP tr[2] * alpha_r - ti[2] * alpha_i; + CO[ 5] A_OP ti[2] * alpha_r + tr[2] * alpha_i; + CO[ 6] A_OP tr[3] * alpha_r - ti[3] * alpha_i; + CO[ 7] A_OP ti[3] * alpha_r + tr[3] * alpha_i; + CO[ 8] A_OP tr[4] * alpha_r - ti[4] * alpha_i; + CO[ 9] A_OP ti[4] * alpha_r + tr[4] * alpha_i; + CO[10] A_OP tr[5] * alpha_r - ti[5] * alpha_i; + CO[11] A_OP ti[5] * alpha_r + tr[5] * alpha_i; + CO[12] A_OP tr[6] * alpha_r - ti[6] * alpha_i; + CO[13] A_OP ti[6] * alpha_r + tr[6] * alpha_i; + CO[14] A_OP tr[7] * alpha_r - ti[7] * alpha_i; + CO[15] A_OP ti[7] * alpha_r + tr[7] * alpha_i; + CO[2*ldc+ 0] A_OP tr[ 8] * alpha_r - ti[ 8] * alpha_i; + CO[2*ldc+ 1] A_OP ti[ 8] * alpha_r + tr[ 8] * alpha_i; + CO[2*ldc+ 2] A_OP tr[ 9] * alpha_r - ti[ 9] * alpha_i; + CO[2*ldc+ 3] A_OP ti[ 9] * alpha_r + tr[ 9] * alpha_i; + CO[2*ldc+ 4] A_OP tr[10] * alpha_r - ti[10] * alpha_i; + CO[2*ldc+ 5] A_OP ti[10] * alpha_r + tr[10] * alpha_i; + CO[2*ldc+ 6] A_OP tr[11] * alpha_r - ti[11] * alpha_i; + CO[2*ldc+ 7] A_OP ti[11] * alpha_r + tr[11] * alpha_i; + CO[2*ldc+ 8] A_OP tr[12] * alpha_r - ti[12] * alpha_i; + CO[2*ldc+ 9] A_OP ti[12] * alpha_r + tr[12] * alpha_i; + CO[2*ldc+10] A_OP tr[13] * alpha_r - ti[13] * alpha_i; + CO[2*ldc+11] A_OP ti[13] * alpha_r + tr[13] * alpha_i; + CO[2*ldc+12] A_OP tr[14] * alpha_r - ti[14] * alpha_i; + CO[2*ldc+13] A_OP ti[14] * alpha_r + tr[14] * alpha_i; + CO[2*ldc+14] A_OP tr[15] * alpha_r - ti[15] * alpha_i; + CO[2*ldc+15] A_OP ti[15] * alpha_r + tr[15] * alpha_i; - AO += temp << 4; - BO += temp << 2; - CO += 16; + AO += temp << 4; + BO += temp << 2; + CO += 16; #if defined(TRMMKERNEL) - REFRESH_AFTER_SAVE (8, 2) + REFRESH_AFTER_SAVE (8, 2) #endif - } - if (m & 4) - { + } + if (m & 4) { #if defined(TRMMKERNEL) - REFRESH_POINTERS (4, 2) + REFRESH_POINTERS (4, 2) #else - BO = B; - temp = k; -#endif - SET_ACC_ZERO() - for (l = 0; l < (temp & (~1)); l+=2) - { - __vector_pair rowA1 = *((__vector_pair *)((void *)&AO[l<<3])); - __vector_pair rowA2 = *((__vector_pair *)((void *)&AO[(l<<3)+4])); - __vector_pair rowA3 = *((__vector_pair *)((void *)&AO[(l<<3)+8])); - __vector_pair rowA4 = *((__vector_pair *)((void *)&AO[(l<<3)+12])); - vec_t rowB1 = *(vec_t *) & BO[l<<2]; - vec_t rowB2 = *(vec_t *) & BO[(l<<2)+2]; - vec_t rowB3 = *(vec_t *) & BO[(l<<2)+4]; - vec_t rowB4 = *(vec_t *) & BO[(l<<2)+6]; - __builtin_mma_xvf64gerpp(&acc0, rowA1, rowB1); - __builtin_mma_xvf64gerpp(&acc1, rowA2, rowB1); - __builtin_mma_xvf64gerpp(&acc2, rowA1, rowB2); - __builtin_mma_xvf64gerpp(&acc3, rowA2, rowB2); - __builtin_mma_xvf64gerpp(&acc0, rowA3, rowB3); - __builtin_mma_xvf64gerpp(&acc1, rowA4, rowB3); - __builtin_mma_xvf64gerpp(&acc2, rowA3, rowB4); - __builtin_mma_xvf64gerpp(&acc3, rowA4, rowB4); - } - for (l = (temp & (~1)); l < temp; ++l) - { - __vector_pair rowA1 = *((__vector_pair *)((void *)&AO[l<<3])); - __vector_pair rowA2 = *((__vector_pair *)((void *)&AO[(l<<3)+4])); - vec_t rowB1 = *(vec_t *) & BO[l<<2]; - vec_t rowB2 = *(vec_t *) & BO[(l<<2)+2]; - __builtin_mma_xvf64gerpp(&acc0, rowA1, rowB1); - __builtin_mma_xvf64gerpp(&acc1, rowA2, rowB1); - __builtin_mma_xvf64gerpp(&acc2, rowA1, rowB2); - __builtin_mma_xvf64gerpp(&acc3, rowA2, rowB2); - } - SAVE_ACC_COMPLEX_22_2(&acc0, &acc2, 0) - SAVE_ACC_COMPLEX_22_2(&acc1, &acc3, 4) - AO += temp << 3; - BO += temp << 2; - CO += 8; + BO = B; + temp = k; +#endif + SET_ACC_ZERO() + for (l = 0; l < (temp & (~1)); l+=2) { + __vector_pair rowA1 = *((__vector_pair *)((void *)&AO[l<<3])); + __vector_pair rowA2 = *((__vector_pair *)((void *)&AO[(l<<3)+4])); + __vector_pair rowA3 = *((__vector_pair *)((void *)&AO[(l<<3)+8])); + __vector_pair rowA4 = *((__vector_pair *)((void *)&AO[(l<<3)+12])); + vec_t rowB1 = *(vec_t *) & BO[l<<2]; + vec_t rowB2 = *(vec_t *) & BO[(l<<2)+2]; + vec_t rowB3 = *(vec_t *) & BO[(l<<2)+4]; + vec_t rowB4 = *(vec_t *) & BO[(l<<2)+6]; + __builtin_mma_xvf64gerpp(&acc0, rowA1, rowB1); + __builtin_mma_xvf64gerpp(&acc1, rowA2, rowB1); + __builtin_mma_xvf64gerpp(&acc2, rowA1, rowB2); + __builtin_mma_xvf64gerpp(&acc3, rowA2, rowB2); + __builtin_mma_xvf64gerpp(&acc0, rowA3, rowB3); + __builtin_mma_xvf64gerpp(&acc1, rowA4, rowB3); + __builtin_mma_xvf64gerpp(&acc2, rowA3, rowB4); + __builtin_mma_xvf64gerpp(&acc3, rowA4, rowB4); + } + for (l = (temp & (~1)); l < temp; ++l) { + __vector_pair rowA1 = *((__vector_pair *)((void *)&AO[l<<3])); + __vector_pair rowA2 = *((__vector_pair *)((void *)&AO[(l<<3)+4])); + vec_t rowB1 = *(vec_t *) & BO[l<<2]; + vec_t rowB2 = *(vec_t *) & BO[(l<<2)+2]; + __builtin_mma_xvf64gerpp(&acc0, rowA1, rowB1); + __builtin_mma_xvf64gerpp(&acc1, rowA2, rowB1); + __builtin_mma_xvf64gerpp(&acc2, rowA1, rowB2); + __builtin_mma_xvf64gerpp(&acc3, rowA2, rowB2); + } + SAVE_ACC_COMPLEX_22_2(&acc0, &acc2, 0) + SAVE_ACC_COMPLEX_22_2(&acc1, &acc3, 4) + AO += temp << 3; + BO += temp << 2; + CO += 8; #if defined(TRMMKERNEL) - REFRESH_AFTER_SAVE (4, 2) + REFRESH_AFTER_SAVE (4, 2) #endif - } - if (m & 2) - { + } + if (m & 2) { #if defined(TRMMKERNEL) - REFRESH_POINTERS (2, 2) + REFRESH_POINTERS (2, 2) #else - BO = B; - temp = k; -#endif - SET_ACC_ZERO() - for (l = 0; l < (temp & (~3)); l+=4) - { - __vector_pair rowA1 = *((__vector_pair *)((void *)&AO[l<<2])); - __vector_pair rowA2 = *((__vector_pair *)((void *)&AO[(l<<2)+4])); - __vector_pair rowA3 = *((__vector_pair *)((void *)&AO[(l<<2)+8])); - __vector_pair rowA4 = *((__vector_pair *)((void *)&AO[(l<<2)+12])); - vec_t rowB1 = *(vec_t *) & BO[l<<2]; - vec_t rowB2 = *(vec_t *) & BO[(l<<2)+2]; - vec_t rowB3 = *(vec_t *) & BO[(l<<2)+4]; - vec_t rowB4 = *(vec_t *) & BO[(l<<2)+6]; - vec_t rowB5 = *(vec_t *) & BO[(l<<2)+8]; - vec_t rowB6 = *(vec_t *) & BO[(l<<2)+10]; - vec_t rowB7 = *(vec_t *) & BO[(l<<2)+12]; - vec_t rowB8 = *(vec_t *) & BO[(l<<2)+14]; - __builtin_mma_xvf64gerpp(&acc0, rowA1, rowB1); - __builtin_mma_xvf64gerpp(&acc1, rowA1, rowB2); - __builtin_mma_xvf64gerpp(&acc0, rowA2, rowB3); - __builtin_mma_xvf64gerpp(&acc1, rowA2, rowB4); - __builtin_mma_xvf64gerpp(&acc0, rowA3, rowB5); - __builtin_mma_xvf64gerpp(&acc1, rowA3, rowB6); - __builtin_mma_xvf64gerpp(&acc0, rowA4, rowB7); - __builtin_mma_xvf64gerpp(&acc1, rowA4, rowB8); - } - for (l = (temp & (~3)); l < temp; ++l) - { - __vector_pair rowA1 = *((__vector_pair *)((void *)&AO[l<<2])); - vec_t rowB1 = *(vec_t *) & BO[l<<2]; - vec_t rowB2 = *(vec_t *) & BO[(l<<2)+2]; - __builtin_mma_xvf64gerpp(&acc0, rowA1, rowB1); - __builtin_mma_xvf64gerpp(&acc1, rowA1, rowB2); - } - SAVE_ACC_COMPLEX_22_1 - AO += temp << 2; - BO += temp << 2; - CO += 4; + BO = B; + temp = k; +#endif + SET_ACC_ZERO() + for (l = 0; l < (temp & (~3)); l+=4) { + __vector_pair rowA1 = *((__vector_pair *)((void *)&AO[l<<2])); + __vector_pair rowA2 = *((__vector_pair *)((void *)&AO[(l<<2)+4])); + __vector_pair rowA3 = *((__vector_pair *)((void *)&AO[(l<<2)+8])); + __vector_pair rowA4 = *((__vector_pair *)((void *)&AO[(l<<2)+12])); + vec_t rowB1 = *(vec_t *) & BO[l<<2]; + vec_t rowB2 = *(vec_t *) & BO[(l<<2)+2]; + vec_t rowB3 = *(vec_t *) & BO[(l<<2)+4]; + vec_t rowB4 = *(vec_t *) & BO[(l<<2)+6]; + vec_t rowB5 = *(vec_t *) & BO[(l<<2)+8]; + vec_t rowB6 = *(vec_t *) & BO[(l<<2)+10]; + vec_t rowB7 = *(vec_t *) & BO[(l<<2)+12]; + vec_t rowB8 = *(vec_t *) & BO[(l<<2)+14]; + __builtin_mma_xvf64gerpp(&acc0, rowA1, rowB1); + __builtin_mma_xvf64gerpp(&acc1, rowA1, rowB2); + __builtin_mma_xvf64gerpp(&acc0, rowA2, rowB3); + __builtin_mma_xvf64gerpp(&acc1, rowA2, rowB4); + __builtin_mma_xvf64gerpp(&acc0, rowA3, rowB5); + __builtin_mma_xvf64gerpp(&acc1, rowA3, rowB6); + __builtin_mma_xvf64gerpp(&acc0, rowA4, rowB7); + __builtin_mma_xvf64gerpp(&acc1, rowA4, rowB8); + } + for (l = (temp & (~3)); l < temp; ++l) { + __vector_pair rowA1 = *((__vector_pair *)((void *)&AO[l<<2])); + vec_t rowB1 = *(vec_t *) & BO[l<<2]; + vec_t rowB2 = *(vec_t *) & BO[(l<<2)+2]; + __builtin_mma_xvf64gerpp(&acc0, rowA1, rowB1); + __builtin_mma_xvf64gerpp(&acc1, rowA1, rowB2); + } + SAVE_ACC_COMPLEX_22_1 + AO += temp << 2; + BO += temp << 2; + CO += 4; #if defined(TRMMKERNEL) - REFRESH_AFTER_SAVE (2, 2) + REFRESH_AFTER_SAVE (2, 2) #endif - } - if (m & 1) - { + } + if (m & 1) { #if defined(TRMMKERNEL) - REFRESH_POINTERS (1, 2) + REFRESH_POINTERS (1, 2) #else - BO = B; - temp = k; -#endif - // RIP OUT MMA STUFF! - SET_ACC_ZERO() - for (l = 0; l < (temp & (~3)); l+=4) - { - __vector_pair rowA1 = *((__vector_pair *)((void *)&AO[l<<1])); - __vector_pair rowA2 = *((__vector_pair *)((void *)&AO[(l<<1)+2])); - __vector_pair rowA3 = *((__vector_pair *)((void *)&AO[(l<<1)+4])); - __vector_pair rowA4 = *((__vector_pair *)((void *)&AO[(l<<1)+6])); - vec_t rowB1 = *(vec_t *) & BO[l<<2]; - vec_t rowB2 = *(vec_t *) & BO[(l<<2)+2]; - vec_t rowB3 = *(vec_t *) & BO[(l<<2)+4]; - vec_t rowB4 = *(vec_t *) & BO[(l<<2)+6]; - vec_t rowB5 = *(vec_t *) & BO[(l<<2)+8]; - vec_t rowB6 = *(vec_t *) & BO[(l<<2)+10]; - vec_t rowB7 = *(vec_t *) & BO[(l<<2)+12]; - vec_t rowB8 = *(vec_t *) & BO[(l<<2)+14]; - __builtin_mma_xvf64gerpp(&acc0, rowA1, rowB1); - __builtin_mma_xvf64gerpp(&acc1, rowA1, rowB2); - __builtin_mma_xvf64gerpp(&acc0, rowA2, rowB3); - __builtin_mma_xvf64gerpp(&acc1, rowA2, rowB4); - __builtin_mma_xvf64gerpp(&acc0, rowA3, rowB5); - __builtin_mma_xvf64gerpp(&acc1, rowA3, rowB6); - __builtin_mma_xvf64gerpp(&acc0, rowA4, rowB7); - __builtin_mma_xvf64gerpp(&acc1, rowA4, rowB8); - } - for (l = (temp & (~3)); l < temp; ++l) - { - __vector_pair rowA1 = *((__vector_pair *)((void *)&AO[l<<1])); - vec_t rowB1 = *(vec_t *) & BO[l<<2]; - vec_t rowB2 = *(vec_t *) & BO[(l<<2)+2]; - __builtin_mma_xvf64gerpp(&acc0, rowA1, rowB1); - __builtin_mma_xvf64gerpp(&acc1, rowA1, rowB2); - } - SAVE_ACC_COMPLEX_12 - AO += temp << 1; - BO += temp << 2; - CO += 2; + BO = B; + temp = k; +#endif + SET_ACC_ZERO() + for (l = 0; l < (temp & (~3)); l+=4) { + __vector_pair rowA1 = *((__vector_pair *)((void *)&AO[l<<1])); + __vector_pair rowA2 = *((__vector_pair *)((void *)&AO[(l<<1)+2])); + __vector_pair rowA3 = *((__vector_pair *)((void *)&AO[(l<<1)+4])); + __vector_pair rowA4 = *((__vector_pair *)((void *)&AO[(l<<1)+6])); + vec_t rowB1 = *(vec_t *) & BO[l<<2]; + vec_t rowB2 = *(vec_t *) & BO[(l<<2)+2]; + vec_t rowB3 = *(vec_t *) & BO[(l<<2)+4]; + vec_t rowB4 = *(vec_t *) & BO[(l<<2)+6]; + vec_t rowB5 = *(vec_t *) & BO[(l<<2)+8]; + vec_t rowB6 = *(vec_t *) & BO[(l<<2)+10]; + vec_t rowB7 = *(vec_t *) & BO[(l<<2)+12]; + vec_t rowB8 = *(vec_t *) & BO[(l<<2)+14]; + __builtin_mma_xvf64gerpp(&acc0, rowA1, rowB1); + __builtin_mma_xvf64gerpp(&acc1, rowA1, rowB2); + __builtin_mma_xvf64gerpp(&acc0, rowA2, rowB3); + __builtin_mma_xvf64gerpp(&acc1, rowA2, rowB4); + __builtin_mma_xvf64gerpp(&acc0, rowA3, rowB5); + __builtin_mma_xvf64gerpp(&acc1, rowA3, rowB6); + __builtin_mma_xvf64gerpp(&acc0, rowA4, rowB7); + __builtin_mma_xvf64gerpp(&acc1, rowA4, rowB8); + } + for (l = (temp & (~3)); l < temp; ++l) { + __vector_pair rowA1 = *((__vector_pair *)((void *)&AO[l<<1])); + vec_t rowB1 = *(vec_t *) & BO[l<<2]; + vec_t rowB2 = *(vec_t *) & BO[(l<<2)+2]; + __builtin_mma_xvf64gerpp(&acc0, rowA1, rowB1); + __builtin_mma_xvf64gerpp(&acc1, rowA1, rowB2); + } + SAVE_ACC_COMPLEX_12 + AO += temp << 1; + BO += temp << 2; + CO += 2; #if defined(TRMMKERNEL) - REFRESH_AFTER_SAVE (1, 2) + REFRESH_AFTER_SAVE (1, 2) #endif - } + } #if defined(TRMMKERNEL) && !defined(LEFT) off += 2; // number of values in A #endif B += k << 2; - } - if (n & 1) - { + } + if (n & 1) { #if defined(TRMMKERNEL) && defined(LEFT) off = offset; #endif AO = A; CO = C; C += ldc<<1; - for (i = 0; i < (m >> 3); i++) - { + for (i = 0; i < (m >> 3); i++) { #if defined(TRMMKERNEL) - REFRESH_POINTERS (8, 1) + REFRESH_POINTERS (8, 1) #else - BO = B; - temp = k; -#endif - SET_ACC_ZERO() - for (l = 0; l < (temp & (~1)); l+=2) - { - __vector_pair rowA1 = *((__vector_pair *)((void *)&AO[l<<4])); - __vector_pair rowA2 = *((__vector_pair *)((void *)&AO[(l<<4)+4])); - __vector_pair rowA3 = *((__vector_pair *)((void *)&AO[(l<<4)+8])); - __vector_pair rowA4 = *((__vector_pair *)((void *)&AO[(l<<4)+12])); - __vector_pair rowA5 = *((__vector_pair *)((void *)&AO[(l<<4)+16])); - __vector_pair rowA6 = *((__vector_pair *)((void *)&AO[(l<<4)+20])); - __vector_pair rowA7 = *((__vector_pair *)((void *)&AO[(l<<4)+24])); - __vector_pair rowA8 = *((__vector_pair *)((void *)&AO[(l<<4)+28])); - vec_t rowB1 = *(vec_t *) & BO[l<<1]; - vec_t rowB2 = *(vec_t *) & BO[(l<<1)+2]; - __builtin_mma_xvf64gerpp(&acc0, rowA1, rowB1); - __builtin_mma_xvf64gerpp(&acc1, rowA2, rowB1); - __builtin_mma_xvf64gerpp(&acc2, rowA3, rowB1); - __builtin_mma_xvf64gerpp(&acc3, rowA4, rowB1); - __builtin_mma_xvf64gerpp(&acc0, rowA5, rowB2); - __builtin_mma_xvf64gerpp(&acc1, rowA6, rowB2); - __builtin_mma_xvf64gerpp(&acc2, rowA7, rowB2); - __builtin_mma_xvf64gerpp(&acc3, rowA8, rowB2); - } - for (l = (temp & (~1)); l < temp; ++l) - { - __vector_pair rowA1 = *((__vector_pair *)((void *)&AO[l<<4])); - __vector_pair rowA2 = *((__vector_pair *)((void *)&AO[(l<<4)+4])); - __vector_pair rowA3 = *((__vector_pair *)((void *)&AO[(l<<4)+8])); - __vector_pair rowA4 = *((__vector_pair *)((void *)&AO[(l<<4)+12])); - vec_t rowB1 = *(vec_t *) & BO[l<<1]; - __builtin_mma_xvf64gerpp(&acc0, rowA1, rowB1); - __builtin_mma_xvf64gerpp(&acc1, rowA2, rowB1); - __builtin_mma_xvf64gerpp(&acc2, rowA3, rowB1); - __builtin_mma_xvf64gerpp(&acc3, rowA4, rowB1); - } - SAVE_ACC_COMPLEX_21_4 + BO = B; + temp = k; +#endif + SET_ACC_ZERO() + for (l = 0; l < (temp & (~1)); l+=2) { + __vector_pair rowA1 = *((__vector_pair *)((void *)&AO[l<<4])); + __vector_pair rowA2 = *((__vector_pair *)((void *)&AO[(l<<4)+4])); + __vector_pair rowA3 = *((__vector_pair *)((void *)&AO[(l<<4)+8])); + __vector_pair rowA4 = *((__vector_pair *)((void *)&AO[(l<<4)+12])); + __vector_pair rowA5 = *((__vector_pair *)((void *)&AO[(l<<4)+16])); + __vector_pair rowA6 = *((__vector_pair *)((void *)&AO[(l<<4)+20])); + __vector_pair rowA7 = *((__vector_pair *)((void *)&AO[(l<<4)+24])); + __vector_pair rowA8 = *((__vector_pair *)((void *)&AO[(l<<4)+28])); + vec_t rowB1 = *(vec_t *) & BO[l<<1]; + vec_t rowB2 = *(vec_t *) & BO[(l<<1)+2]; + __builtin_mma_xvf64gerpp(&acc0, rowA1, rowB1); + __builtin_mma_xvf64gerpp(&acc1, rowA2, rowB1); + __builtin_mma_xvf64gerpp(&acc2, rowA3, rowB1); + __builtin_mma_xvf64gerpp(&acc3, rowA4, rowB1); + __builtin_mma_xvf64gerpp(&acc0, rowA5, rowB2); + __builtin_mma_xvf64gerpp(&acc1, rowA6, rowB2); + __builtin_mma_xvf64gerpp(&acc2, rowA7, rowB2); + __builtin_mma_xvf64gerpp(&acc3, rowA8, rowB2); + } + for (l = (temp & (~1)); l < temp; ++l) { + __vector_pair rowA1 = *((__vector_pair *)((void *)&AO[l<<4])); + __vector_pair rowA2 = *((__vector_pair *)((void *)&AO[(l<<4)+4])); + __vector_pair rowA3 = *((__vector_pair *)((void *)&AO[(l<<4)+8])); + __vector_pair rowA4 = *((__vector_pair *)((void *)&AO[(l<<4)+12])); + vec_t rowB1 = *(vec_t *) & BO[l<<1]; + __builtin_mma_xvf64gerpp(&acc0, rowA1, rowB1); + __builtin_mma_xvf64gerpp(&acc1, rowA2, rowB1); + __builtin_mma_xvf64gerpp(&acc2, rowA3, rowB1); + __builtin_mma_xvf64gerpp(&acc3, rowA4, rowB1); + } + SAVE_ACC_COMPLEX_21_4 - AO += temp << 4; - BO += temp << 1; - CO += 16; + AO += temp << 4; + BO += temp << 1; + CO += 16; #if defined(TRMMKERNEL) - REFRESH_AFTER_SAVE (8, 1) + REFRESH_AFTER_SAVE (8, 1) #endif - } - if (m & 4) - { + } + if (m & 4) { #if defined(TRMMKERNEL) - REFRESH_POINTERS (4, 1) + REFRESH_POINTERS (4, 1) #else - BO = B; - temp = k; -#endif - SET_ACC_ZERO() - for (l = 0; l < (temp & (~3)); l+=4) - { - __vector_pair rowA1 = *((__vector_pair *)((void *)&AO[l<<3])); - __vector_pair rowA2 = *((__vector_pair *)((void *)&AO[(l<<3)+4])); - __vector_pair rowA3 = *((__vector_pair *)((void *)&AO[(l<<3)+8])); - __vector_pair rowA4 = *((__vector_pair *)((void *)&AO[(l<<3)+12])); - __vector_pair rowA5 = *((__vector_pair *)((void *)&AO[(l<<3)+16])); - __vector_pair rowA6 = *((__vector_pair *)((void *)&AO[(l<<3)+20])); - __vector_pair rowA7 = *((__vector_pair *)((void *)&AO[(l<<3)+24])); - __vector_pair rowA8 = *((__vector_pair *)((void *)&AO[(l<<3)+28])); - vec_t rowB1 = *(vec_t *) & BO[l<<1]; - vec_t rowB2 = *(vec_t *) & BO[(l<<1)+2]; - vec_t rowB3 = *(vec_t *) & BO[(l<<1)+4]; - vec_t rowB4 = *(vec_t *) & BO[(l<<1)+6]; - __builtin_mma_xvf64gerpp(&acc0, rowA1, rowB1); - __builtin_mma_xvf64gerpp(&acc1, rowA2, rowB1); - __builtin_mma_xvf64gerpp(&acc2, rowA3, rowB2); - __builtin_mma_xvf64gerpp(&acc3, rowA4, rowB2); - __builtin_mma_xvf64gerpp(&acc4, rowA5, rowB3); - __builtin_mma_xvf64gerpp(&acc5, rowA6, rowB3); - __builtin_mma_xvf64gerpp(&acc6, rowA7, rowB4); - __builtin_mma_xvf64gerpp(&acc7, rowA8, rowB4); - } - for (l = (temp & (~3)); l < temp; ++l) - { - __vector_pair rowA1 = *((__vector_pair *)((void *)&AO[l<<3])); - __vector_pair rowA2 = *((__vector_pair *)((void *)&AO[(l<<3)+4])); - vec_t rowB1 = *(vec_t *) & BO[l<<1]; - __builtin_mma_xvf64gerpp(&acc0, rowA1, rowB1); - __builtin_mma_xvf64gerpp(&acc1, rowA2, rowB1); - } - SAVE_ACC_COMPLEX_21_2 - AO += temp << 3; - BO += temp << 1; - CO += 8; + BO = B; + temp = k; +#endif + SET_ACC_ZERO() + for (l = 0; l < (temp & (~3)); l+=4) { + __vector_pair rowA1 = *((__vector_pair *)((void *)&AO[l<<3])); + __vector_pair rowA2 = *((__vector_pair *)((void *)&AO[(l<<3)+4])); + __vector_pair rowA3 = *((__vector_pair *)((void *)&AO[(l<<3)+8])); + __vector_pair rowA4 = *((__vector_pair *)((void *)&AO[(l<<3)+12])); + __vector_pair rowA5 = *((__vector_pair *)((void *)&AO[(l<<3)+16])); + __vector_pair rowA6 = *((__vector_pair *)((void *)&AO[(l<<3)+20])); + __vector_pair rowA7 = *((__vector_pair *)((void *)&AO[(l<<3)+24])); + __vector_pair rowA8 = *((__vector_pair *)((void *)&AO[(l<<3)+28])); + vec_t rowB1 = *(vec_t *) & BO[l<<1]; + vec_t rowB2 = *(vec_t *) & BO[(l<<1)+2]; + vec_t rowB3 = *(vec_t *) & BO[(l<<1)+4]; + vec_t rowB4 = *(vec_t *) & BO[(l<<1)+6]; + __builtin_mma_xvf64gerpp(&acc0, rowA1, rowB1); + __builtin_mma_xvf64gerpp(&acc1, rowA2, rowB1); + __builtin_mma_xvf64gerpp(&acc2, rowA3, rowB2); + __builtin_mma_xvf64gerpp(&acc3, rowA4, rowB2); + __builtin_mma_xvf64gerpp(&acc4, rowA5, rowB3); + __builtin_mma_xvf64gerpp(&acc5, rowA6, rowB3); + __builtin_mma_xvf64gerpp(&acc6, rowA7, rowB4); + __builtin_mma_xvf64gerpp(&acc7, rowA8, rowB4); + } + for (l = (temp & (~3)); l < temp; ++l) { + __vector_pair rowA1 = *((__vector_pair *)((void *)&AO[l<<3])); + __vector_pair rowA2 = *((__vector_pair *)((void *)&AO[(l<<3)+4])); + vec_t rowB1 = *(vec_t *) & BO[l<<1]; + __builtin_mma_xvf64gerpp(&acc0, rowA1, rowB1); + __builtin_mma_xvf64gerpp(&acc1, rowA2, rowB1); + } + SAVE_ACC_COMPLEX_21_2 + AO += temp << 3; + BO += temp << 1; + CO += 8; #if defined(TRMMKERNEL) - REFRESH_AFTER_SAVE (4, 1) + REFRESH_AFTER_SAVE (4, 1) #endif - } if (m & 2) - { + } + if (m & 2) { #if defined(TRMMKERNEL) - REFRESH_POINTERS (2, 1) + REFRESH_POINTERS (2, 1) #else - BO = B; - temp = k; -#endif - SET_ACC_ZERO() - for (l = 0; l < (temp & (~7)); l+=8) - { - __vector_pair rowA1 = *((__vector_pair *)((void *)&AO[l<<2])); - __vector_pair rowA2 = *((__vector_pair *)((void *)&AO[(l<<2)+4])); - __vector_pair rowA3 = *((__vector_pair *)((void *)&AO[(l<<2)+8])); - __vector_pair rowA4 = *((__vector_pair *)((void *)&AO[(l<<2)+12])); - __vector_pair rowA5 = *((__vector_pair *)((void *)&AO[(l<<2)+16])); - __vector_pair rowA6 = *((__vector_pair *)((void *)&AO[(l<<2)+20])); - __vector_pair rowA7 = *((__vector_pair *)((void *)&AO[(l<<2)+24])); - __vector_pair rowA8 = *((__vector_pair *)((void *)&AO[(l<<2)+28])); - vec_t rowB1 = *(vec_t *) & BO[l<<1]; - vec_t rowB2 = *(vec_t *) & BO[(l<<1)+2]; - vec_t rowB3 = *(vec_t *) & BO[(l<<1)+4]; - vec_t rowB4 = *(vec_t *) & BO[(l<<1)+6]; - vec_t rowB5 = *(vec_t *) & BO[(l<<1)+8]; - vec_t rowB6 = *(vec_t *) & BO[(l<<1)+10]; - vec_t rowB7 = *(vec_t *) & BO[(l<<1)+12]; - vec_t rowB8 = *(vec_t *) & BO[(l<<1)+14]; - __builtin_mma_xvf64gerpp(&acc0, rowA1, rowB1); - __builtin_mma_xvf64gerpp(&acc1, rowA2, rowB2); - __builtin_mma_xvf64gerpp(&acc2, rowA3, rowB3); - __builtin_mma_xvf64gerpp(&acc3, rowA4, rowB4); - __builtin_mma_xvf64gerpp(&acc4, rowA5, rowB5); - __builtin_mma_xvf64gerpp(&acc5, rowA6, rowB6); - __builtin_mma_xvf64gerpp(&acc6, rowA7, rowB7); - __builtin_mma_xvf64gerpp(&acc7, rowA8, rowB8); - } - for (l = (temp & (~7)); l < temp; ++l) - { - __vector_pair rowA1 = *((__vector_pair *)((void *)&AO[l<<2])); - vec_t rowB1 = *(vec_t *) & BO[l<<1]; - __builtin_mma_xvf64gerpp(&acc0, rowA1, rowB1); - } - SAVE_ACC_COMPLEX_21_1 - AO += temp << 2; - BO += temp << 1; - CO += 4; + BO = B; + temp = k; +#endif + SET_ACC_ZERO() + for (l = 0; l < (temp & (~7)); l+=8) { + __vector_pair rowA1 = *((__vector_pair *)((void *)&AO[l<<2])); + __vector_pair rowA2 = *((__vector_pair *)((void *)&AO[(l<<2)+4])); + __vector_pair rowA3 = *((__vector_pair *)((void *)&AO[(l<<2)+8])); + __vector_pair rowA4 = *((__vector_pair *)((void *)&AO[(l<<2)+12])); + __vector_pair rowA5 = *((__vector_pair *)((void *)&AO[(l<<2)+16])); + __vector_pair rowA6 = *((__vector_pair *)((void *)&AO[(l<<2)+20])); + __vector_pair rowA7 = *((__vector_pair *)((void *)&AO[(l<<2)+24])); + __vector_pair rowA8 = *((__vector_pair *)((void *)&AO[(l<<2)+28])); + vec_t rowB1 = *(vec_t *) & BO[l<<1]; + vec_t rowB2 = *(vec_t *) & BO[(l<<1)+2]; + vec_t rowB3 = *(vec_t *) & BO[(l<<1)+4]; + vec_t rowB4 = *(vec_t *) & BO[(l<<1)+6]; + vec_t rowB5 = *(vec_t *) & BO[(l<<1)+8]; + vec_t rowB6 = *(vec_t *) & BO[(l<<1)+10]; + vec_t rowB7 = *(vec_t *) & BO[(l<<1)+12]; + vec_t rowB8 = *(vec_t *) & BO[(l<<1)+14]; + __builtin_mma_xvf64gerpp(&acc0, rowA1, rowB1); + __builtin_mma_xvf64gerpp(&acc1, rowA2, rowB2); + __builtin_mma_xvf64gerpp(&acc2, rowA3, rowB3); + __builtin_mma_xvf64gerpp(&acc3, rowA4, rowB4); + __builtin_mma_xvf64gerpp(&acc4, rowA5, rowB5); + __builtin_mma_xvf64gerpp(&acc5, rowA6, rowB6); + __builtin_mma_xvf64gerpp(&acc6, rowA7, rowB7); + __builtin_mma_xvf64gerpp(&acc7, rowA8, rowB8); + } + for (l = (temp & (~7)); l < temp; ++l) { + __vector_pair rowA1 = *((__vector_pair *)((void *)&AO[l<<2])); + vec_t rowB1 = *(vec_t *) & BO[l<<1]; + __builtin_mma_xvf64gerpp(&acc0, rowA1, rowB1); + } + SAVE_ACC_COMPLEX_21_1 + AO += temp << 2; + BO += temp << 1; + CO += 4; #if defined(TRMMKERNEL) - REFRESH_AFTER_SAVE (2, 1) + REFRESH_AFTER_SAVE (2, 1) #endif - } - if (m & 1) - { + } + if (m & 1) { #if defined(TRMMKERNEL) - REFRESH_POINTERS (1, 1) + REFRESH_POINTERS (1, 1) #else - BO = B; - temp = k; -#endif - // RIP OUT MMA STUFF! - SET_ACC_ZERO() - for (l = 0; l < (temp & (~7)); l+=8) - { - __vector_pair rowA1 = *((__vector_pair *)((void *)&AO[l<<1])); - __vector_pair rowA2 = *((__vector_pair *)((void *)&AO[(l<<1)+2])); - __vector_pair rowA3 = *((__vector_pair *)((void *)&AO[(l<<1)+4])); - __vector_pair rowA4 = *((__vector_pair *)((void *)&AO[(l<<1)+6])); - __vector_pair rowA5 = *((__vector_pair *)((void *)&AO[(l<<1)+8])); - __vector_pair rowA6 = *((__vector_pair *)((void *)&AO[(l<<1)+10])); - __vector_pair rowA7 = *((__vector_pair *)((void *)&AO[(l<<1)+12])); - __vector_pair rowA8 = *((__vector_pair *)((void *)&AO[(l<<1)+14])); - vec_t rowB1 = *(vec_t *) & BO[l<<1]; - vec_t rowB2 = *(vec_t *) & BO[(l<<1)+2]; - vec_t rowB3 = *(vec_t *) & BO[(l<<1)+4]; - vec_t rowB4 = *(vec_t *) & BO[(l<<1)+6]; - vec_t rowB5 = *(vec_t *) & BO[(l<<1)+8]; - vec_t rowB6 = *(vec_t *) & BO[(l<<1)+10]; - vec_t rowB7 = *(vec_t *) & BO[(l<<1)+12]; - vec_t rowB8 = *(vec_t *) & BO[(l<<1)+14]; - __builtin_mma_xvf64gerpp(&acc0, rowA1, rowB1); - __builtin_mma_xvf64gerpp(&acc1, rowA2, rowB2); - __builtin_mma_xvf64gerpp(&acc2, rowA3, rowB3); - __builtin_mma_xvf64gerpp(&acc3, rowA4, rowB4); - __builtin_mma_xvf64gerpp(&acc4, rowA5, rowB5); - __builtin_mma_xvf64gerpp(&acc5, rowA6, rowB6); - __builtin_mma_xvf64gerpp(&acc6, rowA7, rowB7); - __builtin_mma_xvf64gerpp(&acc7, rowA8, rowB8); - } - for (l = (temp & (~7)); l < temp; ++l) - { - __vector_pair rowA1 = *((__vector_pair *)((void *)&AO[l<<1])); - vec_t rowB1 = *(vec_t *) & BO[l<<1]; - __builtin_mma_xvf64gerpp(&acc0, rowA1, rowB1); - } - SAVE_ACC_COMPLEX_11 - AO += temp << 1; - BO += temp << 1; - CO += 2; + BO = B; + temp = k; +#endif + SET_ACC_ZERO() + for (l = 0; l < (temp & (~7)); l+=8) { + __vector_pair rowA1 = *((__vector_pair *)((void *)&AO[l<<1])); + __vector_pair rowA2 = *((__vector_pair *)((void *)&AO[(l<<1)+2])); + __vector_pair rowA3 = *((__vector_pair *)((void *)&AO[(l<<1)+4])); + __vector_pair rowA4 = *((__vector_pair *)((void *)&AO[(l<<1)+6])); + __vector_pair rowA5 = *((__vector_pair *)((void *)&AO[(l<<1)+8])); + __vector_pair rowA6 = *((__vector_pair *)((void *)&AO[(l<<1)+10])); + __vector_pair rowA7 = *((__vector_pair *)((void *)&AO[(l<<1)+12])); + __vector_pair rowA8 = *((__vector_pair *)((void *)&AO[(l<<1)+14])); + vec_t rowB1 = *(vec_t *) & BO[l<<1]; + vec_t rowB2 = *(vec_t *) & BO[(l<<1)+2]; + vec_t rowB3 = *(vec_t *) & BO[(l<<1)+4]; + vec_t rowB4 = *(vec_t *) & BO[(l<<1)+6]; + vec_t rowB5 = *(vec_t *) & BO[(l<<1)+8]; + vec_t rowB6 = *(vec_t *) & BO[(l<<1)+10]; + vec_t rowB7 = *(vec_t *) & BO[(l<<1)+12]; + vec_t rowB8 = *(vec_t *) & BO[(l<<1)+14]; + __builtin_mma_xvf64gerpp(&acc0, rowA1, rowB1); + __builtin_mma_xvf64gerpp(&acc1, rowA2, rowB2); + __builtin_mma_xvf64gerpp(&acc2, rowA3, rowB3); + __builtin_mma_xvf64gerpp(&acc3, rowA4, rowB4); + __builtin_mma_xvf64gerpp(&acc4, rowA5, rowB5); + __builtin_mma_xvf64gerpp(&acc5, rowA6, rowB6); + __builtin_mma_xvf64gerpp(&acc6, rowA7, rowB7); + __builtin_mma_xvf64gerpp(&acc7, rowA8, rowB8); + } + for (l = (temp & (~7)); l < temp; ++l) { + __vector_pair rowA1 = *((__vector_pair *)((void *)&AO[l<<1])); + vec_t rowB1 = *(vec_t *) & BO[l<<1]; + __builtin_mma_xvf64gerpp(&acc0, rowA1, rowB1); + } + SAVE_ACC_COMPLEX_11 + AO += temp << 1; + BO += temp << 1; + CO += 2; #if defined(TRMMKERNEL) - REFRESH_AFTER_SAVE (1, 1) + REFRESH_AFTER_SAVE (1, 1) #endif - } + } #if defined(TRMMKERNEL) && !defined(LEFT) off += 1; // number of values in A #endif B += k << 1; - } - return 0; + } + return 0; } From f68e9989c47d2643fd72986afc59f6a8d7d07486 Mon Sep 17 00:00:00 2001 From: kseniyazaytseva Date: Fri, 2 Feb 2024 12:26:23 +0300 Subject: [PATCH 107/311] Remove zero rows/columns matcopy tests --- utest/test_extensions/test_cimatcopy.c | 32 -------------------------- utest/test_extensions/test_comatcopy.c | 32 -------------------------- utest/test_extensions/test_dimatcopy.c | 32 -------------------------- utest/test_extensions/test_domatcopy.c | 32 -------------------------- utest/test_extensions/test_simatcopy.c | 32 -------------------------- utest/test_extensions/test_somatcopy.c | 32 -------------------------- utest/test_extensions/test_zimatcopy.c | 32 -------------------------- utest/test_extensions/test_zomatcopy.c | 32 -------------------------- 8 files changed, 256 deletions(-) diff --git a/utest/test_extensions/test_cimatcopy.c b/utest/test_extensions/test_cimatcopy.c index 800f8a2d1..a4b1e30ac 100644 --- a/utest/test_extensions/test_cimatcopy.c +++ b/utest/test_extensions/test_cimatcopy.c @@ -714,38 +714,6 @@ CTEST(cimatcopy, xerbla_invalid_trans) ASSERT_EQUAL(TRUE, passed); } -/** - * Test error function for an invalid param m. - * Must be positive. - */ -CTEST(cimatcopy, xerbla_invalid_rows) -{ - blasint m = 0, n = 100; - blasint lda_src = 0, lda_dst = 100; - char order = 'C'; - char trans = 'T'; - int expected_info = 3; - - int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); - ASSERT_EQUAL(TRUE, passed); -} - -/** - * Test error function for an invalid param n. - * Must be positive. - */ -CTEST(cimatcopy, xerbla_invalid_cols) -{ - blasint m = 100, n = 0; - blasint lda_src = 100, lda_dst = 0; - char order = 'C'; - char trans = 'T'; - int expected_info = 4; - - int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); - ASSERT_EQUAL(TRUE, passed); -} - /** * Test error function for an invalid param lda_src. * If matrices are stored using row major layout, diff --git a/utest/test_extensions/test_comatcopy.c b/utest/test_extensions/test_comatcopy.c index 8a3d5ee7b..71663406a 100644 --- a/utest/test_extensions/test_comatcopy.c +++ b/utest/test_extensions/test_comatcopy.c @@ -524,38 +524,6 @@ CTEST(comatcopy, xerbla_invalid_trans) ASSERT_EQUAL(TRUE, passed); } -/** - * Test error function for an invalid param m. - * Must be positive. - */ -CTEST(comatcopy, xerbla_invalid_rows) -{ - blasint m = 0, n = 100; - blasint lda = 0, ldb = 100; - char order = 'C'; - char trans = 'T'; - int expected_info = 3; - - int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); - ASSERT_EQUAL(TRUE, passed); -} - -/** - * Test error function for an invalid param n. - * Must be positive. - */ -CTEST(comatcopy, xerbla_invalid_cols) -{ - blasint m = 100, n = 0; - blasint lda = 100, ldb = 0; - char order = 'C'; - char trans = 'T'; - int expected_info = 4; - - int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); - ASSERT_EQUAL(TRUE, passed); -} - /** * Test error function for an invalid param lda. * If matrices are stored using row major layout, diff --git a/utest/test_extensions/test_dimatcopy.c b/utest/test_extensions/test_dimatcopy.c index 4debb50e8..d2a16bbbf 100644 --- a/utest/test_extensions/test_dimatcopy.c +++ b/utest/test_extensions/test_dimatcopy.c @@ -811,38 +811,6 @@ CTEST(dimatcopy, xerbla_invalid_trans) ASSERT_EQUAL(TRUE, passed); } -/** - * Test error function for an invalid param m. - * Must be positive. - */ -CTEST(dimatcopy, xerbla_invalid_rows) -{ - blasint m = 0, n = 100; - blasint lda_src = 0, lda_dst = 100; - char order = 'C'; - char trans = 'T'; - int expected_info = 3; - - int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); - ASSERT_EQUAL(TRUE, passed); -} - -/** - * Test error function for an invalid param n. - * Must be positive. - */ -CTEST(dimatcopy, xerbla_invalid_cols) -{ - blasint m = 100, n = 0; - blasint lda_src = 100, lda_dst = 0; - char order = 'C'; - char trans = 'T'; - int expected_info = 4; - - int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); - ASSERT_EQUAL(TRUE, passed); -} - /** * Test error function for an invalid param lda_src. * If matrices are stored using row major layout, diff --git a/utest/test_extensions/test_domatcopy.c b/utest/test_extensions/test_domatcopy.c index f692e8784..e60b9c83d 100644 --- a/utest/test_extensions/test_domatcopy.c +++ b/utest/test_extensions/test_domatcopy.c @@ -536,38 +536,6 @@ CTEST(domatcopy, xerbla_invalid_trans) ASSERT_EQUAL(TRUE, passed); } -/** - * Test error function for an invalid param m. - * Must be positive. - */ -CTEST(domatcopy, xerbla_invalid_rows) -{ - blasint m = 0, n = 100; - blasint lda = 0, ldb = 100; - char order = 'C'; - char trans = 'T'; - int expected_info = 3; - - int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); - ASSERT_EQUAL(TRUE, passed); -} - -/** - * Test error function for an invalid param n. - * Must be positive. - */ -CTEST(domatcopy, xerbla_invalid_cols) -{ - blasint m = 100, n = 0; - blasint lda = 100, ldb = 0; - char order = 'C'; - char trans = 'T'; - int expected_info = 4; - - int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); - ASSERT_EQUAL(TRUE, passed); -} - /** * Test error function for an invalid param lda. * If matrices are stored using row major layout, diff --git a/utest/test_extensions/test_simatcopy.c b/utest/test_extensions/test_simatcopy.c index 0d9c44e73..cf14d360c 100644 --- a/utest/test_extensions/test_simatcopy.c +++ b/utest/test_extensions/test_simatcopy.c @@ -811,38 +811,6 @@ CTEST(simatcopy, xerbla_invalid_trans) ASSERT_EQUAL(TRUE, passed); } -/** - * Test error function for an invalid param m. - * Must be positive. - */ -CTEST(simatcopy, xerbla_invalid_rows) -{ - blasint m = 0, n = 100; - blasint lda_src = 0, lda_dst = 100; - char order = 'C'; - char trans = 'T'; - int expected_info = 3; - - int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); - ASSERT_EQUAL(TRUE, passed); -} - -/** - * Test error function for an invalid param n. - * Must be positive. - */ -CTEST(simatcopy, xerbla_invalid_cols) -{ - blasint m = 100, n = 0; - blasint lda_src = 100, lda_dst = 0; - char order = 'C'; - char trans = 'T'; - int expected_info = 4; - - int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); - ASSERT_EQUAL(TRUE, passed); -} - /** * Test error function for an invalid param lda_src. * If matrices are stored using row major layout, diff --git a/utest/test_extensions/test_somatcopy.c b/utest/test_extensions/test_somatcopy.c index c75bbc75e..b53c7cae5 100644 --- a/utest/test_extensions/test_somatcopy.c +++ b/utest/test_extensions/test_somatcopy.c @@ -536,38 +536,6 @@ CTEST(somatcopy, xerbla_invalid_trans) ASSERT_EQUAL(TRUE, passed); } -/** - * Test error function for an invalid param m. - * Must be positive. - */ -CTEST(somatcopy, xerbla_invalid_rows) -{ - blasint m = 0, n = 100; - blasint lda = 0, ldb = 100; - char order = 'C'; - char trans = 'T'; - int expected_info = 3; - - int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); - ASSERT_EQUAL(TRUE, passed); -} - -/** - * Test error function for an invalid param n. - * Must be positive. - */ -CTEST(somatcopy, xerbla_invalid_cols) -{ - blasint m = 100, n = 0; - blasint lda = 100, ldb = 0; - char order = 'C'; - char trans = 'T'; - int expected_info = 4; - - int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); - ASSERT_EQUAL(TRUE, passed); -} - /** * Test error function for an invalid param lda. * If matrices are stored using row major layout, diff --git a/utest/test_extensions/test_zimatcopy.c b/utest/test_extensions/test_zimatcopy.c index 6461ce88f..8376bc493 100644 --- a/utest/test_extensions/test_zimatcopy.c +++ b/utest/test_extensions/test_zimatcopy.c @@ -714,38 +714,6 @@ CTEST(zimatcopy, xerbla_invalid_trans) ASSERT_EQUAL(TRUE, passed); } -/** - * Test error function for an invalid param m. - * Must be positive. - */ -CTEST(zimatcopy, xerbla_invalid_rows) -{ - blasint m = 0, n = 100; - blasint lda_src = 0, lda_dst = 100; - char order = 'C'; - char trans = 'T'; - int expected_info = 3; - - int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); - ASSERT_EQUAL(TRUE, passed); -} - -/** - * Test error function for an invalid param n. - * Must be positive. - */ -CTEST(zimatcopy, xerbla_invalid_cols) -{ - blasint m = 100, n = 0; - blasint lda_src = 100, lda_dst = 0; - char order = 'C'; - char trans = 'T'; - int expected_info = 4; - - int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); - ASSERT_EQUAL(TRUE, passed); -} - /** * Test error function for an invalid param lda_src. * If matrices are stored using row major layout, diff --git a/utest/test_extensions/test_zomatcopy.c b/utest/test_extensions/test_zomatcopy.c index 8df3dd80f..495831c56 100644 --- a/utest/test_extensions/test_zomatcopy.c +++ b/utest/test_extensions/test_zomatcopy.c @@ -541,38 +541,6 @@ CTEST(zomatcopy, xerbla_invalid_trans) ASSERT_EQUAL(TRUE, passed); } -/** -* Test error function for an invalid param m. -* Must be positive. -*/ -CTEST(zomatcopy, xerbla_invalid_rows) -{ - blasint m = 0, n = 100; - blasint lda = 0, ldb = 100; - char order = 'C'; - char trans = 'T'; - int expected_info = 3; - - int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); - ASSERT_EQUAL(TRUE, passed); -} - -/** -* Test error function for an invalid param n. -* Must be positive. -*/ -CTEST(zomatcopy, xerbla_invalid_cols) -{ - blasint m = 100, n = 0; - blasint lda = 100, ldb = 0; - char order = 'C'; - char trans = 'T'; - int expected_info = 4; - - int passed = check_badargs(order, trans, m, n, lda, ldb, expected_info); - ASSERT_EQUAL(TRUE, passed); -} - /** * Test error function for an invalid param lda. * If matrices are stored using row major layout, From 441339104f5056ba8d68343667511de683d69ca6 Mon Sep 17 00:00:00 2001 From: kseniyazaytseva Date: Fri, 2 Feb 2024 13:49:39 +0300 Subject: [PATCH 108/311] fix test ext cmake build --- utest/CMakeLists.txt | 37 +++++++++++++++++++------------------ 1 file changed, 19 insertions(+), 18 deletions(-) diff --git a/utest/CMakeLists.txt b/utest/CMakeLists.txt index d78701707..c090ed511 100644 --- a/utest/CMakeLists.txt +++ b/utest/CMakeLists.txt @@ -22,6 +22,7 @@ endif () set(DIR_EXT test_extensions) set(OpenBLAS_utest_ext_src utest_main.c +${DIR_EXT}/common.c ${DIR_EXT}/xerbla.c ${DIR_EXT}/test_isamin.c ${DIR_EXT}/test_idamin.c @@ -39,14 +40,14 @@ ${DIR_EXT}/test_scamax.c ${DIR_EXT}/test_dzamax.c ${DIR_EXT}/test_zrotg.c ${DIR_EXT}/test_crotg.c -$(DIR_EXT)/test_drotmg.c -$(DIR_EXT)/test_srotmg.c -$(DIR_EXT)/test_zscal.c -$(DIR_EXT)/test_cscal.c -$(DIR_EXT)/test_domatcopy.c -$(DIR_EXT)/test_somatcopy.c -$(DIR_EXT)/test_zomatcopy.c -$(DIR_EXT)/test_comatcopy.c +${DIR_EXT}/test_drotmg.c +${DIR_EXT}/test_srotmg.c +${DIR_EXT}/test_zscal.c +${DIR_EXT}/test_cscal.c +${DIR_EXT}/test_domatcopy.c +${DIR_EXT}/test_somatcopy.c +${DIR_EXT}/test_zomatcopy.c +${DIR_EXT}/test_comatcopy.c ${DIR_EXT}/test_simatcopy.c ${DIR_EXT}/test_dimatcopy.c ${DIR_EXT}/test_cimatcopy.c @@ -59,12 +60,12 @@ ${DIR_EXT}/test_saxpby.c ${DIR_EXT}/test_daxpby.c ${DIR_EXT}/test_caxpby.c ${DIR_EXT}/test_zaxpby.c -${DIR_EXT}/test_caxpyc.c -${DIR_EXT}/test_zaxpyc.c -$(DIR_EXT)/test_cgemv_t.c -$(DIR_EXT)/test_zgemv_t.c -$(DIR_EXT)/test_cgemv_n.c -$(DIR_EXT)/test_zgemv_n.c +# ${DIR_EXT}/test_caxpyc.c +# ${DIR_EXT}/test_zaxpyc.c +${DIR_EXT}/test_cgemv_t.c +${DIR_EXT}/test_zgemv_t.c +${DIR_EXT}/test_cgemv_n.c +${DIR_EXT}/test_zgemv_n.c ${DIR_EXT}/test_crot.c ${DIR_EXT}/test_zrot.c ${DIR_EXT}/test_cgbmv.c @@ -75,10 +76,10 @@ ${DIR_EXT}/test_cgemmt.c ${DIR_EXT}/test_zgemmt.c ${DIR_EXT}/test_ztrmv.c ${DIR_EXT}/test_ctrmv.c -$(DIR_EXT)/test_ztrsv.c -$(DIR_EXT)/test_ctrsv.c -$(DIR_EXT)/test_zgemm.c -$(DIR_EXT)/test_cgemm.c +${DIR_EXT}/test_ztrsv.c +${DIR_EXT}/test_ctrsv.c +${DIR_EXT}/test_zgemm.c +${DIR_EXT}/test_cgemm.c ) # crashing on travis cl with an error code suggesting resource not found From b6949ce74c8a22f4ec2b710ac084411f6b6560b0 Mon Sep 17 00:00:00 2001 From: kseniyazaytseva Date: Fri, 2 Feb 2024 14:42:27 +0300 Subject: [PATCH 109/311] add axpyc to cmake build --- utest/CMakeLists.txt | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/utest/CMakeLists.txt b/utest/CMakeLists.txt index c090ed511..67dc489d1 100644 --- a/utest/CMakeLists.txt +++ b/utest/CMakeLists.txt @@ -60,8 +60,8 @@ ${DIR_EXT}/test_saxpby.c ${DIR_EXT}/test_daxpby.c ${DIR_EXT}/test_caxpby.c ${DIR_EXT}/test_zaxpby.c -# ${DIR_EXT}/test_caxpyc.c -# ${DIR_EXT}/test_zaxpyc.c +${DIR_EXT}/test_caxpyc.c +${DIR_EXT}/test_zaxpyc.c ${DIR_EXT}/test_cgemv_t.c ${DIR_EXT}/test_zgemv_t.c ${DIR_EXT}/test_cgemv_n.c From 4d8dee508ce415743d61042111a9d50660b2b8bb Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Sun, 4 Feb 2024 01:05:03 +0100 Subject: [PATCH 110/311] temporarily disable the CAXPY/ZAXPY kernels --- kernel/riscv64/KERNEL.C910V | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/kernel/riscv64/KERNEL.C910V b/kernel/riscv64/KERNEL.C910V index 2798a870e..066329390 100644 --- a/kernel/riscv64/KERNEL.C910V +++ b/kernel/riscv64/KERNEL.C910V @@ -42,8 +42,8 @@ ZSUMKERNEL = ../arm/zsum.c SAXPYKERNEL = axpy_vector.c DAXPYKERNEL = axpy_vector.c -CAXPYKERNEL = zaxpy_vector.c -ZAXPYKERNEL = zaxpy_vector.c +CAXPYKERNEL = zaxpy.c +ZAXPYKERNEL = zaxpy.c SAXPBYKERNEL = axpby_vector.c DAXPBYKERNEL = axpby_vector.c From 68d354814f9f846338e1988c4f609c8add419012 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Sun, 4 Feb 2024 01:14:22 +0100 Subject: [PATCH 111/311] Fix incompatible pointer type in BFLOAT16 mode --- interface/gemmt.c | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/interface/gemmt.c b/interface/gemmt.c index 01dec0c35..8fd8089d0 100644 --- a/interface/gemmt.c +++ b/interface/gemmt.c @@ -527,7 +527,7 @@ void CNAME(enum CBLAS_ORDER order, enum CBLAS_UPLO Uplo, #endif // for alignment buffer_size = (buffer_size + 3) & ~3; - STACK_ALLOC(buffer_size, FLOAT, buffer); + STACK_ALLOC(buffer_size, IFLOAT, buffer); #ifdef SMP @@ -616,7 +616,7 @@ void CNAME(enum CBLAS_ORDER order, enum CBLAS_UPLO Uplo, #endif // for alignment buffer_size = (buffer_size + 3) & ~3; - STACK_ALLOC(buffer_size, FLOAT, buffer); + STACK_ALLOC(buffer_size, IFLOAT, buffer); #ifdef SMP @@ -666,4 +666,4 @@ void CNAME(enum CBLAS_ORDER order, enum CBLAS_UPLO Uplo, IDEBUG_END; return; -} \ No newline at end of file +} From 3597827c932b90be8916f5fbaa27dd8db818ee9e Mon Sep 17 00:00:00 2001 From: gxw Date: Thu, 1 Feb 2024 16:33:58 +0800 Subject: [PATCH 112/311] utest: add axpby --- utest/CMakeLists.txt | 1 + utest/Makefile | 2 +- utest/test_axpby.c | 320 +++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 322 insertions(+), 1 deletion(-) create mode 100644 utest/test_axpby.c diff --git a/utest/CMakeLists.txt b/utest/CMakeLists.txt index 41829bd22..edfcfb7cf 100644 --- a/utest/CMakeLists.txt +++ b/utest/CMakeLists.txt @@ -17,6 +17,7 @@ else () test_swap.c test_zscal.c test_amin.c + test_axpby.c ) endif () diff --git a/utest/Makefile b/utest/Makefile index 8acaa3ea9..867f8c88c 100644 --- a/utest/Makefile +++ b/utest/Makefile @@ -12,7 +12,7 @@ UTESTBIN=openblas_utest include $(TOPDIR)/Makefile.system OBJS=utest_main.o test_min.o test_amax.o test_ismin.o test_rotmg.o test_axpy.o test_dotu.o test_dsdot.o test_swap.o test_rot.o test_dnrm2.o test_zscal.o \ - test_amin.o + test_amin.o test_axpby.o #test_rot.o test_swap.o test_axpy.o test_dotu.o test_dsdot.o test_fork.o ifneq ($(NO_LAPACK), 1) diff --git a/utest/test_axpby.c b/utest/test_axpby.c new file mode 100644 index 000000000..37ba8ad14 --- /dev/null +++ b/utest/test_axpby.c @@ -0,0 +1,320 @@ +/***************************************************************************** +Copyright (c) 2011-2024, The OpenBLAS Project +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. 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. + 3. Neither the name of the OpenBLAS project nor the names of + its contributors may be used to endorse or promote products + derived from this software without specific prior written + permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +**********************************************************************************/ + +#include "openblas_utest.h" + +#ifdef BUILD_SINGLE +CTEST(axpby, saxpby_inc_0) +{ + blasint i; + blasint N = 9, incX = 0, incY = 0; + float alpha = 1.0, beta = 2.0; + float x1[] = { 1.0, 3.0, 5.0, 7.0, 1.0, 3.0, 5.0, 7.0, 9.0 }; + float y1[] = { 2.0, 4.0, 6.0, 8.0, 2.0, 4.0, 6.0, 8.0, 10.0 }; + + BLASFUNC(saxpby)(&N, &alpha, x1, &incX, &beta, y1, &incY); + + float x2[] = { 1.0, 3.0, 5.0, 7.0, 1.0, 3.0, 5.0, 7.0, 9.0 }; + float y2[] = { 1535.0, 4.0, 6.0, 8.0, 2.0, 4.0, 6.0, 8.0, 10.0 }; + + for(i = 0; i < N; i++){ + ASSERT_DBL_NEAR_TOL(x2[i], x1[i], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(y2[i], y1[i], SINGLE_EPS); + } +} + +CTEST(axpby, saxpby_inc_1) +{ + blasint i; + blasint N = 9, incX = 1, incY = 1; + float alpha = 0.25, beta = 0.75; + float x1[] = { 1.0, 3.0, 5.0, 7.0, 1.0, 3.0, 5.0, 7.0, 9.0 }; + float y1[] = { 2.0, 4.0, 6.0, 8.0, 2.0, 4.0, 6.0, 8.0, 10.0 }; + + BLASFUNC(saxpby)(&N, &alpha, x1, &incX, &beta, y1, &incY); + + float x2[] = { 1.0, 3.0, 5.0, 7.0, 1.0, 3.0, 5.0, 7.0, 9.0 }; + float y2[] = { 1.75, 3.75, 5.75, 7.75, 1.75, 3.75, 5.75, 7.75, 9.75 }; + + for(i = 0; i < N; i++){ + ASSERT_DBL_NEAR_TOL(x2[i], x1[i], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(y2[i], y1[i], SINGLE_EPS); + } +} + +CTEST(axpby, saxpby_inc_2) +{ + blasint i; + blasint N = 9, incX = 2, incY = 2; + float alpha = 0.25, beta = 0.75; + float x1[] = { 1.0, 3.0, 5.0, 7.0, 1.0, 3.0, 5.0, 7.0, 9.0, + 1.0, 3.0, 5.0, 7.0, 1.0, 3.0, 5.0, 7.0, 9.0 }; + float y1[] = { 2.0, 4.0, 6.0, 8.0, 2.0, 4.0, 6.0, 8.0, 10.0, + 2.0, 4.0, 6.0, 8.0, 2.0, 4.0, 6.0, 8.0, 10.0 }; + + BLASFUNC(saxpby)(&N, &alpha, x1, &incX, &beta, y1, &incY); + + float x2[] = { 1.0, 3.0, 5.0, 7.0, 1.0, 3.0, 5.0, 7.0, 9.0, + 1.0, 3.0, 5.0, 7.0, 1.0, 3.0, 5.0, 7.0, 9.0 }; + float y2[] = { 1.75, 4.00, 5.75, 8.00, 1.75, 4.00, 5.75, 8.00, + 9.75, 2.00, 3.75, 6.00, 7.75, 2.00, 3.75, 6.00, + 7.75, 10.00 }; + + for(i = 0; i < 2 * N; i++){ + ASSERT_DBL_NEAR_TOL(x2[i], x1[i], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(y2[i], y1[i], SINGLE_EPS); + } +} +#endif + +#ifdef BUILD_DOUBLE +CTEST(axpby, daxpby_inc_0) +{ + blasint i; + blasint N = 9, incX = 0, incY = 0; + double alpha = 1.0, beta = 2.0; + double x1[] = { 1.0, 3.0, 5.0, 7.0, 1.0, 3.0, 5.0, 7.0, 9.0 }; + double y1[] = { 2.0, 4.0, 6.0, 8.0, 2.0, 4.0, 6.0, 8.0, 10.0 }; + + BLASFUNC(daxpby)(&N, &alpha, x1, &incX, &beta, y1, &incY); + + double x2[] = { 1.0, 3.0, 5.0, 7.0, 1.0, 3.0, 5.0, 7.0, 9.0 }; + double y2[] = { 1535.0, 4.0, 6.0, 8.0, 2.0, 4.0, 6.0, 8.0, 10.0 }; + + for(i = 0; i < N; i++){ + ASSERT_DBL_NEAR_TOL(x2[i], x1[i], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(y2[i], y1[i], DOUBLE_EPS); + } +} + +CTEST(axpby, daxpby_inc_1) +{ + blasint i; + blasint N = 9, incX = 1, incY = 1; + double alpha = 0.25, beta = 0.75; + double x1[] = { 1.0, 3.0, 5.0, 7.0, 1.0, 3.0, 5.0, 7.0, 9.0 }; + double y1[] = { 2.0, 4.0, 6.0, 8.0, 2.0, 4.0, 6.0, 8.0, 10.0 }; + + BLASFUNC(daxpby)(&N, &alpha, x1, &incX, &beta, y1, &incY); + + double x2[] = { 1.0, 3.0, 5.0, 7.0, 1.0, 3.0, 5.0, 7.0, 9.0 }; + double y2[] = { 1.75, 3.75, 5.75, 7.75, 1.75, 3.75, 5.75, 7.75, 9.75 }; + + for(i = 0; i < N; i++){ + ASSERT_DBL_NEAR_TOL(x2[i], x1[i], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(y2[i], y1[i], DOUBLE_EPS); + } +} + +CTEST(axpby, daxpby_inc_2) +{ + blasint i; + blasint N = 9, incX = 2, incY = 2; + double alpha = 0.25, beta = 0.75; + double x1[] = { 1.0, 3.0, 5.0, 7.0, 1.0, 3.0, 5.0, 7.0, 9.0, + 1.0, 3.0, 5.0, 7.0, 1.0, 3.0, 5.0, 7.0, 9.0 }; + double y1[] = { 2.0, 4.0, 6.0, 8.0, 2.0, 4.0, 6.0, 8.0, 10.0, + 2.0, 4.0, 6.0, 8.0, 2.0, 4.0, 6.0, 8.0, 10.0 }; + + BLASFUNC(daxpby)(&N, &alpha, x1, &incX, &beta, y1, &incY); + + double x2[] = { 1.0, 3.0, 5.0, 7.0, 1.0, 3.0, 5.0, 7.0, 9.0, + 1.0, 3.0, 5.0, 7.0, 1.0, 3.0, 5.0, 7.0, 9.0 }; + double y2[] = { 1.75, 4.00, 5.75, 8.00, 1.75, 4.00, 5.75, 8.00, + 9.75, 2.00, 3.75, 6.00, 7.75, 2.00, 3.75, 6.00, + 7.75, 10.00 }; + + for(i = 0; i < 2 * N; i++){ + ASSERT_DBL_NEAR_TOL(x2[i], x1[i], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(y2[i], y1[i], DOUBLE_EPS); + } +} +#endif + +#ifdef BUILD_COMPLEX +CTEST(axpby, caxpby_inc_0) +{ + blasint i; + blasint N = 9, incX = 0, incY = 0; + float alpha[] = { 1.0, 2.0 }, beta[] = { 2.0, 1.0 }; + float x1[] = { 1.0, 3.0, 5.0, 7.0, 1.0, 3.0, 5.0, 7.0, 9.0, + 1.0, 3.0, 5.0, 7.0, 1.0, 3.0, 5.0, 7.0, 9.0 }; + float y1[] = { 2.0, 4.0, 6.0, 8.0, 2.0, 4.0, 6.0, 8.0, 10.0, + 2.0, 4.0, 6.0, 8.0, 2.0, 4.0, 6.0, 8.0, 10.0 }; + + BLASFUNC(caxpby)(&N, alpha, x1, &incX, beta, y1, &incY); + + float x2[] = { 1.0, 3.0, 5.0, 7.0, 1.0, 3.0, 5.0, 7.0, 9.0, + 1.0, 3.0, 5.0, 7.0, 1.0, 3.0, 5.0, 7.0, 9.0 }; + float y2[] = { 9355.0, -8865.0, 6.0, 8.0, 2.0, 4.0, 6.0, 8.0, + 10.0, 2.0, 4.0, 6.0, 8.0, 2.0, 4.0, 6.0, 8.0, 10.0 }; + + for(i = 0; i < 2 * N; i++){ + ASSERT_DBL_NEAR_TOL(x2[i], x1[i], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(y2[i], y1[i], SINGLE_EPS); + } +} + +CTEST(axpby, caxpby_inc_1) +{ + blasint i; + blasint N = 9, incX = 1, incY = 1; + float alpha[] = { 0.25, 0.25 }, beta[] = { 0.75, 0.75 }; + float x1[] = { 1.0, 3.0, 5.0, 7.0, 1.0, 3.0, 5.0, 7.0, 9.0, + 1.0, 3.0, 5.0, 7.0, 1.0, 3.0, 5.0, 7.0, 9.0 }; + float y1[] = { 2.0, 4.0, 6.0, 8.0, 2.0, 4.0, 6.0, 8.0, 10.0, + 2.0, 4.0, 6.0, 8.0, 2.0, 4.0, 6.0, 8.0, 10.0 }; + + BLASFUNC(caxpby)(&N, alpha, x1, &incX, beta, y1, &incY); + + float x2[] = { 1.0, 3.0, 5.0, 7.0, 1.0, 3.0, 5.0, 7.0, 9.0, + 1.0, 3.0, 5.0, 7.0, 1.0, 3.0, 5.0, 7.0, 9.0 }; + float y2[] = { -2.0, 5.5, -2.0, 13.5, -2.0, 5.5, -2.0, 13.5, + 8.0, 11.5, -2.0, 9.5, 6.0, 9.5, -2.0, 9.5, -2.0, 17.5 }; + + for(i = 0; i < 2 * N; i++){ + ASSERT_DBL_NEAR_TOL(x2[i], x1[i], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(y2[i], y1[i], SINGLE_EPS); + } +} + +CTEST(axpby, caxpby_inc_2) +{ + blasint i; + blasint N = 9, incX = 2, incY = 2; + float alpha[] = { 0.25, 0.25 }, beta[] = { 0.75, 0.75 }; + float x1[] = { 1.0, 3.0, 5.0, 7.0, 1.0, 3.0, 5.0, 7.0, 9.0, + 1.0, 3.0, 5.0, 7.0, 1.0, 3.0, 5.0, 7.0, 9.0, + 1.0, 3.0, 5.0, 7.0, 1.0, 3.0, 5.0, 7.0, 9.0, + 1.0, 3.0, 5.0, 7.0, 1.0, 3.0, 5.0, 7.0, 9.0 }; + float y1[] = { 2.0, 4.0, 6.0, 8.0, 2.0, 4.0, 6.0, 8.0, 10.0, + 2.0, 4.0, 6.0, 8.0, 2.0, 4.0, 6.0, 8.0, 10.0, + 2.0, 4.0, 6.0, 8.0, 2.0, 4.0, 6.0, 8.0, 10.0, + 2.0, 4.0, 6.0, 8.0, 2.0, 4.0, 6.0, 8.0, 10.0 }; + + BLASFUNC(caxpby)(&N, &alpha, x1, &incX, &beta, y1, &incY); + + float x2[] = { 1.0, 3.0, 5.0, 7.0, 1.0, 3.0, 5.0, 7.0, 9.0, + 1.0, 3.0, 5.0, 7.0, 1.0, 3.0, 5.0, 7.0, 9.0, + 1.0, 3.0, 5.0, 7.0, 1.0, 3.0, 5.0, 7.0, 9.0, + 1.0, 3.0, 5.0, 7.0, 1.0, 3.0, 5.0, 7.0, 9.0 }; + float y2[] = { -2.0, 5.5, 6.0, 8.0, -2.0, 5.5, 6.0, 8.0, 8.0, + 11.5, 4.0, 6.0, 6.0, 9.5, 4.0, 6.0, -2.0, 17.5, + 2.0, 4.0, -2.0, 13.5, 2.0, 4.0, -2.0, 13.5, 10.0, + 2.0, -2.0, 9.5, 8.0, 2.0, -2.0, 9.5, 8.0, 10.0 }; + + for(i = 0; i < 4 * N; i++){ + ASSERT_DBL_NEAR_TOL(x2[i], x1[i], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(y2[i], y1[i], SINGLE_EPS); + } +} +#endif + +#ifdef BUILD_COMPLEX16 +CTEST(axpby, zaxpby_inc_0) +{ + blasint i; + blasint N = 9, incX = 0, incY = 0; + double alpha[] = { 1.0, 2.0 }, beta[] = { 2.0, 1.0 }; + double x1[] = { 1.0, 3.0, 5.0, 7.0, 1.0, 3.0, 5.0, 7.0, 9.0, + 1.0, 3.0, 5.0, 7.0, 1.0, 3.0, 5.0, 7.0, 9.0 }; + double y1[] = { 2.0, 4.0, 6.0, 8.0, 2.0, 4.0, 6.0, 8.0, 10.0, + 2.0, 4.0, 6.0, 8.0, 2.0, 4.0, 6.0, 8.0, 10.0 }; + + BLASFUNC(zaxpby)(&N, alpha, x1, &incX, beta, y1, &incY); + + double x2[] = { 1.0, 3.0, 5.0, 7.0, 1.0, 3.0, 5.0, 7.0, 9.0, + 1.0, 3.0, 5.0, 7.0, 1.0, 3.0, 5.0, 7.0, 9.0 }; + double y2[] = { 9355.0, -8865.0, 6.0, 8.0, 2.0, 4.0, 6.0, 8.0, + 10.0, 2.0, 4.0, 6.0, 8.0, 2.0, 4.0, 6.0, 8.0, 10.0 }; + + for(i = 0; i < 2 * N; i++){ + ASSERT_DBL_NEAR_TOL(x2[i], x1[i], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(y2[i], y1[i], DOUBLE_EPS); + } +} + +CTEST(axpby, zaxpby_inc_1) +{ + blasint i; + blasint N = 9, incX = 1, incY = 1; + double alpha[] = { 0.25, 0.25 }, beta[] = { 0.75, 0.75 }; + double x1[] = { 1.0, 3.0, 5.0, 7.0, 1.0, 3.0, 5.0, 7.0, 9.0, + 1.0, 3.0, 5.0, 7.0, 1.0, 3.0, 5.0, 7.0, 9.0 }; + double y1[] = { 2.0, 4.0, 6.0, 8.0, 2.0, 4.0, 6.0, 8.0, 10.0, + 2.0, 4.0, 6.0, 8.0, 2.0, 4.0, 6.0, 8.0, 10.0 }; + + BLASFUNC(zaxpby)(&N, alpha, x1, &incX, beta, y1, &incY); + + double x2[] = { 1.0, 3.0, 5.0, 7.0, 1.0, 3.0, 5.0, 7.0, 9.0, + 1.0, 3.0, 5.0, 7.0, 1.0, 3.0, 5.0, 7.0, 9.0 }; + double y2[] = { -2.0, 5.5, -2.0, 13.5, -2.0, 5.5, -2.0, 13.5, + 8.0, 11.5, -2.0, 9.5, 6.0, 9.5, -2.0, 9.5, -2.0, 17.5 }; + + for(i = 0; i < 2 * N; i++){ + ASSERT_DBL_NEAR_TOL(x2[i], x1[i], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(y2[i], y1[i], DOUBLE_EPS); + } +} + +CTEST(axpby, zaxpby_inc_2) +{ + blasint i; + blasint N = 9, incX = 2, incY = 2; + double alpha[] = { 0.25, 0.25 }, beta[] = { 0.75, 0.75 }; + double x1[] = { 1.0, 3.0, 5.0, 7.0, 1.0, 3.0, 5.0, 7.0, 9.0, + 1.0, 3.0, 5.0, 7.0, 1.0, 3.0, 5.0, 7.0, 9.0, + 1.0, 3.0, 5.0, 7.0, 1.0, 3.0, 5.0, 7.0, 9.0, + 1.0, 3.0, 5.0, 7.0, 1.0, 3.0, 5.0, 7.0, 9.0 }; + double y1[] = { 2.0, 4.0, 6.0, 8.0, 2.0, 4.0, 6.0, 8.0, 10.0, + 2.0, 4.0, 6.0, 8.0, 2.0, 4.0, 6.0, 8.0, 10.0, + 2.0, 4.0, 6.0, 8.0, 2.0, 4.0, 6.0, 8.0, 10.0, + 2.0, 4.0, 6.0, 8.0, 2.0, 4.0, 6.0, 8.0, 10.0 }; + + BLASFUNC(zaxpby)(&N, &alpha, x1, &incX, &beta, y1, &incY); + + double x2[] = { 1.0, 3.0, 5.0, 7.0, 1.0, 3.0, 5.0, 7.0, 9.0, + 1.0, 3.0, 5.0, 7.0, 1.0, 3.0, 5.0, 7.0, 9.0, + 1.0, 3.0, 5.0, 7.0, 1.0, 3.0, 5.0, 7.0, 9.0, + 1.0, 3.0, 5.0, 7.0, 1.0, 3.0, 5.0, 7.0, 9.0 }; + double y2[] = { -2.0, 5.5, 6.0, 8.0, -2.0, 5.5, 6.0, 8.0, 8.0, + 11.5, 4.0, 6.0, 6.0, 9.5, 4.0, 6.0, -2.0, 17.5, + 2.0, 4.0, -2.0, 13.5, 2.0, 4.0, -2.0, 13.5, 10.0, + 2.0, -2.0, 9.5, 8.0, 2.0, -2.0, 9.5, 8.0, 10.0 }; + + for(i = 0; i < 4 * N; i++){ + ASSERT_DBL_NEAR_TOL(x2[i], x1[i], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(y2[i], y1[i], DOUBLE_EPS); + } +} +#endif From 1e1f487dc7e95c7e5a1d4234147439a5f4bca070 Mon Sep 17 00:00:00 2001 From: gxw Date: Thu, 1 Feb 2024 19:57:05 +0800 Subject: [PATCH 113/311] LoongArch64: Fixed {s/d}axpby --- kernel/loongarch64/axpby_lasx.S | 9 +++++++-- kernel/loongarch64/axpby_lsx.S | 9 +++++++-- 2 files changed, 14 insertions(+), 4 deletions(-) diff --git a/kernel/loongarch64/axpby_lasx.S b/kernel/loongarch64/axpby_lasx.S index f1d99cd3b..7a246ca5c 100644 --- a/kernel/loongarch64/axpby_lasx.S +++ b/kernel/loongarch64/axpby_lasx.S @@ -57,10 +57,8 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. PROLOGUE bge $r0, N, .L999 - li.d TEMP, 1 movgr2fr.d a1, $r0 ffint.s.l a1, a1 - slli.d TEMP, TEMP, BASE_SHIFT slli.d INCX, INCX, BASE_SHIFT slli.d INCY, INCY, BASE_SHIFT MTG t1, ALPHA @@ -75,6 +73,13 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. xvreplgr2vr.w VXB, t2 xvreplgr2vr.w VXZ, t3 #endif + // If incx == 0 || incy == 0, do one by one + and TEMP, INCX, INCY + or I, N, N + beqz TEMP, .L998 + + li.d TEMP, 1 + slli.d TEMP, TEMP, BASE_SHIFT srai.d I, N, 3 bne INCX, TEMP, .L20 bne INCY, TEMP, .L12 // INCX==1 and INCY!=1 diff --git a/kernel/loongarch64/axpby_lsx.S b/kernel/loongarch64/axpby_lsx.S index 45154c262..e50d4cdcc 100644 --- a/kernel/loongarch64/axpby_lsx.S +++ b/kernel/loongarch64/axpby_lsx.S @@ -57,10 +57,8 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. PROLOGUE bge $r0, N, .L999 - li.d TEMP, 1 movgr2fr.d a1, $r0 ffint.s.l a1, a1 - slli.d TEMP, TEMP, BASE_SHIFT slli.d INCX, INCX, BASE_SHIFT slli.d INCY, INCY, BASE_SHIFT MTG t1, ALPHA @@ -75,6 +73,13 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. vreplgr2vr.w VXB, t2 vreplgr2vr.w VXZ, t3 #endif + // If incx == 0 || incy == 0, do one by one + and TEMP, INCX, INCY + or I, N, N + beqz TEMP, .L998 + + li.d TEMP, 1 + slli.d TEMP, TEMP, BASE_SHIFT srai.d I, N, 3 bne INCX, TEMP, .L20 bne INCY, TEMP, .L12 // INCX==1 and INCY!=1 From 7bc93d95a1d72fe733e43aa1bea64796b123dcbb Mon Sep 17 00:00:00 2001 From: gxw Date: Wed, 24 Jan 2024 16:11:45 +0800 Subject: [PATCH 114/311] LoongArch64: Opt {c/z}axpby --- kernel/loongarch64/KERNEL.LOONGSON2K1000 | 2 + kernel/loongarch64/KERNEL.LOONGSON3R5 | 2 + kernel/loongarch64/caxpby_lasx.S | 1046 ++++++++++++++++++++++ kernel/loongarch64/caxpby_lsx.S | 1029 +++++++++++++++++++++ 4 files changed, 2079 insertions(+) create mode 100644 kernel/loongarch64/caxpby_lasx.S create mode 100644 kernel/loongarch64/caxpby_lsx.S diff --git a/kernel/loongarch64/KERNEL.LOONGSON2K1000 b/kernel/loongarch64/KERNEL.LOONGSON2K1000 index e27ce3bee..f4ab495e6 100644 --- a/kernel/loongarch64/KERNEL.LOONGSON2K1000 +++ b/kernel/loongarch64/KERNEL.LOONGSON2K1000 @@ -58,6 +58,8 @@ ZAXPYKERNEL = caxpy_lsx.S SAXPBYKERNEL = axpby_lsx.S DAXPBYKERNEL = axpby_lsx.S +CAXPBYKERNEL = caxpby_lsx.S +ZAXPBYKERNEL = caxpby_lsx.S SSUMKERNEL = sum_lsx.S DSUMKERNEL = sum_lsx.S diff --git a/kernel/loongarch64/KERNEL.LOONGSON3R5 b/kernel/loongarch64/KERNEL.LOONGSON3R5 index f4429cfba..bd85fab01 100644 --- a/kernel/loongarch64/KERNEL.LOONGSON3R5 +++ b/kernel/loongarch64/KERNEL.LOONGSON3R5 @@ -58,6 +58,8 @@ ZAXPYKERNEL = caxpy_lasx.S SAXPBYKERNEL = axpby_lasx.S DAXPBYKERNEL = axpby_lasx.S +CAXPBYKERNEL = caxpby_lasx.S +ZAXPBYKERNEL = caxpby_lasx.S SSUMKERNEL = sum_lasx.S DSUMKERNEL = sum_lasx.S diff --git a/kernel/loongarch64/caxpby_lasx.S b/kernel/loongarch64/caxpby_lasx.S new file mode 100644 index 000000000..c5802092e --- /dev/null +++ b/kernel/loongarch64/caxpby_lasx.S @@ -0,0 +1,1046 @@ +#define ASSEMBLER + +#include "common.h" +#define N $r4 +#define ALPHAR $f0 +#define ALPHAI $f1 +#define X $r5 +#define INCX $r6 +#define BETAR $f2 +#define BETAI $f3 +#define Y $r7 +#define INCY $r8 + +#define I $r12 +#define TEMP $r13 +#define t1 $r14 +#define t2 $r16 +#define t3 $r15 +#define t4 $r17 +#define XX $r18 +#define YY $r19 +#define a1 $f12 +#define a2 $f13 +#define a3 $f14 +#define a4 $f15 +#define s1 $f16 +#define s2 $f17 +#define s3 $f18 +#define s4 $f19 +#define VX0 $xr8 +#define VX1 $xr20 +#define VX2 $xr21 +#define VX3 $xr22 +#define VXAR $xr23 +#define VXAI $xr19 +#define VXBR $xr14 +#define VXBI $xr13 +#define VXZ $xr12 +#define x1 $xr18 +#define x2 $xr17 +#define x3 $xr16 +#define x4 $xr15 + + PROLOGUE + + bge $r0, N, .L999 + movgr2fr.d a1, $r0 + FFINT a1, a1 + slli.d INCX, INCX, ZBASE_SHIFT + slli.d INCY, INCY, ZBASE_SHIFT + MTG t1, ALPHAR + MTG t2, ALPHAI + MTG t3, BETAR + MTG t4, BETAI +#ifdef DOUBLE + xvreplgr2vr.d VXAR, t1 + xvreplgr2vr.d VXAI, t2 + xvreplgr2vr.d VXBR, t3 + xvreplgr2vr.d VXBI, t4 +#else + xvreplgr2vr.w VXAR, t1 + xvreplgr2vr.w VXAI, t2 + xvreplgr2vr.w VXBR, t3 + xvreplgr2vr.w VXBI, t4 +#endif + xvxor.v VXZ, VXZ, VXZ + // If incx == 0 || incy == 0, do one by one + and TEMP, INCX, INCY + or I, N, N + beqz TEMP, .L998 + + li.d TEMP, 1 + slli.d TEMP, TEMP, ZBASE_SHIFT +#ifdef DOUBLE + srai.d I, N, 2 +#else + srai.d I, N, 3 +#endif + bne INCX, TEMP, .L20 + bne INCY, TEMP, .L12 // INCX==1 and INCY!=1 + b .L11 // INCX==1 and INCY==1 +.L20: + bne INCY, TEMP, .L22 // INCX!=1 and INCY!=1 + b .L21 // INCX!=1 and INCY==1 + +.L11: + bge $r0, I, .L997 + CMPEQ $fcc0, BETAR, a1 + CMPEQ $fcc1, BETAI, a1 + CMPEQ $fcc2, ALPHAR, a1 + CMPEQ $fcc3, ALPHAI, a1 + bceqz $fcc0, .L13 + bceqz $fcc1, .L13 + b .L14 + .align 3 + +.L13: + bceqz $fcc2, .L114 + bceqz $fcc3, .L114 //!(beta_r == 0.0 && beta_i == 0.0) and !(alpha_r == 0.0 && alpha_i == 0.0) + b .L113 //!(beta_r == 0.0 && beta_i == 0.0) and (alpha_r == 0.0 && alpha_i == 0.0) + +.L14: + bceqz $fcc2, .L112 + bceqz $fcc3, .L112 //(beta_r == 0.0 && beta_i == 0.0) and !(alpha_r == 0.0 && alpha_i == 0.0) + b .L111 //(beta_r == 0.0 && beta_i == 0.0) and (alpha_r == 0.0 && alpha_i == 0.0) + .align 3 + +.L111: //(beta_r == 0.0 && beta_i == 0.0) and (alpha_r == 0.0 && alpha_i == 0.0) + xvst VXZ, Y, 0 * SIZE +#ifdef DOUBLE + xvst VXZ, Y, 4 * SIZE + addi.d Y, Y, 8 * SIZE +#else + xvst VXZ, Y, 8 * SIZE + addi.d Y, Y, 16 * SIZE +#endif + addi.d I, I, -1 + blt $r0, I, .L111 + b .L997 + .align 3 + +.L112: //(beta_r == 0.0 && beta_i == 0.0) and !(alpha_r == 0.0 && alpha_i == 0.0) +#ifdef DOUBLE + xvld VX0, X, 0 * SIZE + xvld VX1, X, 4 * SIZE + xvpickev.d x1, VX1, VX0 + xvpickod.d x2, VX1, VX0 +#else + xvld VX0, X, 0 * SIZE + xvld VX1, X, 8 * SIZE + xvpickev.w x1, VX1, VX0 + xvpickod.w x2, VX1, VX0 +#endif + XVFMUL x3, VXAI, x2 + XVFMUL x4, VXAI, x1 + XVMSUB x3, VXAR, x1, x3 + XVFMADD x4, VXAR, x2, x4 +#ifdef DOUBLE + xvilvl.d VX2, x4 ,x3 + xvilvh.d VX3, x4, x3 + xvst VX2, Y, 0 * SIZE + xvst VX3, Y, 4 * SIZE + addi.d X, X, 8 * SIZE + addi.d Y, Y, 8 * SIZE +#else + xvilvl.w VX2, x4 ,x3 + xvilvh.w VX3, x4, x3 + xvst VX2, Y, 0 * SIZE + xvst VX3, Y, 8 * SIZE + addi.d X, X, 16 * SIZE + addi.d Y, Y, 16 * SIZE +#endif + addi.d I, I, -1 + blt $r0, I, .L112 + b .L997 + .align 3 + +.L113: //!(beta_r == 0.0 && beta_i == 0.0) and (alpha_r == 0.0 && alpha_i == 0.0) +#ifdef DOUBLE + xvld VX0, Y, 0 * SIZE + xvld VX1, Y, 4 * SIZE + xvpickev.d x1, VX1, VX0 + xvpickod.d x2, VX1, VX0 +#else + xvld VX0, Y, 0 * SIZE + xvld VX1, Y, 8 * SIZE + xvpickev.w x1, VX1, VX0 + xvpickod.w x2, VX1, VX0 +#endif + XVFMUL x3, VXBI, x2 + XVFMUL x4, VXBI, x1 + XVMSUB x3, VXBR, x1, x3 + XVFMADD x4, VXBR, x2, x4 +#ifdef DOUBLE + xvilvl.d VX2, x4 ,x3 + xvilvh.d VX3, x4, x3 + xvst VX2, Y, 0 * SIZE + xvst VX3, Y, 4 * SIZE + addi.d X, Y, 8 * SIZE +#else + xvilvl.w VX2, x4 ,x3 + xvilvh.w VX3, x4, x3 + xvst VX2, Y, 0 * SIZE + xvst VX3, Y, 8 * SIZE + addi.d X, Y, 16 * SIZE +#endif + addi.d I, I, -1 + blt $r0, I, .L113 + b .L997 + .align 3 + +.L114: +#ifdef DOUBLE + xvld VX0, X, 0 * SIZE + xvld VX1, X, 4 * SIZE + xvld VX2, Y, 0 * SIZE + xvld VX3, Y, 4 * SIZE + xvpickev.d x1, VX1, VX0 + xvpickod.d x2, VX1, VX0 + xvpickev.d x3, VX3, VX2 + xvpickod.d x4, VX3, VX2 +#else + xvld VX0, X, 0 * SIZE + xvld VX1, X, 8 * SIZE + xvld VX2, Y, 0 * SIZE + xvld VX3, Y, 8 * SIZE + xvpickev.w x1, VX1, VX0 + xvpickod.w x2, VX1, VX0 + xvpickev.w x3, VX3, VX2 + xvpickod.w x4, VX3, VX2 +#endif + XVFMUL VX0, VXAI, x2 + XVFMUL VX1, VXAI, x1 + XVFMUL VX2, VXBI, x4 + XVFMUL VX3, VXBI, x3 + XVMSUB VX0, VXAR, x1, VX0 + XVFMADD VX1, VXAR, x2, VX1 + XVMSUB VX2, VXBR, x3, VX2 + XVFMADD VX3, VXBR, x4, VX3 + XVFADD x3, VX0, VX2 + XVFADD x4, VX1, VX3 +#ifdef DOUBLE + xvilvl.d VX2, x4 ,x3 + xvilvh.d VX3, x4, x3 + xvst VX2, Y, 0 * SIZE + xvst VX3, Y, 4 * SIZE + addi.d X, X, 8 * SIZE + addi.d Y, Y, 8 * SIZE +#else + xvilvl.w VX2, x4 ,x3 + xvilvh.w VX3, x4, x3 + xvst VX2, Y, 0 * SIZE + xvst VX3, Y, 8 * SIZE + addi.d X, X, 16 * SIZE + addi.d Y, Y, 16 * SIZE +#endif + addi.d I, I, -1 + blt $r0, I, .L114 + b .L997 + .align 3 + +.L12: // INCX==1 and INCY!=1 + bge $r0, I, .L997 + move YY, Y + .align 3 + +.L121: +#ifdef DOUBLE + xvld VX0, X, 0 * SIZE + ld.d t1, Y, 0 * SIZE + ld.d t2, Y, 1 * SIZE + add.d Y, Y, INCY + ld.d t3, Y, 0 * SIZE + ld.d t4, Y, 1 * SIZE + add.d Y, Y, INCY + xvinsgr2vr.d x3, t1, 0 + xvinsgr2vr.d x4, t2, 0 + xvinsgr2vr.d x3, t3, 2 + xvinsgr2vr.d x4, t4, 2 + + xvld VX1, X, 4 * SIZE + ld.d t1, Y, 0 * SIZE + ld.d t2, Y, 1 * SIZE + add.d Y, Y, INCY + ld.d t3, Y, 0 * SIZE + ld.d t4, Y, 1 * SIZE + xvinsgr2vr.d x3, t1, 1 + xvinsgr2vr.d x4, t2, 1 + xvinsgr2vr.d x3, t3, 3 + xvinsgr2vr.d x4, t4, 3 + add.d Y, Y, INCY + + xvpickev.d x1, VX1, VX0 + xvpickod.d x2, VX1, VX0 + xvfmul.d VX0, VXAI, x2 + xvfmul.d VX1, VXAI, x1 + xvfmul.d VX2, VXBI, x4 + xvfmul.d VX3, VXBI, x3 + xvfmsub.d VX0, VXAR, x1, VX0 + xvfmadd.d VX1, VXAR, x2, VX1 + xvfmsub.d VX2, VXBR, x3, VX2 + xvfmadd.d VX3, VXBR, x4, VX3 + xvfadd.d x3, VX0, VX2 + xvfadd.d x4, VX1, VX3 + addi.d I, I, -1 + xvstelm.d x3, YY, 0 * SIZE, 0 + xvstelm.d x4, YY, 1 * SIZE, 0 + add.d YY, YY, INCY + xvstelm.d x3, YY, 0 * SIZE, 2 + xvstelm.d x4, YY, 1 * SIZE, 2 + add.d YY, YY, INCY + xvstelm.d x3, YY, 0 * SIZE, 1 + xvstelm.d x4, YY, 1 * SIZE, 1 + add.d YY, YY, INCY + xvstelm.d x3, YY, 0 * SIZE, 3 + xvstelm.d x4, YY, 1 * SIZE, 3 + add.d YY, YY, INCY + addi.d X, X, 8 * SIZE + blt $r0, I, .L121 + b .L997 + .align 3 +#else + xvld VX0, X, 0 * SIZE + ld.d t1, Y, 0 * SIZE + ld.d t2, Y, 1 * SIZE + add.d Y, Y, INCY + ld.d t3, Y, 0 * SIZE + ld.d t4, Y, 1 * SIZE + add.d Y, Y, INCY + xvinsgr2vr.w x3, t1, 0 + xvinsgr2vr.w x4, t2, 0 + xvinsgr2vr.w x3, t3, 1 + xvinsgr2vr.w x4, t4, 1 + xvld VX1, X, 8 * SIZE + ld.d t1, Y, 0 * SIZE + ld.d t2, Y, 1 * SIZE + add.d Y, Y, INCY + ld.d t3, Y, 0 * SIZE + ld.d t4, Y, 1 * SIZE + xvinsgr2vr.w x3, t1, 4 + xvinsgr2vr.w x4, t2, 4 + xvinsgr2vr.w x3, t3, 5 + xvinsgr2vr.w x4, t4, 5 + add.d Y, Y, INCY + ld.d t1, Y, 0 * SIZE + ld.d t2, Y, 1 * SIZE + add.d Y, Y, INCY + ld.d t3, Y, 0 * SIZE + ld.d t4, Y, 1 * SIZE + add.d Y, Y, INCY + xvinsgr2vr.w x3, t1, 2 + xvinsgr2vr.w x4, t2, 2 + xvinsgr2vr.w x3, t3, 3 + xvinsgr2vr.w x4, t4, 3 + ld.d t1, Y, 0 * SIZE + ld.d t2, Y, 1 * SIZE + add.d Y, Y, INCY + ld.d t3, Y, 0 * SIZE + ld.d t4, Y, 1 * SIZE + xvinsgr2vr.w x3, t1, 6 + xvinsgr2vr.w x4, t2, 6 + xvinsgr2vr.w x3, t3, 7 + xvinsgr2vr.w x4, t4, 7 + add.d Y, Y, INCY + + xvpickev.w x1, VX1, VX0 + xvpickod.w x2, VX1, VX0 + XVFMUL VX0, VXAI, x2 + XVFMUL VX1, VXAI, x1 + XVFMUL VX2, VXBI, x4 + XVFMUL VX3, VXBI, x3 + XVMSUB VX0, VXAR, x1, VX0 + XVFMADD VX1, VXAR, x2, VX1 + XVMSUB VX2, VXBR, x3, VX2 + XVFMADD VX3, VXBR, x4, VX3 + XVFADD x3, VX0, VX2 + XVFADD x4, VX1, VX3 + addi.d I, I, -1 + xvstelm.w x3, YY, 0 * SIZE, 0 + xvstelm.w x4, YY, 1 * SIZE, 0 + add.d YY, YY, INCY + xvstelm.w x3, YY, 0 * SIZE, 1 + xvstelm.w x4, YY, 1 * SIZE, 1 + add.d YY, YY, INCY + xvstelm.w x3, YY, 0 * SIZE, 4 + xvstelm.w x4, YY, 1 * SIZE, 4 + add.d YY, YY, INCY + xvstelm.w x3, YY, 0 * SIZE, 5 + xvstelm.w x4, YY, 1 * SIZE, 5 + add.d YY, YY, INCY + xvstelm.w x3, YY, 0 * SIZE, 2 + xvstelm.w x4, YY, 1 * SIZE, 2 + add.d YY, YY, INCY + xvstelm.w x3, YY, 0 * SIZE, 3 + xvstelm.w x4, YY, 1 * SIZE, 3 + add.d YY, YY, INCY + xvstelm.w x3, YY, 0 * SIZE, 6 + xvstelm.w x4, YY, 1 * SIZE, 6 + add.d YY, YY, INCY + xvstelm.w x3, YY, 0 * SIZE, 7 + xvstelm.w x4, YY, 1 * SIZE, 7 + add.d YY, YY, INCY + addi.d X, X, 16 * SIZE + blt $r0, I, .L121 + b .L997 + .align 3 +#endif + +.L21:// INCX!=1 and INCY==1 + bge $r0, I, .L997 + .align 3 + +.L211: +#ifdef DOUBLE + xvld VX2, Y, 0 * SIZE + ld.d t1, X, 0 * SIZE + ld.d t2, X, 1 * SIZE + add.d X, X, INCX + ld.d t3, X, 0 * SIZE + ld.d t4, X, 1 * SIZE + add.d X, X, INCX + xvinsgr2vr.d x1, t1, 0 + xvinsgr2vr.d x2, t2, 0 + xvinsgr2vr.d x1, t3, 2 + xvinsgr2vr.d x2, t4, 2 + xvld VX3, Y, 4 * SIZE + ld.d t1, X, 0 * SIZE + ld.d t2, X, 1 * SIZE + add.d X, X, INCX + ld.d t3, X, 0 * SIZE + ld.d t4, X, 1 * SIZE + xvinsgr2vr.d x1, t1, 1 + xvinsgr2vr.d x2, t2, 1 + xvinsgr2vr.d x1, t3, 3 + xvinsgr2vr.d x2, t4, 3 + add.d X, X, INCX + + xvpickev.d x3, VX3, VX2 + xvpickod.d x4, VX3, VX2 + xvfmul.d VX0, VXAI, x2 + xvfmul.d VX1, VXAI, x1 + xvfmul.d VX2, VXBI, x4 + xvfmul.d VX3, VXBI, x3 + xvfmsub.d VX0, VXAR, x1, VX0 + xvfmadd.d VX1, VXAR, x2, VX1 + xvfmsub.d VX2, VXBR, x3, VX2 + xvfmadd.d VX3, VXBR, x4, VX3 + xvfadd.d x3, VX0, VX2 + xvfadd.d x4, VX1, VX3 + xvilvl.d VX2, x4 ,x3 + xvilvh.d VX3, x4, x3 + addi.d I, I, -1 + xvst VX2, Y, 0 * SIZE + xvst VX3, Y, 4 * SIZE + addi.d Y, Y, 8 * SIZE + blt $r0, I, .L211 + b .L997 + .align 3 +#else + xvld VX2, Y, 0 * SIZE + ld.d t1, X, 0 * SIZE + ld.d t2, X, 1 * SIZE + add.d X, X, INCX + ld.d t3, X, 0 * SIZE + ld.d t4, X, 1 * SIZE + add.d X, X, INCX + xvinsgr2vr.w x1, t1, 0 + xvinsgr2vr.w x2, t2, 0 + xvinsgr2vr.w x1, t3, 1 + xvinsgr2vr.w x2, t4, 1 + xvld VX3, Y, 8 * SIZE + ld.d t1, X, 0 * SIZE + ld.d t2, X, 1 * SIZE + add.d X, X, INCX + ld.d t3, X, 0 * SIZE + ld.d t4, X, 1 * SIZE + add.d X, X, INCX + xvinsgr2vr.w x1, t1, 4 + xvinsgr2vr.w x2, t2, 4 + xvinsgr2vr.w x1, t3, 5 + xvinsgr2vr.w x2, t4, 5 + ld.d t1, X, 0 * SIZE + ld.d t2, X, 1 * SIZE + add.d X, X, INCX + ld.d t3, X, 0 * SIZE + ld.d t4, X, 1 * SIZE + add.d X, X, INCX + xvinsgr2vr.w x1, t1, 2 + xvinsgr2vr.w x2, t2, 2 + xvinsgr2vr.w x1, t3, 3 + xvinsgr2vr.w x2, t4, 3 + ld.d t1, X, 0 * SIZE + ld.d t2, X, 1 * SIZE + add.d X, X, INCX + ld.d t3, X, 0 * SIZE + ld.d t4, X, 1 * SIZE + xvinsgr2vr.w x1, t1, 6 + xvinsgr2vr.w x2, t2, 6 + xvinsgr2vr.w x1, t3, 7 + xvinsgr2vr.w x2, t4, 7 + add.d X, X, INCX + + xvpickev.w x3, VX3, VX2 + xvpickod.w x4, VX3, VX2 + XVFMUL VX0, VXAI, x2 + XVFMUL VX1, VXAI, x1 + XVFMUL VX2, VXBI, x4 + XVFMUL VX3, VXBI, x3 + XVMSUB VX0, VXAR, x1, VX0 + XVFMADD VX1, VXAR, x2, VX1 + XVMSUB VX2, VXBR, x3, VX2 + XVFMADD VX3, VXBR, x4, VX3 + XVFADD x3, VX0, VX2 + XVFADD x4, VX1, VX3 + xvilvl.w VX2, x4 ,x3 + xvilvh.w VX3, x4, x3 + addi.d I, I, -1 + xvst VX2, Y, 0 * SIZE + xvst VX3, Y, 8 * SIZE + addi.d Y, Y, 16 * SIZE + blt $r0, I, .L211 + b .L997 + .align 3 +#endif + +.L22: + bge $r0, I, .L997 + move YY, Y + CMPEQ $fcc0, BETAR, a1 + CMPEQ $fcc1, BETAI, a1 + CMPEQ $fcc2, ALPHAR, a1 + CMPEQ $fcc3, ALPHAI, a1 + bceqz $fcc0, .L23 + bceqz $fcc1, .L23 + b .L24 + .align 3 + +.L23: + bceqz $fcc2, .L224 + bceqz $fcc3, .L224 //!(beta_r == 0.0 && beta_i == 0.0) and !(alpha_r == 0.0 && alpha_i == 0.0) + b .L223 //!(beta_r == 0.0 && beta_i == 0.0) and (alpha_r == 0.0 && alpha_i == 0.0) + .align 3 + +.L24: + bceqz $fcc2, .L222 + bceqz $fcc3, .L222 //(beta_r == 0.0 && beta_i == 0.0) and !(alpha_r == 0.0 && alpha_i == 0.0) + b .L221 //(beta_r == 0.0 && beta_i == 0.0) and (alpha_r == 0.0 && alpha_i == 0.0) + .align 3 + +.L221: //(beta_r == 0.0 && beta_i == 0.0) and (alpha_r == 0.0 && alpha_i == 0.0) +#ifdef DOUBLE + xvstelm.d VXZ, Y, 0, 0 + xvstelm.d VXZ, Y, 0, 0 + add.d Y, Y, INCY + xvstelm.d VXZ, Y, 0, 0 + xvstelm.d VXZ, Y, 0, 0 + add.d Y, Y, INCY + xvstelm.d VXZ, Y, 0, 0 + xvstelm.d VXZ, Y, 0, 0 + add.d Y, Y, INCY + xvstelm.d VXZ, Y, 0, 0 + xvstelm.d VXZ, Y, 0, 0 + add.d Y, Y, INCY + addi.d I, I, -1 + blt $r0, I, .L221 + b .L997 + .align 3 +#else + xvstelm.w VXZ, Y, 0, 0 + xvstelm.w VXZ, Y, 0, 0 + add.d Y, Y, INCY + xvstelm.w VXZ, Y, 0, 0 + xvstelm.w VXZ, Y, 0, 0 + add.d Y, Y, INCY + xvstelm.w VXZ, Y, 0, 0 + xvstelm.w VXZ, Y, 0, 0 + add.d Y, Y, INCY + xvstelm.w VXZ, YY, 0, 0 + xvstelm.w VXZ, YY, 0, 0 + add.d Y, Y, INCY + xvstelm.w VXZ, Y, 0, 0 + xvstelm.w VXZ, Y, 0, 0 + add.d Y, Y, INCY + xvstelm.w VXZ, Y, 0, 0 + xvstelm.w VXZ, Y, 0, 0 + add.d Y, Y, INCY + xvstelm.w VXZ, Y, 0, 0 + xvstelm.w VXZ, Y, 0, 0 + add.d Y, Y, INCY + xvstelm.w VXZ, Y, 0, 0 + xvstelm.w VXZ, Y, 0, 0 + add.d Y, Y, INCY + addi.d I, I, -1 + blt $r0, I, .L221 + b .L997 + .align 3 +#endif + +.L222: //(beta_r == 0.0 && beta_i == 0.0) and !(alpha_r == 0.0 && alpha_i == 0.0) +#ifdef DOUBLE + ld.d t1, X, 0 * SIZE + ld.d t2, X, 1 * SIZE + add.d X, X, INCX + ld.d t3, X, 0 * SIZE + ld.d t4, X, 1 * SIZE + add.d X, X, INCX + xvinsgr2vr.d x1, t1, 0 + xvinsgr2vr.d x2, t2, 0 + xvinsgr2vr.d x1, t3, 1 + xvinsgr2vr.d x2, t4, 1 + + ld.d t1, X, 0 * SIZE + ld.d t2, X, 1 * SIZE + add.d X, X, INCX + ld.d t3, X, 0 * SIZE + ld.d t4, X, 1 * SIZE + xvinsgr2vr.d x1, t1, 2 + xvinsgr2vr.d x2, t2, 2 + xvinsgr2vr.d x1, t3, 3 + xvinsgr2vr.d x2, t4, 3 + add.d X, X, INCX + xvfmul.d x3, VXAI, x2 + xvfmul.d x4, VXAI, x1 + xvfmsub.d x3, VXAR, x1, x3 + xvfmadd.d x4, VXAR, x2, x4 + addi.d I, I, -1 + xvstelm.d x3, YY, 0 * SIZE, 0 + xvstelm.d x4, YY, 1 * SIZE, 0 + add.d YY, YY, INCY + xvstelm.d x3, YY, 0 * SIZE, 1 + xvstelm.d x4, YY, 1 * SIZE, 1 + add.d YY, YY, INCY + xvstelm.d x3, YY, 0 * SIZE, 2 + xvstelm.d x4, YY, 1 * SIZE, 2 + add.d YY, YY, INCY + xvstelm.d x3, YY, 0 * SIZE, 3 + xvstelm.d x4, YY, 1 * SIZE, 3 + add.d YY, YY, INCY + blt $r0, I, .L222 + b .L997 + .align 3 +#else + ld.d t1, X, 0 * SIZE + ld.d t2, X, 1 * SIZE + add.d X, X, INCX + ld.d t3, X, 0 * SIZE + ld.d t4, X, 1 * SIZE + add.d X, X, INCX + xvinsgr2vr.w x1, t1, 0 + xvinsgr2vr.w x2, t2, 0 + xvinsgr2vr.w x1, t3, 1 + xvinsgr2vr.w x2, t4, 1 + ld.d t1, X, 0 * SIZE + ld.d t2, X, 1 * SIZE + add.d X, X, INCX + ld.d t3, X, 0 * SIZE + ld.d t4, X, 1 * SIZE + add.d X, X, INCX + xvinsgr2vr.w x1, t1, 2 + xvinsgr2vr.w x2, t2, 2 + xvinsgr2vr.w x1, t3, 3 + xvinsgr2vr.w x2, t4, 3 + + ld.d t1, X, 0 * SIZE + ld.d t2, X, 1 * SIZE + add.d X, X, INCX + ld.d t3, X, 0 * SIZE + ld.d t4, X, 1 * SIZE + add.d X, X, INCX + xvinsgr2vr.w x1, t1, 4 + xvinsgr2vr.w x2, t2, 4 + xvinsgr2vr.w x1, t3, 5 + xvinsgr2vr.w x2, t4, 5 + ld.d t1, X, 0 * SIZE + ld.d t2, X, 1 * SIZE + add.d X, X, INCX + ld.d t3, X, 0 * SIZE + ld.d t4, X, 1 * SIZE + xvinsgr2vr.w x1, t1, 6 + xvinsgr2vr.w x2, t2, 6 + xvinsgr2vr.w x1, t3, 7 + xvinsgr2vr.w x2, t4, 7 + add.d X, X, INCX + XVFMUL x3, VXAI, x2 + XVFMUL x4, VXAI, x1 + XVMSUB x3, VXAR, x1, x3 + XVFMADD x4, VXAR, x2, x4 + addi.d I, I, -1 + xvstelm.w x3, YY, 0 * SIZE, 0 + xvstelm.w x4, YY, 1 * SIZE, 0 + add.d YY, YY, INCY + xvstelm.w x3, YY, 0 * SIZE, 1 + xvstelm.w x4, YY, 1 * SIZE, 1 + add.d YY, YY, INCY + xvstelm.w x3, YY, 0 * SIZE, 2 + xvstelm.w x4, YY, 1 * SIZE, 2 + add.d YY, YY, INCY + xvstelm.w x3, YY, 0 * SIZE, 3 + xvstelm.w x4, YY, 1 * SIZE, 3 + add.d YY, YY, INCY + xvstelm.w x3, YY, 0 * SIZE, 4 + xvstelm.w x4, YY, 1 * SIZE, 4 + add.d YY, YY, INCY + xvstelm.w x3, YY, 0 * SIZE, 5 + xvstelm.w x4, YY, 1 * SIZE, 5 + add.d YY, YY, INCY + xvstelm.w x3, YY, 0 * SIZE, 6 + xvstelm.w x4, YY, 1 * SIZE, 6 + add.d YY, YY, INCY + xvstelm.w x3, YY, 0 * SIZE, 7 + xvstelm.w x4, YY, 1 * SIZE, 7 + add.d YY, YY, INCY + blt $r0, I, .L222 + b .L997 + .align 3 +#endif + +.L223: +#ifdef DOUBLE + ld.d t1, Y, 0 * SIZE + ld.d t2, Y, 1 * SIZE + add.d Y, Y, INCY + ld.d t3, Y, 0 * SIZE + ld.d t4, Y, 1 * SIZE + add.d Y, Y, INCY + xvinsgr2vr.d x1, t1, 0 + xvinsgr2vr.d x2, t2, 0 + xvinsgr2vr.d x1, t3, 1 + xvinsgr2vr.d x2, t4, 1 + + ld.d t1, Y, 0 * SIZE + ld.d t2, Y, 1 * SIZE + add.d Y, Y, INCY + ld.d t3, Y, 0 * SIZE + ld.d t4, Y, 1 * SIZE + xvinsgr2vr.d x1, t1, 2 + xvinsgr2vr.d x2, t2, 2 + xvinsgr2vr.d x1, t3, 3 + xvinsgr2vr.d x2, t4, 3 + add.d Y, Y, INCY + xvfmul.d x3, VXBI, x2 + xvfmul.d x4, VXBI, x1 + xvfmsub.d x3, VXBR, x1, x3 + xvfmadd.d x4, VXBR, x2, x4 + + addi.d I, I, -1 + xvstelm.d x3, YY, 0 * SIZE, 0 + xvstelm.d x4, YY, 1 * SIZE, 0 + add.d YY, YY, INCY + xvstelm.d x3, YY, 0 * SIZE, 1 + xvstelm.d x4, YY, 1 * SIZE, 1 + add.d YY, YY, INCY + xvstelm.d x3, YY, 0 * SIZE, 2 + xvstelm.d x4, YY, 1 * SIZE, 2 + add.d YY, YY, INCY + xvstelm.d x3, YY, 0 * SIZE, 3 + xvstelm.d x4, YY, 1 * SIZE, 3 + add.d YY, YY, INCY + blt $r0, I, .L223 + b .L997 + .align 3 +#else + ld.d t1, Y, 0 * SIZE + ld.d t2, Y, 1 * SIZE + add.d Y, Y, INCY + ld.d t3, Y, 0 * SIZE + ld.d t4, Y, 1 * SIZE + add.d Y, Y, INCY + xvinsgr2vr.w x1, t1, 0 + xvinsgr2vr.w x2, t2, 0 + xvinsgr2vr.w x1, t3, 1 + xvinsgr2vr.w x2, t4, 1 + ld.d t1, Y, 0 * SIZE + ld.d t2, Y, 1 * SIZE + add.d Y, Y, INCY + ld.d t3, Y, 0 * SIZE + ld.d t4, Y, 1 * SIZE + add.d Y, Y, INCY + xvinsgr2vr.w x1, t1, 2 + xvinsgr2vr.w x2, t2, 2 + xvinsgr2vr.w x1, t3, 3 + xvinsgr2vr.w x2, t4, 3 + + ld.d t1, Y, 0 * SIZE + ld.d t2, Y, 1 * SIZE + add.d Y, Y, INCY + ld.d t3, Y, 0 * SIZE + ld.d t4, Y, 1 * SIZE + add.d Y, Y, INCY + xvinsgr2vr.w x1, t1, 4 + xvinsgr2vr.w x2, t2, 4 + xvinsgr2vr.w x1, t3, 5 + xvinsgr2vr.w x2, t4, 5 + ld.d t1, Y, 0 * SIZE + ld.d t2, Y, 1 * SIZE + add.d Y, Y, INCY + ld.d t3, Y, 0 * SIZE + ld.d t4, Y, 1 * SIZE + xvinsgr2vr.w x1, t1, 6 + xvinsgr2vr.w x2, t2, 6 + xvinsgr2vr.w x1, t3, 7 + xvinsgr2vr.w x2, t4, 7 + add.d Y, Y, INCY + + XVFMUL x3, VXBI, x2 + XVFMUL x4, VXBI, x1 + XVMSUB x3, VXBR, x1, x3 + XVFMADD x4, VXBR, x2, x4 + addi.d I, I, -1 + xvstelm.w x3, YY, 0 * SIZE, 0 + xvstelm.w x4, YY, 1 * SIZE, 0 + add.d YY, YY, INCY + xvstelm.w x3, YY, 0 * SIZE, 1 + xvstelm.w x4, YY, 1 * SIZE, 1 + add.d YY, YY, INCY + xvstelm.w x3, YY, 0 * SIZE, 2 + xvstelm.w x4, YY, 1 * SIZE, 2 + add.d YY, YY, INCY + xvstelm.w x3, YY, 0 * SIZE, 3 + xvstelm.w x4, YY, 1 * SIZE, 3 + add.d YY, YY, INCY + xvstelm.w x3, YY, 0 * SIZE, 4 + xvstelm.w x4, YY, 1 * SIZE, 4 + add.d YY, YY, INCY + xvstelm.w x3, YY, 0 * SIZE, 5 + xvstelm.w x4, YY, 1 * SIZE, 5 + add.d YY, YY, INCY + xvstelm.w x3, YY, 0 * SIZE, 6 + xvstelm.w x4, YY, 1 * SIZE, 6 + add.d YY, YY, INCY + xvstelm.w x3, YY, 0 * SIZE, 7 + xvstelm.w x4, YY, 1 * SIZE, 7 + add.d YY, YY, INCY + blt $r0, I, .L223 + b .L997 + .align 3 +#endif + +.L224: +#ifdef DOUBLE + ld.d t1, X, 0 * SIZE + ld.d t2, X, 1 * SIZE + add.d X, X, INCX + ld.d t3, X, 0 * SIZE + ld.d t4, X, 1 * SIZE + add.d X, X, INCX + xvinsgr2vr.d x1, t1, 0 + xvinsgr2vr.d x2, t2, 0 + xvinsgr2vr.d x1, t3, 1 + xvinsgr2vr.d x2, t4, 1 + ld.d t1, X, 0 * SIZE + ld.d t2, X, 1 * SIZE + add.d X, X, INCX + ld.d t3, X, 0 * SIZE + ld.d t4, X, 1 * SIZE + add.d X, X, INCX + xvinsgr2vr.d x1, t1, 2 + xvinsgr2vr.d x2, t2, 2 + xvinsgr2vr.d x1, t3, 3 + xvinsgr2vr.d x2, t4, 3 + + ld.d t1, Y, 0 * SIZE + ld.d t2, Y, 1 * SIZE + add.d Y, Y, INCY + ld.d t3, Y, 0 * SIZE + ld.d t4, Y, 1 * SIZE + add.d Y, Y, INCY + xvinsgr2vr.d x3, t1, 0 + xvinsgr2vr.d x4, t2, 0 + xvinsgr2vr.d x3, t3, 1 + xvinsgr2vr.d x4, t4, 1 + ld.d t1, Y, 0 * SIZE + ld.d t2, Y, 1 * SIZE + add.d Y, Y, INCY + ld.d t3, Y, 0 * SIZE + ld.d t4, Y, 1 * SIZE + xvinsgr2vr.d x3, t1, 2 + xvinsgr2vr.d x4, t2, 2 + xvinsgr2vr.d x3, t3, 3 + xvinsgr2vr.d x4, t4, 3 + add.d Y, Y, INCY + xvfmul.d VX0, VXAI, x2 + xvfmul.d VX1, VXAI, x1 + xvfmul.d VX2, VXBI, x4 + xvfmul.d VX3, VXBI, x3 + xvfmsub.d VX0, VXAR, x1, VX0 + xvfmadd.d VX1, VXAR, x2, VX1 + xvfmsub.d VX2, VXBR, x3, VX2 + xvfmadd.d VX3, VXBR, x4, VX3 + xvfadd.d x3, VX0, VX2 + xvfadd.d x4, VX1, VX3 + addi.d I, I, -1 + + xvstelm.d x3, YY, 0 * SIZE, 0 + xvstelm.d x4, YY, 1 * SIZE, 0 + add.d YY, YY, INCY + xvstelm.d x3, YY, 0 * SIZE, 1 + xvstelm.d x4, YY, 1 * SIZE, 1 + add.d YY, YY, INCY + xvstelm.d x3, YY, 0 * SIZE, 2 + xvstelm.d x4, YY, 1 * SIZE, 2 + add.d YY, YY, INCY + xvstelm.d x3, YY, 0 * SIZE, 3 + xvstelm.d x4, YY, 1 * SIZE, 3 + add.d YY, YY, INCY + blt $r0, I, .L224 + b .L997 + .align 3 +#else + ld.d t1, X, 0 * SIZE + ld.d t2, X, 1 * SIZE + add.d X, X, INCX + ld.d t3, X, 0 * SIZE + ld.d t4, X, 1 * SIZE + add.d X, X, INCX + xvinsgr2vr.w x1, t1, 0 + xvinsgr2vr.w x2, t2, 0 + xvinsgr2vr.w x1, t3, 1 + xvinsgr2vr.w x2, t4, 1 + ld.d t1, X, 0 * SIZE + ld.d t2, X, 1 * SIZE + add.d X, X, INCX + ld.d t3, X, 0 * SIZE + ld.d t4, X, 1 * SIZE + add.d X, X, INCX + xvinsgr2vr.w x1, t1, 2 + xvinsgr2vr.w x2, t2, 2 + xvinsgr2vr.w x1, t3, 3 + xvinsgr2vr.w x2, t4, 3 + ld.d t1, X, 0 * SIZE + ld.d t2, X, 1 * SIZE + add.d X, X, INCX + ld.d t3, X, 0 * SIZE + ld.d t4, X, 1 * SIZE + add.d X, X, INCX + xvinsgr2vr.w x1, t1, 4 + xvinsgr2vr.w x2, t2, 4 + xvinsgr2vr.w x1, t3, 5 + xvinsgr2vr.w x2, t4, 5 + ld.d t1, X, 0 * SIZE + ld.d t2, X, 1 * SIZE + add.d X, X, INCX + ld.d t3, X, 0 * SIZE + ld.d t4, X, 1 * SIZE + add.d X, X, INCX + xvinsgr2vr.w x1, t1, 6 + xvinsgr2vr.w x2, t2, 6 + xvinsgr2vr.w x1, t3, 7 + xvinsgr2vr.w x2, t4, 7 + + ld.d t1, Y, 0 * SIZE + ld.d t2, Y, 1 * SIZE + add.d Y, Y, INCY + ld.d t3, Y, 0 * SIZE + ld.d t4, Y, 1 * SIZE + add.d Y, Y, INCY + xvinsgr2vr.w x3, t1, 0 + xvinsgr2vr.w x4, t2, 0 + xvinsgr2vr.w x3, t3, 1 + xvinsgr2vr.w x4, t4, 1 + ld.d t1, Y, 0 * SIZE + ld.d t2, Y, 1 * SIZE + add.d Y, Y, INCY + ld.d t3, Y, 0 * SIZE + ld.d t4, Y, 1 * SIZE + add.d Y, Y, INCY + xvinsgr2vr.w x3, t1, 2 + xvinsgr2vr.w x4, t2, 2 + xvinsgr2vr.w x3, t3, 3 + xvinsgr2vr.w x4, t4, 3 + ld.d t1, Y, 0 * SIZE + ld.d t2, Y, 1 * SIZE + add.d Y, Y, INCY + ld.d t3, Y, 0 * SIZE + ld.d t4, Y, 1 * SIZE + add.d Y, Y, INCY + xvinsgr2vr.w x3, t1, 4 + xvinsgr2vr.w x4, t2, 4 + xvinsgr2vr.w x3, t3, 5 + xvinsgr2vr.w x4, t4, 5 + ld.d t1, Y, 0 * SIZE + ld.d t2, Y, 1 * SIZE + add.d Y, Y, INCY + ld.d t3, Y, 0 * SIZE + ld.d t4, Y, 1 * SIZE + xvinsgr2vr.w x3, t1, 6 + xvinsgr2vr.w x4, t2, 6 + xvinsgr2vr.w x3, t3, 7 + xvinsgr2vr.w x4, t4, 7 + add.d Y, Y, INCY + + XVFMUL VX0, VXAI, x2 + XVFMUL VX1, VXAI, x1 + XVFMUL VX2, VXBI, x4 + XVFMUL VX3, VXBI, x3 + XVMSUB VX0, VXAR, x1, VX0 + XVFMADD VX1, VXAR, x2, VX1 + XVMSUB VX2, VXBR, x3, VX2 + XVFMADD VX3, VXBR, x4, VX3 + XVFADD x3, VX0, VX2 + XVFADD x4, VX1, VX3 + addi.d I, I, -1 + + xvstelm.w x3, YY, 0 * SIZE, 0 + xvstelm.w x4, YY, 1 * SIZE, 0 + add.d YY, YY, INCY + xvstelm.w x3, YY, 0 * SIZE, 1 + xvstelm.w x4, YY, 1 * SIZE, 1 + add.d YY, YY, INCY + xvstelm.w x3, YY, 0 * SIZE, 2 + xvstelm.w x4, YY, 1 * SIZE, 2 + add.d YY, YY, INCY + xvstelm.w x3, YY, 0 * SIZE, 3 + xvstelm.w x4, YY, 1 * SIZE, 3 + add.d YY, YY, INCY + xvstelm.w x3, YY, 0 * SIZE, 4 + xvstelm.w x4, YY, 1 * SIZE, 4 + add.d YY, YY, INCY + xvstelm.w x3, YY, 0 * SIZE, 5 + xvstelm.w x4, YY, 1 * SIZE, 5 + add.d YY, YY, INCY + xvstelm.w x3, YY, 0 * SIZE, 6 + xvstelm.w x4, YY, 1 * SIZE, 6 + add.d YY, YY, INCY + xvstelm.w x3, YY, 0 * SIZE, 7 + xvstelm.w x4, YY, 1 * SIZE, 7 + add.d YY, YY, INCY + blt $r0, I, .L224 + b .L997 + .align 3 +#endif + +.L997: + andi I, N, 7 + bge $r0, I, .L999 + .align 3 + +.L998: + LD a1, X, 0 * SIZE + LD a2, X, 1 * SIZE + LD a3, Y, 0 * SIZE + LD a4, Y, 1 * SIZE + addi.d I, I, -1 + MUL s1, ALPHAI, a2 + MUL s2, ALPHAI, a1 + MUL s3, BETAI, a4 + MUL s4, BETAI, a3 + MSUB s1, ALPHAR, a1, s1 + MADD s2, a2, ALPHAR, s2 + MSUB s3, BETAR, a3, s3 + MADD s4, a4, BETAR, s4 + ADD s3, s3, s1 + ADD s4, s4, s2 + ST s3, Y, 0 * SIZE + ST s4, Y, 1 * SIZE + add.d X, X, INCX + add.d Y, Y, INCY + blt $r0, I, .L998 + .align 3 + +.L999: + move $r4, $r12 + jirl $r0, $r1, 0x0 + .align 3 + + EPILOGUE diff --git a/kernel/loongarch64/caxpby_lsx.S b/kernel/loongarch64/caxpby_lsx.S new file mode 100644 index 000000000..247ae428e --- /dev/null +++ b/kernel/loongarch64/caxpby_lsx.S @@ -0,0 +1,1029 @@ +#define ASSEMBLER + +#include "common.h" +#define N $r4 +#define ALPHAR $f0 +#define ALPHAI $f1 +#define X $r5 +#define INCX $r6 +#define BETAR $f2 +#define BETAI $f3 +#define Y $r7 +#define INCY $r8 + +#define I $r12 +#define TEMP $r13 +#define t1 $r14 +#define t2 $r16 +#define t3 $r15 +#define t4 $r17 +#define XX $r18 +#define YY $r19 +#define a1 $f12 +#define a2 $f13 +#define a3 $f14 +#define a4 $f15 +#define s1 $f16 +#define s2 $f17 +#define s3 $f18 +#define s4 $f19 +#define VX0 $vr8 +#define VX1 $vr20 +#define VX2 $vr21 +#define VX3 $vr22 +#define VXAR $vr23 +#define VXAI $vr19 +#define VXBR $vr14 +#define VXBI $vr13 +#define VXZ $vr12 +#define x1 $vr18 +#define x2 $vr17 +#define x3 $vr16 +#define x4 $vr15 + + PROLOGUE + + bge $r0, N, .L999 + movgr2fr.d a1, $r0 +#ifdef DOUBLE + ffint.d.l a1, a1 +#else + ffint.s.l a1, a1 +#endif + slli.d INCX, INCX, ZBASE_SHIFT + slli.d INCY, INCY, ZBASE_SHIFT +#ifdef DOUBLE + movfr2gr.d t1, ALPHAR + vreplgr2vr.d VXAR, t1 + movfr2gr.d t2, ALPHAI + vreplgr2vr.d VXAI, t2 + movfr2gr.d t3, BETAR + vreplgr2vr.d VXBR, t3 + movfr2gr.d t4, BETAI + vreplgr2vr.d VXBI, t4 +#else + movfr2gr.s t1, ALPHAR + vreplgr2vr.w VXAR, t1 + movfr2gr.s t2, ALPHAI + vreplgr2vr.w VXAI, t2 + movfr2gr.s t3, BETAR + vreplgr2vr.w VXBR, t3 + movfr2gr.s t4, BETAI + vreplgr2vr.w VXBI, t4 +#endif + vxor.v VXZ, VXZ, VXZ + // If incx == 0 || incy == 0, do one by one + and TEMP, INCX, INCY + or I, N, N + beqz TEMP, .L998 + + li.d TEMP, 1 + slli.d TEMP, TEMP, ZBASE_SHIFT + srai.d I, N, 2 + bne INCX, TEMP, .L20 + bne INCY, TEMP, .L12 // INCX==1 and INCY!=1 + b .L11 // INCX==1 and INCY==1 +.L20: + bne INCY, TEMP, .L22 // INCX!=1 and INCY!=1 + b .L21 // INCX!=1 and INCY==1 + +.L11: + bge $r0, I, .L997 +#ifdef DOUBLE + fcmp.ceq.d $fcc0, BETAR, a1 + fcmp.ceq.d $fcc1, BETAI, a1 + fcmp.ceq.d $fcc2, ALPHAR, a1 + fcmp.ceq.d $fcc3, ALPHAI, a1 +#else + fcmp.ceq.s $fcc0, BETAR, a1 + fcmp.ceq.s $fcc1, BETAI, a1 + fcmp.ceq.s $fcc2, ALPHAR, a1 + fcmp.ceq.s $fcc3, ALPHAI, a1 +#endif + bceqz $fcc0, .L13 + bceqz $fcc1, .L13 + b .L14 + .align 3 + +.L13: + bceqz $fcc2, .L114 + bceqz $fcc3, .L114 //!(beta_r == 0.0 && beta_i == 0.0) and !(alpha_r == 0.0 && alpha_i == 0.0) + b .L113 //!(beta_r == 0.0 && beta_i == 0.0) and (alpha_r == 0.0 && alpha_i == 0.0) + +.L14: + bceqz $fcc2, .L112 + bceqz $fcc3, .L112 //(beta_r == 0.0 && beta_i == 0.0) and !(alpha_r == 0.0 && alpha_i == 0.0) + b .L111 //(beta_r == 0.0 && beta_i == 0.0) and (alpha_r == 0.0 && alpha_i == 0.0) + .align 3 + +.L111: //(beta_r == 0.0 && beta_i == 0.0) and (alpha_r == 0.0 && alpha_i == 0.0) +#ifdef DOUBLE + vst VXZ, Y, 0 * SIZE + vst VXZ, Y, 2 * SIZE + vst VXZ, Y, 4 * SIZE + vst VXZ, Y, 6 * SIZE + addi.d Y, Y, 8 * SIZE + addi.d I, I, -1 + blt $r0, I, .L111 + b .L997 + .align 3 +#else + vst VXZ, Y, 0 * SIZE + vst VXZ, Y, 4 * SIZE + addi.d Y, Y, 8 * SIZE + addi.d I, I, -1 + blt $r0, I, .L111 + b .L997 + .align 3 +#endif + +.L112: //(beta_r == 0.0 && beta_i == 0.0) and !(alpha_r == 0.0 && alpha_i == 0.0) +#ifdef DOUBLE + vld VX0, X, 0 * SIZE + vld VX1, X, 2 * SIZE + vpickev.d x1, VX1, VX0 + vpickod.d x2, VX1, VX0 + vfmul.d x3, VXAI, x2 + vfmul.d x4, VXAI, x1 + vfmsub.d x3, VXAR, x1, x3 + vfmadd.d x4, VXAR, x2, x4 + vilvl.d VX2, x4 ,x3 + vilvh.d VX3, x4, x3 + vst VX2, Y, 0 * SIZE + vst VX3, Y, 2 * SIZE + + vld VX0, X, 4 * SIZE + vld VX1, X, 6 * SIZE + vpickev.d x1, VX1, VX0 + vpickod.d x2, VX1, VX0 + vfmul.d x3, VXAI, x2 + vfmul.d x4, VXAI, x1 + vfmsub.d x3, VXAR, x1, x3 + vfmadd.d x4, VXAR, x2, x4 + vilvl.d VX2, x4 ,x3 + vilvh.d VX3, x4, x3 + vst VX2, Y, 4 * SIZE + vst VX3, Y, 6 * SIZE + addi.d X, X, 8 * SIZE + addi.d Y, Y, 8 * SIZE + addi.d I, I, -1 + blt $r0, I, .L112 + b .L997 + .align 3 +#else + vld VX0, X, 0 * SIZE + vld VX1, X, 4 * SIZE + vpickev.w x1, VX1, VX0 + vpickod.w x2, VX1, VX0 + vfmul.s x3, VXAI, x2 + vfmul.s x4, VXAI, x1 + vfmsub.s x3, VXAR, x1, x3 + vfmadd.s x4, VXAR, x2, x4 + vilvl.w VX2, x4 ,x3 + vilvh.w VX3, x4, x3 + vst VX2, Y, 0 * SIZE + vst VX3, Y, 4 * SIZE + addi.d X, X, 8 * SIZE + addi.d Y, Y, 8 * SIZE + addi.d I, I, -1 + blt $r0, I, .L112 + b .L997 + .align 3 +#endif + +.L113: //!(beta_r == 0.0 && beta_i == 0.0) and (alpha_r == 0.0 && alpha_i == 0.0) +#ifdef DOUBLE + vld VX0, Y, 0 * SIZE + vld VX1, Y, 2 * SIZE + vpickev.d x1, VX1, VX0 + vpickod.d x2, VX1, VX0 + vfmul.d x3, VXBI, x2 + vfmul.d x4, VXBI, x1 + vfmsub.d x3, VXBR, x1, x3 + vfmadd.d x4, VXBR, x2, x4 + vilvl.d VX2, x4 ,x3 + vilvh.d VX3, x4, x3 + vst VX2, Y, 0 * SIZE + vst VX3, Y, 2 * SIZE + vld VX0, Y, 4 * SIZE + vld VX1, Y, 6 * SIZE + vpickev.d x1, VX1, VX0 + vpickod.d x2, VX1, VX0 + vfmul.d x3, VXBI, x2 + vfmul.d x4, VXBI, x1 + vfmsub.d x3, VXBR, x1, x3 + vfmadd.d x4, VXBR, x2, x4 + vilvl.d VX2, x4 ,x3 + vilvh.d VX3, x4, x3 + vst VX2, Y, 4 * SIZE + vst VX3, Y, 6 * SIZE + addi.d Y, Y, 8 * SIZE + addi.d I, I, -1 + blt $r0, I, .L113 + b .L997 + .align 3 +#else + vld VX0, Y, 0 * SIZE + vld VX1, Y, 4 * SIZE + vpickev.w x1, VX1, VX0 + vpickod.w x2, VX1, VX0 + vfmul.s x3, VXBI, x2 + vfmul.s x4, VXBI, x1 + vfmsub.s x3, VXBR, x1, x3 + vfmadd.s x4, VXBR, x2, x4 + vilvl.w VX2, x4 ,x3 + vilvh.w VX3, x4, x3 + vst VX2, Y, 0 * SIZE + vst VX3, Y, 4 * SIZE + addi.d Y, Y, 8 * SIZE + addi.d I, I, -1 + blt $r0, I, .L113 + b .L997 + .align 3 +#endif + +.L114: +#ifdef DOUBLE + vld VX0, X, 0 * SIZE + vld VX1, X, 2 * SIZE + vld VX2, Y, 0 * SIZE + vld VX3, Y, 2 * SIZE + vpickev.d x1, VX1, VX0 + vpickod.d x2, VX1, VX0 + vpickev.d x3, VX3, VX2 + vpickod.d x4, VX3, VX2 + vfmul.d VX0, VXAI, x2 + vfmul.d VX1, VXAI, x1 + vfmul.d VX2, VXBI, x4 + vfmul.d VX3, VXBI, x3 + vfmsub.d VX0, VXAR, x1, VX0 + vfmadd.d VX1, VXAR, x2, VX1 + vfmsub.d VX2, VXBR, x3, VX2 + vfmadd.d VX3, VXBR, x4, VX3 + vfadd.d x3, VX0, VX2 + vfadd.d x4, VX1, VX3 + vilvl.d VX2, x4 ,x3 + vilvh.d VX3, x4, x3 + vst VX2, Y, 0 * SIZE + vst VX3, Y, 2 * SIZE + + vld VX0, X, 4 * SIZE + vld VX1, X, 6 * SIZE + vld VX2, Y, 4 * SIZE + vld VX3, Y, 6 * SIZE + vpickev.d x1, VX1, VX0 + vpickod.d x2, VX1, VX0 + vpickev.d x3, VX3, VX2 + vpickod.d x4, VX3, VX2 + vfmul.d VX0, VXAI, x2 + vfmul.d VX1, VXAI, x1 + vfmul.d VX2, VXBI, x4 + vfmul.d VX3, VXBI, x3 + vfmsub.d VX0, VXAR, x1, VX0 + vfmadd.d VX1, VXAR, x2, VX1 + vfmsub.d VX2, VXBR, x3, VX2 + vfmadd.d VX3, VXBR, x4, VX3 + vfadd.d x3, VX0, VX2 + vfadd.d x4, VX1, VX3 + vilvl.d VX2, x4 ,x3 + vilvh.d VX3, x4, x3 + vst VX2, Y, 4 * SIZE + vst VX3, Y, 6 * SIZE + addi.d X, X, 8 * SIZE + addi.d Y, Y, 8 * SIZE + addi.d I, I, -1 + blt $r0, I, .L114 + b .L997 + .align 3 +#else + vld VX0, X, 0 * SIZE + vld VX1, X, 4 * SIZE + vld VX2, Y, 0 * SIZE + vld VX3, Y, 4 * SIZE + vpickev.w x1, VX1, VX0 + vpickod.w x2, VX1, VX0 + vpickev.w x3, VX3, VX2 + vpickod.w x4, VX3, VX2 + vfmul.s VX0, VXAI, x2 + vfmul.s VX1, VXAI, x1 + vfmul.s VX2, VXBI, x4 + vfmul.s VX3, VXBI, x3 + vfmsub.s VX0, VXAR, x1, VX0 + vfmadd.s VX1, VXAR, x2, VX1 + vfmsub.s VX2, VXBR, x3, VX2 + vfmadd.s VX3, VXBR, x4, VX3 + vfadd.s x3, VX0, VX2 + vfadd.s x4, VX1, VX3 + vilvl.w VX2, x4 ,x3 + vilvh.w VX3, x4, x3 + vst VX2, Y, 0 * SIZE + vst VX3, Y, 4 * SIZE + addi.d X, X, 8 * SIZE + addi.d Y, Y, 8 * SIZE + addi.d I, I, -1 + blt $r0, I, .L114 + b .L997 + .align 3 +#endif + +.L12: // INCX==1 and INCY!=1 + bge $r0, I, .L997 + move YY, Y + .align 3 + +.L121: +#ifdef DOUBLE + vld VX0, X, 0 * SIZE + vld VX1, X, 2 * SIZE + ld.d t1, Y, 0 * SIZE + ld.d t2, Y, 1 * SIZE + add.d Y, Y, INCY + ld.d t3, Y, 0 * SIZE + ld.d t4, Y, 1 * SIZE + vinsgr2vr.d x3, t1, 0 + vinsgr2vr.d x4, t2, 0 + vinsgr2vr.d x3, t3, 1 + vinsgr2vr.d x4, t4, 1 + add.d Y, Y, INCY + vpickev.d x1, VX1, VX0 + vpickod.d x2, VX1, VX0 + vfmul.d VX0, VXAI, x2 + vfmul.d VX1, VXAI, x1 + vfmul.d VX2, VXBI, x4 + vfmul.d VX3, VXBI, x3 + vfmsub.d VX0, VXAR, x1, VX0 + vfmadd.d VX1, VXAR, x2, VX1 + vfmsub.d VX2, VXBR, x3, VX2 + vfmadd.d VX3, VXBR, x4, VX3 + vfadd.d x3, VX0, VX2 + vfadd.d x4, VX1, VX3 + vstelm.d x3, YY, 0 * SIZE, 0 + vstelm.d x4, YY, 1 * SIZE, 0 + add.d YY, YY, INCY + vstelm.d x3, YY, 0 * SIZE, 1 + vstelm.d x4, YY, 1 * SIZE, 1 + add.d YY, YY, INCY + + vld VX0, X, 4 * SIZE + vld VX1, X, 6 * SIZE + ld.d t1, Y, 0 * SIZE + ld.d t2, Y, 1 * SIZE + add.d Y, Y, INCY + ld.d t3, Y, 0 * SIZE + ld.d t4, Y, 1 * SIZE + vinsgr2vr.d x3, t1, 0 + vinsgr2vr.d x4, t2, 0 + vinsgr2vr.d x3, t3, 1 + vinsgr2vr.d x4, t4, 1 + add.d Y, Y, INCY + vpickev.d x1, VX1, VX0 + vpickod.d x2, VX1, VX0 + vfmul.d VX0, VXAI, x2 + vfmul.d VX1, VXAI, x1 + vfmul.d VX2, VXBI, x4 + vfmul.d VX3, VXBI, x3 + vfmsub.d VX0, VXAR, x1, VX0 + vfmadd.d VX1, VXAR, x2, VX1 + vfmsub.d VX2, VXBR, x3, VX2 + vfmadd.d VX3, VXBR, x4, VX3 + vfadd.d x3, VX0, VX2 + vfadd.d x4, VX1, VX3 + addi.d I, I, -1 + vstelm.d x3, YY, 0 * SIZE, 0 + vstelm.d x4, YY, 1 * SIZE, 0 + add.d YY, YY, INCY + vstelm.d x3, YY, 0 * SIZE, 1 + vstelm.d x4, YY, 1 * SIZE, 1 + add.d YY, YY, INCY + addi.d X, X, 8 * SIZE + blt $r0, I, .L121 + b .L997 + .align 3 +#else + vld VX0, X, 0 * SIZE + ld.w t1, Y, 0 * SIZE + ld.w t2, Y, 1 * SIZE + add.d Y, Y, INCY + ld.w t3, Y, 0 * SIZE + ld.w t4, Y, 1 * SIZE + add.d Y, Y, INCY + vinsgr2vr.w x3, t1, 0 + vinsgr2vr.w x4, t2, 0 + vinsgr2vr.w x3, t3, 1 + vinsgr2vr.w x4, t4, 1 + + vld VX1, X, 4 * SIZE + ld.w t1, Y, 0 * SIZE + ld.w t2, Y, 1 * SIZE + add.d Y, Y, INCY + ld.w t3, Y, 0 * SIZE + ld.w t4, Y, 1 * SIZE + vinsgr2vr.w x3, t1, 2 + vinsgr2vr.w x4, t2, 2 + vinsgr2vr.w x3, t3, 3 + vinsgr2vr.w x4, t4, 3 + add.d Y, Y, INCY + + vpickev.w x1, VX1, VX0 + vpickod.w x2, VX1, VX0 + vfmul.s VX0, VXAI, x2 + vfmul.s VX1, VXAI, x1 + vfmul.s VX2, VXBI, x4 + vfmul.s VX3, VXBI, x3 + vfmsub.s VX0, VXAR, x1, VX0 + vfmadd.s VX1, VXAR, x2, VX1 + vfmsub.s VX2, VXBR, x3, VX2 + vfmadd.s VX3, VXBR, x4, VX3 + vfadd.s x3, VX0, VX2 + vfadd.s x4, VX1, VX3 + addi.d I, I, -1 + vstelm.w x3, YY, 0 * SIZE, 0 + vstelm.w x4, YY, 1 * SIZE, 0 + add.d YY, YY, INCY + vstelm.w x3, YY, 0 * SIZE, 1 + vstelm.w x4, YY, 1 * SIZE, 1 + add.d YY, YY, INCY + vstelm.w x3, YY, 0 * SIZE, 2 + vstelm.w x4, YY, 1 * SIZE, 2 + add.d YY, YY, INCY + vstelm.w x3, YY, 0 * SIZE, 3 + vstelm.w x4, YY, 1 * SIZE, 3 + add.d YY, YY, INCY + addi.d X, X, 8 * SIZE + blt $r0, I, .L121 + b .L997 + .align 3 +#endif + +.L21:// INCX!=1 and INCY==1 + bge $r0, I, .L997 + .align 3 + +.L211: +#ifdef DOUBLE + vld VX2, Y, 0 * SIZE + vld VX3, Y, 2 * SIZE + ld.d t1, X, 0 * SIZE + ld.d t2, X, 1 * SIZE + add.d X, X, INCX + ld.d t3, X, 0 * SIZE + ld.d t4, X, 1 * SIZE + vinsgr2vr.d x1, t1, 0 + vinsgr2vr.d x2, t2, 0 + vinsgr2vr.d x1, t3, 1 + vinsgr2vr.d x2, t4, 1 + add.d X, X, INCX + vpickev.d x3, VX3, VX2 + vpickod.d x4, VX3, VX2 + vfmul.d VX0, VXAI, x2 + vfmul.d VX1, VXAI, x1 + vfmul.d VX2, VXBI, x4 + vfmul.d VX3, VXBI, x3 + vfmsub.d VX0, VXAR, x1, VX0 + vfmadd.d VX1, VXAR, x2, VX1 + vfmsub.d VX2, VXBR, x3, VX2 + vfmadd.d VX3, VXBR, x4, VX3 + vfadd.d x3, VX0, VX2 + vfadd.d x4, VX1, VX3 + vilvl.d VX2, x4 ,x3 + vilvh.d VX3, x4, x3 + vst VX2, Y, 0 * SIZE + vst VX3, Y, 2 * SIZE + + vld VX2, Y, 4 * SIZE + vld VX3, Y, 6 * SIZE + ld.d t1, X, 0 * SIZE + ld.d t2, X, 1 * SIZE + add.d X, X, INCX + ld.d t3, X, 0 * SIZE + ld.d t4, X, 1 * SIZE + vinsgr2vr.d x1, t1, 0 + vinsgr2vr.d x2, t2, 0 + vinsgr2vr.d x1, t3, 1 + vinsgr2vr.d x2, t4, 1 + add.d X, X, INCX + vpickev.d x3, VX3, VX2 + vpickod.d x4, VX3, VX2 + vfmul.d VX0, VXAI, x2 + vfmul.d VX1, VXAI, x1 + vfmul.d VX2, VXBI, x4 + vfmul.d VX3, VXBI, x3 + vfmsub.d VX0, VXAR, x1, VX0 + vfmadd.d VX1, VXAR, x2, VX1 + vfmsub.d VX2, VXBR, x3, VX2 + vfmadd.d VX3, VXBR, x4, VX3 + vfadd.d x3, VX0, VX2 + vfadd.d x4, VX1, VX3 + vilvl.d VX2, x4 ,x3 + vilvh.d VX3, x4, x3 + addi.d I, I, -1 + vst VX3, Y, 4 * SIZE + vst VX3, Y, 6 * SIZE + addi.d Y, Y, 8 * SIZE + blt $r0, I, .L211 + b .L997 + .align 3 +#else + vld VX2, Y, 0 * SIZE + ld.w t1, X, 0 * SIZE + ld.w t2, X, 1 * SIZE + add.d X, X, INCX + ld.w t3, X, 0 * SIZE + ld.w t4, X, 1 * SIZE + add.d X, X, INCX + vinsgr2vr.w x1, t1, 0 + vinsgr2vr.w x2, t2, 0 + vinsgr2vr.w x1, t3, 1 + vinsgr2vr.w x2, t4, 1 + vld VX3, Y, 4 * SIZE + ld.w t1, X, 0 * SIZE + ld.w t2, X, 1 * SIZE + add.d X, X, INCX + ld.w t3, X, 0 * SIZE + ld.w t4, X, 1 * SIZE + vinsgr2vr.w x1, t1, 2 + vinsgr2vr.w x2, t2, 2 + vinsgr2vr.w x1, t3, 3 + vinsgr2vr.w x2, t4, 3 + add.d X, X, INCX + + vpickev.w x3, VX3, VX2 + vpickod.w x4, VX3, VX2 + vfmul.s VX0, VXAI, x2 + vfmul.s VX1, VXAI, x1 + vfmul.s VX2, VXBI, x4 + vfmul.s VX3, VXBI, x3 + vfmsub.s VX0, VXAR, x1, VX0 + vfmadd.s VX1, VXAR, x2, VX1 + vfmsub.s VX2, VXBR, x3, VX2 + vfmadd.s VX3, VXBR, x4, VX3 + vfadd.s x3, VX0, VX2 + vfadd.s x4, VX1, VX3 + vilvl.w VX2, x4 ,x3 + vilvh.w VX3, x4, x3 + addi.d I, I, -1 + vst VX2, Y, 0 * SIZE + vst VX3, Y, 4 * SIZE + addi.d Y, Y, 8 * SIZE + blt $r0, I, .L211 + b .L997 + .align 3 +#endif + +.L22: + bge $r0, I, .L997 + move YY, Y +#ifdef DOUBLE + fcmp.ceq.d $fcc0, BETAR, a1 + fcmp.ceq.d $fcc1, BETAI, a1 + fcmp.ceq.d $fcc2, ALPHAR, a1 + fcmp.ceq.d $fcc3, ALPHAI, a1 +#else + fcmp.ceq.s $fcc0, BETAR, a1 + fcmp.ceq.s $fcc1, BETAI, a1 + fcmp.ceq.s $fcc2, ALPHAR, a1 + fcmp.ceq.s $fcc3, ALPHAI, a1 +#endif + bceqz $fcc0, .L23 + bceqz $fcc1, .L23 + b .L24 + .align 3 + +.L23: + bceqz $fcc2, .L224 + bceqz $fcc3, .L224 //!(beta_r == 0.0 && beta_i == 0.0) and !(alpha_r == 0.0 && alpha_i == 0.0) + b .L223 //!(beta_r == 0.0 && beta_i == 0.0) and (alpha_r == 0.0 && alpha_i == 0.0) + .align 3 + +.L24: + bceqz $fcc2, .L222 + bceqz $fcc3, .L222 //(beta_r == 0.0 && beta_i == 0.0) and !(alpha_r == 0.0 && alpha_i == 0.0) + b .L221 //(beta_r == 0.0 && beta_i == 0.0) and (alpha_r == 0.0 && alpha_i == 0.0) + .align 3 + +.L221: //(beta_r == 0.0 && beta_i == 0.0) and (alpha_r == 0.0 && alpha_i == 0.0) +#ifdef DOUBLE + vstelm.d VXZ, Y, 0, 0 + vstelm.d VXZ, Y, 0, 0 + add.d Y, Y, INCY + vstelm.d VXZ, Y, 0, 0 + vstelm.d VXZ, Y, 0, 0 + add.d Y, Y, INCY + vstelm.d VXZ, Y, 0, 0 + vstelm.d VXZ, Y, 0, 0 + add.d Y, Y, INCY + vstelm.d VXZ, Y, 0, 0 + vstelm.d VXZ, Y, 0, 0 + add.d Y, Y, INCY + addi.d I, I, -1 + blt $r0, I, .L221 + b .L997 + .align 3 +#else + vstelm.w VXZ, Y, 0, 0 + vstelm.w VXZ, Y, 0, 0 + add.d Y, Y, INCY + vstelm.w VXZ, Y, 0, 0 + vstelm.w VXZ, Y, 0, 0 + add.d Y, Y, INCY + vstelm.w VXZ, Y, 0, 0 + vstelm.w VXZ, Y, 0, 0 + add.d Y, Y, INCY + vstelm.w VXZ, Y, 0, 0 + vstelm.w VXZ, Y, 0, 0 + add.d Y, Y, INCY + addi.d I, I, -1 + blt $r0, I, .L221 + b .L997 + .align 3 +#endif + +.L222: //(beta_r == 0.0 && beta_i == 0.0) and !(alpha_r == 0.0 && alpha_i == 0.0) +#ifdef DOUBLE + ld.d t1, X, 0 * SIZE + ld.d t2, X, 1 * SIZE + add.d X, X, INCX + ld.d t3, X, 0 * SIZE + ld.d t4, X, 1 * SIZE + add.d X, X, INCX + vinsgr2vr.d x1, t1, 0 + vinsgr2vr.d x2, t2, 0 + vinsgr2vr.d x1, t3, 1 + vinsgr2vr.d x2, t4, 1 + vfmul.d x3, VXAI, x2 + vfmul.d x4, VXAI, x1 + vfmsub.d x3, VXAR, x1, x3 + vfmadd.d x4, VXAR, x2, x4 + vstelm.d x3, YY, 0 * SIZE, 0 + vstelm.d x4, YY, 1 * SIZE, 0 + add.d YY, YY, INCY + vstelm.d x3, YY, 0 * SIZE, 1 + vstelm.d x4, YY, 1 * SIZE, 1 + add.d YY, YY, INCY + + ld.d t1, X, 0 * SIZE + ld.d t2, X, 1 * SIZE + add.d X, X, INCX + ld.d t3, X, 0 * SIZE + ld.d t4, X, 1 * SIZE + vinsgr2vr.d x1, t1, 0 + vinsgr2vr.d x2, t2, 0 + vinsgr2vr.d x1, t3, 1 + vinsgr2vr.d x2, t4, 1 + add.d X, X, INCX + vfmul.d x3, VXAI, x2 + vfmul.d x4, VXAI, x1 + vfmsub.d x3, VXAR, x1, x3 + vfmadd.d x4, VXAR, x2, x4 + addi.d I, I, -1 + vstelm.d x3, YY, 0 * SIZE, 0 + vstelm.d x4, YY, 1 * SIZE, 0 + add.d YY, YY, INCY + vstelm.d x3, YY, 0 * SIZE, 1 + vstelm.d x4, YY, 1 * SIZE, 1 + add.d YY, YY, INCY + blt $r0, I, .L222 + b .L997 + .align 3 +#else + ld.w t1, X, 0 * SIZE + ld.w t2, X, 1 * SIZE + add.d X, X, INCX + ld.w t3, X, 0 * SIZE + ld.w t4, X, 1 * SIZE + add.d X, X, INCX + vinsgr2vr.w x1, t1, 0 + vinsgr2vr.w x2, t2, 0 + vinsgr2vr.w x1, t3, 1 + vinsgr2vr.w x2, t4, 1 + + ld.w t1, X, 0 * SIZE + ld.w t2, X, 1 * SIZE + add.d X, X, INCX + ld.w t3, X, 0 * SIZE + ld.w t4, X, 1 * SIZE + vinsgr2vr.w x1, t1, 2 + vinsgr2vr.w x2, t2, 2 + vinsgr2vr.w x1, t3, 3 + vinsgr2vr.w x2, t4, 3 + add.d X, X, INCX + vfmul.s x3, VXAI, x2 + vfmul.s x4, VXAI, x1 + vfmsub.s x3, VXAR, x1, x3 + vfmadd.s x4, VXAR, x2, x4 + addi.d I, I, -1 + vstelm.w x3, YY, 0 * SIZE, 0 + vstelm.w x4, YY, 1 * SIZE, 0 + add.d YY, YY, INCY + vstelm.w x3, YY, 0 * SIZE, 1 + vstelm.w x4, YY, 1 * SIZE, 1 + add.d YY, YY, INCY + vstelm.w x3, YY, 0 * SIZE, 2 + vstelm.w x4, YY, 1 * SIZE, 2 + add.d YY, YY, INCY + vstelm.w x3, YY, 0 * SIZE, 3 + vstelm.w x4, YY, 1 * SIZE, 3 + add.d YY, YY, INCY + blt $r0, I, .L222 + b .L997 + .align 3 +#endif + +.L223: +#ifdef DOUBLE + ld.d t1, Y, 0 * SIZE + ld.d t2, Y, 1 * SIZE + add.d Y, Y, INCY + ld.d t3, Y, 0 * SIZE + ld.d t4, Y, 1 * SIZE + vinsgr2vr.d x1, t1, 0 + vinsgr2vr.d x2, t2, 0 + vinsgr2vr.d x1, t3, 1 + vinsgr2vr.d x2, t4, 1 + add.d Y, Y, INCY + vfmul.d x3, VXBI, x2 + vfmul.d x4, VXBI, x1 + vfmsub.d x3, VXBR, x1, x3 + vfmadd.d x4, VXBR, x2, x4 + vstelm.d x3, YY, 0 * SIZE, 0 + vstelm.d x4, YY, 1 * SIZE, 0 + add.d YY, YY, INCY + vstelm.d x3, YY, 0 * SIZE, 1 + vstelm.d x4, YY, 1 * SIZE, 1 + add.d YY, YY, INCY + ld.d t1, Y, 0 * SIZE + ld.d t2, Y, 1 * SIZE + add.d Y, Y, INCY + ld.d t3, Y, 0 * SIZE + ld.d t4, Y, 1 * SIZE + vinsgr2vr.d x1, t1, 0 + vinsgr2vr.d x2, t2, 0 + vinsgr2vr.d x1, t3, 1 + vinsgr2vr.d x2, t4, 1 + add.d Y, Y, INCY + vfmul.d x3, VXBI, x2 + vfmul.d x4, VXBI, x1 + vfmsub.d x3, VXBR, x1, x3 + vfmadd.d x4, VXBR, x2, x4 + addi.d I, I, -1 + vstelm.d x3, YY, 0 * SIZE, 0 + vstelm.d x4, YY, 1 * SIZE, 0 + add.d YY, YY, INCY + vstelm.d x3, YY, 0 * SIZE, 1 + vstelm.d x4, YY, 1 * SIZE, 1 + add.d YY, YY, INCY + blt $r0, I, .L223 + b .L997 + .align 3 +#else + ld.w t1, Y, 0 * SIZE + ld.w t2, Y, 1 * SIZE + add.d Y, Y, INCY + ld.w t3, Y, 0 * SIZE + ld.w t4, Y, 1 * SIZE + add.d Y, Y, INCY + vinsgr2vr.w x1, t1, 0 + vinsgr2vr.w x2, t2, 0 + vinsgr2vr.w x1, t3, 1 + vinsgr2vr.w x2, t4, 1 + + ld.w t1, Y, 0 * SIZE + ld.w t2, Y, 1 * SIZE + add.d Y, Y, INCY + ld.w t3, Y, 0 * SIZE + ld.w t4, Y, 1 * SIZE + vinsgr2vr.w x1, t1, 2 + vinsgr2vr.w x2, t2, 2 + vinsgr2vr.w x1, t3, 3 + vinsgr2vr.w x2, t4, 3 + add.d Y, Y, INCY + vfmul.s x3, VXBI, x2 + vfmul.s x4, VXBI, x1 + vfmsub.s x3, VXBR, x1, x3 + vfmadd.s x4, VXBR, x2, x4 + + addi.d I, I, -1 + vstelm.w x3, YY, 0 * SIZE, 0 + vstelm.w x4, YY, 1 * SIZE, 0 + add.d YY, YY, INCY + vstelm.w x3, YY, 0 * SIZE, 1 + vstelm.w x4, YY, 1 * SIZE, 1 + add.d YY, YY, INCY + vstelm.w x3, YY, 0 * SIZE, 2 + vstelm.w x4, YY, 1 * SIZE, 2 + add.d YY, YY, INCY + vstelm.w x3, YY, 0 * SIZE, 3 + vstelm.w x4, YY, 1 * SIZE, 3 + add.d YY, YY, INCY + blt $r0, I, .L223 + b .L997 + .align 3 +#endif + +.L224: +#ifdef DOUBLE + ld.d t1, X, 0 * SIZE + ld.d t2, X, 1 * SIZE + add.d X, X, INCX + ld.d t3, X, 0 * SIZE + ld.d t4, X, 1 * SIZE + add.d X, X, INCX + vinsgr2vr.d x1, t1, 0 + vinsgr2vr.d x2, t2, 0 + vinsgr2vr.d x1, t3, 1 + vinsgr2vr.d x2, t4, 1 + ld.d t1, Y, 0 * SIZE + ld.d t2, Y, 1 * SIZE + add.d Y, Y, INCY + ld.d t3, Y, 0 * SIZE + ld.d t4, Y, 1 * SIZE + vinsgr2vr.d x3, t1, 0 + vinsgr2vr.d x4, t2, 0 + vinsgr2vr.d x3, t3, 1 + vinsgr2vr.d x4, t4, 1 + add.d Y, Y, INCY + vfmul.d VX0, VXAI, x2 + vfmul.d VX1, VXAI, x1 + vfmul.d VX2, VXBI, x4 + vfmul.d VX3, VXBI, x3 + vfmsub.d VX0, VXAR, x1, VX0 + vfmadd.d VX1, VXAR, x2, VX1 + vfmsub.d VX2, VXBR, x3, VX2 + vfmadd.d VX3, VXBR, x4, VX3 + vfadd.d x3, VX0, VX2 + vfadd.d x4, VX1, VX3 + vstelm.d x3, YY, 0 * SIZE, 0 + vstelm.d x4, YY, 1 * SIZE, 0 + add.d YY, YY, INCY + vstelm.d x3, YY, 0 * SIZE, 1 + vstelm.d x4, YY, 1 * SIZE, 1 + add.d YY, YY, INCY + + ld.d t1, X, 0 * SIZE + ld.d t2, X, 1 * SIZE + add.d X, X, INCX + ld.d t3, X, 0 * SIZE + ld.d t4, X, 1 * SIZE + add.d X, X, INCX + vinsgr2vr.d x1, t1, 0 + vinsgr2vr.d x2, t2, 0 + vinsgr2vr.d x1, t3, 1 + vinsgr2vr.d x2, t4, 1 + ld.d t1, Y, 0 * SIZE + ld.d t2, Y, 1 * SIZE + add.d Y, Y, INCY + ld.d t3, Y, 0 * SIZE + ld.d t4, Y, 1 * SIZE + vinsgr2vr.d x3, t1, 0 + vinsgr2vr.d x4, t2, 0 + vinsgr2vr.d x3, t3, 1 + vinsgr2vr.d x4, t4, 1 + add.d Y, Y, INCY + vfmul.d VX0, VXAI, x2 + vfmul.d VX1, VXAI, x1 + vfmul.d VX2, VXBI, x4 + vfmul.d VX3, VXBI, x3 + vfmsub.d VX0, VXAR, x1, VX0 + vfmadd.d VX1, VXAR, x2, VX1 + vfmsub.d VX2, VXBR, x3, VX2 + vfmadd.d VX3, VXBR, x4, VX3 + vfadd.d x3, VX0, VX2 + vfadd.d x4, VX1, VX3 + vstelm.d x3, YY, 0 * SIZE, 0 + vstelm.d x4, YY, 1 * SIZE, 0 + add.d YY, YY, INCY + vstelm.d x3, YY, 0 * SIZE, 1 + vstelm.d x4, YY, 1 * SIZE, 1 + add.d YY, YY, INCY + addi.d I, I, -1 + blt $r0, I, .L224 + b .L997 + .align 3 +#else + ld.w t1, X, 0 * SIZE + ld.w t2, X, 1 * SIZE + add.d X, X, INCX + ld.w t3, X, 0 * SIZE + ld.w t4, X, 1 * SIZE + add.d X, X, INCX + vinsgr2vr.w x1, t1, 0 + vinsgr2vr.w x2, t2, 0 + vinsgr2vr.w x1, t3, 1 + vinsgr2vr.w x2, t4, 1 + ld.w t1, X, 0 * SIZE + ld.w t2, X, 1 * SIZE + add.d X, X, INCX + ld.w t3, X, 0 * SIZE + ld.w t4, X, 1 * SIZE + add.d X, X, INCX + vinsgr2vr.w x1, t1, 2 + vinsgr2vr.w x2, t2, 2 + vinsgr2vr.w x1, t3, 3 + vinsgr2vr.w x2, t4, 3 + + ld.w t1, Y, 0 * SIZE + ld.w t2, Y, 1 * SIZE + add.d Y, Y, INCY + ld.w t3, Y, 0 * SIZE + ld.w t4, Y, 1 * SIZE + add.d Y, Y, INCY + vinsgr2vr.w x3, t1, 0 + vinsgr2vr.w x4, t2, 0 + vinsgr2vr.w x3, t3, 1 + vinsgr2vr.w x4, t4, 1 + ld.w t1, Y, 0 * SIZE + ld.w t2, Y, 1 * SIZE + add.d Y, Y, INCY + ld.w t3, Y, 0 * SIZE + ld.w t4, Y, 1 * SIZE + vinsgr2vr.w x3, t1, 2 + vinsgr2vr.w x4, t2, 2 + vinsgr2vr.w x3, t3, 3 + vinsgr2vr.w x4, t4, 3 + add.d Y, Y, INCY + vfmul.s VX0, VXAI, x2 + vfmul.s VX1, VXAI, x1 + vfmul.s VX2, VXBI, x4 + vfmul.s VX3, VXBI, x3 + vfmsub.s VX0, VXAR, x1, VX0 + vfmadd.s VX1, VXAR, x2, VX1 + vfmsub.s VX2, VXBR, x3, VX2 + vfmadd.s VX3, VXBR, x4, VX3 + vfadd.s x3, VX0, VX2 + vfadd.s x4, VX1, VX3 + addi.d I, I, -1 + + vstelm.w x3, YY, 0 * SIZE, 0 + vstelm.w x4, YY, 1 * SIZE, 0 + add.d YY, YY, INCY + vstelm.w x3, YY, 0 * SIZE, 1 + vstelm.w x4, YY, 1 * SIZE, 1 + add.d YY, YY, INCY + vstelm.w x3, YY, 0 * SIZE, 2 + vstelm.w x4, YY, 1 * SIZE, 2 + add.d YY, YY, INCY + vstelm.w x3, YY, 0 * SIZE, 3 + vstelm.w x4, YY, 1 * SIZE, 3 + add.d YY, YY, INCY + blt $r0, I, .L224 + b .L997 + .align 3 +#endif + +.L997: + andi I, N, 3 + bge $r0, I, .L999 + .align 3 + +.L998: +#ifdef DOUBLE + fld.d a1, X, 0 * SIZE + fld.d a2, X, 1 * SIZE + fld.d a3, Y, 0 * SIZE + fld.d a4, Y, 1 * SIZE + addi.d I, I, -1 + fmul.d s1, ALPHAI, a2 + fmul.d s2, ALPHAI, a1 + fmul.d s3, BETAI, a4 + fmul.d s4, BETAI, a3 + fmsub.d s1, ALPHAR, a1, s1 + fmadd.d s2, a2, ALPHAR, s2 + fmsub.d s3, BETAR, a3, s3 + fmadd.d s4, a4, BETAR, s4 + fadd.d s3, s3, s1 + fadd.d s4, s4, s2 + fst.d s3, Y, 0 * SIZE + fst.d s4, Y, 1 * SIZE + add.d X, X, INCX + add.d Y, Y, INCY + blt $r0, I, .L998 + .align 3 +#else + fld.s a1, X, 0 * SIZE + fld.s a2, X, 1 * SIZE + fld.s a3, Y, 0 * SIZE + fld.s a4, Y, 1 * SIZE + addi.d I, I, -1 + fmul.s s1, ALPHAI, a2 + fmul.s s2, ALPHAI, a1 + fmul.s s3, BETAI, a4 + fmul.s s4, BETAI, a3 + fmsub.s s1, ALPHAR, a1, s1 + fmadd.s s2, a2, ALPHAR, s2 + fmsub.s s3, BETAR, a3, s3 + fmadd.s s4, a4, BETAR, s4 + fadd.s s3, s3, s1 + fadd.s s4, s4, s2 + fst.s s3, Y, 0 * SIZE + fst.s s4, Y, 1 * SIZE + add.d X, X, INCX + add.d Y, Y, INCY + blt $r0, I, .L998 + .align 3 +#endif +.L999: + move $r4, $r12 + jirl $r0, $r1, 0x0 + .align 3 + + EPILOGUE From adde7253217a6824da1deff064b46e36c1e259ca Mon Sep 17 00:00:00 2001 From: gxw Date: Sun, 4 Feb 2024 14:43:08 +0800 Subject: [PATCH 115/311] LoongArch64: Fixed {s/d}amin LSX optimization --- kernel/loongarch64/amin_lsx.S | 1 - 1 file changed, 1 deletion(-) diff --git a/kernel/loongarch64/amin_lsx.S b/kernel/loongarch64/amin_lsx.S index c3c3f4ae9..47701b6e4 100644 --- a/kernel/loongarch64/amin_lsx.S +++ b/kernel/loongarch64/amin_lsx.S @@ -124,7 +124,6 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. .L13: FABS $f0, $f0 - SUB $f0, $f0, $f0 jirl $r0, $r1, 0x0 .align 3 From d02c61e82e82b7f721ecf50dd7717547b6302a19 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Sun, 4 Feb 2024 10:01:27 +0100 Subject: [PATCH 116/311] Update lowercase cpunames for RISC-V --- cpuid_riscv64.c | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/cpuid_riscv64.c b/cpuid_riscv64.c index 5db54f1aa..ff7ba2aad 100644 --- a/cpuid_riscv64.c +++ b/cpuid_riscv64.c @@ -86,7 +86,10 @@ static char *cpuname[] = { static char *cpuname_lower[] = { "riscv64_generic", - "c910v" + "c910v", + "x280", + "riscv64_zvl256b", + "riscv64_zvl128b" }; int detect(void){ From e61d96303d4972181e1d1b26b1f3a88ed9e5de02 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Sun, 4 Feb 2024 10:05:20 +0100 Subject: [PATCH 117/311] Fix missing NO_AVX2 fallback for SapphireRapids --- driver/others/dynamic.c | 1 + 1 file changed, 1 insertion(+) diff --git a/driver/others/dynamic.c b/driver/others/dynamic.c index 69a473060..e3f905265 100644 --- a/driver/others/dynamic.c +++ b/driver/others/dynamic.c @@ -275,6 +275,7 @@ extern gotoblas_t gotoblas_EXCAVATOR; #define gotoblas_SKYLAKEX gotoblas_SANDYBRIDGE #define gotoblas_COOPERLAKE gotoblas_SANDYBRIDGE #define gotoblas_ZEN gotoblas_SANDYBRIDGE +#define gotoblas_SAPPHIRERAPIDS gotoblas_SANDYBRIDGE #else extern gotoblas_t gotoblas_HASWELL; extern gotoblas_t gotoblas_ZEN; From 6d8a273cca96c16873a15b59ea724834aa9b4558 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Sun, 4 Feb 2024 22:07:51 +0100 Subject: [PATCH 118/311] Handle zero increment(s) in C910V ?AXPBY (#4483) * Handle zero increment(s) --- kernel/riscv64/axpby_vector.c | 58 +++++++++++++++++++++++++ kernel/riscv64/zaxpby_vector.c | 77 ++++++++++++++++++++++++++++++++++ 2 files changed, 135 insertions(+) diff --git a/kernel/riscv64/axpby_vector.c b/kernel/riscv64/axpby_vector.c index 850fc903e..721aad2b0 100644 --- a/kernel/riscv64/axpby_vector.c +++ b/kernel/riscv64/axpby_vector.c @@ -69,6 +69,63 @@ int CNAME(BLASLONG n, FLOAT alpha, FLOAT *x, BLASLONG inc_x, FLOAT beta, FLOAT * BLASLONG stride_x, stride_y, ix = 0, iy = 0; + if (inc_x == 0 || inc_y == 0) { /* use trivial non-vectorized loop if either increment is zero */ + + if ( beta == 0.0 ) + { + + if ( alpha == 0.0 ) + { + while(i < n) + { + y[iy] = 0.0 ; + iy += inc_y ; + i++ ; + } + } + else + { + while(i < n) + { + y[iy] = alpha * x[ix] ; + ix += inc_x ; + iy += inc_y ; + i++ ; + } + + + } + + } + else + { + + if ( alpha == 0.0 ) + { + while(i < n) + { + y[iy] = beta * y[iy] ; + iy += inc_y ; + i++ ; + } + } + else + { + while(i < n) + { + y[iy] = alpha * x[ix] + beta * y[iy] ; + ix += inc_x ; + iy += inc_y ; + i++ ; + } + } + + } + + return(0); + + } else { /* vectorized approach for non-zero increments */ + if(beta == 0.0){ if(alpha == 0.0){//alpha == 0 && beta == 0 if(inc_y == 1){ @@ -381,5 +438,6 @@ int CNAME(BLASLONG n, FLOAT alpha, FLOAT *x, BLASLONG inc_x, FLOAT beta, FLOAT * } } return(0); + } } diff --git a/kernel/riscv64/zaxpby_vector.c b/kernel/riscv64/zaxpby_vector.c index d5ad974cf..bbf2bbe7d 100644 --- a/kernel/riscv64/zaxpby_vector.c +++ b/kernel/riscv64/zaxpby_vector.c @@ -62,6 +62,82 @@ int CNAME(BLASLONG n, FLOAT alpha_r, FLOAT alpha_i, FLOAT *x, BLASLONG inc_x, FL stride_x = inc_x * 2 * sizeof(FLOAT); stride_y = inc_y * 2 * sizeof(FLOAT); + if (inc_x == 0 || inc_y == 0) { + + FLOAT temp; + BLASLONG inc_x2, inc_y2; + + inc_x2 = 2 * inc_x; + inc_y2 = 2 * inc_y; + + if ( beta_r == 0.0 && beta_i == 0.0) + { + if ( alpha_r == 0.0 && alpha_i == 0.0 ) + { + + while(i < n) + { + y[iy] = 0.0 ; + y[iy+1] = 0.0 ; + iy += inc_y2 ; + i++ ; + } + + } + else + { + + while(i < n) + { + y[iy] = ( alpha_r * x[ix] - alpha_i * x[ix+1] ) ; + y[iy+1] = ( alpha_r * x[ix+1] + alpha_i * x[ix] ) ; + ix += inc_x2 ; + iy += inc_y2 ; + i++ ; + } + + + } + + } + else + { + if ( alpha_r == 0.0 && alpha_i == 0.0 ) + { + + while(i < n) + { + temp = ( beta_r * y[iy] - beta_i * y[iy+1] ) ; + y[iy+1] = ( beta_r * y[iy+1] + beta_i * y[iy] ) ; + y[iy] = temp; + iy += inc_y2 ; + i++ ; + } + + } + else + { + + while(i < n) + { + temp = ( alpha_r * x[ix] - alpha_i * x[ix+1] ) + ( beta_r * y[iy] - beta_i * y[iy+1] ) ; + y[iy+1] = ( alpha_r * x[ix+1] + alpha_i * x[ix] ) + ( beta_r * y[iy+1] + beta_i * y[iy] ) ; + y[iy] = temp; + ix += inc_x2 ; + iy += inc_y2 ; + i++ ; + } + + + } + + + + } + return(0); + + } else { + if(beta_r == 0.0 && beta_i == 0.0){ if(alpha_r == 0.0 && alpha_i == 0.0){ if(inc_y == 1){ @@ -191,5 +267,6 @@ int CNAME(BLASLONG n, FLOAT alpha_r, FLOAT alpha_i, FLOAT *x, BLASLONG inc_x, FL } } return(0); + } } From 479e4af0893f3772eff9a75e89cf28bef91383c3 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Mon, 5 Feb 2024 15:35:24 +0100 Subject: [PATCH 119/311] Rescale input vector more often to minimize relative error (Reference-LAPACK PR 981) --- lapack-netlib/SRC/clarfgp.f | 30 ++++++++++-------------------- lapack-netlib/SRC/zlarfgp.f | 30 ++++++++++-------------------- 2 files changed, 20 insertions(+), 40 deletions(-) diff --git a/lapack-netlib/SRC/clarfgp.f b/lapack-netlib/SRC/clarfgp.f index 47b5e47b0..980e93612 100644 --- a/lapack-netlib/SRC/clarfgp.f +++ b/lapack-netlib/SRC/clarfgp.f @@ -148,33 +148,23 @@ ALPHR = REAL( ALPHA ) ALPHI = AIMAG( ALPHA ) * - IF( XNORM.LE.EPS*ABS(ALPHA) ) THEN + IF( XNORM.LE.EPS*ABS(ALPHA) .AND. ALPHI.EQ.ZERO ) THEN * * H = [1-alpha/abs(alpha) 0; 0 I], sign chosen so ALPHA >= 0. * - IF( ALPHI.EQ.ZERO ) THEN - IF( ALPHR.GE.ZERO ) THEN -* When TAU.eq.ZERO, the vector is special-cased to be -* all zeros in the application routines. We do not need -* to clear it. - TAU = ZERO - ELSE -* However, the application routines rely on explicit -* zero checks when TAU.ne.ZERO, and we must clear X. - TAU = TWO - DO J = 1, N-1 - X( 1 + (J-1)*INCX ) = ZERO - END DO - ALPHA = -ALPHA - END IF + IF( ALPHR.GE.ZERO ) THEN +* When TAU.eq.ZERO, the vector is special-cased to be +* all zeros in the application routines. We do not need +* to clear it. + TAU = ZERO ELSE -* Only "reflecting" the diagonal entry to be real and non-negative. - XNORM = SLAPY2( ALPHR, ALPHI ) - TAU = CMPLX( ONE - ALPHR / XNORM, -ALPHI / XNORM ) +* However, the application routines rely on explicit +* zero checks when TAU.ne.ZERO, and we must clear X. + TAU = TWO DO J = 1, N-1 X( 1 + (J-1)*INCX ) = ZERO END DO - ALPHA = XNORM + ALPHA = -ALPHA END IF ELSE * diff --git a/lapack-netlib/SRC/zlarfgp.f b/lapack-netlib/SRC/zlarfgp.f index 6c9efb04c..d54f2ea5d 100644 --- a/lapack-netlib/SRC/zlarfgp.f +++ b/lapack-netlib/SRC/zlarfgp.f @@ -148,33 +148,23 @@ ALPHR = DBLE( ALPHA ) ALPHI = DIMAG( ALPHA ) * - IF( XNORM.LE.EPS*ABS(ALPHA) ) THEN + IF( XNORM.LE.EPS*ABS(ALPHA) .AND. ALPHI.EQ.ZERO ) THEN * * H = [1-alpha/abs(alpha) 0; 0 I], sign chosen so ALPHA >= 0. * - IF( ALPHI.EQ.ZERO ) THEN - IF( ALPHR.GE.ZERO ) THEN -* When TAU.eq.ZERO, the vector is special-cased to be -* all zeros in the application routines. We do not need -* to clear it. - TAU = ZERO - ELSE -* However, the application routines rely on explicit -* zero checks when TAU.ne.ZERO, and we must clear X. - TAU = TWO - DO J = 1, N-1 - X( 1 + (J-1)*INCX ) = ZERO - END DO - ALPHA = -ALPHA - END IF + IF( ALPHR.GE.ZERO ) THEN +* When TAU.eq.ZERO, the vector is special-cased to be +* all zeros in the application routines. We do not need +* to clear it. + TAU = ZERO ELSE -* Only "reflecting" the diagonal entry to be real and non-negative. - XNORM = DLAPY2( ALPHR, ALPHI ) - TAU = DCMPLX( ONE - ALPHR / XNORM, -ALPHI / XNORM ) +* However, the application routines rely on explicit +* zero checks when TAU.ne.ZERO, and we must clear X. + TAU = TWO DO J = 1, N-1 X( 1 + (J-1)*INCX ) = ZERO END DO - ALPHA = XNORM + ALPHA = -ALPHA END IF ELSE * From 63fbffddf86e2443e7aa4eda4fdad2db84b17568 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Mon, 5 Feb 2024 21:44:03 +0100 Subject: [PATCH 120/311] Add option FIXED_LIBNAME to suppress versioning and softlinking --- Makefile | 25 +++++++++++++++---------- Makefile.system | 4 ++++ 2 files changed, 19 insertions(+), 10 deletions(-) diff --git a/Makefile b/Makefile index b344abcd2..e595ad99a 100644 --- a/Makefile +++ b/Makefile @@ -1,5 +1,9 @@ TOPDIR = . include ./Makefile.system +LNCMD = ln -fs +ifeq ($(FIXED_LIBNAME), 1) +LNCMD = true +endif BLASDIRS = interface driver/level2 driver/level3 driver/others @@ -134,17 +138,17 @@ shared : libs netlib $(RELA) ifneq ($(NO_SHARED), 1) ifeq ($(OSNAME), $(filter $(OSNAME),Linux SunOS Android Haiku FreeBSD DragonFly)) @$(MAKE) -C exports so - @ln -fs $(LIBSONAME) $(LIBPREFIX).so - @ln -fs $(LIBSONAME) $(LIBPREFIX).so.$(MAJOR_VERSION) + @$(LNCMD) $(LIBSONAME) $(LIBPREFIX).so + @$(LNCMD) $(LIBSONAME) $(LIBPREFIX).so.$(MAJOR_VERSION) endif ifeq ($(OSNAME), $(filter $(OSNAME),OpenBSD NetBSD)) @$(MAKE) -C exports so - @ln -fs $(LIBSONAME) $(LIBPREFIX).so + @$(LNCMD) $(LIBSONAME) $(LIBPREFIX).so endif ifeq ($(OSNAME), Darwin) @$(MAKE) -C exports dyn - @ln -fs $(LIBDYNNAME) $(LIBPREFIX).dylib - @ln -fs $(LIBDYNNAME) $(LIBPREFIX).$(MAJOR_VERSION).dylib + @$(LNCMD) $(LIBDYNNAME) $(LIBPREFIX).dylib + @$(LNCMD) $(LIBDYNNAME) $(LIBPREFIX).$(MAJOR_VERSION).dylib endif ifeq ($(OSNAME), WINNT) @$(MAKE) -C exports dll @@ -229,13 +233,13 @@ ifeq ($(INTERFACE64),1) endif @echo THELIBNAME=$(LIBNAME) >> Makefile.conf_last @echo THELIBSONAME=$(LIBSONAME) >> Makefile.conf_last - @-ln -fs $(LIBNAME) $(LIBPREFIX).$(LIBSUFFIX) + @-$(LNCMD) $(LIBNAME) $(LIBPREFIX).$(LIBSUFFIX) @touch lib.grd prof : prof_blas prof_lapack prof_blas : - ln -fs $(LIBNAME_P) $(LIBPREFIX)_p.$(LIBSUFFIX) + $(LNCMD) $(LIBNAME_P) $(LIBPREFIX)_p.$(LIBSUFFIX) for d in $(SUBDIRS) ; \ do if test -d $$d; then \ $(MAKE) -C $$d prof || exit 1 ; \ @@ -246,7 +250,7 @@ ifeq ($(DYNAMIC_ARCH), 1) endif blas : - ln -fs $(LIBNAME) $(LIBPREFIX).$(LIBSUFFIX) + $(LNCMD) $(LIBNAME) $(LIBPREFIX).$(LIBSUFFIX) for d in $(BLASDIRS) ; \ do if test -d $$d; then \ $(MAKE) -C $$d libs || exit 1 ; \ @@ -254,7 +258,7 @@ blas : done hpl : - ln -fs $(LIBNAME) $(LIBPREFIX).$(LIBSUFFIX) + $(LNCMD) $(LIBNAME) $(LIBPREFIX).$(LIBSUFFIX) for d in $(BLASDIRS) ../laswp exports ; \ do if test -d $$d; then \ $(MAKE) -C $$d $(@F) || exit 1 ; \ @@ -268,7 +272,7 @@ ifeq ($(DYNAMIC_ARCH), 1) endif hpl_p : - ln -fs $(LIBNAME_P) $(LIBPREFIX)_p.$(LIBSUFFIX) + $(LNCMD) $(LIBNAME_P) $(LIBPREFIX)_p.$(LIBSUFFIX) for d in $(SUBDIRS) ../laswp exports ; \ do if test -d $$d; then \ $(MAKE) -C $$d $(@F) || exit 1 ; \ @@ -401,6 +405,7 @@ lapack-runtest: lapack-test blas-test: (cd $(NETLIB_LAPACK_DIR)/BLAS/TESTING && rm -f x* *.out) + $(MAKE) -j 1 -C $(NETLIB_LAPACK_DIR) blas_testing (cd $(NETLIB_LAPACK_DIR)/BLAS/TESTING && cat *.out) diff --git a/Makefile.system b/Makefile.system index 0088eaff5..0353a4d21 100644 --- a/Makefile.system +++ b/Makefile.system @@ -1704,6 +1704,10 @@ LIBNAME_P = $(LIBPREFIX)p$(REVISION)_p.$(LIBSUFFIX) endif endif +ifeq ($(FIXED_LIBNAME),1) + LIBNAME = $(LIBPREFIX).$(LIBSUFFIX) + LIBNAME_P = $(LIBPREFIX)_p.$(LIBSUFFIX) +endif LIBDLLNAME = $(LIBPREFIX).dll IMPLIBNAME = lib$(LIBNAMEBASE).dll.a From 440edfd997a4a383ced5226553c15e50c1c750b0 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Mon, 5 Feb 2024 21:44:50 +0100 Subject: [PATCH 121/311] Add option to suppress versioning of the internal name --- exports/Makefile | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/exports/Makefile b/exports/Makefile index 7682f851d..71c112c67 100644 --- a/exports/Makefile +++ b/exports/Makefile @@ -132,8 +132,12 @@ libgoto_hpl.def : $(GENSYM) ./$(GENSYM) win2khpl $(ARCH) dummy $(EXPRECISION) $(NO_CBLAS) $(NO_LAPACK) $(NO_LAPACKE) $(NEED2UNDERSCORES) $(ONLY_CBLAS) "$(SYMBOLPREFIX)" "$(SYMBOLSUFFIX)" $(BUILD_LAPACK_DEPRECATED) $(BUILD_BFLOAT16) $(BUILD_SINGLE) $(BUILD_DOUBLE) $(BUILD_COMPLEX) $(BUILD_COMPLEX16) > $(@F) ifeq ($(OSNAME), Darwin) +ifeq ($(FIXED_LIBNAME),1) +INTERNALNAME = $(LIBPREFIX).dylib +else INTERNALNAME = $(LIBPREFIX).$(MAJOR_VERSION).dylib endif +endif ifeq (, $(SYMBOLPREFIX)$(SYMBOLSUFFIX)) $(LIBDYNNAME) : ../$(LIBNAME) osx.def @@ -169,8 +173,12 @@ INTERNALNAME = $(LIBPREFIX).so FEXTRALIB += -lm EXTRALIB += -lm else +ifeq ($(FIXED_LIBNAME),1) +INTERNALNAME = $(LIBPREFIX).so +else INTERNALNAME = $(LIBPREFIX).so.$(MAJOR_VERSION) endif +endif ifeq (, $(SYMBOLPREFIX)$(SYMBOLSUFFIX)) ../$(LIBSONAME) : ../$(LIBNAME) linktest.c From fe3da43b7dac7af1be5538f87f707a6073fbc52c Mon Sep 17 00:00:00 2001 From: pengxu Date: Tue, 6 Feb 2024 11:49:01 +0800 Subject: [PATCH 122/311] Optimized zgemm kernel 8*4 LASX, 4*4 LSX and cgemm kernel 8*4 LSX for LoongArch --- kernel/loongarch64/KERNEL.LOONGSON2K1000 | 20 +- kernel/loongarch64/KERNEL.LOONGSON3R5 | 10 +- kernel/loongarch64/cgemm_kernel_8x4_lsx.S | 3313 ++++++++++++++++++ kernel/loongarch64/cgemm_ncopy_4_lsx.S | 341 ++ kernel/loongarch64/cgemm_ncopy_8_lsx.S | 263 ++ kernel/loongarch64/cgemm_tcopy_4_lsx.S | 324 ++ kernel/loongarch64/cgemm_tcopy_8_lsx.S | 277 ++ kernel/loongarch64/zgemm_kernel_4x4_lsx.S | 2316 +++++++++++++ kernel/loongarch64/zgemm_kernel_8x4_lasx.S | 3545 ++++++++++++++++++++ kernel/loongarch64/zgemm_ncopy_4_lasx.S | 320 ++ kernel/loongarch64/zgemm_ncopy_4_lsx.S | 332 ++ kernel/loongarch64/zgemm_ncopy_8_lasx.S | 263 ++ kernel/loongarch64/zgemm_tcopy_4_lasx.S | 302 ++ kernel/loongarch64/zgemm_tcopy_4_lsx.S | 355 ++ kernel/loongarch64/zgemm_tcopy_8_lasx.S | 268 ++ param.h | 10 +- 16 files changed, 12248 insertions(+), 11 deletions(-) create mode 100644 kernel/loongarch64/cgemm_kernel_8x4_lsx.S create mode 100644 kernel/loongarch64/cgemm_ncopy_4_lsx.S create mode 100644 kernel/loongarch64/cgemm_ncopy_8_lsx.S create mode 100644 kernel/loongarch64/cgemm_tcopy_4_lsx.S create mode 100644 kernel/loongarch64/cgemm_tcopy_8_lsx.S create mode 100644 kernel/loongarch64/zgemm_kernel_4x4_lsx.S create mode 100644 kernel/loongarch64/zgemm_kernel_8x4_lasx.S create mode 100644 kernel/loongarch64/zgemm_ncopy_4_lasx.S create mode 100644 kernel/loongarch64/zgemm_ncopy_4_lsx.S create mode 100644 kernel/loongarch64/zgemm_ncopy_8_lasx.S create mode 100644 kernel/loongarch64/zgemm_tcopy_4_lasx.S create mode 100644 kernel/loongarch64/zgemm_tcopy_4_lsx.S create mode 100644 kernel/loongarch64/zgemm_tcopy_8_lasx.S diff --git a/kernel/loongarch64/KERNEL.LOONGSON2K1000 b/kernel/loongarch64/KERNEL.LOONGSON2K1000 index f4ab495e6..c7ef44035 100644 --- a/kernel/loongarch64/KERNEL.LOONGSON2K1000 +++ b/kernel/loongarch64/KERNEL.LOONGSON2K1000 @@ -100,9 +100,13 @@ DTRSMKERNEL_LT = ../generic/trsm_kernel_LT.c DTRSMKERNEL_RN = ../generic/trsm_kernel_RN.c DTRSMKERNEL_RT = ../generic/trsm_kernel_RT.c -CGEMMKERNEL = cgemm_kernel_2x2_lsx.S -CGEMMONCOPY = cgemm_ncopy_2_lsx.S -CGEMMOTCOPY = cgemm_tcopy_2_lsx.S +CGEMMKERNEL = cgemm_kernel_8x4_lsx.S +CGEMMINCOPY = cgemm_ncopy_8_lsx.S +CGEMMITCOPY = cgemm_tcopy_8_lsx.S +CGEMMONCOPY = cgemm_ncopy_4_lsx.S +CGEMMOTCOPY = cgemm_tcopy_4_lsx.S +CGEMMINCOPYOBJ = cgemm_incopy$(TSUFFIX).$(SUFFIX) +CGEMMITCOPYOBJ = cgemm_itcopy$(TSUFFIX).$(SUFFIX) CGEMMONCOPYOBJ = cgemm_oncopy$(TSUFFIX).$(SUFFIX) CGEMMOTCOPYOBJ = cgemm_otcopy$(TSUFFIX).$(SUFFIX) @@ -111,4 +115,14 @@ CTRSMKERNEL_LT = ../generic/trsm_kernel_LT.c CTRSMKERNEL_RN = ../generic/trsm_kernel_RN.c CTRSMKERNEL_RT = ../generic/trsm_kernel_RT.c +ZGEMMKERNEL = zgemm_kernel_4x4_lsx.S +ZGEMMONCOPY = zgemm_ncopy_4_lsx.S +ZGEMMOTCOPY = zgemm_tcopy_4_lsx.S +ZGEMMONCOPYOBJ = zgemm_oncopy$(TSUFFIX).$(SUFFIX) +ZGEMMOTCOPYOBJ = zgemm_otcopy$(TSUFFIX).$(SUFFIX) + +ZTRSMKERNEL_LN = ../generic/trsm_kernel_LN.c +ZTRSMKERNEL_LT = ../generic/trsm_kernel_LT.c +ZTRSMKERNEL_RN = ../generic/trsm_kernel_RN.c +ZTRSMKERNEL_RT = ../generic/trsm_kernel_RT.c endif diff --git a/kernel/loongarch64/KERNEL.LOONGSON3R5 b/kernel/loongarch64/KERNEL.LOONGSON3R5 index bd85fab01..17d15656a 100644 --- a/kernel/loongarch64/KERNEL.LOONGSON3R5 +++ b/kernel/loongarch64/KERNEL.LOONGSON3R5 @@ -122,9 +122,13 @@ CTRSMKERNEL_LT = ../generic/trsm_kernel_LT.c CTRSMKERNEL_RN = ../generic/trsm_kernel_RN.c CTRSMKERNEL_RT = ../generic/trsm_kernel_RT.c -ZGEMMKERNEL = zgemm_kernel_2x2_lasx.S -ZGEMMONCOPY = zgemm_ncopy_2_lasx.S -ZGEMMOTCOPY = zgemm_tcopy_2_lasx.S +ZGEMMKERNEL = zgemm_kernel_8x4_lasx.S +ZGEMMINCOPY = zgemm_ncopy_8_lasx.S +ZGEMMITCOPY = zgemm_tcopy_8_lasx.S +ZGEMMONCOPY = zgemm_ncopy_4_lasx.S +ZGEMMOTCOPY = zgemm_tcopy_4_lasx.S +ZGEMMINCOPYOBJ = zgemm_incopy$(TSUFFIX).$(SUFFIX) +ZGEMMITCOPYOBJ = zgemm_itcopy$(TSUFFIX).$(SUFFIX) ZGEMMONCOPYOBJ = zgemm_oncopy$(TSUFFIX).$(SUFFIX) ZGEMMOTCOPYOBJ = zgemm_otcopy$(TSUFFIX).$(SUFFIX) diff --git a/kernel/loongarch64/cgemm_kernel_8x4_lsx.S b/kernel/loongarch64/cgemm_kernel_8x4_lsx.S new file mode 100644 index 000000000..1e9fd8524 --- /dev/null +++ b/kernel/loongarch64/cgemm_kernel_8x4_lsx.S @@ -0,0 +1,3313 @@ +/******************************************************************************* +Copyright (c) 2024, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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. +*******************************************************************************/ +#define ASSEMBLER + +#include "common.h" + + +/* Function parameters */ +#define M $r4 // param 1: bm +#define N $r5 // param 2: bn +#define K $r6 // param 3: bk +#define ALPHA_R $f0 // param 4: alphar +#define ALPHA_I $f1 // param 5: alphai +#define A $r7 // param 6: ba +#define B $r8 // param 7: bb +#define C $r9 // param 8: bc +#define LDC $r10 // param 9: ldc + +#if defined (TRMMKERNEL) +#define OFFSET $r11 // param 10: offset +#endif +#define OFF $r26 + +#define I $r12 +#define J $r13 +#define L $r14 +#define TL $r15 +#define A0 $r16 +#define B0 $r17 +#define C0 $r18 +#define C1 $r19 +#define C2 $r20 +#define C3 $r23 +#define T0 $r24 +#define T1 $r25 +#define T2 $r26 +#define T3 $r27 + +#define a1 $f2 +#define a2 $f3 +#define a3 $f4 +#define a4 $f5 +#define a5 $f6 +#define a6 $f7 +#define a7 $f8 +#define a8 $f9 +#define b1 $f10 +#define b2 $f11 +#define b3 $f12 +#define b4 $f13 +#define b5 $f14 +#define b6 $f15 +#define b7 $f16 +#define b8 $f17 +#define c11 $f18 +#define c12 $f19 +#define c21 $f20 +#define c22 $f21 +#define c31 $f22 +#define c32 $f23 +#define c41 $f24 +#define c42 $f25 + +/* LSX vectors */ +#define U0 $vr30 +#define U1 $vr31 +#define U2 $vr2 +#define U3 $vr3 +#define U4 $vr4 +#define U5 $vr5 +#define U6 $vr6 +#define U7 $vr7 +#define U8 $vr8 +#define U9 $vr9 +#define U10 $vr10 +#define U11 $vr11 +#define U12 $vr12 +#define U13 $vr13 +#define U14 $vr14 +#define U15 $vr15 +#define D0 $vr16 +#define D1 $vr17 +#define D2 $vr18 +#define D3 $vr19 +#define D4 $vr20 +#define D5 $vr21 +#define D6 $vr22 +#define D7 $vr23 +#define D8 $vr24 +#define D9 $vr25 +#define D10 $vr26 +#define D11 $vr27 +#define D12 $vr28 +#define D13 $vr29 +#define VALPHAR $vr28 +#define VALPHAI $vr29 + + +#if defined(NN) || defined(NT) || defined(TN) || defined(TT) +#define VMADD1 VFMADD +#define VMADD2 VFMADD +#define VMADD3 VNMSUB +#define VMADD4 VFMADD + +#define MADD1 MADD +#define MADD2 MADD +#define MADD3 NMSUB +#define MADD4 MADD +#endif + +#if defined(NR) || defined(NC) || defined(TR) || defined(TC) +#define VMADD1 VFMADD +#define VMADD2 VFMADD +#define VMADD3 VFMADD +#define VMADD4 VNMSUB + +#define MADD1 MADD +#define MADD2 MADD +#define MADD3 MADD +#define MADD4 NMSUB +#endif + +#if defined(RN) || defined(RT) || defined(CN) || defined(CT) +#define VMADD1 VFMADD +#define VMADD2 VNMSUB +#define VMADD3 VFMADD +#define VMADD4 VFMADD + +#define MADD1 MADD +#define MADD2 NMSUB +#define MADD3 MADD +#define MADD4 MADD +#endif + +#if defined(RR) || defined(RC) || defined(CR) || defined(CC) +#define VMADD1 VFMADD +#define VMADD2 VNMSUB +#define VMADD3 VNMSUB +#define VMADD4 VNMSUB + +#define MADD1 MADD +#define MADD2 NMSUB +#define MADD3 NMSUB +#define MADD4 NMSUB +#endif + + PROLOGUE + + addi.d $sp, $sp, -128 + SDARG $r23, $sp, 0 + SDARG $r24, $sp, 8 + SDARG $r25, $sp, 16 + SDARG $r26, $sp, 24 + SDARG $r27, $sp, 32 + ST $f23, $sp, 40 + ST $f24, $sp, 48 + ST $f25, $sp, 56 + ST $f26, $sp, 64 + ST $f27, $sp, 72 + ST $f28, $sp, 80 + ST $f29, $sp, 88 + ST $f30, $sp, 96 + ST $f31, $sp, 104 + ST ALPHA_R,$sp, 112 + ST ALPHA_I,$sp, 120 + + vldrepl.w VALPHAR, $sp, 112 + vldrepl.w VALPHAI, $sp, 120 + +#if defined (TRMMKERNEL) && !defined(LEFT) + sub.d OFF, $r0, OFFSET +#else + xor OFF, OFF, OFF +#endif + + slli.d LDC, LDC, 2 + + move J, $r0 + srai.d T0, N, 2 //bn/4 + beq J, T0, .L19 + +.L10: /* for(j=0; j0) */ + vld U0, S1, 0x00 + vld U1, S1, 0x10 + vld U2, S2, 0x00 + vld U3, S2, 0x10 + + vand.v D0, U2, U2 + vand.v D1, U3, U3 + vand.v D2, U2, U2 + vand.v D3, U3, U3 + + vpermi.w D0, U0, 0x44 + vpermi.w D2, U0, 0xee + vpermi.w D1, U1, 0x44 + vpermi.w D3, U1, 0xee + + vst D0, TD, 0x00 + vst D2, TD, 0x10 + vst D1, TD, 0x20 + vst D3, TD, 0x30 + + addi.d S1, S1, 0x20 // a_offset + addi.d S2, S2, 0x20 + addi.d TD, TD, 0x40 // b_offset + + addi.d I, I, -1 + blt ZERO, I, .L_N11 + +.L_N10: /* if(m&2) */ + andi I, M, 0x02 + beq I, ZERO, .L_N130 + + vld U0, S1, 0x00 + vld U1, S2, 0x00 + vand.v D0, U1, U1 + + vpermi.w D0, U0, 0x44 + vpermi.w U1, U0, 0xee + + vst D0, TD, 0x00 + vst U1, TD, 0x10 + + addi.d S1, S1, 0x10 // a_offset + addi.d S2, S2, 0x10 + addi.d TD, TD, 0x20 // b_offset + +.L_N130: /* if(m&1) */ + andi I, M, 0x01 + beq I, ZERO, .L_N20 + + fld.s F0, S1, 0x00 + fld.s F1, S1, 0x04 + + fld.s F2, S2, 0x00 + fld.s F3, S2, 0x04 + + fst.s F0, TD, 0x00 + fst.s F1, TD, 0x04 + fst.s F2, TD, 0x08 + fst.s F3, TD, 0x0c + + addi.d TD, TD, 0x10 + +.L_N20: /* if(n&1) */ + andi I, N, 0x01 + beq I, ZERO, .L_N00 + + move S1, TS + srai.d I, M, 0x02 + + beq I, ZERO, .L_N30 + +.L_N21: /* if(i>0) */ + vld U0, S1, 0x00 + vld U1, S1, 0x10 + + vst U0, TD, 0x00 + vst U1, TD, 0x10 + + addi.d S1, S1, 0x20 // aoffset1 + addi.d TD, TD, 0x20 // b_offset + + addi.d I, I, -1 + blt ZERO, I, .L_N21 + +.L_N30: /* if(m&2) */ + andi I, M, 0x02 + beq I, ZERO, .L_N330 + + vld U0, S1, 0x00 + + vst U0, TD, 0x00 + + addi.d S1, S1, 0x10 // aoffset1 + addi.d TD, TD, 0x10 // b_offset + +.L_N330: /* if(m&1) */ + andi I, M, 0x01 + beq I, ZERO, .L_N00 + + fld.s F0, S1, 0x00 + fld.s F1, S1, 0x04 + + fst.s F0, TD, 0x00 + fst.s F1, TD, 0x04 + +.L_N00: + LDARG $r23, $sp, 0 + addi.d $sp, $sp, 8 + jirl $r0, $r1, 0x00 + + EPILOGUE \ No newline at end of file diff --git a/kernel/loongarch64/cgemm_ncopy_8_lsx.S b/kernel/loongarch64/cgemm_ncopy_8_lsx.S new file mode 100644 index 000000000..87a88e37d --- /dev/null +++ b/kernel/loongarch64/cgemm_ncopy_8_lsx.S @@ -0,0 +1,263 @@ +/******************************************************************************* +Copyright (c) 2024, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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. +*******************************************************************************/ +#define ASSEMBLER + +#include "common.h" + +/* Function parameters */ +#define M $r4 // param 1: m +#define N $r5 // param 2: n +#define SRC $r6 // param 3: src +#define LDA $r7 // param 4: lda +#define DST $r8 // param 5: dst + +#define I $r9 +#define J $r10 +#define S1 $r12 +#define S2 $r13 +#define S3 $r14 +#define S4 $r15 +#define S5 $r16 +#define S6 $r17 +#define S7 $r18 +#define S8 $r19 +#define TD $r20 +#define TS $r11 +#define TL $r7 +#define T0 $r23 +#define ZERO $r0 + +#define F0 $f0 +#define F1 $f1 +#define F2 $f2 +#define F3 $f3 +#define F4 $f4 +#define F5 $f5 +#define F6 $f6 +#define F7 $f7 + +/* LSX vectors */ +#define U0 $vr0 +#define U1 $vr1 +#define U2 $vr2 +#define U3 $vr3 +#define U4 $vr4 +#define U5 $vr5 +#define U6 $vr6 +#define U7 $vr7 +#define D0 $vr8 +#define D1 $vr9 +#define D2 $vr10 +#define D3 $vr11 +#define D4 $vr12 +#define D5 $vr13 +#define D6 $vr14 +#define D7 $vr15 +#define D8 $vr16 + + PROLOGUE + + addi.d $sp, $sp, -8 + SDARG $r23, $sp, 0 + + move TD, DST //boffset + move TS, SRC //aoffset + + slli.d TL, LDA, 0x02 //lda + slli.d TL, TL, 0x01 + + slli.d T0, TL, 0x03 + srai.d J, N, 0x03 //j + + beq J, ZERO, .L_N1 + +.L_J1: /* if(j>0) j--*/ + move S1, TS + add.d S2, TS, TL + move I, M + add.d S3, S2, TL + add.d S4, S3, TL + add.d S5, S4, TL + add.d S6, S5, TL + add.d S7, S6, TL + add.d S8, S7, TL + add.d TS, TS, T0 + + beq I, ZERO, .L_J11 + +.L_I1: /* if(i>0) i--*/ + fld.s F0, S1, 0x00 + fld.s F1, S1, 0x04 + fld.s F2, S2, 0x00 + fld.s F3, S2, 0x04 + fld.s F4, S3, 0x00 + fld.s F5, S3, 0x04 + fld.s F6, S4, 0x00 + fld.s F7, S4, 0x04 + + fst.s F0, TD, 0x00 + fst.s F1, TD, 0x04 + fst.s F2, TD, 0x08 + fst.s F3, TD, 0x0c + fst.s F4, TD, 0x10 + fst.s F5, TD, 0x14 + fst.s F6, TD, 0x18 + fst.s F7, TD, 0x1c + + fld.s F0, S5, 0x00 + fld.s F1, S5, 0x04 + fld.s F2, S6, 0x00 + fld.s F3, S6, 0x04 + fld.s F4, S7, 0x00 + fld.s F5, S7, 0x04 + fld.s F6, S8, 0x00 + fld.s F7, S8, 0x04 + + fst.s F0, TD, 0x20 + fst.s F1, TD, 0x24 + fst.s F2, TD, 0x28 + fst.s F3, TD, 0x2c + fst.s F4, TD, 0x30 + fst.s F5, TD, 0x34 + fst.s F6, TD, 0x38 + fst.s F7, TD, 0x3c + + addi.d S1, S1, 0x08 + addi.d S2, S2, 0x08 + addi.d S3, S3, 0x08 + addi.d S4, S4, 0x08 + addi.d S5, S5, 0x08 + addi.d S6, S6, 0x08 + addi.d S7, S7, 0x08 + addi.d S8, S8, 0x08 + addi.d TD, TD, 0x40 + + addi.d I, I, -1 + blt ZERO, I, .L_I1 + +.L_J11: /* j--*/ + addi.d J, J, -1 + blt ZERO, J, .L_J1 + +.L_N1: /* if(n&4)*/ + andi I, N, 0x04 + beq I, ZERO, .L_N2 + + move S1, TS + add.d S2, TS, TL + move I, M + add.d S3, S2, TL + add.d S4, S3, TL + add.d TS, S4, TL + + beq I, ZERO, .L_N2 + +.L_N11: /* if(i>0)*/ + fld.s F0, S1, 0x00 + fld.s F1, S1, 0x04 + fld.s F2, S2, 0x00 + fld.s F3, S2, 0x04 + fld.s F4, S3, 0x00 + fld.s F5, S3, 0x04 + fld.s F6, S4, 0x00 + fld.s F7, S4, 0x04 + + fst.s F0, TD, 0x00 + fst.s F1, TD, 0x04 + fst.s F2, TD, 0x08 + fst.s F3, TD, 0x0c + fst.s F4, TD, 0x10 + fst.s F5, TD, 0x14 + fst.s F6, TD, 0x18 + fst.s F7, TD, 0x1c + + addi.d S1, S1, 0x08 + addi.d S2, S2, 0x08 + addi.d S3, S3, 0x08 + addi.d S4, S4, 0x08 + addi.d TD, TD, 0x20 + + addi.d I, I, -1 + blt ZERO, I, .L_N11 + +.L_N2: /* if(n&2)*/ + andi I, N, 0x02 + beq I, ZERO, .L_N3 + + move S1, TS + add.d S2, TS, TL + move I, M + add.d TS, S2, TL + + beq I, ZERO, .L_N3 + +.L_N21: /* if(i>0)*/ + fld.s F0, S1, 0x00 + fld.s F1, S1, 0x04 + fld.s F2, S2, 0x00 + fld.s F3, S2, 0x04 + + fst.s F0, TD, 0x00 + fst.s F1, TD, 0x04 + fst.s F2, TD, 0x08 + fst.s F3, TD, 0x0c + + addi.d S1, S1, 0x08 + addi.d S2, S2, 0x08 + addi.d TD, TD, 0x10 + + addi.d I, I, -1 + blt ZERO, I, .L_N21 + +.L_N3: /* if(n&2)*/ + andi I, N, 0x01 + beq I, ZERO, .L_N0 + + move S1, TS + move I, M + + beq I, ZERO, .L_N0 + +.L_N31: /* if(i>0)*/ + fld.s F0, S1, 0x00 + fld.s F1, S1, 0x04 + + fst.s F0, TD, 0x00 + fst.s F1, TD, 0x04 + + addi.d S1, S1, 0x08 + addi.d TD, TD, 0x08 + + addi.d I, I, -1 + blt ZERO, I, .L_N31 + +.L_N0: + LDARG $r23, $sp, 0 + addi.d $sp, $sp, 8 + jirl $r0, $r1, 0x00 + + EPILOGUE \ No newline at end of file diff --git a/kernel/loongarch64/cgemm_tcopy_4_lsx.S b/kernel/loongarch64/cgemm_tcopy_4_lsx.S new file mode 100644 index 000000000..6d63d62e7 --- /dev/null +++ b/kernel/loongarch64/cgemm_tcopy_4_lsx.S @@ -0,0 +1,324 @@ +/******************************************************************************* +Copyright (c) 2024, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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. +*******************************************************************************/ +#define ASSEMBLER + +#include "common.h" + +/* Function parameters */ +#define M $r4 // param 1: m +#define N $r5 // param 2: n +#define SRC $r6 // param 3: src +#define LDA $r7 // param 4: lda +#define DST $r8 // param 5: dst + +#define I $r9 +#define J $r10 +#define S1 $r12 +#define S2 $r13 +#define S3 $r14 +#define S4 $r15 +#define TD $r16 +#define TS $r17 +#define TL $r18 +#define T0 $r19 +#define S8 $r20 +#define S9 $r23 +#define S10 $r11 +#define ZERO $r0 + +#define F0 $f0 +#define F1 $f1 +#define F2 $f2 +#define F3 $f3 +#define F4 $f4 +#define F5 $f5 +#define F6 $f6 +#define F7 $f7 + +/* LSX vectors */ +#define U0 $vr0 +#define U1 $vr1 +#define U2 $vr2 +#define U3 $vr3 +#define U4 $vr4 +#define U5 $vr5 +#define U6 $vr6 +#define U7 $vr7 +#define U8 $vr8 +#define U9 $vr9 +#define U10 $vr10 +#define U11 $vr11 +#define U12 $vr12 +#define U13 $vr13 +#define U14 $vr14 +#define U15 $vr15 + + + PROLOGUE + + addi.d $sp, $sp, -8 + SDARG $r23, $sp, 0 + + move TS, SRC //aoffset + move TD, DST //boffset + slli.d TL, LDA, 0x02 //lda + slli.d TL, TL, 0x01 //lda + + ori T0, ZERO, 0x03 + andn T0, N, T0 + mul.w T0, M, T0 + slli.d T0, T0, 0x01 + slli.d T0, T0, 0x02 + add.d S9, DST, T0 //boffset2 + + ori T0, ZERO, 0x01 + andn T0, N, T0 + mul.w T0, M, T0 + slli.d T0, T0, 0x01 + slli.d T0, T0, 0x02 + add.d S10, DST, T0 //boffset3 + + srai.d J, M, 0x02 //j + + beq J, ZERO, .L_M1 + +.L_J1: /* if(j>0) j--*/ + move S1, TS //aoffset1 + add.d S2, S1, TL + add.d S3, S2, TL + add.d S4, S3, TL + + slli.d T0, TL, 0x02 + add.d TS, TS, T0 + + move S8, TD //boffset1 + addi.d TD, TD, 0x80 + + srai.d I, N, 0x02 + + beq ZERO, I, .L_JN1 + +.L_JI1: /* if(i>0) i--*/ + vld U0, S1, 0x00 + vld U1, S1, 0x10 + + vld U2, S2, 0x00 + vld U3, S2, 0x10 + + vld U4, S3, 0x00 + vld U5, S3, 0x10 + + vld U6, S4, 0x00 + vld U7, S4, 0x10 + + vst U0, S8, 0x00 + vst U1, S8, 0x10 + vst U2, S8, 0x20 + vst U3, S8, 0x30 + vst U4, S8, 0x40 + vst U5, S8, 0x50 + vst U6, S8, 0x60 + vst U7, S8, 0x70 + + addi.d S1, S1, 0x20 + addi.d S2, S2, 0x20 + addi.d S3, S3, 0x20 + addi.d S4, S4, 0x20 + slli.d T0, M, 0x05 + add.d S8, S8, T0 + + addi.d I, I, -1 + blt ZERO, I, .L_JI1 + +.L_JN1: /* if(n&2) */ + andi I, N, 0x02 + beq ZERO, I, .L_JN2 + + vld U0, S1, 0x00 + vld U1, S2, 0x00 + vld U2, S3, 0x00 + vld U3, S4, 0x00 + + vst U0, S9, 0x00 + vst U1, S9, 0x10 + vst U2, S9, 0x20 + vst U3, S9, 0x30 + + addi.d S1, S1, 0x10 + addi.d S2, S2, 0x10 + addi.d S3, S3, 0x10 + addi.d S4, S4, 0x10 + addi.d S9, S9, 0x40 + +.L_JN2: /* if(n&1) */ + andi I, N, 0x01 + beq ZERO, I, .L_J0 + + fld.s F0, S1, 0x00 + fld.s F1, S1, 0x04 + + fld.s F2, S2, 0x00 + fld.s F3, S2, 0x04 + + fld.s F4, S3, 0x00 + fld.s F5, S3, 0x04 + + fld.s F6, S4, 0x00 + fld.s F7, S4, 0x04 + + fst.s F0, S10, 0x00 + fst.s F1, S10, 0x04 + fst.s F2, S10, 0x08 + fst.s F3, S10, 0x0c + fst.s F4, S10, 0x10 + fst.s F5, S10, 0x14 + fst.s F6, S10, 0x18 + fst.s F7, S10, 0x1c + + addi.d S10, S10, 0x20 + +.L_J0: + addi.d J, J, -1 + blt ZERO, J, .L_J1 + +.L_M1: /* if(m&2) */ + andi I, M, 0x02 + beq ZERO, I, .L_M2 + + move S1, TS //aoffset1 + add.d S2, S1, TL + + slli.d T0, TL, 0x01 + add.d TS, TS, T0 + + move S8, TD //boffset1 + addi.d TD, TD, 0x40 + + srai.d I, N, 0x02 + beq ZERO, I, .L_M1N1 + +.L_M1I1: /* if(i>0) */ + vld U0, S1, 0x00 + vld U1, S1, 0x10 + + vld U2, S2, 0x00 + vld U3, S2, 0x10 + + vst U0, S8, 0x00 + vst U1, S8, 0x10 + vst U2, S8, 0x20 + vst U3, S8, 0x30 + + addi.d S1, S1, 0x20 + addi.d S2, S2, 0x20 + slli.d T0, M, 0x05 + add.d S8, S8, T0 + + addi.d I, I, -1 + blt ZERO, I, .L_M1I1 + +.L_M1N1: /* if(n&2) */ + andi I, N, 0x02 + beq ZERO, I, .L_M1N2 + + vld U0, S1, 0x00 + vld U1, S2, 0x00 + + vst U0, S9, 0x00 + vst U1, S9, 0x10 + + addi.d S1, S1, 0x10 + addi.d S2, S2, 0x10 + addi.d S9, S9, 0x20 + +.L_M1N2: /* if(n&1) */ + andi I, N, 0x01 + beq ZERO, I, .L_M2 + + fld.s F0, S1, 0x00 + fld.s F1, S1, 0x04 + + fld.s F2, S2, 0x00 + fld.s F3, S2, 0x04 + + fst.s F0, S10, 0x00 + fst.s F1, S10, 0x04 + fst.s F2, S10, 0x08 + fst.s F3, S10, 0x0c + + addi.d S10, S10, 0x10 + +.L_M2: /* if(m&1) */ + andi I, M, 0x01 + beq ZERO, I, .L_M0 + + move S1, TS //aoffset1 + move S8, TD //boffset1 + + srai.d I, N, 0x02 + beq ZERO, I, .L_M2N1 + +.L_M2I1: /* if(i>0) */ + vld U0, S1, 0x00 + vld U1, S1, 0x10 + + vst U0, S8, 0x00 + vst U1, S8, 0x10 + + addi.d S1, S1, 0x20 + slli.d T0, M, 0x05 + add.d S8, S8, T0 + + addi.d I, I, -1 + blt ZERO, I, .L_M2I1 + +.L_M2N1: /* if(n&2) */ + andi I, N, 0x02 + beq ZERO, I, .L_M2N2 + + vld U0, S1, 0x00 + + vst U0, S9, 0x00 + + addi.d S1, S1, 0x10 + +.L_M2N2: /* if(n&1) */ + andi I, N, 0x01 + beq ZERO, I, .L_M0 + + fld.s F0, S1, 0x00 + fld.s F1, S1, 0x04 + + fst.s F0, S10, 0x00 + fst.s F1, S10, 0x04 + +.L_M0: + LDARG $r23, $sp, 0 + addi.d $sp, $sp, 8 + jirl $r0, $r1, 0x00 + + EPILOGUE \ No newline at end of file diff --git a/kernel/loongarch64/cgemm_tcopy_8_lsx.S b/kernel/loongarch64/cgemm_tcopy_8_lsx.S new file mode 100644 index 000000000..2935bbc07 --- /dev/null +++ b/kernel/loongarch64/cgemm_tcopy_8_lsx.S @@ -0,0 +1,277 @@ +/******************************************************************************* +Copyright (c) 2024, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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. +*******************************************************************************/ +#define ASSEMBLER + +#include "common.h" + +/* Function parameters */ +#define M $r4 // param 1: m +#define N $r5 // param 2: n +#define SRC $r6 // param 3: src +#define LDA $r7 // param 4: lda +#define DST $r8 // param 5: dst + +#define I $r9 +#define J $r10 +#define S1 $r12 +#define S2 $r13 +#define S3 $r14 +#define S4 $r15 +#define S5 $r16 +#define S6 $r17 +#define S7 $r18 +#define S8 $r19 +#define TD $r20 +#define TS $r11 +#define TL $r7 +#define T0 $r23 +#define ZERO $r0 + +#define F0 $f0 +#define F1 $f1 +#define F2 $f2 +#define F3 $f3 +#define F4 $f4 +#define F5 $f5 +#define F6 $f6 +#define F7 $f7 + +/* LASX vectors */ +#define U0 $vr0 +#define U1 $vr1 +#define U2 $vr2 +#define U3 $vr3 +#define U4 $vr4 +#define U5 $vr5 +#define U6 $vr6 +#define U7 $vr7 +#define D0 $vr8 +#define D1 $vr9 +#define D2 $vr10 +#define D3 $vr11 +#define D4 $vr12 +#define D5 $vr13 +#define D6 $vr14 +#define D7 $vr15 + + + PROLOGUE + + addi.d $sp, $sp, -8 + SDARG $r23, $sp, 0 + + move TS, SRC //aoffset + move TD, DST //boffset + slli.d TL, LDA, 0x02 //lda + slli.d TL, TL, 0x01 + + srai.d J, N, 0x03 //j + + beq J, ZERO, .L_N1 + +.L_J1: /* if(j>0) j--*/ + move S1, TS //aoffset1 + slli.d T0, TL, 0x01 //2*lda + add.d S2, TS, TL + addi.d TS, TS, 0x40 + + srai.d I, M, 0x01 + beq ZERO, I, .L_J1M1 + +.L_J1I1: /* if(i>0) i--*/ + vld U0, S1, 0x00 + vld U1, S1, 0x10 + vld U2, S1, 0x20 + vld U3, S1, 0x30 + + vld U4, S2, 0x00 + vld U5, S2, 0x10 + vld U6, S2, 0x20 + vld U7, S2, 0x30 + + vst U0, TD, 0x00 + vst U1, TD, 0x10 + vst U2, TD, 0x20 + vst U3, TD, 0x30 + vst U4, TD, 0x40 + vst U5, TD, 0x50 + vst U6, TD, 0x60 + vst U7, TD, 0x70 + + add.d S1, S1, T0 + add.d S2, S2, T0 + addi.d TD, TD, 0x80 + + addi.d I, I, -1 + blt ZERO, I, .L_J1I1 + +.L_J1M1: /* if(m&1) */ + andi I, M, 0x01 + beq ZERO, I, .L_J0 + + vld U0, S1, 0x00 + vld U1, S1, 0x10 + vld U2, S1, 0x20 + vld U3, S1, 0x30 + + vst U0, TD, 0x00 + vst U1, TD, 0x10 + vst U2, TD, 0x20 + vst U3, TD, 0x30 + + addi.d TD, TD, 0x40 + +.L_J0: + addi.d J, J, -1 + blt ZERO, J, .L_J1 + +.L_N1: /* if(n&4) */ + andi I, N, 0x04 + beq ZERO, I, .L_N2 + + move S1, TS //aoffset1 + slli.d T0, TL, 0x01 //2*lda + add.d S2, TS, TL + addi.d TS, TS, 0x20 + + srai.d I, M, 0x01 + beq ZERO, I, .L_N1M1 + +.L_N1I1: /* if(i>0) i-- */ + vld U0, S1, 0x00 + vld U1, S1, 0x10 + + vld U2, S2, 0x00 + vld U3, S2, 0x10 + + vst U0, TD, 0x00 + vst U1, TD, 0x10 + vst U2, TD, 0x20 + vst U3, TD, 0x30 + + add.d S1, S1, T0 + add.d S2, S2, T0 + addi.d TD, TD, 0x40 + + addi.d I, I, -1 + blt ZERO, I, .L_N1I1 + +.L_N1M1: /* if(m&1) */ + andi I, M, 0x01 + beq ZERO, I, .L_N2 + + vld U0, S1, 0x00 + vld U1, S1, 0x10 + + vst U0, TD, 0x00 + vst U1, TD, 0x10 + + addi.d TD, TD, 0x20 + +.L_N2: /* if(n&2) */ + andi I, N, 0x02 + beq ZERO, I, .L_N3 + + move S1, TS //aoffset1 + slli.d T0, TL, 0x01 //2*lda + add.d S2, TS, TL + addi.d TS, TS, 0x10 + + srai.d I, M, 0x01 + beq ZERO, I, .L_N2M1 + +.L_N2I1: /* if(i>0) i-- */ + vld U0, S1, 0x00 + vld U1, S2, 0x00 + + vst U0, TD, 0x00 + vst U1, TD, 0x10 + + add.d S1, S1, T0 + add.d S2, S2, T0 + + addi.d TD, TD, 0x20 + + addi.d I, I, -1 + blt ZERO, I, .L_N2I1 + +.L_N2M1: /* if(m&1) */ + andi I, M, 0x01 + beq ZERO, I, .L_N3 + + vld U0, S1, 0x00 + + vst U0, TD, 0x00 + + addi.d TD, TD, 0x10 + +.L_N3: /* if(n&1) */ + andi I, N, 0x01 + beq ZERO, I, .L_N0 + + move S1, TS //aoffset1 + slli.d T0, TL, 0x01 //2*lda + add.d S2, TS, TL + + srai.d I, M, 0x01 + beq ZERO, I, .L_N3M1 + +.L_N3I1: /* if(i>0) i-- */ + fld.s F0, S1, 0x00 + fld.s F1, S1, 0x04 + + fld.s F2, S2, 0x00 + fld.s F3, S2, 0x04 + + fst.s F0, TD, 0x00 + fst.s F1, TD, 0x04 + fst.s F2, TD, 0x08 + fst.s F3, TD, 0x0c + + add.d S1, S1, T0 + add.d S2, S2, T0 + addi.d TD, TD, 0x10 + + addi.d I, I, -1 + blt ZERO, I, .L_N3I1 + +.L_N3M1: /* if(m&1) */ + andi I, M, 0x01 + beq ZERO, I, .L_N0 + + fld.s F0, S1, 0x00 + fld.s F1, S1, 0x04 + + fst.s F0, TD, 0x00 + fst.s F1, TD, 0x04 + +.L_N0: + LDARG $r23, $sp, 0 + addi.d $sp, $sp, 8 + jirl $r0, $r1, 0x00 + + EPILOGUE \ No newline at end of file diff --git a/kernel/loongarch64/zgemm_kernel_4x4_lsx.S b/kernel/loongarch64/zgemm_kernel_4x4_lsx.S new file mode 100644 index 000000000..6c4841b24 --- /dev/null +++ b/kernel/loongarch64/zgemm_kernel_4x4_lsx.S @@ -0,0 +1,2316 @@ +/******************************************************************************* +Copyright (c) 2024, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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. +*******************************************************************************/ +#define ASSEMBLER + +#include "common.h" + + +/* Function parameters */ +#define M $r4 // param 1: bm +#define N $r5 // param 2: bn +#define K $r6 // param 3: bk +#define ALPHA_R $f0 // param 4: alphar +#define ALPHA_I $f1 // param 5: alphai +#define A $r7 // param 6: ba +#define B $r8 // param 7: bb +#define C $r9 // param 8: bc +#define LDC $r10 // param 9: ldc + +#if defined (TRMMKERNEL) +#define OFFSET $r11 // param 10: offset +#endif +#define OFF $r26 + +#define I $r12 +#define J $r13 +#define L $r14 +#define TL $r15 +#define A0 $r16 +#define B0 $r17 +#define C0 $r18 +#define C1 $r19 +#define C2 $r20 +#define C3 $r23 +#define T0 $r24 +#define T1 $r25 +#define T2 $r26 +#define T3 $r27 + +#define a1 $f2 +#define a2 $f3 +#define a3 $f4 +#define a4 $f5 +#define a5 $f6 +#define a6 $f7 +#define a7 $f8 +#define a8 $f9 +#define b1 $f10 +#define b2 $f11 +#define b3 $f12 +#define b4 $f13 +#define b5 $f14 +#define b6 $f15 +#define b7 $f16 +#define b8 $f17 +#define c11 $f18 +#define c12 $f19 +#define c21 $f20 +#define c22 $f21 +#define c31 $f22 +#define c32 $f23 +#define c41 $f24 +#define c42 $f25 + +/* LSX vectors */ +#define U0 $vr30 +#define U1 $vr31 +#define U2 $vr2 +#define U3 $vr3 +#define U4 $vr4 +#define U5 $vr5 +#define U6 $vr6 +#define U7 $vr7 +#define U8 $vr8 +#define U9 $vr9 +#define U10 $vr10 +#define U11 $vr11 +#define U12 $vr12 +#define U13 $vr13 +#define U14 $vr14 +#define U15 $vr15 +#define D0 $vr16 +#define D1 $vr17 +#define D2 $vr18 +#define D3 $vr19 +#define D4 $vr20 +#define D5 $vr21 +#define D6 $vr22 +#define D7 $vr23 +#define D8 $vr24 +#define D9 $vr25 +#define D10 $vr26 +#define D11 $vr27 +#define D12 $vr28 +#define D13 $vr29 +#define VALPHAR $vr28 +#define VALPHAI $vr29 + + +#if defined(NN) || defined(NT) || defined(TN) || defined(TT) +#define VMADD1 VFMADD +#define VMADD2 VFMADD +#define VMADD3 VNMSUB +#define VMADD4 VFMADD + +#define MADD1 MADD +#define MADD2 MADD +#define MADD3 NMSUB +#define MADD4 MADD +#endif + +#if defined(NR) || defined(NC) || defined(TR) || defined(TC) +#define VMADD1 VFMADD +#define VMADD2 VFMADD +#define VMADD3 VFMADD +#define VMADD4 VNMSUB + +#define MADD1 MADD +#define MADD2 MADD +#define MADD3 MADD +#define MADD4 NMSUB +#endif + +#if defined(RN) || defined(RT) || defined(CN) || defined(CT) +#define VMADD1 VFMADD +#define VMADD2 VNMSUB +#define VMADD3 VFMADD +#define VMADD4 VFMADD + +#define MADD1 MADD +#define MADD2 NMSUB +#define MADD3 MADD +#define MADD4 MADD +#endif + +#if defined(RR) || defined(RC) || defined(CR) || defined(CC) +#define VMADD1 VFMADD +#define VMADD2 VNMSUB +#define VMADD3 VNMSUB +#define VMADD4 VNMSUB + +#define MADD1 MADD +#define MADD2 NMSUB +#define MADD3 NMSUB +#define MADD4 NMSUB +#endif + + PROLOGUE + + addi.d $sp, $sp, -128 + SDARG $r23, $sp, 0 + SDARG $r24, $sp, 8 + SDARG $r25, $sp, 16 + SDARG $r26, $sp, 24 + SDARG $r27, $sp, 32 + ST $f23, $sp, 40 + ST $f24, $sp, 48 + ST $f25, $sp, 56 + ST $f26, $sp, 64 + ST $f27, $sp, 72 + ST $f28, $sp, 80 + ST $f29, $sp, 88 + ST $f30, $sp, 96 + ST $f31, $sp, 104 + ST ALPHA_R,$sp, 112 + ST ALPHA_I,$sp, 120 + + vldrepl.d VALPHAR, $sp, 112 + vldrepl.d VALPHAI, $sp, 120 + +#if defined (TRMMKERNEL) && !defined(LEFT) + sub.d OFF, $r0, OFFSET +#else + xor OFF, OFF, OFF +#endif + + slli.d LDC, LDC, BASE_SHIFT + + move J, $r0 + srai.d T0, N, 2 //bn/4 + beq J, T0, .L19 + +.L10: /* for(j=0; j0) */ + xvld U0, S1, 0x00 + xvld U1, S1, 0x20 + xvld U2, S2, 0x00 + xvld U3, S2, 0x20 + + xvand.v D0, U0, U0 + xvand.v D1, U1, U1 + xvand.v D2, U2, U2 + xvand.v D3, U3, U3 + + xvpermi.q D0, U2, 0x02 + xvpermi.q D2, U0, 0x31 + xvpermi.q D1, U3, 0x02 + xvpermi.q D3, U1, 0x31 + + xvst D0, TD, 0x00 + xvst D2, TD, 0x20 + xvst D1, TD, 0x40 + xvst D3, TD, 0x60 + + addi.d S1, S1, 0x40 // a_offset + addi.d S2, S2, 0x40 + addi.d TD, TD, 0x80 // b_offset + + addi.d I, I, -1 + blt ZERO, I, .L_N11 + +.L_N10: /* if(m&2) */ + andi I, M, 0x02 + beq I, ZERO, .L_N130 + + xvld U0, S1, 0x00 + xvld U1, S2, 0x00 + xvand.v D0, U0, U0 + + xvpermi.q D0, U1, 0x02 + xvpermi.q U1, U0, 0x31 + + xvst D0, TD, 0x00 + xvst U1, TD, 0x20 + + addi.d S1, S1, 0x20 // a_offset + addi.d S2, S2, 0x20 + addi.d TD, TD, 0x40 // b_offset + +.L_N130: /* if(m&1) */ + andi I, M, 0x01 + beq I, ZERO, .L_N20 + + vld $vr0, S1, 0x00 + vld $vr1, S2, 0x00 + + vst $vr0, TD, 0x00 + vst $vr1, TD, 0x10 + + addi.d TD, TD, 0x20 + +.L_N20: /* if(n&1) */ + andi I, N, 0x01 + beq I, ZERO, .L_N00 + + move S1, TS + srai.d I, M, 0x02 + + beq I, ZERO, .L_N30 + +.L_N21: /* if(i>0) */ + xvld U0, S1, 0x00 + xvld U1, S1, 0x20 + + xvst U0, TD, 0x00 + xvst U1, TD, 0x20 + + addi.d S1, S1, 0x40 // aoffset1 + addi.d TD, TD, 0x40 // b_offset + + addi.d I, I, -1 + blt ZERO, I, .L_N21 + +.L_N30: /* if(m&2) */ + andi I, M, 0x02 + beq I, ZERO, .L_N330 + + xvld U0, S1, 0x00 + xvst U0, TD, 0x00 + + addi.d S1, S1, 0x20 // aoffset1 + addi.d TD, TD, 0x20 // b_offset + +.L_N330: /* if(m&1) */ + andi I, M, 0x01 + beq I, ZERO, .L_N00 + + vld $vr0, S1, 0x00 + vst $vr0, TD, 0x00 + +.L_N00: + LDARG $r23, $sp, 0 + addi.d $sp, $sp, 8 + jirl $r0, $r1, 0x00 + + EPILOGUE \ No newline at end of file diff --git a/kernel/loongarch64/zgemm_ncopy_4_lsx.S b/kernel/loongarch64/zgemm_ncopy_4_lsx.S new file mode 100644 index 000000000..203471cbd --- /dev/null +++ b/kernel/loongarch64/zgemm_ncopy_4_lsx.S @@ -0,0 +1,332 @@ +/******************************************************************************* +Copyright (c) 2024, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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. +*******************************************************************************/ +#define ASSEMBLER + +#include "common.h" + +/* Function parameters */ +#define M $r4 // param 1: m +#define N $r5 // param 2: n +#define SRC $r6 // param 3: src +#define LDA $r7 // param 4: lda +#define DST $r8 // param 5: dst + +#define I $r9 +#define J $r10 +#define S1 $r12 +#define S2 $r13 +#define S3 $r14 +#define S4 $r15 +#define S5 $r16 +#define S6 $r17 +#define S7 $r18 +#define TD $r20 +#define TS $r11 +#define TL $r19 +#define T0 $r23 +#define ZERO $r0 + +#define F0 $f0 +#define F1 $f1 +#define F2 $f2 +#define F3 $f3 +#define F4 $f4 +#define F5 $f5 +#define F6 $f6 +#define F7 $f7 + +/* LSX vectors */ +#define U0 $vr0 +#define U1 $vr1 +#define U2 $vr2 +#define U3 $vr3 +#define U4 $vr4 +#define U5 $vr5 +#define U6 $vr6 +#define U7 $vr7 +#define U8 $vr8 +#define U9 $vr9 +#define U10 $vr10 +#define U11 $vr11 +#define U12 $vr12 +#define U13 $vr13 +#define U14 $vr14 +#define U15 $vr15 + + PROLOGUE + + addi.d $sp, $sp, -8 + SDARG $r23, $sp, 0 + + move TD, DST //boffset + move TS, SRC //aoffset + + slli.d TL, LDA, 0x03 + slli.d TL, TL, 0x01 + + srai.d J, N, 0x02 + beq J, ZERO, .L_N0 + +.L_J1: /* J-- */ + move S1, TS + add.d S2, S1, TL + add.d S3, S2, TL + add.d S4, S3, TL + + slli.d T0, TL, 0x02 + add.d TS, TS, T0 + + srai.d I, M, 0x02 + beq I, ZERO, .L_I3 + +.L_I1: /* I-- */ + vld U0, S1, 0x00 + vld U1, S1, 0x10 + vld U2, S1, 0x20 + vld U3, S1, 0x30 + + vld U4, S2, 0x00 + vld U5, S2, 0x10 + vld U6, S2, 0x20 + vld U7, S2, 0x30 + + vld U8, S3, 0x00 + vld U9, S3, 0x10 + vld U10, S3, 0x20 + vld U11, S3, 0x30 + + vld U12, S4, 0x00 + vld U13, S4, 0x10 + vld U14, S4, 0x20 + vld U15, S4, 0x30 + + vst U0, TD, 0x00 + vst U4, TD, 0x10 + vst U8, TD, 0x20 + vst U12, TD, 0x30 + + vst U1, TD, 0x40 + vst U5, TD, 0x50 + vst U9, TD, 0x60 + vst U13, TD, 0x70 + + vst U2, TD, 0x80 + vst U6, TD, 0x90 + vst U10, TD, 0xa0 + vst U14, TD, 0xb0 + + vst U3, TD, 0xc0 + vst U7, TD, 0xd0 + vst U11, TD, 0xe0 + vst U15, TD, 0xf0 + + addi.d S1, S1, 0x40 // a_offset + addi.d S2, S2, 0x40 + addi.d S3, S3, 0x40 + addi.d S4, S4, 0x40 + addi.d TD, TD, 0x100 // b_offset + + addi.d I, I, -1 + blt ZERO, I, .L_I1 + +.L_I3: /* if(m&2) */ + andi I, M, 0x02 + beq I, ZERO, .L_II20 + + vld U0, S1, 0x00 + vld U1, S1, 0x10 + + vld U2, S2, 0x00 + vld U3, S2, 0x10 + + vld U4, S3, 0x00 + vld U5, S3, 0x10 + + vld U6, S4, 0x00 + vld U7, S4, 0x10 + + vst U0, TD, 0x00 + vst U2, TD, 0x10 + vst U4, TD, 0x20 + vst U6, TD, 0x30 + + vst U1, TD, 0x40 + vst U3, TD, 0x50 + vst U5, TD, 0x60 + vst U7, TD, 0x70 + + addi.d S1, S1, 0x20 + addi.d S2, S2, 0x20 + addi.d S3, S3, 0x20 + addi.d S4, S4, 0x20 + addi.d TD, TD, 0x80 + +.L_II20: /* if(m&1) */ + andi I, M, 0x01 + beq I, ZERO, .L_J0 + + vld U0, S1, 0x00 + vld U1, S2, 0x00 + vld U2, S3, 0x00 + vld U3, S4, 0x00 + + vst U0, TD, 0x00 + vst U1, TD, 0x10 + vst U2, TD, 0x20 + vst U3, TD, 0x30 + + addi.d TD, TD, 0x40 + +.L_J0: + addi.d J, J, -1 + blt ZERO, J, .L_J1 + +.L_N0: /* if(n&2) */ + andi I, N, 0x02 + beq ZERO, I, .L_N20 + + move S1, TS + add.d S2, S1, TL + + slli.d T0, TL, 0x01 + add.d TS, TS, T0 + + srai.d I, M, 0x02 + beq ZERO, I, .L_N10 + +.L_N11: /* if(i>0) */ + vld U0, S1, 0x00 + vld U1, S1, 0x10 + vld U2, S1, 0x20 + vld U3, S1, 0x30 + + vld U4, S2, 0x00 + vld U5, S2, 0x10 + vld U6, S2, 0x20 + vld U7, S2, 0x30 + + vst U0, TD, 0x00 + vst U4, TD, 0x10 + vst U1, TD, 0x20 + vst U5, TD, 0x30 + + vst U2, TD, 0x40 + vst U6, TD, 0x50 + vst U3, TD, 0x60 + vst U7, TD, 0x70 + + addi.d S1, S1, 0x40 // a_offset + addi.d S2, S2, 0x40 + addi.d TD, TD, 0x80 // b_offset + + addi.d I, I, -1 + blt ZERO, I, .L_N11 + +.L_N10: /* if(m&2) */ + andi I, M, 0x02 + beq I, ZERO, .L_N130 + + vld U0, S1, 0x00 + vld U1, S1, 0x10 + + vld U2, S2, 0x00 + vld U3, S2, 0x10 + + vst U0, TD, 0x00 + vst U2, TD, 0x10 + vst U1, TD, 0x20 + vst U3, TD, 0x30 + + addi.d S1, S1, 0x20 // a_offset + addi.d S2, S2, 0x20 + addi.d TD, TD, 0x40 // b_offset + +.L_N130: /* if(m&1) */ + andi I, M, 0x01 + beq I, ZERO, .L_N20 + + vld U0, S1, 0x00 + vld U1, S2, 0x00 + + vst U0, TD, 0x00 + vst U1, TD, 0x10 + + addi.d TD, TD, 0x20 + +.L_N20: /* if(n&1) */ + andi I, N, 0x01 + beq I, ZERO, .L_N00 + + move S1, TS + srai.d I, M, 0x02 + + beq I, ZERO, .L_N30 + +.L_N21: /* if(i>0) */ + vld U0, S1, 0x00 + vld U1, S1, 0x10 + vld U2, S1, 0x20 + vld U3, S1, 0x30 + + vst U0, TD, 0x00 + vst U1, TD, 0x10 + vst U2, TD, 0x20 + vst U3, TD, 0x30 + + addi.d S1, S1, 0x40 // aoffset1 + addi.d TD, TD, 0x40 // b_offset + + addi.d I, I, -1 + blt ZERO, I, .L_N21 + +.L_N30: /* if(m&2) */ + andi I, M, 0x02 + beq I, ZERO, .L_N330 + + vld U0, S1, 0x00 + vld U1, S1, 0x10 + + vst U0, TD, 0x00 + vst U1, TD, 0x10 + + addi.d S1, S1, 0x20 // aoffset1 + addi.d TD, TD, 0x20 // b_offset + +.L_N330: /* if(m&1) */ + andi I, M, 0x01 + beq I, ZERO, .L_N00 + + vld U0, S1, 0x00 + + vst U0, TD, 0x00 + +.L_N00: + LDARG $r23, $sp, 0 + addi.d $sp, $sp, 8 + jirl $r0, $r1, 0x00 + + EPILOGUE \ No newline at end of file diff --git a/kernel/loongarch64/zgemm_ncopy_8_lasx.S b/kernel/loongarch64/zgemm_ncopy_8_lasx.S new file mode 100644 index 000000000..7cd8f605b --- /dev/null +++ b/kernel/loongarch64/zgemm_ncopy_8_lasx.S @@ -0,0 +1,263 @@ +/******************************************************************************* +Copyright (c) 2024, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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. +*******************************************************************************/ +#define ASSEMBLER + +#include "common.h" + +/* Function parameters */ +#define M $r4 // param 1: m +#define N $r5 // param 2: n +#define SRC $r6 // param 3: src +#define LDA $r7 // param 4: lda +#define DST $r8 // param 5: dst + +#define I $r9 +#define J $r10 +#define S1 $r12 +#define S2 $r13 +#define S3 $r14 +#define S4 $r15 +#define S5 $r16 +#define S6 $r17 +#define S7 $r18 +#define S8 $r19 +#define TD $r20 +#define TS $r11 +#define TL $r7 +#define T0 $r23 +#define ZERO $r0 + +#define F0 $f0 +#define F1 $f1 +#define F2 $f2 +#define F3 $f3 +#define F4 $f4 +#define F5 $f5 +#define F6 $f6 +#define F7 $f7 + +/* LASX vectors */ +#define U0 $xr0 +#define U1 $xr1 +#define U2 $xr2 +#define U3 $xr3 +#define U4 $xr4 +#define U5 $xr5 +#define U6 $xr6 +#define U7 $xr7 +#define D0 $xr8 +#define D1 $xr9 +#define D2 $xr10 +#define D3 $xr11 +#define D4 $xr12 +#define D5 $xr13 +#define D6 $xr14 +#define D7 $xr15 +#define D8 $xr16 + + PROLOGUE + + addi.d $sp, $sp, -8 + SDARG $r23, $sp, 0 + + move TD, DST //boffset + move TS, SRC //aoffset + + slli.d TL, LDA, 0x03 //lda + slli.d TL, TL, 0x01 + + slli.d T0, TL, 0x03 + srai.d J, N, 0x03 //j + + beq J, ZERO, .L_N1 + +.L_J1: /* if(j>0) j--*/ + move S1, TS + add.d S2, TS, TL + move I, M + add.d S3, S2, TL + add.d S4, S3, TL + add.d S5, S4, TL + add.d S6, S5, TL + add.d S7, S6, TL + add.d S8, S7, TL + add.d TS, TS, T0 + + beq I, ZERO, .L_J11 + +.L_I1: /* if(i>0) i--*/ + fld.d F0, S1, 0x00 + fld.d F1, S1, 0x08 + fld.d F2, S2, 0x00 + fld.d F3, S2, 0x08 + fld.d F4, S3, 0x00 + fld.d F5, S3, 0x08 + fld.d F6, S4, 0x00 + fld.d F7, S4, 0x08 + + fst.d F0, TD, 0x00 + fst.d F1, TD, 0x08 + fst.d F2, TD, 0x10 + fst.d F3, TD, 0x18 + fst.d F4, TD, 0x20 + fst.d F5, TD, 0x28 + fst.d F6, TD, 0x30 + fst.d F7, TD, 0x38 + + fld.d F0, S5, 0x00 + fld.d F1, S5, 0x08 + fld.d F2, S6, 0x00 + fld.d F3, S6, 0x08 + fld.d F4, S7, 0x00 + fld.d F5, S7, 0x08 + fld.d F6, S8, 0x00 + fld.d F7, S8, 0x08 + + fst.d F0, TD, 0x40 + fst.d F1, TD, 0x48 + fst.d F2, TD, 0x50 + fst.d F3, TD, 0x58 + fst.d F4, TD, 0x60 + fst.d F5, TD, 0x68 + fst.d F6, TD, 0x70 + fst.d F7, TD, 0x78 + + addi.d S1, S1, 0x10 + addi.d S2, S2, 0x10 + addi.d S3, S3, 0x10 + addi.d S4, S4, 0x10 + addi.d S5, S5, 0x10 + addi.d S6, S6, 0x10 + addi.d S7, S7, 0x10 + addi.d S8, S8, 0x10 + addi.d TD, TD, 0x80 + + addi.d I, I, -1 + blt ZERO, I, .L_I1 + +.L_J11: /* j--*/ + addi.d J, J, -1 + blt ZERO, J, .L_J1 + +.L_N1: /* if(n&4)*/ + andi I, N, 0x04 + beq I, ZERO, .L_N2 + + move S1, TS + add.d S2, TS, TL + move I, M + add.d S3, S2, TL + add.d S4, S3, TL + add.d TS, S4, TL + + beq I, ZERO, .L_N2 + +.L_N11: /* if(i>0)*/ + fld.d F0, S1, 0x00 + fld.d F1, S1, 0x08 + fld.d F2, S2, 0x00 + fld.d F3, S2, 0x08 + fld.d F4, S3, 0x00 + fld.d F5, S3, 0x08 + fld.d F6, S4, 0x00 + fld.d F7, S4, 0x08 + + fst.d F0, TD, 0x00 + fst.d F1, TD, 0x08 + fst.d F2, TD, 0x10 + fst.d F3, TD, 0x18 + fst.d F4, TD, 0x20 + fst.d F5, TD, 0x28 + fst.d F6, TD, 0x30 + fst.d F7, TD, 0x38 + + addi.d S1, S1, 0x10 + addi.d S2, S2, 0x10 + addi.d S3, S3, 0x10 + addi.d S4, S4, 0x10 + addi.d TD, TD, 0x40 + + addi.d I, I, -1 + blt ZERO, I, .L_N11 + +.L_N2: /* if(n&2)*/ + andi I, N, 0x02 + beq I, ZERO, .L_N3 + + move S1, TS + add.d S2, TS, TL + move I, M + add.d TS, S2, TL + + beq I, ZERO, .L_N3 + +.L_N21: /* if(i>0)*/ + fld.d F0, S1, 0x00 + fld.d F1, S1, 0x08 + fld.d F2, S2, 0x00 + fld.d F3, S2, 0x08 + + fst.d F0, TD, 0x00 + fst.d F1, TD, 0x08 + fst.d F2, TD, 0x10 + fst.d F3, TD, 0x18 + + addi.d S1, S1, 0x10 + addi.d S2, S2, 0x10 + addi.d TD, TD, 0x20 + + addi.d I, I, -1 + blt ZERO, I, .L_N21 + +.L_N3: /* if(n&2)*/ + andi I, N, 0x01 + beq I, ZERO, .L_N0 + + move S1, TS + move I, M + + beq I, ZERO, .L_N0 + +.L_N31: /* if(i>0)*/ + fld.d F0, S1, 0x00 + fld.d F1, S1, 0x08 + + fst.d F0, TD, 0x00 + fst.d F1, TD, 0x08 + + addi.d S1, S1, 0x10 + addi.d TD, TD, 0x10 + + addi.d I, I, -1 + blt ZERO, I, .L_N31 + +.L_N0: + LDARG $r23, $sp, 0 + addi.d $sp, $sp, 8 + jirl $r0, $r1, 0x00 + + EPILOGUE \ No newline at end of file diff --git a/kernel/loongarch64/zgemm_tcopy_4_lasx.S b/kernel/loongarch64/zgemm_tcopy_4_lasx.S new file mode 100644 index 000000000..1adee11c5 --- /dev/null +++ b/kernel/loongarch64/zgemm_tcopy_4_lasx.S @@ -0,0 +1,302 @@ +/******************************************************************************* +Copyright (c) 2024, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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. +*******************************************************************************/ +#define ASSEMBLER + +#include "common.h" + +/* Function parameters */ +#define M $r4 // param 1: m +#define N $r5 // param 2: n +#define SRC $r6 // param 3: src +#define LDA $r7 // param 4: lda +#define DST $r8 // param 5: dst + +#define I $r9 +#define J $r10 +#define S1 $r12 +#define S2 $r13 +#define S3 $r14 +#define S4 $r15 +#define TD $r16 +#define TS $r17 +#define TL $r18 +#define T0 $r19 +#define S8 $r20 +#define S9 $r23 +#define S10 $r11 +#define ZERO $r0 + +#define F0 $f0 +#define F1 $f1 +#define F2 $f2 +#define F3 $f3 +#define F4 $f4 +#define F5 $f5 +#define F6 $f6 +#define F7 $f7 + +/* LASX vectors */ +#define U0 $xr0 +#define U1 $xr1 +#define U2 $xr2 +#define U3 $xr3 +#define U4 $xr4 +#define U5 $xr5 +#define U6 $xr6 +#define U7 $xr7 +#define D0 $xr8 +#define D1 $xr9 +#define D2 $xr10 +#define D3 $xr11 +#define D4 $xr12 +#define D5 $xr13 +#define D6 $xr14 +#define D7 $xr15 + + + PROLOGUE + + addi.d $sp, $sp, -8 + SDARG $r23, $sp, 0 + + move TS, SRC //aoffset + move TD, DST //boffset + slli.d TL, LDA, 0x03 //lda + slli.d TL, TL, 0x01 //lda + + ori T0, ZERO, 0x03 + andn T0, N, T0 + mul.d T0, M, T0 + slli.d T0, T0, 0x01 + slli.d T0, T0, 0x03 + add.d S9, DST, T0 //boffset2 + + ori T0, ZERO, 0x01 + andn T0, N, T0 + mul.d T0, M, T0 + slli.d T0, T0, 0x01 + slli.d T0, T0, 0x03 + add.d S10, DST, T0 //boffset3 + + srai.d J, M, 0x02 //j + + beq J, ZERO, .L_M1 + +.L_J1: /* if(j>0) j--*/ + move S1, TS //aoffset1 + add.d S2, S1, TL + add.d S3, S2, TL + add.d S4, S3, TL + + slli.d T0, TL, 0x02 + add.d TS, TS, T0 + + move S8, TD //boffset1 + addi.d TD, TD, 0x100 + + srai.d I, N, 0x02 + + beq ZERO, I, .L_JN1 + +.L_JI1: /* if(i>0) i--*/ + xvld U0, S1, 0x00 + xvld U1, S1, 0x20 + xvld U2, S2, 0x00 + xvld U3, S2, 0x20 + xvld U4, S3, 0x00 + xvld U5, S3, 0x20 + xvld U6, S4, 0x00 + xvld U7, S4, 0x20 + + xvst U0, S8, 0x00 + xvst U1, S8, 0x20 + xvst U2, S8, 0x40 + xvst U3, S8, 0x60 + xvst U4, S8, 0x80 + xvst U5, S8, 0xa0 + xvst U6, S8, 0xc0 + xvst U7, S8, 0xe0 + + addi.d S1, S1, 0x40 + addi.d S2, S2, 0x40 + addi.d S3, S3, 0x40 + addi.d S4, S4, 0x40 + slli.d T0, M, 0x06 + add.d S8, S8, T0 + + addi.d I, I, -1 + blt ZERO, I, .L_JI1 + +.L_JN1: /* if(n&2) */ + andi I, N, 0x02 + beq ZERO, I, .L_JN2 + + xvld U0, S1, 0x00 + xvld U1, S2, 0x00 + xvld U2, S3, 0x00 + xvld U3, S4, 0x00 + + xvst U0, S9, 0x00 + xvst U1, S9, 0x20 + xvst U2, S9, 0x40 + xvst U3, S9, 0x60 + + addi.d S1, S1, 0x20 + addi.d S2, S2, 0x20 + addi.d S3, S3, 0x20 + addi.d S4, S4, 0x20 + addi.d S9, S9, 0x80 + +.L_JN2: /* if(n&1) */ + andi I, N, 0x01 + beq ZERO, I, .L_J0 + + vld $vr0, S1, 0x00 + vld $vr1, S2, 0x00 + vld $vr2, S3, 0x00 + vld $vr3, S4, 0x00 + + vst $vr0, S10, 0x00 + vst $vr1, S10, 0x10 + vst $vr2, S10, 0x20 + vst $vr3, S10, 0x30 + + addi.d S10, S10, 0x40 + +.L_J0: + addi.d J, J, -1 + blt ZERO, J, .L_J1 + +.L_M1: /* if(m&2) */ + andi I, M, 0x02 + beq ZERO, I, .L_M2 + + move S1, TS //aoffset1 + add.d S2, S1, TL + + slli.d T0, TL, 0x01 + add.d TS, TS, T0 + + move S8, TD //boffset1 + addi.d TD, TD, 0x80 + + srai.d I, N, 0x02 + beq ZERO, I, .L_M1N1 + +.L_M1I1: /* if(i>0) */ + xvld U0, S1, 0x00 + xvld U1, S1, 0x20 + xvld U2, S2, 0x00 + xvld U3, S2, 0x20 + + xvst U0, S8, 0x00 + xvst U1, S8, 0x20 + xvst U2, S8, 0x40 + xvst U3, S8, 0x60 + + addi.d S1, S1, 0x40 + addi.d S2, S2, 0x40 + slli.d T0, M, 0x06 + add.d S8, S8, T0 + + addi.d I, I, -1 + blt ZERO, I, .L_M1I1 + +.L_M1N1: /* if(n&2) */ + andi I, N, 0x02 + beq ZERO, I, .L_M1N2 + + xvld U0, S1, 0x00 + xvld U1, S2, 0x00 + + xvst U0, S9, 0x00 + xvst U1, S9, 0x20 + + addi.d S1, S1, 0x20 + addi.d S2, S2, 0x20 + addi.d S9, S9, 0x40 + +.L_M1N2: /* if(n&1) */ + andi I, N, 0x01 + beq ZERO, I, .L_M2 + + vld $vr0, S1, 0x00 + vld $vr1, S2, 0x00 + + vst $vr0, S10, 0x00 + vst $vr1, S10, 0x10 + + addi.d S10, S10, 0x20 + +.L_M2: /* if(m&1) */ + andi I, M, 0x01 + beq ZERO, I, .L_M0 + + move S1, TS //aoffset1 + move S8, TD //boffset1 + + srai.d I, N, 0x02 + beq ZERO, I, .L_M2N1 + +.L_M2I1: /* if(i>0) */ + xvld U0, S1, 0x00 + xvld U1, S1, 0x20 + + xvst U0, S8, 0x00 + xvst U1, S8, 0x20 + + addi.d S1, S1, 0x40 + slli.d T0, M, 0x06 + add.d S8, S8, T0 + + addi.d I, I, -1 + blt ZERO, I, .L_M2I1 + +.L_M2N1: /* if(n&2) */ + andi I, N, 0x02 + beq ZERO, I, .L_M2N2 + + xvld U0, S1, 0x00 + + xvst U0, S9, 0x00 + + addi.d S1, S1, 0x20 + +.L_M2N2: /* if(n&1) */ + andi I, N, 0x01 + beq ZERO, I, .L_M0 + + vld $vr0, S1, 0x00 + + vst $vr0, S10, 0x00 + +.L_M0: + LDARG $r23, $sp, 0 + addi.d $sp, $sp, 8 + jirl $r0, $r1, 0x00 + + EPILOGUE \ No newline at end of file diff --git a/kernel/loongarch64/zgemm_tcopy_4_lsx.S b/kernel/loongarch64/zgemm_tcopy_4_lsx.S new file mode 100644 index 000000000..954753eaf --- /dev/null +++ b/kernel/loongarch64/zgemm_tcopy_4_lsx.S @@ -0,0 +1,355 @@ +/******************************************************************************* +Copyright (c) 2024, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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. +*******************************************************************************/ +#define ASSEMBLER + +#include "common.h" + +/* Function parameters */ +#define M $r4 // param 1: m +#define N $r5 // param 2: n +#define SRC $r6 // param 3: src +#define LDA $r7 // param 4: lda +#define DST $r8 // param 5: dst + +#define I $r9 +#define J $r10 +#define S1 $r12 +#define S2 $r13 +#define S3 $r14 +#define S4 $r15 +#define TD $r16 +#define TS $r17 +#define TL $r18 +#define T0 $r19 +#define S8 $r20 +#define S9 $r23 +#define S10 $r11 +#define ZERO $r0 + +#define F0 $f0 +#define F1 $f1 +#define F2 $f2 +#define F3 $f3 +#define F4 $f4 +#define F5 $f5 +#define F6 $f6 +#define F7 $f7 + +/* LSX vectors */ +#define U0 $vr0 +#define U1 $vr1 +#define U2 $vr2 +#define U3 $vr3 +#define U4 $vr4 +#define U5 $vr5 +#define U6 $vr6 +#define U7 $vr7 +#define U8 $vr8 +#define U9 $vr9 +#define U10 $vr10 +#define U11 $vr11 +#define U12 $vr12 +#define U13 $vr13 +#define U14 $vr14 +#define U15 $vr15 + + + PROLOGUE + + addi.d $sp, $sp, -8 + SDARG $r23, $sp, 0 + + move TS, SRC //aoffset + move TD, DST //boffset + slli.d TL, LDA, 0x03 //lda + slli.d TL, TL, 0x01 //lda + + ori T0, ZERO, 0x03 + andn T0, N, T0 + mul.d T0, M, T0 + slli.d T0, T0, 0x01 + slli.d T0, T0, 0x03 + add.d S9, DST, T0 //boffset2 + + ori T0, ZERO, 0x01 + andn T0, N, T0 + mul.d T0, M, T0 + slli.d T0, T0, 0x01 + slli.d T0, T0, 0x03 + add.d S10, DST, T0 //boffset3 + + srai.d J, M, 0x02 //j + + beq J, ZERO, .L_M1 + +.L_J1: /* if(j>0) j--*/ + move S1, TS //aoffset1 + add.d S2, S1, TL + add.d S3, S2, TL + add.d S4, S3, TL + + slli.d T0, TL, 0x02 + add.d TS, TS, T0 + + move S8, TD //boffset1 + addi.d TD, TD, 0x100 + + srai.d I, N, 0x02 + + beq ZERO, I, .L_JN1 + +.L_JI1: /* if(i>0) i--*/ + vld U0, S1, 0x00 + vld U1, S1, 0x10 + vld U2, S1, 0x20 + vld U3, S1, 0x30 + + vld U4, S2, 0x00 + vld U5, S2, 0x10 + vld U6, S2, 0x20 + vld U7, S2, 0x30 + + vld U8, S3, 0x00 + vld U9, S3, 0x10 + vld U10, S3, 0x20 + vld U11, S3, 0x30 + + vld U12, S4, 0x00 + vld U13, S4, 0x10 + vld U14, S4, 0x20 + vld U15, S4, 0x30 + + vst U0, S8, 0x00 + vst U1, S8, 0x10 + vst U2, S8, 0x20 + vst U3, S8, 0x30 + vst U4, S8, 0x40 + vst U5, S8, 0x50 + vst U6, S8, 0x60 + vst U7, S8, 0x70 + + vst U8, S8, 0x80 + vst U9, S8, 0x90 + vst U10, S8, 0xa0 + vst U11, S8, 0xb0 + vst U12, S8, 0xc0 + vst U13, S8, 0xd0 + vst U14, S8, 0xe0 + vst U15, S8, 0xf0 + + addi.d S1, S1, 0x40 + addi.d S2, S2, 0x40 + addi.d S3, S3, 0x40 + addi.d S4, S4, 0x40 + slli.d T0, M, 0x06 + add.d S8, S8, T0 + + addi.d I, I, -1 + blt ZERO, I, .L_JI1 + +.L_JN1: /* if(n&2) */ + andi I, N, 0x02 + beq ZERO, I, .L_JN2 + + vld U0, S1, 0x00 + vld U1, S1, 0x10 + + vld U2, S2, 0x00 + vld U3, S2, 0x10 + + vld U4, S3, 0x00 + vld U5, S3, 0x10 + + vld U6, S4, 0x00 + vld U7, S4, 0x10 + + vst U0, S9, 0x00 + vst U1, S9, 0x10 + vst U2, S9, 0x20 + vst U3, S9, 0x30 + + vst U4, S9, 0x40 + vst U5, S9, 0x50 + vst U6, S9, 0x60 + vst U7, S9, 0x70 + + addi.d S1, S1, 0x20 + addi.d S2, S2, 0x20 + addi.d S3, S3, 0x20 + addi.d S4, S4, 0x20 + addi.d S9, S9, 0x80 + +.L_JN2: /* if(n&1) */ + andi I, N, 0x01 + beq ZERO, I, .L_J0 + + vld U0, S1, 0x00 + vld U1, S2, 0x00 + vld U2, S3, 0x00 + vld U3, S4, 0x00 + + vst U0, S10, 0x00 + vst U1, S10, 0x10 + vst U2, S10, 0x20 + vst U3, S10, 0x30 + + addi.d S10, S10, 0x40 + +.L_J0: + addi.d J, J, -1 + blt ZERO, J, .L_J1 + +.L_M1: /* if(m&2) */ + andi I, M, 0x02 + beq ZERO, I, .L_M2 + + move S1, TS //aoffset1 + add.d S2, S1, TL + + slli.d T0, TL, 0x01 + add.d TS, TS, T0 + + move S8, TD //boffset1 + addi.d TD, TD, 0x80 + + srai.d I, N, 0x02 + beq ZERO, I, .L_M1N1 + +.L_M1I1: /* if(i>0) */ + vld U0, S1, 0x00 + vld U1, S1, 0x10 + vld U2, S1, 0x20 + vld U3, S1, 0x30 + + vld U4, S2, 0x00 + vld U5, S2, 0x10 + vld U6, S2, 0x20 + vld U7, S2, 0x30 + + vst U0, S8, 0x00 + vst U1, S8, 0x10 + vst U2, S8, 0x20 + vst U3, S8, 0x30 + + vst U4, S8, 0x40 + vst U5, S8, 0x50 + vst U6, S8, 0x60 + vst U7, S8, 0x70 + + addi.d S1, S1, 0x40 + addi.d S2, S2, 0x40 + slli.d T0, M, 0x06 + add.d S8, S8, T0 + + addi.d I, I, -1 + blt ZERO, I, .L_M1I1 + +.L_M1N1: /* if(n&2) */ + andi I, N, 0x02 + beq ZERO, I, .L_M1N2 + + vld U0, S1, 0x00 + vld U1, S1, 0x10 + + vld U2, S2, 0x00 + vld U3, S2, 0x10 + + vst U0, S9, 0x00 + vst U1, S9, 0x10 + vst U2, S9, 0x20 + vst U3, S9, 0x30 + + addi.d S1, S1, 0x20 + addi.d S2, S2, 0x20 + addi.d S9, S9, 0x40 + +.L_M1N2: /* if(n&1) */ + andi I, N, 0x01 + beq ZERO, I, .L_M2 + + vld U0, S1, 0x00 + vld U1, S2, 0x00 + + vst U0, S10, 0x00 + vst U1, S10, 0x10 + + addi.d S10, S10, 0x20 + +.L_M2: /* if(m&1) */ + andi I, M, 0x01 + beq ZERO, I, .L_M0 + + move S1, TS //aoffset1 + move S8, TD //boffset1 + + srai.d I, N, 0x02 + beq ZERO, I, .L_M2N1 + +.L_M2I1: /* if(i>0) */ + vld U0, S1, 0x00 + vld U1, S1, 0x10 + vld U2, S1, 0x20 + vld U3, S1, 0x30 + + vst U0, S8, 0x00 + vst U1, S8, 0x10 + vst U2, S8, 0x20 + vst U3, S8, 0x30 + + addi.d S1, S1, 0x40 + slli.d T0, M, 0x06 + add.d S8, S8, T0 + + addi.d I, I, -1 + blt ZERO, I, .L_M2I1 + +.L_M2N1: /* if(n&2) */ + andi I, N, 0x02 + beq ZERO, I, .L_M2N2 + + vld U0, S1, 0x00 + vld U1, S1, 0x10 + + vst U0, S9, 0x00 + vst U1, S9, 0x10 + + addi.d S1, S1, 0x20 + +.L_M2N2: /* if(n&1) */ + andi I, N, 0x01 + beq ZERO, I, .L_M0 + + vld U0, S1, 0x00 + + vst U0, S10, 0x00 + +.L_M0: + LDARG $r23, $sp, 0 + addi.d $sp, $sp, 8 + jirl $r0, $r1, 0x00 + + EPILOGUE \ No newline at end of file diff --git a/kernel/loongarch64/zgemm_tcopy_8_lasx.S b/kernel/loongarch64/zgemm_tcopy_8_lasx.S new file mode 100644 index 000000000..f7440dc24 --- /dev/null +++ b/kernel/loongarch64/zgemm_tcopy_8_lasx.S @@ -0,0 +1,268 @@ +/******************************************************************************* +Copyright (c) 2024, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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. +*******************************************************************************/ +#define ASSEMBLER + +#include "common.h" + +/* Function parameters */ +#define M $r4 // param 1: m +#define N $r5 // param 2: n +#define SRC $r6 // param 3: src +#define LDA $r7 // param 4: lda +#define DST $r8 // param 5: dst + +#define I $r9 +#define J $r10 +#define S1 $r12 +#define S2 $r13 +#define S3 $r14 +#define S4 $r15 +#define S5 $r16 +#define S6 $r17 +#define S7 $r18 +#define S8 $r19 +#define TD $r20 +#define TS $r11 +#define TL $r7 +#define T0 $r23 +#define ZERO $r0 + +#define F0 $f0 +#define F1 $f1 +#define F2 $f2 +#define F3 $f3 +#define F4 $f4 +#define F5 $f5 +#define F6 $f6 +#define F7 $f7 + +/* LASX vectors */ +#define U0 $xr0 +#define U1 $xr1 +#define U2 $xr2 +#define U3 $xr3 +#define U4 $xr4 +#define U5 $xr5 +#define U6 $xr6 +#define U7 $xr7 +#define D0 $xr8 +#define D1 $xr9 +#define D2 $xr10 +#define D3 $xr11 +#define D4 $xr12 +#define D5 $xr13 +#define D6 $xr14 +#define D7 $xr15 + + + PROLOGUE + + addi.d $sp, $sp, -8 + SDARG $r23, $sp, 0 + + move TS, SRC //aoffset + move TD, DST //boffset + slli.d TL, LDA, 0x03 //lda + slli.d TL, TL, 0x01 + + srai.d J, N, 0x03 //j + + beq J, ZERO, .L_N1 + +.L_J1: /* if(j>0) j--*/ + move S1, TS //aoffset1 + slli.d T0, TL, 0x01 //2*lda + add.d S2, TS, TL + addi.d TS, TS, 0x80 + + srai.d I, M, 0x01 + beq ZERO, I, .L_J1M1 + +.L_J1I1: /* if(i>0) i--*/ + xvld U0, S1, 0x00 + xvld U1, S1, 0x20 + xvld U2, S1, 0x40 + xvld U3, S1, 0x60 + xvld U4, S2, 0x00 + xvld U5, S2, 0x20 + xvld U6, S2, 0x40 + xvld U7, S2, 0x60 + + xvst U0, TD, 0x00 + xvst U1, TD, 0x20 + xvst U2, TD, 0x40 + xvst U3, TD, 0x60 + xvst U4, TD, 0x80 + xvst U5, TD, 0xa0 + xvst U6, TD, 0xc0 + xvst U7, TD, 0xe0 + + add.d S1, S1, T0 + add.d S2, S2, T0 + addi.d TD, TD, 0x100 + + addi.d I, I, -1 + blt ZERO, I, .L_J1I1 + +.L_J1M1: /* if(m&1) */ + andi I, M, 0x01 + beq ZERO, I, .L_J0 + + xvld U0, S1, 0x00 + xvld U1, S1, 0x20 + xvld U2, S1, 0x40 + xvld U3, S1, 0x60 + + xvst U0, TD, 0x00 + xvst U1, TD, 0x20 + xvst U2, TD, 0x40 + xvst U3, TD, 0x60 + + addi.d TD, TD, 0x80 + +.L_J0: + addi.d J, J, -1 + blt ZERO, J, .L_J1 + +.L_N1: /* if(n&4) */ + andi I, N, 0x04 + beq ZERO, I, .L_N2 + + move S1, TS //aoffset1 + slli.d T0, TL, 0x01 //2*lda + add.d S2, TS, TL + addi.d TS, TS, 0x40 + + srai.d I, M, 0x01 + beq ZERO, I, .L_N1M1 + +.L_N1I1: /* if(i>0) i-- */ + xvld U0, S1, 0x00 + xvld U1, S1, 0x20 + xvld U2, S2, 0x00 + xvld U3, S2, 0x20 + + xvst U0, TD, 0x00 + xvst U1, TD, 0x20 + xvst U2, TD, 0x40 + xvst U3, TD, 0x60 + + add.d S1, S1, T0 + add.d S2, S2, T0 + addi.d TD, TD, 0x80 + + addi.d I, I, -1 + blt ZERO, I, .L_N1I1 + +.L_N1M1: /* if(m&1) */ + andi I, M, 0x01 + beq ZERO, I, .L_N2 + + xvld U0, S1, 0x00 + xvld U1, S1, 0x20 + + xvst U0, TD, 0x00 + xvst U1, TD, 0x20 + + addi.d TD, TD, 0x40 + +.L_N2: /* if(n&2) */ + andi I, N, 0x02 + beq ZERO, I, .L_N3 + + move S1, TS //aoffset1 + slli.d T0, TL, 0x01 //2*lda + add.d S2, TS, TL + addi.d TS, TS, 0x20 + + srai.d I, M, 0x01 + beq ZERO, I, .L_N2M1 + +.L_N2I1: /* if(i>0) i-- */ + xvld U0, S1, 0x00 + xvld U1, S2, 0x00 + + xvst U0, TD, 0x00 + xvst U1, TD, 0x20 + + add.d S1, S1, T0 + add.d S2, S2, T0 + + addi.d TD, TD, 0x40 + + addi.d I, I, -1 + blt ZERO, I, .L_N2I1 + +.L_N2M1: /* if(m&1) */ + andi I, M, 0x01 + beq ZERO, I, .L_N3 + + xvld U0, S1, 0x00 + + xvst U0, TD, 0x00 + + addi.d TD, TD, 0x20 + +.L_N3: /* if(n&1) */ + andi I, N, 0x01 + beq ZERO, I, .L_N0 + + move S1, TS //aoffset1 + slli.d T0, TL, 0x01 //2*lda + add.d S2, TS, TL + + srai.d I, M, 0x01 + beq ZERO, I, .L_N3M1 + +.L_N3I1: /* if(i>0) i-- */ + vld $vr0, S1, 0x00 + vld $vr1, S2, 0x00 + + vst $vr0, TD, 0x00 + vst $vr1, TD, 0x10 + + add.d S1, S1, T0 + add.d S2, S2, T0 + addi.d TD, TD, 0x20 + + addi.d I, I, -1 + blt ZERO, I, .L_N3I1 + +.L_N3M1: /* if(m&1) */ + andi I, M, 0x01 + beq ZERO, I, .L_N0 + + vld $vr0, S1, 0x00 + + vst $vr0, TD, 0x00 + +.L_N0: + LDARG $r23, $sp, 0 + addi.d $sp, $sp, 8 + jirl $r0, $r1, 0x00 + + EPILOGUE \ No newline at end of file diff --git a/param.h b/param.h index 003ea396f..5d2e960a2 100644 --- a/param.h +++ b/param.h @@ -2854,12 +2854,12 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define QGEMM_DEFAULT_UNROLL_N 2 #define CGEMM_DEFAULT_UNROLL_N 2 -#define ZGEMM_DEFAULT_UNROLL_N 2 +#define ZGEMM_DEFAULT_UNROLL_N 4 #define XGEMM_DEFAULT_UNROLL_N 1 #define QGEMM_DEFAULT_UNROLL_M 2 #define CGEMM_DEFAULT_UNROLL_M 2 -#define ZGEMM_DEFAULT_UNROLL_M 2 +#define ZGEMM_DEFAULT_UNROLL_M 8 #define XGEMM_DEFAULT_UNROLL_M 1 #define SGEMM_DEFAULT_P 256 @@ -2891,10 +2891,10 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define DGEMM_DEFAULT_UNROLL_M 8 #define DGEMM_DEFAULT_UNROLL_N 4 -#define CGEMM_DEFAULT_UNROLL_M 2 -#define CGEMM_DEFAULT_UNROLL_N 2 +#define CGEMM_DEFAULT_UNROLL_M 8 +#define CGEMM_DEFAULT_UNROLL_N 4 -#define ZGEMM_DEFAULT_UNROLL_M 1 +#define ZGEMM_DEFAULT_UNROLL_M 4 #define ZGEMM_DEFAULT_UNROLL_N 4 #define SGEMM_DEFAULT_P 128 From d4db6a9f16a5c82bbe1860f591cc731c4d83d7c8 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Tue, 6 Feb 2024 22:23:47 +0100 Subject: [PATCH 123/311] Separate the interface for SBGEMMT from GEMMT due to differences in GEMV arguments --- interface/CMakeLists.txt | 1 + interface/Makefile | 8 +- interface/gemmt.c | 3 +- interface/sbgemmt.c | 447 +++++++++++++++++++++++++++++++++++++++ 4 files changed, 452 insertions(+), 7 deletions(-) create mode 100644 interface/sbgemmt.c diff --git a/interface/CMakeLists.txt b/interface/CMakeLists.txt index ed19b556a..55374674a 100644 --- a/interface/CMakeLists.txt +++ b/interface/CMakeLists.txt @@ -119,6 +119,7 @@ endif () if (BUILD_BFLOAT16) GenerateNamedObjects("bf16dot.c" "" "sbdot" ${CBLAS_FLAG} "" "" true "BFLOAT16") GenerateNamedObjects("gemm.c" "" "sbgemm" ${CBLAS_FLAG} "" "" true "BFLOAT16") + GenerateNamedObjects("gemmt.c" "" "sbgemmt" ${CBLAS_FLAG} "" "" true "BFLOAT16") GenerateNamedObjects("sbgemv.c" "" "sbgemv" ${CBLAS_FLAG} "" "" true "BFLOAT16") GenerateNamedObjects("tobf16.c" "SINGLE_PREC" "sbstobf16" ${CBLAS_FLAG} "" "" true "BFLOAT16") GenerateNamedObjects("tobf16.c" "DOUBLE_PREC" "sbdtobf16" ${CBLAS_FLAG} "" "" true "BFLOAT16") diff --git a/interface/Makefile b/interface/Makefile index ad4a0fb89..048d679d6 100644 --- a/interface/Makefile +++ b/interface/Makefile @@ -1303,7 +1303,7 @@ xhpr2.$(SUFFIX) xhpr2.$(PSUFFIX) : zhpr2.c ifeq ($(BUILD_BFLOAT16),1) sbgemm.$(SUFFIX) sbgemm.$(PSUFFIX) : gemm.c ../param.h $(CC) -c $(CFLAGS) $< -o $(@F) -sbgemmt.$(SUFFIX) sbgemmt.$(PSUFFIX) : gemmt.c ../param.h +sbgemmt.$(SUFFIX) sbgemmt.$(PSUFFIX) : sbgemmt.c ../param.h $(CC) -c $(CFLAGS) $< -o $(@F) endif @@ -1662,10 +1662,6 @@ cblas_zaxpyc.$(SUFFIX) cblas_zaxpyc.$(PSUFFIX) : zaxpy.c cblas_xaxpyc.$(SUFFIX) cblas_xaxpyc.$(PSUFFIX) : zaxpy.c $(CC) $(CFLAGS) -DCBLAS -c -DCONJ $< -o $(@F) -sscal.$(SUFFIX) sscal.$(PSUFFIX) : scal.c - $(CC) $(CFLAGS) -c $< -o $(@F) - -dscal.$(SUFFIX) dscal.$(PSUFFIX) : scal.c cblas_zaxpy.$(SUFFIX) cblas_zaxpy.$(PSUFFIX) : zaxpy.c $(CC) $(CFLAGS) -DCBLAS -c $< -o $(@F) @@ -1971,7 +1967,7 @@ cblas_sgemmt.$(SUFFIX) cblas_sgemmt.$(PSUFFIX) : gemmt.c ../param.h $(CC) -DCBLAS -c $(CFLAGS) $< -o $(@F) ifeq ($(BUILD_BFLOAT16),1) -cblas_sbgemmt.$(SUFFIX) cblas_sbgemmt.$(PSUFFIX) : gemmt.c ../param.h +cblas_sbgemmt.$(SUFFIX) cblas_sbgemmt.$(PSUFFIX) : sbgemmt.c ../param.h $(CC) -DCBLAS -c $(CFLAGS) $< -o $(@F) endif diff --git a/interface/gemmt.c b/interface/gemmt.c index 8fd8089d0..018deb7fb 100644 --- a/interface/gemmt.c +++ b/interface/gemmt.c @@ -158,7 +158,8 @@ void NAME(char *UPLO, char *TRANSA, char *TRANSB, uplo = 0; if (Uplo == 'L') uplo = 1; - + + nrowa = m; if (transa & 1) nrowa = k; nrowb = k; #if defined(COMPLEX) diff --git a/interface/sbgemmt.c b/interface/sbgemmt.c new file mode 100644 index 000000000..759af4bfb --- /dev/null +++ b/interface/sbgemmt.c @@ -0,0 +1,447 @@ +/*********************************************************************/ +/* Copyright 2024, The OpenBLAS Project. */ +/* All rights reserved. */ +/* */ +/* Redistribution and use in source and binary forms, with or */ +/* without modification, are permitted provided that the following */ +/* conditions are met: */ +/* */ +/* 1. Redistributions of source code must retain the above */ +/* copyright notice, this list of conditions and the following */ +/* disclaimer. */ +/* */ +/* 2. 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. */ +/* */ +/* THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY OF TEXAS AT */ +/* AUSTIN ``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 UNIVERSITY OF TEXAS AT */ +/* AUSTIN 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 +#include +#include "common.h" + +#define SMP_THRESHOLD_MIN 65536.0 +#define ERROR_NAME "SBGEMMT " + +#ifndef GEMM_MULTITHREAD_THRESHOLD +#define GEMM_MULTITHREAD_THRESHOLD 4 +#endif + +#ifndef CBLAS + +void NAME(char *UPLO, char *TRANSA, char *TRANSB, + blasint * M, blasint * K, + FLOAT * Alpha, + IFLOAT * a, blasint * ldA, + IFLOAT * b, blasint * ldB, FLOAT * Beta, FLOAT * c, blasint * ldC) +{ + + blasint m, k; + blasint lda, ldb, ldc; + int transa, transb, uplo; + blasint info; + + char transA, transB, Uplo; + blasint nrowa, nrowb; + IFLOAT *buffer; + IFLOAT *aa, *bb; + FLOAT *cc; + FLOAT alpha, beta; + + PRINT_DEBUG_NAME; + + m = *M; + k = *K; + + alpha = *Alpha; + beta = *Beta; + + lda = *ldA; + ldb = *ldB; + ldc = *ldC; + + transA = *TRANSA; + transB = *TRANSB; + Uplo = *UPLO; + TOUPPER(transA); + TOUPPER(transB); + TOUPPER(Uplo); + + transa = -1; + transb = -1; + uplo = -1; + + if (transA == 'N') + transa = 0; + if (transA == 'T') + transa = 1; + + if (transA == 'R') + transa = 0; + if (transA == 'C') + transa = 1; + + if (transB == 'N') + transb = 0; + if (transB == 'T') + transb = 1; + + if (transB == 'R') + transb = 0; + if (transB == 'C') + transb = 1; + + if (Uplo == 'U') + uplo = 0; + if (Uplo == 'L') + uplo = 1; + nrowa = m; + if (transa & 1) nrowa = k; + nrowb = k; + if (transb & 1) nrowb = m; + + info = 0; + + if (ldc < MAX(1, m)) + info = 13; + if (ldb < MAX(1, nrowb)) + info = 10; + if (lda < MAX(1, nrowa)) + info = 8; + if (k < 0) + info = 5; + if (m < 0) + info = 4; + if (transb < 0) + info = 3; + if (transa < 0) + info = 2; + if (uplo < 0) + info = 1; + + if (info != 0) { + BLASFUNC(xerbla) (ERROR_NAME, &info, sizeof(ERROR_NAME)); + return; + } +#else + +void CNAME(enum CBLAS_ORDER order, enum CBLAS_UPLO Uplo, + enum CBLAS_TRANSPOSE TransA, enum CBLAS_TRANSPOSE TransB, blasint m, + blasint k, + FLOAT alpha, + IFLOAT * A, blasint LDA, + IFLOAT * B, blasint LDB, FLOAT beta, FLOAT * c, blasint ldc) +{ + IFLOAT *aa, *bb; + FLOAT *cc; + + int transa, transb, uplo; + blasint info; + blasint lda, ldb; + IFLOAT *a, *b; + XFLOAT *buffer; + + PRINT_DEBUG_CNAME; + + uplo = -1; + transa = -1; + transb = -1; + info = 0; + + if (order == CblasColMajor) { + if (Uplo == CblasUpper) uplo = 0; + if (Uplo == CblasLower) uplo = 1; + + if (TransA == CblasNoTrans) + transa = 0; + if (TransA == CblasTrans) + transa = 1; + + if (TransA == CblasConjNoTrans) + transa = 0; + if (TransA == CblasConjTrans) + transa = 1; + + if (TransB == CblasNoTrans) + transb = 0; + if (TransB == CblasTrans) + transb = 1; + + if (TransB == CblasConjNoTrans) + transb = 0; + if (TransB == CblasConjTrans) + transb = 1; + + a = (void *)A; + b = (void *)B; + lda = LDA; + ldb = LDB; + + info = -1; + + blasint nrowa; + blasint nrowb; + nrowa = m; + if (transa & 1) nrowa = k; + nrowb = k; + if (transb & 1) nrowb = m; + + if (ldc < MAX(1, m)) + info = 13; + if (ldb < MAX(1, nrowb)) + info = 10; + if (lda < MAX(1, nrowa)) + info = 8; + if (k < 0) + info = 5; + if (m < 0) + info = 4; + if (transb < 0) + info = 3; + if (transa < 0) + info = 2; + if (uplo < 0) + info = 1; + } + + if (order == CblasRowMajor) { + + a = (void *)B; + b = (void *)A; + + lda = LDB; + ldb = LDA; + + if (Uplo == CblasUpper) uplo = 0; + if (Uplo == CblasLower) uplo = 1; + + if (TransB == CblasNoTrans) + transa = 0; + if (TransB == CblasTrans) + transa = 1; + + if (TransB == CblasConjNoTrans) + transa = 0; + if (TransB == CblasConjTrans) + transa = 1; + + if (TransA == CblasNoTrans) + transb = 0; + if (TransA == CblasTrans) + transb = 1; + + if (TransA == CblasConjNoTrans) + transb = 0; + if (TransA == CblasConjTrans) + transb = 1; + + info = -1; + + blasint ncola; + blasint ncolb; + + ncola = m; + if (transa & 1) ncola = k; + ncolb = k; + + if (transb & 1) { + ncolb = m; + } + + if (ldc < MAX(1,m)) + info = 13; + if (ldb < MAX(1, ncolb)) + info = 8; + if (lda < MAX(1, ncola)) + info = 10; + if (k < 0) + info = 5; + if (m < 0) + info = 4; + if (transb < 0) + info = 2; + if (transa < 0) + info = 3; + if (uplo < 0) + info = 1; + } + + if (info >= 0) { + BLASFUNC(xerbla) (ERROR_NAME, &info, sizeof(ERROR_NAME)); + return; + } + +#endif + int buffer_size; + blasint i, j; + +#ifdef SMP + int nthreads; +#endif + + +#ifdef SMP + static int (*gemv_thread[]) (BLASLONG, BLASLONG, FLOAT, IFLOAT *, + BLASLONG, IFLOAT *, BLASLONG, FLOAT, + FLOAT *, BLASLONG, int) = { + sbgemv_thread_n, sbgemv_thread_t, + }; +#endif + int (*gemv[]) (BLASLONG, BLASLONG, FLOAT, IFLOAT *, BLASLONG, + IFLOAT *, BLASLONG, FLOAT, FLOAT *, BLASLONG) = { + SBGEMV_N, SBGEMV_T,}; + + + if (m == 0) + return; + + IDEBUG_START; + + const blasint incb = ((transb & 1) == 0) ? 1 : ldb; + + if (uplo == 1) { + for (i = 0; i < m; i++) { + j = m - i; + + aa = a + i; + bb = b + i * ldb; + if (transa & 1) { + aa = a + lda * i; + } + if (transb & 1) + bb = b + i; + cc = c + i * ldc + i; + +#if 0 + if (beta != ONE) + SCAL_K(l, 0, 0, beta, cc, 1, NULL, 0, NULL, 0); + + if (alpha == ZERO) + continue; +#endif + + IDEBUG_START; + + buffer_size = j + k + 128 / sizeof(FLOAT); +#ifdef WINDOWS_ABI + buffer_size += 160 / sizeof(FLOAT); +#endif + // for alignment + buffer_size = (buffer_size + 3) & ~3; + STACK_ALLOC(buffer_size, IFLOAT, buffer); + +#ifdef SMP + + if (1L * j * k < 2304L * GEMM_MULTITHREAD_THRESHOLD) + nthreads = 1; + else + nthreads = num_cpu_avail(2); + + if (nthreads == 1) { +#endif + + if (!(transa & 1)) + (gemv[(int)transa]) (j, k, alpha, aa, lda, + bb, incb, beta, cc, 1); + else + (gemv[(int)transa]) (k, j, alpha, aa, lda, + bb, incb, beta, cc, 1); + +#ifdef SMP + } else { + if (!(transa & 1)) + (gemv_thread[(int)transa]) (j, k, alpha, aa, + lda, bb, incb, beta, cc, + 1, nthreads); + else + (gemv_thread[(int)transa]) (k, j, alpha, aa, + lda, bb, incb, beta, cc, + 1, nthreads); + + } +#endif + + STACK_FREE(buffer); + } + } else { + + for (i = 0; i < m; i++) { + j = i + 1; + + bb = b + i * ldb; + if (transb & 1) { + bb = b + i; + } + cc = c + i * ldc; + +#if 0 + if (beta != ONE) + SCAL_K(l, 0, 0, beta, cc, 1, NULL, 0, NULL, 0); + + if (alpha == ZERO) + continue; +#endif + IDEBUG_START; + + buffer_size = j + k + 128 / sizeof(FLOAT); +#ifdef WINDOWS_ABI + buffer_size += 160 / sizeof(FLOAT); +#endif + // for alignment + buffer_size = (buffer_size + 3) & ~3; + STACK_ALLOC(buffer_size, IFLOAT, buffer); + +#ifdef SMP + + if (1L * j * k < 2304L * GEMM_MULTITHREAD_THRESHOLD) + nthreads = 1; + else + nthreads = num_cpu_avail(2); + + if (nthreads == 1) { +#endif + + if (!(transa & 1)) + (gemv[(int)transa]) (j, k, alpha, a, lda, bb, + incb, beta, cc, 1); + else + (gemv[(int)transa]) (k, j, alpha, a, lda, bb, + incb, beta, cc, 1); + +#ifdef SMP + } else { + if (!(transa & 1)) + (gemv_thread[(int)transa]) (j, k, alpha, a, lda, + bb, incb, beta, cc, 1, + nthreads); + else + (gemv_thread[(int)transa]) (k, j, alpha, a, lda, + bb, incb, beta, cc, 1, + nthreads); + } +#endif + + STACK_FREE(buffer); + } + } + + IDEBUG_END; + + return; +} From 1ed69ea1c05d091ec4f38358939aad441b0b2d4a Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Tue, 6 Feb 2024 23:35:12 +0100 Subject: [PATCH 124/311] improve naming --- Makefile.system | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Makefile.system b/Makefile.system index 0353a4d21..49bd1cbed 100644 --- a/Makefile.system +++ b/Makefile.system @@ -1705,8 +1705,8 @@ endif endif ifeq ($(FIXED_LIBNAME),1) - LIBNAME = $(LIBPREFIX).$(LIBSUFFIX) - LIBNAME_P = $(LIBPREFIX)_p.$(LIBSUFFIX) + LIBNAME = $(LIBPREFIX)$(LIBSONAMEBASE)$(LIBNAMESUFFIX).$(LIBSUFFIX) + LIBNAME_P = $(LIBPREFIX)$(LISOBNAMEBASE)$(LIBNAMESUFFIX)_p.$(LIBSUFFIX) endif LIBDLLNAME = $(LIBPREFIX).dll From 9ef10ffa496b919c25aedbb4aa2fdb930901475a Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Tue, 6 Feb 2024 23:38:19 +0100 Subject: [PATCH 125/311] Handle prefixed and suffixed libnames, optionally suppress softlinking --- Makefile.install | 24 ++++++++++++++---------- openblas.pc.in | 2 +- 2 files changed, 15 insertions(+), 11 deletions(-) diff --git a/Makefile.install b/Makefile.install index 81f959177..e7d129cce 100644 --- a/Makefile.install +++ b/Makefile.install @@ -2,10 +2,12 @@ TOPDIR = . export GOTOBLAS_MAKEFILE = 1 -include $(TOPDIR)/Makefile.conf_last include ./Makefile.system +LNCMD = ln -fs ifdef THELIBNAME LIBNAME=$(THELIBNAME) LIBSONAME=$(THELIBSONAME) +LNCMD = true endif ifeq ($(INTERFACE64),1) USE_64BITINT=1 @@ -99,7 +101,7 @@ ifneq ($(NO_STATIC),1) @echo Copying the static library to $(DESTDIR)$(OPENBLAS_LIBRARY_DIR) @install -m644 $(LIBNAME) "$(DESTDIR)$(OPENBLAS_LIBRARY_DIR)" @cd "$(DESTDIR)$(OPENBLAS_LIBRARY_DIR)" ; \ - ln -fs $(LIBNAME) $(LIBPREFIX).$(LIBSUFFIX) + $(LNCMD) $(LIBNAME) $(LIBPREFIX).$(LIBSUFFIX) endif #for install shared library ifneq ($(NO_SHARED),1) @@ -107,21 +109,21 @@ ifneq ($(NO_SHARED),1) ifeq ($(OSNAME), $(filter $(OSNAME),Linux SunOS Android Haiku FreeBSD DragonFly)) @install -m755 $(LIBSONAME) "$(DESTDIR)$(OPENBLAS_LIBRARY_DIR)" @cd "$(DESTDIR)$(OPENBLAS_LIBRARY_DIR)" ; \ - ln -fs $(LIBSONAME) $(LIBPREFIX).so ; \ - ln -fs $(LIBSONAME) $(LIBPREFIX).so.$(MAJOR_VERSION) + $(LNCMD) $(LIBSONAME) $(LIBPREFIX).so ; \ + $(LNCMD) $(LIBSONAME) $(LIBPREFIX).so.$(MAJOR_VERSION) endif ifeq ($(OSNAME), $(filter $(OSNAME),OpenBSD NetBSD)) @cp $(LIBSONAME) "$(DESTDIR)$(OPENBLAS_LIBRARY_DIR)" @cd "$(DESTDIR)$(OPENBLAS_LIBRARY_DIR)" ; \ - ln -fs $(LIBSONAME) $(LIBPREFIX).so + $(LNCMD) $(LIBSONAME) $(LIBPREFIX).so endif ifeq ($(OSNAME), Darwin) @-cp $(LIBDYNNAME) "$(DESTDIR)$(OPENBLAS_LIBRARY_DIR)" @-install_name_tool -id "$(OPENBLAS_LIBRARY_DIR)/$(LIBPREFIX).$(MAJOR_VERSION).dylib" "$(DESTDIR)$(OPENBLAS_LIBRARY_DIR)/$(LIBDYNNAME)" @cd "$(DESTDIR)$(OPENBLAS_LIBRARY_DIR)" ; \ - ln -fs $(LIBDYNNAME) $(LIBPREFIX).dylib ; \ - ln -fs $(LIBDYNNAME) $(LIBPREFIX).$(MAJOR_VERSION).dylib + $(LNCMD) $(LIBDYNNAME) $(LIBPREFIX).dylib ; \ + $(LNCMD) $(LIBDYNNAME) $(LIBPREFIX).$(MAJOR_VERSION).dylib endif ifeq ($(OSNAME), WINNT) @-cp $(LIBDLLNAME) "$(DESTDIR)$(OPENBLAS_BINARY_DIR)" @@ -149,15 +151,15 @@ ifneq ($(NO_STATIC),1) @echo Copying the static library to $(DESTDIR)$(OPENBLAS_LIBRARY_DIR) @installbsd -c -m 644 $(LIBNAME) "$(DESTDIR)$(OPENBLAS_LIBRARY_DIR)" @cd "$(DESTDIR)$(OPENBLAS_LIBRARY_DIR)" ; \ - ln -fs $(LIBNAME) $(LIBPREFIX).$(LIBSUFFIX) + $(LNCMD) $(LIBNAME) $(LIBPREFIX).$(LIBSUFFIX) endif #for install shared library ifneq ($(NO_SHARED),1) @echo Copying the shared library to $(DESTDIR)$(OPENBLAS_LIBRARY_DIR) @installbsd -c -m 755 $(LIBSONAME) "$(DESTDIR)$(OPENBLAS_LIBRARY_DIR)" @cd "$(DESTDIR)$(OPENBLAS_LIBRARY_DIR)" ; \ - ln -fs $(LIBSONAME) $(LIBPREFIX).so ; \ - ln -fs $(LIBSONAME) $(LIBPREFIX).so.$(MAJOR_VERSION) + $(LNCMD) $(LIBSONAME) $(LIBPREFIX).so ; \ + $(LNCMD) $(LIBSONAME) $(LIBPREFIX).so.$(MAJOR_VERSION) endif endif @@ -170,6 +172,8 @@ endif @echo Generating $(LIBSONAMEBASE)$(SUFFIX64).pc in "$(DESTDIR)$(OPENBLAS_PKGCONFIG_DIR)" @echo 'libdir='$(OPENBLAS_LIBRARY_DIR) > "$(PKGFILE)" + @echo 'libprefix='$(LIBPREFIX) >> "$(PKGFILE)" + @echo 'libnamesuffix='$(LIBNAMESUFFIX) >> "$(PKGFILE)" @echo 'libsuffix='$(SYMBOLSUFFIX) >> "$(PKGFILE)" @echo 'includedir='$(OPENBLAS_INCLUDE_DIR) >> "$(PKGFILE)" @echo 'openblas_config= USE_64BITINT='$(INTERFACE64) 'DYNAMIC_ARCH='$(DYNAMIC_ARCH) 'DYNAMIC_OLDER='$(DYNAMIC_OLDER) 'NO_CBLAS='$(NO_CBLAS) 'NO_LAPACK='$(NO_LAPACK) 'NO_LAPACKE='$(NO_LAPACKE) 'NO_AFFINITY='$(NO_AFFINITY) 'USE_OPENMP='$(USE_OPENMP) $(CORE) 'MAX_THREADS='$(NUM_THREADS)>> "$(PKGFILE)" @@ -186,7 +190,7 @@ endif ifneq ($(NO_SHARED),1) #ifeq logical or ifeq ($(OSNAME), $(filter $(OSNAME),Linux FreeBSD NetBSD OpenBSD DragonFly)) - @echo "SET(OpenBLAS_LIBRARIES ${OPENBLAS_LIBRARY_DIR}/$(LIBPREFIX).so)" >> "$(DESTDIR)$(OPENBLAS_CMAKE_DIR)/$(OPENBLAS_CMAKE_CONFIG)" + @echo "SET(OpenBLAS_LIBRARIES ${OPENBLAS_LIBRARY_DIR}/$(LIBPREFIX)$(LIBSONAMEBASE)$(LIBNAMESUFFIX).so)" >> "$(DESTDIR)$(OPENBLAS_CMAKE_DIR)/$(OPENBLAS_CMAKE_CONFIG)" endif ifeq ($(OSNAME), $(filter $(OSNAME),WINNT CYGWIN_NT)) @echo "SET(OpenBLAS_LIBRARIES ${OPENBLAS_BINARY_DIR}/$(LIBDLLNAME))" >> "$(DESTDIR)$(OPENBLAS_CMAKE_DIR)/$(OPENBLAS_CMAKE_CONFIG)" diff --git a/openblas.pc.in b/openblas.pc.in index 8ad6e8bee..6c27c462b 100644 --- a/openblas.pc.in +++ b/openblas.pc.in @@ -2,6 +2,6 @@ Name: openblas Description: OpenBLAS is an optimized BLAS library based on GotoBLAS2 1.13 BSD version Version: ${version} URL: https://github.com/xianyi/OpenBLAS -Libs: -L${libdir} -lopenblas${libsuffix} +Libs: -L${libdir} -l$(libprefix}openblas${libnamesuffix} Libs.private: ${extralib} Cflags: -I${includedir} From 25b300bbeebb03f781a94fe0a655f59cd20094a7 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Tue, 6 Feb 2024 23:40:01 +0100 Subject: [PATCH 126/311] improve internal names --- exports/Makefile | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/exports/Makefile b/exports/Makefile index 71c112c67..238623b04 100644 --- a/exports/Makefile +++ b/exports/Makefile @@ -133,7 +133,7 @@ libgoto_hpl.def : $(GENSYM) ifeq ($(OSNAME), Darwin) ifeq ($(FIXED_LIBNAME),1) -INTERNALNAME = $(LIBPREFIX).dylib +INTERNALNAME = $(LIBPREFIX)$(LIBSONAMEBASE)$(LIBNAMESUFFIX).dylib else INTERNALNAME = $(LIBPREFIX).$(MAJOR_VERSION).dylib endif @@ -174,7 +174,7 @@ FEXTRALIB += -lm EXTRALIB += -lm else ifeq ($(FIXED_LIBNAME),1) -INTERNALNAME = $(LIBPREFIX).so +INTERNALNAME = $(LIBPREFIX)$(LIBSONAMEBASE)$(LIBNAMESUFFIX).so else INTERNALNAME = $(LIBPREFIX).so.$(MAJOR_VERSION) endif From fb99fc2e6e4ec8ecdcfffe1ca1aeb787464d2825 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Wed, 7 Feb 2024 13:42:08 +0100 Subject: [PATCH 127/311] fix type conversion warnings --- test/compare_sgemm_sbgemm.c | 18 ++++++++++++++---- 1 file changed, 14 insertions(+), 4 deletions(-) diff --git a/test/compare_sgemm_sbgemm.c b/test/compare_sgemm_sbgemm.c index cf808b56d..4afa8bf93 100644 --- a/test/compare_sgemm_sbgemm.c +++ b/test/compare_sgemm_sbgemm.c @@ -81,6 +81,16 @@ float16to32 (bfloat16_bits f16) return f32.v; } +float +float32to16 (float32_bits f32) +{ + bfloat16_bits f16; + f16.bits.s = f32.bits.s; + f16.bits.e = f32.bits.e; + f16.bits.m = (uint32_t) f32.bits.m >> 16; + return f32.v; +} + int main (int argc, char *argv[]) { @@ -108,16 +118,16 @@ main (int argc, char *argv[]) A[j * k + i] = ((FLOAT) rand () / (FLOAT) RAND_MAX) + 0.5; B[j * k + i] = ((FLOAT) rand () / (FLOAT) RAND_MAX) + 0.5; C[j * k + i] = 0; - AA[j * k + i].v = *(uint32_t *) & A[j * k + i] >> 16; - BB[j * k + i].v = *(uint32_t *) & B[j * k + i] >> 16; + AA[j * k + i].v = float32to16( A[j * k + i] ); + BB[j * k + i].v = float32to16( B[j * k + i] ); CC[j * k + i] = 0; DD[j * k + i] = 0; } } SGEMM (&transA, &transB, &m, &n, &k, &alpha, A, &m, B, &k, &beta, C, &m); - SBGEMM (&transA, &transB, &m, &n, &k, &alpha, AA, - &m, BB, &k, &beta, CC, &m); + SBGEMM (&transA, &transB, &m, &n, &k, &alpha, (bfloat16*) AA, + &m, (bfloat16*)BB, &k, &beta, CC, &m); for (i = 0; i < n; i++) for (j = 0; j < m; j++) if (fabs (CC[i * m + j] - C[i * m + j]) > 1.0) From 08ce6b1c1c6468c26607353d516e0dc8c009f58e Mon Sep 17 00:00:00 2001 From: Chip Kerchner Date: Wed, 7 Feb 2024 07:54:06 -0600 Subject: [PATCH 128/311] Add missing CPU ID definitions for old versions of AIX. --- driver/others/dynamic_power.c | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/driver/others/dynamic_power.c b/driver/others/dynamic_power.c index 0454f186c..16320dc40 100644 --- a/driver/others/dynamic_power.c +++ b/driver/others/dynamic_power.c @@ -43,6 +43,13 @@ char *gotoblas_corename(void) { #define CPU_POWER9 9 #define CPU_POWER10 10 +#ifndef POWER_9 +#define POWER_9 0x20000 /* 9 class CPU */ +#endif +#ifndef POWER_10 +#define POWER_10 0x40000 /* 10 class CPU */ +#endif + #ifdef _AIX #include From 574912f534380b9df8d713407ecfc2de6175acb9 Mon Sep 17 00:00:00 2001 From: Chip Kerchner Date: Wed, 7 Feb 2024 07:54:06 -0600 Subject: [PATCH 129/311] Add missing CPU ID definitions for old versions of AIX. --- driver/others/dynamic_power.c | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/driver/others/dynamic_power.c b/driver/others/dynamic_power.c index 0454f186c..16320dc40 100644 --- a/driver/others/dynamic_power.c +++ b/driver/others/dynamic_power.c @@ -43,6 +43,13 @@ char *gotoblas_corename(void) { #define CPU_POWER9 9 #define CPU_POWER10 10 +#ifndef POWER_9 +#define POWER_9 0x20000 /* 9 class CPU */ +#endif +#ifndef POWER_10 +#define POWER_10 0x40000 /* 10 class CPU */ +#endif + #ifdef _AIX #include From e9f480111e1d5b6f69c8053f79375b0a4242712f Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Wed, 7 Feb 2024 19:57:18 +0100 Subject: [PATCH 130/311] fix sbgemm bfloat16 conversion errors introduced in PR 4488 --- test/compare_sgemm_sbgemm.c | 18 ++++++------------ 1 file changed, 6 insertions(+), 12 deletions(-) diff --git a/test/compare_sgemm_sbgemm.c b/test/compare_sgemm_sbgemm.c index 4afa8bf93..bc74233ab 100644 --- a/test/compare_sgemm_sbgemm.c +++ b/test/compare_sgemm_sbgemm.c @@ -81,16 +81,6 @@ float16to32 (bfloat16_bits f16) return f32.v; } -float -float32to16 (float32_bits f32) -{ - bfloat16_bits f16; - f16.bits.s = f32.bits.s; - f16.bits.e = f32.bits.e; - f16.bits.m = (uint32_t) f32.bits.m >> 16; - return f32.v; -} - int main (int argc, char *argv[]) { @@ -110,6 +100,8 @@ main (int argc, char *argv[]) float C[m * n]; bfloat16_bits AA[m * k], BB[k * n]; float DD[m * n], CC[m * n]; + bfloat16 atmp,btmp; + blasint one=1; for (j = 0; j < m; j++) { @@ -118,8 +110,10 @@ main (int argc, char *argv[]) A[j * k + i] = ((FLOAT) rand () / (FLOAT) RAND_MAX) + 0.5; B[j * k + i] = ((FLOAT) rand () / (FLOAT) RAND_MAX) + 0.5; C[j * k + i] = 0; - AA[j * k + i].v = float32to16( A[j * k + i] ); - BB[j * k + i].v = float32to16( B[j * k + i] ); + sbstobf16_(&one, &A[j*k+i], &one, &atmp, &one); + sbstobf16_(&one, &B[j*k+i], &one, &btmp, &one); + AA[j * k + i].v = atmp; + BB[j * k + i].v = btmp; CC[j * k + i] = 0; DD[j * k + i] = 0; } From ff10e6b6dc30e247eb0cabd00de610b48c615c91 Mon Sep 17 00:00:00 2001 From: kseniyazaytseva Date: Thu, 8 Feb 2024 00:19:54 +0300 Subject: [PATCH 131/311] Fix zero step tests --- utest/test_extensions/test_damin.c | 4 ++-- utest/test_extensions/test_dzamax.c | 7 +++---- utest/test_extensions/test_dzamin.c | 6 +++--- utest/test_extensions/test_idamin.c | 4 ++-- utest/test_extensions/test_isamin.c | 4 ++-- utest/test_extensions/test_samin.c | 6 +++--- utest/test_extensions/test_scamax.c | 7 +++---- utest/test_extensions/test_scamin.c | 6 +++--- 8 files changed, 21 insertions(+), 23 deletions(-) diff --git a/utest/test_extensions/test_damin.c b/utest/test_extensions/test_damin.c index d492343ed..fdd2bc658 100644 --- a/utest/test_extensions/test_damin.c +++ b/utest/test_extensions/test_damin.c @@ -60,12 +60,12 @@ CTEST(damin, step_zero){ blasint i; blasint N = ELEMENTS, inc = 0; double x[ELEMENTS]; - for (i = 0; i < N * inc; i ++) { + for (i = 0; i < N; i ++) { x[i] = i + 1000; } x[8] = 0.0; double amin = BLASFUNC(damin)(&N, x, &inc); - ASSERT_DBL_NEAR_TOL(0.0, amin, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(x[0], amin, DOUBLE_EPS); } /** diff --git a/utest/test_extensions/test_dzamax.c b/utest/test_extensions/test_dzamax.c index edea3de8f..bdb3a4f18 100644 --- a/utest/test_extensions/test_dzamax.c +++ b/utest/test_extensions/test_dzamax.c @@ -59,13 +59,12 @@ CTEST(dzamax, bad_args_N_0){ CTEST(dzamax, step_zero){ blasint i; blasint N = ELEMENTS * 2, inc = 0; - double x[ELEMENTS]; - for (i = 0; i < N * inc * 2; i ++) { + double x[ELEMENTS * 2]; + for (i = 0; i < N; i ++) { x[i] = i + 1000; } - x[8] = 0.0; double amax = BLASFUNC(dzamax)(&N, x, &inc); - ASSERT_DBL_NEAR_TOL(0.0, amax, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL((x[0] + x[1]), amax, DOUBLE_EPS); } /** diff --git a/utest/test_extensions/test_dzamin.c b/utest/test_extensions/test_dzamin.c index 916eede92..9fcf87b7b 100644 --- a/utest/test_extensions/test_dzamin.c +++ b/utest/test_extensions/test_dzamin.c @@ -59,13 +59,13 @@ CTEST(dzamin, bad_args_N_0){ CTEST(dzamin, step_zero){ blasint i; blasint N = ELEMENTS * 2, inc = 0; - double x[ELEMENTS]; - for (i = 0; i < N * inc * 2; i ++) { + double x[ELEMENTS * 2]; + for (i = 0; i < N; i ++) { x[i] = i + 1000; } x[8] = 0.0; double amin = BLASFUNC(dzamin)(&N, x, &inc); - ASSERT_DBL_NEAR_TOL(0.0, amin, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL((x[0] + x[1]), amin, DOUBLE_EPS); } /** diff --git a/utest/test_extensions/test_idamin.c b/utest/test_extensions/test_idamin.c index 9f099f666..6a7ed9d1e 100644 --- a/utest/test_extensions/test_idamin.c +++ b/utest/test_extensions/test_idamin.c @@ -62,7 +62,7 @@ CTEST(idamin, step_zero){ blasint i; blasint N = ELEMENTS, inc = 0; double x[ELEMENTS]; - for (i = 0; i < N * inc; i ++) { + for (i = 0; i < N; i ++) { x[i] = i + 1000; } x[8] = 0.0; @@ -435,7 +435,7 @@ CTEST(idamin, c_api_step_zero){ blasint i; blasint N = ELEMENTS, inc = 0; double x[ELEMENTS]; - for (i = 0; i < N * inc; i ++) { + for (i = 0; i < N; i ++) { x[i] = i + 1000; } x[8] = 0.0; diff --git a/utest/test_extensions/test_isamin.c b/utest/test_extensions/test_isamin.c index df8dead07..4ff235b83 100644 --- a/utest/test_extensions/test_isamin.c +++ b/utest/test_extensions/test_isamin.c @@ -62,7 +62,7 @@ CTEST(isamin, step_zero){ blasint i; blasint N = ELEMENTS, inc = 0; float x[ELEMENTS]; - for (i = 0; i < N * inc; i ++) { + for (i = 0; i < N; i ++) { x[i] = i + 1000; } x[8] = 0.0f; @@ -435,7 +435,7 @@ CTEST(isamin, c_api_step_zero){ blasint i; blasint N = ELEMENTS, inc = 0; float x[ELEMENTS]; - for (i = 0; i < N * inc; i ++) { + for (i = 0; i < N; i ++) { x[i] = i + 1000; } x[8] = 0.0f; diff --git a/utest/test_extensions/test_samin.c b/utest/test_extensions/test_samin.c index 5c747a0f6..2e3a73797 100644 --- a/utest/test_extensions/test_samin.c +++ b/utest/test_extensions/test_samin.c @@ -60,12 +60,12 @@ CTEST(samin, step_zero){ blasint i; blasint N = ELEMENTS, inc = 0; float x[ELEMENTS]; - for (i = 0; i < N * inc; i ++) { + for (i = 0; i < N; i ++) { x[i] = i + 1000; } - x[8] = 0.0f; + x[8] = 0.0; float amin = BLASFUNC(samin)(&N, x, &inc); - ASSERT_DBL_NEAR_TOL(0.0f, amin, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(x[0], amin, SINGLE_EPS); } /** diff --git a/utest/test_extensions/test_scamax.c b/utest/test_extensions/test_scamax.c index 39d7201ff..0f49ebfad 100644 --- a/utest/test_extensions/test_scamax.c +++ b/utest/test_extensions/test_scamax.c @@ -59,13 +59,12 @@ CTEST(scamax, bad_args_N_0){ CTEST(scamax, step_zero){ blasint i; blasint N = ELEMENTS * 2, inc = 0; - float x[ELEMENTS]; - for (i = 0; i < N * inc * 2; i ++) { + float x[ELEMENTS * 2]; + for (i = 0; i < N; i ++) { x[i] = i + 1000; } - x[8] = 0.0f; float amax = BLASFUNC(scamax)(&N, x, &inc); - ASSERT_DBL_NEAR_TOL(0.0f, amax, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL((x[0] + x[1]), amax, SINGLE_EPS); } /** diff --git a/utest/test_extensions/test_scamin.c b/utest/test_extensions/test_scamin.c index 4baa23184..0f0414a1c 100644 --- a/utest/test_extensions/test_scamin.c +++ b/utest/test_extensions/test_scamin.c @@ -59,13 +59,13 @@ CTEST(scamin, bad_args_N_0){ CTEST(scamin, step_zero){ blasint i; blasint N = ELEMENTS * 2, inc = 0; - float x[ELEMENTS]; - for (i = 0; i < N * inc * 2; i ++) { + float x[ELEMENTS * 2]; + for (i = 0; i < N; i ++) { x[i] = i + 1000; } x[8] = 0.0f; float amin = BLASFUNC(scamin)(&N, x, &inc); - ASSERT_DBL_NEAR_TOL(0.0f, amin, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL((x[0] + x[1]), amin, SINGLE_EPS); } /** From ec5cfe3bc8e7fb4fae09e961ea6169e01cd21fa3 Mon Sep 17 00:00:00 2001 From: kseniyazaytseva Date: Thu, 8 Feb 2024 00:21:38 +0300 Subject: [PATCH 132/311] Fix invalid tests --- utest/test_extensions/test_cgeadd.c | 6 +++--- utest/test_extensions/test_dgeadd.c | 6 +++--- utest/test_extensions/test_dimatcopy.c | 8 ++++---- utest/test_extensions/test_sgeadd.c | 6 +++--- utest/test_extensions/test_simatcopy.c | 8 ++++---- utest/test_extensions/test_zgeadd.c | 6 +++--- 6 files changed, 20 insertions(+), 20 deletions(-) diff --git a/utest/test_extensions/test_cgeadd.c b/utest/test_extensions/test_cgeadd.c index 0cf6cbf87..9b87ad9f3 100644 --- a/utest/test_extensions/test_cgeadd.c +++ b/utest/test_extensions/test_cgeadd.c @@ -349,7 +349,7 @@ CTEST(cgeadd, xerbla_lda_invalid) blasint lda = INVALID; blasint ldc = 1; - int expected_info = 6; + int expected_info = 5; int passed = check_badargs('F', order, m, n, lda, ldc, expected_info); ASSERT_EQUAL(TRUE, passed); @@ -682,7 +682,7 @@ CTEST(cgeadd, c_api_xerbla_n_invalid_row_major) blasint lda = 1; blasint ldc = 1; - int expected_info = 1; + int expected_info = 2; int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); ASSERT_EQUAL(TRUE, passed); @@ -730,7 +730,7 @@ CTEST(cgeadd, c_api_xerbla_m_invalid_row_major) blasint lda = 1; blasint ldc = 1; - int expected_info = 2; + int expected_info = 1; int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); ASSERT_EQUAL(TRUE, passed); diff --git a/utest/test_extensions/test_dgeadd.c b/utest/test_extensions/test_dgeadd.c index 4654c51a3..8f93a842e 100644 --- a/utest/test_extensions/test_dgeadd.c +++ b/utest/test_extensions/test_dgeadd.c @@ -346,7 +346,7 @@ CTEST(dgeadd, xerbla_lda_invalid) blasint lda = INVALID; blasint ldc = 1; - int expected_info = 6; + int expected_info = 5; int passed = check_badargs('F', order, m, n, lda, ldc, expected_info); ASSERT_EQUAL(TRUE, passed); @@ -680,7 +680,7 @@ CTEST(dgeadd, c_api_xerbla_n_invalid_row_major) blasint lda = 1; blasint ldc = 1; - int expected_info = 1; + int expected_info = 2; int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); ASSERT_EQUAL(TRUE, passed); @@ -728,7 +728,7 @@ CTEST(dgeadd, c_api_xerbla_m_invalid_row_major) blasint lda = 1; blasint ldc = 1; - int expected_info = 2; + int expected_info = 1; int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); ASSERT_EQUAL(TRUE, passed); diff --git a/utest/test_extensions/test_dimatcopy.c b/utest/test_extensions/test_dimatcopy.c index d2a16bbbf..811c356b3 100644 --- a/utest/test_extensions/test_dimatcopy.c +++ b/utest/test_extensions/test_dimatcopy.c @@ -856,7 +856,7 @@ CTEST(dimatcopy, xerbla_rowmajor_notrans_invalid_ldb) blasint lda_src = 100, lda_dst = 50; char order = 'R'; char trans = 'N'; - int expected_info = 9; + int expected_info = 8; int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); ASSERT_EQUAL(TRUE, passed); @@ -873,7 +873,7 @@ CTEST(dimatcopy, xerbla_rowmajor_trans_invalid_ldb) blasint lda_src = 100, lda_dst = 50; char order = 'R'; char trans = 'T'; - int expected_info = 9; + int expected_info = 8; int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); ASSERT_EQUAL(TRUE, passed); @@ -890,7 +890,7 @@ CTEST(dimatcopy, xerbla_colmajor_notrans_invalid_ldb) blasint lda_src = 100, lda_dst = 50; char order = 'C'; char trans = 'N'; - int expected_info = 9; + int expected_info = 8; int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); ASSERT_EQUAL(TRUE, passed); @@ -907,7 +907,7 @@ CTEST(dimatcopy, xerbla_colmajor_trans_invalid_ldb) blasint lda_src = 100, lda_dst = 50; char order = 'C'; char trans = 'T'; - int expected_info = 9; + int expected_info = 8; int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); ASSERT_EQUAL(TRUE, passed); diff --git a/utest/test_extensions/test_sgeadd.c b/utest/test_extensions/test_sgeadd.c index b42ce9c0e..171132b9d 100644 --- a/utest/test_extensions/test_sgeadd.c +++ b/utest/test_extensions/test_sgeadd.c @@ -349,7 +349,7 @@ CTEST(sgeadd, xerbla_lda_invalid) blasint lda = INVALID; blasint ldc = 1; - int expected_info = 6; + int expected_info = 5; int passed = check_badargs('F', order, m, n, lda, ldc, expected_info); ASSERT_EQUAL(TRUE, passed); @@ -682,7 +682,7 @@ CTEST(sgeadd, c_api_xerbla_n_invalid_row_major) blasint lda = 1; blasint ldc = 1; - int expected_info = 1; + int expected_info = 2; int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); ASSERT_EQUAL(TRUE, passed); @@ -730,7 +730,7 @@ CTEST(sgeadd, c_api_xerbla_m_invalid_row_major) blasint lda = 1; blasint ldc = 1; - int expected_info = 2; + int expected_info = 1; int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); ASSERT_EQUAL(TRUE, passed); diff --git a/utest/test_extensions/test_simatcopy.c b/utest/test_extensions/test_simatcopy.c index cf14d360c..ba388596d 100644 --- a/utest/test_extensions/test_simatcopy.c +++ b/utest/test_extensions/test_simatcopy.c @@ -856,7 +856,7 @@ CTEST(simatcopy, xerbla_rowmajor_notrans_invalid_ldb) blasint lda_src = 100, lda_dst = 50; char order = 'R'; char trans = 'N'; - int expected_info = 9; + int expected_info = 8; int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); ASSERT_EQUAL(TRUE, passed); @@ -873,7 +873,7 @@ CTEST(simatcopy, xerbla_rowmajor_trans_invalid_ldb) blasint lda_src = 100, lda_dst = 50; char order = 'R'; char trans = 'T'; - int expected_info = 9; + int expected_info = 8; int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); ASSERT_EQUAL(TRUE, passed); @@ -890,7 +890,7 @@ CTEST(simatcopy, xerbla_colmajor_notrans_invalid_ldb) blasint lda_src = 100, lda_dst = 50; char order = 'C'; char trans = 'N'; - int expected_info = 9; + int expected_info = 8; int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); ASSERT_EQUAL(TRUE, passed); @@ -907,7 +907,7 @@ CTEST(simatcopy, xerbla_colmajor_trans_invalid_ldb) blasint lda_src = 100, lda_dst = 50; char order = 'C'; char trans = 'T'; - int expected_info = 9; + int expected_info = 8; int passed = check_badargs(order, trans, m, n, lda_src, lda_dst, expected_info); ASSERT_EQUAL(TRUE, passed); diff --git a/utest/test_extensions/test_zgeadd.c b/utest/test_extensions/test_zgeadd.c index e50f86de0..7496ccf88 100644 --- a/utest/test_extensions/test_zgeadd.c +++ b/utest/test_extensions/test_zgeadd.c @@ -349,7 +349,7 @@ CTEST(zgeadd, xerbla_lda_invalid) blasint lda = INVALID; blasint ldc = 1; - int expected_info = 6; + int expected_info = 5; int passed = check_badargs('F', order, m, n, lda, ldc, expected_info); ASSERT_EQUAL(TRUE, passed); @@ -682,7 +682,7 @@ CTEST(zgeadd, c_api_xerbla_n_invalid_row_major) blasint lda = 1; blasint ldc = 1; - int expected_info = 1; + int expected_info = 2; int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); ASSERT_EQUAL(TRUE, passed); @@ -730,7 +730,7 @@ CTEST(zgeadd, c_api_xerbla_m_invalid_row_major) blasint lda = 1; blasint ldc = 1; - int expected_info = 2; + int expected_info = 1; int passed = check_badargs('C', order, m, n, lda, ldc, expected_info); ASSERT_EQUAL(TRUE, passed); From cfabc48190bb3ac1b5c6ace9ee560477394054c8 Mon Sep 17 00:00:00 2001 From: kseniyazaytseva Date: Thu, 8 Feb 2024 00:22:15 +0300 Subject: [PATCH 133/311] Update rotg tests --- utest/test_extensions/test_crotg.c | 24 ++++++++++++------------ utest/test_extensions/test_zrotg.c | 16 ++++++++-------- 2 files changed, 20 insertions(+), 20 deletions(-) diff --git a/utest/test_extensions/test_crotg.c b/utest/test_extensions/test_crotg.c index 9db7dc7d3..84875ccf7 100644 --- a/utest/test_extensions/test_crotg.c +++ b/utest/test_extensions/test_crotg.c @@ -48,10 +48,10 @@ CTEST(crotg, zero_a) float sc; BLASFUNC(crotg)(sa, sb, &sc, ss); ASSERT_DBL_NEAR_TOL(0.0f, sc, SINGLE_EPS); - ASSERT_DBL_NEAR_TOL(1.0f, ss[0], SINGLE_EPS); - ASSERT_DBL_NEAR_TOL(0.0f, ss[1], SINGLE_EPS); - ASSERT_DBL_NEAR_TOL(1.0f, sa[0], SINGLE_EPS); - ASSERT_DBL_NEAR_TOL(1.0f, sa[1], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(0.70711f, ss[0], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(-0.70711f, ss[1], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(1.41421f, sa[0], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(0.0f, sa[1], SINGLE_EPS); } /** @@ -83,8 +83,8 @@ CTEST(crotg, zero_real) float ss[2]; float sc; BLASFUNC(crotg)(sa, sb, &sc, ss); - ASSERT_DBL_NEAR_TOL(0.7071f, sc, SINGLE_EPS); - ASSERT_DBL_NEAR_TOL(0.7071f, ss[0], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(0.70711f, sc, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(0.70711f, ss[0], SINGLE_EPS); ASSERT_DBL_NEAR_TOL(0.0f, ss[1], SINGLE_EPS); ASSERT_DBL_NEAR_TOL(0.0f, sa[0], SINGLE_EPS); ASSERT_DBL_NEAR_TOL(1.41421f, sa[1], SINGLE_EPS); @@ -174,10 +174,10 @@ CTEST(crotg, c_api_zero_a) float sc; cblas_crotg(sa, sb, &sc, ss); ASSERT_DBL_NEAR_TOL(0.0f, sc, SINGLE_EPS); - ASSERT_DBL_NEAR_TOL(1.0f, ss[0], SINGLE_EPS); - ASSERT_DBL_NEAR_TOL(0.0f, ss[1], SINGLE_EPS); - ASSERT_DBL_NEAR_TOL(1.0f, sa[0], SINGLE_EPS); - ASSERT_DBL_NEAR_TOL(1.0f, sa[1], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(0.70711f, ss[0], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(-0.70711f, ss[1], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(1.41421f, sa[0], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(0.0f, sa[1], SINGLE_EPS); } /** @@ -209,8 +209,8 @@ CTEST(crotg, c_api_zero_real) float ss[2]; float sc; cblas_crotg(sa, sb, &sc, ss); - ASSERT_DBL_NEAR_TOL(0.7071f, sc, SINGLE_EPS); - ASSERT_DBL_NEAR_TOL(0.7071f, ss[0], SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(0.70711f, sc, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(0.70711f, ss[0], SINGLE_EPS); ASSERT_DBL_NEAR_TOL(0.0f, ss[1], SINGLE_EPS); ASSERT_DBL_NEAR_TOL(0.0f, sa[0], SINGLE_EPS); ASSERT_DBL_NEAR_TOL(1.41421f, sa[1], SINGLE_EPS); diff --git a/utest/test_extensions/test_zrotg.c b/utest/test_extensions/test_zrotg.c index 310121422..1de95447d 100644 --- a/utest/test_extensions/test_zrotg.c +++ b/utest/test_extensions/test_zrotg.c @@ -48,10 +48,10 @@ CTEST(zrotg, zero_a) double sc; BLASFUNC(zrotg)(sa, sb, &sc, ss); ASSERT_DBL_NEAR_TOL(0.0, sc, DOUBLE_EPS); - ASSERT_DBL_NEAR_TOL(1.0, ss[0], DOUBLE_EPS); - ASSERT_DBL_NEAR_TOL(0.0, ss[1], DOUBLE_EPS); - ASSERT_DBL_NEAR_TOL(1.0, sa[0], DOUBLE_EPS); - ASSERT_DBL_NEAR_TOL(1.0, sa[1], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(0.70710678118655, ss[0], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(-0.70710678118655, ss[1], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(1.41421356237310, sa[0], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(0.0, sa[1], DOUBLE_EPS); } /** @@ -174,10 +174,10 @@ CTEST(zrotg, c_api_zero_a) double sc; cblas_zrotg(sa, sb, &sc, ss); ASSERT_DBL_NEAR_TOL(0.0, sc, DOUBLE_EPS); - ASSERT_DBL_NEAR_TOL(1.0, ss[0], DOUBLE_EPS); - ASSERT_DBL_NEAR_TOL(0.0, ss[1], DOUBLE_EPS); - ASSERT_DBL_NEAR_TOL(1.0, sa[0], DOUBLE_EPS); - ASSERT_DBL_NEAR_TOL(1.0, sa[1], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(0.70710678118655, ss[0], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(-0.70710678118655, ss[1], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(1.41421356237310, sa[0], DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(0.0, sa[1], DOUBLE_EPS); } /** From b3fa16345d83b723b8984b78dc6a2bb5d9f3d479 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Thu, 8 Feb 2024 13:15:34 +0100 Subject: [PATCH 134/311] fix prototype for c/zaxpby --- common_interface.h | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/common_interface.h b/common_interface.h index 61a82c306..5a2e1654c 100644 --- a/common_interface.h +++ b/common_interface.h @@ -773,8 +773,8 @@ xdouble BLASFUNC(qlamc3)(xdouble *, xdouble *); void BLASFUNC(saxpby) (blasint *, float *, float *, blasint *, float *, float *, blasint *); void BLASFUNC(daxpby) (blasint *, double *, double *, blasint *, double *, double *, blasint *); -void BLASFUNC(caxpby) (blasint *, float *, float *, blasint *, float *, float *, blasint *); -void BLASFUNC(zaxpby) (blasint *, double *, double *, blasint *, double *, double *, blasint *); +void BLASFUNC(caxpby) (blasint *, void *, float *, blasint *, void *, float *, blasint *); +void BLASFUNC(zaxpby) (blasint *, void *, double *, blasint *, void *, double *, blasint *); void BLASFUNC(somatcopy) (char *, char *, blasint *, blasint *, float *, float *, blasint *, float *, blasint *); void BLASFUNC(domatcopy) (char *, char *, blasint *, blasint *, double *, double *, blasint *, double *, blasint *); From 500ac4de5e20596d5cd797d745db97dd0a62ff86 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Thu, 8 Feb 2024 13:18:34 +0100 Subject: [PATCH 135/311] fix incompatible pointer types --- interface/zaxpby.c | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/interface/zaxpby.c b/interface/zaxpby.c index 3a4db7403..e5065270d 100644 --- a/interface/zaxpby.c +++ b/interface/zaxpby.c @@ -39,12 +39,14 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #ifndef CBLAS -void NAME(blasint *N, FLOAT *ALPHA, FLOAT *x, blasint *INCX, FLOAT *BETA, FLOAT *y, blasint *INCY) +void NAME(blasint *N, void *VALPHA, FLOAT *x, blasint *INCX, void *VBETA, FLOAT *y, blasint *INCY) { blasint n = *N; blasint incx = *INCX; blasint incy = *INCY; + FLOAT* ALPHA = (FLOAT*) VALPHA; + FLOAT* BETA = (FLOAT*) VBETA; #else From ac6b4b7aa472799245c497ab3caa6e77c0e80852 Mon Sep 17 00:00:00 2001 From: Chip Kerchner Date: Thu, 8 Feb 2024 08:56:30 -0600 Subject: [PATCH 136/311] Make sure CPU ID works for all POWER_10 conditions --- driver/others/dynamic_power.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/driver/others/dynamic_power.c b/driver/others/dynamic_power.c index 16320dc40..cd5e88922 100644 --- a/driver/others/dynamic_power.c +++ b/driver/others/dynamic_power.c @@ -69,7 +69,7 @@ static int cpuid(void) else if (arch == POWER_9) return CPU_POWER9; #endif #ifdef POWER_10 - else if (arch == POWER_10) return CPU_POWER10; + else if (arch >= POWER_10) return CPU_POWER10; #endif return CPU_UNKNOWN; } From d408ecedba8cc1d9b799b89df6996bdcd996d5fc Mon Sep 17 00:00:00 2001 From: Chip Kerchner Date: Thu, 8 Feb 2024 12:17:18 -0600 Subject: [PATCH 137/311] Add environment variable to display coretype for dynamic arch. --- driver/others/dynamic_power.c | 3 +++ 1 file changed, 3 insertions(+) diff --git a/driver/others/dynamic_power.c b/driver/others/dynamic_power.c index cd5e88922..4c1f4a26e 100644 --- a/driver/others/dynamic_power.c +++ b/driver/others/dynamic_power.c @@ -339,6 +339,9 @@ void gotoblas_dynamic_init(void) { if (gotoblas && gotoblas -> init) { strncpy(coren,gotoblas_corename(),20); sprintf(coremsg, "Core: %s\n",coren); + if (getenv("GET_OPENBLAS_CORETYPE")) { + fprintf(stderr, "%s", coremsg); + } openblas_warning(2, coremsg); gotoblas -> init(); } else { From 83bec5135534c94fe1790aa5795620a7cdeaa916 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Thu, 8 Feb 2024 21:23:48 +0100 Subject: [PATCH 138/311] Update with recently added CBLAS interfaces and LAPACK/LAPACKE functions --- exports/gensymbol | 85 +++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 85 insertions(+) diff --git a/exports/gensymbol b/exports/gensymbol index 704eab06f..93edf2400 100755 --- a/exports/gensymbol +++ b/exports/gensymbol @@ -60,6 +60,7 @@ cblasobjsc=" cblas_ctbsv cblas_ctpmv cblas_ctpsv cblas_ctrmm cblas_ctrmv cblas_ctrsm cblas_ctrsv cblas_scnrm2 cblas_scasum cblas_cgemmt cblas_icamax cblas_icamin cblas_icmin cblas_icmax cblas_scsum cblas_cimatcopy cblas_comatcopy + cblas_caxpyc cblas_crotg cblas_csrot cblas_scamax cblas_scamin " cblasobjsd=" cblas_dasum cblas_daxpy cblas_dcopy cblas_ddot @@ -69,6 +70,7 @@ cblasobjsd=" cblas_dsyr2k cblas_dsyr cblas_dsyrk cblas_dtbmv cblas_dtbsv cblas_dtpmv cblas_dtpsv cblas_dtrmm cblas_dtrmv cblas_dtrsm cblas_dtrsv cblas_daxpby cblas_dgeadd cblas_dgemmt cblas_idamax cblas_idamin cblas_idmin cblas_idmax cblas_dsum cblas_dimatcopy cblas_domatcopy + cblas_damax cblas_damin " cblasobjss=" @@ -80,6 +82,7 @@ cblasobjss=" cblas_stbmv cblas_stbsv cblas_stpmv cblas_stpsv cblas_strmm cblas_strmv cblas_strsm cblas_strsv cblas_sgeadd cblas_sgemmt cblas_isamax cblas_isamin cblas_ismin cblas_ismax cblas_ssum cblas_simatcopy cblas_somatcopy + cblas_samax cblas_samin " cblasobjsz=" @@ -91,6 +94,7 @@ cblasobjsz=" cblas_ztrsv cblas_cdotc_sub cblas_cdotu_sub cblas_zdotc_sub cblas_zdotu_sub cblas_zaxpby cblas_zgeadd cblas_zgemmt cblas_izamax cblas_izamin cblas_izmin cblas_izmax cblas_dzsum cblas_zimatcopy cblas_zomatcopy + cblas_zaxpyc cblas_zdrot cblas_zrotg cblas_dzamax cblas_dzamin " cblasobjs="cblas_xerbla" @@ -861,6 +865,51 @@ lapackobjs2z="$lapackobjs2z zgedmd zgedmdq " + +#functions added post 3.11 + +lapackobjs2c="$lapackobjs2c + claqp2rk + claqp3rk + claqz0 + claqz1 + claqz2 + claqz3 + clatrs3 + ctrsyl3 + " +lapackobjs2d="$lapackobjs2d + dgelqs + dgelst + dgeqp3rk + dgeqrs + dlaqp2rk + dlaqp3rk + dlaqz0 + dlaqz1 + dlaqz2 + dlaqz3 + dlaqz4 + dlarmm + dlatrs3 + dtrsyl3 + " +lapackobjs2z="$lapackobjs2z + zgelqs + zgelst + zgeqp3rk + zgeqrs + zlaqp2rk + zlaqp3rk + zlaqz0 + zlaqz1 + zlaqz2 + zlaqz3 + zlatrs3 + zrscl + ztrsyl3 +" + lapack_extendedprecision_objs=" zposvxx clagge clatms chesvxx cposvxx cgesvxx ssyrfssx csyrfsx dlagsy dsysvxx sporfsx slatms zlatms zherfsx csysvxx @@ -1622,6 +1671,14 @@ lapackeobjsc=" LAPACKE_cgetsqrhrt_work LAPACKE_cungtsqr_row LAPACKE_cungtsqr_row_work + LAPACKE_clangb + LAPACKE_clangb_work + LAPACKE_ctrsyl3 + LAPACKE_ctrsyl3_work + LAPACKE_ctz_nancheck + LAPACKE_ctz_trans + LAPACKE_cunhr_col + LAPACKE_cunhr_col_work " lapackeobjsd=" @@ -2239,6 +2296,14 @@ lapackeobjsd=" LAPACKE_dgetsqrhrt_work LAPACKE_dorgtsqr_row LAPACKE_dorgtsqr_row_work + LAPACKE_dlangb + LAPACKE_dlangb_work + LAPACKE_dorhr_col + LAPACKE_dorhr_col_work + LAPACKE_dtrsyl3 + LAPACKE_dtrsyl3_work + LAPACKE_dtz_nancheck + LAPACKE_dtz_trans " lapackeobjss=" @@ -2848,6 +2913,14 @@ lapackeobjss=" LAPACKE_sgetsqrhrt_work LAPACKE_sorgtsqr_row LAPACKE_sorgtsqr_row_work + LAPACKE_slangb + LAPACKE_slangb_work + LAPACKE_sorhr_col + LAPACKE_sorhr_col_work + LAPACKE_strsyl3 + LAPACKE_strsyl3_work + LAPACKE_stz_nancheck + LAPACKE_stz_trans " lapackeobjsz=" @@ -3515,6 +3588,14 @@ lapackeobjsz=" LAPACKE_zgetsqrhrt_work LAPACKE_zungtsqr_row LAPACKE_zungtsqr_row_work + LAPACKE_zlangb + LAPACKE_zlangb_work + LAPACKE_ztrsyl3 + LAPACKE_ztrsyl3_work + LAPACKE_ztz_nancheck + LAPACKE_ztz_trans + LAPACKE_zunhr_col + LAPACKE_zunhr_col_work " ## @(SRCX_OBJ) from `lapack-3.4.1/lapacke/src/Makefile` ## Not exported: requires LAPACKE_EXTENDED to be set and depends on the @@ -3616,6 +3697,7 @@ lapack_embeded_underscore_objs_s=" ssysv_aa_2stage ssytrf_aa_2stage ssytrs_aa_2stage slaorhr_col_getrfnp slaorhr_col_getrfnp2 sorhr_col + slarfb_gett " lapack_embeded_underscore_objs_c=" chetf2_rook chetrf_rook chetri_rook @@ -3641,6 +3723,7 @@ lapack_embeded_underscore_objs_c=" csysv_aa_2stage csytrf_aa_2stage csytrs_aa_2stage claunhr_col_getrfnp claunhr_col_getrfnp2 cunhr_col + clarfb_gett " lapack_embeded_underscore_objs_d=" dlasyf_rook @@ -3658,6 +3741,7 @@ lapack_embeded_underscore_objs_d=" dsysv_aa_2stage dsytrf_aa_2stage dsytrs_aa_2stage dlaorhr_col_getrfnp dlaorhr_col_getrfnp2 dorhr_col + dlarfb_gett " lapack_embeded_underscore_objs_z=" zhetf2_rook zhetrf_rook zhetri_rook @@ -3682,6 +3766,7 @@ lapack_embeded_underscore_objs_z=" zhetrs_aa_2stage zsysv_aa_2stage zsytrf_aa_2stage zsytrs_aa_2stage zlaunhr_col_getrfnp zlaunhr_col_getrfnp2 zunhr_col + zlarfb_gett " dirname=`pwd -P`/../lapack-netlib From 98c56a7314dbc0032152b7658c73c203124963f9 Mon Sep 17 00:00:00 2001 From: Mark Seminatore Date: Thu, 8 Feb 2024 13:50:15 -0800 Subject: [PATCH 139/311] more cleanup --- driver/others/blas_server_win32.c | 35 ++++++++++++++++++++----------- 1 file changed, 23 insertions(+), 12 deletions(-) diff --git a/driver/others/blas_server_win32.c b/driver/others/blas_server_win32.c index ee6d08f8c..89ce9e656 100644 --- a/driver/others/blas_server_win32.c +++ b/driver/others/blas_server_win32.c @@ -73,7 +73,7 @@ static DWORD blas_threads_id[MAX_CPU_NUMBER]; static volatile int thread_target; // target num of live threads, volatile for cross-thread reads // -// +// Legacy code path // static void legacy_exec(void *func, int mode, blas_arg_t *args, void *sb) { @@ -369,11 +369,11 @@ int blas_thread_init(void) { return 0; } -/* - User can call one of two routines. - exec_blas_async ... immediately returns after jobs are queued. - exec_blas ... returns after jobs are finished. -*/ +// +// User can call one of two routines. +// exec_blas_async ... immediately returns after jobs are queued. +// exec_blas ... returns after jobs are finished. +// int exec_blas_async(BLASLONG pos, blas_queue_t *queue) { #if defined(SMP_SERVER) @@ -471,27 +471,32 @@ int exec_blas(BLASLONG num, blas_queue_t *queue) { if ((num <= 0) || (queue == NULL)) return 0; - if ((num > 1) && queue -> next) exec_blas_async(1, queue -> next); + if ((num > 1) && queue -> next) + exec_blas_async(1, queue -> next); routine = queue -> routine; if (queue -> mode & BLAS_LEGACY) { legacy_exec(routine, queue -> mode, queue -> args, queue -> sb); - } else + } else { if (queue -> mode & BLAS_PTHREAD) { void (*pthreadcompat)(void *) = queue -> routine; (pthreadcompat)(queue -> args); } else (routine)(queue -> args, queue -> range_m, queue -> range_n, - queue -> sa, queue -> sb, 0); + queue -> sa, queue -> sb, 0); + } - if ((num > 1) && queue -> next) exec_blas_async_wait(num - 1, queue -> next); + if ((num > 1) && queue -> next) + exec_blas_async_wait(num - 1, queue -> next); return 0; } +// // Shutdown procedure, but user don't have to call this routine. The // kernel automatically kill threads. +// int BLASFUNC(blas_thread_shutdown)(void) { int i; @@ -502,7 +507,7 @@ int BLASFUNC(blas_thread_shutdown)(void) { if (blas_server_avail) { - for(i = 0; i < blas_num_threads - 1; i++) { + for (i = 0; i < blas_num_threads - 1; i++) { // Could also just use WaitForMultipleObjects DWORD wait_thread_value = WaitForSingleObject(blas_threads[i], 50); @@ -524,6 +529,9 @@ int BLASFUNC(blas_thread_shutdown)(void) { return 0; } +// +// Legacy function to set numbef of threads +// void goto_set_num_threads(int num_threads) { long i; @@ -577,7 +585,7 @@ void goto_set_num_threads(int num_threads) blas_server_avail = 1; } - for(i = (blas_num_threads > 0) ? blas_num_threads - 1 : 0; i < num_threads - 1; i++) { + for (i = (blas_num_threads > 0) ? blas_num_threads - 1 : 0; i < num_threads - 1; i++) { //MT_TRACE("set_num_threads: creating thread [%d]\n", i); blas_threads[i] = CreateThread(NULL, 0, @@ -593,6 +601,9 @@ void goto_set_num_threads(int num_threads) blas_cpu_number = num_threads; } +// +// Openblas function to set thread count +// void openblas_set_num_threads(int num) { goto_set_num_threads(num); From 93872f4681430a6ae9d857d8044d36ba98d09bf2 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Thu, 8 Feb 2024 23:02:09 +0100 Subject: [PATCH 140/311] drop the ?laqz? symbols for now (not translatable by f2c) --- exports/gensymbol | 32 +++++++++++++++++--------------- 1 file changed, 17 insertions(+), 15 deletions(-) diff --git a/exports/gensymbol b/exports/gensymbol index 93edf2400..226035842 100755 --- a/exports/gensymbol +++ b/exports/gensymbol @@ -871,13 +871,14 @@ lapackobjs2z="$lapackobjs2z lapackobjs2c="$lapackobjs2c claqp2rk claqp3rk - claqz0 - claqz1 - claqz2 - claqz3 - clatrs3 ctrsyl3 " +# claqz0 +# claqz1 +# claqz2 +# claqz3 +# clatrs3 + lapackobjs2d="$lapackobjs2d dgelqs dgelst @@ -885,15 +886,16 @@ lapackobjs2d="$lapackobjs2d dgeqrs dlaqp2rk dlaqp3rk - dlaqz0 - dlaqz1 - dlaqz2 - dlaqz3 - dlaqz4 dlarmm dlatrs3 dtrsyl3 " +# dlaqz0 +# dlaqz1 +# dlaqz2 +# dlaqz3 +# dlaqz4 + lapackobjs2z="$lapackobjs2z zgelqs zgelst @@ -901,14 +903,14 @@ lapackobjs2z="$lapackobjs2z zgeqrs zlaqp2rk zlaqp3rk - zlaqz0 - zlaqz1 - zlaqz2 - zlaqz3 zlatrs3 zrscl ztrsyl3 -" + " +# zlaqz0 +# zlaqz1 +# zlaqz2 +# zlaqz3 lapack_extendedprecision_objs=" zposvxx clagge clatms chesvxx cposvxx cgesvxx ssyrfssx csyrfsx From ff1523163f71e1ad9f1e4a2c8548416f213e7cb1 Mon Sep 17 00:00:00 2001 From: Sergei Lewis Date: Fri, 9 Feb 2024 12:59:14 +0000 Subject: [PATCH 141/311] Fix axpy test hangs when n==0. Reenable zaxpy_vector kernel for C910V. --- kernel/riscv64/KERNEL.C910V | 4 ++-- kernel/riscv64/axpy_vector.c | 2 +- kernel/riscv64/zaxpy_vector.c | 8 ++++---- 3 files changed, 7 insertions(+), 7 deletions(-) diff --git a/kernel/riscv64/KERNEL.C910V b/kernel/riscv64/KERNEL.C910V index 066329390..2798a870e 100644 --- a/kernel/riscv64/KERNEL.C910V +++ b/kernel/riscv64/KERNEL.C910V @@ -42,8 +42,8 @@ ZSUMKERNEL = ../arm/zsum.c SAXPYKERNEL = axpy_vector.c DAXPYKERNEL = axpy_vector.c -CAXPYKERNEL = zaxpy.c -ZAXPYKERNEL = zaxpy.c +CAXPYKERNEL = zaxpy_vector.c +ZAXPYKERNEL = zaxpy_vector.c SAXPBYKERNEL = axpby_vector.c DAXPBYKERNEL = axpby_vector.c diff --git a/kernel/riscv64/axpy_vector.c b/kernel/riscv64/axpy_vector.c index e99ca8542..6dffe5f09 100644 --- a/kernel/riscv64/axpy_vector.c +++ b/kernel/riscv64/axpy_vector.c @@ -65,7 +65,7 @@ int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT da, FLOAT *x, BLAS FLOAT_V_T vy0, vy1; BLASLONG stride_x, stride_y; - if (n < 0) return(0); + if (n <= 0) return(0); if (da == 0.0) return(0); if (inc_x == 1 && inc_y == 1) { diff --git a/kernel/riscv64/zaxpy_vector.c b/kernel/riscv64/zaxpy_vector.c index d19e51118..1e766c5f4 100644 --- a/kernel/riscv64/zaxpy_vector.c +++ b/kernel/riscv64/zaxpy_vector.c @@ -45,10 +45,10 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT da_r, FLOAT da_i, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y, FLOAT *dummy, BLASLONG dummy2) { - BLASLONG i = 0, j = 0; - BLASLONG ix = 0,iy = 0; - if(n < 0) return(0); - if(da_r == 0.0 && da_i == 0.0) return(0); + BLASLONG i = 0, j = 0; + BLASLONG ix = 0,iy = 0; + if(n <= 0) return(0); + if(da_r == 0.0 && da_i == 0.0) return(0); unsigned int gvl = 0; BLASLONG stride_x = inc_x * 2 * sizeof(FLOAT); BLASLONG stride_y = inc_y * 2 * sizeof(FLOAT); From bb96e466aee3a969bfb767d347262977bc918658 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Fri, 9 Feb 2024 15:50:11 +0100 Subject: [PATCH 142/311] Introduce LIBNAMEPREFIX to avoid messing with the internal LIBPREFIX --- Makefile.install | 4 ++-- Makefile.rule | 5 +++++ Makefile.system | 12 ++++++++---- 3 files changed, 15 insertions(+), 6 deletions(-) diff --git a/Makefile.install b/Makefile.install index e7d129cce..2b00db4be 100644 --- a/Makefile.install +++ b/Makefile.install @@ -172,7 +172,7 @@ endif @echo Generating $(LIBSONAMEBASE)$(SUFFIX64).pc in "$(DESTDIR)$(OPENBLAS_PKGCONFIG_DIR)" @echo 'libdir='$(OPENBLAS_LIBRARY_DIR) > "$(PKGFILE)" - @echo 'libprefix='$(LIBPREFIX) >> "$(PKGFILE)" + @echo 'libprefix='$(LIBNAMEPREFIX) >> "$(PKGFILE)" @echo 'libnamesuffix='$(LIBNAMESUFFIX) >> "$(PKGFILE)" @echo 'libsuffix='$(SYMBOLSUFFIX) >> "$(PKGFILE)" @echo 'includedir='$(OPENBLAS_INCLUDE_DIR) >> "$(PKGFILE)" @@ -190,7 +190,7 @@ endif ifneq ($(NO_SHARED),1) #ifeq logical or ifeq ($(OSNAME), $(filter $(OSNAME),Linux FreeBSD NetBSD OpenBSD DragonFly)) - @echo "SET(OpenBLAS_LIBRARIES ${OPENBLAS_LIBRARY_DIR}/$(LIBPREFIX)$(LIBSONAMEBASE)$(LIBNAMESUFFIX).so)" >> "$(DESTDIR)$(OPENBLAS_CMAKE_DIR)/$(OPENBLAS_CMAKE_CONFIG)" + @echo "SET(OpenBLAS_LIBRARIES ${OPENBLAS_LIBRARY_DIR}/$(LIBPREFIX)$(LIBNAMESUFFIX).so)" >> "$(DESTDIR)$(OPENBLAS_CMAKE_DIR)/$(OPENBLAS_CMAKE_CONFIG)" endif ifeq ($(OSNAME), $(filter $(OSNAME),WINNT CYGWIN_NT)) @echo "SET(OpenBLAS_LIBRARIES ${OPENBLAS_BINARY_DIR}/$(LIBDLLNAME))" >> "$(DESTDIR)$(OPENBLAS_CMAKE_DIR)/$(OPENBLAS_CMAKE_CONFIG)" diff --git a/Makefile.rule b/Makefile.rule index 8dbf5eab6..02ec739fd 100644 --- a/Makefile.rule +++ b/Makefile.rule @@ -5,6 +5,11 @@ # This library's version VERSION = 0.3.26.dev +# If you set this prefix, the library name will be lib$(LIBNAMESUFFIX)openblas.a +# and lib$(LIBNAMESUFFIX)openblas.so, with a matching soname in the shared library +# +# LIBNAMEPREFIX = scipy + # If you set the suffix, the library name will be libopenblas_$(LIBNAMESUFFIX).a # and libopenblas_$(LIBNAMESUFFIX).so. Meanwhile, the soname in shared library # is libopenblas_$(LIBNAMESUFFIX).so.0. diff --git a/Makefile.system b/Makefile.system index 49bd1cbed..233663ef9 100644 --- a/Makefile.system +++ b/Makefile.system @@ -1516,6 +1516,10 @@ ifndef LIBSONAMEBASE LIBSONAMEBASE = openblas endif +ifndef LIBNAMEPREFIX +LIBNAMEPREFIX = +endif + ifndef LIBNAMESUFFIX LIBNAMEBASE = $(SYMBOLPREFIX)$(LIBSONAMEBASE)$(SYMBOLSUFFIX) else @@ -1523,9 +1527,9 @@ LIBNAMEBASE = $(SYMBOLPREFIX)$(LIBSONAMEBASE)$(SYMBOLSUFFIX)_$(LIBNAMESUFFIX) endif ifeq ($(OSNAME), CYGWIN_NT) -LIBPREFIX = cyg$(LIBNAMEBASE) +LIBPREFIX = cyg$(LIBNAMEPREFIX)$(LIBNAMEBASE) else -LIBPREFIX = lib$(LIBNAMEBASE) +LIBPREFIX = lib$(LIBNAMEPREFIX)$(LIBNAMEBASE) endif KERNELDIR = $(TOPDIR)/kernel/$(ARCH) @@ -1705,8 +1709,8 @@ endif endif ifeq ($(FIXED_LIBNAME),1) - LIBNAME = $(LIBPREFIX)$(LIBSONAMEBASE)$(LIBNAMESUFFIX).$(LIBSUFFIX) - LIBNAME_P = $(LIBPREFIX)$(LISOBNAMEBASE)$(LIBNAMESUFFIX)_p.$(LIBSUFFIX) + LIBNAME = lib$(LIBNAMEPREFIX)$(LIBSONAMEBASE)$(LIBNAMESUFFIX).$(LIBSUFFIX) + LIBNAME_P = lib$(LIBNAMEPREFIX)$(LISOBNAMEBASE)$(LIBNAMESUFFIX)_p.$(LIBSUFFIX) endif LIBDLLNAME = $(LIBPREFIX).dll From 10ea3fb7421b4beeddbaff9e759cdcf873c4b369 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Fri, 9 Feb 2024 17:09:55 +0100 Subject: [PATCH 143/311] fix duplication of name parts --- exports/Makefile | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/exports/Makefile b/exports/Makefile index 238623b04..e8dea0364 100644 --- a/exports/Makefile +++ b/exports/Makefile @@ -133,7 +133,7 @@ libgoto_hpl.def : $(GENSYM) ifeq ($(OSNAME), Darwin) ifeq ($(FIXED_LIBNAME),1) -INTERNALNAME = $(LIBPREFIX)$(LIBSONAMEBASE)$(LIBNAMESUFFIX).dylib +INTERNALNAME = $(LIBPREFIX)$(LIBNAMESUFFIX).dylib else INTERNALNAME = $(LIBPREFIX).$(MAJOR_VERSION).dylib endif @@ -174,7 +174,7 @@ FEXTRALIB += -lm EXTRALIB += -lm else ifeq ($(FIXED_LIBNAME),1) -INTERNALNAME = $(LIBPREFIX)$(LIBSONAMEBASE)$(LIBNAMESUFFIX).so +INTERNALNAME = $(LIBPREFIX)$(LIBNAMESUFFIX).so else INTERNALNAME = $(LIBPREFIX).so.$(MAJOR_VERSION) endif From 4c554bd527cc3b8ed0c160cee457e23bfe442343 Mon Sep 17 00:00:00 2001 From: kseniyazaytseva Date: Sat, 10 Feb 2024 00:46:52 +0300 Subject: [PATCH 144/311] check abs zero inc --- utest/test_extensions/test_damin.c | 4 ++-- utest/test_extensions/test_dzamax.c | 4 ++-- utest/test_extensions/test_dzamin.c | 4 ++-- utest/test_extensions/test_samin.c | 4 ++-- utest/test_extensions/test_scamax.c | 4 ++-- utest/test_extensions/test_scamin.c | 4 ++-- 6 files changed, 12 insertions(+), 12 deletions(-) diff --git a/utest/test_extensions/test_damin.c b/utest/test_extensions/test_damin.c index fdd2bc658..736921fa3 100644 --- a/utest/test_extensions/test_damin.c +++ b/utest/test_extensions/test_damin.c @@ -61,11 +61,11 @@ CTEST(damin, step_zero){ blasint N = ELEMENTS, inc = 0; double x[ELEMENTS]; for (i = 0; i < N; i ++) { - x[i] = i + 1000; + x[i] = i - 1000; } x[8] = 0.0; double amin = BLASFUNC(damin)(&N, x, &inc); - ASSERT_DBL_NEAR_TOL(x[0], amin, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL(fabs(x[0]), amin, DOUBLE_EPS); } /** diff --git a/utest/test_extensions/test_dzamax.c b/utest/test_extensions/test_dzamax.c index bdb3a4f18..7bc0200c9 100644 --- a/utest/test_extensions/test_dzamax.c +++ b/utest/test_extensions/test_dzamax.c @@ -61,10 +61,10 @@ CTEST(dzamax, step_zero){ blasint N = ELEMENTS * 2, inc = 0; double x[ELEMENTS * 2]; for (i = 0; i < N; i ++) { - x[i] = i + 1000; + x[i] = i - 1000; } double amax = BLASFUNC(dzamax)(&N, x, &inc); - ASSERT_DBL_NEAR_TOL((x[0] + x[1]), amax, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL((fabs(x[0]) + fabs(x[1])), amax, DOUBLE_EPS); } /** diff --git a/utest/test_extensions/test_dzamin.c b/utest/test_extensions/test_dzamin.c index 9fcf87b7b..549881fdc 100644 --- a/utest/test_extensions/test_dzamin.c +++ b/utest/test_extensions/test_dzamin.c @@ -61,11 +61,11 @@ CTEST(dzamin, step_zero){ blasint N = ELEMENTS * 2, inc = 0; double x[ELEMENTS * 2]; for (i = 0; i < N; i ++) { - x[i] = i + 1000; + x[i] = i - 1000; } x[8] = 0.0; double amin = BLASFUNC(dzamin)(&N, x, &inc); - ASSERT_DBL_NEAR_TOL((x[0] + x[1]), amin, DOUBLE_EPS); + ASSERT_DBL_NEAR_TOL((fabs(x[0]) + fabs(x[1])), amin, DOUBLE_EPS); } /** diff --git a/utest/test_extensions/test_samin.c b/utest/test_extensions/test_samin.c index 2e3a73797..fd34d462a 100644 --- a/utest/test_extensions/test_samin.c +++ b/utest/test_extensions/test_samin.c @@ -61,11 +61,11 @@ CTEST(samin, step_zero){ blasint N = ELEMENTS, inc = 0; float x[ELEMENTS]; for (i = 0; i < N; i ++) { - x[i] = i + 1000; + x[i] = i - 1000; } x[8] = 0.0; float amin = BLASFUNC(samin)(&N, x, &inc); - ASSERT_DBL_NEAR_TOL(x[0], amin, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL(fabsf(x[0]), amin, SINGLE_EPS); } /** diff --git a/utest/test_extensions/test_scamax.c b/utest/test_extensions/test_scamax.c index 0f49ebfad..8c214ddff 100644 --- a/utest/test_extensions/test_scamax.c +++ b/utest/test_extensions/test_scamax.c @@ -61,10 +61,10 @@ CTEST(scamax, step_zero){ blasint N = ELEMENTS * 2, inc = 0; float x[ELEMENTS * 2]; for (i = 0; i < N; i ++) { - x[i] = i + 1000; + x[i] = i - 1000; } float amax = BLASFUNC(scamax)(&N, x, &inc); - ASSERT_DBL_NEAR_TOL((x[0] + x[1]), amax, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL((fabsf(x[0]) + fabsf(x[1])), amax, SINGLE_EPS); } /** diff --git a/utest/test_extensions/test_scamin.c b/utest/test_extensions/test_scamin.c index 0f0414a1c..507548f2a 100644 --- a/utest/test_extensions/test_scamin.c +++ b/utest/test_extensions/test_scamin.c @@ -61,11 +61,11 @@ CTEST(scamin, step_zero){ blasint N = ELEMENTS * 2, inc = 0; float x[ELEMENTS * 2]; for (i = 0; i < N; i ++) { - x[i] = i + 1000; + x[i] = i - 1000; } x[8] = 0.0f; float amin = BLASFUNC(scamin)(&N, x, &inc); - ASSERT_DBL_NEAR_TOL((x[0] + x[1]), amin, SINGLE_EPS); + ASSERT_DBL_NEAR_TOL((fabsf(x[0]) + fabsf(x[1])), amin, SINGLE_EPS); } /** From 5e9ead09ac03f27f7906576d4ec16cb80dc9fb4d Mon Sep 17 00:00:00 2001 From: kseniyazaytseva Date: Sat, 10 Feb 2024 00:47:25 +0300 Subject: [PATCH 145/311] fix info return --- interface/geadd.c | 4 ++-- interface/zgeadd.c | 6 +++--- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/interface/geadd.c b/interface/geadd.c index 3a0ea015d..a2e6d1081 100644 --- a/interface/geadd.c +++ b/interface/geadd.c @@ -117,8 +117,8 @@ void CNAME(enum CBLAS_ORDER order, if (ldc < MAX(1, m)) info = 8; if (lda < MAX(1, m)) info = 5; - if (n < 0) info = 2; - if (m < 0) info = 1; + if (n < 0) info = 1; + if (m < 0) info = 2; } if (info >= 0) { diff --git a/interface/zgeadd.c b/interface/zgeadd.c index 7124cf230..de71f27b8 100644 --- a/interface/zgeadd.c +++ b/interface/zgeadd.c @@ -66,7 +66,7 @@ void NAME(blasint *M, blasint *N, FLOAT *ALPHA, FLOAT *a, blasint *LDA, info = 0; - if (lda < MAX(1, m)) info = 6; + if (lda < MAX(1, m)) info = 5; if (ldc < MAX(1, m)) info = 8; if (n < 0) info = 2; @@ -115,8 +115,8 @@ void CNAME(enum CBLAS_ORDER order, if (ldc < MAX(1, m)) info = 8; if (lda < MAX(1, m)) info = 5; - if (n < 0) info = 2; - if (m < 0) info = 1; + if (n < 0) info = 1; + if (m < 0) info = 2; } if (info >= 0) { From c6f30fd4146258dcdfc7cf1322ad1e0b4f88e1ac Mon Sep 17 00:00:00 2001 From: kseniyazaytseva Date: Sat, 10 Feb 2024 00:48:07 +0300 Subject: [PATCH 146/311] check for zero inc --- interface/max.c | 20 ++++++++++++++++++++ 1 file changed, 20 insertions(+) diff --git a/interface/max.c b/interface/max.c index 6c7d32bd9..7817601b9 100644 --- a/interface/max.c +++ b/interface/max.c @@ -46,6 +46,12 @@ #ifdef USE_ABS +#if defined(DOUBLE) +#define ABS fabs +#else +#define ABS fabsf +#endif + #ifndef USE_MIN /* ABS & MAX */ @@ -92,6 +98,8 @@ #else +#define ABS + #ifndef USE_MIN /* MAX */ @@ -130,6 +138,12 @@ FLOATRET NAME(blasint *N, FLOAT *x, blasint *INCX){ if (n <= 0) return 0; +#ifndef COMPLEX + if (incx == 0) return (ABS(*x)); +#else + if (incx == 0) return (ABS(*x) + ABS(*(x+1))); +#endif + IDEBUG_START; FUNCTION_PROFILE_START(); @@ -158,6 +172,12 @@ FLOAT CNAME(blasint n, FLOAT *x, blasint incx){ if (n <= 0) return 0; +#ifndef COMPLEX + if (incx == 0) return (ABS(*x)); +#else + if (incx == 0) return (ABS(*x) + ABS(*(x+1))); +#endif + IDEBUG_START; FUNCTION_PROFILE_START(); From 7e9b1c08074d1e88f446fc5861f44c8844e93d30 Mon Sep 17 00:00:00 2001 From: kseniyazaytseva Date: Sat, 10 Feb 2024 00:49:42 +0300 Subject: [PATCH 147/311] fix uninitialized data usage --- interface/zrotg.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/interface/zrotg.c b/interface/zrotg.c index ea73352dd..8acc3c9b2 100644 --- a/interface/zrotg.c +++ b/interface/zrotg.c @@ -102,7 +102,7 @@ void CNAME(void *VDA, void *VDB, FLOAT *C, void *VS) { if (ada >= h *safmin) { *C = sqrt(ada/h); *R = *DA / *C; - *(R+1) = *(DA+1) / *(C+1); + *(R+1) = *(DA+1) / *C; rtmax *= 2.; if ( ada > rtmin && h < rtmax) { // no risk of intermediate overflow *S = *S1 * (*DA / adahsq) - *(S1+1)* (*(DA+1)/adahsq); @@ -115,7 +115,7 @@ void CNAME(void *VDA, void *VDB, FLOAT *C, void *VS) { *C = ada / adahsq; if (*C >= safmin) { *R = *DA / *C; - *(R+1) = *(DA+1) / *(C+1); + *(R+1) = *(DA+1) / *C; } else { *R = *DA * (h / adahsq); *(R+1) = *(DA+1) * (h / adahsq); From 8698f9e37f63bd0a57b8182aaecb46cac2adf620 Mon Sep 17 00:00:00 2001 From: Dmitry Mikushin Date: Sat, 10 Feb 2024 19:12:16 +0100 Subject: [PATCH 148/311] Adding basic support of benchmarks into CMake for single, double, single complex and double complex cases. Each benchmarking target has a suffix to identify the data type, for example ./benchmark_gemm3m_COMPLEX_DOUBLE is a gemm3m.c source compiled with COMPLEX and DOUBLE macros defined --- CMakeLists.txt | 28 ++++++++++++++++++++++++++++ 1 file changed, 28 insertions(+) diff --git a/CMakeLists.txt b/CMakeLists.txt index 5a1e4b271..059035ac3 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -452,6 +452,34 @@ if (BUILD_SHARED_LIBS AND NOT ${SYMBOLPREFIX}${SYMBOLSUFFIX} STREQUAL "") endif() endif() +if (BUILD_TESTING) + find_package(OpenMP REQUIRED) + file(GLOB SOURCES "benchmark/*.c") + foreach(source ${SOURCES}) + get_filename_component(name ${source} NAME_WE) + if ((NOT ${name} STREQUAL "zdot-intel") AND (NOT ${name} STREQUAL "cula_wrapper")) + set(defines DEFAULT COMPLEX DOUBLE "COMPLEX\;DOUBLE") + foreach(define ${defines}) + set(target_name "benchmark_${name}") + if (NOT "${define}" STREQUAL "DEFAULT") + string(JOIN "_" define_str ${define}) + set(target_name "${target_name}_${define_str}") + endif() + if ((NOT ${target_name} STREQUAL "benchmark_imax_COMPLEX") AND (NOT ${target_name} STREQUAL "benchmark_imax_COMPLEX_DOUBLE") AND + (NOT ${target_name} STREQUAL "benchmark_imin_COMPLEX") AND (NOT ${target_name} STREQUAL "benchmark_imin_COMPLEX_DOUBLE") AND + (NOT ${target_name} STREQUAL "benchmark_max_COMPLEX") AND (NOT ${target_name} STREQUAL "benchmark_max_COMPLEX_DOUBLE") AND + (NOT ${target_name} STREQUAL "benchmark_min_COMPLEX") AND (NOT ${target_name} STREQUAL "benchmark_min_COMPLEX_DOUBLE")) + add_executable(${target_name} ${source}) + target_include_directories(${target_name} PRIVATE ${CMAKE_CURRENT_SOURCE_DIR} ${CMAKE_CURRENT_BINARY_DIR}) + target_link_libraries(${target_name} ${OpenBLAS_LIBNAME} OpenMP::OpenMP_C) + if (NOT "${define}" STREQUAL "DEFAULT") + target_compile_definitions(${target_name} PRIVATE ${define}) + endif() + endif() + endforeach() + endif() + endforeach() +endif() # Install project From d0f5dc763be1783874c5fe5c84c0eef90e73a6d1 Mon Sep 17 00:00:00 2001 From: Dmitry Mikushin Date: Mon, 12 Feb 2024 02:18:03 +0100 Subject: [PATCH 149/311] Adding USE_GEMM3M macro to kernel targets, so that the *gemm3m functions and parameters can be included into the gotoblas structure. Fixes #4500 --- kernel/CMakeLists.txt | 3 +++ 1 file changed, 3 insertions(+) diff --git a/kernel/CMakeLists.txt b/kernel/CMakeLists.txt index 60314eedb..74e6760c2 100644 --- a/kernel/CMakeLists.txt +++ b/kernel/CMakeLists.txt @@ -1349,6 +1349,9 @@ endif () set_target_properties(kernel${TSUFFIX} PROPERTIES COMPILE_FLAGS "${KERNEL_DEFINITIONS}") get_target_property(KERNEL_INCLUDE_DIRECTORIES kernel${TSUFFIX} INCLUDE_DIRECTORIES) set_target_properties(kernel${TSUFFIX} PROPERTIES INCLUDE_DIRECTORIES "${KERNEL_INCLUDE_DIRECTORIES};${TARGET_CONF_DIR}") + if (USE_GEMM3M) + target_compile_definitions(kernel${TSUFFIX} PRIVATE USE_GEMM3M) + endif() endfunction () From 10548a0460d0b6abd160e69cd7ca727d41681584 Mon Sep 17 00:00:00 2001 From: Mark Seminatore Date: Mon, 12 Feb 2024 10:22:12 -0800 Subject: [PATCH 150/311] update contributors --- CONTRIBUTORS.md | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/CONTRIBUTORS.md b/CONTRIBUTORS.md index 493747052..8f7abc5f8 100644 --- a/CONTRIBUTORS.md +++ b/CONTRIBUTORS.md @@ -218,4 +218,6 @@ In chronological order: * [2022-08] Fix building from sources for QNX * Mark Seminatore - * [2023-11-09] Improve Windows threading performance scaling \ No newline at end of file + * [2023-11-09] Improve Windows threading performance scaling + * [2024-02-09] Introduce MT_TRACE facility and improve code consistency + \ No newline at end of file From a28afac791853e93c8462199d7ce18694ccc0a2c Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Thu, 15 Feb 2024 11:48:33 +0100 Subject: [PATCH 151/311] Add FIXED_LIBNAME, LIBNAMEPREFIX and LIBNAMESUFFIX --- CMakeLists.txt | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 5a1e4b271..a4440ee1b 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -40,6 +40,11 @@ option(USE_PERL "Use the older PERL scripts for build preparation instead of uni option(NO_WARMUP "Do not run a benchmark on each startup just to find the best location for the memory buffer" ON) +option(FIXED_LIBNAME "Use a non-versioned name for the library and no symbolic linking to variant names" OFF) + +set(LIBNAMEPREFIX "" CACHE STRING "Add a prefix to the openblas part of the library name" ) +set(LIBNAMESUFFIX "" CACHE STRING "Add a suffix after the openblas part of the library name" ) + if(${CMAKE_SYSTEM_NAME} MATCHES "Linux") option(NO_AFFINITY "Disable support for CPU affinity masks to avoid binding processes from e.g. R or numpy/scipy to a single core" ON) else() @@ -96,7 +101,7 @@ message(WARNING "CMake support is experimental. It does not yet support all buil include("${PROJECT_SOURCE_DIR}/cmake/utils.cmake") include("${PROJECT_SOURCE_DIR}/cmake/system.cmake") -set(OpenBLAS_LIBNAME openblas${SUFFIX64_UNDERSCORE}) +set(OpenBLAS_LIBNAME ${LIBNAMEPREFIX}openblas${LIBNAMESUFFIX}${SUFFIX64_UNDERSCORE}) set(BLASDIRS interface driver/level2 driver/level3 driver/others) @@ -336,11 +341,12 @@ endif() add_subdirectory(cpp_thread_test) endif() +if (NOT FIXED_LIBNAME) set_target_properties(${OpenBLAS_LIBS} PROPERTIES VERSION ${OpenBLAS_MAJOR_VERSION}.${OpenBLAS_MINOR_VERSION} SOVERSION ${OpenBLAS_MAJOR_VERSION} ) - +endif() if (BUILD_SHARED_LIBS AND BUILD_RELAPACK) if (NOT MSVC) target_link_libraries(${OpenBLAS_LIBNAME}_shared "-Wl,-allow-multiple-definition") From ffbfc3c692c44029eda64a5bc2cc1292bac5572e Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Thu, 15 Feb 2024 12:16:34 +0100 Subject: [PATCH 152/311] Add libname prefix and suffix --- cmake/openblas.pc.in | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/cmake/openblas.pc.in b/cmake/openblas.pc.in index 11e5606e5..9526d2df6 100644 --- a/cmake/openblas.pc.in +++ b/cmake/openblas.pc.in @@ -1,4 +1,6 @@ libdir=@CMAKE_INSTALL_FULL_LIBDIR@ +libnameprefix=@LIBNAMEPREFIX@ +libnamesuffix=@LIBNAMESUFFIX@ libsuffix=@SUFFIX64_UNDERSCORE@ includedir=@CMAKE_INSTALL_FULL_INCLUDEDIR@ @@ -7,5 +9,5 @@ Name: OpenBLAS Description: OpenBLAS is an optimized BLAS library based on GotoBLAS2 1.13 BSD version Version: @OpenBLAS_VERSION@ URL: https://github.com/OpenMathLib/OpenBLAS -Libs: @OpenMP_C_FLAGS@ -L${libdir} -lopenblas${libsuffix} +Libs: @OpenMP_C_FLAGS@ -L${libdir} -l${libnameprefix}openblas${libnamesuffix}${libsuffix} Cflags: -I${includedir} From a0e3f77e0bdbaab44ac86076e15ad15c65c15106 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Thu, 15 Feb 2024 12:17:38 +0100 Subject: [PATCH 153/311] add FIXED_LIBNAME, PREFIX and SUFFIX --- cmake/system.cmake | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/cmake/system.cmake b/cmake/system.cmake index bc87f7b44..95f34e9f8 100644 --- a/cmake/system.cmake +++ b/cmake/system.cmake @@ -501,10 +501,11 @@ set(CCOMMON_OPT "${CCOMMON_OPT} -DBLAS3_MEM_ALLOC_THRESHOLD=${BLAS3_MEM_ALLOC_TH endif() endif() endif() + +set(LIBPREFIX "lib${LIBNAMEPREFIX}openblas") + if (DEFINED LIBNAMESUFFIX) - set(LIBPREFIX "libopenblas_${LIBNAMESUFFIX}") -else () - set(LIBPREFIX "libopenblas") + set(LIBPREFIX "${LIBNAMEPREFIX}_${LIBNAMESUFFIX}") endif () if (NOT DEFINED SYMBOLPREFIX) @@ -679,6 +680,10 @@ else () endif () endif () +if (DEFINED FIXED_LIBNAME) + set (LIBNAME "${LIBPREFIX}.${LIBSUFFIX}") + set (LIBNAME "${LIBPREFIX}_p.${LIBSUFFIX}") +endif() set(LIBDLLNAME "${LIBPREFIX}.dll") set(LIBSONAME "${LIBNAME}.${LIBSUFFIX}.so") From 3120f12e767f05cf59e53e903c6a2a2ca9440b07 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Thu, 15 Feb 2024 14:16:20 +0100 Subject: [PATCH 154/311] allow for more pre- and suffixes in the name of the openblas library --- lapack-netlib/TESTING/EIG/CMakeLists.txt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lapack-netlib/TESTING/EIG/CMakeLists.txt b/lapack-netlib/TESTING/EIG/CMakeLists.txt index e7236677a..d9c34fe98 100644 --- a/lapack-netlib/TESTING/EIG/CMakeLists.txt +++ b/lapack-netlib/TESTING/EIG/CMakeLists.txt @@ -106,7 +106,7 @@ set(ZDMDEIGTST zchkdmd.f90) macro(add_eig_executable name) add_executable(${name} ${ARGN}) - target_link_libraries(${name} openblas${SUFFIX64_UNDERSCORE}) + target_link_libraries(${name} ${LIBNAMEPREFIX}openblas${LIBNAMESUFFIX}${SUFFIX64_UNDERSCORE}) #${TMGLIB} ../${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) endmacro() From c90979d8ef1aa69f7993efabb1b652d96d0f286c Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Thu, 15 Feb 2024 14:17:11 +0100 Subject: [PATCH 155/311] allow for more pre- and suffixes in the name of the openblas library --- lapack-netlib/TESTING/LIN/CMakeLists.txt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lapack-netlib/TESTING/LIN/CMakeLists.txt b/lapack-netlib/TESTING/LIN/CMakeLists.txt index 143fd0597..95baa3122 100644 --- a/lapack-netlib/TESTING/LIN/CMakeLists.txt +++ b/lapack-netlib/TESTING/LIN/CMakeLists.txt @@ -239,7 +239,7 @@ set(ZLINTSTRFP zchkrfp.f zdrvrfp.f zdrvrf1.f zdrvrf2.f zdrvrf3.f zdrvrf4.f zerrr macro(add_lin_executable name) add_executable(${name} ${ARGN}) - target_link_libraries(${name} openblas${SUFFIX64_UNDERSCORE}) + target_link_libraries(${name} ${LIBNAMEPREFIX}openblas${LIBNAMESUFFIX}${SUFFIX64_UNDERSCORE}) #${TMGLIB} ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) endmacro() From ca6b4961e4a5d2804372769f7d04cf5d7d86968e Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Thu, 15 Feb 2024 14:31:11 +0100 Subject: [PATCH 156/311] updates to fix option conflicts and config file generation --- Makefile.install | 4 +++- Makefile.system | 2 +- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/Makefile.install b/Makefile.install index 2b00db4be..b2bc5aa41 100644 --- a/Makefile.install +++ b/Makefile.install @@ -7,6 +7,8 @@ LNCMD = ln -fs ifdef THELIBNAME LIBNAME=$(THELIBNAME) LIBSONAME=$(THELIBSONAME) +endif +ifeq ($(FIXED_LIBNAME), 1) LNCMD = true endif ifeq ($(INTERFACE64),1) @@ -190,7 +192,7 @@ endif ifneq ($(NO_SHARED),1) #ifeq logical or ifeq ($(OSNAME), $(filter $(OSNAME),Linux FreeBSD NetBSD OpenBSD DragonFly)) - @echo "SET(OpenBLAS_LIBRARIES ${OPENBLAS_LIBRARY_DIR}/$(LIBPREFIX)$(LIBNAMESUFFIX).so)" >> "$(DESTDIR)$(OPENBLAS_CMAKE_DIR)/$(OPENBLAS_CMAKE_CONFIG)" + @echo "SET(OpenBLAS_LIBRARIES ${OPENBLAS_LIBRARY_DIR}/$(LIBPREFIX)$(SYMBOLSUFFIX).so)" >> "$(DESTDIR)$(OPENBLAS_CMAKE_DIR)/$(OPENBLAS_CMAKE_CONFIG)" endif ifeq ($(OSNAME), $(filter $(OSNAME),WINNT CYGWIN_NT)) @echo "SET(OpenBLAS_LIBRARIES ${OPENBLAS_BINARY_DIR}/$(LIBDLLNAME))" >> "$(DESTDIR)$(OPENBLAS_CMAKE_DIR)/$(OPENBLAS_CMAKE_CONFIG)" diff --git a/Makefile.system b/Makefile.system index 233663ef9..2be7024c8 100644 --- a/Makefile.system +++ b/Makefile.system @@ -1523,7 +1523,7 @@ endif ifndef LIBNAMESUFFIX LIBNAMEBASE = $(SYMBOLPREFIX)$(LIBSONAMEBASE)$(SYMBOLSUFFIX) else -LIBNAMEBASE = $(SYMBOLPREFIX)$(LIBSONAMEBASE)$(SYMBOLSUFFIX)_$(LIBNAMESUFFIX) +LIBNAMEBASE = $(SYMBOLPREFIX)$(LIBSONAMEBASE)$(SYMBOLSUFFIX)$(LIBNAMESUFFIX) endif ifeq ($(OSNAME), CYGWIN_NT) From ba17758c02134acb327a4b71202be6be15e36dbd Mon Sep 17 00:00:00 2001 From: Sergei Lewis Date: Fri, 16 Feb 2024 15:58:02 +0000 Subject: [PATCH 157/311] fix axpy implementations where y has a stride of 0 --- kernel/riscv64/axpy_rvv.c | 26 ++++++++++++++++++++++++-- kernel/riscv64/axpy_vector.c | 24 +++++++++++++++++++++++- 2 files changed, 47 insertions(+), 3 deletions(-) diff --git a/kernel/riscv64/axpy_rvv.c b/kernel/riscv64/axpy_rvv.c index 8bc2f30de..2d5293f76 100644 --- a/kernel/riscv64/axpy_rvv.c +++ b/kernel/riscv64/axpy_rvv.c @@ -30,19 +30,29 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #if !defined(DOUBLE) #define VSETVL(n) __riscv_vsetvl_e32m8(n) #define FLOAT_V_T vfloat32m8_t +#define FLOAT_V_M1_T vfloat32m1_t #define VLEV_FLOAT __riscv_vle32_v_f32m8 #define VLSEV_FLOAT __riscv_vlse32_v_f32m8 #define VSEV_FLOAT __riscv_vse32_v_f32m8 +#define VSEV_FLOAT_M1 __riscv_vse32_v_f32m1 #define VSSEV_FLOAT __riscv_vsse32_v_f32m8 #define VFMACCVF_FLOAT __riscv_vfmacc_vf_f32m8 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f32m8 +#define VFREDSUMVS_FLOAT __riscv_vfredusum_vs_f32m8_f32m1 +#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f32m1 #else #define VSETVL(n) __riscv_vsetvl_e64m8(n) #define FLOAT_V_T vfloat64m8_t +#define FLOAT_V_M1_T vfloat64m1_t #define VLEV_FLOAT __riscv_vle64_v_f64m8 #define VLSEV_FLOAT __riscv_vlse64_v_f64m8 #define VSEV_FLOAT __riscv_vse64_v_f64m8 +#define VSEV_FLOAT_M1 __riscv_vse64_v_f64m1 #define VSSEV_FLOAT __riscv_vsse64_v_f64m8 #define VFMACCVF_FLOAT __riscv_vfmacc_vf_f64m8 +#define VFMVVF_FLOAT __riscv_vfmv_v_f_f64m8 +#define VFREDSUMVS_FLOAT __riscv_vfredusum_vs_f64m8_f64m1 +#define VFMVVF_FLOAT_M1 __riscv_vfmv_v_f_f64m1 #endif int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT da, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y, FLOAT *dummy, BLASLONG dummy2) @@ -76,7 +86,7 @@ int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT da, FLOAT *x, BLAS VSEV_FLOAT(y, vy, vl); } - } else if (1 == inc_x) { + } else if (1 == inc_x && 0 != inc_y) { BLASLONG stride_y = inc_y * sizeof(FLOAT); @@ -89,8 +99,20 @@ int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT da, FLOAT *x, BLAS VSSEV_FLOAT(y, stride_y, vy, vl); } - } else { + } else if( 0 == inc_y ) { + BLASLONG stride_x = inc_x * sizeof(FLOAT); + size_t in_vl = VSETVL(n); + vy = VFMVVF_FLOAT( y[0], in_vl ); + for (size_t vl; n > 0; n -= vl, x += vl*inc_x) { + vl = VSETVL(n); + vx = VLSEV_FLOAT(x, stride_x, vl); + vy = VFMACCVF_FLOAT(vy, da, vx, vl); + } + FLOAT_V_M1_T vres = VFMVVF_FLOAT_M1( 0.0f, 1 ); + vres = VFREDSUMVS_FLOAT( vy, vres, in_vl ); + VSEV_FLOAT_M1(y, vres, 1); + } else { BLASLONG stride_x = inc_x * sizeof(FLOAT); BLASLONG stride_y = inc_y * sizeof(FLOAT); diff --git a/kernel/riscv64/axpy_vector.c b/kernel/riscv64/axpy_vector.c index 6dffe5f09..c77a18afa 100644 --- a/kernel/riscv64/axpy_vector.c +++ b/kernel/riscv64/axpy_vector.c @@ -51,11 +51,20 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define VSETVL JOIN(RISCV_RVV(vsetvl), _e, ELEN, LMUL, _) #define FLOAT_V_T JOIN(vfloat, ELEN, LMUL, _t, _) +#define FLOAT_V_M1_T JOIN(vfloat, ELEN, m1, _t, _) #define VLEV_FLOAT JOIN(RISCV_RVV(vle), ELEN, _v_f, ELEN, LMUL) #define VLSEV_FLOAT JOIN(RISCV_RVV(vlse), ELEN, _v_f, ELEN, LMUL) #define VSEV_FLOAT JOIN(RISCV_RVV(vse), ELEN, _v_f, ELEN, LMUL) #define VSSEV_FLOAT JOIN(RISCV_RVV(vsse), ELEN, _v_f, ELEN, LMUL) #define VFMACCVF_FLOAT JOIN(RISCV_RVV(vfmacc), _vf_f, ELEN, LMUL, _) +#define VFMVVF_FLOAT JOIN(RISCV_RVV(vfmv), _v_f_f, ELEN, LMUL, _) +#define VFMVVF_FLOAT_M1 JOIN(RISCV_RVV(vfmv), _v_f_f, ELEN, m1, _) + +#ifdef RISCV_0p10_INTRINSICS +#define VFREDSUMVS_FLOAT(va, vb, gvl) JOIN(RISCV_RVV(vfredusum_vs_f), ELEN, LMUL, _f, JOIN2( ELEN, m1))(v_res, va, vb, gvl) +#else +#define VFREDSUMVS_FLOAT JOIN(RISCV_RVV(vfredusum_vs_f), ELEN, LMUL, _f, JOIN2( ELEN, m1)) +#endif int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT da, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y, FLOAT *dummy, BLASLONG dummy2) { @@ -123,7 +132,7 @@ int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT da, FLOAT *x, BLAS VSEV_FLOAT(&y[j], vy0, gvl); j += gvl; } - }else if(inc_x == 1){ + } else if (1 == inc_x && 0 != inc_y) { stride_y = inc_y * sizeof(FLOAT); gvl = VSETVL(n); if(gvl <= n/2){ @@ -151,6 +160,19 @@ int CNAME(BLASLONG n, BLASLONG dummy0, BLASLONG dummy1, FLOAT da, FLOAT *x, BLAS VSSEV_FLOAT(&y[j*inc_y], stride_y, vy0, gvl); j += gvl; } + } else if( 0 == inc_y ) { + BLASLONG stride_x = inc_x * sizeof(FLOAT); + size_t in_vl = VSETVL(n); + vy0 = VFMVVF_FLOAT( y[0], in_vl ); + + for (size_t vl; n > 0; n -= vl, x += vl*inc_x) { + vl = VSETVL(n); + vx0 = VLSEV_FLOAT(x, stride_x, vl); + vy0 = VFMACCVF_FLOAT(vy0, da, vx0, vl); + } + FLOAT_V_M1_T v_res = VFMVVF_FLOAT_M1( 0.0f, 1 ); + v_res = VFREDSUMVS_FLOAT( vy0, v_res, in_vl ); + y[0] = EXTRACT_FLOAT(v_res); }else{ stride_x = inc_x * sizeof(FLOAT); stride_y = inc_y * sizeof(FLOAT); From 461ecabb2249fd598b325a91d2b4dfccbc90a824 Mon Sep 17 00:00:00 2001 From: Sergei Lewis Date: Fri, 16 Feb 2024 11:33:28 +0000 Subject: [PATCH 158/311] add RISCV64_ZVL128B and RISCV64_ZVL256B targets to CI flows and to README.md --- .github/workflows/riscv64_vector.yml | 253 +++++++++++++++++++++++++++ README.md | 10 ++ common_riscv64.h | 2 +- 3 files changed, 264 insertions(+), 1 deletion(-) create mode 100644 .github/workflows/riscv64_vector.yml diff --git a/.github/workflows/riscv64_vector.yml b/.github/workflows/riscv64_vector.yml new file mode 100644 index 000000000..dd6fe9ca8 --- /dev/null +++ b/.github/workflows/riscv64_vector.yml @@ -0,0 +1,253 @@ +name: riscv64 zvl256b qemu test + +on: [push, pull_request] + +concurrency: + group: ${{ github.workflow }}-${{ github.head_ref || github.run_id }} + cancel-in-progress: true + +permissions: + contents: read # to fetch code (actions/checkout) + +jobs: + TEST: + if: "github.repository == 'OpenMathLib/OpenBLAS'" + runs-on: ubuntu-latest + env: + triple: riscv64-unknown-linux-gnu + riscv_gnu_toolchain: https://github.com/riscv-collab/riscv-gnu-toolchain + riscv_gnu_toolchain_version: 13.2.0 + riscv_gnu_toolchain_nightly_download_path: /releases/download/2024.02.02/riscv64-glibc-ubuntu-22.04-llvm-nightly-2024.02.02-nightly.tar.gz + strategy: + fail-fast: false + matrix: + include: + - target: RISCV64_ZVL128B + opts: TARGET=RISCV64_ZVL128B BINARY=64 ARCH=riscv64 + qemu_cpu: rv64,g=true,c=true,v=true,vext_spec=v1.0,vlen=128,elen=64 + - target: RISCV64_ZVL256B + opts: TARGET=RISCV64_ZVL256B BINARY=64 ARCH=riscv64 + qemu_cpu: rv64,g=true,c=true,v=true,vext_spec=v1.0,vlen=256,elen=64 + + steps: + - name: Checkout repository + uses: actions/checkout@v3 + + - name: install build deps + run: | + sudo apt-get update + sudo apt-get install autoconf automake autotools-dev ninja-build make \ + libgomp1-riscv64-cross ccache + wget ${riscv_gnu_toolchain}/${riscv_gnu_toolchain_nightly_download_path} + tar -xvf $(basename ${riscv_gnu_toolchain_nightly_download_path}) -C /opt + + - name: Compilation cache + uses: actions/cache@v3 + with: + path: ~/.ccache + key: ccache-${{ runner.os }}-${{ matrix.target }}-${{ github.ref }}-${{ github.sha }} + restore-keys: | + ccache-${{ runner.os }}-${{ matrix.target }}-${{ github.ref }} + ccache-${{ runner.os }}-${{ matrix.target }} + + - name: Configure ccache + run: | + test -d ~/.ccache || mkdir -p ~/.ccache + echo "max_size = 300M" > ~/.ccache/ccache.conf + echo "compression = true" >> ~/.ccache/ccache.conf + ccache -s + + - name: build OpenBLAS libs + run: | + export PATH="/opt/riscv/bin:$PATH" + make TARGET=${{ matrix.target }} CFLAGS="-DTARGET=${{ matrix.target }}" \ + CC='ccache clang --rtlib=compiler-rt -target ${triple} --sysroot /opt/riscv/sysroot --gcc-toolchain=/opt/riscv/lib/gcc/riscv64-unknown-linux-gnu/${riscv_gnu_toolchain_version}/' \ + AR='ccache ${triple}-ar' AS='ccache ${triple}-gcc' LD='ccache ${triple}-gcc' \ + RANLIB='ccache ${triple}-ranlib' \ + FC='ccache ${triple}-gfortran' ${{ matrix.opts }} \ + HOSTCC=gcc HOSTFC=gfortran -j$(nproc) + + - name: build OpenBLAS tests + run: | + export PATH="/opt/riscv/bin:$PATH" + make TARGET=${{ matrix.target }} CFLAGS="-DTARGET=${{ matrix.target }}" \ + CC='${triple}-gcc' \ + AR='ccache ${triple}-ar' AS='ccache ${triple}-gcc' LD='ccache ${triple}-gcc' \ + RANLIB='ccache ${triple}-ranlib' \ + FC='ccache ${triple}-gfortran' ${{ matrix.opts }} \ + HOSTCC=gcc HOSTFC=gfortran -j$(nproc) tests + + - name: build lapack-netlib tests + working-directory: ./lapack-netlib/TESTING + run: | + export PATH="/opt/riscv/bin:$PATH" + make TARGET=${{ matrix.target }} CFLAGS="-DTARGET=${{ matrix.target }}" \ + CC='${triple}-gcc' \ + AR='ccache ${triple}-ar' AS='ccache ${triple}-gcc' LD='ccache ${triple}-gcc' \ + RANLIB='ccache ${triple}-ranlib' \ + FC='ccache ${triple}-gfortran' ${{ matrix.opts }} \ + HOSTCC=gcc HOSTFC=gfortran -j$(nproc) \ + LIN/xlintsts LIN/xlintstc LIN/xlintstd LIN/xlintstz LIN/xlintstrfs \ + LIN/xlintstrfc LIN/xlintstrfd LIN/xlintstrfz LIN/xlintstds \ + LIN/xlintstzc EIG/xeigtsts EIG/xeigtstc EIG/xeigtstd EIG/xeigtstz \ + + - name: OpenBLAS tests + shell: bash + run: | + export PATH="/opt/riscv/bin:$PATH" + export QEMU_CPU=${{ matrix.qemu_cpu }} + rm -rf ./test_out + mkdir -p ./test_out + run_test() { local DIR=$1; local CMD=$2; local DATA=$3; local OUTPUT="./test_out/$DIR.$CMD"; \ + echo "`pwd`/$DIR/$CMD $DIR/$DATA" >> $OUTPUT; \ + if [[ -z $DATA ]]; then qemu-riscv64 ./$DIR/$CMD |& tee $OUTPUT ; \ + else qemu-riscv64 ./$DIR/$CMD < ./$DIR/$DATA |& tee $OUTPUT ; fi ; \ + RV=$? ; if [[ $RV != 0 ]]; then echo "*** FAIL: nonzero exit code $RV" >> $OUTPUT ; fi \ + } + run_test test cblat1 & + run_test test cblat2 cblat2.dat & + run_test test cblat3 cblat3.dat & + run_test test dblat1 & + run_test test dblat2 dblat2.dat & + run_test test dblat3 dblat3.dat & + run_test test sblat1 & + run_test test sblat2 sblat2.dat & + run_test test sblat3 sblat3.dat & + run_test test zblat1 & + run_test test zblat2 zblat2.dat & + run_test test zblat3 zblat3.dat & + run_test ctest xccblat1 & + run_test ctest xccblat2 cin2 & + run_test ctest xccblat3 cin3 & + run_test ctest xdcblat1 & + run_test ctest xdcblat2 din2 & + run_test ctest xdcblat3 din3 & + run_test ctest xscblat1 & + run_test ctest xscblat2 sin2 & + run_test ctest xscblat3 sin3 & + run_test ctest xzcblat1 & + run_test ctest xzcblat2 zin2 & + run_test ctest xzcblat3 zin3 & + wait + while IFS= read -r -d $'\0' LOG; do cat $LOG ; FAILURES=1 ; done < <(grep -lZ FAIL ./test_out/*) + if [[ ! -z $FAILURES ]]; then echo "==========" ; echo "== FAIL ==" ; echo "==========" ; echo ; exit 1 ; fi + + - name: netlib tests + shell: bash + run: | + : # these take a very long time + echo "Skipping netlib tests in CI" + exit 0 + : # comment out exit above to enable the tests + : # probably we want to identify a subset to run in CI + export PATH="/opt/riscv/bin:$PATH" + export QEMU_CPU=${{ matrix.qemu_cpu }} + rm -rf ./test_out + mkdir -p ./test_out + run_test() { local OUTPUT="./test_out/$1"; local DATA="./lapack-netlib/TESTING/$2"; local CMD="./lapack-netlib/TESTING/$3"; \ + echo "$4" >> $OUTPUT; \ + echo "$CMD" >> $OUTPUT; \ + qemu-riscv64 $CMD < $DATA |& tee $OUTPUT; \ + RV=$? ; if [[ $RV != 0 ]]; then echo "*** FAIL: nonzero exit code $RV" >> $OUTPUT ; fi; \ + if grep -q fail $OUTPUT ; then echo "*** FAIL: log contains 'fail'" >> $OUTPUT ; fi ; \ + if grep -q rror $OUTPUT | grep -v -q "passed" | grep -v "largest error" ; then echo "*** FAIL: log contains 'error'" >> $OUTPUT ; fi \ + } + run_test stest.out stest.in LIN/xlintsts "Testing REAL LAPACK linear equation routines" & + run_test ctest.out ctest.in LIN/xlintstc "Testing COMPLEX LAPACK linear equation routines" & + run_test dtest.out dtest.in LIN/xlintstd "Testing DOUBLE PRECISION LAPACK linear equation routines" & + run_test ztest.out ztest.in LIN/xlintstz "Testing COMPLEX16 LAPACK linear equation routines" & + run_test dstest.out dstest.in LIN/xlintstds "Testing SINGLE-DOUBLE PRECISION LAPACK prototype linear equation routines" & + run_test zctest.out zctest.in LIN/xlintstzc "Testing COMPLEX-COMPLEX16 LAPACK prototype linear equation routines" & + run_test stest_rfp.out stest_rfp.in LIN/xlintstrfs "Testing REAL LAPACK RFP prototype linear equation routines" & + run_test dtest_rfp.out dtest_rfp.in LIN/xlintstrfd "Testing DOUBLE PRECISION LAPACK RFP prototype linear equation routines" & + run_test ctest_rfp.out ctest_rfp.in LIN/xlintstrfc "Testing COMPLEX LAPACK RFP prototype linear equation routines" & + run_test ztest_rfp.out ztest_rfp.in LIN/xlintstrfz "Testing COMPLEX16 LAPACK RFP prototype linear equation routines" & + run_test snep.out nep.in EIG/xeigtsts "NEP - Testing Nonsymmetric Eigenvalue Problem routines" & + run_test ssep.out sep.in EIG/xeigtsts "SEP - Testing Symmetric Eigenvalue Problem routines" & + run_test sse2.out se2.in EIG/xeigtsts "SEP - Testing Symmetric Eigenvalue Problem routines" & + run_test ssvd.out svd.in EIG/xeigtsts "SVD - Testing Singular Value Decomposition routines" & + run_test sec.out sec.in EIG/xeigtsts "SEC - Testing REAL Eigen Condition Routines" & + run_test sed.out sed.in EIG/xeigtsts "SEV - Testing REAL Nonsymmetric Eigenvalue Driver" & + run_test sgg.out sgg.in EIG/xeigtsts "SGG - Testing REAL Nonsymmetric Generalized Eigenvalue Problem routines" & + run_test sgd.out sgd.in EIG/xeigtsts "SGD - Testing REAL Nonsymmetric Generalized Eigenvalue Problem driver routines" & + run_test ssb.out ssb.in EIG/xeigtsts "SSB - Testing REAL Symmetric Eigenvalue Problem routines" & + run_test ssg.out ssg.in EIG/xeigtsts "SSG - Testing REAL Symmetric Generalized Eigenvalue Problem routines" & + run_test sbal.out sbal.in EIG/xeigtsts "SGEBAL - Testing the balancing of a REAL general matrix" & + run_test sbak.out sbak.in EIG/xeigtsts "SGEBAK - Testing the back transformation of a REAL balanced matrix" & + run_test sgbal.out sgbal.in EIG/xeigtsts "SGGBAL - Testing the balancing of a pair of REAL general matrices" & + run_test sgbak.out sgbak.in EIG/xeigtsts "SGGBAK - Testing the back transformation of a pair of REAL balanced matrices" & + run_test sbb.out sbb.in EIG/xeigtsts "SBB - Testing banded Singular Value Decomposition routines" & + run_test sglm.out glm.in EIG/xeigtsts "GLM - Testing Generalized Linear Regression Model routines" & + run_test sgqr.out gqr.in EIG/xeigtsts "GQR - Testing Generalized QR and RQ factorization routines" & + run_test sgsv.out gsv.in EIG/xeigtsts "GSV - Testing Generalized Singular Value Decomposition routines" & + run_test scsd.out csd.in EIG/xeigtsts "CSD - Testing CS Decomposition routines" & + run_test slse.out lse.in EIG/xeigtsts "LSE - Testing Constrained Linear Least Squares routines" & + run_test cnep.out nep.in EIG/xeigtstc "NEP - Testing Nonsymmetric Eigenvalue Problem routines" & + run_test csep.out sep.in EIG/xeigtstc "SEP - Testing Symmetric Eigenvalue Problem routines" & + run_test cse2.out se2.in EIG/xeigtstc "SEP - Testing Symmetric Eigenvalue Problem routines" & + run_test csvd.out svd.in EIG/xeigtstc "SVD - Testing Singular Value Decomposition routines" & + run_test cec.out cec.in EIG/xeigtstc "CEC - Testing COMPLEX Eigen Condition Routines" & + run_test ced.out ced.in EIG/xeigtstc "CES - Testing COMPLEX Nonsymmetric Schur Form Driver" & + run_test cgg.out cgg.in EIG/xeigtstc "CGG - Testing COMPLEX Nonsymmetric Generalized Eigenvalue Problem routines" & + run_test cgd.out cgd.in EIG/xeigtstc "CGD - Testing COMPLEX Nonsymmetric Generalized Eigenvalue Problem driver routines" & + run_test csb.out csb.in EIG/xeigtstc "CHB - Testing Hermitian Eigenvalue Problem routines" & + run_test csg.out csg.in EIG/xeigtstc "CSG - Testing Symmetric Generalized Eigenvalue Problem routines" & + run_test cbal.out cbal.in EIG/xeigtstc "CGEBAL - Testing the balancing of a COMPLEX general matrix" & + run_test cbak.out cbak.in EIG/xeigtstc "CGEBAK - Testing the back transformation of a COMPLEX balanced matrix" & + run_test cgbal.out cgbal.in EIG/xeigtstc "CGGBAL - Testing the balancing of a pair of COMPLEX general matrices" & + run_test cgbak.out cgbak.in EIG/xeigtstc "CGGBAK - Testing the back transformation of a pair of COMPLEX balanced matrices" & + run_test cbb.out cbb.in EIG/xeigtstc "CBB - Testing banded Singular Value Decomposition routines" & + run_test cglm.out glm.in EIG/xeigtstc "GLM - Testing Generalized Linear Regression Model routines" & + run_test cgqr.out gqr.in EIG/xeigtstc "GQR - Testing Generalized QR and RQ factorization routines" & + run_test cgsv.out gsv.in EIG/xeigtstc "GSV - Testing Generalized Singular Value Decomposition routines" & + run_test ccsd.out csd.in EIG/xeigtstc "CSD - Testing CS Decomposition routines" & + run_test clse.out lse.in EIG/xeigtstc "LSE - Testing Constrained Linear Least Squares routines" & + run_test dnep.out nep.in EIG/xeigtstd "NEP - Testing Nonsymmetric Eigenvalue Problem routines" & + run_test dsep.out sep.in EIG/xeigtstd "SEP - Testing Symmetric Eigenvalue Problem routines" & + run_test dse2.out se2.in EIG/xeigtstd "SEP - Testing Symmetric Eigenvalue Problem routines" & + run_test dsvd.out svd.in EIG/xeigtstd "SVD - Testing Singular Value Decomposition routines" & + run_test dec.out dec.in EIG/xeigtstd "DEC - Testing DOUBLE PRECISION Eigen Condition Routines" & + run_test ded.out ded.in EIG/xeigtstd "DEV - Testing DOUBLE PRECISION Nonsymmetric Eigenvalue Driver" & + run_test dgg.out dgg.in EIG/xeigtstd "DGG - Testing DOUBLE PRECISION Nonsymmetric Generalized Eigenvalue Problem routines" & + run_test dgd.out dgd.in EIG/xeigtstd "DGD - Testing DOUBLE PRECISION Nonsymmetric Generalized Eigenvalue Problem driver routines" & + run_test dsb.out dsb.in EIG/xeigtstd "DSB - Testing DOUBLE PRECISION Symmetric Eigenvalue Problem routines" & + run_test dsg.out dsg.in EIG/xeigtstd "DSG - Testing DOUBLE PRECISION Symmetric Generalized Eigenvalue Problem routines" & + run_test dbal.out dbal.in EIG/xeigtstd "DGEBAL - Testing the balancing of a DOUBLE PRECISION general matrix" & + run_test dbak.out dbak.in EIG/xeigtstd "DGEBAK - Testing the back transformation of a DOUBLE PRECISION balanced matrix" & + run_test dgbal.out dgbal.in EIG/xeigtstd "DGGBAL - Testing the balancing of a pair of DOUBLE PRECISION general matrices" & + run_test dgbak.out dgbak.in EIG/xeigtstd "DGGBAK - Testing the back transformation of a pair of DOUBLE PRECISION balanced matrices" & + run_test dbb.out dbb.in EIG/xeigtstd "DBB - Testing banded Singular Value Decomposition routines" & + run_test dglm.out glm.in EIG/xeigtstd "GLM - Testing Generalized Linear Regression Model routines" & + run_test dgqr.out gqr.in EIG/xeigtstd "GQR - Testing Generalized QR and RQ factorization routines" & + run_test dgsv.out gsv.in EIG/xeigtstd "GSV - Testing Generalized Singular Value Decomposition routines" & + run_test dcsd.out csd.in EIG/xeigtstd "CSD - Testing CS Decomposition routines" & + run_test dlse.out lse.in EIG/xeigtstd "LSE - Testing Constrained Linear Least Squares routines" & + run_test znep.out nep.in EIG/xeigtstz "NEP - Testing Nonsymmetric Eigenvalue Problem routines" & + run_test zsep.out sep.in EIG/xeigtstz "SEP - Testing Symmetric Eigenvalue Problem routines" & + run_test zse2.out se2.in EIG/xeigtstz "SEP - Testing Symmetric Eigenvalue Problem routines" & + run_test zsvd.out svd.in EIG/xeigtstz "SVD - Testing Singular Value Decomposition routines" & + run_test zec.out zec.in EIG/xeigtstz "ZEC - Testing COMPLEX16 Eigen Condition Routines" & + run_test zed.out zed.in EIG/xeigtstz "ZES - Testing COMPLEX16 Nonsymmetric Schur Form Driver" & + run_test zgg.out zgg.in EIG/xeigtstz "ZGG - Testing COMPLEX16 Nonsymmetric Generalized Eigenvalue Problem routines" & + run_test zgd.out zgd.in EIG/xeigtstz "ZGD - Testing COMPLEX16 Nonsymmetric Generalized Eigenvalue Problem driver routines" & + run_test zsb.out zsb.in EIG/xeigtstz "ZHB - Testing Hermitian Eigenvalue Problem routines" & + run_test zsg.out zsg.in EIG/xeigtstz "ZSG - Testing Symmetric Generalized Eigenvalue Problem routines" & + run_test zbal.out zbal.in EIG/xeigtstz "ZGEBAL - Testing the balancing of a COMPLEX16 general matrix" & + run_test zbak.out zbak.in EIG/xeigtstz "ZGEBAK - Testing the back transformation of a COMPLEX16 balanced matrix" & + run_test zgbal.out zgbal.in EIG/xeigtstz "ZGGBAL - Testing the balancing of a pair of COMPLEX general matrices" & + run_test zgbak.out zgbak.in EIG/xeigtstz "ZGGBAK - Testing the back transformation of a pair of COMPLEX16 balanced matrices" & + run_test zbb.out zbb.in EIG/xeigtstz "ZBB - Testing banded Singular Value Decomposition routines" & + run_test zglm.out glm.in EIG/xeigtstz "GLM - Testing Generalized Linear Regression Model routines" & + run_test zgqr.out gqr.in EIG/xeigtstz "GQR - Testing Generalized QR and RQ factorization routines" & + run_test zgsv.out gsv.in EIG/xeigtstz "GSV - Testing Generalized Singular Value Decomposition routines" & + run_test zcsd.out csd.in EIG/xeigtstz "CSD - Testing CS Decomposition routines" & + run_test zlse.out lse.in EIG/xeigtstz "LSE - Testing Constrained Linear Least Squares routines" & + wait + while IFS= read -r -d $'\0' LOG; do cat $LOG ; FAILURES=1 ; done < <(grep -lZ FAIL ./test_out/*) + python ./lapack-netlib/lapack_testing.py -d ./test_out -e > netlib_summary + TOTALS="$(grep 'ALL PRECISIONS' netlib_summary)" + NUMERICAL_ERRORS=-1 + OTHER_ERRORS=-1 + . <(awk '/ALL PRECISIONS/{printf "NUMERICAL_ERRORS=%s\nOTHER_ERRORS=%s\n", $5, $7}' netlib_summary + if (( NUMERICAL_ERRORS != 0 )) || (( OTHER_ERRORS != 0 )) ; then cat netlib_summary ; FAILURES=1 ; fi + if [[ ! -z $FAILURES ]]; then echo "==========" ; echo "== FAIL ==" ; echo "==========" ; echo ; exit 1 ; fi diff --git a/README.md b/README.md index 2f0a0da4c..43f390db0 100644 --- a/README.md +++ b/README.md @@ -203,6 +203,16 @@ Please read `GotoBLAS_01Readme.txt` for older CPU models already supported by th make HOSTCC=gcc TARGET=x280 NUM_THREADS=8 CC=riscv64-unknown-linux-gnu-clang FC=riscv64-unknown-linux-gnu-gfortran ``` +- **ZVL???B**: Level-3 BLAS and Level-1,2 including vectorised kernels targeting generic RISCV cores with vector support with registers of at least the corresponding width; ZVL128B and ZVL256B are available. +e.g.: + ```sh +make TARGET=RISCV64_ZVL256B CFLAGS="-DTARGET=RISCV64_ZVL256B" \ + BINARY=64 ARCH=riscv64 CC='clang -target riscv64-unknown-linux-gnu' \ + AR=riscv64-unknown-linux-gnu-ar AS=riscv64-unknown-linux-gnu-gcc \ + LD=riscv64-unknown-linux-gnu-gcc FC=riscv64-unknown-linux-gnu-gfortran \ + HOSTCC=gcc HOSTFC=gfortran -j + ``` + ### Support for multiple targets in a single library OpenBLAS can be built for multiple targets with runtime detection of the target cpu by specifiying `DYNAMIC_ARCH=1` in Makefile.rule, on the gmake command line or as `-DDYNAMIC_ARCH=TRUE` in cmake. diff --git a/common_riscv64.h b/common_riscv64.h index ab3bfa25a..eccfc644f 100644 --- a/common_riscv64.h +++ b/common_riscv64.h @@ -91,7 +91,7 @@ static inline int blas_quickdivide(blasint x, blasint y){ #define BUFFER_SIZE ( 32 << 20) #define SEEK_ADDRESS -#if defined(C910V) || (defined(RISCV64_ZVL256B) && (defined(__clang__) || defined(RVV_COMPATIBLE_GCC))) || defined(RISCV64_ZVL128B) || defined(x280) +#if defined(C910V) || defined(RISCV64_ZVL256B) || defined(RISCV64_ZVL128B) || defined(x280) # include #endif From 4787a55c64a17d80020c370c3e439f362979c83e Mon Sep 17 00:00:00 2001 From: pengxu Date: Tue, 20 Feb 2024 20:41:45 +0800 Subject: [PATCH 159/311] Optimized cgemm kernel 16x4 LASX for LoongArch --- kernel/generic/zhemm_ltcopy_16.c | 1170 ++++++ kernel/generic/zhemm_utcopy_16.c | 1168 ++++++ kernel/generic/zneg_tcopy_16.c | 587 +++ kernel/generic/zsymm_lcopy_16.c | 333 ++ kernel/generic/zsymm_ucopy_16.c | 332 ++ kernel/generic/ztrmm_lncopy_16.c | 2310 ++++++++++++ kernel/generic/ztrmm_ltcopy_16.c | 2313 ++++++++++++ kernel/generic/ztrmm_uncopy_16.c | 2316 ++++++++++++ kernel/generic/ztrmm_utcopy_16.c | 2318 ++++++++++++ kernel/generic/ztrsm_lncopy_16.c | 308 ++ kernel/generic/ztrsm_ltcopy_16.c | 264 ++ kernel/generic/ztrsm_uncopy_16.c | 313 ++ kernel/generic/ztrsm_utcopy_16.c | 261 ++ kernel/loongarch64/KERNEL.LOONGSON3R5 | 10 +- kernel/loongarch64/cgemm_kernel_16x4_lasx.S | 3757 +++++++++++++++++++ kernel/loongarch64/cgemm_ncopy_16_lasx.S | 691 ++++ kernel/loongarch64/cgemm_ncopy_4_lasx.S | 325 ++ kernel/loongarch64/cgemm_tcopy_16_lasx.S | 741 ++++ kernel/loongarch64/cgemm_tcopy_4_lasx.S | 306 ++ param.h | 12 +- 20 files changed, 19828 insertions(+), 7 deletions(-) create mode 100644 kernel/generic/zhemm_ltcopy_16.c create mode 100644 kernel/generic/zhemm_utcopy_16.c create mode 100644 kernel/generic/zneg_tcopy_16.c create mode 100644 kernel/generic/zsymm_lcopy_16.c create mode 100644 kernel/generic/zsymm_ucopy_16.c create mode 100644 kernel/generic/ztrmm_lncopy_16.c create mode 100644 kernel/generic/ztrmm_ltcopy_16.c create mode 100644 kernel/generic/ztrmm_uncopy_16.c create mode 100644 kernel/generic/ztrmm_utcopy_16.c create mode 100644 kernel/generic/ztrsm_lncopy_16.c create mode 100644 kernel/generic/ztrsm_ltcopy_16.c create mode 100644 kernel/generic/ztrsm_uncopy_16.c create mode 100644 kernel/generic/ztrsm_utcopy_16.c create mode 100644 kernel/loongarch64/cgemm_kernel_16x4_lasx.S create mode 100644 kernel/loongarch64/cgemm_ncopy_16_lasx.S create mode 100644 kernel/loongarch64/cgemm_ncopy_4_lasx.S create mode 100644 kernel/loongarch64/cgemm_tcopy_16_lasx.S create mode 100644 kernel/loongarch64/cgemm_tcopy_4_lasx.S diff --git a/kernel/generic/zhemm_ltcopy_16.c b/kernel/generic/zhemm_ltcopy_16.c new file mode 100644 index 000000000..8797891ea --- /dev/null +++ b/kernel/generic/zhemm_ltcopy_16.c @@ -0,0 +1,1170 @@ +/******************************************************************************* +Copyright (c) 2024, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 +#include "common.h" + +int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG posX, BLASLONG posY, FLOAT *b){ + + BLASLONG i, js, offset; + + FLOAT data01, data02, data03, data04, data05, data06, data07, data08; + FLOAT data09, data10, data11, data12, data13, data14, data15, data16; + FLOAT data17, data18, data19, data20, data21, data22, data23, data24; + FLOAT data25, data26, data27, data28, data29, data30, data31, data32; + + FLOAT *ao1, *ao2, *ao3, *ao4, *ao5, *ao6, *ao7, *ao8; + FLOAT *ao9, *ao10, *ao11, *ao12, *ao13, *ao14, *ao15, *ao16; + + lda *= 2; + + js = (n >> 4); + while (js > 0){ + + offset = posX - posY; + + if (offset > 0) ao1 = a + (posX + 0) * 2 + posY * lda; else ao1 = a + posY * 2 + (posX + 0) * lda; + if (offset > -1) ao2 = a + (posX + 1) * 2 + posY * lda; else ao2 = a + posY * 2 + (posX + 1) * lda; + if (offset > -2) ao3 = a + (posX + 2) * 2 + posY * lda; else ao3 = a + posY * 2 + (posX + 2) * lda; + if (offset > -3) ao4 = a + (posX + 3) * 2 + posY * lda; else ao4 = a + posY * 2 + (posX + 3) * lda; + if (offset > -4) ao5 = a + (posX + 4) * 2 + posY * lda; else ao5 = a + posY * 2 + (posX + 4) * lda; + if (offset > -5) ao6 = a + (posX + 5) * 2 + posY * lda; else ao6 = a + posY * 2 + (posX + 5) * lda; + if (offset > -6) ao7 = a + (posX + 6) * 2 + posY * lda; else ao7 = a + posY * 2 + (posX + 6) * lda; + if (offset > -7) ao8 = a + (posX + 7) * 2 + posY * lda; else ao8 = a + posY * 2 + (posX + 7) * lda; + if (offset > -8) ao9 = a + (posX + 8) * 2 + posY * lda; else ao9 = a + posY * 2 + (posX + 8) * lda; + if (offset > -9) ao10 = a + (posX + 9) * 2 + posY * lda; else ao10 = a + posY * 2 + (posX + 9) * lda; + if (offset > -10) ao11 = a + (posX + 10) * 2 + posY * lda; else ao11 = a + posY * 2 + (posX + 10) * lda; + if (offset > -11) ao12 = a + (posX + 11) * 2 + posY * lda; else ao12 = a + posY * 2 + (posX + 11) * lda; + if (offset > -12) ao13 = a + (posX + 12) * 2 + posY * lda; else ao13 = a + posY * 2 + (posX + 12) * lda; + if (offset > -13) ao14 = a + (posX + 13) * 2 + posY * lda; else ao14 = a + posY * 2 + (posX + 13) * lda; + if (offset > -14) ao15 = a + (posX + 14) * 2 + posY * lda; else ao15 = a + posY * 2 + (posX + 14) * lda; + if (offset > -15) ao16 = a + (posX + 15) * 2 + posY * lda; else ao16 = a + posY * 2 + (posX + 15) * lda; + + i = m; + + while (i > 0) { + data01 = *(ao1 + 0); + data02 = *(ao1 + 1); + data03 = *(ao2 + 0); + data04 = *(ao2 + 1); + data05 = *(ao3 + 0); + data06 = *(ao3 + 1); + data07 = *(ao4 + 0); + data08 = *(ao4 + 1); + data09 = *(ao5 + 0); + data10 = *(ao5 + 1); + data11 = *(ao6 + 0); + data12 = *(ao6 + 1); + data13 = *(ao7 + 0); + data14 = *(ao7 + 1); + data15 = *(ao8 + 0); + data16 = *(ao8 + 1); + data17 = *(ao9 + 0); + data18 = *(ao9 + 1); + data19 = *(ao10 + 0); + data20 = *(ao10 + 1); + data21 = *(ao11 + 0); + data22 = *(ao11 + 1); + data23 = *(ao12 + 0); + data24 = *(ao12 + 1); + data25 = *(ao13 + 0); + data26 = *(ao13 + 1); + data27 = *(ao14 + 0); + data28 = *(ao14 + 1); + data29 = *(ao15 + 0); + data30 = *(ao15 + 1); + data31 = *(ao16 + 0); + data32 = *(ao16 + 1); + + if (offset > 0) ao1 += lda; else ao1 += 2; + if (offset > -1) ao2 += lda; else ao2 += 2; + if (offset > -2) ao3 += lda; else ao3 += 2; + if (offset > -3) ao4 += lda; else ao4 += 2; + if (offset > -4) ao5 += lda; else ao5 += 2; + if (offset > -5) ao6 += lda; else ao6 += 2; + if (offset > -6) ao7 += lda; else ao7 += 2; + if (offset > -7) ao8 += lda; else ao8 += 2; + if (offset > -8) ao9 += lda; else ao9 += 2; + if (offset > -9) ao10 += lda; else ao10 += 2; + if (offset > -10) ao11 += lda; else ao11 += 2; + if (offset > -11) ao12 += lda; else ao12 += 2; + if (offset > -12) ao13 += lda; else ao13 += 2; + if (offset > -13) ao14 += lda; else ao14 += 2; + if (offset > -14) ao15 += lda; else ao15 += 2; + if (offset > -15) ao16 += lda; else ao16 += 2; + + if (offset > 0) { + b[ 0] = data01; + b[ 1] = data02; + b[ 2] = data03; + b[ 3] = data04; + b[ 4] = data05; + b[ 5] = data06; + b[ 6] = data07; + b[ 7] = data08; + b[ 8] = data09; + b[ 9] = data10; + b[10] = data11; + b[11] = data12; + b[12] = data13; + b[13] = data14; + b[14] = data15; + b[15] = data16; + b[16] = data17; + b[17] = data18; + b[18] = data19; + b[19] = data20; + b[20] = data21; + b[21] = data22; + b[22] = data23; + b[23] = data24; + b[24] = data25; + b[25] = data26; + b[26] = data27; + b[27] = data28; + b[28] = data29; + b[29] = data30; + b[30] = data31; + b[31] = data32; + } else + if (offset < -15) { + b[ 0] = data01; + b[ 1] = -data02; + b[ 2] = data03; + b[ 3] = -data04; + b[ 4] = data05; + b[ 5] = -data06; + b[ 6] = data07; + b[ 7] = -data08; + b[ 8] = data09; + b[ 9] = -data10; + b[10] = data11; + b[11] = -data12; + b[12] = data13; + b[13] = -data14; + b[14] = data15; + b[15] = -data16; + b[16] = data17; + b[17] = -data18; + b[18] = data19; + b[19] = -data20; + b[20] = data21; + b[21] = -data22; + b[22] = data23; + b[23] = -data24; + b[24] = data25; + b[25] = -data26; + b[26] = data27; + b[27] = -data28; + b[28] = data29; + b[29] = -data30; + b[30] = data31; + b[31] = -data32; + } else { + switch (offset) { + case 0 : + b[ 0] = data01; + b[ 1] = ZERO; + b[ 2] = data03; + b[ 3] = data04; + b[ 4] = data05; + b[ 5] = data06; + b[ 6] = data07; + b[ 7] = data08; + b[ 8] = data09; + b[ 9] = data10; + b[10] = data11; + b[11] = data12; + b[12] = data13; + b[13] = data14; + b[14] = data15; + b[15] = data16; + b[16] = data17; + b[17] = data18; + b[18] = data19; + b[19] = data20; + b[20] = data21; + b[21] = data22; + b[22] = data23; + b[23] = data24; + b[24] = data25; + b[25] = data26; + b[26] = data27; + b[27] = data28; + b[28] = data29; + b[29] = data30; + b[30] = data31; + b[31] = data32; + break; + case -1 : + b[ 0] = data01; + b[ 1] = -data02; + b[ 2] = data03; + b[ 3] = ZERO; + b[ 4] = data05; + b[ 5] = data06; + b[ 6] = data07; + b[ 7] = data08; + b[ 8] = data09; + b[ 9] = data10; + b[10] = data11; + b[11] = data12; + b[12] = data13; + b[13] = data14; + b[14] = data15; + b[15] = data16; + b[16] = data17; + b[17] = data18; + b[18] = data19; + b[19] = data20; + b[20] = data21; + b[21] = data22; + b[22] = data23; + b[23] = data24; + b[24] = data25; + b[25] = data26; + b[26] = data27; + b[27] = data28; + b[28] = data29; + b[29] = data30; + b[30] = data31; + b[31] = data32; + break; + case -2 : + b[ 0] = data01; + b[ 1] = -data02; + b[ 2] = data03; + b[ 3] = -data04; + b[ 4] = data05; + b[ 5] = ZERO; + b[ 6] = data07; + b[ 7] = data08; + b[ 8] = data09; + b[ 9] = data10; + b[10] = data11; + b[11] = data12; + b[12] = data13; + b[13] = data14; + b[14] = data15; + b[15] = data16; + b[16] = data17; + b[17] = data18; + b[18] = data19; + b[19] = data20; + b[20] = data21; + b[21] = data22; + b[22] = data23; + b[23] = data24; + b[24] = data25; + b[25] = data26; + b[26] = data27; + b[27] = data28; + b[28] = data29; + b[29] = data30; + b[30] = data31; + b[31] = data32; + break; + case -3 : + b[ 0] = data01; + b[ 1] = -data02; + b[ 2] = data03; + b[ 3] = -data04; + b[ 4] = data05; + b[ 5] = -data06; + b[ 6] = data07; + b[ 7] = ZERO; + b[ 8] = data09; + b[ 9] = data10; + b[10] = data11; + b[11] = data12; + b[12] = data13; + b[13] = data14; + b[14] = data15; + b[15] = data16; + b[16] = data17; + b[17] = data18; + b[18] = data19; + b[19] = data20; + b[20] = data21; + b[21] = data22; + b[22] = data23; + b[23] = data24; + b[24] = data25; + b[25] = data26; + b[26] = data27; + b[27] = data28; + b[28] = data29; + b[29] = data30; + b[30] = data31; + b[31] = data32; + break; + case -4 : + b[ 0] = data01; + b[ 1] = -data02; + b[ 2] = data03; + b[ 3] = -data04; + b[ 4] = data05; + b[ 5] = -data06; + b[ 6] = data07; + b[ 7] = -data08; + b[ 8] = data09; + b[ 9] = ZERO; + b[10] = data11; + b[11] = data12; + b[12] = data13; + b[13] = data14; + b[14] = data15; + b[15] = data16; + b[16] = data17; + b[17] = data18; + b[18] = data19; + b[19] = data20; + b[20] = data21; + b[21] = data22; + b[22] = data23; + b[23] = data24; + b[24] = data25; + b[25] = data26; + b[26] = data27; + b[27] = data28; + b[28] = data29; + b[29] = data30; + b[30] = data31; + b[31] = data32; + break; + case -5 : + b[ 0] = data01; + b[ 1] = -data02; + b[ 2] = data03; + b[ 3] = -data04; + b[ 4] = data05; + b[ 5] = -data06; + b[ 6] = data07; + b[ 7] = -data08; + b[ 8] = data09; + b[ 9] = -data10; + b[10] = data11; + b[11] = ZERO; + b[12] = data13; + b[13] = data14; + b[14] = data15; + b[15] = data16; + b[16] = data17; + b[17] = data18; + b[18] = data19; + b[19] = data20; + b[20] = data21; + b[21] = data22; + b[22] = data23; + b[23] = data24; + b[24] = data25; + b[25] = data26; + b[26] = data27; + b[27] = data28; + b[28] = data29; + b[29] = data30; + b[30] = data31; + b[31] = data32; + break; + case -6 : + b[ 0] = data01; + b[ 1] = -data02; + b[ 2] = data03; + b[ 3] = -data04; + b[ 4] = data05; + b[ 5] = -data06; + b[ 6] = data07; + b[ 7] = -data08; + b[ 8] = data09; + b[ 9] = -data10; + b[10] = data11; + b[11] = -data12; + b[12] = data13; + b[13] = ZERO; + b[14] = data15; + b[15] = data16; + b[16] = data17; + b[17] = data18; + b[18] = data19; + b[19] = data20; + b[20] = data21; + b[21] = data22; + b[22] = data23; + b[23] = data24; + b[24] = data25; + b[25] = data26; + b[26] = data27; + b[27] = data28; + b[28] = data29; + b[29] = data30; + b[30] = data31; + b[31] = data32; + break; + case -7 : + b[ 0] = data01; + b[ 1] = -data02; + b[ 2] = data03; + b[ 3] = -data04; + b[ 4] = data05; + b[ 5] = -data06; + b[ 6] = data07; + b[ 7] = -data08; + b[ 8] = data09; + b[ 9] = -data10; + b[10] = data11; + b[11] = -data12; + b[12] = data13; + b[13] = -data14; + b[14] = data15; + b[15] = ZERO; + b[16] = data17; + b[17] = data18; + b[18] = data19; + b[19] = data20; + b[20] = data21; + b[21] = data22; + b[22] = data23; + b[23] = data24; + b[24] = data25; + b[25] = data26; + b[26] = data27; + b[27] = data28; + b[28] = data29; + b[29] = data30; + b[30] = data31; + b[31] = data32; + break; + case -8 : + b[ 0] = data01; + b[ 1] = -data02; + b[ 2] = data03; + b[ 3] = -data04; + b[ 4] = data05; + b[ 5] = -data06; + b[ 6] = data07; + b[ 7] = -data08; + b[ 8] = data09; + b[ 9] = -data10; + b[10] = data11; + b[11] = -data12; + b[12] = data13; + b[13] = -data14; + b[14] = data15; + b[15] = -data16; + b[16] = data17; + b[17] = ZERO; + b[18] = data19; + b[19] = data20; + b[20] = data21; + b[21] = data22; + b[22] = data23; + b[23] = data24; + b[24] = data25; + b[25] = data26; + b[26] = data27; + b[27] = data28; + b[28] = data29; + b[29] = data30; + b[30] = data31; + b[31] = data32; + break; + case -9 : + b[ 0] = data01; + b[ 1] = -data02; + b[ 2] = data03; + b[ 3] = -data04; + b[ 4] = data05; + b[ 5] = -data06; + b[ 6] = data07; + b[ 7] = -data08; + b[ 8] = data09; + b[ 9] = -data10; + b[10] = data11; + b[11] = -data12; + b[12] = data13; + b[13] = -data14; + b[14] = data15; + b[15] = -data16; + b[16] = data17; + b[17] = -data18; + b[18] = data19; + b[19] = ZERO; + b[20] = data21; + b[21] = data22; + b[22] = data23; + b[23] = data24; + b[24] = data25; + b[25] = data26; + b[26] = data27; + b[27] = data28; + b[28] = data29; + b[29] = data30; + b[30] = data31; + b[31] = data32; + break; + case -10 : + b[ 0] = data01; + b[ 1] = -data02; + b[ 2] = data03; + b[ 3] = -data04; + b[ 4] = data05; + b[ 5] = -data06; + b[ 6] = data07; + b[ 7] = -data08; + b[ 8] = data09; + b[ 9] = -data10; + b[10] = data11; + b[11] = -data12; + b[12] = data13; + b[13] = -data14; + b[14] = data15; + b[15] = -data16; + b[16] = data17; + b[17] = -data18; + b[18] = data19; + b[19] = -data20; + b[20] = data21; + b[21] = ZERO; + b[22] = data23; + b[23] = data24; + b[24] = data25; + b[25] = data26; + b[26] = data27; + b[27] = data28; + b[28] = data29; + b[29] = data30; + b[30] = data31; + b[31] = data32; + break; + case -11 : + b[ 0] = data01; + b[ 1] = -data02; + b[ 2] = data03; + b[ 3] = -data04; + b[ 4] = data05; + b[ 5] = -data06; + b[ 6] = data07; + b[ 7] = -data08; + b[ 8] = data09; + b[ 9] = -data10; + b[10] = data11; + b[11] = -data12; + b[12] = data13; + b[13] = -data14; + b[14] = data15; + b[15] = -data16; + b[16] = data17; + b[17] = -data18; + b[18] = data19; + b[19] = -data20; + b[20] = data21; + b[21] = -data22; + b[22] = data23; + b[23] = ZERO; + b[24] = data25; + b[25] = data26; + b[26] = data27; + b[27] = data28; + b[28] = data29; + b[29] = data30; + b[30] = data31; + b[31] = data32; + break; + case -12 : + b[ 0] = data01; + b[ 1] = -data02; + b[ 2] = data03; + b[ 3] = -data04; + b[ 4] = data05; + b[ 5] = -data06; + b[ 6] = data07; + b[ 7] = -data08; + b[ 8] = data09; + b[ 9] = -data10; + b[10] = data11; + b[11] = -data12; + b[12] = data13; + b[13] = -data14; + b[14] = data15; + b[15] = -data16; + b[16] = data17; + b[17] = -data18; + b[18] = data19; + b[19] = -data20; + b[20] = data21; + b[21] = -data22; + b[22] = data23; + b[23] = -data24; + b[24] = data25; + b[25] = ZERO; + b[26] = data27; + b[27] = data28; + b[28] = data29; + b[29] = data30; + b[30] = data31; + b[31] = data32; + break; + case -13 : + b[ 0] = data01; + b[ 1] = -data02; + b[ 2] = data03; + b[ 3] = -data04; + b[ 4] = data05; + b[ 5] = -data06; + b[ 6] = data07; + b[ 7] = -data08; + b[ 8] = data09; + b[ 9] = -data10; + b[10] = data11; + b[11] = -data12; + b[12] = data13; + b[13] = -data14; + b[14] = data15; + b[15] = -data16; + b[16] = data17; + b[17] = -data18; + b[18] = data19; + b[19] = -data20; + b[20] = data21; + b[21] = -data22; + b[22] = data23; + b[23] = -data24; + b[24] = data25; + b[25] = -data26; + b[26] = data27; + b[27] = ZERO; + b[28] = data29; + b[29] = data30; + b[30] = data31; + b[31] = data32; + break; + case -14 : + b[ 0] = data01; + b[ 1] = -data02; + b[ 2] = data03; + b[ 3] = -data04; + b[ 4] = data05; + b[ 5] = -data06; + b[ 6] = data07; + b[ 7] = -data08; + b[ 8] = data09; + b[ 9] = -data10; + b[10] = data11; + b[11] = -data12; + b[12] = data13; + b[13] = -data14; + b[14] = data15; + b[15] = -data16; + b[16] = data17; + b[17] = -data18; + b[18] = data19; + b[19] = -data20; + b[20] = data21; + b[21] = -data22; + b[22] = data23; + b[23] = -data24; + b[24] = data25; + b[25] = -data26; + b[26] = data27; + b[27] = -data28; + b[28] = data29; + b[29] = ZERO; + b[30] = data31; + b[31] = data32; + break; + case -15 : + b[ 0] = data01; + b[ 1] = -data02; + b[ 2] = data03; + b[ 3] = -data04; + b[ 4] = data05; + b[ 5] = -data06; + b[ 6] = data07; + b[ 7] = -data08; + b[ 8] = data09; + b[ 9] = -data10; + b[10] = data11; + b[11] = -data12; + b[12] = data13; + b[13] = -data14; + b[14] = data15; + b[15] = -data16; + b[16] = data17; + b[17] = -data18; + b[18] = data19; + b[19] = -data20; + b[20] = data21; + b[21] = -data22; + b[22] = data23; + b[23] = -data24; + b[24] = data25; + b[25] = -data26; + b[26] = data27; + b[27] = -data28; + b[28] = data29; + b[29] = -data30; + b[30] = data31; + b[31] = ZERO; + break; + } + } + + b += 32; + + offset --; + i --; + } + + posX += 16; + js --; + } + + if (n & 8) { + offset = posX - posY; + + if (offset > 0) ao1 = a + (posX + 0) * 2 + posY * lda; else ao1 = a + posY * 2 + (posX + 0) * lda; + if (offset > -1) ao2 = a + (posX + 1) * 2 + posY * lda; else ao2 = a + posY * 2 + (posX + 1) * lda; + if (offset > -2) ao3 = a + (posX + 2) * 2 + posY * lda; else ao3 = a + posY * 2 + (posX + 2) * lda; + if (offset > -3) ao4 = a + (posX + 3) * 2 + posY * lda; else ao4 = a + posY * 2 + (posX + 3) * lda; + if (offset > -4) ao5 = a + (posX + 4) * 2 + posY * lda; else ao5 = a + posY * 2 + (posX + 4) * lda; + if (offset > -5) ao6 = a + (posX + 5) * 2 + posY * lda; else ao6 = a + posY * 2 + (posX + 5) * lda; + if (offset > -6) ao7 = a + (posX + 6) * 2 + posY * lda; else ao7 = a + posY * 2 + (posX + 6) * lda; + if (offset > -7) ao8 = a + (posX + 7) * 2 + posY * lda; else ao8 = a + posY * 2 + (posX + 7) * lda; + + i = m; + + while (i > 0) { + data01 = *(ao1 + 0); + data02 = *(ao1 + 1); + data03 = *(ao2 + 0); + data04 = *(ao2 + 1); + data05 = *(ao3 + 0); + data06 = *(ao3 + 1); + data07 = *(ao4 + 0); + data08 = *(ao4 + 1); + data09 = *(ao5 + 0); + data10 = *(ao5 + 1); + data11 = *(ao6 + 0); + data12 = *(ao6 + 1); + data13 = *(ao7 + 0); + data14 = *(ao7 + 1); + data15 = *(ao8 + 0); + data16 = *(ao8 + 1); + + if (offset > 0) ao1 += lda; else ao1 += 2; + if (offset > -1) ao2 += lda; else ao2 += 2; + if (offset > -2) ao3 += lda; else ao3 += 2; + if (offset > -3) ao4 += lda; else ao4 += 2; + if (offset > -4) ao5 += lda; else ao5 += 2; + if (offset > -5) ao6 += lda; else ao6 += 2; + if (offset > -6) ao7 += lda; else ao7 += 2; + if (offset > -7) ao8 += lda; else ao8 += 2; + + if (offset > 0) { + b[ 0] = data01; + b[ 1] = data02; + b[ 2] = data03; + b[ 3] = data04; + b[ 4] = data05; + b[ 5] = data06; + b[ 6] = data07; + b[ 7] = data08; + b[ 8] = data09; + b[ 9] = data10; + b[10] = data11; + b[11] = data12; + b[12] = data13; + b[13] = data14; + b[14] = data15; + b[15] = data16; + } else + if (offset < -7) { + b[ 0] = data01; + b[ 1] = -data02; + b[ 2] = data03; + b[ 3] = -data04; + b[ 4] = data05; + b[ 5] = -data06; + b[ 6] = data07; + b[ 7] = -data08; + b[ 8] = data09; + b[ 9] = -data10; + b[10] = data11; + b[11] = -data12; + b[12] = data13; + b[13] = -data14; + b[14] = data15; + b[15] = -data16; + } else { + switch (offset) { + case 0 : + b[ 0] = data01; + b[ 1] = ZERO; + b[ 2] = data03; + b[ 3] = data04; + b[ 4] = data05; + b[ 5] = data06; + b[ 6] = data07; + b[ 7] = data08; + b[ 8] = data09; + b[ 9] = data10; + b[10] = data11; + b[11] = data12; + b[12] = data13; + b[13] = data14; + b[14] = data15; + b[15] = data16; + break; + case -1 : + b[ 0] = data01; + b[ 1] = -data02; + b[ 2] = data03; + b[ 3] = ZERO; + b[ 4] = data05; + b[ 5] = data06; + b[ 6] = data07; + b[ 7] = data08; + b[ 8] = data09; + b[ 9] = data10; + b[10] = data11; + b[11] = data12; + b[12] = data13; + b[13] = data14; + b[14] = data15; + b[15] = data16; + break; + case -2 : + b[ 0] = data01; + b[ 1] = -data02; + b[ 2] = data03; + b[ 3] = -data04; + b[ 4] = data05; + b[ 5] = ZERO; + b[ 6] = data07; + b[ 7] = data08; + b[ 8] = data09; + b[ 9] = data10; + b[10] = data11; + b[11] = data12; + b[12] = data13; + b[13] = data14; + b[14] = data15; + b[15] = data16; + break; + case -3 : + b[ 0] = data01; + b[ 1] = -data02; + b[ 2] = data03; + b[ 3] = -data04; + b[ 4] = data05; + b[ 5] = -data06; + b[ 6] = data07; + b[ 7] = ZERO; + b[ 8] = data09; + b[ 9] = data10; + b[10] = data11; + b[11] = data12; + b[12] = data13; + b[13] = data14; + b[14] = data15; + b[15] = data16; + break; + case -4 : + b[ 0] = data01; + b[ 1] = -data02; + b[ 2] = data03; + b[ 3] = -data04; + b[ 4] = data05; + b[ 5] = -data06; + b[ 6] = data07; + b[ 7] = -data08; + b[ 8] = data09; + b[ 9] = ZERO; + b[10] = data11; + b[11] = data12; + b[12] = data13; + b[13] = data14; + b[14] = data15; + b[15] = data16; + break; + case -5 : + b[ 0] = data01; + b[ 1] = -data02; + b[ 2] = data03; + b[ 3] = -data04; + b[ 4] = data05; + b[ 5] = -data06; + b[ 6] = data07; + b[ 7] = -data08; + b[ 8] = data09; + b[ 9] = -data10; + b[10] = data11; + b[11] = ZERO; + b[12] = data13; + b[13] = data14; + b[14] = data15; + b[15] = data16; + break; + case -6 : + b[ 0] = data01; + b[ 1] = -data02; + b[ 2] = data03; + b[ 3] = -data04; + b[ 4] = data05; + b[ 5] = -data06; + b[ 6] = data07; + b[ 7] = -data08; + b[ 8] = data09; + b[ 9] = -data10; + b[10] = data11; + b[11] = -data12; + b[12] = data13; + b[13] = ZERO; + b[14] = data15; + b[15] = data16; + break; + case -7 : + b[ 0] = data01; + b[ 1] = -data02; + b[ 2] = data03; + b[ 3] = -data04; + b[ 4] = data05; + b[ 5] = -data06; + b[ 6] = data07; + b[ 7] = -data08; + b[ 8] = data09; + b[ 9] = -data10; + b[10] = data11; + b[11] = -data12; + b[12] = data13; + b[13] = -data14; + b[14] = data15; + b[15] = ZERO; + break; + } + } + + b += 16; + + offset --; + i --; + } + + posX += 8; + } + + if (n & 4) { + + offset = posX - posY; + + if (offset > 0) ao1 = a + (posX + 0) * 2 + posY * lda; else ao1 = a + posY * 2 + (posX + 0) * lda; + if (offset > -1) ao2 = a + (posX + 1) * 2 + posY * lda; else ao2 = a + posY * 2 + (posX + 1) * lda; + if (offset > -2) ao3 = a + (posX + 2) * 2 + posY * lda; else ao3 = a + posY * 2 + (posX + 2) * lda; + if (offset > -3) ao4 = a + (posX + 3) * 2 + posY * lda; else ao4 = a + posY * 2 + (posX + 3) * lda; + + i = m; + + while (i > 0) { + data01 = *(ao1 + 0); + data02 = *(ao1 + 1); + data03 = *(ao2 + 0); + data04 = *(ao2 + 1); + data05 = *(ao3 + 0); + data06 = *(ao3 + 1); + data07 = *(ao4 + 0); + data08 = *(ao4 + 1); + + if (offset > 0) ao1 += lda; else ao1 += 2; + if (offset > -1) ao2 += lda; else ao2 += 2; + if (offset > -2) ao3 += lda; else ao3 += 2; + if (offset > -3) ao4 += lda; else ao4 += 2; + + if (offset > 0) { + b[ 0] = data01; + b[ 1] = data02; + b[ 2] = data03; + b[ 3] = data04; + b[ 4] = data05; + b[ 5] = data06; + b[ 6] = data07; + b[ 7] = data08; + } else + if (offset < -3) { + b[ 0] = data01; + b[ 1] = -data02; + b[ 2] = data03; + b[ 3] = -data04; + b[ 4] = data05; + b[ 5] = -data06; + b[ 6] = data07; + b[ 7] = -data08; + } else { + switch (offset) { + case 0 : + b[ 0] = data01; + b[ 1] = ZERO; + b[ 2] = data03; + b[ 3] = data04; + b[ 4] = data05; + b[ 5] = data06; + b[ 6] = data07; + b[ 7] = data08; + break; + case -1 : + b[ 0] = data01; + b[ 1] = -data02; + b[ 2] = data03; + b[ 3] = ZERO; + b[ 4] = data05; + b[ 5] = data06; + b[ 6] = data07; + b[ 7] = data08; + break; + case -2 : + b[ 0] = data01; + b[ 1] = -data02; + b[ 2] = data03; + b[ 3] = -data04; + b[ 4] = data05; + b[ 5] = ZERO; + b[ 6] = data07; + b[ 7] = data08; + break; + case -3 : + b[ 0] = data01; + b[ 1] = -data02; + b[ 2] = data03; + b[ 3] = -data04; + b[ 4] = data05; + b[ 5] = -data06; + b[ 6] = data07; + b[ 7] = ZERO; + break; + } + } + + b += 8; + + offset --; + i --; + } + + posX += 4; + } + + if (n & 2) { + + offset = posX - posY; + + if (offset > 0) ao1 = a + (posX + 0) * 2 + posY * lda; else ao1 = a + posY * 2 + (posX + 0) * lda; + if (offset > -1) ao2 = a + (posX + 1) * 2 + posY * lda; else ao2 = a + posY * 2 + (posX + 1) * lda; + + i = m; + + while (i > 0) { + data01 = *(ao1 + 0); + data02 = *(ao1 + 1); + data03 = *(ao2 + 0); + data04 = *(ao2 + 1); + + if (offset > 0) ao1 += lda; else ao1 += 2; + if (offset > -1) ao2 += lda; else ao2 += 2; + + if (offset > 0) { + b[ 0] = data01; + b[ 1] = data02; + b[ 2] = data03; + b[ 3] = data04; + } else + if (offset < -1) { + b[ 0] = data01; + b[ 1] = -data02; + b[ 2] = data03; + b[ 3] = -data04; + } else { + switch (offset) { + case 0 : + b[ 0] = data01; + b[ 1] = ZERO; + b[ 2] = data03; + b[ 3] = data04; + break; + case -1 : + b[ 0] = data01; + b[ 1] = -data02; + b[ 2] = data03; + b[ 3] = ZERO; + break; + } + } + + b += 4; + + offset --; + i --; + } + + posX += 2; + + } + + if (n & 1) { + + offset = posX - posY; + + if (offset > 0) ao1 = a + (posX + 0) * 2 + posY * lda; else ao1 = a + posY * 2 + (posX + 0) * lda; + + i = m; + + while (i > 0) { + data01 = *(ao1 + 0); + data02 = *(ao1 + 1); + + if (offset > 0) ao1 += lda; else ao1 += 2; + + if (offset > 0) { + b[ 0] = data01; + b[ 1] = data02; + } else + if (offset < 0) { + b[ 0] = data01; + b[ 1] = -data02; + } else { + b[ 0] = data01; + b[ 1] = ZERO; + } + + b += 2; + + offset --; + i --; + } + + } + + return 0; +} diff --git a/kernel/generic/zhemm_utcopy_16.c b/kernel/generic/zhemm_utcopy_16.c new file mode 100644 index 000000000..822483a83 --- /dev/null +++ b/kernel/generic/zhemm_utcopy_16.c @@ -0,0 +1,1168 @@ +/******************************************************************************* +Copyright (c) 2024, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 +#include "common.h" + +int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG posX, BLASLONG posY, FLOAT *b){ + + BLASLONG i, js, offset; + + FLOAT data01, data02, data03, data04, data05, data06, data07, data08; + FLOAT data09, data10, data11, data12, data13, data14, data15, data16; + FLOAT data17, data18, data19, data20, data21, data22, data23, data24; + FLOAT data25, data26, data27, data28, data29, data30, data31, data32; + + FLOAT *ao1, *ao2, *ao3, *ao4, *ao5, *ao6, *ao7, *ao8; + FLOAT *ao9, *ao10, *ao11, *ao12, *ao13, *ao14, *ao15, *ao16; + + lda *= 2; + + js = (n >> 4); + while (js > 0){ + + offset = posX - posY; + + if (offset > 0) ao1 = a + posY * 2 + (posX + 0) * lda; else ao1 = a + (posX + 0) * 2 + posY * lda; + if (offset > -1) ao2 = a + posY * 2 + (posX + 1) * lda; else ao2 = a + (posX + 1) * 2 + posY * lda; + if (offset > -2) ao3 = a + posY * 2 + (posX + 2) * lda; else ao3 = a + (posX + 2) * 2 + posY * lda; + if (offset > -3) ao4 = a + posY * 2 + (posX + 3) * lda; else ao4 = a + (posX + 3) * 2 + posY * lda; + if (offset > -4) ao5 = a + posY * 2 + (posX + 4) * lda; else ao5 = a + (posX + 4) * 2 + posY * lda; + if (offset > -5) ao6 = a + posY * 2 + (posX + 5) * lda; else ao6 = a + (posX + 5) * 2 + posY * lda; + if (offset > -6) ao7 = a + posY * 2 + (posX + 6) * lda; else ao7 = a + (posX + 6) * 2 + posY * lda; + if (offset > -7) ao8 = a + posY * 2 + (posX + 7) * lda; else ao8 = a + (posX + 7) * 2 + posY * lda; + if (offset > -8) ao9 = a + posY * 2 + (posX + 8) * lda; else ao9 = a + (posX + 8) * 2 + posY * lda; + if (offset > -9) ao10 = a + posY * 2 + (posX + 9) * lda; else ao10 = a + (posX + 9) * 2 + posY * lda; + if (offset > -10) ao11 = a + posY * 2 + (posX + 10) * lda; else ao11 = a + (posX + 10) * 2 + posY * lda; + if (offset > -11) ao12 = a + posY * 2 + (posX + 11) * lda; else ao12 = a + (posX + 11) * 2 + posY * lda; + if (offset > -12) ao13 = a + posY * 2 + (posX + 12) * lda; else ao13 = a + (posX + 12) * 2 + posY * lda; + if (offset > -13) ao14 = a + posY * 2 + (posX + 13) * lda; else ao14 = a + (posX + 13) * 2 + posY * lda; + if (offset > -14) ao15 = a + posY * 2 + (posX + 14) * lda; else ao15 = a + (posX + 14) * 2 + posY * lda; + if (offset > -15) ao16 = a + posY * 2 + (posX + 15) * lda; else ao16 = a + (posX + 15) * 2 + posY * lda; + + i = m; + + while (i > 0) { + data01 = *(ao1 + 0); + data02 = *(ao1 + 1); + data03 = *(ao2 + 0); + data04 = *(ao2 + 1); + data05 = *(ao3 + 0); + data06 = *(ao3 + 1); + data07 = *(ao4 + 0); + data08 = *(ao4 + 1); + data09 = *(ao5 + 0); + data10 = *(ao5 + 1); + data11 = *(ao6 + 0); + data12 = *(ao6 + 1); + data13 = *(ao7 + 0); + data14 = *(ao7 + 1); + data15 = *(ao8 + 0); + data16 = *(ao8 + 1); + data17 = *(ao9 + 0); + data18 = *(ao9 + 1); + data19 = *(ao10 + 0); + data20 = *(ao10 + 1); + data21 = *(ao11 + 0); + data22 = *(ao11 + 1); + data23 = *(ao12 + 0); + data24 = *(ao12 + 1); + data25 = *(ao13 + 0); + data26 = *(ao13 + 1); + data27 = *(ao14 + 0); + data28 = *(ao14 + 1); + data29 = *(ao15 + 0); + data30 = *(ao15 + 1); + data31 = *(ao16 + 0); + data32 = *(ao16 + 1); + + if (offset > 0) ao1 += 2; else ao1 += lda; + if (offset > -1) ao2 += 2; else ao2 += lda; + if (offset > -2) ao3 += 2; else ao3 += lda; + if (offset > -3) ao4 += 2; else ao4 += lda; + if (offset > -4) ao5 += 2; else ao5 += lda; + if (offset > -5) ao6 += 2; else ao6 += lda; + if (offset > -6) ao7 += 2; else ao7 += lda; + if (offset > -7) ao8 += 2; else ao8 += lda; + if (offset > -8) ao9 += 2; else ao9 += lda; + if (offset > -9) ao10 += 2; else ao10 += lda; + if (offset > -10) ao11 += 2; else ao11 += lda; + if (offset > -11) ao12 += 2; else ao12 += lda; + if (offset > -12) ao13 += 2; else ao13 += lda; + if (offset > -13) ao14 += 2; else ao14 += lda; + if (offset > -14) ao15 += 2; else ao15 += lda; + if (offset > -15) ao16 += 2; else ao16 += lda; + + if (offset > 0) { + b[ 0] = data01; + b[ 1] = -data02; + b[ 2] = data03; + b[ 3] = -data04; + b[ 4] = data05; + b[ 5] = -data06; + b[ 6] = data07; + b[ 7] = -data08; + b[ 8] = data09; + b[ 9] = -data10; + b[10] = data11; + b[11] = -data12; + b[12] = data13; + b[13] = -data14; + b[14] = data15; + b[15] = -data16; + b[16] = data17; + b[17] = -data18; + b[18] = data19; + b[19] = -data20; + b[20] = data21; + b[21] = -data22; + b[22] = data23; + b[23] = -data24; + b[24] = data25; + b[25] = -data26; + b[26] = data27; + b[27] = -data28; + b[28] = data29; + b[29] = -data30; + b[30] = data31; + b[31] = -data32; + } else + if (offset < -15) { + b[ 0] = data01; + b[ 1] = data02; + b[ 2] = data03; + b[ 3] = data04; + b[ 4] = data05; + b[ 5] = data06; + b[ 6] = data07; + b[ 7] = data08; + b[ 8] = data09; + b[ 9] = data10; + b[10] = data11; + b[11] = data12; + b[12] = data13; + b[13] = data14; + b[14] = data15; + b[15] = data16; + b[16] = data17; + b[17] = data18; + b[18] = data19; + b[19] = data20; + b[20] = data21; + b[21] = data22; + b[22] = data23; + b[23] = data24; + b[24] = data25; + b[25] = data26; + b[26] = data27; + b[27] = data28; + b[28] = data29; + b[29] = data30; + b[30] = data31; + b[31] = data32; + } else { + switch (offset) { + case 0 : + b[ 0] = data01; + b[ 1] = ZERO; + b[ 2] = data03; + b[ 3] = -data04; + b[ 4] = data05; + b[ 5] = -data06; + b[ 6] = data07; + b[ 7] = -data08; + b[ 8] = data09; + b[ 9] = -data10; + b[10] = data11; + b[11] = -data12; + b[12] = data13; + b[13] = -data14; + b[14] = data15; + b[15] = -data16; + b[16] = data17; + b[17] = -data18; + b[18] = data19; + b[19] = -data20; + b[20] = data21; + b[21] = -data22; + b[22] = data23; + b[23] = -data24; + b[24] = data25; + b[25] = -data26; + b[26] = data27; + b[27] = -data28; + b[28] = data29; + b[29] = -data30; + b[30] = data31; + b[31] = -data32; + break; + case -1 : + b[ 0] = data01; + b[ 1] = data02; + b[ 2] = data03; + b[ 3] = ZERO; + b[ 4] = data05; + b[ 5] = -data06; + b[ 6] = data07; + b[ 7] = -data08; + b[ 8] = data09; + b[ 9] = -data10; + b[10] = data11; + b[11] = -data12; + b[12] = data13; + b[13] = -data14; + b[14] = data15; + b[15] = -data16; + b[16] = data17; + b[17] = -data18; + b[18] = data19; + b[19] = -data20; + b[20] = data21; + b[21] = -data22; + b[22] = data23; + b[23] = -data24; + b[24] = data25; + b[25] = -data26; + b[26] = data27; + b[27] = -data28; + b[28] = data29; + b[29] = -data30; + b[30] = data31; + b[31] = -data32; + break; + case -2 : + b[ 0] = data01; + b[ 1] = data02; + b[ 2] = data03; + b[ 3] = data04; + b[ 4] = data05; + b[ 5] = ZERO; + b[ 6] = data07; + b[ 7] = -data08; + b[ 8] = data09; + b[ 9] = -data10; + b[10] = data11; + b[11] = -data12; + b[12] = data13; + b[13] = -data14; + b[14] = data15; + b[15] = -data16; + b[16] = data17; + b[17] = -data18; + b[18] = data19; + b[19] = -data20; + b[20] = data21; + b[21] = -data22; + b[22] = data23; + b[23] = -data24; + b[24] = data25; + b[25] = -data26; + b[26] = data27; + b[27] = -data28; + b[28] = data29; + b[29] = -data30; + b[30] = data31; + b[31] = -data32; + break; + case -3 : + b[ 0] = data01; + b[ 1] = data02; + b[ 2] = data03; + b[ 3] = data04; + b[ 4] = data05; + b[ 5] = data06; + b[ 6] = data07; + b[ 7] = ZERO; + b[ 8] = data09; + b[ 9] = -data10; + b[10] = data11; + b[11] = -data12; + b[12] = data13; + b[13] = -data14; + b[14] = data15; + b[15] = -data16; + b[16] = data17; + b[17] = -data18; + b[18] = data19; + b[19] = -data20; + b[20] = data21; + b[21] = -data22; + b[22] = data23; + b[23] = -data24; + b[24] = data25; + b[25] = -data26; + b[26] = data27; + b[27] = -data28; + b[28] = data29; + b[29] = -data30; + b[30] = data31; + b[31] = -data32; + break; + case -4 : + b[ 0] = data01; + b[ 1] = data02; + b[ 2] = data03; + b[ 3] = data04; + b[ 4] = data05; + b[ 5] = data06; + b[ 6] = data07; + b[ 7] = data08; + b[ 8] = data09; + b[ 9] = ZERO; + b[10] = data11; + b[11] = -data12; + b[12] = data13; + b[13] = -data14; + b[14] = data15; + b[15] = -data16; + b[16] = data17; + b[17] = -data18; + b[18] = data19; + b[19] = -data20; + b[20] = data21; + b[21] = -data22; + b[22] = data23; + b[23] = -data24; + b[24] = data25; + b[25] = -data26; + b[26] = data27; + b[27] = -data28; + b[28] = data29; + b[29] = -data30; + b[30] = data31; + b[31] = -data32; + break; + case -5 : + b[ 0] = data01; + b[ 1] = data02; + b[ 2] = data03; + b[ 3] = data04; + b[ 4] = data05; + b[ 5] = data06; + b[ 6] = data07; + b[ 7] = data08; + b[ 8] = data09; + b[ 9] = data10; + b[10] = data11; + b[11] = ZERO; + b[12] = data13; + b[13] = -data14; + b[14] = data15; + b[15] = -data16; + b[16] = data17; + b[17] = -data18; + b[18] = data19; + b[19] = -data20; + b[20] = data21; + b[21] = -data22; + b[22] = data23; + b[23] = -data24; + b[24] = data25; + b[25] = -data26; + b[26] = data27; + b[27] = -data28; + b[28] = data29; + b[29] = -data30; + b[30] = data31; + b[31] = -data32; + break; + case -6 : + b[ 0] = data01; + b[ 1] = data02; + b[ 2] = data03; + b[ 3] = data04; + b[ 4] = data05; + b[ 5] = data06; + b[ 6] = data07; + b[ 7] = data08; + b[ 8] = data09; + b[ 9] = data10; + b[10] = data11; + b[11] = data12; + b[12] = data13; + b[13] = ZERO; + b[14] = data15; + b[15] = -data16; + b[16] = data17; + b[17] = -data18; + b[18] = data19; + b[19] = -data20; + b[20] = data21; + b[21] = -data22; + b[22] = data23; + b[23] = -data24; + b[24] = data25; + b[25] = -data26; + b[26] = data27; + b[27] = -data28; + b[28] = data29; + b[29] = -data30; + b[30] = data31; + b[31] = -data32; + break; + case -7 : + b[ 0] = data01; + b[ 1] = data02; + b[ 2] = data03; + b[ 3] = data04; + b[ 4] = data05; + b[ 5] = data06; + b[ 6] = data07; + b[ 7] = data08; + b[ 8] = data09; + b[ 9] = data10; + b[10] = data11; + b[11] = data12; + b[12] = data13; + b[13] = data14; + b[14] = data15; + b[15] = ZERO; + b[16] = data17; + b[17] = -data18; + b[18] = data19; + b[19] = -data20; + b[20] = data21; + b[21] = -data22; + b[22] = data23; + b[23] = -data24; + b[24] = data25; + b[25] = -data26; + b[26] = data27; + b[27] = -data28; + b[28] = data29; + b[29] = -data30; + b[30] = data31; + b[31] = -data32; + break; + case -8 : + b[ 0] = data01; + b[ 1] = data02; + b[ 2] = data03; + b[ 3] = data04; + b[ 4] = data05; + b[ 5] = data06; + b[ 6] = data07; + b[ 7] = data08; + b[ 8] = data09; + b[ 9] = data10; + b[10] = data11; + b[11] = data12; + b[12] = data13; + b[13] = data14; + b[14] = data15; + b[15] = data16; + b[16] = data17; + b[17] = ZERO; + b[18] = data19; + b[19] = -data20; + b[20] = data21; + b[21] = -data22; + b[22] = data23; + b[23] = -data24; + b[24] = data25; + b[25] = -data26; + b[26] = data27; + b[27] = -data28; + b[28] = data29; + b[29] = -data30; + b[30] = data31; + b[31] = -data32; + break; + case -9 : + b[ 0] = data01; + b[ 1] = data02; + b[ 2] = data03; + b[ 3] = data04; + b[ 4] = data05; + b[ 5] = data06; + b[ 6] = data07; + b[ 7] = data08; + b[ 8] = data09; + b[ 9] = data10; + b[10] = data11; + b[11] = data12; + b[12] = data13; + b[13] = data14; + b[14] = data15; + b[15] = data16; + b[16] = data17; + b[17] = data18; + b[18] = data19; + b[19] = ZERO; + b[20] = data21; + b[21] = -data22; + b[22] = data23; + b[23] = -data24; + b[24] = data25; + b[25] = -data26; + b[26] = data27; + b[27] = -data28; + b[28] = data29; + b[29] = -data30; + b[30] = data31; + b[31] = -data32; + break; + case -10 : + b[ 0] = data01; + b[ 1] = data02; + b[ 2] = data03; + b[ 3] = data04; + b[ 4] = data05; + b[ 5] = data06; + b[ 6] = data07; + b[ 7] = data08; + b[ 8] = data09; + b[ 9] = data10; + b[10] = data11; + b[11] = data12; + b[12] = data13; + b[13] = data14; + b[14] = data15; + b[15] = data16; + b[16] = data17; + b[17] = data18; + b[18] = data19; + b[19] = data20; + b[20] = data21; + b[21] = ZERO; + b[22] = data23; + b[23] = -data24; + b[24] = data25; + b[25] = -data26; + b[26] = data27; + b[27] = -data28; + b[28] = data29; + b[29] = -data30; + b[30] = data31; + b[31] = -data32; + break; + case -11 : + b[ 0] = data01; + b[ 1] = data02; + b[ 2] = data03; + b[ 3] = data04; + b[ 4] = data05; + b[ 5] = data06; + b[ 6] = data07; + b[ 7] = data08; + b[ 8] = data09; + b[ 9] = data10; + b[10] = data11; + b[11] = data12; + b[12] = data13; + b[13] = data14; + b[14] = data15; + b[15] = data16; + b[16] = data17; + b[17] = data18; + b[18] = data19; + b[19] = data20; + b[20] = data21; + b[21] = data22; + b[22] = data23; + b[23] = ZERO; + b[24] = data25; + b[25] = -data26; + b[26] = data27; + b[27] = -data28; + b[28] = data29; + b[29] = -data30; + b[30] = data31; + b[31] = -data32; + break; + case -12 : + b[ 0] = data01; + b[ 1] = data02; + b[ 2] = data03; + b[ 3] = data04; + b[ 4] = data05; + b[ 5] = data06; + b[ 6] = data07; + b[ 7] = data08; + b[ 8] = data09; + b[ 9] = data10; + b[10] = data11; + b[11] = data12; + b[12] = data13; + b[13] = data14; + b[14] = data15; + b[15] = data16; + b[16] = data17; + b[17] = data18; + b[18] = data19; + b[19] = data20; + b[20] = data21; + b[21] = data22; + b[22] = data23; + b[23] = data24; + b[24] = data25; + b[25] = ZERO; + b[26] = data27; + b[27] = -data28; + b[28] = data29; + b[29] = -data30; + b[30] = data31; + b[31] = -data32; + break; + case -13 : + b[ 0] = data01; + b[ 1] = data02; + b[ 2] = data03; + b[ 3] = data04; + b[ 4] = data05; + b[ 5] = data06; + b[ 6] = data07; + b[ 7] = data08; + b[ 8] = data09; + b[ 9] = data10; + b[10] = data11; + b[11] = data12; + b[12] = data13; + b[13] = data14; + b[14] = data15; + b[15] = data16; + b[16] = data17; + b[17] = data18; + b[18] = data19; + b[19] = data20; + b[20] = data21; + b[21] = data22; + b[22] = data23; + b[23] = data24; + b[24] = data25; + b[25] = data26; + b[26] = data27; + b[27] = ZERO; + b[28] = data29; + b[29] = -data30; + b[30] = data31; + b[31] = -data32; + break; + case -14 : + b[ 0] = data01; + b[ 1] = data02; + b[ 2] = data03; + b[ 3] = data04; + b[ 4] = data05; + b[ 5] = data06; + b[ 6] = data07; + b[ 7] = data08; + b[ 8] = data09; + b[ 9] = data10; + b[10] = data11; + b[11] = data12; + b[12] = data13; + b[13] = data14; + b[14] = data15; + b[15] = data16; + b[16] = data17; + b[17] = data18; + b[18] = data19; + b[19] = data20; + b[20] = data21; + b[21] = data22; + b[22] = data23; + b[23] = data24; + b[24] = data25; + b[25] = data26; + b[26] = data27; + b[27] = data28; + b[28] = data29; + b[29] = ZERO; + b[30] = data31; + b[31] = -data32; + break; + case -15 : + b[ 0] = data01; + b[ 1] = data02; + b[ 2] = data03; + b[ 3] = data04; + b[ 4] = data05; + b[ 5] = data06; + b[ 6] = data07; + b[ 7] = data08; + b[ 8] = data09; + b[ 9] = data10; + b[10] = data11; + b[11] = data12; + b[12] = data13; + b[13] = data14; + b[14] = data15; + b[15] = data16; + b[16] = data17; + b[17] = data18; + b[18] = data19; + b[19] = data20; + b[20] = data21; + b[21] = data22; + b[22] = data23; + b[23] = data24; + b[24] = data25; + b[25] = data26; + b[26] = data27; + b[27] = data28; + b[28] = data29; + b[29] = data30; + b[30] = data31; + b[31] = ZERO; + break; + } + } + + b += 32; + + offset --; + i --; + } + + posX += 16; + js --; + } + + if (n & 8) { + offset = posX - posY; + + if (offset > 0) ao1 = a + posY * 2 + (posX + 0) * lda; else ao1 = a + (posX + 0) * 2 + posY * lda; + if (offset > -1) ao2 = a + posY * 2 + (posX + 1) * lda; else ao2 = a + (posX + 1) * 2 + posY * lda; + if (offset > -2) ao3 = a + posY * 2 + (posX + 2) * lda; else ao3 = a + (posX + 2) * 2 + posY * lda; + if (offset > -3) ao4 = a + posY * 2 + (posX + 3) * lda; else ao4 = a + (posX + 3) * 2 + posY * lda; + if (offset > -4) ao5 = a + posY * 2 + (posX + 4) * lda; else ao5 = a + (posX + 4) * 2 + posY * lda; + if (offset > -5) ao6 = a + posY * 2 + (posX + 5) * lda; else ao6 = a + (posX + 5) * 2 + posY * lda; + if (offset > -6) ao7 = a + posY * 2 + (posX + 6) * lda; else ao7 = a + (posX + 6) * 2 + posY * lda; + if (offset > -7) ao8 = a + posY * 2 + (posX + 7) * lda; else ao8 = a + (posX + 7) * 2 + posY * lda; + + i = m; + + while (i > 0) { + data01 = *(ao1 + 0); + data02 = *(ao1 + 1); + data03 = *(ao2 + 0); + data04 = *(ao2 + 1); + data05 = *(ao3 + 0); + data06 = *(ao3 + 1); + data07 = *(ao4 + 0); + data08 = *(ao4 + 1); + data09 = *(ao5 + 0); + data10 = *(ao5 + 1); + data11 = *(ao6 + 0); + data12 = *(ao6 + 1); + data13 = *(ao7 + 0); + data14 = *(ao7 + 1); + data15 = *(ao8 + 0); + data16 = *(ao8 + 1); + + if (offset > 0) ao1 += 2; else ao1 += lda; + if (offset > -1) ao2 += 2; else ao2 += lda; + if (offset > -2) ao3 += 2; else ao3 += lda; + if (offset > -3) ao4 += 2; else ao4 += lda; + if (offset > -4) ao5 += 2; else ao5 += lda; + if (offset > -5) ao6 += 2; else ao6 += lda; + if (offset > -6) ao7 += 2; else ao7 += lda; + if (offset > -7) ao8 += 2; else ao8 += lda; + + if (offset > 0) { + b[ 0] = data01; + b[ 1] = -data02; + b[ 2] = data03; + b[ 3] = -data04; + b[ 4] = data05; + b[ 5] = -data06; + b[ 6] = data07; + b[ 7] = -data08; + b[ 8] = data09; + b[ 9] = -data10; + b[10] = data11; + b[11] = -data12; + b[12] = data13; + b[13] = -data14; + b[14] = data15; + b[15] = -data16; + } else + if (offset < -7) { + b[ 0] = data01; + b[ 1] = data02; + b[ 2] = data03; + b[ 3] = data04; + b[ 4] = data05; + b[ 5] = data06; + b[ 6] = data07; + b[ 7] = data08; + b[ 8] = data09; + b[ 9] = data10; + b[10] = data11; + b[11] = data12; + b[12] = data13; + b[13] = data14; + b[14] = data15; + b[15] = data16; + } else { + switch (offset) { + case 0 : + b[ 0] = data01; + b[ 1] = ZERO; + b[ 2] = data03; + b[ 3] = -data04; + b[ 4] = data05; + b[ 5] = -data06; + b[ 6] = data07; + b[ 7] = -data08; + b[ 8] = data09; + b[ 9] = -data10; + b[10] = data11; + b[11] = -data12; + b[12] = data13; + b[13] = -data14; + b[14] = data15; + b[15] = -data16; + break; + case -1 : + b[ 0] = data01; + b[ 1] = data02; + b[ 2] = data03; + b[ 3] = ZERO; + b[ 4] = data05; + b[ 5] = -data06; + b[ 6] = data07; + b[ 7] = -data08; + b[ 8] = data09; + b[ 9] = -data10; + b[10] = data11; + b[11] = -data12; + b[12] = data13; + b[13] = -data14; + b[14] = data15; + b[15] = -data16; + break; + case -2 : + b[ 0] = data01; + b[ 1] = data02; + b[ 2] = data03; + b[ 3] = data04; + b[ 4] = data05; + b[ 5] = ZERO; + b[ 6] = data07; + b[ 7] = -data08; + b[ 8] = data09; + b[ 9] = -data10; + b[10] = data11; + b[11] = -data12; + b[12] = data13; + b[13] = -data14; + b[14] = data15; + b[15] = -data16; + break; + case -3 : + b[ 0] = data01; + b[ 1] = data02; + b[ 2] = data03; + b[ 3] = data04; + b[ 4] = data05; + b[ 5] = data06; + b[ 6] = data07; + b[ 7] = ZERO; + b[ 8] = data09; + b[ 9] = -data10; + b[10] = data11; + b[11] = -data12; + b[12] = data13; + b[13] = -data14; + b[14] = data15; + b[15] = -data16; + break; + case -4 : + b[ 0] = data01; + b[ 1] = data02; + b[ 2] = data03; + b[ 3] = data04; + b[ 4] = data05; + b[ 5] = data06; + b[ 6] = data07; + b[ 7] = data08; + b[ 8] = data09; + b[ 9] = ZERO; + b[10] = data11; + b[11] = -data12; + b[12] = data13; + b[13] = -data14; + b[14] = data15; + b[15] = -data16; + break; + case -5 : + b[ 0] = data01; + b[ 1] = data02; + b[ 2] = data03; + b[ 3] = data04; + b[ 4] = data05; + b[ 5] = data06; + b[ 6] = data07; + b[ 7] = data08; + b[ 8] = data09; + b[ 9] = data10; + b[10] = data11; + b[11] = ZERO; + b[12] = data13; + b[13] = -data14; + b[14] = data15; + b[15] = -data16; + break; + case -6 : + b[ 0] = data01; + b[ 1] = data02; + b[ 2] = data03; + b[ 3] = data04; + b[ 4] = data05; + b[ 5] = data06; + b[ 6] = data07; + b[ 7] = data08; + b[ 8] = data09; + b[ 9] = data10; + b[10] = data11; + b[11] = data12; + b[12] = data13; + b[13] = ZERO; + b[14] = data15; + b[15] = -data16; + break; + case -7 : + b[ 0] = data01; + b[ 1] = data02; + b[ 2] = data03; + b[ 3] = data04; + b[ 4] = data05; + b[ 5] = data06; + b[ 6] = data07; + b[ 7] = data08; + b[ 8] = data09; + b[ 9] = data10; + b[10] = data11; + b[11] = data12; + b[12] = data13; + b[13] = data14; + b[14] = data15; + b[15] = ZERO; + break; + } + } + + b += 16; + + offset --; + i --; + } + + posX += 8; + } + + if (n & 4) { + offset = posX - posY; + + if (offset > 0) ao1 = a + posY * 2 + (posX + 0) * lda; else ao1 = a + (posX + 0) * 2 + posY * lda; + if (offset > -1) ao2 = a + posY * 2 + (posX + 1) * lda; else ao2 = a + (posX + 1) * 2 + posY * lda; + if (offset > -2) ao3 = a + posY * 2 + (posX + 2) * lda; else ao3 = a + (posX + 2) * 2 + posY * lda; + if (offset > -3) ao4 = a + posY * 2 + (posX + 3) * lda; else ao4 = a + (posX + 3) * 2 + posY * lda; + + i = m; + + while (i > 0) { + data01 = *(ao1 + 0); + data02 = *(ao1 + 1); + data03 = *(ao2 + 0); + data04 = *(ao2 + 1); + data05 = *(ao3 + 0); + data06 = *(ao3 + 1); + data07 = *(ao4 + 0); + data08 = *(ao4 + 1); + + if (offset > 0) ao1 += 2; else ao1 += lda; + if (offset > -1) ao2 += 2; else ao2 += lda; + if (offset > -2) ao3 += 2; else ao3 += lda; + if (offset > -3) ao4 += 2; else ao4 += lda; + + if (offset > 0) { + b[ 0] = data01; + b[ 1] = -data02; + b[ 2] = data03; + b[ 3] = -data04; + b[ 4] = data05; + b[ 5] = -data06; + b[ 6] = data07; + b[ 7] = -data08; + } else + if (offset < -3) { + b[ 0] = data01; + b[ 1] = data02; + b[ 2] = data03; + b[ 3] = data04; + b[ 4] = data05; + b[ 5] = data06; + b[ 6] = data07; + b[ 7] = data08; + } else { + switch (offset) { + case 0 : + b[ 0] = data01; + b[ 1] = ZERO; + b[ 2] = data03; + b[ 3] = -data04; + b[ 4] = data05; + b[ 5] = -data06; + b[ 6] = data07; + b[ 7] = -data08; + break; + case -1 : + b[ 0] = data01; + b[ 1] = data02; + b[ 2] = data03; + b[ 3] = ZERO; + b[ 4] = data05; + b[ 5] = -data06; + b[ 6] = data07; + b[ 7] = -data08; + break; + case -2 : + b[ 0] = data01; + b[ 1] = data02; + b[ 2] = data03; + b[ 3] = data04; + b[ 4] = data05; + b[ 5] = ZERO; + b[ 6] = data07; + b[ 7] = -data08; + break; + case -3 : + b[ 0] = data01; + b[ 1] = data02; + b[ 2] = data03; + b[ 3] = data04; + b[ 4] = data05; + b[ 5] = data06; + b[ 6] = data07; + b[ 7] = ZERO; + break; + } + } + + b += 8; + + offset --; + i --; + } + + posX += 4; + } + + if (n & 2) { + + offset = posX - posY; + + if (offset > 0) ao1 = a + posY * 2 + (posX + 0) * lda; else ao1 = a + (posX + 0) * 2 + posY * lda; + if (offset > -1) ao2 = a + posY * 2 + (posX + 1) * lda; else ao2 = a + (posX + 1) * 2 + posY * lda; + + i = m; + + while (i > 0) { + data01 = *(ao1 + 0); + data02 = *(ao1 + 1); + data03 = *(ao2 + 0); + data04 = *(ao2 + 1); + + if (offset > 0) ao1 += 2; else ao1 += lda; + if (offset > -1) ao2 += 2; else ao2 += lda; + + if (offset > 0) { + b[ 0] = data01; + b[ 1] = -data02; + b[ 2] = data03; + b[ 3] = -data04; + } else + if (offset < -1) { + b[ 0] = data01; + b[ 1] = data02; + b[ 2] = data03; + b[ 3] = data04; + } else { + switch (offset) { + case 0 : + b[ 0] = data01; + b[ 1] = ZERO; + b[ 2] = data03; + b[ 3] = -data04; + break; + case -1 : + b[ 0] = data01; + b[ 1] = data02; + b[ 2] = data03; + b[ 3] = ZERO; + break; + } + } + + b += 4; + + offset --; + i --; + } + + posX += 2; + } + + if (n & 1) { + + offset = posX - posY; + + if (offset > 0) ao1 = a + posY * 2 + (posX + 0) * lda; else ao1 = a + (posX + 0) * 2 + posY * lda; + + i = m; + + while (i > 0) { + data01 = *(ao1 + 0); + data02 = *(ao1 + 1); + + if (offset > 0) ao1 += 2; else ao1 += lda; + + if (offset > 0) { + b[ 0] = data01; + b[ 1] = -data02; + } else + if (offset < 0) { + b[ 0] = data01; + b[ 1] = data02; + } else { + b[ 0] = data01; + b[ 1] = ZERO; + } + + b += 2; + + offset --; + i --; + } + + } + + return 0; +} diff --git a/kernel/generic/zneg_tcopy_16.c b/kernel/generic/zneg_tcopy_16.c new file mode 100644 index 000000000..50f5a3d37 --- /dev/null +++ b/kernel/generic/zneg_tcopy_16.c @@ -0,0 +1,587 @@ +/******************************************************************************* +Copyright (c) 2024, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 +#include "common.h" + +int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, FLOAT *b){ + + BLASLONG i, j; + + FLOAT *aoffset; + FLOAT *aoffset1, *aoffset2; + + FLOAT *boffset; + + FLOAT ctemp01, ctemp02, ctemp03, ctemp04; + FLOAT ctemp05, ctemp06, ctemp07, ctemp08; + FLOAT ctemp09, ctemp10, ctemp11, ctemp12; + FLOAT ctemp13, ctemp14, ctemp15, ctemp16; + FLOAT ctemp17, ctemp18, ctemp19, ctemp20; + FLOAT ctemp21, ctemp22, ctemp23, ctemp24; + FLOAT ctemp25, ctemp26, ctemp27, ctemp28; + FLOAT ctemp29, ctemp30, ctemp31, ctemp32; + + FLOAT ctemp33, ctemp34, ctemp35, ctemp36; + FLOAT ctemp37, ctemp38, ctemp39, ctemp40; + FLOAT ctemp41, ctemp42, ctemp43, ctemp44; + FLOAT ctemp45, ctemp46, ctemp47, ctemp48; + FLOAT ctemp49, ctemp50, ctemp51, ctemp52; + FLOAT ctemp53, ctemp54, ctemp55, ctemp56; + FLOAT ctemp57, ctemp58, ctemp59, ctemp60; + FLOAT ctemp61, ctemp62, ctemp63, ctemp64; + + aoffset = a; + boffset = b; + lda *= 2; + +#if 0 + fprintf(stderr, "M = %d N = %d\n", m, n); +#endif + + j = (n >> 4); + if (j > 0){ + do{ + aoffset1 = aoffset; + aoffset2 = aoffset + lda; + aoffset += 32; + + i = (m >> 1); + if (i > 0){ + do{ + ctemp01 = *(aoffset1 + 0); + ctemp02 = *(aoffset1 + 1); + ctemp03 = *(aoffset1 + 2); + ctemp04 = *(aoffset1 + 3); + ctemp05 = *(aoffset1 + 4); + ctemp06 = *(aoffset1 + 5); + ctemp07 = *(aoffset1 + 6); + ctemp08 = *(aoffset1 + 7); + ctemp09 = *(aoffset1 + 8); + ctemp10 = *(aoffset1 + 9); + ctemp11 = *(aoffset1 + 10); + ctemp12 = *(aoffset1 + 11); + ctemp13 = *(aoffset1 + 12); + ctemp14 = *(aoffset1 + 13); + ctemp15 = *(aoffset1 + 14); + ctemp16 = *(aoffset1 + 15); + ctemp17 = *(aoffset1 + 16); + ctemp18 = *(aoffset1 + 17); + ctemp19 = *(aoffset1 + 18); + ctemp20 = *(aoffset1 + 19); + ctemp21 = *(aoffset1 + 20); + ctemp22 = *(aoffset1 + 21); + ctemp23 = *(aoffset1 + 22); + ctemp24 = *(aoffset1 + 23); + ctemp25 = *(aoffset1 + 24); + ctemp26 = *(aoffset1 + 25); + ctemp27 = *(aoffset1 + 26); + ctemp28 = *(aoffset1 + 27); + ctemp29 = *(aoffset1 + 28); + ctemp30 = *(aoffset1 + 29); + ctemp31 = *(aoffset1 + 30); + ctemp32 = *(aoffset1 + 31); + + ctemp33 = *(aoffset2 + 0); + ctemp34 = *(aoffset2 + 1); + ctemp35 = *(aoffset2 + 2); + ctemp36 = *(aoffset2 + 3); + ctemp37 = *(aoffset2 + 4); + ctemp38 = *(aoffset2 + 5); + ctemp39 = *(aoffset2 + 6); + ctemp40 = *(aoffset2 + 7); + ctemp41 = *(aoffset2 + 8); + ctemp42 = *(aoffset2 + 9); + ctemp43 = *(aoffset2 + 10); + ctemp44 = *(aoffset2 + 11); + ctemp45 = *(aoffset2 + 12); + ctemp46 = *(aoffset2 + 13); + ctemp47 = *(aoffset2 + 14); + ctemp48 = *(aoffset2 + 15); + ctemp49 = *(aoffset2 + 16); + ctemp50 = *(aoffset2 + 17); + ctemp51 = *(aoffset2 + 18); + ctemp52 = *(aoffset2 + 19); + ctemp53 = *(aoffset2 + 20); + ctemp54 = *(aoffset2 + 21); + ctemp55 = *(aoffset2 + 22); + ctemp56 = *(aoffset2 + 23); + ctemp57 = *(aoffset2 + 24); + ctemp58 = *(aoffset2 + 25); + ctemp59 = *(aoffset2 + 26); + ctemp60 = *(aoffset2 + 27); + ctemp61 = *(aoffset2 + 28); + ctemp62 = *(aoffset2 + 29); + ctemp63 = *(aoffset2 + 30); + ctemp64 = *(aoffset2 + 31); + + *(boffset + 0) = -ctemp01; + *(boffset + 1) = -ctemp02; + *(boffset + 2) = -ctemp03; + *(boffset + 3) = -ctemp04; + *(boffset + 4) = -ctemp05; + *(boffset + 5) = -ctemp06; + *(boffset + 6) = -ctemp07; + *(boffset + 7) = -ctemp08; + + *(boffset + 8) = -ctemp09; + *(boffset + 9) = -ctemp10; + *(boffset + 10) = -ctemp11; + *(boffset + 11) = -ctemp12; + *(boffset + 12) = -ctemp13; + *(boffset + 13) = -ctemp14; + *(boffset + 14) = -ctemp15; + *(boffset + 15) = -ctemp16; + + *(boffset + 16) = -ctemp17; + *(boffset + 17) = -ctemp18; + *(boffset + 18) = -ctemp19; + *(boffset + 19) = -ctemp20; + *(boffset + 20) = -ctemp21; + *(boffset + 21) = -ctemp22; + *(boffset + 22) = -ctemp23; + *(boffset + 23) = -ctemp24; + + *(boffset + 24) = -ctemp25; + *(boffset + 25) = -ctemp26; + *(boffset + 26) = -ctemp27; + *(boffset + 27) = -ctemp28; + *(boffset + 28) = -ctemp29; + *(boffset + 29) = -ctemp30; + *(boffset + 30) = -ctemp31; + *(boffset + 31) = -ctemp32; + + *(boffset + 32) = -ctemp33; + *(boffset + 33) = -ctemp34; + *(boffset + 34) = -ctemp35; + *(boffset + 35) = -ctemp36; + *(boffset + 36) = -ctemp37; + *(boffset + 37) = -ctemp38; + *(boffset + 38) = -ctemp39; + *(boffset + 39) = -ctemp40; + + *(boffset + 40) = -ctemp41; + *(boffset + 41) = -ctemp42; + *(boffset + 42) = -ctemp43; + *(boffset + 43) = -ctemp44; + *(boffset + 44) = -ctemp45; + *(boffset + 45) = -ctemp46; + *(boffset + 46) = -ctemp47; + *(boffset + 47) = -ctemp48; + + *(boffset + 48) = -ctemp49; + *(boffset + 49) = -ctemp50; + *(boffset + 50) = -ctemp51; + *(boffset + 51) = -ctemp52; + *(boffset + 52) = -ctemp53; + *(boffset + 53) = -ctemp54; + *(boffset + 54) = -ctemp55; + *(boffset + 55) = -ctemp56; + + *(boffset + 56) = -ctemp57; + *(boffset + 57) = -ctemp58; + *(boffset + 58) = -ctemp59; + *(boffset + 59) = -ctemp60; + *(boffset + 60) = -ctemp61; + *(boffset + 61) = -ctemp62; + *(boffset + 62) = -ctemp63; + *(boffset + 63) = -ctemp64; + + aoffset1 += 2 * lda; + aoffset2 += 2 * lda; + boffset += 64; + + i --; + }while(i > 0); + } + + if (m & 1){ + ctemp01 = *(aoffset1 + 0); + ctemp02 = *(aoffset1 + 1); + ctemp03 = *(aoffset1 + 2); + ctemp04 = *(aoffset1 + 3); + ctemp05 = *(aoffset1 + 4); + ctemp06 = *(aoffset1 + 5); + ctemp07 = *(aoffset1 + 6); + ctemp08 = *(aoffset1 + 7); + ctemp09 = *(aoffset1 + 8); + ctemp10 = *(aoffset1 + 9); + ctemp11 = *(aoffset1 + 10); + ctemp12 = *(aoffset1 + 11); + ctemp13 = *(aoffset1 + 12); + ctemp14 = *(aoffset1 + 13); + ctemp15 = *(aoffset1 + 14); + ctemp16 = *(aoffset1 + 15); + ctemp17 = *(aoffset1 + 16); + ctemp18 = *(aoffset1 + 17); + ctemp19 = *(aoffset1 + 18); + ctemp20 = *(aoffset1 + 19); + ctemp21 = *(aoffset1 + 20); + ctemp22 = *(aoffset1 + 21); + ctemp23 = *(aoffset1 + 22); + ctemp24 = *(aoffset1 + 23); + ctemp25 = *(aoffset1 + 24); + ctemp26 = *(aoffset1 + 25); + ctemp27 = *(aoffset1 + 26); + ctemp28 = *(aoffset1 + 27); + ctemp29 = *(aoffset1 + 28); + ctemp30 = *(aoffset1 + 29); + ctemp31 = *(aoffset1 + 30); + ctemp32 = *(aoffset1 + 31); + + *(boffset + 0) = -ctemp01; + *(boffset + 1) = -ctemp02; + *(boffset + 2) = -ctemp03; + *(boffset + 3) = -ctemp04; + *(boffset + 4) = -ctemp05; + *(boffset + 5) = -ctemp06; + *(boffset + 6) = -ctemp07; + *(boffset + 7) = -ctemp08; + + *(boffset + 8) = -ctemp09; + *(boffset + 9) = -ctemp10; + *(boffset + 10) = -ctemp11; + *(boffset + 11) = -ctemp12; + *(boffset + 12) = -ctemp13; + *(boffset + 13) = -ctemp14; + *(boffset + 14) = -ctemp15; + *(boffset + 15) = -ctemp16; + + *(boffset + 16) = -ctemp17; + *(boffset + 17) = -ctemp18; + *(boffset + 18) = -ctemp19; + *(boffset + 19) = -ctemp20; + *(boffset + 20) = -ctemp21; + *(boffset + 21) = -ctemp22; + *(boffset + 22) = -ctemp23; + *(boffset + 23) = -ctemp24; + + *(boffset + 24) = -ctemp25; + *(boffset + 25) = -ctemp26; + *(boffset + 26) = -ctemp27; + *(boffset + 27) = -ctemp28; + *(boffset + 28) = -ctemp29; + *(boffset + 29) = -ctemp30; + *(boffset + 30) = -ctemp31; + *(boffset + 31) = -ctemp32; + + boffset += 32; + } + + j--; + }while(j > 0); + } /* end of if(j > 0) */ + + if (n & 8){ + aoffset1 = aoffset; + aoffset2 = aoffset + lda; + aoffset += 16; + + i = (m >> 1); + if (i > 0){ + do{ + ctemp01 = *(aoffset1 + 0); + ctemp02 = *(aoffset1 + 1); + ctemp03 = *(aoffset1 + 2); + ctemp04 = *(aoffset1 + 3); + ctemp05 = *(aoffset1 + 4); + ctemp06 = *(aoffset1 + 5); + ctemp07 = *(aoffset1 + 6); + ctemp08 = *(aoffset1 + 7); + ctemp09 = *(aoffset1 + 8); + ctemp10 = *(aoffset1 + 9); + ctemp11 = *(aoffset1 + 10); + ctemp12 = *(aoffset1 + 11); + ctemp13 = *(aoffset1 + 12); + ctemp14 = *(aoffset1 + 13); + ctemp15 = *(aoffset1 + 14); + ctemp16 = *(aoffset1 + 15); + + ctemp17 = *(aoffset2 + 0); + ctemp18 = *(aoffset2 + 1); + ctemp19 = *(aoffset2 + 2); + ctemp20 = *(aoffset2 + 3); + ctemp21 = *(aoffset2 + 4); + ctemp22 = *(aoffset2 + 5); + ctemp23 = *(aoffset2 + 6); + ctemp24 = *(aoffset2 + 7); + ctemp25 = *(aoffset2 + 8); + ctemp26 = *(aoffset2 + 9); + ctemp27 = *(aoffset2 + 10); + ctemp28 = *(aoffset2 + 11); + ctemp29 = *(aoffset2 + 12); + ctemp30 = *(aoffset2 + 13); + ctemp31 = *(aoffset2 + 14); + ctemp32 = *(aoffset2 + 15); + + *(boffset + 0) = -ctemp01; + *(boffset + 1) = -ctemp02; + *(boffset + 2) = -ctemp03; + *(boffset + 3) = -ctemp04; + *(boffset + 4) = -ctemp05; + *(boffset + 5) = -ctemp06; + *(boffset + 6) = -ctemp07; + *(boffset + 7) = -ctemp08; + + *(boffset + 8) = -ctemp09; + *(boffset + 9) = -ctemp10; + *(boffset + 10) = -ctemp11; + *(boffset + 11) = -ctemp12; + *(boffset + 12) = -ctemp13; + *(boffset + 13) = -ctemp14; + *(boffset + 14) = -ctemp15; + *(boffset + 15) = -ctemp16; + + *(boffset + 16) = -ctemp17; + *(boffset + 17) = -ctemp18; + *(boffset + 18) = -ctemp19; + *(boffset + 19) = -ctemp20; + *(boffset + 20) = -ctemp21; + *(boffset + 21) = -ctemp22; + *(boffset + 22) = -ctemp23; + *(boffset + 23) = -ctemp24; + + *(boffset + 24) = -ctemp25; + *(boffset + 25) = -ctemp26; + *(boffset + 26) = -ctemp27; + *(boffset + 27) = -ctemp28; + *(boffset + 28) = -ctemp29; + *(boffset + 29) = -ctemp30; + *(boffset + 30) = -ctemp31; + *(boffset + 31) = -ctemp32; + + aoffset1 += 2 * lda; + aoffset2 += 2 * lda; + boffset += 32; + + i --; + }while(i > 0); + } + + if (m & 1){ + ctemp01 = *(aoffset1 + 0); + ctemp02 = *(aoffset1 + 1); + ctemp03 = *(aoffset1 + 2); + ctemp04 = *(aoffset1 + 3); + ctemp05 = *(aoffset1 + 4); + ctemp06 = *(aoffset1 + 5); + ctemp07 = *(aoffset1 + 6); + ctemp08 = *(aoffset1 + 7); + ctemp09 = *(aoffset1 + 8); + ctemp10 = *(aoffset1 + 9); + ctemp11 = *(aoffset1 + 10); + ctemp12 = *(aoffset1 + 11); + ctemp13 = *(aoffset1 + 12); + ctemp14 = *(aoffset1 + 13); + ctemp15 = *(aoffset1 + 14); + ctemp16 = *(aoffset1 + 15); + + *(boffset + 0) = -ctemp01; + *(boffset + 1) = -ctemp02; + *(boffset + 2) = -ctemp03; + *(boffset + 3) = -ctemp04; + *(boffset + 4) = -ctemp05; + *(boffset + 5) = -ctemp06; + *(boffset + 6) = -ctemp07; + *(boffset + 7) = -ctemp08; + + *(boffset + 8) = -ctemp09; + *(boffset + 9) = -ctemp10; + *(boffset + 10) = -ctemp11; + *(boffset + 11) = -ctemp12; + *(boffset + 12) = -ctemp13; + *(boffset + 13) = -ctemp14; + *(boffset + 14) = -ctemp15; + *(boffset + 15) = -ctemp16; + + boffset += 16; + } + } + + if (n & 4){ + aoffset1 = aoffset; + aoffset2 = aoffset + lda; + aoffset += 8; + + i = (m >> 1); + if (i > 0){ + do{ + ctemp01 = *(aoffset1 + 0); + ctemp02 = *(aoffset1 + 1); + ctemp03 = *(aoffset1 + 2); + ctemp04 = *(aoffset1 + 3); + ctemp05 = *(aoffset1 + 4); + ctemp06 = *(aoffset1 + 5); + ctemp07 = *(aoffset1 + 6); + ctemp08 = *(aoffset1 + 7); + + ctemp09 = *(aoffset2 + 0); + ctemp10 = *(aoffset2 + 1); + ctemp11 = *(aoffset2 + 2); + ctemp12 = *(aoffset2 + 3); + ctemp13 = *(aoffset2 + 4); + ctemp14 = *(aoffset2 + 5); + ctemp15 = *(aoffset2 + 6); + ctemp16 = *(aoffset2 + 7); + + *(boffset + 0) = -ctemp01; + *(boffset + 1) = -ctemp02; + *(boffset + 2) = -ctemp03; + *(boffset + 3) = -ctemp04; + *(boffset + 4) = -ctemp05; + *(boffset + 5) = -ctemp06; + *(boffset + 6) = -ctemp07; + *(boffset + 7) = -ctemp08; + + *(boffset + 8) = -ctemp09; + *(boffset + 9) = -ctemp10; + *(boffset + 10) = -ctemp11; + *(boffset + 11) = -ctemp12; + *(boffset + 12) = -ctemp13; + *(boffset + 13) = -ctemp14; + *(boffset + 14) = -ctemp15; + *(boffset + 15) = -ctemp16; + + aoffset1 += 2 * lda; + aoffset2 += 2 * lda; + boffset += 16; + + i --; + }while(i > 0); + } + + if (m & 1){ + ctemp01 = *(aoffset1 + 0); + ctemp02 = *(aoffset1 + 1); + ctemp03 = *(aoffset1 + 2); + ctemp04 = *(aoffset1 + 3); + ctemp05 = *(aoffset1 + 4); + ctemp06 = *(aoffset1 + 5); + ctemp07 = *(aoffset1 + 6); + ctemp08 = *(aoffset1 + 7); + + *(boffset + 0) = -ctemp01; + *(boffset + 1) = -ctemp02; + *(boffset + 2) = -ctemp03; + *(boffset + 3) = -ctemp04; + *(boffset + 4) = -ctemp05; + *(boffset + 5) = -ctemp06; + *(boffset + 6) = -ctemp07; + *(boffset + 7) = -ctemp08; + + boffset += 8; + } + } + + if (n & 2){ + aoffset1 = aoffset; + aoffset2 = aoffset + lda; + aoffset += 4; + + i = (m >> 1); + if (i > 0){ + do{ + ctemp01 = *(aoffset1 + 0); + ctemp02 = *(aoffset1 + 1); + ctemp03 = *(aoffset1 + 2); + ctemp04 = *(aoffset1 + 3); + + ctemp05 = *(aoffset2 + 0); + ctemp06 = *(aoffset2 + 1); + ctemp07 = *(aoffset2 + 2); + ctemp08 = *(aoffset2 + 3); + + *(boffset + 0) = -ctemp01; + *(boffset + 1) = -ctemp02; + *(boffset + 2) = -ctemp03; + *(boffset + 3) = -ctemp04; + *(boffset + 4) = -ctemp05; + *(boffset + 5) = -ctemp06; + *(boffset + 6) = -ctemp07; + *(boffset + 7) = -ctemp08; + + aoffset1 += 2 * lda; + aoffset2 += 2 * lda; + boffset += 8; + + i --; + }while(i > 0); + } + + if (m & 1){ + ctemp01 = *(aoffset1 + 0); + ctemp02 = *(aoffset1 + 1); + ctemp03 = *(aoffset1 + 2); + ctemp04 = *(aoffset1 + 3); + + *(boffset + 0) = -ctemp01; + *(boffset + 1) = -ctemp02; + *(boffset + 2) = -ctemp03; + *(boffset + 3) = -ctemp04; + + boffset += 4; + } + } + + if (n & 1){ + aoffset1 = aoffset; + aoffset2 = aoffset + lda; + // aoffset += 2; + + i = (m >> 1); + if (i > 0){ + do{ + ctemp01 = *(aoffset1 + 0); + ctemp02 = *(aoffset1 + 1); + ctemp03 = *(aoffset2 + 0); + ctemp04 = *(aoffset2 + 1); + + *(boffset + 0) = -ctemp01; + *(boffset + 1) = -ctemp02; + *(boffset + 2) = -ctemp03; + *(boffset + 3) = -ctemp04; + + aoffset1 += 2 * lda; + aoffset2 += 2 * lda; + boffset += 4; + + i --; + }while(i > 0); + } + + if (m & 1){ + ctemp01 = *(aoffset1 + 0); + ctemp02 = *(aoffset1 + 1); + + *(boffset + 0) = -ctemp01; + *(boffset + 1) = -ctemp02; + // boffset += 2; + } + } + + return 0; +} diff --git a/kernel/generic/zsymm_lcopy_16.c b/kernel/generic/zsymm_lcopy_16.c new file mode 100644 index 000000000..b32374a5e --- /dev/null +++ b/kernel/generic/zsymm_lcopy_16.c @@ -0,0 +1,333 @@ +/******************************************************************************* +Copyright (c) 2024, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 +#include "common.h" + +int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG posX, BLASLONG posY, FLOAT *b){ + + BLASLONG i, js, offset; + + FLOAT data01, data02, data03, data04, data05, data06, data07, data08; + FLOAT data09, data10, data11, data12, data13, data14, data15, data16; + FLOAT data17, data18, data19, data20, data21, data22, data23, data24; + FLOAT data25, data26, data27, data28, data29, data30, data31, data32; + + FLOAT *ao1, *ao2, *ao3, *ao4, *ao5, *ao6, *ao7, *ao8; + FLOAT *ao9, *ao10, *ao11, *ao12, *ao13, *ao14, *ao15, *ao16; + + lda *= 2; + + js = (n >> 4); + while (js > 0){ + + offset = posX - posY; + + if (offset > 0) ao1 = a + (posX + 0) * 2 + posY * lda; else ao1 = a + posY * 2 + (posX + 0) * lda; + if (offset > -1) ao2 = a + (posX + 1) * 2 + posY * lda; else ao2 = a + posY * 2 + (posX + 1) * lda; + if (offset > -2) ao3 = a + (posX + 2) * 2 + posY * lda; else ao3 = a + posY * 2 + (posX + 2) * lda; + if (offset > -3) ao4 = a + (posX + 3) * 2 + posY * lda; else ao4 = a + posY * 2 + (posX + 3) * lda; + if (offset > -4) ao5 = a + (posX + 4) * 2 + posY * lda; else ao5 = a + posY * 2 + (posX + 4) * lda; + if (offset > -5) ao6 = a + (posX + 5) * 2 + posY * lda; else ao6 = a + posY * 2 + (posX + 5) * lda; + if (offset > -6) ao7 = a + (posX + 6) * 2 + posY * lda; else ao7 = a + posY * 2 + (posX + 6) * lda; + if (offset > -7) ao8 = a + (posX + 7) * 2 + posY * lda; else ao8 = a + posY * 2 + (posX + 7) * lda; + if (offset > -8) ao9 = a + (posX + 8) * 2 + posY * lda; else ao9 = a + posY * 2 + (posX + 8) * lda; + if (offset > -9) ao10 = a + (posX + 9) * 2 + posY * lda; else ao10 = a + posY * 2 + (posX + 9) * lda; + if (offset > -10) ao11 = a + (posX + 10) * 2 + posY * lda; else ao11 = a + posY * 2 + (posX + 10) * lda; + if (offset > -11) ao12 = a + (posX + 11) * 2 + posY * lda; else ao12 = a + posY * 2 + (posX + 11) * lda; + if (offset > -12) ao13 = a + (posX + 12) * 2 + posY * lda; else ao13 = a + posY * 2 + (posX + 12) * lda; + if (offset > -13) ao14 = a + (posX + 13) * 2 + posY * lda; else ao14 = a + posY * 2 + (posX + 13) * lda; + if (offset > -14) ao15 = a + (posX + 14) * 2 + posY * lda; else ao15 = a + posY * 2 + (posX + 14) * lda; + if (offset > -15) ao16 = a + (posX + 15) * 2 + posY * lda; else ao16 = a + posY * 2 + (posX + 15) * lda; + + + i = m; + + while (i > 0) { + data01 = *(ao1 + 0); + data02 = *(ao1 + 1); + data03 = *(ao2 + 0); + data04 = *(ao2 + 1); + data05 = *(ao3 + 0); + data06 = *(ao3 + 1); + data07 = *(ao4 + 0); + data08 = *(ao4 + 1); + data09 = *(ao5 + 0); + data10 = *(ao5 + 1); + data11 = *(ao6 + 0); + data12 = *(ao6 + 1); + data13 = *(ao7 + 0); + data14 = *(ao7 + 1); + data15 = *(ao8 + 0); + data16 = *(ao8 + 1); + data17 = *(ao9 + 0); + data18 = *(ao9 + 1); + data19 = *(ao10 + 0); + data20 = *(ao10 + 1); + data21 = *(ao11 + 0); + data22 = *(ao11 + 1); + data23 = *(ao12 + 0); + data24 = *(ao12 + 1); + data25 = *(ao13 + 0); + data26 = *(ao13 + 1); + data27 = *(ao14 + 0); + data28 = *(ao14 + 1); + data29 = *(ao15 + 0); + data30 = *(ao15 + 1); + data31 = *(ao16 + 0); + data32 = *(ao16 + 1); + + if (offset > 0) ao1 += lda; else ao1 += 2; + if (offset > -1) ao2 += lda; else ao2 += 2; + if (offset > -2) ao3 += lda; else ao3 += 2; + if (offset > -3) ao4 += lda; else ao4 += 2; + if (offset > -4) ao5 += lda; else ao5 += 2; + if (offset > -5) ao6 += lda; else ao6 += 2; + if (offset > -6) ao7 += lda; else ao7 += 2; + if (offset > -7) ao8 += lda; else ao8 += 2; + if (offset > -8) ao9 += lda; else ao9 += 2; + if (offset > -9) ao10 += lda; else ao10 += 2; + if (offset > -10) ao11 += lda; else ao11 += 2; + if (offset > -11) ao12 += lda; else ao12 += 2; + if (offset > -12) ao13 += lda; else ao13 += 2; + if (offset > -13) ao14 += lda; else ao14 += 2; + if (offset > -14) ao15 += lda; else ao15 += 2; + if (offset > -15) ao16 += lda; else ao16 += 2; + + b[ 0] = data01; + b[ 1] = data02; + b[ 2] = data03; + b[ 3] = data04; + b[ 4] = data05; + b[ 5] = data06; + b[ 6] = data07; + b[ 7] = data08; + b[ 8] = data09; + b[ 9] = data10; + b[10] = data11; + b[11] = data12; + b[12] = data13; + b[13] = data14; + b[14] = data15; + b[15] = data16; + b[16] = data17; + b[17] = data18; + b[18] = data19; + b[19] = data20; + b[20] = data21; + b[21] = data22; + b[22] = data23; + b[23] = data24; + b[24] = data25; + b[25] = data26; + b[26] = data27; + b[27] = data28; + b[28] = data29; + b[29] = data30; + b[30] = data31; + b[31] = data32; + + b += 32; + + offset --; + i --; + } + + posX += 16; + js --; + } + + if (n & 8) { + offset = posX - posY; + + if (offset > 0) ao1 = a + (posX + 0) * 2 + posY * lda; else ao1 = a + posY * 2 + (posX + 0) * lda; + if (offset > -1) ao2 = a + (posX + 1) * 2 + posY * lda; else ao2 = a + posY * 2 + (posX + 1) * lda; + if (offset > -2) ao3 = a + (posX + 2) * 2 + posY * lda; else ao3 = a + posY * 2 + (posX + 2) * lda; + if (offset > -3) ao4 = a + (posX + 3) * 2 + posY * lda; else ao4 = a + posY * 2 + (posX + 3) * lda; + if (offset > -4) ao5 = a + (posX + 4) * 2 + posY * lda; else ao5 = a + posY * 2 + (posX + 4) * lda; + if (offset > -5) ao6 = a + (posX + 5) * 2 + posY * lda; else ao6 = a + posY * 2 + (posX + 5) * lda; + if (offset > -6) ao7 = a + (posX + 6) * 2 + posY * lda; else ao7 = a + posY * 2 + (posX + 6) * lda; + if (offset > -7) ao8 = a + (posX + 7) * 2 + posY * lda; else ao8 = a + posY * 2 + (posX + 7) * lda; + + i = m; + + while (i > 0) { + data01 = *(ao1 + 0); + data02 = *(ao1 + 1); + data03 = *(ao2 + 0); + data04 = *(ao2 + 1); + data05 = *(ao3 + 0); + data06 = *(ao3 + 1); + data07 = *(ao4 + 0); + data08 = *(ao4 + 1); + data09 = *(ao5 + 0); + data10 = *(ao5 + 1); + data11 = *(ao6 + 0); + data12 = *(ao6 + 1); + data13 = *(ao7 + 0); + data14 = *(ao7 + 1); + data15 = *(ao8 + 0); + data16 = *(ao8 + 1); + + if (offset > 0) ao1 += lda; else ao1 += 2; + if (offset > -1) ao2 += lda; else ao2 += 2; + if (offset > -2) ao3 += lda; else ao3 += 2; + if (offset > -3) ao4 += lda; else ao4 += 2; + if (offset > -4) ao5 += lda; else ao5 += 2; + if (offset > -5) ao6 += lda; else ao6 += 2; + if (offset > -6) ao7 += lda; else ao7 += 2; + if (offset > -7) ao8 += lda; else ao8 += 2; + + b[ 0] = data01; + b[ 1] = data02; + b[ 2] = data03; + b[ 3] = data04; + b[ 4] = data05; + b[ 5] = data06; + b[ 6] = data07; + b[ 7] = data08; + b[ 8] = data09; + b[ 9] = data10; + b[10] = data11; + b[11] = data12; + b[12] = data13; + b[13] = data14; + b[14] = data15; + b[15] = data16; + + b += 16; + + offset --; + i --; + } + + posX += 8; + } + + if (n & 4) { + offset = posX - posY; + + if (offset > 0) ao1 = a + (posX + 0) * 2 + posY * lda; else ao1 = a + posY * 2 + (posX + 0) * lda; + if (offset > -1) ao2 = a + (posX + 1) * 2 + posY * lda; else ao2 = a + posY * 2 + (posX + 1) * lda; + if (offset > -2) ao3 = a + (posX + 2) * 2 + posY * lda; else ao3 = a + posY * 2 + (posX + 2) * lda; + if (offset > -3) ao4 = a + (posX + 3) * 2 + posY * lda; else ao4 = a + posY * 2 + (posX + 3) * lda; + + i = m; + + while (i > 0) { + data01 = *(ao1 + 0); + data02 = *(ao1 + 1); + data03 = *(ao2 + 0); + data04 = *(ao2 + 1); + data05 = *(ao3 + 0); + data06 = *(ao3 + 1); + data07 = *(ao4 + 0); + data08 = *(ao4 + 1); + + if (offset > 0) ao1 += lda; else ao1 += 2; + if (offset > -1) ao2 += lda; else ao2 += 2; + if (offset > -2) ao3 += lda; else ao3 += 2; + if (offset > -3) ao4 += lda; else ao4 += 2; + + b[ 0] = data01; + b[ 1] = data02; + b[ 2] = data03; + b[ 3] = data04; + b[ 4] = data05; + b[ 5] = data06; + b[ 6] = data07; + b[ 7] = data08; + + b += 8; + + offset --; + i --; + } + + posX += 4; + } + + if (n & 2) { + + offset = posX - posY; + + if (offset > 0) ao1 = a + (posX + 0) * 2 + posY * lda; else ao1 = a + posY * 2 + (posX + 0) * lda; + if (offset > -1) ao2 = a + (posX + 1) * 2 + posY * lda; else ao2 = a + posY * 2 + (posX + 1) * lda; + + i = m; + + while (i > 0) { + data01 = *(ao1 + 0); + data02 = *(ao1 + 1); + data03 = *(ao2 + 0); + data04 = *(ao2 + 1); + + if (offset > 0) ao1 += lda; else ao1 += 2; + if (offset > -1) ao2 += lda; else ao2 += 2; + + b[ 0] = data01; + b[ 1] = data02; + b[ 2] = data03; + b[ 3] = data04; + + b += 4; + + offset --; + i --; + } + + posX += 2; + + } + + if (n & 1) { + + offset = posX - posY; + + if (offset > 0) ao1 = a + (posX + 0) * 2 + posY * lda; else ao1 = a + posY * 2 + (posX + 0) * lda; + + i = m; + + while (i > 0) { + data01 = *(ao1 + 0); + data02 = *(ao1 + 1); + + if (offset > 0) ao1 += lda; else ao1 += 2; + + b[ 0] = data01; + b[ 1] = data02; + + b += 2; + + offset --; + i --; + } + + } + + return 0; +} diff --git a/kernel/generic/zsymm_ucopy_16.c b/kernel/generic/zsymm_ucopy_16.c new file mode 100644 index 000000000..cb19bea47 --- /dev/null +++ b/kernel/generic/zsymm_ucopy_16.c @@ -0,0 +1,332 @@ +/******************************************************************************* +Copyright (c) 2024, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 +#include "common.h" + +int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG posX, BLASLONG posY, FLOAT *b){ + + BLASLONG i, js, offset; + + FLOAT data01, data02, data03, data04, data05, data06, data07, data08; + FLOAT data09, data10, data11, data12, data13, data14, data15, data16; + FLOAT data17, data18, data19, data20, data21, data22, data23, data24; + FLOAT data25, data26, data27, data28, data29, data30, data31, data32; + + FLOAT *ao1, *ao2, *ao3, *ao4, *ao5, *ao6, *ao7, *ao8; + FLOAT *ao9, *ao10, *ao11, *ao12, *ao13, *ao14, *ao15, *ao16; + + lda *= 2; + + js = (n >> 4); + while (js > 0){ + + offset = posX - posY; + + if (offset > 0) ao1 = a + posY * 2 + (posX + 0) * lda; else ao1 = a + (posX + 0) * 2 + posY * lda; + if (offset > -1) ao2 = a + posY * 2 + (posX + 1) * lda; else ao2 = a + (posX + 1) * 2 + posY * lda; + if (offset > -2) ao3 = a + posY * 2 + (posX + 2) * lda; else ao3 = a + (posX + 2) * 2 + posY * lda; + if (offset > -3) ao4 = a + posY * 2 + (posX + 3) * lda; else ao4 = a + (posX + 3) * 2 + posY * lda; + if (offset > -4) ao5 = a + posY * 2 + (posX + 4) * lda; else ao5 = a + (posX + 4) * 2 + posY * lda; + if (offset > -5) ao6 = a + posY * 2 + (posX + 5) * lda; else ao6 = a + (posX + 5) * 2 + posY * lda; + if (offset > -6) ao7 = a + posY * 2 + (posX + 6) * lda; else ao7 = a + (posX + 6) * 2 + posY * lda; + if (offset > -7) ao8 = a + posY * 2 + (posX + 7) * lda; else ao8 = a + (posX + 7) * 2 + posY * lda; + if (offset > -8) ao9 = a + posY * 2 + (posX + 8) * lda; else ao9 = a + (posX + 8) * 2 + posY * lda; + if (offset > -9) ao10 = a + posY * 2 + (posX + 9) * lda; else ao10 = a + (posX + 9) * 2 + posY * lda; + if (offset > -10) ao11 = a + posY * 2 + (posX + 10) * lda; else ao11 = a + (posX + 10) * 2 + posY * lda; + if (offset > -11) ao12 = a + posY * 2 + (posX + 11) * lda; else ao12 = a + (posX + 11) * 2 + posY * lda; + if (offset > -12) ao13 = a + posY * 2 + (posX + 12) * lda; else ao13 = a + (posX + 12) * 2 + posY * lda; + if (offset > -13) ao14 = a + posY * 2 + (posX + 13) * lda; else ao14 = a + (posX + 13) * 2 + posY * lda; + if (offset > -14) ao15 = a + posY * 2 + (posX + 14) * lda; else ao15 = a + (posX + 14) * 2 + posY * lda; + if (offset > -15) ao16 = a + posY * 2 + (posX + 15) * lda; else ao16 = a + (posX + 15) * 2 + posY * lda; + + i = m; + + while (i > 0) { + data01 = *(ao1 + 0); + data02 = *(ao1 + 1); + data03 = *(ao2 + 0); + data04 = *(ao2 + 1); + data05 = *(ao3 + 0); + data06 = *(ao3 + 1); + data07 = *(ao4 + 0); + data08 = *(ao4 + 1); + data09 = *(ao5 + 0); + data10 = *(ao5 + 1); + data11 = *(ao6 + 0); + data12 = *(ao6 + 1); + data13 = *(ao7 + 0); + data14 = *(ao7 + 1); + data15 = *(ao8 + 0); + data16 = *(ao8 + 1); + data17 = *(ao9 + 0); + data18 = *(ao9 + 1); + data19 = *(ao10 + 0); + data20 = *(ao10 + 1); + data21 = *(ao11 + 0); + data22 = *(ao11 + 1); + data23 = *(ao12 + 0); + data24 = *(ao12 + 1); + data25 = *(ao13 + 0); + data26 = *(ao13 + 1); + data27 = *(ao14 + 0); + data28 = *(ao14 + 1); + data29 = *(ao15 + 0); + data30 = *(ao15 + 1); + data31 = *(ao16 + 0); + data32 = *(ao16 + 1); + + if (offset > 0) ao1 += 2; else ao1 += lda; + if (offset > -1) ao2 += 2; else ao2 += lda; + if (offset > -2) ao3 += 2; else ao3 += lda; + if (offset > -3) ao4 += 2; else ao4 += lda; + if (offset > -4) ao5 += 2; else ao5 += lda; + if (offset > -5) ao6 += 2; else ao6 += lda; + if (offset > -6) ao7 += 2; else ao7 += lda; + if (offset > -7) ao8 += 2; else ao8 += lda; + if (offset > -8) ao9 += 2; else ao9 += lda; + if (offset > -9) ao10 += 2; else ao10 += lda; + if (offset > -10) ao11 += 2; else ao11 += lda; + if (offset > -11) ao12 += 2; else ao12 += lda; + if (offset > -12) ao13 += 2; else ao13 += lda; + if (offset > -13) ao14 += 2; else ao14 += lda; + if (offset > -14) ao15 += 2; else ao15 += lda; + if (offset > -15) ao16 += 2; else ao16 += lda; + + b[ 0] = data01; + b[ 1] = data02; + b[ 2] = data03; + b[ 3] = data04; + b[ 4] = data05; + b[ 5] = data06; + b[ 6] = data07; + b[ 7] = data08; + b[ 8] = data09; + b[ 9] = data10; + b[10] = data11; + b[11] = data12; + b[12] = data13; + b[13] = data14; + b[14] = data15; + b[15] = data16; + b[16] = data17; + b[17] = data18; + b[18] = data19; + b[19] = data20; + b[20] = data21; + b[21] = data22; + b[22] = data23; + b[23] = data24; + b[24] = data25; + b[25] = data26; + b[26] = data27; + b[27] = data28; + b[28] = data29; + b[29] = data30; + b[30] = data31; + b[31] = data32; + + b += 32; + + offset --; + i --; + } + + posX += 16; + js --; + } + + if (n & 8) { + offset = posX - posY; + + if (offset > 0) ao1 = a + posY * 2 + (posX + 0) * lda; else ao1 = a + (posX + 0) * 2 + posY * lda; + if (offset > -1) ao2 = a + posY * 2 + (posX + 1) * lda; else ao2 = a + (posX + 1) * 2 + posY * lda; + if (offset > -2) ao3 = a + posY * 2 + (posX + 2) * lda; else ao3 = a + (posX + 2) * 2 + posY * lda; + if (offset > -3) ao4 = a + posY * 2 + (posX + 3) * lda; else ao4 = a + (posX + 3) * 2 + posY * lda; + if (offset > -4) ao5 = a + posY * 2 + (posX + 4) * lda; else ao5 = a + (posX + 4) * 2 + posY * lda; + if (offset > -5) ao6 = a + posY * 2 + (posX + 5) * lda; else ao6 = a + (posX + 5) * 2 + posY * lda; + if (offset > -6) ao7 = a + posY * 2 + (posX + 6) * lda; else ao7 = a + (posX + 6) * 2 + posY * lda; + if (offset > -7) ao8 = a + posY * 2 + (posX + 7) * lda; else ao8 = a + (posX + 7) * 2 + posY * lda; + + i = m; + + while (i > 0) { + data01 = *(ao1 + 0); + data02 = *(ao1 + 1); + data03 = *(ao2 + 0); + data04 = *(ao2 + 1); + data05 = *(ao3 + 0); + data06 = *(ao3 + 1); + data07 = *(ao4 + 0); + data08 = *(ao4 + 1); + data09 = *(ao5 + 0); + data10 = *(ao5 + 1); + data11 = *(ao6 + 0); + data12 = *(ao6 + 1); + data13 = *(ao7 + 0); + data14 = *(ao7 + 1); + data15 = *(ao8 + 0); + data16 = *(ao8 + 1); + + if (offset > 0) ao1 += 2; else ao1 += lda; + if (offset > -1) ao2 += 2; else ao2 += lda; + if (offset > -2) ao3 += 2; else ao3 += lda; + if (offset > -3) ao4 += 2; else ao4 += lda; + if (offset > -4) ao5 += 2; else ao5 += lda; + if (offset > -5) ao6 += 2; else ao6 += lda; + if (offset > -6) ao7 += 2; else ao7 += lda; + if (offset > -7) ao8 += 2; else ao8 += lda; + + b[ 0] = data01; + b[ 1] = data02; + b[ 2] = data03; + b[ 3] = data04; + b[ 4] = data05; + b[ 5] = data06; + b[ 6] = data07; + b[ 7] = data08; + b[ 8] = data09; + b[ 9] = data10; + b[10] = data11; + b[11] = data12; + b[12] = data13; + b[13] = data14; + b[14] = data15; + b[15] = data16; + + b += 16; + + offset --; + i --; + } + + posX += 8; + } + + if (n & 4) { + + offset = posX - posY; + + if (offset > 0) ao1 = a + posY * 2 + (posX + 0) * lda; else ao1 = a + (posX + 0) * 2 + posY * lda; + if (offset > -1) ao2 = a + posY * 2 + (posX + 1) * lda; else ao2 = a + (posX + 1) * 2 + posY * lda; + if (offset > -2) ao3 = a + posY * 2 + (posX + 2) * lda; else ao3 = a + (posX + 2) * 2 + posY * lda; + if (offset > -3) ao4 = a + posY * 2 + (posX + 3) * lda; else ao4 = a + (posX + 3) * 2 + posY * lda; + + i = m; + + while (i > 0) { + data01 = *(ao1 + 0); + data02 = *(ao1 + 1); + data03 = *(ao2 + 0); + data04 = *(ao2 + 1); + data05 = *(ao3 + 0); + data06 = *(ao3 + 1); + data07 = *(ao4 + 0); + data08 = *(ao4 + 1); + + if (offset > 0) ao1 += 2; else ao1 += lda; + if (offset > -1) ao2 += 2; else ao2 += lda; + if (offset > -2) ao3 += 2; else ao3 += lda; + if (offset > -3) ao4 += 2; else ao4 += lda; + + b[ 0] = data01; + b[ 1] = data02; + b[ 2] = data03; + b[ 3] = data04; + b[ 4] = data05; + b[ 5] = data06; + b[ 6] = data07; + b[ 7] = data08; + + b += 8; + + offset --; + i --; + } + + posX += 4; + } + + if (n & 2) { + + offset = posX - posY; + + if (offset > 0) ao1 = a + posY * 2 + (posX + 0) * lda; else ao1 = a + (posX + 0) * 2 + posY * lda; + if (offset > -1) ao2 = a + posY * 2 + (posX + 1) * lda; else ao2 = a + (posX + 1) * 2 + posY * lda; + + i = m; + + while (i > 0) { + data01 = *(ao1 + 0); + data02 = *(ao1 + 1); + data03 = *(ao2 + 0); + data04 = *(ao2 + 1); + + if (offset > 0) ao1 += 2; else ao1 += lda; + if (offset > -1) ao2 += 2; else ao2 += lda; + + b[ 0] = data01; + b[ 1] = data02; + b[ 2] = data03; + b[ 3] = data04; + + b += 4; + + offset --; + i --; + } + + posX += 2; + } + + if (n & 1) { + + offset = posX - posY; + + if (offset > 0) ao1 = a + posY * 2 + (posX + 0) * lda; else ao1 = a + (posX + 0) * 2 + posY * lda; + + i = m; + + while (i > 0) { + data01 = *(ao1 + 0); + data02 = *(ao1 + 1); + + if (offset > 0) ao1 += 2; else ao1 += lda; + + b[ 0] = data01; + b[ 1] = data02; + + b += 2; + + offset --; + i --; + } + + } + + return 0; +} diff --git a/kernel/generic/ztrmm_lncopy_16.c b/kernel/generic/ztrmm_lncopy_16.c new file mode 100644 index 000000000..d7fb23176 --- /dev/null +++ b/kernel/generic/ztrmm_lncopy_16.c @@ -0,0 +1,2310 @@ +/******************************************************************************* +Copyright (c) 2024, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 +#include "common.h" + +int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG posX, BLASLONG posY, FLOAT *b){ + + BLASLONG i, js; + BLASLONG X, ii; + + FLOAT *a01, *a02, *a03, *a04, *a05, *a06, *a07, *a08; + FLOAT *a09, *a10, *a11, *a12, *a13, *a14, *a15, *a16; + + lda += lda; + + js = (n >> 4); + + if (js > 0){ + do { + X = posX; + + if (posX <= posY) { + a01 = a + posY * 2 + (posX + 0) * lda; + a02 = a + posY * 2 + (posX + 1) * lda; + a03 = a + posY * 2 + (posX + 2) * lda; + a04 = a + posY * 2 + (posX + 3) * lda; + a05 = a + posY * 2 + (posX + 4) * lda; + a06 = a + posY * 2 + (posX + 5) * lda; + a07 = a + posY * 2 + (posX + 6) * lda; + a08 = a + posY * 2 + (posX + 7) * lda; + a09 = a + posY * 2 + (posX + 8) * lda; + a10 = a + posY * 2 + (posX + 9) * lda; + a11 = a + posY * 2 + (posX + 10) * lda; + a12 = a + posY * 2 + (posX + 11) * lda; + a13 = a + posY * 2 + (posX + 12) * lda; + a14 = a + posY * 2 + (posX + 13) * lda; + a15 = a + posY * 2 + (posX + 14) * lda; + a16 = a + posY * 2 + (posX + 15) * lda; + } else { + a01 = a + posX * 2 + (posY + 0) * lda; + a02 = a + posX * 2 + (posY + 1) * lda; + a03 = a + posX * 2 + (posY + 2) * lda; + a04 = a + posX * 2 + (posY + 3) * lda; + a05 = a + posX * 2 + (posY + 4) * lda; + a06 = a + posX * 2 + (posY + 5) * lda; + a07 = a + posX * 2 + (posY + 6) * lda; + a08 = a + posX * 2 + (posY + 7) * lda; + a09 = a + posX * 2 + (posY + 8) * lda; + a10 = a + posX * 2 + (posY + 9) * lda; + a11 = a + posX * 2 + (posY + 10) * lda; + a12 = a + posX * 2 + (posY + 11) * lda; + a13 = a + posX * 2 + (posY + 12) * lda; + a14 = a + posX * 2 + (posY + 13) * lda; + a15 = a + posX * 2 + (posY + 14) * lda; + a16 = a + posX * 2 + (posY + 15) * lda; + } + + i = (m >> 4); + if (i > 0) { + do { + if (X > posY) { + for (ii = 0; ii < 16; ii++){ + + b[ 0] = *(a01 + 0); + b[ 1] = *(a01 + 1); + b[ 2] = *(a02 + 0); + b[ 3] = *(a02 + 1); + b[ 4] = *(a03 + 0); + b[ 5] = *(a03 + 1); + b[ 6] = *(a04 + 0); + b[ 7] = *(a04 + 1); + + b[ 8] = *(a05 + 0); + b[ 9] = *(a05 + 1); + b[ 10] = *(a06 + 0); + b[ 11] = *(a06 + 1); + b[ 12] = *(a07 + 0); + b[ 13] = *(a07 + 1); + b[ 14] = *(a08 + 0); + b[ 15] = *(a08 + 1); + + b[ 16] = *(a09 + 0); + b[ 17] = *(a09 + 1); + b[ 18] = *(a10 + 0); + b[ 19] = *(a10 + 1); + b[ 20] = *(a11 + 0); + b[ 21] = *(a11 + 1); + b[ 22] = *(a12 + 0); + b[ 23] = *(a12 + 1); + + b[ 24] = *(a13 + 0); + b[ 25] = *(a13 + 1); + b[ 26] = *(a14 + 0); + b[ 27] = *(a14 + 1); + b[ 28] = *(a15 + 0); + b[ 29] = *(a15 + 1); + b[ 30] = *(a16 + 0); + b[ 31] = *(a16 + 1); + + a01 += 2; + a02 += 2; + a03 += 2; + a04 += 2; + a05 += 2; + a06 += 2; + a07 += 2; + a08 += 2; + a09 += 2; + a10 += 2; + a11 += 2; + a12 += 2; + a13 += 2; + a14 += 2; + a15 += 2; + a16 += 2; + b += 32; + } + } else + if (X < posY) { + a01 += 16 * lda; + a02 += 16 * lda; + a03 += 16 * lda; + a04 += 16 * lda; + a05 += 16 * lda; + a06 += 16 * lda; + a07 += 16 * lda; + a08 += 16 * lda; + a09 += 16 * lda; + a10 += 16 * lda; + a11 += 16 * lda; + a12 += 16 * lda; + a13 += 16 * lda; + a14 += 16 * lda; + a15 += 16 * lda; + a16 += 16 * lda; + + b += 512; + + } else { +#ifdef UNIT + b[ 0] = ONE; + b[ 1] = ZERO; +#else + b[ 0] = *(a01 + 0); + b[ 1] = *(a01 + 1); +#endif + b[ 2] = ZERO; + b[ 3] = ZERO; + b[ 4] = ZERO; + b[ 5] = ZERO; + b[ 6] = ZERO; + b[ 7] = ZERO; + b[ 8] = ZERO; + b[ 9] = ZERO; + b[ 10] = ZERO; + b[ 11] = ZERO; + b[ 12] = ZERO; + b[ 13] = ZERO; + b[ 14] = ZERO; + b[ 15] = ZERO; + b[ 16] = ZERO; + b[ 17] = ZERO; + b[ 18] = ZERO; + b[ 19] = ZERO; + b[ 20] = ZERO; + b[ 21] = ZERO; + b[ 22] = ZERO; + b[ 23] = ZERO; + b[ 24] = ZERO; + b[ 25] = ZERO; + b[ 26] = ZERO; + b[ 27] = ZERO; + b[ 28] = ZERO; + b[ 29] = ZERO; + b[ 30] = ZERO; + b[ 31] = ZERO; + + b[ 32] = *(a01 + 2); + b[ 33] = *(a01 + 3); +#ifdef UNIT + b[ 34] = ONE; + b[ 35] = ZERO; +#else + b[ 34] = *(a02 + 2); + b[ 35] = *(a02 + 3); +#endif + b[ 36] = ZERO; + b[ 37] = ZERO; + b[ 38] = ZERO; + b[ 39] = ZERO; + b[ 40] = ZERO; + b[ 41] = ZERO; + b[ 42] = ZERO; + b[ 43] = ZERO; + b[ 44] = ZERO; + b[ 45] = ZERO; + b[ 46] = ZERO; + b[ 47] = ZERO; + b[ 48] = ZERO; + b[ 49] = ZERO; + b[ 50] = ZERO; + b[ 51] = ZERO; + b[ 52] = ZERO; + b[ 53] = ZERO; + b[ 54] = ZERO; + b[ 55] = ZERO; + b[ 56] = ZERO; + b[ 57] = ZERO; + b[ 58] = ZERO; + b[ 59] = ZERO; + b[ 60] = ZERO; + b[ 61] = ZERO; + b[ 62] = ZERO; + b[ 63] = ZERO; + + b[ 64] = *(a01 + 4); + b[ 65] = *(a01 + 5); + b[ 66] = *(a02 + 4); + b[ 67] = *(a02 + 5); +#ifdef UNIT + b[ 68] = ONE; + b[ 69] = ZERO; +#else + b[ 68] = *(a03 + 4); + b[ 69] = *(a03 + 5); +#endif + b[ 70] = ZERO; + b[ 71] = ZERO; + b[ 72] = ZERO; + b[ 73] = ZERO; + b[ 74] = ZERO; + b[ 75] = ZERO; + b[ 76] = ZERO; + b[ 77] = ZERO; + b[ 78] = ZERO; + b[ 79] = ZERO; + b[ 80] = ZERO; + b[ 81] = ZERO; + b[ 82] = ZERO; + b[ 83] = ZERO; + b[ 84] = ZERO; + b[ 85] = ZERO; + b[ 86] = ZERO; + b[ 87] = ZERO; + b[ 88] = ZERO; + b[ 89] = ZERO; + b[ 90] = ZERO; + b[ 91] = ZERO; + b[ 92] = ZERO; + b[ 93] = ZERO; + b[ 94] = ZERO; + b[ 95] = ZERO; + + b[ 96] = *(a01 + 6); + b[ 97] = *(a01 + 7); + b[ 98] = *(a02 + 6); + b[ 99] = *(a02 + 7); + b[100] = *(a03 + 6); + b[101] = *(a03 + 7); +#ifdef UNIT + b[102] = ONE; + b[103] = ZERO; +#else + b[102] = *(a04 + 6); + b[103] = *(a04 + 7); +#endif + b[104] = ZERO; + b[105] = ZERO; + b[106] = ZERO; + b[107] = ZERO; + b[108] = ZERO; + b[109] = ZERO; + b[110] = ZERO; + b[111] = ZERO; + b[112] = ZERO; + b[113] = ZERO; + b[114] = ZERO; + b[115] = ZERO; + b[116] = ZERO; + b[117] = ZERO; + b[118] = ZERO; + b[119] = ZERO; + b[120] = ZERO; + b[121] = ZERO; + b[122] = ZERO; + b[123] = ZERO; + b[124] = ZERO; + b[125] = ZERO; + b[126] = ZERO; + b[127] = ZERO; + + b[128] = *(a01 + 8); + b[129] = *(a01 + 9); + b[130] = *(a02 + 8); + b[131] = *(a02 + 9); + b[132] = *(a03 + 8); + b[133] = *(a03 + 9); + b[134] = *(a04 + 8); + b[135] = *(a04 + 9); +#ifdef UNIT + b[136] = ONE; + b[137] = ZERO; +#else + b[136] = *(a05 + 8); + b[137] = *(a05 + 9); +#endif + b[138] = ZERO; + b[139] = ZERO; + b[140] = ZERO; + b[141] = ZERO; + b[142] = ZERO; + b[143] = ZERO; + b[144] = ZERO; + b[145] = ZERO; + b[146] = ZERO; + b[147] = ZERO; + b[148] = ZERO; + b[149] = ZERO; + b[150] = ZERO; + b[151] = ZERO; + b[152] = ZERO; + b[153] = ZERO; + b[154] = ZERO; + b[155] = ZERO; + b[156] = ZERO; + b[157] = ZERO; + b[158] = ZERO; + b[159] = ZERO; + + b[160] = *(a01 + 10); + b[161] = *(a01 + 11); + b[162] = *(a02 + 10); + b[163] = *(a02 + 11); + b[164] = *(a03 + 10); + b[165] = *(a03 + 11); + b[166] = *(a04 + 10); + b[167] = *(a04 + 11); + b[168] = *(a05 + 10); + b[169] = *(a05 + 11); +#ifdef UNIT + b[170] = ONE; + b[171] = ZERO; +#else + b[170] = *(a06 + 10); + b[171] = *(a06 + 11); +#endif + b[172] = ZERO; + b[173] = ZERO; + b[174] = ZERO; + b[175] = ZERO; + b[176] = ZERO; + b[177] = ZERO; + b[178] = ZERO; + b[179] = ZERO; + b[180] = ZERO; + b[181] = ZERO; + b[182] = ZERO; + b[183] = ZERO; + b[184] = ZERO; + b[185] = ZERO; + b[186] = ZERO; + b[187] = ZERO; + b[188] = ZERO; + b[189] = ZERO; + b[190] = ZERO; + b[191] = ZERO; + + b[192] = *(a01 + 12); + b[193] = *(a01 + 13); + b[194] = *(a02 + 12); + b[195] = *(a02 + 13); + b[196] = *(a03 + 12); + b[197] = *(a03 + 13); + b[198] = *(a04 + 12); + b[199] = *(a04 + 13); + b[200] = *(a05 + 12); + b[201] = *(a05 + 13); + b[202] = *(a06 + 12); + b[203] = *(a06 + 13); +#ifdef UNIT + b[204] = ONE; + b[205] = ZERO; +#else + b[204] = *(a07 + 12); + b[205] = *(a07 + 13); +#endif + b[206] = ZERO; + b[207] = ZERO; + b[208] = ZERO; + b[209] = ZERO; + b[210] = ZERO; + b[211] = ZERO; + b[212] = ZERO; + b[213] = ZERO; + b[214] = ZERO; + b[215] = ZERO; + b[216] = ZERO; + b[217] = ZERO; + b[218] = ZERO; + b[219] = ZERO; + b[220] = ZERO; + b[221] = ZERO; + b[222] = ZERO; + b[223] = ZERO; + + b[224] = *(a01 + 14); + b[225] = *(a01 + 15); + b[226] = *(a02 + 14); + b[227] = *(a02 + 15); + b[228] = *(a03 + 14); + b[229] = *(a03 + 15); + b[230] = *(a04 + 14); + b[231] = *(a04 + 15); + b[232] = *(a05 + 14); + b[233] = *(a05 + 15); + b[234] = *(a06 + 14); + b[235] = *(a06 + 15); + b[236] = *(a07 + 14); + b[237] = *(a07 + 15); +#ifdef UNIT + b[238] = ONE; + b[239] = ZERO; +#else + b[238] = *(a08 + 14); + b[239] = *(a08 + 15); +#endif + b[240] = ZERO; + b[241] = ZERO; + b[242] = ZERO; + b[243] = ZERO; + b[244] = ZERO; + b[245] = ZERO; + b[246] = ZERO; + b[247] = ZERO; + b[248] = ZERO; + b[249] = ZERO; + b[250] = ZERO; + b[251] = ZERO; + b[252] = ZERO; + b[253] = ZERO; + b[254] = ZERO; + b[255] = ZERO; + + b[256] = *(a01 + 16); + b[257] = *(a01 + 17); + b[258] = *(a02 + 16); + b[259] = *(a02 + 17); + b[260] = *(a03 + 16); + b[261] = *(a03 + 17); + b[262] = *(a04 + 16); + b[263] = *(a04 + 17); + b[264] = *(a05 + 16); + b[265] = *(a05 + 17); + b[266] = *(a06 + 16); + b[267] = *(a06 + 17); + b[268] = *(a07 + 16); + b[269] = *(a07 + 17); + b[270] = *(a08 + 16); + b[271] = *(a08 + 17); +#ifdef UNIT + b[272] = ONE; + b[273] = ZERO; +#else + b[272] = *(a09 + 16); + b[273] = *(a09 + 17); +#endif + b[274] = ZERO; + b[275] = ZERO; + b[276] = ZERO; + b[277] = ZERO; + b[278] = ZERO; + b[279] = ZERO; + b[280] = ZERO; + b[281] = ZERO; + b[282] = ZERO; + b[283] = ZERO; + b[284] = ZERO; + b[285] = ZERO; + b[286] = ZERO; + b[287] = ZERO; + + b[288] = *(a01 + 18); + b[289] = *(a01 + 19); + b[290] = *(a02 + 18); + b[291] = *(a02 + 19); + b[292] = *(a03 + 18); + b[293] = *(a03 + 19); + b[294] = *(a04 + 18); + b[295] = *(a04 + 19); + b[296] = *(a05 + 18); + b[297] = *(a05 + 19); + b[298] = *(a06 + 18); + b[299] = *(a06 + 19); + b[300] = *(a07 + 18); + b[301] = *(a07 + 19); + b[302] = *(a08 + 18); + b[303] = *(a08 + 19); + b[304] = *(a09 + 18); + b[305] = *(a09 + 19); +#ifdef UNIT + b[306] = ONE; + b[307] = ZERO; +#else + b[306] = *(a10 + 18); + b[307] = *(a10 + 19); +#endif + b[308] = ZERO; + b[309] = ZERO; + b[310] = ZERO; + b[311] = ZERO; + b[312] = ZERO; + b[313] = ZERO; + b[314] = ZERO; + b[315] = ZERO; + b[316] = ZERO; + b[317] = ZERO; + b[318] = ZERO; + b[319] = ZERO; + + b[320] = *(a01 + 20); + b[321] = *(a01 + 21); + b[322] = *(a02 + 20); + b[323] = *(a02 + 21); + b[324] = *(a03 + 20); + b[325] = *(a03 + 21); + b[326] = *(a04 + 20); + b[327] = *(a04 + 21); + b[328] = *(a05 + 20); + b[329] = *(a05 + 21); + b[330] = *(a06 + 20); + b[331] = *(a06 + 21); + b[332] = *(a07 + 20); + b[333] = *(a07 + 21); + b[334] = *(a08 + 20); + b[335] = *(a08 + 21); + b[336] = *(a09 + 20); + b[337] = *(a09 + 21); + b[338] = *(a10 + 20); + b[339] = *(a10 + 21); +#ifdef UNIT + b[340] = ONE; + b[341] = ZERO; +#else + b[340] = *(a11 + 20); + b[341] = *(a11 + 21); +#endif + b[342] = ZERO; + b[343] = ZERO; + b[344] = ZERO; + b[345] = ZERO; + b[346] = ZERO; + b[347] = ZERO; + b[348] = ZERO; + b[349] = ZERO; + b[350] = ZERO; + b[351] = ZERO; + + b[352] = *(a01 + 22); + b[353] = *(a01 + 23); + b[354] = *(a02 + 22); + b[355] = *(a02 + 23); + b[356] = *(a03 + 22); + b[357] = *(a03 + 23); + b[358] = *(a04 + 22); + b[359] = *(a04 + 23); + b[360] = *(a05 + 22); + b[361] = *(a05 + 23); + b[362] = *(a06 + 22); + b[363] = *(a06 + 23); + b[364] = *(a07 + 22); + b[365] = *(a07 + 23); + b[366] = *(a08 + 22); + b[367] = *(a08 + 23); + b[368] = *(a09 + 22); + b[369] = *(a09 + 23); + b[370] = *(a10 + 22); + b[371] = *(a10 + 23); + b[372] = *(a11 + 22); + b[373] = *(a11 + 23); +#ifdef UNIT + b[374] = ONE; + b[375] = ZERO; +#else + b[374] = *(a12 + 22); + b[375] = *(a12 + 23); +#endif + b[376] = ZERO; + b[377] = ZERO; + b[378] = ZERO; + b[379] = ZERO; + b[380] = ZERO; + b[381] = ZERO; + b[382] = ZERO; + b[383] = ZERO; + + b[384] = *(a01 + 24); + b[385] = *(a01 + 25); + b[386] = *(a02 + 24); + b[387] = *(a02 + 25); + b[388] = *(a03 + 24); + b[389] = *(a03 + 25); + b[390] = *(a04 + 24); + b[391] = *(a04 + 25); + b[392] = *(a05 + 24); + b[393] = *(a05 + 25); + b[394] = *(a06 + 24); + b[395] = *(a06 + 25); + b[396] = *(a07 + 24); + b[397] = *(a07 + 25); + b[398] = *(a08 + 24); + b[399] = *(a08 + 25); + b[400] = *(a09 + 24); + b[401] = *(a09 + 25); + b[402] = *(a10 + 24); + b[403] = *(a10 + 25); + b[404] = *(a11 + 24); + b[405] = *(a11 + 25); + b[406] = *(a12 + 24); + b[407] = *(a12 + 25); +#ifdef UNIT + b[408] = ONE; + b[409] = ZERO; +#else + b[408] = *(a13 + 24); + b[409] = *(a13 + 25); +#endif + b[410] = ZERO; + b[411] = ZERO; + b[412] = ZERO; + b[413] = ZERO; + b[414] = ZERO; + b[415] = ZERO; + + b[416] = *(a01 + 26); + b[417] = *(a01 + 27); + b[418] = *(a02 + 26); + b[419] = *(a02 + 27); + b[420] = *(a03 + 26); + b[421] = *(a03 + 27); + b[422] = *(a04 + 26); + b[423] = *(a04 + 27); + b[424] = *(a05 + 26); + b[425] = *(a05 + 27); + b[426] = *(a06 + 26); + b[427] = *(a06 + 27); + b[428] = *(a07 + 26); + b[429] = *(a07 + 27); + b[430] = *(a08 + 26); + b[431] = *(a08 + 27); + b[432] = *(a09 + 26); + b[433] = *(a09 + 27); + b[434] = *(a10 + 26); + b[435] = *(a10 + 27); + b[436] = *(a11 + 26); + b[437] = *(a11 + 27); + b[438] = *(a12 + 26); + b[439] = *(a12 + 27); + b[440] = *(a13 + 26); + b[441] = *(a13 + 27); +#ifdef UNIT + b[442] = ONE; + b[443] = ZERO; +#else + b[442] = *(a14 + 26); + b[443] = *(a14 + 27); +#endif + b[444] = ZERO; + b[445] = ZERO; + b[446] = ZERO; + b[447] = ZERO; + + b[448] = *(a01 + 28); + b[449] = *(a01 + 29); + b[450] = *(a02 + 28); + b[451] = *(a02 + 29); + b[452] = *(a03 + 28); + b[453] = *(a03 + 29); + b[454] = *(a04 + 28); + b[455] = *(a04 + 29); + b[456] = *(a05 + 28); + b[457] = *(a05 + 29); + b[458] = *(a06 + 28); + b[459] = *(a06 + 29); + b[460] = *(a07 + 28); + b[461] = *(a07 + 29); + b[462] = *(a08 + 28); + b[463] = *(a08 + 29); + b[464] = *(a09 + 28); + b[465] = *(a09 + 29); + b[466] = *(a10 + 28); + b[467] = *(a10 + 29); + b[468] = *(a11 + 28); + b[469] = *(a11 + 29); + b[470] = *(a12 + 28); + b[471] = *(a12 + 29); + b[472] = *(a13 + 28); + b[473] = *(a13 + 29); + b[474] = *(a14 + 28); + b[475] = *(a14 + 29); +#ifdef UNIT + b[476] = ONE; + b[477] = ZERO; +#else + b[476] = *(a15 + 28); + b[477] = *(a15 + 29); +#endif + b[478] = ZERO; + b[479] = ZERO; + + b[480] = *(a01 + 30); + b[481] = *(a01 + 31); + b[482] = *(a02 + 30); + b[483] = *(a02 + 31); + b[484] = *(a03 + 30); + b[485] = *(a03 + 31); + b[486] = *(a04 + 30); + b[487] = *(a04 + 31); + b[488] = *(a05 + 30); + b[489] = *(a05 + 31); + b[490] = *(a06 + 30); + b[491] = *(a06 + 31); + b[492] = *(a07 + 30); + b[493] = *(a07 + 31); + b[494] = *(a08 + 30); + b[495] = *(a08 + 31); + b[496] = *(a09 + 30); + b[497] = *(a09 + 31); + b[498] = *(a10 + 30); + b[499] = *(a10 + 31); + b[500] = *(a11 + 30); + b[501] = *(a11 + 31); + b[502] = *(a12 + 30); + b[503] = *(a12 + 31); + b[504] = *(a13 + 30); + b[505] = *(a13 + 31); + b[506] = *(a14 + 30); + b[507] = *(a14 + 31); + b[508] = *(a15 + 30); + b[509] = *(a15 + 31); +#ifdef UNIT + b[510] = ONE; + b[511] = ZERO; +#else + b[510] = *(a16 + 30); + b[511] = *(a16 + 31); +#endif + + a01 += 32; + a02 += 32; + a03 += 32; + a04 += 32; + a05 += 32; + a06 += 32; + a07 += 32; + a08 += 32; + a09 += 32; + a10 += 32; + a11 += 32; + a12 += 32; + a13 += 32; + a14 += 32; + a15 += 32; + a16 += 32; + b += 512; + } + + X += 16; + i --; + } while (i > 0); + } + + i = (m & 15); + if (i) { + + if (X > posY) { + + for (ii = 0; ii < i; ii++){ + b[ 0] = *(a01 + 0); + b[ 1] = *(a01 + 1); + b[ 2] = *(a02 + 0); + b[ 3] = *(a02 + 1); + b[ 4] = *(a03 + 0); + b[ 5] = *(a03 + 1); + b[ 6] = *(a04 + 0); + b[ 7] = *(a04 + 1); + b[ 8] = *(a05 + 0); + b[ 9] = *(a05 + 1); + b[ 10] = *(a06 + 0); + b[ 11] = *(a06 + 1); + b[ 12] = *(a07 + 0); + b[ 13] = *(a07 + 1); + b[ 14] = *(a08 + 0); + b[ 15] = *(a08 + 1); + + b[ 16] = *(a09 + 0); + b[ 17] = *(a09 + 1); + b[ 18] = *(a10 + 0); + b[ 19] = *(a10 + 1); + b[ 20] = *(a11 + 0); + b[ 21] = *(a11 + 1); + b[ 22] = *(a12 + 0); + b[ 23] = *(a12 + 1); + b[ 24] = *(a13 + 0); + b[ 25] = *(a13 + 1); + b[ 26] = *(a14 + 0); + b[ 27] = *(a14 + 1); + b[ 28] = *(a15 + 0); + b[ 29] = *(a15 + 1); + b[ 30] = *(a16 + 0); + b[ 31] = *(a16 + 1); + + a01 += 2; + a02 += 2; + a03 += 2; + a04 += 2; + a05 += 2; + a06 += 2; + a07 += 2; + a08 += 2; + a09 += 2; + a10 += 2; + a11 += 2; + a12 += 2; + a13 += 2; + a14 += 2; + a15 += 2; + a16 += 2; + b += 32; + } + } else + if (X < posY) { + /* a01 += i * lda; + a02 += i * lda; + a03 += i * lda; + a04 += i * lda; + a05 += i * lda; + a06 += i * lda; + a07 += i * lda; + a08 += i * lda; + a09 += i * lda; + a10 += i * lda; + a11 += i * lda; + a12 += i * lda; + a13 += i * lda; + a14 += i * lda; + a15 += i * lda; + a16 += i * lda; */ + b += 32 * i; + } else { +#ifdef UNIT + b[ 0] = ONE; + b[ 1] = ZERO; +#else + b[ 0] = *(a01 + 0); + b[ 1] = *(a01 + 1); +#endif + b[ 2] = ZERO; + b[ 3] = ZERO; + b[ 4] = ZERO; + b[ 5] = ZERO; + b[ 6] = ZERO; + b[ 7] = ZERO; + b[ 8] = ZERO; + b[ 9] = ZERO; + b[ 10] = ZERO; + b[ 11] = ZERO; + b[ 12] = ZERO; + b[ 13] = ZERO; + b[ 14] = ZERO; + b[ 15] = ZERO; + b[ 16] = ZERO; + b[ 17] = ZERO; + b[ 18] = ZERO; + b[ 19] = ZERO; + b[ 20] = ZERO; + b[ 21] = ZERO; + b[ 22] = ZERO; + b[ 23] = ZERO; + b[ 24] = ZERO; + b[ 25] = ZERO; + b[ 26] = ZERO; + b[ 27] = ZERO; + b[ 28] = ZERO; + b[ 29] = ZERO; + b[ 30] = ZERO; + b[ 31] = ZERO; + b += 32; + + if (i >= 2) { + b[ 0] = *(a01 + 2); + b[ 1] = *(a01 + 3); +#ifdef UNIT + b[ 2] = ONE; + b[ 3] = ZERO; +#else + b[ 2] = *(a02 + 2); + b[ 3] = *(a02 + 3); +#endif + b[ 4] = ZERO; + b[ 5] = ZERO; + b[ 6] = ZERO; + b[ 7] = ZERO; + b[ 8] = ZERO; + b[ 9] = ZERO; + b[ 10] = ZERO; + b[ 11] = ZERO; + b[ 12] = ZERO; + b[ 13] = ZERO; + b[ 14] = ZERO; + b[ 15] = ZERO; + b[ 16] = ZERO; + b[ 17] = ZERO; + b[ 18] = ZERO; + b[ 19] = ZERO; + b[ 20] = ZERO; + b[ 21] = ZERO; + b[ 22] = ZERO; + b[ 23] = ZERO; + b[ 24] = ZERO; + b[ 25] = ZERO; + b[ 26] = ZERO; + b[ 27] = ZERO; + b[ 28] = ZERO; + b[ 29] = ZERO; + b[ 30] = ZERO; + b[ 31] = ZERO; + b += 32; + } + + if (i >= 3) { + b[ 0] = *(a01 + 4); + b[ 1] = *(a01 + 5); + b[ 2] = *(a02 + 4); + b[ 3] = *(a02 + 5); +#ifdef UNIT + b[ 4] = ONE; + b[ 5] = ZERO; +#else + b[ 4] = *(a03 + 4); + b[ 5] = *(a03 + 5); +#endif + b[ 6] = ZERO; + b[ 7] = ZERO; + b[ 8] = ZERO; + b[ 9] = ZERO; + b[ 10] = ZERO; + b[ 11] = ZERO; + b[ 12] = ZERO; + b[ 13] = ZERO; + b[ 14] = ZERO; + b[ 15] = ZERO; + b[ 16] = ZERO; + b[ 17] = ZERO; + b[ 18] = ZERO; + b[ 19] = ZERO; + b[ 20] = ZERO; + b[ 21] = ZERO; + b[ 22] = ZERO; + b[ 23] = ZERO; + b[ 24] = ZERO; + b[ 25] = ZERO; + b[ 26] = ZERO; + b[ 27] = ZERO; + b[ 28] = ZERO; + b[ 29] = ZERO; + b[ 30] = ZERO; + b[ 31] = ZERO; + b += 32; + } + + if (i >= 4) { + b[ 0] = *(a01 + 6); + b[ 1] = *(a01 + 7); + b[ 2] = *(a02 + 6); + b[ 3] = *(a02 + 7); + b[ 4] = *(a03 + 6); + b[ 5] = *(a03 + 7); +#ifdef UNIT + b[ 6] = ONE; + b[ 7] = ZERO; +#else + b[ 6] = *(a04 + 6); + b[ 7] = *(a04 + 7); +#endif + b[ 8] = ZERO; + b[ 9] = ZERO; + b[ 10] = ZERO; + b[ 11] = ZERO; + b[ 12] = ZERO; + b[ 13] = ZERO; + b[ 14] = ZERO; + b[ 15] = ZERO; + b[ 16] = ZERO; + b[ 17] = ZERO; + b[ 18] = ZERO; + b[ 19] = ZERO; + b[ 20] = ZERO; + b[ 21] = ZERO; + b[ 22] = ZERO; + b[ 23] = ZERO; + b[ 24] = ZERO; + b[ 25] = ZERO; + b[ 26] = ZERO; + b[ 27] = ZERO; + b[ 28] = ZERO; + b[ 29] = ZERO; + b[ 30] = ZERO; + b[ 31] = ZERO; + b += 32; + } + + if (i >= 5) { + b[ 0] = *(a01 + 8); + b[ 1] = *(a01 + 9); + b[ 2] = *(a02 + 8); + b[ 3] = *(a02 + 9); + b[ 4] = *(a03 + 8); + b[ 5] = *(a03 + 9); + b[ 6] = *(a04 + 8); + b[ 7] = *(a04 + 9); +#ifdef UNIT + b[ 8] = ONE; + b[ 9] = ZERO; +#else + b[ 8] = *(a05 + 8); + b[ 9] = *(a05 + 9); +#endif + b[ 10] = ZERO; + b[ 11] = ZERO; + b[ 12] = ZERO; + b[ 13] = ZERO; + b[ 14] = ZERO; + b[ 15] = ZERO; + b[ 16] = ZERO; + b[ 17] = ZERO; + b[ 18] = ZERO; + b[ 19] = ZERO; + b[ 20] = ZERO; + b[ 21] = ZERO; + b[ 22] = ZERO; + b[ 23] = ZERO; + b[ 24] = ZERO; + b[ 25] = ZERO; + b[ 26] = ZERO; + b[ 27] = ZERO; + b[ 28] = ZERO; + b[ 29] = ZERO; + b[ 30] = ZERO; + b[ 31] = ZERO; + b += 32; + } + + if (i >= 6) { + b[ 0] = *(a01 + 10); + b[ 1] = *(a01 + 11); + b[ 2] = *(a02 + 10); + b[ 3] = *(a02 + 11); + b[ 4] = *(a03 + 10); + b[ 5] = *(a03 + 11); + b[ 6] = *(a04 + 10); + b[ 7] = *(a04 + 11); + b[ 8] = *(a05 + 10); + b[ 9] = *(a05 + 11); +#ifdef UNIT + b[10] = ONE; + b[11] = ZERO; +#else + b[10] = *(a06 + 10); + b[11] = *(a06 + 11); +#endif + b[ 12] = ZERO; + b[ 13] = ZERO; + b[ 14] = ZERO; + b[ 15] = ZERO; + b[ 16] = ZERO; + b[ 17] = ZERO; + b[ 18] = ZERO; + b[ 19] = ZERO; + b[ 20] = ZERO; + b[ 21] = ZERO; + b[ 22] = ZERO; + b[ 23] = ZERO; + b[ 24] = ZERO; + b[ 25] = ZERO; + b[ 26] = ZERO; + b[ 27] = ZERO; + b[ 28] = ZERO; + b[ 29] = ZERO; + b[ 30] = ZERO; + b[ 31] = ZERO; + b += 32; + } + + if (i >= 7) { + b[ 0] = *(a01 + 12); + b[ 1] = *(a01 + 13); + b[ 2] = *(a02 + 12); + b[ 3] = *(a02 + 13); + b[ 4] = *(a03 + 12); + b[ 5] = *(a03 + 13); + b[ 6] = *(a04 + 12); + b[ 7] = *(a04 + 13); + b[ 8] = *(a05 + 12); + b[ 9] = *(a05 + 13); + b[10] = *(a06 + 12); + b[11] = *(a06 + 13); +#ifdef UNIT + b[12] = ONE; + b[13] = ZERO; +#else + b[12] = *(a07 + 12); + b[13] = *(a07 + 13); +#endif + b[ 14] = ZERO; + b[ 15] = ZERO; + b[ 16] = ZERO; + b[ 17] = ZERO; + b[ 18] = ZERO; + b[ 19] = ZERO; + b[ 20] = ZERO; + b[ 21] = ZERO; + b[ 22] = ZERO; + b[ 23] = ZERO; + b[ 24] = ZERO; + b[ 25] = ZERO; + b[ 26] = ZERO; + b[ 27] = ZERO; + b[ 28] = ZERO; + b[ 29] = ZERO; + b[ 30] = ZERO; + b[ 31] = ZERO; + b += 32; + } + + if (i >= 8) { + b[ 0] = *(a01 + 14); + b[ 1] = *(a01 + 15); + b[ 2] = *(a02 + 14); + b[ 3] = *(a02 + 15); + b[ 4] = *(a03 + 14); + b[ 5] = *(a03 + 15); + b[ 6] = *(a04 + 14); + b[ 7] = *(a04 + 15); + b[ 8] = *(a05 + 14); + b[ 9] = *(a05 + 15); + b[ 10] = *(a06 + 14); + b[ 11] = *(a06 + 15); + b[ 12] = *(a07 + 14); + b[ 13] = *(a07 + 15); +#ifdef UNIT + b[ 14] = ONE; + b[ 15] = ZERO; +#else + b[ 14] = *(a08 + 14); + b[ 15] = *(a08 + 15); +#endif + b[ 16] = ZERO; + b[ 17] = ZERO; + b[ 18] = ZERO; + b[ 19] = ZERO; + b[ 20] = ZERO; + b[ 21] = ZERO; + b[ 22] = ZERO; + b[ 23] = ZERO; + b[ 24] = ZERO; + b[ 25] = ZERO; + b[ 26] = ZERO; + b[ 27] = ZERO; + b[ 28] = ZERO; + b[ 29] = ZERO; + b[ 30] = ZERO; + b[ 31] = ZERO; + b += 32; + } + + if (i >= 9) { + b[ 0] = *(a01 + 16); + b[ 1] = *(a01 + 17); + b[ 2] = *(a02 + 16); + b[ 3] = *(a02 + 17); + b[ 4] = *(a03 + 16); + b[ 5] = *(a03 + 17); + b[ 6] = *(a04 + 16); + b[ 7] = *(a04 + 17); + b[ 8] = *(a05 + 16); + b[ 9] = *(a05 + 17); + b[ 10] = *(a06 + 16); + b[ 11] = *(a06 + 17); + b[ 12] = *(a07 + 16); + b[ 13] = *(a07 + 17); + b[ 14] = *(a08 + 16); + b[ 15] = *(a08 + 17); +#ifdef UNIT + b[ 16] = ONE; + b[ 17] = ZERO; +#else + b[ 16] = *(a09 + 16); + b[ 17] = *(a09 + 17); +#endif + b[ 18] = ZERO; + b[ 19] = ZERO; + b[ 20] = ZERO; + b[ 21] = ZERO; + b[ 22] = ZERO; + b[ 23] = ZERO; + b[ 24] = ZERO; + b[ 25] = ZERO; + b[ 26] = ZERO; + b[ 27] = ZERO; + b[ 28] = ZERO; + b[ 29] = ZERO; + b[ 30] = ZERO; + b[ 31] = ZERO; + b += 32; + } + + if (i >= 10) { + b[ 0] = *(a01 + 18); + b[ 1] = *(a01 + 19); + b[ 2] = *(a02 + 18); + b[ 3] = *(a02 + 19); + b[ 4] = *(a03 + 18); + b[ 5] = *(a03 + 19); + b[ 6] = *(a04 + 18); + b[ 7] = *(a04 + 19); + b[ 8] = *(a05 + 18); + b[ 9] = *(a05 + 19); + b[ 10] = *(a06 + 18); + b[ 11] = *(a06 + 19); + b[ 12] = *(a07 + 18); + b[ 13] = *(a07 + 19); + b[ 14] = *(a08 + 18); + b[ 15] = *(a08 + 19); + b[ 16] = *(a09 + 18); + b[ 17] = *(a09 + 19); +#ifdef UNIT + b[ 18] = ONE; + b[ 19] = ZERO; +#else + b[ 18] = *(a10 + 18); + b[ 19] = *(a10 + 19); +#endif + b[ 20] = ZERO; + b[ 21] = ZERO; + b[ 22] = ZERO; + b[ 23] = ZERO; + b[ 24] = ZERO; + b[ 25] = ZERO; + b[ 26] = ZERO; + b[ 27] = ZERO; + b[ 28] = ZERO; + b[ 29] = ZERO; + b[ 30] = ZERO; + b[ 31] = ZERO; + b += 32; + } + + if (i >= 11) { + b[ 0] = *(a01 + 20); + b[ 1] = *(a01 + 21); + b[ 2] = *(a02 + 20); + b[ 3] = *(a02 + 21); + b[ 4] = *(a03 + 20); + b[ 5] = *(a03 + 21); + b[ 6] = *(a04 + 20); + b[ 7] = *(a04 + 21); + b[ 8] = *(a05 + 20); + b[ 9] = *(a05 + 21); + b[ 10] = *(a06 + 20); + b[ 11] = *(a06 + 21); + b[ 12] = *(a07 + 20); + b[ 13] = *(a07 + 21); + b[ 14] = *(a08 + 20); + b[ 15] = *(a08 + 21); + b[ 16] = *(a09 + 20); + b[ 17] = *(a09 + 21); + b[ 18] = *(a10 + 20); + b[ 19] = *(a10 + 21); +#ifdef UNIT + b[ 20] = ONE; + b[ 21] = ZERO; +#else + b[ 20] = *(a11 + 20); + b[ 21] = *(a11 + 21); +#endif + b[ 22] = ZERO; + b[ 23] = ZERO; + b[ 24] = ZERO; + b[ 25] = ZERO; + b[ 26] = ZERO; + b[ 27] = ZERO; + b[ 28] = ZERO; + b[ 29] = ZERO; + b[ 30] = ZERO; + b[ 31] = ZERO; + b += 32; + } + + if (i >= 12) { + b[ 0] = *(a01 + 22); + b[ 1] = *(a01 + 23); + b[ 2] = *(a02 + 22); + b[ 3] = *(a02 + 23); + b[ 4] = *(a03 + 22); + b[ 5] = *(a03 + 23); + b[ 6] = *(a04 + 22); + b[ 7] = *(a04 + 23); + b[ 8] = *(a05 + 22); + b[ 9] = *(a05 + 23); + b[ 10] = *(a06 + 22); + b[ 11] = *(a06 + 23); + b[ 12] = *(a07 + 22); + b[ 13] = *(a07 + 23); + b[ 14] = *(a08 + 22); + b[ 15] = *(a08 + 23); + b[ 16] = *(a09 + 22); + b[ 17] = *(a09 + 23); + b[ 18] = *(a10 + 22); + b[ 19] = *(a10 + 23); + b[ 20] = *(a11 + 22); + b[ 21] = *(a11 + 23); +#ifdef UNIT + b[ 22] = ONE; + b[ 23] = ZERO; +#else + b[ 22] = *(a12 + 22); + b[ 23] = *(a12 + 23); +#endif + b[ 24] = ZERO; + b[ 25] = ZERO; + b[ 26] = ZERO; + b[ 27] = ZERO; + b[ 28] = ZERO; + b[ 29] = ZERO; + b[ 30] = ZERO; + b[ 31] = ZERO; + b += 32; + } + + if (i >= 13) { + b[ 0] = *(a01 + 24); + b[ 1] = *(a01 + 25); + b[ 2] = *(a02 + 24); + b[ 3] = *(a02 + 25); + b[ 4] = *(a03 + 24); + b[ 5] = *(a03 + 25); + b[ 6] = *(a04 + 24); + b[ 7] = *(a04 + 25); + b[ 8] = *(a05 + 24); + b[ 9] = *(a05 + 25); + b[ 10] = *(a06 + 24); + b[ 11] = *(a06 + 25); + b[ 12] = *(a07 + 24); + b[ 13] = *(a07 + 25); + b[ 14] = *(a08 + 24); + b[ 15] = *(a08 + 25); + b[ 16] = *(a09 + 24); + b[ 17] = *(a09 + 25); + b[ 18] = *(a10 + 24); + b[ 19] = *(a10 + 25); + b[ 20] = *(a11 + 24); + b[ 21] = *(a11 + 25); + b[ 22] = *(a12 + 24); + b[ 23] = *(a12 + 25); +#ifdef UNIT + b[ 24] = ONE; + b[ 25] = ZERO; +#else + b[ 24] = *(a13 + 24); + b[ 25] = *(a13 + 25); +#endif + b[ 26] = ZERO; + b[ 27] = ZERO; + b[ 28] = ZERO; + b[ 29] = ZERO; + b[ 30] = ZERO; + b[ 31] = ZERO; + b += 32; + } + + if (i >= 14) { + b[ 0] = *(a01 + 26); + b[ 1] = *(a01 + 27); + b[ 2] = *(a02 + 26); + b[ 3] = *(a02 + 27); + b[ 4] = *(a03 + 26); + b[ 5] = *(a03 + 27); + b[ 6] = *(a04 + 26); + b[ 7] = *(a04 + 27); + b[ 8] = *(a05 + 26); + b[ 9] = *(a05 + 27); + b[ 10] = *(a06 + 26); + b[ 11] = *(a06 + 27); + b[ 12] = *(a07 + 26); + b[ 13] = *(a07 + 27); + b[ 14] = *(a08 + 26); + b[ 15] = *(a08 + 27); + b[ 16] = *(a09 + 26); + b[ 17] = *(a09 + 27); + b[ 18] = *(a10 + 26); + b[ 19] = *(a10 + 27); + b[ 20] = *(a11 + 26); + b[ 21] = *(a11 + 27); + b[ 22] = *(a12 + 26); + b[ 23] = *(a12 + 27); + b[ 24] = *(a13 + 26); + b[ 25] = *(a13 + 27); +#ifdef UNIT + b[ 26] = ONE; + b[ 27] = ZERO; +#else + b[ 26] = *(a14 + 26); + b[ 27] = *(a14 + 27); +#endif + b[ 28] = ZERO; + b[ 29] = ZERO; + b[ 30] = ZERO; + b[ 31] = ZERO; + b += 32; + } + + if (i >= 15) { + b[ 0] = *(a01 + 28); + b[ 1] = *(a01 + 29); + b[ 2] = *(a02 + 28); + b[ 3] = *(a02 + 29); + b[ 4] = *(a03 + 28); + b[ 5] = *(a03 + 29); + b[ 6] = *(a04 + 28); + b[ 7] = *(a04 + 29); + b[ 8] = *(a05 + 28); + b[ 9] = *(a05 + 29); + b[ 10] = *(a06 + 28); + b[ 11] = *(a06 + 29); + b[ 12] = *(a07 + 28); + b[ 13] = *(a07 + 29); + b[ 14] = *(a08 + 28); + b[ 15] = *(a08 + 29); + b[ 16] = *(a09 + 28); + b[ 17] = *(a09 + 29); + b[ 18] = *(a10 + 28); + b[ 19] = *(a10 + 29); + b[ 20] = *(a11 + 28); + b[ 21] = *(a11 + 29); + b[ 22] = *(a12 + 28); + b[ 23] = *(a12 + 29); + b[ 24] = *(a13 + 28); + b[ 25] = *(a13 + 29); + b[ 26] = *(a14 + 28); + b[ 27] = *(a14 + 29); +#ifdef UNIT + b[ 28] = ONE; + b[ 29] = ZERO; +#else + b[ 28] = *(a15 + 28); + b[ 29] = *(a15 + 29); +#endif + b[ 30] = ZERO; + b[ 31] = ZERO; + b += 32; + } + } + } + + posY += 16; + js --; + } while (js > 0); + } /* End of main loop */ + + + if (n & 8){ + X = posX; + + if (posX <= posY) { + a01 = a + posY * 2 + (posX + 0) * lda; + a02 = a + posY * 2 + (posX + 1) * lda; + a03 = a + posY * 2 + (posX + 2) * lda; + a04 = a + posY * 2 + (posX + 3) * lda; + a05 = a + posY * 2 + (posX + 4) * lda; + a06 = a + posY * 2 + (posX + 5) * lda; + a07 = a + posY * 2 + (posX + 6) * lda; + a08 = a + posY * 2 + (posX + 7) * lda; + } else { + a01 = a + posX * 2 + (posY + 0) * lda; + a02 = a + posX * 2 + (posY + 1) * lda; + a03 = a + posX * 2 + (posY + 2) * lda; + a04 = a + posX * 2 + (posY + 3) * lda; + a05 = a + posX * 2 + (posY + 4) * lda; + a06 = a + posX * 2 + (posY + 5) * lda; + a07 = a + posX * 2 + (posY + 6) * lda; + a08 = a + posX * 2 + (posY + 7) * lda; + } + + i = (m >> 3); + if (i > 0) { + do { + if (X > posY) { + for (ii = 0; ii < 8; ii++){ + + b[ 0] = *(a01 + 0); + b[ 1] = *(a01 + 1); + b[ 2] = *(a02 + 0); + b[ 3] = *(a02 + 1); + b[ 4] = *(a03 + 0); + b[ 5] = *(a03 + 1); + b[ 6] = *(a04 + 0); + b[ 7] = *(a04 + 1); + + b[ 8] = *(a05 + 0); + b[ 9] = *(a05 + 1); + b[ 10] = *(a06 + 0); + b[ 11] = *(a06 + 1); + b[ 12] = *(a07 + 0); + b[ 13] = *(a07 + 1); + b[ 14] = *(a08 + 0); + b[ 15] = *(a08 + 1); + + a01 += 2; + a02 += 2; + a03 += 2; + a04 += 2; + a05 += 2; + a06 += 2; + a07 += 2; + a08 += 2; + b += 16; + } + } else + if (X < posY) { + a01 += 8 * lda; + a02 += 8 * lda; + a03 += 8 * lda; + a04 += 8 * lda; + a05 += 8 * lda; + a06 += 8 * lda; + a07 += 8 * lda; + a08 += 8 * lda; + + b += 128; + } else { +#ifdef UNIT + b[ 0] = ONE; + b[ 1] = ZERO; +#else + b[ 0] = *(a01 + 0); + b[ 1] = *(a01 + 1); +#endif + b[ 2] = ZERO; + b[ 3] = ZERO; + b[ 4] = ZERO; + b[ 5] = ZERO; + b[ 6] = ZERO; + b[ 7] = ZERO; + b[ 8] = ZERO; + b[ 9] = ZERO; + b[ 10] = ZERO; + b[ 11] = ZERO; + b[ 12] = ZERO; + b[ 13] = ZERO; + b[ 14] = ZERO; + b[ 15] = ZERO; + + b[ 16] = *(a01 + 2); + b[ 17] = *(a01 + 3); +#ifdef UNIT + b[ 18] = ONE; + b[ 19] = ZERO; +#else + b[ 18] = *(a02 + 2); + b[ 19] = *(a02 + 3); +#endif + b[ 20] = ZERO; + b[ 21] = ZERO; + b[ 22] = ZERO; + b[ 23] = ZERO; + b[ 24] = ZERO; + b[ 25] = ZERO; + b[ 26] = ZERO; + b[ 27] = ZERO; + b[ 28] = ZERO; + b[ 29] = ZERO; + b[ 30] = ZERO; + b[ 31] = ZERO; + + b[ 32] = *(a01 + 4); + b[ 33] = *(a01 + 5); + b[ 34] = *(a02 + 4); + b[ 35] = *(a02 + 5); +#ifdef UNIT + b[ 36] = ONE; + b[ 37] = ZERO; +#else + b[ 36] = *(a03 + 4); + b[ 37] = *(a03 + 5); +#endif + b[ 38] = ZERO; + b[ 39] = ZERO; + b[ 40] = ZERO; + b[ 41] = ZERO; + b[ 42] = ZERO; + b[ 43] = ZERO; + b[ 44] = ZERO; + b[ 45] = ZERO; + b[ 46] = ZERO; + b[ 47] = ZERO; + + b[ 48] = *(a01 + 6); + b[ 49] = *(a01 + 7); + b[ 50] = *(a02 + 6); + b[ 51] = *(a02 + 7); + b[ 52] = *(a03 + 6); + b[ 53] = *(a03 + 7); +#ifdef UNIT + b[ 54] = ONE; + b[ 55] = ZERO; +#else + b[ 54] = *(a04 + 6); + b[ 55] = *(a04 + 7); +#endif + b[ 56] = ZERO; + b[ 57] = ZERO; + b[ 58] = ZERO; + b[ 59] = ZERO; + b[ 60] = ZERO; + b[ 61] = ZERO; + b[ 62] = ZERO; + b[ 63] = ZERO; + + b[ 64] = *(a01 + 8); + b[ 65] = *(a01 + 9); + b[ 66] = *(a02 + 8); + b[ 67] = *(a02 + 9); + b[ 68] = *(a03 + 8); + b[ 69] = *(a03 + 9); + b[ 70] = *(a04 + 8); + b[ 71] = *(a04 + 9); +#ifdef UNIT + b[ 72] = ONE; + b[ 73] = ZERO; +#else + b[ 72] = *(a05 + 8); + b[ 73] = *(a05 + 9); +#endif + b[ 74] = ZERO; + b[ 75] = ZERO; + b[ 76] = ZERO; + b[ 77] = ZERO; + b[ 78] = ZERO; + b[ 79] = ZERO; + + b[ 80] = *(a01 + 10); + b[ 81] = *(a01 + 11); + b[ 82] = *(a02 + 10); + b[ 83] = *(a02 + 11); + b[ 84] = *(a03 + 10); + b[ 85] = *(a03 + 11); + b[ 86] = *(a04 + 10); + b[ 87] = *(a04 + 11); + b[ 88] = *(a05 + 10); + b[ 89] = *(a05 + 11); +#ifdef UNIT + b[ 90] = ONE; + b[ 91] = ZERO; +#else + b[ 90] = *(a06 + 10); + b[ 91] = *(a06 + 11); +#endif + b[ 92] = ZERO; + b[ 93] = ZERO; + b[ 94] = ZERO; + b[ 95] = ZERO; + + b[ 96] = *(a01 + 12); + b[ 97] = *(a01 + 13); + b[ 98] = *(a02 + 12); + b[ 99] = *(a02 + 13); + b[100] = *(a03 + 12); + b[101] = *(a03 + 13); + b[102] = *(a04 + 12); + b[103] = *(a04 + 13); + b[104] = *(a05 + 12); + b[105] = *(a05 + 13); + b[106] = *(a06 + 12); + b[107] = *(a06 + 13); +#ifdef UNIT + b[108] = ONE; + b[109] = ZERO; +#else + b[108] = *(a07 + 12); + b[109] = *(a07 + 13); +#endif + b[110] = ZERO; + b[111] = ZERO; + + b[112] = *(a01 + 14); + b[113] = *(a01 + 15); + b[114] = *(a02 + 14); + b[115] = *(a02 + 15); + b[116] = *(a03 + 14); + b[117] = *(a03 + 15); + b[118] = *(a04 + 14); + b[119] = *(a04 + 15); + b[120] = *(a05 + 14); + b[121] = *(a05 + 15); + b[122] = *(a06 + 14); + b[123] = *(a06 + 15); + b[124] = *(a07 + 14); + b[125] = *(a07 + 15); +#ifdef UNIT + b[126] = ONE; + b[127] = ZERO; +#else + b[126] = *(a08 + 14); + b[127] = *(a08 + 15); +#endif + + a01 += 16; + a02 += 16; + a03 += 16; + a04 += 16; + a05 += 16; + a06 += 16; + a07 += 16; + a08 += 16; + b += 128; + } + + X += 8; + i --; + } while (i > 0); + } + + i = (m & 7); + if (i) { + + if (X > posY) { + for (ii = 0; ii < i; ii++){ + + b[ 0] = *(a01 + 0); + b[ 1] = *(a01 + 1); + b[ 2] = *(a02 + 0); + b[ 3] = *(a02 + 1); + b[ 4] = *(a03 + 0); + b[ 5] = *(a03 + 1); + b[ 6] = *(a04 + 0); + b[ 7] = *(a04 + 1); + + b[ 8] = *(a05 + 0); + b[ 9] = *(a05 + 1); + b[ 10] = *(a06 + 0); + b[ 11] = *(a06 + 1); + b[ 12] = *(a07 + 0); + b[ 13] = *(a07 + 1); + b[ 14] = *(a08 + 0); + b[ 15] = *(a08 + 1); + + a01 += 2; + a02 += 2; + a03 += 2; + a04 += 2; + a05 += 2; + a06 += 2; + a07 += 2; + a08 += 2; + b += 16; + } + } else + if (X < posY) { + /* a01 += i * lda; + a02 += i * lda; + a03 += i * lda; + a04 += i * lda; + a05 += i * lda; + a06 += i * lda; + a07 += i * lda; + a08 += i * lda; */ + b += 16 * i; + } else { +#ifdef UNIT + b[ 0] = ONE; + b[ 1] = ZERO; +#else + b[ 0] = *(a01 + 0); + b[ 1] = *(a01 + 1); +#endif + b[ 2] = ZERO; + b[ 3] = ZERO; + b[ 4] = ZERO; + b[ 5] = ZERO; + b[ 6] = ZERO; + b[ 7] = ZERO; + b[ 8] = ZERO; + b[ 9] = ZERO; + b[ 10] = ZERO; + b[ 11] = ZERO; + b[ 12] = ZERO; + b[ 13] = ZERO; + b[ 14] = ZERO; + b[ 15] = ZERO; + b += 16; + + if (i >= 2) { + b[ 0] = *(a01 + 2); + b[ 1] = *(a01 + 3); +#ifdef UNIT + b[ 2] = ONE; + b[ 3] = ZERO; +#else + b[ 2] = *(a02 + 2); + b[ 3] = *(a02 + 3); +#endif + b[ 4] = ZERO; + b[ 5] = ZERO; + b[ 6] = ZERO; + b[ 7] = ZERO; + b[ 8] = ZERO; + b[ 9] = ZERO; + b[10] = ZERO; + b[11] = ZERO; + b[12] = ZERO; + b[13] = ZERO; + b[14] = ZERO; + b[15] = ZERO; + b += 16; + } + + if (i >= 3) { + b[ 0] = *(a01 + 4); + b[ 1] = *(a01 + 5); + b[ 2] = *(a02 + 4); + b[ 3] = *(a02 + 5); +#ifdef UNIT + b[ 4] = ONE; + b[ 5] = ZERO; +#else + b[ 4] = *(a03 + 4); + b[ 5] = *(a03 + 5); +#endif + b[ 6] = ZERO; + b[ 7] = ZERO; + b[ 8] = ZERO; + b[ 9] = ZERO; + b[10] = ZERO; + b[11] = ZERO; + b[12] = ZERO; + b[13] = ZERO; + b[14] = ZERO; + b[15] = ZERO; + b += 16; + } + + if (i >= 4) { + b[ 0] = *(a01 + 6); + b[ 1] = *(a01 + 7); + b[ 2] = *(a02 + 6); + b[ 3] = *(a02 + 7); + b[ 4] = *(a03 + 6); + b[ 5] = *(a03 + 7); +#ifdef UNIT + b[ 6] = ONE; + b[ 7] = ZERO; +#else + b[ 6] = *(a04 + 6); + b[ 7] = *(a04 + 7); +#endif + b[ 8] = ZERO; + b[ 9] = ZERO; + b[10] = ZERO; + b[11] = ZERO; + b[12] = ZERO; + b[13] = ZERO; + b[14] = ZERO; + b[15] = ZERO; + b += 16; + } + + if (i >= 5) { + b[ 0] = *(a01 + 8); + b[ 1] = *(a01 + 9); + b[ 2] = *(a02 + 8); + b[ 3] = *(a02 + 9); + b[ 4] = *(a03 + 8); + b[ 5] = *(a03 + 9); + b[ 6] = *(a04 + 8); + b[ 7] = *(a04 + 9); +#ifdef UNIT + b[ 8] = ONE; + b[ 9] = ZERO; +#else + b[ 8] = *(a05 + 8); + b[ 9] = *(a05 + 9); +#endif + b[10] = ZERO; + b[11] = ZERO; + b[12] = ZERO; + b[13] = ZERO; + b[14] = ZERO; + b[15] = ZERO; + b += 16; + } + + if (i >= 6) { + b[ 0] = *(a01 + 10); + b[ 1] = *(a01 + 11); + b[ 2] = *(a02 + 10); + b[ 3] = *(a02 + 11); + b[ 4] = *(a03 + 10); + b[ 5] = *(a03 + 11); + b[ 6] = *(a04 + 10); + b[ 7] = *(a04 + 11); + b[ 8] = *(a05 + 10); + b[ 9] = *(a05 + 11); +#ifdef UNIT + b[10] = ONE; + b[11] = ZERO; +#else + b[10] = *(a06 + 10); + b[11] = *(a06 + 11); +#endif + b[12] = ZERO; + b[13] = ZERO; + b[14] = ZERO; + b[15] = ZERO; + b += 16; + } + + if (i >= 7) { + b[ 0] = *(a01 + 12); + b[ 1] = *(a01 + 13); + b[ 2] = *(a02 + 12); + b[ 3] = *(a02 + 13); + b[ 4] = *(a03 + 12); + b[ 5] = *(a03 + 13); + b[ 6] = *(a04 + 12); + b[ 7] = *(a04 + 13); + b[ 8] = *(a05 + 12); + b[ 9] = *(a05 + 13); + b[10] = *(a06 + 12); + b[11] = *(a06 + 13); +#ifdef UNIT + b[12] = ONE; + b[13] = ZERO; +#else + b[12] = *(a07 + 12); + b[13] = *(a07 + 13); +#endif + b[14] = ZERO; + b[15] = ZERO; + b += 16; + } + } + } + + posY += 8; + } + + + if (n & 4){ + X = posX; + + if (posX <= posY) { + a01 = a + posY * 2 + (posX + 0) * lda; + a02 = a + posY * 2 + (posX + 1) * lda; + a03 = a + posY * 2 + (posX + 2) * lda; + a04 = a + posY * 2 + (posX + 3) * lda; + } else { + a01 = a + posX * 2 + (posY + 0) * lda; + a02 = a + posX * 2 + (posY + 1) * lda; + a03 = a + posX * 2 + (posY + 2) * lda; + a04 = a + posX * 2 + (posY + 3) * lda; + } + + i = (m >> 2); + if (i > 0) { + do { + if (X > posY) { + for (ii = 0; ii < 4; ii++){ + b[ 0] = *(a01 + 0); + b[ 1] = *(a01 + 1); + b[ 2] = *(a02 + 0); + b[ 3] = *(a02 + 1); + b[ 4] = *(a03 + 0); + b[ 5] = *(a03 + 1); + b[ 6] = *(a04 + 0); + b[ 7] = *(a04 + 1); + + a01 += 2; + a02 += 2; + a03 += 2; + a04 += 2; + b += 8; + } + } else + if (X < posY) { + a01 += 4 * lda; + a02 += 4 * lda; + a03 += 4 * lda; + a04 += 4 * lda; + b += 32; + } else { +#ifdef UNIT + b[ 0] = ONE; + b[ 1] = ZERO; +#else + b[ 0] = *(a01 + 0); + b[ 1] = *(a01 + 1); +#endif + b[ 2] = ZERO; + b[ 3] = ZERO; + b[ 4] = ZERO; + b[ 5] = ZERO; + b[ 6] = ZERO; + b[ 7] = ZERO; + + b[ 8] = *(a01 + 2); + b[ 9] = *(a01 + 3); +#ifdef UNIT + b[ 10] = ONE; + b[ 11] = ZERO; +#else + b[ 10] = *(a02 + 2); + b[ 11] = *(a02 + 3); +#endif + b[ 12] = ZERO; + b[ 13] = ZERO; + b[ 14] = ZERO; + b[ 15] = ZERO; + + b[ 16] = *(a01 + 4); + b[ 17] = *(a01 + 5); + b[ 18] = *(a02 + 4); + b[ 19] = *(a02 + 5); +#ifdef UNIT + b[ 20] = ONE; + b[ 21] = ZERO; +#else + b[ 20] = *(a03 + 4); + b[ 21] = *(a03 + 5); +#endif + b[ 22] = ZERO; + b[ 23] = ZERO; + + b[ 24] = *(a01 + 6); + b[ 25] = *(a01 + 7); + b[ 26] = *(a02 + 6); + b[ 27] = *(a02 + 7); + b[ 28] = *(a03 + 6); + b[ 29] = *(a03 + 7); +#ifdef UNIT + b[ 30] = ONE; + b[ 31] = ZERO; +#else + b[ 30] = *(a04 + 6); + b[ 31] = *(a04 + 7); +#endif + + a01 += 8; + a02 += 8; + a03 += 8; + a04 += 8; + b += 32; + } + + X += 4; + i --; + } while (i > 0); + } + + i = (m & 3); + if (i) { + + if (X > posY) { + + for (ii = 0; ii < i; ii++){ + b[ 0] = *(a01 + 0); + b[ 1] = *(a01 + 1); + b[ 2] = *(a02 + 0); + b[ 3] = *(a02 + 1); + b[ 4] = *(a03 + 0); + b[ 5] = *(a03 + 1); + b[ 6] = *(a04 + 0); + b[ 7] = *(a04 + 1); + + a01 += 2; + a02 += 2; + a03 += 2; + a04 += 2; + b += 8; + } + } else + if (X < posY) { + /* a01 += i * lda; + a02 += i * lda; + a03 += i * lda; + a04 += i * lda; */ + b += 8 * i; + } else { +#ifdef UNIT + b[ 0] = ONE; + b[ 1] = ZERO; +#else + b[ 0] = *(a01 + 0); + b[ 1] = *(a01 + 1); +#endif + b[ 2] = ZERO; + b[ 3] = ZERO; + b[ 4] = ZERO; + b[ 5] = ZERO; + b[ 6] = ZERO; + b[ 7] = ZERO; + b += 8; + + if (i >= 2) { + b[ 0] = *(a01 + 2); + b[ 1] = *(a01 + 3); +#ifdef UNIT + b[ 2] = ONE; + b[ 3] = ZERO; +#else + b[ 2] = *(a02 + 2); + b[ 3] = *(a02 + 3); +#endif + b[ 4] = ZERO; + b[ 5] = ZERO; + b[ 6] = ZERO; + b[ 7] = ZERO; + b += 8; + } + + if (i >= 3) { + b[ 0] = *(a01 + 4); + b[ 1] = *(a01 + 5); + b[ 2] = *(a02 + 4); + b[ 3] = *(a02 + 5); +#ifdef UNIT + b[ 4] = ONE; + b[ 5] = ZERO; +#else + b[ 4] = *(a03 + 4); + b[ 5] = *(a03 + 5); +#endif + b[ 6] = ZERO; + b[ 7] = ZERO; + b += 8; + } + } + } + + posY += 4; + } + + if (n & 2){ + X = posX; + + if (posX <= posY) { + a01 = a + posY * 2 + (posX + 0) * lda; + a02 = a + posY * 2 + (posX + 1) * lda; + } else { + a01 = a + posX * 2 + (posY + 0) * lda; + a02 = a + posX * 2 + (posY + 1) * lda; + } + + i = (m >> 1); + if (i > 0) { + do { + if (X > posY) { + b[ 0] = *(a01 + 0); + b[ 1] = *(a01 + 1); + b[ 2] = *(a02 + 0); + b[ 3] = *(a02 + 1); + b[ 4] = *(a01 + 2); + b[ 5] = *(a01 + 3); + b[ 6] = *(a02 + 2); + b[ 7] = *(a02 + 3); + + a01 += 4; + a02 += 4; + b += 8; + } else + if (X < posY) { + a01 += 2 * lda; + a02 += 2 * lda; + b += 8; + } else { +#ifdef UNIT + b[ 0] = ONE; + b[ 1] = ZERO; +#else + b[ 0] = *(a01 + 0); + b[ 1] = *(a01 + 1); +#endif + b[ 2] = ZERO; + b[ 3] = ZERO; + + b[ 4] = *(a01 + 2); + b[ 5] = *(a01 + 3); +#ifdef UNIT + b[ 6] = ONE; + b[ 7] = ZERO; +#else + b[ 6] = *(a02 + 2); + b[ 7] = *(a02 + 3); +#endif + a01 += 4; + a02 += 4; + b += 8; + } + + X += 2; + i --; + } while (i > 0); + } + + if (m & 1) { + + if (X > posY) { + b[ 0] = *(a01 + 0); + b[ 1] = *(a01 + 1); + b[ 2] = *(a02 + 0); + b[ 3] = *(a02 + 1); + /* a01 += 2; + a02 += 2; */ + b += 4; + } else + if (X < posY) { + /* a01 += 2 * lda; + a02 += 2 * lda; */ + b += 4; + } else { +#ifdef UNIT + b[ 0] = ONE; + b[ 1] = ZERO; +#else + b[ 0] = *(a01 + 0); + b[ 1] = *(a01 + 1); +#endif + b[ 2] = ZERO; + b[ 3] = ZERO; + b += 4; + } + } + posY += 2; + } + + if (n & 1){ + X = posX; + + if (posX <= posY) { + a01 = a + posY * 2 + (posX + 0) * lda; + } else { + a01 = a + posX * 2 + (posY + 0) * lda; + } + + i = m; + if (m > 0) { + do { + if (X > posY) { + b[ 0] = *(a01 + 0); + b[ 1] = *(a01 + 1); + a01 += 2; + b += 2; + } else + if (X < posY) { + a01 += lda; + b += 2; + } else { +#ifdef UNIT + b[ 0] = ONE; + b[ 1] = ZERO; +#else + b[ 0] = *(a01 + 0); + b[ 1] = *(a01 + 1); +#endif + a01 += 2; + b += 2; + } + + X += 1; + i --; + } while (i > 0); + } + } + + return 0; +} diff --git a/kernel/generic/ztrmm_ltcopy_16.c b/kernel/generic/ztrmm_ltcopy_16.c new file mode 100644 index 000000000..8d585e70b --- /dev/null +++ b/kernel/generic/ztrmm_ltcopy_16.c @@ -0,0 +1,2313 @@ +/******************************************************************************* +Copyright (c) 2024, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 +#include "common.h" + +int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG posX, BLASLONG posY, FLOAT *b){ + + BLASLONG i, js; + BLASLONG X, ii; + + FLOAT *a01, *a02, *a03, *a04, *a05, *a06, *a07, *a08; + FLOAT *a09, *a10, *a11, *a12, *a13, *a14, *a15, *a16; + + lda += lda; + + js = (n >> 4); + + if (js > 0){ + do { + X = posX; + + if (posX <= posY) { + a01 = a + posY * 2 + (posX + 0) * lda; + a02 = a + posY * 2 + (posX + 1) * lda; + a03 = a + posY * 2 + (posX + 2) * lda; + a04 = a + posY * 2 + (posX + 3) * lda; + a05 = a + posY * 2 + (posX + 4) * lda; + a06 = a + posY * 2 + (posX + 5) * lda; + a07 = a + posY * 2 + (posX + 6) * lda; + a08 = a + posY * 2 + (posX + 7) * lda; + a09 = a + posY * 2 + (posX + 8) * lda; + a10 = a + posY * 2 + (posX + 9) * lda; + a11 = a + posY * 2 + (posX + 10) * lda; + a12 = a + posY * 2 + (posX + 11) * lda; + a13 = a + posY * 2 + (posX + 12) * lda; + a14 = a + posY * 2 + (posX + 13) * lda; + a15 = a + posY * 2 + (posX + 14) * lda; + a16 = a + posY * 2 + (posX + 15) * lda; + } else { + a01 = a + posX * 2 + (posY + 0) * lda; + a02 = a + posX * 2 + (posY + 1) * lda; + a03 = a + posX * 2 + (posY + 2) * lda; + a04 = a + posX * 2 + (posY + 3) * lda; + a05 = a + posX * 2 + (posY + 4) * lda; + a06 = a + posX * 2 + (posY + 5) * lda; + a07 = a + posX * 2 + (posY + 6) * lda; + a08 = a + posX * 2 + (posY + 7) * lda; + a09 = a + posX * 2 + (posY + 8) * lda; + a10 = a + posX * 2 + (posY + 9) * lda; + a11 = a + posX * 2 + (posY + 10) * lda; + a12 = a + posX * 2 + (posY + 11) * lda; + a13 = a + posX * 2 + (posY + 12) * lda; + a14 = a + posX * 2 + (posY + 13) * lda; + a15 = a + posX * 2 + (posY + 14) * lda; + a16 = a + posX * 2 + (posY + 15) * lda; + } + + i = (m >> 4); + if (i > 0) { + do { + if (X > posY) { + a01 += 32; + a02 += 32; + a03 += 32; + a04 += 32; + a05 += 32; + a06 += 32; + a07 += 32; + a08 += 32; + a09 += 32; + a10 += 32; + a11 += 32; + a12 += 32; + a13 += 32; + a14 += 32; + a15 += 32; + a16 += 32; + b += 512; + } else + if (X < posY) { + for (ii = 0; ii < 16; ii++){ + + b[ 0] = *(a01 + 0); + b[ 1] = *(a01 + 1); + b[ 2] = *(a01 + 2); + b[ 3] = *(a01 + 3); + b[ 4] = *(a01 + 4); + b[ 5] = *(a01 + 5); + b[ 6] = *(a01 + 6); + b[ 7] = *(a01 + 7); + + b[ 8] = *(a01 + 8); + b[ 9] = *(a01 + 9); + b[ 10] = *(a01 + 10); + b[ 11] = *(a01 + 11); + b[ 12] = *(a01 + 12); + b[ 13] = *(a01 + 13); + b[ 14] = *(a01 + 14); + b[ 15] = *(a01 + 15); + + b[ 16] = *(a01 + 16); + b[ 17] = *(a01 + 17); + b[ 18] = *(a01 + 18); + b[ 19] = *(a01 + 19); + b[ 20] = *(a01 + 20); + b[ 21] = *(a01 + 21); + b[ 22] = *(a01 + 22); + b[ 23] = *(a01 + 23); + + b[ 24] = *(a01 + 24); + b[ 25] = *(a01 + 25); + b[ 26] = *(a01 + 26); + b[ 27] = *(a01 + 27); + b[ 28] = *(a01 + 28); + b[ 29] = *(a01 + 29); + b[ 30] = *(a01 + 30); + b[ 31] = *(a01 + 31); + + a01 += lda; + b += 32; + } + a02 += 16 * lda; + a03 += 16 * lda; + a04 += 16 * lda; + a05 += 16 * lda; + a06 += 16 * lda; + a07 += 16 * lda; + a08 += 16 * lda; + a09 += 16 * lda; + a10 += 16 * lda; + a11 += 16 * lda; + a12 += 16 * lda; + a13 += 16 * lda; + a14 += 16 * lda; + a15 += 16 * lda; + a16 += 16 * lda; + + } else { +#ifdef UNIT + b[ 0] = ONE; + b[ 1] = ZERO; +#else + b[ 0] = *(a01 + 0); + b[ 1] = *(a01 + 1); +#endif + b[ 2] = *(a01 + 2); + b[ 3] = *(a01 + 3); + b[ 4] = *(a01 + 4); + b[ 5] = *(a01 + 5); + b[ 6] = *(a01 + 6); + b[ 7] = *(a01 + 7); + b[ 8] = *(a01 + 8); + b[ 9] = *(a01 + 9); + b[ 10] = *(a01 + 10); + b[ 11] = *(a01 + 11); + b[ 12] = *(a01 + 12); + b[ 13] = *(a01 + 13); + b[ 14] = *(a01 + 14); + b[ 15] = *(a01 + 15); + b[ 16] = *(a01 + 16); + b[ 17] = *(a01 + 17); + b[ 18] = *(a01 + 18); + b[ 19] = *(a01 + 19); + b[ 20] = *(a01 + 20); + b[ 21] = *(a01 + 21); + b[ 22] = *(a01 + 22); + b[ 23] = *(a01 + 23); + b[ 24] = *(a01 + 24); + b[ 25] = *(a01 + 25); + b[ 26] = *(a01 + 26); + b[ 27] = *(a01 + 27); + b[ 28] = *(a01 + 28); + b[ 29] = *(a01 + 29); + b[ 30] = *(a01 + 30); + b[ 31] = *(a01 + 31); + + b[ 32] = ZERO; + b[ 33] = ZERO; +#ifdef UNIT + b[ 34] = ONE; + b[ 35] = ZERO; +#else + b[ 34] = *(a02 + 2); + b[ 35] = *(a02 + 3); +#endif + b[ 36] = *(a02 + 4); + b[ 37] = *(a02 + 5); + b[ 38] = *(a02 + 6); + b[ 39] = *(a02 + 7); + b[ 40] = *(a02 + 8); + b[ 41] = *(a02 + 9); + b[ 42] = *(a02 + 10); + b[ 43] = *(a02 + 11); + b[ 44] = *(a02 + 12); + b[ 45] = *(a02 + 13); + b[ 46] = *(a02 + 14); + b[ 47] = *(a02 + 15); + b[ 48] = *(a02 + 16); + b[ 49] = *(a02 + 17); + b[ 50] = *(a02 + 18); + b[ 51] = *(a02 + 19); + b[ 52] = *(a02 + 20); + b[ 53] = *(a02 + 21); + b[ 54] = *(a02 + 22); + b[ 55] = *(a02 + 23); + b[ 56] = *(a02 + 24); + b[ 57] = *(a02 + 25); + b[ 58] = *(a02 + 26); + b[ 59] = *(a02 + 27); + b[ 60] = *(a02 + 28); + b[ 61] = *(a02 + 29); + b[ 62] = *(a02 + 30); + b[ 63] = *(a02 + 31); + + b[ 64] = ZERO; + b[ 65] = ZERO; + b[ 66] = ZERO; + b[ 67] = ZERO; +#ifdef UNIT + b[ 68] = ONE; + b[ 69] = ZERO; +#else + b[ 68] = *(a03 + 4); + b[ 69] = *(a03 + 5); +#endif + b[ 70] = *(a03 + 6); + b[ 71] = *(a03 + 7); + b[ 72] = *(a03 + 8); + b[ 73] = *(a03 + 9); + b[ 74] = *(a03 + 10); + b[ 75] = *(a03 + 11); + b[ 76] = *(a03 + 12); + b[ 77] = *(a03 + 13); + b[ 78] = *(a03 + 14); + b[ 79] = *(a03 + 15); + b[ 80] = *(a03 + 16); + b[ 81] = *(a03 + 17); + b[ 82] = *(a03 + 18); + b[ 83] = *(a03 + 19); + b[ 84] = *(a03 + 20); + b[ 85] = *(a03 + 21); + b[ 86] = *(a03 + 22); + b[ 87] = *(a03 + 23); + b[ 88] = *(a03 + 24); + b[ 89] = *(a03 + 25); + b[ 90] = *(a03 + 26); + b[ 91] = *(a03 + 27); + b[ 92] = *(a03 + 28); + b[ 93] = *(a03 + 29); + b[ 94] = *(a03 + 30); + b[ 95] = *(a03 + 31); + + b[ 96] = ZERO; + b[ 97] = ZERO; + b[ 98] = ZERO; + b[ 99] = ZERO; + b[100] = ZERO; + b[101] = ZERO; +#ifdef UNIT + b[102] = ONE; + b[103] = ZERO; +#else + b[102] = *(a04 + 6); + b[103] = *(a04 + 7); +#endif + b[104] = *(a04 + 8); + b[105] = *(a04 + 9); + b[106] = *(a04 + 10); + b[107] = *(a04 + 11); + b[108] = *(a04 + 12); + b[109] = *(a04 + 13); + b[110] = *(a04 + 14); + b[111] = *(a04 + 15); + b[112] = *(a04 + 16); + b[113] = *(a04 + 17); + b[114] = *(a04 + 18); + b[115] = *(a04 + 19); + b[116] = *(a04 + 20); + b[117] = *(a04 + 21); + b[118] = *(a04 + 22); + b[119] = *(a04 + 23); + b[120] = *(a04 + 24); + b[121] = *(a04 + 25); + b[122] = *(a04 + 26); + b[123] = *(a04 + 27); + b[124] = *(a04 + 28); + b[125] = *(a04 + 29); + b[126] = *(a04 + 30); + b[127] = *(a04 + 31); + + b[128] = ZERO; + b[129] = ZERO; + b[130] = ZERO; + b[131] = ZERO; + b[132] = ZERO; + b[133] = ZERO; + b[134] = ZERO; + b[135] = ZERO; +#ifdef UNIT + b[136] = ONE; + b[137] = ZERO; +#else + b[136] = *(a05 + 8); + b[137] = *(a05 + 9); +#endif + b[138] = *(a05 + 10); + b[139] = *(a05 + 11); + b[140] = *(a05 + 12); + b[141] = *(a05 + 13); + b[142] = *(a05 + 14); + b[143] = *(a05 + 15); + b[144] = *(a05 + 16); + b[145] = *(a05 + 17); + b[146] = *(a05 + 18); + b[147] = *(a05 + 19); + b[148] = *(a05 + 20); + b[149] = *(a05 + 21); + b[150] = *(a05 + 22); + b[151] = *(a05 + 23); + b[152] = *(a05 + 24); + b[153] = *(a05 + 25); + b[154] = *(a05 + 26); + b[155] = *(a05 + 27); + b[156] = *(a05 + 28); + b[157] = *(a05 + 29); + b[158] = *(a05 + 30); + b[159] = *(a05 + 31); + + b[160] = ZERO; + b[161] = ZERO; + b[162] = ZERO; + b[163] = ZERO; + b[164] = ZERO; + b[165] = ZERO; + b[166] = ZERO; + b[167] = ZERO; + b[168] = ZERO; + b[169] = ZERO; +#ifdef UNIT + b[170] = ONE; + b[171] = ZERO; +#else + b[170] = *(a06 + 10); + b[171] = *(a06 + 11); +#endif + b[172] = *(a06 + 12); + b[173] = *(a06 + 13); + b[174] = *(a06 + 14); + b[175] = *(a06 + 15); + b[176] = *(a06 + 16); + b[177] = *(a06 + 17); + b[178] = *(a06 + 18); + b[179] = *(a06 + 19); + b[180] = *(a06 + 20); + b[181] = *(a06 + 21); + b[182] = *(a06 + 22); + b[183] = *(a06 + 23); + b[184] = *(a06 + 24); + b[185] = *(a06 + 25); + b[186] = *(a06 + 26); + b[187] = *(a06 + 27); + b[188] = *(a06 + 28); + b[189] = *(a06 + 29); + b[190] = *(a06 + 30); + b[191] = *(a06 + 31); + + b[192] = ZERO; + b[193] = ZERO; + b[194] = ZERO; + b[195] = ZERO; + b[196] = ZERO; + b[197] = ZERO; + b[198] = ZERO; + b[199] = ZERO; + b[200] = ZERO; + b[201] = ZERO; + b[202] = ZERO; + b[203] = ZERO; +#ifdef UNIT + b[204] = ONE; + b[205] = ZERO; +#else + b[204] = *(a07 + 12); + b[205] = *(a07 + 13); +#endif + b[206] = *(a07 + 14); + b[207] = *(a07 + 15); + b[208] = *(a07 + 16); + b[209] = *(a07 + 17); + b[210] = *(a07 + 18); + b[211] = *(a07 + 19); + b[212] = *(a07 + 20); + b[213] = *(a07 + 21); + b[214] = *(a07 + 22); + b[215] = *(a07 + 23); + b[216] = *(a07 + 24); + b[217] = *(a07 + 25); + b[218] = *(a07 + 26); + b[219] = *(a07 + 27); + b[220] = *(a07 + 28); + b[221] = *(a07 + 29); + b[222] = *(a07 + 30); + b[223] = *(a07 + 31); + + b[224] = ZERO; + b[225] = ZERO; + b[226] = ZERO; + b[227] = ZERO; + b[228] = ZERO; + b[229] = ZERO; + b[230] = ZERO; + b[231] = ZERO; + b[232] = ZERO; + b[233] = ZERO; + b[234] = ZERO; + b[235] = ZERO; + b[236] = ZERO; + b[237] = ZERO; +#ifdef UNIT + b[238] = ONE; + b[239] = ZERO; +#else + b[238] = *(a08 + 14); + b[239] = *(a08 + 15); +#endif + b[240] = *(a08 + 16); + b[241] = *(a08 + 17); + b[242] = *(a08 + 18); + b[243] = *(a08 + 19); + b[244] = *(a08 + 20); + b[245] = *(a08 + 21); + b[246] = *(a08 + 22); + b[247] = *(a08 + 23); + b[248] = *(a08 + 24); + b[249] = *(a08 + 25); + b[250] = *(a08 + 26); + b[251] = *(a08 + 27); + b[252] = *(a08 + 28); + b[253] = *(a08 + 29); + b[254] = *(a08 + 30); + b[255] = *(a08 + 31); + + b[256] = ZERO; + b[257] = ZERO; + b[258] = ZERO; + b[259] = ZERO; + b[260] = ZERO; + b[261] = ZERO; + b[262] = ZERO; + b[263] = ZERO; + b[264] = ZERO; + b[265] = ZERO; + b[266] = ZERO; + b[267] = ZERO; + b[268] = ZERO; + b[269] = ZERO; + b[270] = ZERO; + b[271] = ZERO; +#ifdef UNIT + b[272] = ONE; + b[273] = ZERO; +#else + b[272] = *(a09 + 16); + b[273] = *(a09 + 17); +#endif + b[274] = *(a09 + 18); + b[275] = *(a09 + 19); + b[276] = *(a09 + 20); + b[277] = *(a09 + 21); + b[278] = *(a09 + 22); + b[279] = *(a09 + 23); + b[280] = *(a09 + 24); + b[281] = *(a09 + 25); + b[282] = *(a09 + 26); + b[283] = *(a09 + 27); + b[284] = *(a09 + 28); + b[285] = *(a09 + 29); + b[286] = *(a09 + 30); + b[287] = *(a09 + 31); + + b[288] = ZERO; + b[289] = ZERO; + b[290] = ZERO; + b[291] = ZERO; + b[292] = ZERO; + b[293] = ZERO; + b[294] = ZERO; + b[295] = ZERO; + b[296] = ZERO; + b[297] = ZERO; + b[298] = ZERO; + b[299] = ZERO; + b[300] = ZERO; + b[301] = ZERO; + b[302] = ZERO; + b[303] = ZERO; + b[304] = ZERO; + b[305] = ZERO; +#ifdef UNIT + b[306] = ONE; + b[307] = ZERO; +#else + b[306] = *(a10 + 18); + b[307] = *(a10 + 19); +#endif + b[308] = *(a10 + 20); + b[309] = *(a10 + 21); + b[310] = *(a10 + 22); + b[311] = *(a10 + 23); + b[312] = *(a10 + 24); + b[313] = *(a10 + 25); + b[314] = *(a10 + 26); + b[315] = *(a10 + 27); + b[316] = *(a10 + 28); + b[317] = *(a10 + 29); + b[318] = *(a10 + 30); + b[319] = *(a10 + 31); + + b[320] = ZERO; + b[321] = ZERO; + b[322] = ZERO; + b[323] = ZERO; + b[324] = ZERO; + b[325] = ZERO; + b[326] = ZERO; + b[327] = ZERO; + b[328] = ZERO; + b[329] = ZERO; + b[330] = ZERO; + b[331] = ZERO; + b[332] = ZERO; + b[333] = ZERO; + b[334] = ZERO; + b[335] = ZERO; + b[336] = ZERO; + b[337] = ZERO; + b[338] = ZERO; + b[339] = ZERO; +#ifdef UNIT + b[340] = ONE; + b[341] = ZERO; +#else + b[340] = *(a11 + 20); + b[341] = *(a11 + 21); +#endif + b[342] = *(a11 + 22); + b[343] = *(a11 + 23); + b[344] = *(a11 + 24); + b[345] = *(a11 + 25); + b[346] = *(a11 + 26); + b[347] = *(a11 + 27); + b[348] = *(a11 + 28); + b[349] = *(a11 + 29); + b[350] = *(a11 + 30); + b[351] = *(a11 + 31); + + b[352] = ZERO; + b[353] = ZERO; + b[354] = ZERO; + b[355] = ZERO; + b[356] = ZERO; + b[357] = ZERO; + b[358] = ZERO; + b[359] = ZERO; + b[360] = ZERO; + b[361] = ZERO; + b[362] = ZERO; + b[363] = ZERO; + b[364] = ZERO; + b[365] = ZERO; + b[366] = ZERO; + b[367] = ZERO; + b[368] = ZERO; + b[369] = ZERO; + b[370] = ZERO; + b[371] = ZERO; + b[372] = ZERO; + b[373] = ZERO; +#ifdef UNIT + b[374] = ONE; + b[375] = ZERO; +#else + b[374] = *(a12 + 22); + b[375] = *(a12 + 23); +#endif + b[376] = *(a12 + 24); + b[377] = *(a12 + 25); + b[378] = *(a12 + 26); + b[379] = *(a12 + 27); + b[380] = *(a12 + 28); + b[381] = *(a12 + 29); + b[382] = *(a12 + 30); + b[383] = *(a12 + 31); + + b[384] = ZERO; + b[385] = ZERO; + b[386] = ZERO; + b[387] = ZERO; + b[388] = ZERO; + b[389] = ZERO; + b[390] = ZERO; + b[391] = ZERO; + b[392] = ZERO; + b[393] = ZERO; + b[394] = ZERO; + b[395] = ZERO; + b[396] = ZERO; + b[397] = ZERO; + b[398] = ZERO; + b[399] = ZERO; + b[400] = ZERO; + b[401] = ZERO; + b[402] = ZERO; + b[403] = ZERO; + b[404] = ZERO; + b[405] = ZERO; + b[406] = ZERO; + b[407] = ZERO; +#ifdef UNIT + b[408] = ONE; + b[409] = ZERO; +#else + b[408] = *(a13 + 24); + b[409] = *(a13 + 25); +#endif + b[410] = *(a13 + 26); + b[411] = *(a13 + 27); + b[412] = *(a13 + 28); + b[413] = *(a13 + 29); + b[414] = *(a13 + 30); + b[415] = *(a13 + 31); + + b[416] = ZERO; + b[417] = ZERO; + b[418] = ZERO; + b[419] = ZERO; + b[420] = ZERO; + b[421] = ZERO; + b[422] = ZERO; + b[423] = ZERO; + b[424] = ZERO; + b[425] = ZERO; + b[426] = ZERO; + b[427] = ZERO; + b[428] = ZERO; + b[429] = ZERO; + b[430] = ZERO; + b[431] = ZERO; + b[432] = ZERO; + b[433] = ZERO; + b[434] = ZERO; + b[435] = ZERO; + b[436] = ZERO; + b[437] = ZERO; + b[438] = ZERO; + b[439] = ZERO; + b[440] = ZERO; + b[441] = ZERO; +#ifdef UNIT + b[442] = ONE; + b[443] = ZERO; +#else + b[442] = *(a14 + 26); + b[443] = *(a14 + 27); +#endif + b[444] = *(a14 + 28); + b[445] = *(a14 + 29); + b[446] = *(a14 + 30); + b[447] = *(a14 + 31); + + b[448] = ZERO; + b[449] = ZERO; + b[450] = ZERO; + b[451] = ZERO; + b[452] = ZERO; + b[453] = ZERO; + b[454] = ZERO; + b[455] = ZERO; + b[456] = ZERO; + b[457] = ZERO; + b[458] = ZERO; + b[459] = ZERO; + b[460] = ZERO; + b[461] = ZERO; + b[462] = ZERO; + b[463] = ZERO; + b[464] = ZERO; + b[465] = ZERO; + b[466] = ZERO; + b[467] = ZERO; + b[468] = ZERO; + b[469] = ZERO; + b[470] = ZERO; + b[471] = ZERO; + b[472] = ZERO; + b[473] = ZERO; + b[474] = ZERO; + b[475] = ZERO; +#ifdef UNIT + b[476] = ONE; + b[477] = ZERO; +#else + b[476] = *(a15 + 28); + b[477] = *(a15 + 29); +#endif + b[478] = *(a15 + 30); + b[479] = *(a15 + 31); + + b[480] = ZERO; + b[481] = ZERO; + b[482] = ZERO; + b[483] = ZERO; + b[484] = ZERO; + b[485] = ZERO; + b[486] = ZERO; + b[487] = ZERO; + b[488] = ZERO; + b[489] = ZERO; + b[490] = ZERO; + b[491] = ZERO; + b[492] = ZERO; + b[493] = ZERO; + b[494] = ZERO; + b[495] = ZERO; + b[496] = ZERO; + b[497] = ZERO; + b[498] = ZERO; + b[499] = ZERO; + b[500] = ZERO; + b[501] = ZERO; + b[502] = ZERO; + b[503] = ZERO; + b[504] = ZERO; + b[505] = ZERO; + b[506] = ZERO; + b[507] = ZERO; + b[508] = ZERO; + b[509] = ZERO; +#ifdef UNIT + b[510] = ONE; + b[511] = ZERO; +#else + b[510] = *(a16 + 30); + b[511] = *(a16 + 31); +#endif + + a01 += 32; + a02 += 32; + a03 += 32; + a04 += 32; + a05 += 32; + a06 += 32; + a07 += 32; + a08 += 32; + a09 += 32; + a10 += 32; + a11 += 32; + a12 += 32; + a13 += 32; + a14 += 32; + a15 += 32; + a16 += 32; + b += 512; + } + + X += 16; + i --; + } while (i > 0); + } + + i = (m & 15); + if (i) { + + if (X > posY) { + /* a01 += i * lda; + a02 += i * lda; + a03 += i * lda; + a04 += i * lda; + a05 += i * lda; + a06 += i * lda; + a07 += i * lda; + a08 += i * lda; + a09 += i * lda; + a10 += i * lda; + a11 += i * lda; + a12 += i * lda; + a13 += i * lda; + a14 += i * lda; + a15 += i * lda; + a16 += i * lda; */ + b += 32 * i; + } else + if (X < posY) { + for (ii = 0; ii < i; ii++){ + b[ 0] = *(a01 + 0); + b[ 1] = *(a01 + 1); + b[ 2] = *(a01 + 2); + b[ 3] = *(a01 + 3); + b[ 4] = *(a01 + 4); + b[ 5] = *(a01 + 5); + b[ 6] = *(a01 + 6); + b[ 7] = *(a01 + 7); + b[ 8] = *(a01 + 8); + b[ 9] = *(a01 + 9); + b[ 10] = *(a01 + 10); + b[ 11] = *(a01 + 11); + b[ 12] = *(a01 + 12); + b[ 13] = *(a01 + 13); + b[ 14] = *(a01 + 14); + b[ 15] = *(a01 + 15); + + b[ 16] = *(a01 + 16); + b[ 17] = *(a01 + 17); + b[ 18] = *(a01 + 18); + b[ 19] = *(a01 + 19); + b[ 20] = *(a01 + 20); + b[ 21] = *(a01 + 21); + b[ 22] = *(a01 + 22); + b[ 23] = *(a01 + 23); + b[ 24] = *(a01 + 24); + b[ 25] = *(a01 + 25); + b[ 26] = *(a01 + 26); + b[ 27] = *(a01 + 27); + b[ 28] = *(a01 + 28); + b[ 29] = *(a01 + 29); + b[ 30] = *(a01 + 30); + b[ 31] = *(a01 + 31); + + a01 += lda; + a02 += lda; + a03 += lda; + a04 += lda; + a05 += lda; + a06 += lda; + a07 += lda; + a08 += lda; + a09 += lda; + a10 += lda; + a11 += lda; + a12 += lda; + a13 += lda; + a14 += lda; + a15 += lda; + a16 += lda; + b += 32; + } + } else { +#ifdef UNIT + b[ 0] = ONE; + b[ 1] = ZERO; +#else + b[ 0] = *(a01 + 0); + b[ 1] = *(a01 + 1); +#endif + b[ 2] = *(a01 + 2); + b[ 3] = *(a01 + 3); + b[ 4] = *(a01 + 4); + b[ 5] = *(a01 + 5); + b[ 6] = *(a01 + 6); + b[ 7] = *(a01 + 7); + b[ 8] = *(a01 + 8); + b[ 9] = *(a01 + 9); + b[ 10] = *(a01 + 10); + b[ 11] = *(a01 + 11); + b[ 12] = *(a01 + 12); + b[ 13] = *(a01 + 13); + b[ 14] = *(a01 + 14); + b[ 15] = *(a01 + 15); + b[ 16] = *(a01 + 16); + b[ 17] = *(a01 + 17); + b[ 18] = *(a01 + 18); + b[ 19] = *(a01 + 19); + b[ 20] = *(a01 + 20); + b[ 21] = *(a01 + 21); + b[ 22] = *(a01 + 22); + b[ 23] = *(a01 + 23); + b[ 24] = *(a01 + 24); + b[ 25] = *(a01 + 25); + b[ 26] = *(a01 + 26); + b[ 27] = *(a01 + 27); + b[ 28] = *(a01 + 28); + b[ 29] = *(a01 + 29); + b[ 30] = *(a01 + 30); + b[ 31] = *(a01 + 31); + b += 32; + + if (i >= 2) { + b[ 0] = ZERO; + b[ 1] = ZERO; +#ifdef UNIT + b[ 2] = ONE; + b[ 3] = ZERO; +#else + b[ 2] = *(a02 + 2); + b[ 3] = *(a02 + 3); +#endif + b[ 4] = *(a02 + 4); + b[ 5] = *(a02 + 5); + b[ 6] = *(a02 + 6); + b[ 7] = *(a02 + 7); + b[ 8] = *(a02 + 8); + b[ 9] = *(a02 + 9); + b[ 10] = *(a02 + 10); + b[ 11] = *(a02 + 11); + b[ 12] = *(a02 + 12); + b[ 13] = *(a02 + 13); + b[ 14] = *(a02 + 14); + b[ 15] = *(a02 + 15); + b[ 16] = *(a02 + 16); + b[ 17] = *(a02 + 17); + b[ 18] = *(a02 + 18); + b[ 19] = *(a02 + 19); + b[ 20] = *(a02 + 20); + b[ 21] = *(a02 + 21); + b[ 22] = *(a02 + 22); + b[ 23] = *(a02 + 23); + b[ 24] = *(a02 + 24); + b[ 25] = *(a02 + 25); + b[ 26] = *(a02 + 26); + b[ 27] = *(a02 + 27); + b[ 28] = *(a02 + 28); + b[ 29] = *(a02 + 29); + b[ 30] = *(a02 + 30); + b[ 31] = *(a02 + 31); + b += 32; + } + + if (i >= 3) { + b[ 0] = ZERO; + b[ 1] = ZERO; + b[ 2] = ZERO; + b[ 3] = ZERO; +#ifdef UNIT + b[ 4] = ONE; + b[ 5] = ZERO; +#else + b[ 4] = *(a03 + 4); + b[ 5] = *(a03 + 5); +#endif + b[ 6] = *(a03 + 6); + b[ 7] = *(a03 + 7); + b[ 8] = *(a03 + 8); + b[ 9] = *(a03 + 9); + b[ 10] = *(a03 + 10); + b[ 11] = *(a03 + 11); + b[ 12] = *(a03 + 12); + b[ 13] = *(a03 + 13); + b[ 14] = *(a03 + 14); + b[ 15] = *(a03 + 15); + b[ 16] = *(a03 + 16); + b[ 17] = *(a03 + 17); + b[ 18] = *(a03 + 18); + b[ 19] = *(a03 + 19); + b[ 20] = *(a03 + 20); + b[ 21] = *(a03 + 21); + b[ 22] = *(a03 + 22); + b[ 23] = *(a03 + 23); + b[ 24] = *(a03 + 24); + b[ 25] = *(a03 + 25); + b[ 26] = *(a03 + 26); + b[ 27] = *(a03 + 27); + b[ 28] = *(a03 + 28); + b[ 29] = *(a03 + 29); + b[ 30] = *(a03 + 30); + b[ 31] = *(a03 + 31); + b += 32; + } + + if (i >= 4) { + b[ 0] = ZERO; + b[ 1] = ZERO; + b[ 2] = ZERO; + b[ 3] = ZERO; + b[ 4] = ZERO; + b[ 5] = ZERO; +#ifdef UNIT + b[ 6] = ONE; + b[ 7] = ZERO; +#else + b[ 6] = *(a04 + 6); + b[ 7] = *(a04 + 7); +#endif + b[ 8] = *(a04 + 8); + b[ 9] = *(a04 + 9); + b[ 10] = *(a04 + 10); + b[ 11] = *(a04 + 11); + b[ 12] = *(a04 + 12); + b[ 13] = *(a04 + 13); + b[ 14] = *(a04 + 14); + b[ 15] = *(a04 + 15); + b[ 16] = *(a04 + 16); + b[ 17] = *(a04 + 17); + b[ 18] = *(a04 + 18); + b[ 19] = *(a04 + 19); + b[ 20] = *(a04 + 20); + b[ 21] = *(a04 + 21); + b[ 22] = *(a04 + 22); + b[ 23] = *(a04 + 23); + b[ 24] = *(a04 + 24); + b[ 25] = *(a04 + 25); + b[ 26] = *(a04 + 26); + b[ 27] = *(a04 + 27); + b[ 28] = *(a04 + 28); + b[ 29] = *(a04 + 29); + b[ 30] = *(a04 + 30); + b[ 31] = *(a04 + 31); + b += 32; + } + + if (i >= 5) { + b[ 0] = ZERO; + b[ 1] = ZERO; + b[ 2] = ZERO; + b[ 3] = ZERO; + b[ 4] = ZERO; + b[ 5] = ZERO; + b[ 6] = ZERO; + b[ 7] = ZERO; +#ifdef UNIT + b[ 8] = ONE; + b[ 9] = ZERO; +#else + b[ 8] = *(a05 + 8); + b[ 9] = *(a05 + 9); +#endif + b[ 10] = *(a05 + 10); + b[ 11] = *(a05 + 11); + b[ 12] = *(a05 + 12); + b[ 13] = *(a05 + 13); + b[ 14] = *(a05 + 14); + b[ 15] = *(a05 + 15); + b[ 16] = *(a05 + 16); + b[ 17] = *(a05 + 17); + b[ 18] = *(a05 + 18); + b[ 19] = *(a05 + 19); + b[ 20] = *(a05 + 20); + b[ 21] = *(a05 + 21); + b[ 22] = *(a05 + 22); + b[ 23] = *(a05 + 23); + b[ 24] = *(a05 + 24); + b[ 25] = *(a05 + 25); + b[ 26] = *(a05 + 26); + b[ 27] = *(a05 + 27); + b[ 28] = *(a05 + 28); + b[ 29] = *(a05 + 29); + b[ 30] = *(a05 + 30); + b[ 31] = *(a05 + 31); + b += 32; + } + + if (i >= 6) { + b[ 0] = ZERO; + b[ 1] = ZERO; + b[ 2] = ZERO; + b[ 3] = ZERO; + b[ 4] = ZERO; + b[ 5] = ZERO; + b[ 6] = ZERO; + b[ 7] = ZERO; + b[ 8] = ZERO; + b[ 9] = ZERO; +#ifdef UNIT + b[10] = ONE; + b[11] = ZERO; +#else + b[10] = *(a06 + 10); + b[11] = *(a06 + 11); +#endif + b[ 12] = *(a06 + 12); + b[ 13] = *(a06 + 13); + b[ 14] = *(a06 + 14); + b[ 15] = *(a06 + 15); + b[ 16] = *(a06 + 16); + b[ 17] = *(a06 + 17); + b[ 18] = *(a06 + 18); + b[ 19] = *(a06 + 19); + b[ 20] = *(a06 + 20); + b[ 21] = *(a06 + 21); + b[ 22] = *(a06 + 22); + b[ 23] = *(a06 + 23); + b[ 24] = *(a06 + 24); + b[ 25] = *(a06 + 25); + b[ 26] = *(a06 + 26); + b[ 27] = *(a06 + 27); + b[ 28] = *(a06 + 28); + b[ 29] = *(a06 + 29); + b[ 30] = *(a06 + 30); + b[ 31] = *(a06 + 31); + b += 32; + } + + if (i >= 7) { + b[ 0] = ZERO; + b[ 1] = ZERO; + b[ 2] = ZERO; + b[ 3] = ZERO; + b[ 4] = ZERO; + b[ 5] = ZERO; + b[ 6] = ZERO; + b[ 7] = ZERO; + b[ 8] = ZERO; + b[ 9] = ZERO; + b[10] = ZERO; + b[11] = ZERO; +#ifdef UNIT + b[12] = ONE; + b[13] = ZERO; +#else + b[12] = *(a07 + 12); + b[13] = *(a07 + 13); +#endif + b[ 14] = *(a07 + 14); + b[ 15] = *(a07 + 15); + b[ 16] = *(a07 + 16); + b[ 17] = *(a07 + 17); + b[ 18] = *(a07 + 18); + b[ 19] = *(a07 + 19); + b[ 20] = *(a07 + 20); + b[ 21] = *(a07 + 21); + b[ 22] = *(a07 + 22); + b[ 23] = *(a07 + 23); + b[ 24] = *(a07 + 24); + b[ 25] = *(a07 + 25); + b[ 26] = *(a07 + 26); + b[ 27] = *(a07 + 27); + b[ 28] = *(a07 + 28); + b[ 29] = *(a07 + 29); + b[ 30] = *(a07 + 30); + b[ 31] = *(a07 + 31); + b += 32; + } + + if (i >= 8) { + b[ 0] = ZERO; + b[ 1] = ZERO; + b[ 2] = ZERO; + b[ 3] = ZERO; + b[ 4] = ZERO; + b[ 5] = ZERO; + b[ 6] = ZERO; + b[ 7] = ZERO; + b[ 8] = ZERO; + b[ 9] = ZERO; + b[ 10] = ZERO; + b[ 11] = ZERO; + b[ 12] = ZERO; + b[ 13] = ZERO; +#ifdef UNIT + b[ 14] = ONE; + b[ 15] = ZERO; +#else + b[ 14] = *(a08 + 14); + b[ 15] = *(a08 + 15); +#endif + b[ 16] = *(a08 + 16); + b[ 17] = *(a08 + 17); + b[ 18] = *(a08 + 18); + b[ 19] = *(a08 + 19); + b[ 20] = *(a08 + 20); + b[ 21] = *(a08 + 21); + b[ 22] = *(a08 + 22); + b[ 23] = *(a08 + 23); + b[ 24] = *(a08 + 24); + b[ 25] = *(a08 + 25); + b[ 26] = *(a08 + 26); + b[ 27] = *(a08 + 27); + b[ 28] = *(a08 + 28); + b[ 29] = *(a08 + 29); + b[ 30] = *(a08 + 30); + b[ 31] = *(a08 + 31); + b += 32; + } + + if (i >= 9) { + b[ 0] = ZERO; + b[ 1] = ZERO; + b[ 2] = ZERO; + b[ 3] = ZERO; + b[ 4] = ZERO; + b[ 5] = ZERO; + b[ 6] = ZERO; + b[ 7] = ZERO; + b[ 8] = ZERO; + b[ 9] = ZERO; + b[ 10] = ZERO; + b[ 11] = ZERO; + b[ 12] = ZERO; + b[ 13] = ZERO; + b[ 14] = ZERO; + b[ 15] = ZERO; +#ifdef UNIT + b[ 16] = ONE; + b[ 17] = ZERO; +#else + b[ 16] = *(a09 + 16); + b[ 17] = *(a09 + 17); +#endif + b[ 18] = *(a09 + 18); + b[ 19] = *(a09 + 19); + b[ 20] = *(a09 + 20); + b[ 21] = *(a09 + 21); + b[ 22] = *(a09 + 22); + b[ 23] = *(a09 + 23); + b[ 24] = *(a09 + 24); + b[ 25] = *(a09 + 25); + b[ 26] = *(a09 + 26); + b[ 27] = *(a09 + 27); + b[ 28] = *(a09 + 28); + b[ 29] = *(a09 + 29); + b[ 30] = *(a09 + 30); + b[ 31] = *(a09 + 31); + b += 32; + } + + if (i >= 10) { + b[ 0] = ZERO; + b[ 1] = ZERO; + b[ 2] = ZERO; + b[ 3] = ZERO; + b[ 4] = ZERO; + b[ 5] = ZERO; + b[ 6] = ZERO; + b[ 7] = ZERO; + b[ 8] = ZERO; + b[ 9] = ZERO; + b[ 10] = ZERO; + b[ 11] = ZERO; + b[ 12] = ZERO; + b[ 13] = ZERO; + b[ 14] = ZERO; + b[ 15] = ZERO; + b[ 16] = ZERO; + b[ 17] = ZERO; +#ifdef UNIT + b[ 18] = ONE; + b[ 19] = ZERO; +#else + b[ 18] = *(a10 + 18); + b[ 19] = *(a10 + 19); +#endif + b[ 20] = *(a10 + 20); + b[ 21] = *(a10 + 21); + b[ 22] = *(a10 + 22); + b[ 23] = *(a10 + 23); + b[ 24] = *(a10 + 24); + b[ 25] = *(a10 + 25); + b[ 26] = *(a10 + 26); + b[ 27] = *(a10 + 27); + b[ 28] = *(a10 + 28); + b[ 29] = *(a10 + 29); + b[ 30] = *(a10 + 30); + b[ 31] = *(a10 + 31); + b += 32; + } + + if (i >= 11) { + b[ 0] = ZERO; + b[ 1] = ZERO; + b[ 2] = ZERO; + b[ 3] = ZERO; + b[ 4] = ZERO; + b[ 5] = ZERO; + b[ 6] = ZERO; + b[ 7] = ZERO; + b[ 8] = ZERO; + b[ 9] = ZERO; + b[ 10] = ZERO; + b[ 11] = ZERO; + b[ 12] = ZERO; + b[ 13] = ZERO; + b[ 14] = ZERO; + b[ 15] = ZERO; + b[ 16] = ZERO; + b[ 17] = ZERO; + b[ 18] = ZERO; + b[ 19] = ZERO; +#ifdef UNIT + b[ 20] = ONE; + b[ 21] = ZERO; +#else + b[ 20] = *(a11 + 20); + b[ 21] = *(a11 + 21); +#endif + b[ 22] = *(a11 + 22); + b[ 23] = *(a11 + 23); + b[ 24] = *(a11 + 24); + b[ 25] = *(a11 + 25); + b[ 26] = *(a11 + 26); + b[ 27] = *(a11 + 27); + b[ 28] = *(a11 + 28); + b[ 29] = *(a11 + 29); + b[ 30] = *(a11 + 30); + b[ 31] = *(a11 + 31); + b += 32; + } + + if (i >= 12) { + b[ 0] = ZERO; + b[ 1] = ZERO; + b[ 2] = ZERO; + b[ 3] = ZERO; + b[ 4] = ZERO; + b[ 5] = ZERO; + b[ 6] = ZERO; + b[ 7] = ZERO; + b[ 8] = ZERO; + b[ 9] = ZERO; + b[ 10] = ZERO; + b[ 11] = ZERO; + b[ 12] = ZERO; + b[ 13] = ZERO; + b[ 14] = ZERO; + b[ 15] = ZERO; + b[ 16] = ZERO; + b[ 17] = ZERO; + b[ 18] = ZERO; + b[ 19] = ZERO; + b[ 20] = ZERO; + b[ 21] = ZERO; +#ifdef UNIT + b[ 22] = ONE; + b[ 23] = ZERO; +#else + b[ 22] = *(a12 + 22); + b[ 23] = *(a12 + 23); +#endif + b[ 24] = *(a12 + 24); + b[ 25] = *(a12 + 25); + b[ 26] = *(a12 + 26); + b[ 27] = *(a12 + 27); + b[ 28] = *(a12 + 28); + b[ 29] = *(a12 + 29); + b[ 30] = *(a12 + 30); + b[ 31] = *(a12 + 31); + b += 32; + } + + if (i >= 13) { + b[ 0] = ZERO; + b[ 1] = ZERO; + b[ 2] = ZERO; + b[ 3] = ZERO; + b[ 4] = ZERO; + b[ 5] = ZERO; + b[ 6] = ZERO; + b[ 7] = ZERO; + b[ 8] = ZERO; + b[ 9] = ZERO; + b[ 10] = ZERO; + b[ 11] = ZERO; + b[ 12] = ZERO; + b[ 13] = ZERO; + b[ 14] = ZERO; + b[ 15] = ZERO; + b[ 16] = ZERO; + b[ 17] = ZERO; + b[ 18] = ZERO; + b[ 19] = ZERO; + b[ 20] = ZERO; + b[ 21] = ZERO; + b[ 22] = ZERO; + b[ 23] = ZERO; +#ifdef UNIT + b[ 24] = ONE; + b[ 25] = ZERO; +#else + b[ 24] = *(a13 + 24); + b[ 25] = *(a13 + 25); +#endif + b[ 26] = *(a13 + 26); + b[ 27] = *(a13 + 27); + b[ 28] = *(a13 + 28); + b[ 29] = *(a12 + 29); + b[ 30] = *(a13 + 30); + b[ 31] = *(a13 + 31); + b += 32; + } + + if (i >= 14) { + b[ 0] = ZERO; + b[ 1] = ZERO; + b[ 2] = ZERO; + b[ 3] = ZERO; + b[ 4] = ZERO; + b[ 5] = ZERO; + b[ 6] = ZERO; + b[ 7] = ZERO; + b[ 8] = ZERO; + b[ 9] = ZERO; + b[ 10] = ZERO; + b[ 11] = ZERO; + b[ 12] = ZERO; + b[ 13] = ZERO; + b[ 14] = ZERO; + b[ 15] = ZERO; + b[ 16] = ZERO; + b[ 17] = ZERO; + b[ 18] = ZERO; + b[ 19] = ZERO; + b[ 20] = ZERO; + b[ 21] = ZERO; + b[ 22] = ZERO; + b[ 23] = ZERO; + b[ 24] = ZERO; + b[ 25] = ZERO; +#ifdef UNIT + b[ 26] = ONE; + b[ 27] = ZERO; +#else + b[ 26] = *(a14 + 26); + b[ 27] = *(a14 + 27); +#endif + b[ 28] = *(a14 + 28); + b[ 29] = *(a14 + 29); + b[ 30] = *(a14 + 30); + b[ 31] = *(a14 + 31); + b += 32; + } + + if (i >= 15) { + b[ 0] = ZERO; + b[ 1] = ZERO; + b[ 2] = ZERO; + b[ 3] = ZERO; + b[ 4] = ZERO; + b[ 5] = ZERO; + b[ 6] = ZERO; + b[ 7] = ZERO; + b[ 8] = ZERO; + b[ 9] = ZERO; + b[ 10] = ZERO; + b[ 11] = ZERO; + b[ 12] = ZERO; + b[ 13] = ZERO; + b[ 14] = ZERO; + b[ 15] = ZERO; + b[ 16] = ZERO; + b[ 17] = ZERO; + b[ 18] = ZERO; + b[ 19] = ZERO; + b[ 20] = ZERO; + b[ 21] = ZERO; + b[ 22] = ZERO; + b[ 23] = ZERO; + b[ 24] = ZERO; + b[ 25] = ZERO; + b[ 26] = ZERO; + b[ 27] = ZERO; +#ifdef UNIT + b[ 28] = ONE; + b[ 29] = ZERO; +#else + b[ 28] = *(a15 + 28); + b[ 29] = *(a15 + 29); +#endif + b[ 30] = *(a15 + 30); + b[ 31] = *(a15 + 31); + b += 32; + } + } + } + + posY += 16; + js --; + } while (js > 0); + } /* End of main loop */ + + + if (n & 8){ + X = posX; + + if (posX <= posY) { + a01 = a + posY * 2 + (posX + 0) * lda; + a02 = a + posY * 2 + (posX + 1) * lda; + a03 = a + posY * 2 + (posX + 2) * lda; + a04 = a + posY * 2 + (posX + 3) * lda; + a05 = a + posY * 2 + (posX + 4) * lda; + a06 = a + posY * 2 + (posX + 5) * lda; + a07 = a + posY * 2 + (posX + 6) * lda; + a08 = a + posY * 2 + (posX + 7) * lda; + } else { + a01 = a + posX * 2 + (posY + 0) * lda; + a02 = a + posX * 2 + (posY + 1) * lda; + a03 = a + posX * 2 + (posY + 2) * lda; + a04 = a + posX * 2 + (posY + 3) * lda; + a05 = a + posX * 2 + (posY + 4) * lda; + a06 = a + posX * 2 + (posY + 5) * lda; + a07 = a + posX * 2 + (posY + 6) * lda; + a08 = a + posX * 2 + (posY + 7) * lda; + } + + i = (m >> 3); + if (i > 0) { + do { + if (X > posY) { + a01 += 16; + a02 += 16; + a03 += 16; + a04 += 16; + a05 += 16; + a06 += 16; + a07 += 16; + a08 += 16; + b += 128; + } else + if (X < posY) { + for (ii = 0; ii < 8; ii++){ + + b[ 0] = *(a01 + 0); + b[ 1] = *(a01 + 1); + b[ 2] = *(a01 + 2); + b[ 3] = *(a01 + 3); + b[ 4] = *(a01 + 4); + b[ 5] = *(a01 + 5); + b[ 6] = *(a01 + 6); + b[ 7] = *(a01 + 7); + + b[ 8] = *(a01 + 8); + b[ 9] = *(a01 + 9); + b[ 10] = *(a01 + 10); + b[ 11] = *(a01 + 11); + b[ 12] = *(a01 + 12); + b[ 13] = *(a01 + 13); + b[ 14] = *(a01 + 14); + b[ 15] = *(a01 + 15); + + a01 += lda; + b += 16; + } + a02 += 8 * lda; + a03 += 8 * lda; + a04 += 8 * lda; + a05 += 8 * lda; + a06 += 8 * lda; + a07 += 8 * lda; + a08 += 8 * lda; + } else { +#ifdef UNIT + b[ 0] = ONE; + b[ 1] = ZERO; +#else + b[ 0] = *(a01 + 0); + b[ 1] = *(a01 + 1); +#endif + b[ 2] = *(a01 + 2); + b[ 3] = *(a01 + 3); + b[ 4] = *(a01 + 4); + b[ 5] = *(a01 + 5); + b[ 6] = *(a01 + 6); + b[ 7] = *(a01 + 7); + b[ 8] = *(a01 + 8); + b[ 9] = *(a01 + 9); + b[ 10] = *(a01 + 10); + b[ 11] = *(a01 + 11); + b[ 12] = *(a01 + 12); + b[ 13] = *(a01 + 13); + b[ 14] = *(a01 + 14); + b[ 15] = *(a01 + 15); + + b[ 16] = ZERO; + b[ 17] = ZERO; +#ifdef UNIT + b[ 18] = ONE; + b[ 19] = ZERO; +#else + b[ 18] = *(a02 + 2); + b[ 19] = *(a02 + 3); +#endif + b[ 20] = *(a02 + 4); + b[ 21] = *(a02 + 5); + b[ 22] = *(a02 + 6); + b[ 23] = *(a02 + 7); + b[ 24] = *(a02 + 8); + b[ 25] = *(a02 + 9); + b[ 26] = *(a02 + 10); + b[ 27] = *(a02 + 11); + b[ 28] = *(a02 + 12); + b[ 29] = *(a02 + 13); + b[ 30] = *(a02 + 14); + b[ 31] = *(a02 + 15); + + b[ 32] = ZERO; + b[ 33] = ZERO; + b[ 34] = ZERO; + b[ 35] = ZERO; +#ifdef UNIT + b[ 36] = ONE; + b[ 37] = ZERO; +#else + b[ 36] = *(a03 + 4); + b[ 37] = *(a03 + 5); +#endif + b[ 38] = *(a03 + 6); + b[ 39] = *(a03 + 7); + b[ 40] = *(a03 + 8); + b[ 41] = *(a03 + 9); + b[ 42] = *(a03 + 10); + b[ 43] = *(a03 + 11); + b[ 44] = *(a03 + 12); + b[ 45] = *(a03 + 13); + b[ 46] = *(a03 + 14); + b[ 47] = *(a03 + 15); + + b[ 48] = ZERO; + b[ 49] = ZERO; + b[ 50] = ZERO; + b[ 51] = ZERO; + b[ 52] = ZERO; + b[ 53] = ZERO; +#ifdef UNIT + b[ 54] = ONE; + b[ 55] = ZERO; +#else + b[ 54] = *(a04 + 6); + b[ 55] = *(a04 + 7); +#endif + b[ 56] = *(a04 + 8); + b[ 57] = *(a04 + 9); + b[ 58] = *(a04 + 10); + b[ 59] = *(a04 + 11); + b[ 60] = *(a04 + 12); + b[ 61] = *(a04 + 13); + b[ 62] = *(a04 + 14); + b[ 63] = *(a04 + 15); + + b[ 64] = ZERO; + b[ 65] = ZERO; + b[ 66] = ZERO; + b[ 67] = ZERO; + b[ 68] = ZERO; + b[ 69] = ZERO; + b[ 70] = ZERO; + b[ 71] = ZERO; +#ifdef UNIT + b[ 72] = ONE; + b[ 73] = ZERO; +#else + b[ 72] = *(a05 + 8); + b[ 73] = *(a05 + 9); +#endif + b[ 74] = *(a05 + 10); + b[ 75] = *(a05 + 11); + b[ 76] = *(a05 + 12); + b[ 77] = *(a05 + 13); + b[ 78] = *(a05 + 14); + b[ 79] = *(a05 + 15); + + b[ 80] = ZERO; + b[ 81] = ZERO; + b[ 82] = ZERO; + b[ 83] = ZERO; + b[ 84] = ZERO; + b[ 85] = ZERO; + b[ 86] = ZERO; + b[ 87] = ZERO; + b[ 88] = ZERO; + b[ 89] = ZERO; +#ifdef UNIT + b[ 90] = ONE; + b[ 91] = ZERO; +#else + b[ 90] = *(a06 + 10); + b[ 91] = *(a06 + 11); +#endif + b[ 92] = *(a06 + 12); + b[ 93] = *(a06 + 13); + b[ 94] = *(a06 + 14); + b[ 95] = *(a06 + 15); + + b[ 96] = ZERO; + b[ 97] = ZERO; + b[ 98] = ZERO; + b[ 99] = ZERO; + b[100] = ZERO; + b[101] = ZERO; + b[102] = ZERO; + b[103] = ZERO; + b[104] = ZERO; + b[105] = ZERO; + b[106] = ZERO; + b[107] = ZERO; +#ifdef UNIT + b[108] = ONE; + b[109] = ZERO; +#else + b[108] = *(a07 + 12); + b[109] = *(a07 + 13); +#endif + b[110] = *(a07 + 14); + b[111] = *(a07 + 15); + + b[112] = ZERO; + b[113] = ZERO; + b[114] = ZERO; + b[115] = ZERO; + b[116] = ZERO; + b[117] = ZERO; + b[118] = ZERO; + b[119] = ZERO; + b[120] = ZERO; + b[121] = ZERO; + b[122] = ZERO; + b[123] = ZERO; + b[124] = ZERO; + b[125] = ZERO; +#ifdef UNIT + b[126] = ONE; + b[127] = ZERO; +#else + b[126] = *(a08 + 14); + b[127] = *(a08 + 15); +#endif + + a01 += 16; + a02 += 16; + a03 += 16; + a04 += 16; + a05 += 16; + a06 += 16; + a07 += 16; + a08 += 16; + b += 128; + } + + X += 8; + i --; + } while (i > 0); + } + + i = (m & 7); + if (i) { + + if (X > posY) { + /* a01 += 2 * i; + a02 += 2 * i; + a03 += 2 * i; + a04 += 2 * i; + a05 += 2 * i; + a06 += 2 * i; + a07 += 2 * i; + a08 += 2 * i; */ + b += 16 * i; + } else + if (X < posY) { + for (ii = 0; ii < i; ii++){ + b[ 0] = *(a01 + 0); + b[ 1] = *(a01 + 1); + b[ 2] = *(a01 + 2); + b[ 3] = *(a01 + 3); + b[ 4] = *(a01 + 4); + b[ 5] = *(a01 + 5); + b[ 6] = *(a01 + 6); + b[ 7] = *(a01 + 7); + + b[ 8] = *(a01 + 8); + b[ 9] = *(a01 + 9); + b[ 10] = *(a01 + 10); + b[ 11] = *(a01 + 11); + b[ 12] = *(a01 + 12); + b[ 13] = *(a01 + 13); + b[ 14] = *(a01 + 14); + b[ 15] = *(a01 + 15); + + a01 += lda; + a02 += lda; + a03 += lda; + a04 += lda; + a05 += lda; + a06 += lda; + a07 += lda; + a08 += lda; + b += 16; + } + } else { +#ifdef UNIT + b[ 0] = ONE; + b[ 1] = ZERO; +#else + b[ 0] = *(a01 + 0); + b[ 1] = *(a01 + 1); +#endif + b[ 2] = *(a01 + 2); + b[ 3] = *(a01 + 3); + b[ 4] = *(a01 + 4); + b[ 5] = *(a01 + 5); + b[ 6] = *(a01 + 6); + b[ 7] = *(a01 + 7); + + b[ 8] = *(a01 + 8); + b[ 9] = *(a01 + 9); + b[ 10] = *(a01 + 10); + b[ 11] = *(a01 + 11); + b[ 12] = *(a01 + 12); + b[ 13] = *(a01 + 13); + b[ 14] = *(a01 + 14); + b[ 15] = *(a01 + 15); + b += 16; + + if (i >= 2) { + b[ 0] = ZERO; + b[ 1] = ZERO; +#ifdef UNIT + b[ 2] = ONE; + b[ 3] = ZERO; +#else + b[ 2] = *(a02 + 2); + b[ 3] = *(a02 + 3); +#endif + b[ 4] = *(a02 + 4); + b[ 5] = *(a02 + 5); + b[ 6] = *(a02 + 6); + b[ 7] = *(a02 + 7); + + b[ 8] = *(a02 + 8); + b[ 9] = *(a02 + 9); + b[10] = *(a02 + 10); + b[11] = *(a02 + 11); + b[12] = *(a02 + 12); + b[13] = *(a02 + 13); + b[14] = *(a02 + 14); + b[15] = *(a02 + 15); + b += 16; + } + + if (i >= 3) { + b[ 0] = ZERO; + b[ 1] = ZERO; + b[ 2] = ZERO; + b[ 3] = ZERO; +#ifdef UNIT + b[ 4] = ONE; + b[ 5] = ZERO; +#else + b[ 4] = *(a03 + 4); + b[ 5] = *(a03 + 5); +#endif + b[ 6] = *(a03 + 6); + b[ 7] = *(a03 + 7); + + b[ 8] = *(a03 + 8); + b[ 9] = *(a03 + 9); + b[10] = *(a03 + 10); + b[11] = *(a03 + 11); + b[12] = *(a03 + 12); + b[13] = *(a03 + 13); + b[14] = *(a03 + 14); + b[15] = *(a03 + 15); + b += 16; + } + + if (i >= 4) { + b[ 0] = ZERO; + b[ 1] = ZERO; + b[ 2] = ZERO; + b[ 3] = ZERO; + b[ 4] = ZERO; + b[ 5] = ZERO; +#ifdef UNIT + b[ 6] = ONE; + b[ 7] = ZERO; +#else + b[ 6] = *(a04 + 6); + b[ 7] = *(a04 + 7); +#endif + + b[ 8] = *(a04 + 8); + b[ 9] = *(a04 + 9); + b[10] = *(a04 + 10); + b[11] = *(a04 + 11); + b[12] = *(a04 + 12); + b[13] = *(a04 + 13); + b[14] = *(a04 + 14); + b[15] = *(a04 + 15); + b += 16; + } + + if (i >= 5) { + b[ 0] = ZERO; + b[ 1] = ZERO; + b[ 2] = ZERO; + b[ 3] = ZERO; + b[ 4] = ZERO; + b[ 5] = ZERO; + b[ 6] = ZERO; + b[ 7] = ZERO; + +#ifdef UNIT + b[ 8] = ONE; + b[ 9] = ZERO; +#else + b[ 8] = *(a05 + 8); + b[ 9] = *(a05 + 9); +#endif + b[10] = *(a05 + 10); + b[11] = *(a05 + 11); + b[12] = *(a05 + 12); + b[13] = *(a05 + 13); + b[14] = *(a05 + 14); + b[15] = *(a05 + 15); + b += 16; + } + + if (i >= 6) { + b[ 0] = ZERO; + b[ 1] = ZERO; + b[ 2] = ZERO; + b[ 3] = ZERO; + b[ 4] = ZERO; + b[ 5] = ZERO; + b[ 6] = ZERO; + b[ 7] = ZERO; + + b[ 8] = ZERO; + b[ 9] = ZERO; +#ifdef UNIT + b[10] = ONE; + b[11] = ZERO; +#else + b[10] = *(a06 + 10); + b[11] = *(a06 + 11); +#endif + b[12] = *(a06 + 12); + b[13] = *(a06 + 13); + b[14] = *(a06 + 14); + b[15] = *(a06 + 15); + b += 16; + } + + if (i >= 7) { + b[ 0] = ZERO; + b[ 1] = ZERO; + b[ 2] = ZERO; + b[ 3] = ZERO; + b[ 4] = ZERO; + b[ 5] = ZERO; + b[ 6] = ZERO; + b[ 7] = ZERO; + + b[ 8] = ZERO; + b[ 9] = ZERO; + b[10] = ZERO; + b[11] = ZERO; +#ifdef UNIT + b[12] = ONE; + b[13] = ZERO; +#else + b[12] = *(a07 + 12); + b[13] = *(a07 + 13); +#endif + b[14] = *(a07 + 14); + b[15] = *(a07 + 15); + b += 16; + } + } + } + + posY += 8; + } + + + if (n & 4){ + X = posX; + + if (posX <= posY) { + a01 = a + posY * 2 + (posX + 0) * lda; + a02 = a + posY * 2 + (posX + 1) * lda; + a03 = a + posY * 2 + (posX + 2) * lda; + a04 = a + posY * 2 + (posX + 3) * lda; + } else { + a01 = a + posX * 2 + (posY + 0) * lda; + a02 = a + posX * 2 + (posY + 1) * lda; + a03 = a + posX * 2 + (posY + 2) * lda; + a04 = a + posX * 2 + (posY + 3) * lda; + } + + i = (m >> 2); + if (i > 0) { + do { + if (X > posY) { + a01 += 8; + a02 += 8; + a03 += 8; + a04 += 8; + b += 32; + } else + if (X < posY) { + for (ii = 0; ii < 4; ii++){ + b[ 0] = *(a01 + 0); + b[ 1] = *(a01 + 1); + b[ 2] = *(a01 + 2); + b[ 3] = *(a01 + 3); + b[ 4] = *(a01 + 4); + b[ 5] = *(a01 + 5); + b[ 6] = *(a01 + 6); + b[ 7] = *(a01 + 7); + + a01 += lda; + b += 8; + } + + a02 += 4 * lda; + a03 += 4 * lda; + a04 += 4 * lda; + } else { +#ifdef UNIT + b[ 0] = ONE; + b[ 1] = ZERO; +#else + b[ 0] = *(a01 + 0); + b[ 1] = *(a01 + 1); +#endif + b[ 2] = *(a01 + 2); + b[ 3] = *(a01 + 3); + b[ 4] = *(a01 + 4); + b[ 5] = *(a01 + 5); + b[ 6] = *(a01 + 6); + b[ 7] = *(a01 + 7); + + b[ 8] = ZERO; + b[ 9] = ZERO; +#ifdef UNIT + b[ 10] = ONE; + b[ 11] = ZERO; +#else + b[ 10] = *(a02 + 2); + b[ 11] = *(a02 + 3); +#endif + b[ 12] = *(a02 + 4); + b[ 13] = *(a02 + 5); + b[ 14] = *(a02 + 6); + b[ 15] = *(a02 + 7); + + b[ 16] = ZERO; + b[ 17] = ZERO; + b[ 18] = ZERO; + b[ 19] = ZERO; +#ifdef UNIT + b[ 20] = ONE; + b[ 21] = ZERO; +#else + b[ 20] = *(a03 + 4); + b[ 21] = *(a03 + 5); +#endif + b[ 22] = *(a03 + 6); + b[ 23] = *(a03 + 7); + + b[ 24] = ZERO; + b[ 25] = ZERO; + b[ 26] = ZERO; + b[ 27] = ZERO; + b[ 28] = ZERO; + b[ 29] = ZERO; +#ifdef UNIT + b[ 30] = ONE; + b[ 31] = ZERO; +#else + b[ 30] = *(a04 + 6); + b[ 31] = *(a04 + 7); +#endif + + a01 += 8; + a02 += 8; + a03 += 8; + a04 += 8; + b += 32; + } + + X += 4; + i --; + } while (i > 0); + } + + i = (m & 3); + if (i > 0) { + if (X > posY) { + /* a01 += 2 * i; + a02 += 2 * i; + a03 += 2 * i; + a04 += 2 * i; */ + b += 8 * i; + } else + if (X < posY) { + for (ii = 0; ii < i; ii++){ + b[ 0] = *(a01 + 0); + b[ 1] = *(a01 + 1); + b[ 2] = *(a01 + 2); + b[ 3] = *(a01 + 3); + b[ 4] = *(a01 + 4); + b[ 5] = *(a01 + 5); + b[ 6] = *(a01 + 6); + b[ 7] = *(a01 + 7); + + a01 += lda; + a02 += lda; + a03 += lda; + a04 += lda; + b += 8; + } + } else { +#ifdef UNIT + b[ 0] = ONE; + b[ 1] = ZERO; +#else + b[ 0] = *(a01 + 0); + b[ 1] = *(a01 + 1); +#endif + b[ 2] = *(a01 + 2); + b[ 3] = *(a01 + 3); + b[ 4] = *(a01 + 4); + b[ 5] = *(a01 + 5); + b[ 6] = *(a01 + 6); + b[ 7] = *(a01 + 7); + b += 8; + + if (i >= 2) { + b[ 0] = ZERO; + b[ 1] = ZERO; +#ifdef UNIT + b[ 2] = ONE; + b[ 3] = ZERO; +#else + b[ 2] = *(a02 + 2); + b[ 3] = *(a02 + 3); +#endif + b[ 4] = *(a02 + 4); + b[ 5] = *(a02 + 5); + b[ 6] = *(a02 + 6); + b[ 7] = *(a02 + 7); + b += 8; + } + + if (i >= 3) { + b[ 0] = ZERO; + b[ 1] = ZERO; + b[ 2] = ZERO; + b[ 3] = ZERO; +#ifdef UNIT + b[ 4] = ONE; + b[ 5] = ZERO; +#else + b[ 4] = *(a03 + 4); + b[ 5] = *(a03 + 5); +#endif + b[ 6] = *(a03 + 6); + b[ 7] = *(a03 + 7); + b += 8; + } + } + } + posY += 4; + } + + if (n & 2){ + X = posX; + + if (posX <= posY) { + a01 = a + posY * 2 + (posX + 0) * lda; + a02 = a + posY * 2 + (posX + 1) * lda; + } else { + a01 = a + posX * 2 + (posY + 0) * lda; + a02 = a + posX * 2 + (posY + 1) * lda; + } + + i = (m >> 1); + if (i > 0) { + do { + if (X > posY) { + a01 += 4; + a02 += 4; + b += 8; + } else + if (X < posY) { + b[0] = *(a01 + 0); + b[1] = *(a01 + 1); + b[2] = *(a01 + 2); + b[3] = *(a01 + 3); + b[4] = *(a02 + 0); + b[5] = *(a02 + 1); + b[6] = *(a02 + 2); + b[7] = *(a02 + 3); + a01 += 2 * lda; + a02 += 2 * lda; + b += 8; + } else { +#ifdef UNIT + b[0] = ONE; + b[1] = ZERO; +#else + b[0] = *(a01 + 0); + b[1] = *(a01 + 1); +#endif + b[2] = *(a01 + 2); + b[3] = *(a01 + 3); + + b[4] = ZERO; + b[5] = ZERO; +#ifdef UNIT + b[6] = ONE; + b[7] = ZERO; +#else + b[6] = *(a02 + 2); + b[7] = *(a02 + 3); +#endif + a01 += 4; + a02 += 4; + b += 8; + } + + X += 2; + i --; + } while (i > 0); + } + + i = (m & 1); + if (i > 0) { + if (X > posY) { + /* a01 += 2; + a02 += 2; */ + b += 4; + } else + if (X < posY) { + b[ 0] = *(a01 + 0); + b[ 1] = *(a01 + 1); + b[ 2] = *(a01 + 2); + b[ 3] = *(a01 + 3); + + /* a01 += lda; + a02 += lda; */ + b += 4; + } else { +#ifdef UNIT + b[ 0] = ONE; + b[ 1] = ZERO; +#else + b[ 0] = *(a01 + 0); + b[ 1] = *(a01 + 1); +#endif + b[ 2] = *(a01 + 2); + b[ 3] = *(a01 + 3); + b += 4; + } + } + posY += 2; + } + + if (n & 1){ + X = posX; + + if (posX <= posY) { + a01 = a + posY * 2 + (posX + 0) * lda; + } else { + a01 = a + posX * 2 + (posY + 0) * lda; + } + + i = m; + if (i > 0) { + do { + + if (X > posY) { + a01 += 2; + b += 2; + } else + if (X < posY) { + b[0] = *(a01 + 0); + b[1] = *(a01 + 1); + a01 += lda; + b += 2; + } else { +#ifdef UNIT + b[0] = ONE; + b[1] = ZERO; +#else + b[0] = *(a01 + 0); + b[1] = *(a01 + 1); +#endif + a01 += 2; + b += 2; + } + + X += 1; + i --; + } while (i > 0); + } + // posY += 1; + } + + return 0; +} diff --git a/kernel/generic/ztrmm_uncopy_16.c b/kernel/generic/ztrmm_uncopy_16.c new file mode 100644 index 000000000..40b85db38 --- /dev/null +++ b/kernel/generic/ztrmm_uncopy_16.c @@ -0,0 +1,2316 @@ +/******************************************************************************* +Copyright (c) 2024, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 +#include "common.h" + +int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG posX, BLASLONG posY, FLOAT *b){ + + BLASLONG i, js; + BLASLONG X, ii; + + FLOAT *a01, *a02, *a03, *a04, *a05, *a06, *a07, *a08; + FLOAT *a09, *a10, *a11, *a12, *a13, *a14, *a15, *a16; + + lda += lda; + + js = (n >> 4); + + if (js > 0){ + do { + X = posX; + + if (posX <= posY) { + a01 = a + posX * 2 + (posY + 0) * lda; + a02 = a + posX * 2 + (posY + 1) * lda; + a03 = a + posX * 2 + (posY + 2) * lda; + a04 = a + posX * 2 + (posY + 3) * lda; + a05 = a + posX * 2 + (posY + 4) * lda; + a06 = a + posX * 2 + (posY + 5) * lda; + a07 = a + posX * 2 + (posY + 6) * lda; + a08 = a + posX * 2 + (posY + 7) * lda; + a09 = a + posX * 2 + (posY + 8) * lda; + a10 = a + posX * 2 + (posY + 9) * lda; + a11 = a + posX * 2 + (posY + 10) * lda; + a12 = a + posX * 2 + (posY + 11) * lda; + a13 = a + posX * 2 + (posY + 12) * lda; + a14 = a + posX * 2 + (posY + 13) * lda; + a15 = a + posX * 2 + (posY + 14) * lda; + a16 = a + posX * 2 + (posY + 15) * lda; + } else { + a01 = a + posY * 2 + (posX + 0) * lda; + a02 = a + posY * 2 + (posX + 1) * lda; + a03 = a + posY * 2 + (posX + 2) * lda; + a04 = a + posY * 2 + (posX + 3) * lda; + a05 = a + posY * 2 + (posX + 4) * lda; + a06 = a + posY * 2 + (posX + 5) * lda; + a07 = a + posY * 2 + (posX + 6) * lda; + a08 = a + posY * 2 + (posX + 7) * lda; + a09 = a + posY * 2 + (posX + 8) * lda; + a10 = a + posY * 2 + (posX + 9) * lda; + a11 = a + posY * 2 + (posX + 10) * lda; + a12 = a + posY * 2 + (posX + 11) * lda; + a13 = a + posY * 2 + (posX + 12) * lda; + a14 = a + posY * 2 + (posX + 13) * lda; + a15 = a + posY * 2 + (posX + 14) * lda; + a16 = a + posY * 2 + (posX + 15) * lda; + } + + i = (m >> 4); + if (i > 0) { + do { + if (X < posY) { + for (ii = 0; ii < 16; ii++){ + + b[ 0] = *(a01 + 0); + b[ 1] = *(a01 + 1); + b[ 2] = *(a02 + 0); + b[ 3] = *(a02 + 1); + b[ 4] = *(a03 + 0); + b[ 5] = *(a03 + 1); + b[ 6] = *(a04 + 0); + b[ 7] = *(a04 + 1); + + b[ 8] = *(a05 + 0); + b[ 9] = *(a05 + 1); + b[ 10] = *(a06 + 0); + b[ 11] = *(a06 + 1); + b[ 12] = *(a07 + 0); + b[ 13] = *(a07 + 1); + b[ 14] = *(a08 + 0); + b[ 15] = *(a08 + 1); + + b[ 16] = *(a09 + 0); + b[ 17] = *(a09 + 1); + b[ 18] = *(a10 + 0); + b[ 19] = *(a10 + 1); + b[ 20] = *(a11 + 0); + b[ 21] = *(a11 + 1); + b[ 22] = *(a12 + 0); + b[ 23] = *(a12 + 1); + + b[ 24] = *(a13 + 0); + b[ 25] = *(a13 + 1); + b[ 26] = *(a14 + 0); + b[ 27] = *(a14 + 1); + b[ 28] = *(a15 + 0); + b[ 29] = *(a15 + 1); + b[ 30] = *(a16 + 0); + b[ 31] = *(a16 + 1); + + a01 += 2; + a02 += 2; + a03 += 2; + a04 += 2; + a05 += 2; + a06 += 2; + a07 += 2; + a08 += 2; + a09 += 2; + a10 += 2; + a11 += 2; + a12 += 2; + a13 += 2; + a14 += 2; + a15 += 2; + a16 += 2; + b += 32; + } + } else + if (X > posY) { + a01 += 16 * lda; + a02 += 16 * lda; + a03 += 16 * lda; + a04 += 16 * lda; + a05 += 16 * lda; + a06 += 16 * lda; + a07 += 16 * lda; + a08 += 16 * lda; + a09 += 16 * lda; + a10 += 16 * lda; + a11 += 16 * lda; + a12 += 16 * lda; + a13 += 16 * lda; + a14 += 16 * lda; + a15 += 16 * lda; + a16 += 16 * lda; + + b += 512; + + } else { +#ifdef UNIT + b[ 0] = ONE; + b[ 1] = ZERO; +#else + b[ 0] = *(a01 + 0); + b[ 1] = *(a01 + 1); +#endif + b[ 2] = *(a02 + 0); + b[ 3] = *(a02 + 1); + b[ 4] = *(a03 + 0); + b[ 5] = *(a03 + 1); + b[ 6] = *(a04 + 0); + b[ 7] = *(a04 + 1); + b[ 8] = *(a05 + 0); + b[ 9] = *(a05 + 1); + b[ 10] = *(a06 + 0); + b[ 11] = *(a06 + 1); + b[ 12] = *(a07 + 0); + b[ 13] = *(a07 + 1); + b[ 14] = *(a08 + 0); + b[ 15] = *(a08 + 1); + b[ 16] = *(a09 + 0); + b[ 17] = *(a09 + 1); + b[ 18] = *(a10 + 0); + b[ 19] = *(a10 + 1); + b[ 20] = *(a11 + 0); + b[ 21] = *(a11 + 1); + b[ 22] = *(a12 + 0); + b[ 23] = *(a12 + 1); + b[ 24] = *(a13 + 0); + b[ 25] = *(a13 + 1); + b[ 26] = *(a14 + 0); + b[ 27] = *(a14 + 1); + b[ 28] = *(a15 + 0); + b[ 29] = *(a15 + 1); + b[ 30] = *(a16 + 0); + b[ 31] = *(a16 + 1); + + b[ 32] = ZERO; + b[ 33] = ZERO; +#ifdef UNIT + b[ 34] = ONE; + b[ 35] = ZERO; +#else + b[ 34] = *(a02 + 2); + b[ 35] = *(a02 + 3); +#endif + b[ 36] = *(a03 + 2); + b[ 37] = *(a03 + 3); + b[ 38] = *(a04 + 2); + b[ 39] = *(a04 + 3); + b[ 40] = *(a05 + 2); + b[ 41] = *(a05 + 3); + b[ 42] = *(a06 + 2); + b[ 43] = *(a06 + 3); + b[ 44] = *(a07 + 2); + b[ 45] = *(a07 + 3); + b[ 46] = *(a08 + 2); + b[ 47] = *(a08 + 3); + b[ 48] = *(a09 + 2); + b[ 49] = *(a09 + 3); + b[ 50] = *(a10 + 2); + b[ 51] = *(a10 + 3); + b[ 52] = *(a11 + 2); + b[ 53] = *(a11 + 3); + b[ 54] = *(a12 + 2); + b[ 55] = *(a12 + 3); + b[ 56] = *(a13 + 2); + b[ 57] = *(a13 + 3); + b[ 58] = *(a14 + 2); + b[ 59] = *(a14 + 3); + b[ 60] = *(a15 + 2); + b[ 61] = *(a15 + 3); + b[ 62] = *(a16 + 2); + b[ 63] = *(a16 + 3); + + b[ 64] = ZERO; + b[ 65] = ZERO; + b[ 66] = ZERO; + b[ 67] = ZERO; +#ifdef UNIT + b[ 68] = ONE; + b[ 69] = ZERO; +#else + b[ 68] = *(a03 + 4); + b[ 69] = *(a03 + 5); +#endif + b[ 70] = *(a04 + 4); + b[ 71] = *(a04 + 5); + b[ 72] = *(a05 + 4); + b[ 73] = *(a05 + 5); + b[ 74] = *(a06 + 4); + b[ 75] = *(a06 + 5); + b[ 76] = *(a07 + 4); + b[ 77] = *(a07 + 5); + b[ 78] = *(a08 + 4); + b[ 79] = *(a08 + 5); + b[ 80] = *(a09 + 4); + b[ 81] = *(a09 + 5); + b[ 82] = *(a10 + 4); + b[ 83] = *(a10 + 5); + b[ 84] = *(a11 + 4); + b[ 85] = *(a11 + 5); + b[ 86] = *(a12 + 4); + b[ 87] = *(a12 + 5); + b[ 88] = *(a13 + 4); + b[ 89] = *(a13 + 5); + b[ 90] = *(a14 + 4); + b[ 91] = *(a14 + 5); + b[ 92] = *(a15 + 4); + b[ 93] = *(a15 + 5); + b[ 94] = *(a16 + 4); + b[ 95] = *(a16 + 5); + + b[ 96] = ZERO; + b[ 97] = ZERO; + b[ 98] = ZERO; + b[ 99] = ZERO; + b[100] = ZERO; + b[101] = ZERO; +#ifdef UNIT + b[102] = ONE; + b[103] = ZERO; +#else + b[102] = *(a04 + 6); + b[103] = *(a04 + 7); +#endif + b[104] = *(a05 + 6); + b[105] = *(a05 + 7); + b[106] = *(a06 + 6); + b[107] = *(a06 + 7); + b[108] = *(a07 + 6); + b[109] = *(a07 + 7); + b[110] = *(a08 + 6); + b[111] = *(a08 + 7); + b[112] = *(a09 + 6); + b[113] = *(a09 + 7); + b[114] = *(a10 + 6); + b[115] = *(a10 + 7); + b[116] = *(a11 + 6); + b[117] = *(a11 + 7); + b[118] = *(a12 + 6); + b[119] = *(a12 + 7); + b[120] = *(a13 + 6); + b[121] = *(a13 + 7); + b[122] = *(a14 + 6); + b[123] = *(a14 + 7); + b[124] = *(a15 + 6); + b[125] = *(a15 + 7); + b[126] = *(a16 + 6); + b[127] = *(a16 + 7); + + b[128] = ZERO; + b[129] = ZERO; + b[130] = ZERO; + b[131] = ZERO; + b[132] = ZERO; + b[133] = ZERO; + b[134] = ZERO; + b[135] = ZERO; +#ifdef UNIT + b[136] = ONE; + b[137] = ZERO; +#else + b[136] = *(a05 + 8); + b[137] = *(a05 + 9); +#endif + b[138] = *(a06 + 8); + b[139] = *(a06 + 9); + b[140] = *(a07 + 8); + b[141] = *(a07 + 9); + b[142] = *(a08 + 8); + b[143] = *(a08 + 9); + b[144] = *(a09 + 8); + b[145] = *(a09 + 9); + b[146] = *(a10 + 8); + b[147] = *(a10 + 9); + b[148] = *(a11 + 8); + b[149] = *(a11 + 9); + b[150] = *(a12 + 8); + b[151] = *(a12 + 9); + b[152] = *(a13 + 8); + b[153] = *(a13 + 9); + b[154] = *(a14 + 8); + b[155] = *(a14 + 9); + b[156] = *(a15 + 8); + b[157] = *(a15 + 9); + b[158] = *(a16 + 8); + b[159] = *(a16 + 9); + + b[160] = ZERO; + b[161] = ZERO; + b[162] = ZERO; + b[163] = ZERO; + b[164] = ZERO; + b[165] = ZERO; + b[166] = ZERO; + b[167] = ZERO; + b[168] = ZERO; + b[169] = ZERO; +#ifdef UNIT + b[170] = ONE; + b[171] = ZERO; +#else + b[170] = *(a06 + 10); + b[171] = *(a06 + 11); +#endif + b[172] = *(a07 + 10); + b[173] = *(a07 + 11); + b[174] = *(a08 + 10); + b[175] = *(a08 + 11); + b[176] = *(a09 + 10); + b[177] = *(a09 + 11); + b[178] = *(a10 + 10); + b[179] = *(a10 + 11); + b[180] = *(a11 + 10); + b[181] = *(a11 + 11); + b[182] = *(a12 + 10); + b[183] = *(a12 + 11); + b[184] = *(a13 + 10); + b[185] = *(a13 + 11); + b[186] = *(a14 + 10); + b[187] = *(a14 + 11); + b[188] = *(a15 + 10); + b[189] = *(a15 + 11); + b[190] = *(a16 + 10); + b[191] = *(a16 + 11); + + b[192] = ZERO; + b[193] = ZERO; + b[194] = ZERO; + b[195] = ZERO; + b[196] = ZERO; + b[197] = ZERO; + b[198] = ZERO; + b[199] = ZERO; + b[200] = ZERO; + b[201] = ZERO; + b[202] = ZERO; + b[203] = ZERO; +#ifdef UNIT + b[204] = ONE; + b[205] = ZERO; +#else + b[204] = *(a07 + 12); + b[205] = *(a07 + 13); +#endif + b[206] = *(a08 + 12); + b[207] = *(a08 + 13); + b[208] = *(a09 + 12); + b[209] = *(a09 + 13); + b[210] = *(a10 + 12); + b[211] = *(a10 + 13); + b[212] = *(a11 + 12); + b[213] = *(a11 + 13); + b[214] = *(a12 + 12); + b[215] = *(a12 + 13); + b[216] = *(a13 + 12); + b[217] = *(a13 + 13); + b[218] = *(a14 + 12); + b[219] = *(a14 + 13); + b[220] = *(a15 + 12); + b[221] = *(a15 + 13); + b[222] = *(a16 + 12); + b[223] = *(a16 + 13); + + b[224] = ZERO; + b[225] = ZERO; + b[226] = ZERO; + b[227] = ZERO; + b[228] = ZERO; + b[229] = ZERO; + b[230] = ZERO; + b[231] = ZERO; + b[232] = ZERO; + b[233] = ZERO; + b[234] = ZERO; + b[235] = ZERO; + b[236] = ZERO; + b[237] = ZERO; +#ifdef UNIT + b[238] = ONE; + b[239] = ZERO; +#else + b[238] = *(a08 + 14); + b[239] = *(a08 + 15); +#endif + b[240] = *(a09 + 14); + b[241] = *(a09 + 15); + b[242] = *(a10 + 14); + b[243] = *(a10 + 15); + b[244] = *(a11 + 14); + b[245] = *(a11 + 15); + b[246] = *(a12 + 14); + b[247] = *(a12 + 15); + b[248] = *(a13 + 14); + b[249] = *(a13 + 15); + b[250] = *(a14 + 14); + b[251] = *(a14 + 15); + b[252] = *(a15 + 14); + b[253] = *(a15 + 15); + b[254] = *(a16 + 14); + b[255] = *(a16 + 15); + + b[256] = ZERO; + b[257] = ZERO; + b[258] = ZERO; + b[259] = ZERO; + b[260] = ZERO; + b[261] = ZERO; + b[262] = ZERO; + b[263] = ZERO; + b[264] = ZERO; + b[265] = ZERO; + b[266] = ZERO; + b[267] = ZERO; + b[268] = ZERO; + b[269] = ZERO; + b[270] = ZERO; + b[271] = ZERO; +#ifdef UNIT + b[272] = ONE; + b[273] = ZERO; +#else + b[272] = *(a09 + 16); + b[273] = *(a09 + 17); +#endif + b[274] = *(a10 + 16); + b[275] = *(a10 + 17); + b[276] = *(a11 + 16); + b[277] = *(a11 + 17); + b[278] = *(a12 + 16); + b[279] = *(a12 + 17); + b[280] = *(a13 + 16); + b[281] = *(a13 + 17); + b[282] = *(a14 + 16); + b[283] = *(a14 + 17); + b[284] = *(a15 + 16); + b[285] = *(a15 + 17); + b[286] = *(a16 + 16); + b[287] = *(a16 + 17); + + b[288] = ZERO; + b[289] = ZERO; + b[290] = ZERO; + b[291] = ZERO; + b[292] = ZERO; + b[293] = ZERO; + b[294] = ZERO; + b[295] = ZERO; + b[296] = ZERO; + b[297] = ZERO; + b[298] = ZERO; + b[299] = ZERO; + b[300] = ZERO; + b[301] = ZERO; + b[302] = ZERO; + b[303] = ZERO; + b[304] = ZERO; + b[305] = ZERO; +#ifdef UNIT + b[306] = ONE; + b[307] = ZERO; +#else + b[306] = *(a10 + 18); + b[307] = *(a10 + 19); +#endif + b[308] = *(a11 + 18); + b[309] = *(a11 + 19); + b[310] = *(a12 + 18); + b[311] = *(a12 + 19); + b[312] = *(a13 + 18); + b[313] = *(a13 + 19); + b[314] = *(a14 + 18); + b[315] = *(a14 + 19); + b[316] = *(a15 + 18); + b[317] = *(a15 + 19); + b[318] = *(a16 + 18); + b[319] = *(a16 + 19); + + b[320] = ZERO; + b[321] = ZERO; + b[322] = ZERO; + b[323] = ZERO; + b[324] = ZERO; + b[325] = ZERO; + b[326] = ZERO; + b[327] = ZERO; + b[328] = ZERO; + b[329] = ZERO; + b[330] = ZERO; + b[331] = ZERO; + b[332] = ZERO; + b[333] = ZERO; + b[334] = ZERO; + b[335] = ZERO; + b[336] = ZERO; + b[337] = ZERO; + b[338] = ZERO; + b[339] = ZERO; +#ifdef UNIT + b[340] = ONE; + b[341] = ZERO; +#else + b[340] = *(a11 + 20); + b[341] = *(a11 + 21); +#endif + b[342] = *(a12 + 20); + b[343] = *(a12 + 21); + b[344] = *(a13 + 20); + b[345] = *(a13 + 21); + b[346] = *(a14 + 20); + b[347] = *(a14 + 21); + b[348] = *(a15 + 20); + b[349] = *(a15 + 21); + b[350] = *(a16 + 20); + b[351] = *(a16 + 21); + + b[352] = ZERO; + b[353] = ZERO; + b[354] = ZERO; + b[355] = ZERO; + b[356] = ZERO; + b[357] = ZERO; + b[358] = ZERO; + b[359] = ZERO; + b[360] = ZERO; + b[361] = ZERO; + b[362] = ZERO; + b[363] = ZERO; + b[364] = ZERO; + b[365] = ZERO; + b[366] = ZERO; + b[367] = ZERO; + b[368] = ZERO; + b[369] = ZERO; + b[370] = ZERO; + b[371] = ZERO; + b[372] = ZERO; + b[373] = ZERO; +#ifdef UNIT + b[374] = ONE; + b[375] = ZERO; +#else + b[374] = *(a12 + 22); + b[375] = *(a12 + 23); +#endif + b[376] = *(a13 + 22); + b[377] = *(a13 + 23); + b[378] = *(a14 + 22); + b[379] = *(a14 + 23); + b[380] = *(a15 + 22); + b[381] = *(a15 + 23); + b[382] = *(a16 + 22); + b[383] = *(a16 + 23); + + b[384] = ZERO; + b[385] = ZERO; + b[386] = ZERO; + b[387] = ZERO; + b[388] = ZERO; + b[389] = ZERO; + b[390] = ZERO; + b[391] = ZERO; + b[392] = ZERO; + b[393] = ZERO; + b[394] = ZERO; + b[395] = ZERO; + b[396] = ZERO; + b[397] = ZERO; + b[398] = ZERO; + b[399] = ZERO; + b[400] = ZERO; + b[401] = ZERO; + b[402] = ZERO; + b[403] = ZERO; + b[404] = ZERO; + b[405] = ZERO; + b[406] = ZERO; + b[407] = ZERO; +#ifdef UNIT + b[408] = ONE; + b[409] = ZERO; +#else + b[408] = *(a13 + 24); + b[409] = *(a13 + 25); +#endif + b[410] = *(a14 + 24); + b[411] = *(a14 + 25); + b[412] = *(a15 + 24); + b[413] = *(a15 + 25); + b[414] = *(a16 + 24); + b[415] = *(a16 + 25); + + b[416] = ZERO; + b[417] = ZERO; + b[418] = ZERO; + b[419] = ZERO; + b[420] = ZERO; + b[421] = ZERO; + b[422] = ZERO; + b[423] = ZERO; + b[424] = ZERO; + b[425] = ZERO; + b[426] = ZERO; + b[427] = ZERO; + b[428] = ZERO; + b[429] = ZERO; + b[430] = ZERO; + b[431] = ZERO; + b[432] = ZERO; + b[433] = ZERO; + b[434] = ZERO; + b[435] = ZERO; + b[436] = ZERO; + b[437] = ZERO; + b[438] = ZERO; + b[439] = ZERO; + b[440] = ZERO; + b[441] = ZERO; +#ifdef UNIT + b[442] = ONE; + b[443] = ZERO; +#else + b[442] = *(a14 + 26); + b[443] = *(a14 + 27); +#endif + b[444] = *(a15 + 26); + b[445] = *(a15 + 27); + b[446] = *(a16 + 26); + b[447] = *(a16 + 27); + + b[448] = ZERO; + b[449] = ZERO; + b[450] = ZERO; + b[451] = ZERO; + b[452] = ZERO; + b[453] = ZERO; + b[454] = ZERO; + b[455] = ZERO; + b[456] = ZERO; + b[457] = ZERO; + b[458] = ZERO; + b[459] = ZERO; + b[460] = ZERO; + b[461] = ZERO; + b[462] = ZERO; + b[463] = ZERO; + b[464] = ZERO; + b[465] = ZERO; + b[466] = ZERO; + b[467] = ZERO; + b[468] = ZERO; + b[469] = ZERO; + b[470] = ZERO; + b[471] = ZERO; + b[472] = ZERO; + b[473] = ZERO; + b[474] = ZERO; + b[475] = ZERO; +#ifdef UNIT + b[476] = ONE; + b[477] = ZERO; +#else + b[476] = *(a15 + 28); + b[477] = *(a15 + 29); +#endif + b[478] = *(a16 + 28); + b[479] = *(a16 + 29); + + b[480] = ZERO; + b[481] = ZERO; + b[482] = ZERO; + b[483] = ZERO; + b[484] = ZERO; + b[485] = ZERO; + b[486] = ZERO; + b[487] = ZERO; + b[488] = ZERO; + b[489] = ZERO; + b[490] = ZERO; + b[491] = ZERO; + b[492] = ZERO; + b[493] = ZERO; + b[494] = ZERO; + b[495] = ZERO; + b[496] = ZERO; + b[497] = ZERO; + b[498] = ZERO; + b[499] = ZERO; + b[500] = ZERO; + b[501] = ZERO; + b[502] = ZERO; + b[503] = ZERO; + b[504] = ZERO; + b[505] = ZERO; + b[506] = ZERO; + b[507] = ZERO; + b[508] = ZERO; + b[509] = ZERO; +#ifdef UNIT + b[510] = ONE; + b[511] = ZERO; +#else + b[510] = *(a16 + 30); + b[511] = *(a16 + 31); +#endif + + a01 += 16 * lda; + a02 += 16 * lda; + a03 += 16 * lda; + a04 += 16 * lda; + a05 += 16 * lda; + a06 += 16 * lda; + a07 += 16 * lda; + a08 += 16 * lda; + a09 += 16 * lda; + a10 += 16 * lda; + a11 += 16 * lda; + a12 += 16 * lda; + a13 += 16 * lda; + a14 += 16 * lda; + a15 += 16 * lda; + a16 += 16 * lda; + b += 512; + } + + X += 16; + i --; + } while (i > 0); + } + + i = (m & 15); + if (i) { + + if (X < posY) { + + for (ii = 0; ii < i; ii++){ + b[ 0] = *(a01 + 0); + b[ 1] = *(a01 + 1); + b[ 2] = *(a02 + 0); + b[ 3] = *(a02 + 1); + b[ 4] = *(a03 + 0); + b[ 5] = *(a03 + 1); + b[ 6] = *(a04 + 0); + b[ 7] = *(a04 + 1); + b[ 8] = *(a05 + 0); + b[ 9] = *(a05 + 1); + b[ 10] = *(a06 + 0); + b[ 11] = *(a06 + 1); + b[ 12] = *(a07 + 0); + b[ 13] = *(a07 + 1); + b[ 14] = *(a08 + 0); + b[ 15] = *(a08 + 1); + + b[ 16] = *(a09 + 0); + b[ 17] = *(a09 + 1); + b[ 18] = *(a10 + 0); + b[ 19] = *(a10 + 1); + b[ 20] = *(a11 + 0); + b[ 21] = *(a11 + 1); + b[ 22] = *(a12 + 0); + b[ 23] = *(a12 + 1); + b[ 24] = *(a13 + 0); + b[ 25] = *(a13 + 1); + b[ 26] = *(a14 + 0); + b[ 27] = *(a14 + 1); + b[ 28] = *(a15 + 0); + b[ 29] = *(a15 + 1); + b[ 30] = *(a16 + 0); + b[ 31] = *(a16 + 1); + + a01 += 2; + a02 += 2; + a03 += 2; + a04 += 2; + a05 += 2; + a06 += 2; + a07 += 2; + a08 += 2; + a09 += 2; + a10 += 2; + a11 += 2; + a12 += 2; + a13 += 2; + a14 += 2; + a15 += 2; + a16 += 2; + b += 32; + } + } else + if (X > posY) { + /* a01 += i * lda; + a02 += i * lda; + a03 += i * lda; + a04 += i * lda; + a05 += i * lda; + a06 += i * lda; + a07 += i * lda; + a08 += i * lda; + a09 += i * lda; + a10 += i * lda; + a11 += i * lda; + a12 += i * lda; + a13 += i * lda; + a14 += i * lda; + a15 += i * lda; + a16 += i * lda; */ + b += 32 * i; + } else { +#ifdef UNIT + b[ 0] = ONE; + b[ 1] = ZERO; +#else + b[ 0] = *(a01 + 0); + b[ 1] = *(a01 + 1); +#endif + b[ 2] = *(a02 + 0); + b[ 3] = *(a02 + 1); + b[ 4] = *(a03 + 0); + b[ 5] = *(a03 + 1); + b[ 6] = *(a04 + 0); + b[ 7] = *(a04 + 1); + b[ 8] = *(a05 + 0); + b[ 9] = *(a05 + 1); + b[ 10] = *(a06 + 0); + b[ 11] = *(a06 + 1); + b[ 12] = *(a07 + 0); + b[ 13] = *(a07 + 1); + b[ 14] = *(a08 + 0); + b[ 15] = *(a08 + 1); + b[ 16] = *(a09 + 0); + b[ 17] = *(a09 + 1); + b[ 18] = *(a10 + 0); + b[ 19] = *(a10 + 1); + b[ 20] = *(a11 + 0); + b[ 21] = *(a11 + 1); + b[ 22] = *(a12 + 0); + b[ 23] = *(a12 + 1); + b[ 24] = *(a13 + 0); + b[ 25] = *(a13 + 1); + b[ 26] = *(a14 + 0); + b[ 27] = *(a14 + 1); + b[ 28] = *(a15 + 0); + b[ 29] = *(a15 + 1); + b[ 30] = *(a16 + 0); + b[ 31] = *(a16 + 1); + b += 32; + + if (i >= 2) { + b[ 0] = ZERO; + b[ 1] = ZERO; +#ifdef UNIT + b[ 2] = ONE; + b[ 3] = ZERO; +#else + b[ 2] = *(a02 + 2); + b[ 3] = *(a02 + 3); +#endif + b[ 4] = *(a03 + 2); + b[ 5] = *(a03 + 3); + b[ 6] = *(a04 + 2); + b[ 7] = *(a04 + 3); + b[ 8] = *(a05 + 2); + b[ 9] = *(a05 + 3); + b[ 10] = *(a06 + 2); + b[ 11] = *(a06 + 3); + b[ 12] = *(a07 + 2); + b[ 13] = *(a07 + 3); + b[ 14] = *(a08 + 2); + b[ 15] = *(a08 + 3); + b[ 16] = *(a09 + 2); + b[ 17] = *(a09 + 3); + b[ 18] = *(a10 + 2); + b[ 19] = *(a10 + 3); + b[ 20] = *(a11 + 2); + b[ 21] = *(a11 + 3); + b[ 22] = *(a12 + 2); + b[ 23] = *(a12 + 3); + b[ 24] = *(a13 + 2); + b[ 25] = *(a13 + 3); + b[ 26] = *(a14 + 2); + b[ 27] = *(a14 + 3); + b[ 28] = *(a15 + 2); + b[ 29] = *(a15 + 3); + b[ 30] = *(a16 + 2); + b[ 31] = *(a16 + 3); + b += 32; + } + + if (i >= 3) { + b[ 0] = ZERO; + b[ 1] = ZERO; + b[ 2] = ZERO; + b[ 3] = ZERO; +#ifdef UNIT + b[ 4] = ONE; + b[ 5] = ZERO; +#else + b[ 4] = *(a03 + 4); + b[ 5] = *(a03 + 5); +#endif + b[ 6] = *(a04 + 4); + b[ 7] = *(a04 + 5); + b[ 8] = *(a05 + 4); + b[ 9] = *(a05 + 5); + b[ 10] = *(a06 + 4); + b[ 11] = *(a06 + 5); + b[ 12] = *(a07 + 4); + b[ 13] = *(a07 + 5); + b[ 14] = *(a08 + 4); + b[ 15] = *(a08 + 5); + b[ 16] = *(a09 + 4); + b[ 17] = *(a09 + 5); + b[ 18] = *(a10 + 4); + b[ 19] = *(a10 + 5); + b[ 20] = *(a11 + 4); + b[ 21] = *(a11 + 5); + b[ 22] = *(a12 + 4); + b[ 23] = *(a12 + 5); + b[ 24] = *(a13 + 4); + b[ 25] = *(a13 + 5); + b[ 26] = *(a14 + 4); + b[ 27] = *(a14 + 5); + b[ 28] = *(a15 + 4); + b[ 29] = *(a15 + 5); + b[ 30] = *(a16 + 4); + b[ 31] = *(a16 + 5); + b += 32; + } + + if (i >= 4) { + b[ 0] = ZERO; + b[ 1] = ZERO; + b[ 2] = ZERO; + b[ 3] = ZERO; + b[ 4] = ZERO; + b[ 5] = ZERO; +#ifdef UNIT + b[ 6] = ONE; + b[ 7] = ZERO; +#else + b[ 6] = *(a04 + 6); + b[ 7] = *(a04 + 7); +#endif + b[ 8] = *(a05 + 6); + b[ 9] = *(a05 + 7); + b[ 10] = *(a06 + 6); + b[ 11] = *(a06 + 7); + b[ 12] = *(a07 + 6); + b[ 13] = *(a07 + 7); + b[ 14] = *(a08 + 6); + b[ 15] = *(a08 + 7); + b[ 16] = *(a09 + 6); + b[ 17] = *(a09 + 7); + b[ 18] = *(a10 + 6); + b[ 19] = *(a10 + 7); + b[ 20] = *(a11 + 6); + b[ 21] = *(a11 + 7); + b[ 22] = *(a12 + 6); + b[ 23] = *(a12 + 7); + b[ 24] = *(a13 + 6); + b[ 25] = *(a13 + 7); + b[ 26] = *(a14 + 6); + b[ 27] = *(a14 + 7); + b[ 28] = *(a15 + 6); + b[ 29] = *(a15 + 7); + b[ 30] = *(a16 + 6); + b[ 31] = *(a16 + 7); + b += 32; + } + + if (i >= 5) { + b[ 0] = ZERO; + b[ 1] = ZERO; + b[ 2] = ZERO; + b[ 3] = ZERO; + b[ 4] = ZERO; + b[ 5] = ZERO; + b[ 6] = ZERO; + b[ 7] = ZERO; +#ifdef UNIT + b[ 8] = ONE; + b[ 9] = ZERO; +#else + b[ 8] = *(a05 + 8); + b[ 9] = *(a05 + 9); +#endif + b[ 10] = *(a06 + 8); + b[ 11] = *(a06 + 9); + b[ 12] = *(a07 + 8); + b[ 13] = *(a07 + 9); + b[ 14] = *(a08 + 8); + b[ 15] = *(a08 + 9); + b[ 16] = *(a09 + 8); + b[ 17] = *(a09 + 9); + b[ 18] = *(a10 + 8); + b[ 19] = *(a10 + 9); + b[ 20] = *(a11 + 8); + b[ 21] = *(a11 + 9); + b[ 22] = *(a12 + 8); + b[ 23] = *(a12 + 9); + b[ 24] = *(a13 + 8); + b[ 25] = *(a13 + 9); + b[ 26] = *(a14 + 8); + b[ 27] = *(a14 + 9); + b[ 28] = *(a15 + 8); + b[ 29] = *(a15 + 9); + b[ 30] = *(a16 + 8); + b[ 31] = *(a16 + 9); + b += 32; + } + + if (i >= 6) { + b[ 0] = ZERO; + b[ 1] = ZERO; + b[ 2] = ZERO; + b[ 3] = ZERO; + b[ 4] = ZERO; + b[ 5] = ZERO; + b[ 6] = ZERO; + b[ 7] = ZERO; + b[ 8] = ZERO; + b[ 9] = ZERO; +#ifdef UNIT + b[10] = ONE; + b[11] = ZERO; +#else + b[10] = *(a06 + 10); + b[11] = *(a06 + 11); +#endif + b[ 12] = *(a07 + 10); + b[ 13] = *(a07 + 11); + b[ 14] = *(a08 + 10); + b[ 15] = *(a08 + 11); + b[ 16] = *(a09 + 10); + b[ 17] = *(a09 + 11); + b[ 18] = *(a10 + 10); + b[ 19] = *(a10 + 11); + b[ 20] = *(a11 + 10); + b[ 21] = *(a11 + 11); + b[ 22] = *(a12 + 10); + b[ 23] = *(a12 + 11); + b[ 24] = *(a13 + 10); + b[ 25] = *(a13 + 11); + b[ 26] = *(a14 + 10); + b[ 27] = *(a14 + 11); + b[ 28] = *(a15 + 10); + b[ 29] = *(a15 + 11); + b[ 30] = *(a16 + 10); + b[ 31] = *(a16 + 11); + b += 32; + } + + if (i >= 7) { + b[ 0] = ZERO; + b[ 1] = ZERO; + b[ 2] = ZERO; + b[ 3] = ZERO; + b[ 4] = ZERO; + b[ 5] = ZERO; + b[ 6] = ZERO; + b[ 7] = ZERO; + b[ 8] = ZERO; + b[ 9] = ZERO; + b[10] = ZERO; + b[11] = ZERO; +#ifdef UNIT + b[12] = ONE; + b[13] = ZERO; +#else + b[12] = *(a07 + 12); + b[13] = *(a07 + 13); +#endif + b[ 14] = *(a08 + 12); + b[ 15] = *(a08 + 13); + b[ 16] = *(a09 + 12); + b[ 17] = *(a09 + 13); + b[ 18] = *(a10 + 12); + b[ 19] = *(a10 + 13); + b[ 20] = *(a11 + 12); + b[ 21] = *(a11 + 13); + b[ 22] = *(a12 + 12); + b[ 23] = *(a12 + 13); + b[ 24] = *(a13 + 12); + b[ 25] = *(a13 + 13); + b[ 26] = *(a14 + 12); + b[ 27] = *(a14 + 13); + b[ 28] = *(a15 + 12); + b[ 29] = *(a15 + 13); + b[ 30] = *(a16 + 12); + b[ 31] = *(a16 + 13); + b += 32; + } + + if (i >= 8) { + b[ 0] = ZERO; + b[ 1] = ZERO; + b[ 2] = ZERO; + b[ 3] = ZERO; + b[ 4] = ZERO; + b[ 5] = ZERO; + b[ 6] = ZERO; + b[ 7] = ZERO; + b[ 8] = ZERO; + b[ 9] = ZERO; + b[10] = ZERO; + b[11] = ZERO; + b[12] = ZERO; + b[13] = ZERO; +#ifdef UNIT + b[ 14] = ONE; + b[ 15] = ZERO; +#else + b[ 14] = *(a08 + 14); + b[ 15] = *(a08 + 15); +#endif + b[ 16] = *(a09 + 14); + b[ 17] = *(a09 + 15); + b[ 18] = *(a10 + 14); + b[ 19] = *(a10 + 15); + b[ 20] = *(a11 + 14); + b[ 21] = *(a11 + 15); + b[ 22] = *(a12 + 14); + b[ 23] = *(a12 + 15); + b[ 24] = *(a13 + 14); + b[ 25] = *(a13 + 15); + b[ 26] = *(a14 + 14); + b[ 27] = *(a14 + 15); + b[ 28] = *(a15 + 14); + b[ 29] = *(a15 + 15); + b[ 30] = *(a16 + 14); + b[ 31] = *(a16 + 15); + b += 32; + } + + if (i >= 9) { + b[ 0] = ZERO; + b[ 1] = ZERO; + b[ 2] = ZERO; + b[ 3] = ZERO; + b[ 4] = ZERO; + b[ 5] = ZERO; + b[ 6] = ZERO; + b[ 7] = ZERO; + b[ 8] = ZERO; + b[ 9] = ZERO; + b[10] = ZERO; + b[11] = ZERO; + b[12] = ZERO; + b[13] = ZERO; + b[ 14] = ZERO; + b[ 15] = ZERO; +#ifdef UNIT + b[ 16] = ONE; + b[ 17] = ZERO; +#else + b[ 16] = *(a09 + 16); + b[ 17] = *(a09 + 17); +#endif + b[ 18] = *(a10 + 16); + b[ 19] = *(a10 + 17); + b[ 20] = *(a11 + 16); + b[ 21] = *(a11 + 17); + b[ 22] = *(a12 + 16); + b[ 23] = *(a12 + 17); + b[ 24] = *(a13 + 16); + b[ 25] = *(a13 + 17); + b[ 26] = *(a14 + 16); + b[ 27] = *(a14 + 17); + b[ 28] = *(a15 + 16); + b[ 29] = *(a15 + 17); + b[ 30] = *(a16 + 16); + b[ 31] = *(a16 + 17); + b += 32; + } + + if (i >= 10) { + b[ 0] = ZERO; + b[ 1] = ZERO; + b[ 2] = ZERO; + b[ 3] = ZERO; + b[ 4] = ZERO; + b[ 5] = ZERO; + b[ 6] = ZERO; + b[ 7] = ZERO; + b[ 8] = ZERO; + b[ 9] = ZERO; + b[10] = ZERO; + b[11] = ZERO; + b[12] = ZERO; + b[13] = ZERO; + b[ 14] = ZERO; + b[ 15] = ZERO; + b[ 16] = ZERO; + b[ 17] = ZERO; +#ifdef UNIT + b[ 18] = ONE; + b[ 19] = ZERO; +#else + b[ 18] = *(a10 + 18); + b[ 19] = *(a10 + 19); +#endif + b[ 20] = *(a11 + 18); + b[ 21] = *(a11 + 19); + b[ 22] = *(a12 + 18); + b[ 23] = *(a12 + 19); + b[ 24] = *(a13 + 18); + b[ 25] = *(a13 + 19); + b[ 26] = *(a14 + 18); + b[ 27] = *(a14 + 19); + b[ 28] = *(a15 + 18); + b[ 29] = *(a15 + 19); + b[ 30] = *(a16 + 18); + b[ 31] = *(a16 + 19); + b += 32; + } + + if (i >= 11) { + b[ 0] = ZERO; + b[ 1] = ZERO; + b[ 2] = ZERO; + b[ 3] = ZERO; + b[ 4] = ZERO; + b[ 5] = ZERO; + b[ 6] = ZERO; + b[ 7] = ZERO; + b[ 8] = ZERO; + b[ 9] = ZERO; + b[10] = ZERO; + b[11] = ZERO; + b[12] = ZERO; + b[13] = ZERO; + b[ 14] = ZERO; + b[ 15] = ZERO; + b[ 16] = ZERO; + b[ 17] = ZERO; + b[ 18] = ZERO; + b[ 19] = ZERO; +#ifdef UNIT + b[ 20] = ONE; + b[ 21] = ZERO; +#else + b[ 20] = *(a11 + 20); + b[ 21] = *(a11 + 21); +#endif + b[ 22] = *(a12 + 20); + b[ 23] = *(a12 + 21); + b[ 24] = *(a13 + 20); + b[ 25] = *(a13 + 21); + b[ 26] = *(a14 + 20); + b[ 27] = *(a14 + 21); + b[ 28] = *(a15 + 20); + b[ 29] = *(a15 + 21); + b[ 30] = *(a16 + 20); + b[ 31] = *(a16 + 21); + b += 32; + } + + if (i >= 12) { + b[ 0] = ZERO; + b[ 1] = ZERO; + b[ 2] = ZERO; + b[ 3] = ZERO; + b[ 4] = ZERO; + b[ 5] = ZERO; + b[ 6] = ZERO; + b[ 7] = ZERO; + b[ 8] = ZERO; + b[ 9] = ZERO; + b[10] = ZERO; + b[11] = ZERO; + b[12] = ZERO; + b[13] = ZERO; + b[ 14] = ZERO; + b[ 15] = ZERO; + b[ 16] = ZERO; + b[ 17] = ZERO; + b[ 18] = ZERO; + b[ 19] = ZERO; + b[ 20] = ZERO; + b[ 21] = ZERO; +#ifdef UNIT + b[ 22] = ONE; + b[ 23] = ZERO; +#else + b[ 22] = *(a12 + 22); + b[ 23] = *(a12 + 23); +#endif + b[ 24] = *(a13 + 22); + b[ 25] = *(a13 + 23); + b[ 26] = *(a14 + 22); + b[ 27] = *(a14 + 23); + b[ 28] = *(a15 + 22); + b[ 29] = *(a15 + 23); + b[ 30] = *(a16 + 22); + b[ 31] = *(a16 + 23); + b += 32; + } + + if (i >= 13) { + b[ 0] = ZERO; + b[ 1] = ZERO; + b[ 2] = ZERO; + b[ 3] = ZERO; + b[ 4] = ZERO; + b[ 5] = ZERO; + b[ 6] = ZERO; + b[ 7] = ZERO; + b[ 8] = ZERO; + b[ 9] = ZERO; + b[10] = ZERO; + b[11] = ZERO; + b[12] = ZERO; + b[13] = ZERO; + b[ 14] = ZERO; + b[ 15] = ZERO; + b[ 16] = ZERO; + b[ 17] = ZERO; + b[ 18] = ZERO; + b[ 19] = ZERO; + b[ 20] = ZERO; + b[ 21] = ZERO; + b[ 22] = ZERO; + b[ 23] = ZERO; +#ifdef UNIT + b[ 24] = ONE; + b[ 25] = ZERO; +#else + b[ 24] = *(a13 + 24); + b[ 25] = *(a13 + 25); +#endif + b[ 26] = *(a14 + 24); + b[ 27] = *(a14 + 25); + b[ 28] = *(a15 + 24); + b[ 29] = *(a15 + 25); + b[ 30] = *(a16 + 24); + b[ 31] = *(a16 + 25); + b += 32; + } + + if (i >= 14) { + b[ 0] = ZERO; + b[ 1] = ZERO; + b[ 2] = ZERO; + b[ 3] = ZERO; + b[ 4] = ZERO; + b[ 5] = ZERO; + b[ 6] = ZERO; + b[ 7] = ZERO; + b[ 8] = ZERO; + b[ 9] = ZERO; + b[10] = ZERO; + b[11] = ZERO; + b[12] = ZERO; + b[13] = ZERO; + b[ 14] = ZERO; + b[ 15] = ZERO; + b[ 16] = ZERO; + b[ 17] = ZERO; + b[ 18] = ZERO; + b[ 19] = ZERO; + b[ 20] = ZERO; + b[ 21] = ZERO; + b[ 22] = ZERO; + b[ 23] = ZERO; + b[ 24] = ZERO; + b[ 25] = ZERO; +#ifdef UNIT + b[ 26] = ONE; + b[ 27] = ZERO; +#else + b[ 26] = *(a14 + 26); + b[ 27] = *(a14 + 27); +#endif + b[ 28] = *(a15 + 26); + b[ 29] = *(a15 + 27); + b[ 30] = *(a16 + 26); + b[ 31] = *(a16 + 27); + b += 32; + } + + if (i >= 15) { + b[ 0] = ZERO; + b[ 1] = ZERO; + b[ 2] = ZERO; + b[ 3] = ZERO; + b[ 4] = ZERO; + b[ 5] = ZERO; + b[ 6] = ZERO; + b[ 7] = ZERO; + b[ 8] = ZERO; + b[ 9] = ZERO; + b[10] = ZERO; + b[11] = ZERO; + b[12] = ZERO; + b[13] = ZERO; + b[ 14] = ZERO; + b[ 15] = ZERO; + b[ 16] = ZERO; + b[ 17] = ZERO; + b[ 18] = ZERO; + b[ 19] = ZERO; + b[ 20] = ZERO; + b[ 21] = ZERO; + b[ 22] = ZERO; + b[ 23] = ZERO; + b[ 24] = ZERO; + b[ 25] = ZERO; + b[ 26] = ZERO; + b[ 27] = ZERO; +#ifdef UNIT + b[ 28] = ONE; + b[ 29] = ZERO; +#else + b[ 28] = *(a15 + 28); + b[ 29] = *(a15 + 29); +#endif + b[ 30] = *(a16 + 28); + b[ 31] = *(a16 + 29); + b += 32; + } + } + } + + posY += 16; + js --; + } while (js > 0); + } /* End of main loop */ + + + if (n & 8){ + X = posX; + + if (posX <= posY) { + a01 = a + posX * 2 + (posY + 0) * lda; + a02 = a + posX * 2 + (posY + 1) * lda; + a03 = a + posX * 2 + (posY + 2) * lda; + a04 = a + posX * 2 + (posY + 3) * lda; + a05 = a + posX * 2 + (posY + 4) * lda; + a06 = a + posX * 2 + (posY + 5) * lda; + a07 = a + posX * 2 + (posY + 6) * lda; + a08 = a + posX * 2 + (posY + 7) * lda; + } else { + a01 = a + posY * 2 + (posX + 0) * lda; + a02 = a + posY * 2 + (posX + 1) * lda; + a03 = a + posY * 2 + (posX + 2) * lda; + a04 = a + posY * 2 + (posX + 3) * lda; + a05 = a + posY * 2 + (posX + 4) * lda; + a06 = a + posY * 2 + (posX + 5) * lda; + a07 = a + posY * 2 + (posX + 6) * lda; + a08 = a + posY * 2 + (posX + 7) * lda; + } + + i = (m >> 3); + if (i > 0) { + do { + if (X < posY) { + for (ii = 0; ii < 8; ii++){ + + b[ 0] = *(a01 + 0); + b[ 1] = *(a01 + 1); + b[ 2] = *(a02 + 0); + b[ 3] = *(a02 + 1); + b[ 4] = *(a03 + 0); + b[ 5] = *(a03 + 1); + b[ 6] = *(a04 + 0); + b[ 7] = *(a04 + 1); + + b[ 8] = *(a05 + 0); + b[ 9] = *(a05 + 1); + b[ 10] = *(a06 + 0); + b[ 11] = *(a06 + 1); + b[ 12] = *(a07 + 0); + b[ 13] = *(a07 + 1); + b[ 14] = *(a08 + 0); + b[ 15] = *(a08 + 1); + + a01 += 2; + a02 += 2; + a03 += 2; + a04 += 2; + a05 += 2; + a06 += 2; + a07 += 2; + a08 += 2; + b += 16; + } + } else + if (X > posY) { + a01 += 8 * lda; + a02 += 8 * lda; + a03 += 8 * lda; + a04 += 8 * lda; + a05 += 8 * lda; + a06 += 8 * lda; + a07 += 8 * lda; + a08 += 8 * lda; + + b += 128; + } else { +#ifdef UNIT + b[ 0] = ONE; + b[ 1] = ZERO; +#else + b[ 0] = *(a01 + 0); + b[ 1] = *(a01 + 1); +#endif + b[ 2] = *(a02 + 0); + b[ 3] = *(a02 + 1); + b[ 4] = *(a03 + 0); + b[ 5] = *(a03 + 1); + b[ 6] = *(a04 + 0); + b[ 7] = *(a04 + 1); + + b[ 8] = *(a05 + 0); + b[ 9] = *(a05 + 1); + b[ 10] = *(a06 + 0); + b[ 11] = *(a06 + 1); + b[ 12] = *(a07 + 0); + b[ 13] = *(a07 + 1); + b[ 14] = *(a08 + 0); + b[ 15] = *(a08 + 1); + + b[ 16] = ZERO; + b[ 17] = ZERO; +#ifdef UNIT + b[ 18] = ONE; + b[ 19] = ZERO; +#else + b[ 18] = *(a02 + 2); + b[ 19] = *(a02 + 3); +#endif + b[ 20] = *(a03 + 2); + b[ 21] = *(a03 + 3); + b[ 22] = *(a04 + 2); + b[ 23] = *(a04 + 3); + b[ 24] = *(a05 + 2); + b[ 25] = *(a05 + 3); + b[ 26] = *(a06 + 2); + b[ 27] = *(a06 + 3); + b[ 28] = *(a07 + 2); + b[ 29] = *(a07 + 3); + b[ 30] = *(a08 + 2); + b[ 31] = *(a08 + 3); + + b[ 32] = ZERO; + b[ 33] = ZERO; + b[ 34] = ZERO; + b[ 35] = ZERO; +#ifdef UNIT + b[ 36] = ONE; + b[ 37] = ZERO; +#else + b[ 36] = *(a03 + 4); + b[ 37] = *(a03 + 5); +#endif + b[ 38] = *(a04 + 4); + b[ 39] = *(a04 + 5); + b[ 40] = *(a05 + 4); + b[ 41] = *(a05 + 5); + b[ 42] = *(a06 + 4); + b[ 43] = *(a06 + 5); + b[ 44] = *(a07 + 4); + b[ 45] = *(a07 + 5); + b[ 46] = *(a08 + 4); + b[ 47] = *(a08 + 5); + + b[ 48] = ZERO; + b[ 49] = ZERO; + b[ 50] = ZERO; + b[ 51] = ZERO; + b[ 52] = ZERO; + b[ 53] = ZERO; +#ifdef UNIT + b[ 54] = ONE; + b[ 55] = ZERO; +#else + b[ 54] = *(a04 + 6); + b[ 55] = *(a04 + 7); +#endif + b[ 56] = *(a05 + 6); + b[ 57] = *(a05 + 7); + b[ 58] = *(a06 + 6); + b[ 59] = *(a06 + 7); + b[ 60] = *(a07 + 6); + b[ 61] = *(a07 + 7); + b[ 62] = *(a08 + 6); + b[ 63] = *(a08 + 7); + + b[ 64] = ZERO; + b[ 65] = ZERO; + b[ 66] = ZERO; + b[ 67] = ZERO; + b[ 68] = ZERO; + b[ 69] = ZERO; + b[ 70] = ZERO; + b[ 71] = ZERO; +#ifdef UNIT + b[ 72] = ONE; + b[ 73] = ZERO; +#else + b[ 72] = *(a05 + 8); + b[ 73] = *(a05 + 9); +#endif + b[ 74] = *(a06 + 8); + b[ 75] = *(a06 + 9); + b[ 76] = *(a07 + 8); + b[ 77] = *(a07 + 9); + b[ 78] = *(a08 + 8); + b[ 79] = *(a08 + 9); + + b[ 80] = ZERO; + b[ 81] = ZERO; + b[ 82] = ZERO; + b[ 83] = ZERO; + b[ 84] = ZERO; + b[ 85] = ZERO; + b[ 86] = ZERO; + b[ 87] = ZERO; + b[ 88] = ZERO; + b[ 89] = ZERO; +#ifdef UNIT + b[ 90] = ONE; + b[ 91] = ZERO; +#else + b[ 90] = *(a06 + 10); + b[ 91] = *(a06 + 11); +#endif + b[ 92] = *(a07 + 10); + b[ 93] = *(a07 + 11); + b[ 94] = *(a08 + 10); + b[ 95] = *(a08 + 11); + + b[ 96] = ZERO; + b[ 97] = ZERO; + b[ 98] = ZERO; + b[ 99] = ZERO; + b[100] = ZERO; + b[101] = ZERO; + b[102] = ZERO; + b[103] = ZERO; + b[104] = ZERO; + b[105] = ZERO; + b[106] = ZERO; + b[107] = ZERO; +#ifdef UNIT + b[108] = ONE; + b[109] = ZERO; +#else + b[108] = *(a07 + 12); + b[109] = *(a07 + 13); +#endif + b[110] = *(a08 + 12); + b[111] = *(a08 + 13); + + b[112] = ZERO; + b[113] = ZERO; + b[114] = ZERO; + b[115] = ZERO; + b[116] = ZERO; + b[117] = ZERO; + b[118] = ZERO; + b[119] = ZERO; + b[120] = ZERO; + b[121] = ZERO; + b[122] = ZERO; + b[123] = ZERO; + b[124] = ZERO; + b[125] = ZERO; +#ifdef UNIT + b[126] = ONE; + b[127] = ZERO; +#else + b[126] = *(a08 + 14); + b[127] = *(a08 + 15); +#endif + + a01 += 8 * lda; + a02 += 8 * lda; + a03 += 8 * lda; + a04 += 8 * lda; + a05 += 8 * lda; + a06 += 8 * lda; + a07 += 8 * lda; + a08 += 8 * lda; + b += 128; + } + + X += 8; + i --; + } while (i > 0); + } + + i = (m & 7); + if (i) { + + if (X < posY) { + for (ii = 0; ii < i; ii++){ + + b[ 0] = *(a01 + 0); + b[ 1] = *(a01 + 1); + b[ 2] = *(a02 + 0); + b[ 3] = *(a02 + 1); + b[ 4] = *(a03 + 0); + b[ 5] = *(a03 + 1); + b[ 6] = *(a04 + 0); + b[ 7] = *(a04 + 1); + + b[ 8] = *(a05 + 0); + b[ 9] = *(a05 + 1); + b[ 10] = *(a06 + 0); + b[ 11] = *(a06 + 1); + b[ 12] = *(a07 + 0); + b[ 13] = *(a07 + 1); + b[ 14] = *(a08 + 0); + b[ 15] = *(a08 + 1); + + a01 += 2; + a02 += 2; + a03 += 2; + a04 += 2; + a05 += 2; + a06 += 2; + a07 += 2; + a08 += 2; + b += 16; + } + } else + if (X > posY) { + /* a01 += i * lda; + a02 += i * lda; + a03 += i * lda; + a04 += i * lda; + a05 += i * lda; + a06 += i * lda; + a07 += i * lda; + a08 += i * lda; */ + b += 16 * i; + } else { +#ifdef UNIT + b[ 0] = ONE; + b[ 1] = ZERO; +#else + b[ 0] = *(a01 + 0); + b[ 1] = *(a01 + 1); +#endif + b[ 2] = *(a02 + 0); + b[ 3] = *(a02 + 1); + b[ 4] = *(a03 + 0); + b[ 5] = *(a03 + 1); + b[ 6] = *(a04 + 0); + b[ 7] = *(a04 + 1); + b[ 8] = *(a05 + 0); + b[ 9] = *(a05 + 1); + b[10] = *(a06 + 0); + b[11] = *(a06 + 1); + b[12] = *(a07 + 0); + b[13] = *(a07 + 1); + b[14] = *(a08 + 0); + b[15] = *(a08 + 1); + b += 16; + + if(i >= 2) { + b[ 0] = ZERO; + b[ 1] = ZERO; +#ifdef UNIT + b[ 2] = ONE; + b[ 3] = ZERO; +#else + b[ 2] = *(a02 + 2); + b[ 3] = *(a02 + 3); +#endif + b[ 4] = *(a03 + 2); + b[ 5] = *(a03 + 3); + b[ 6] = *(a04 + 2); + b[ 7] = *(a04 + 3); + b[ 8] = *(a05 + 2); + b[ 9] = *(a05 + 3); + b[10] = *(a06 + 2); + b[11] = *(a06 + 3); + b[12] = *(a07 + 2); + b[13] = *(a07 + 3); + b[14] = *(a08 + 2); + b[15] = *(a08 + 3); + b += 16; + } + + if (i >= 3) { + b[ 0] = ZERO; + b[ 1] = ZERO; + b[ 2] = ZERO; + b[ 3] = ZERO; +#ifdef UNIT + b[ 4] = ONE; + b[ 5] = ZERO; +#else + b[ 4] = *(a03 + 4); + b[ 5] = *(a03 + 5); +#endif + b[ 6] = *(a04 + 4); + b[ 7] = *(a04 + 5); + b[ 8] = *(a05 + 4); + b[ 9] = *(a05 + 5); + b[10] = *(a06 + 4); + b[11] = *(a06 + 5); + b[12] = *(a07 + 4); + b[13] = *(a07 + 5); + b[14] = *(a08 + 4); + b[15] = *(a08 + 5); + b += 16; + } + + if (i >= 4) { + b[ 0] = ZERO; + b[ 1] = ZERO; + b[ 2] = ZERO; + b[ 3] = ZERO; + b[ 4] = ZERO; + b[ 5] = ZERO; +#ifdef UNIT + b[ 6] = ONE; + b[ 7] = ZERO; +#else + b[ 6] = *(a04 + 6); + b[ 7] = *(a04 + 7); +#endif + b[ 8] = *(a05 + 6); + b[ 9] = *(a05 + 7); + b[10] = *(a06 + 6); + b[11] = *(a06 + 7); + b[12] = *(a07 + 6); + b[13] = *(a07 + 7); + b[14] = *(a08 + 6); + b[15] = *(a08 + 7); + b += 16; + } + + if (i >= 5) { + b[ 0] = ZERO; + b[ 1] = ZERO; + b[ 2] = ZERO; + b[ 3] = ZERO; + b[ 4] = ZERO; + b[ 5] = ZERO; + b[ 6] = ZERO; + b[ 7] = ZERO; +#ifdef UNIT + b[ 8] = ONE; + b[ 9] = ZERO; +#else + b[ 8] = *(a05 + 8); + b[ 9] = *(a05 + 9); +#endif + b[10] = *(a06 + 8); + b[11] = *(a06 + 9); + b[12] = *(a07 + 8); + b[13] = *(a07 + 9); + b[14] = *(a08 + 8); + b[15] = *(a08 + 9); + b += 16; + } + + if (i >= 6) { + b[ 0] = ZERO; + b[ 1] = ZERO; + b[ 2] = ZERO; + b[ 3] = ZERO; + b[ 4] = ZERO; + b[ 5] = ZERO; + b[ 6] = ZERO; + b[ 7] = ZERO; + b[ 8] = ZERO; + b[ 9] = ZERO; +#ifdef UNIT + b[10] = ONE; + b[11] = ZERO; +#else + b[10] = *(a06 + 10); + b[11] = *(a06 + 11); +#endif + b[12] = *(a07 + 10); + b[13] = *(a07 + 11); + b[14] = *(a08 + 10); + b[15] = *(a08 + 11); + b += 16; + } + + if (i >= 7) { + b[ 0] = ZERO; + b[ 1] = ZERO; + b[ 2] = ZERO; + b[ 3] = ZERO; + b[ 4] = ZERO; + b[ 5] = ZERO; + b[ 6] = ZERO; + b[ 7] = ZERO; + b[ 8] = ZERO; + b[ 9] = ZERO; + b[10] = ZERO; + b[11] = ZERO; +#ifdef UNIT + b[12] = ONE; + b[13] = ZERO; +#else + b[12] = *(a07 + 12); + b[13] = *(a07 + 13); +#endif + b[14] = *(a08 + 12); + b[15] = *(a08 + 13); + b += 16; + } + } + } + + posY += 8; + } + + + if (n & 4){ + X = posX; + + if (posX <= posY) { + a01 = a + posX * 2 + (posY + 0) * lda; + a02 = a + posX * 2 + (posY + 1) * lda; + a03 = a + posX * 2 + (posY + 2) * lda; + a04 = a + posX * 2 + (posY + 3) * lda; + } else { + a01 = a + posY * 2 + (posX + 0) * lda; + a02 = a + posY * 2 + (posX + 1) * lda; + a03 = a + posY * 2 + (posX + 2) * lda; + a04 = a + posY * 2 + (posX + 3) * lda; + } + + i = (m >> 2); + if (i > 0) { + do { + if (X < posY) { + for (ii = 0; ii < 4; ii++){ + + b[ 0] = *(a01 + 0); + b[ 1] = *(a01 + 1); + b[ 2] = *(a02 + 0); + b[ 3] = *(a02 + 1); + b[ 4] = *(a03 + 0); + b[ 5] = *(a03 + 1); + b[ 6] = *(a04 + 0); + b[ 7] = *(a04 + 1); + + a01 += 2; + a02 += 2; + a03 += 2; + a04 += 2; + b += 8; + } + } else + if (X > posY) { + a01 += 4 * lda; + a02 += 4 * lda; + a03 += 4 * lda; + a04 += 4 * lda; + b += 32; + } else { +#ifdef UNIT + b[ 0] = ONE; + b[ 1] = ZERO; +#else + b[ 0] = *(a01 + 0); + b[ 1] = *(a01 + 1); +#endif + b[ 2] = *(a02 + 0); + b[ 3] = *(a02 + 1); + b[ 4] = *(a03 + 0); + b[ 5] = *(a03 + 1); + b[ 6] = *(a04 + 0); + b[ 7] = *(a04 + 1); + + b[ 8] = ZERO; + b[ 9] = ZERO; +#ifdef UNIT + b[ 10] = ONE; + b[ 11] = ZERO; +#else + b[ 10] = *(a02 + 2); + b[ 11] = *(a02 + 3); +#endif + b[ 12] = *(a03 + 2); + b[ 13] = *(a03 + 3); + b[ 14] = *(a04 + 2); + b[ 15] = *(a04 + 3); + + b[ 16] = ZERO; + b[ 17] = ZERO; + b[ 18] = ZERO; + b[ 19] = ZERO; +#ifdef UNIT + b[ 20] = ONE; + b[ 21] = ZERO; +#else + b[ 20] = *(a03 + 4); + b[ 21] = *(a03 + 5); +#endif + b[ 22] = *(a04 + 4); + b[ 23] = *(a04 + 5); + + b[ 24] = ZERO; + b[ 25] = ZERO; + b[ 26] = ZERO; + b[ 27] = ZERO; + b[ 28] = ZERO; + b[ 29] = ZERO; +#ifdef UNIT + b[ 30] = ONE; + b[ 31] = ZERO; +#else + b[ 30] = *(a04 + 6); + b[ 31] = *(a04 + 7); +#endif + + a01 += 4 * lda; + a02 += 4 * lda; + a03 += 4 * lda; + a04 += 4 * lda; + + b += 32; + } + + X += 4; + i --; + } while (i > 0); + } + + i = (m & 3); + if (i) { + + if (X < posY) { + + for (ii = 0; ii < i; ii++){ + b[ 0] = *(a01 + 0); + b[ 1] = *(a01 + 1); + b[ 2] = *(a02 + 0); + b[ 3] = *(a02 + 1); + b[ 4] = *(a03 + 0); + b[ 5] = *(a03 + 1); + b[ 6] = *(a04 + 0); + b[ 7] = *(a04 + 1); + + a01 += 2; + a02 += 2; + a03 += 2; + a04 += 2; + b += 8; + } + } else + if (X > posY) { + /* a01 += i * lda; + a02 += i * lda; + a03 += i * lda; + a04 += i * lda; */ + b += 8 * i; + } else { +#ifdef UNIT + b[ 0] = ONE; + b[ 1] = ZERO; +#else + b[ 0] = *(a01 + 0); + b[ 1] = *(a01 + 1); +#endif + b[ 2] = *(a02 + 0); + b[ 3] = *(a02 + 1); + b[ 4] = *(a03 + 0); + b[ 5] = *(a03 + 1); + b[ 6] = *(a04 + 0); + b[ 7] = *(a04 + 1); + b += 8; + + if(i >= 2) { + b[ 0] = ZERO; + b[ 1] = ZERO; +#ifdef UNIT + b[ 2] = ONE; + b[ 3] = ZERO; +#else + b[ 2] = *(a02 + 2); + b[ 3] = *(a02 + 3); +#endif + b[ 4] = *(a03 + 2); + b[ 5] = *(a03 + 3); + b[ 6] = *(a04 + 2); + b[ 7] = *(a04 + 3); + b += 8; + } + + if (i >= 3) { + b[ 0] = ZERO; + b[ 1] = ZERO; + b[ 2] = ZERO; + b[ 3] = ZERO; +#ifdef UNIT + b[ 4] = ONE; + b[ 5] = ZERO; +#else + b[ 4] = *(a03 + 4); + b[ 5] = *(a03 + 5); +#endif + b[ 6] = *(a04 + 4); + b[ 7] = *(a04 + 5); + b += 8; + } + } + } + + posY += 4; + } + + if (n & 2){ + X = posX; + + if (posX <= posY) { + a01 = a + posX * 2 + (posY + 0) * lda; + a02 = a + posX * 2 + (posY + 1) * lda; + } else { + a01 = a + posY * 2 + (posX + 0) * lda; + a02 = a + posY * 2 + (posX + 1) * lda; + } + + i = (m >> 1); + if (i > 0) { + do { + if (X < posY) { + b[ 0] = *(a01 + 0); + b[ 1] = *(a01 + 1); + b[ 2] = *(a02 + 0); + b[ 3] = *(a02 + 1); + b[ 4] = *(a01 + 2); + b[ 5] = *(a01 + 3); + b[ 6] = *(a02 + 2); + b[ 7] = *(a02 + 3); + + a01 += 4; + a02 += 4; + b += 8; + } else + if (X > posY) { + a01 += 2 * lda; + a02 += 2 * lda; + b += 8; + } else { +#ifdef UNIT + b[ 0] = ONE; + b[ 1] = ZERO; +#else + b[ 0] = *(a01 + 0); + b[ 1] = *(a01 + 1); +#endif + b[ 2] = *(a02 + 0); + b[ 3] = *(a02 + 1); + + b[ 4] = ZERO; + b[ 5] = ZERO; +#ifdef UNIT + b[ 6] = ONE; + b[ 7] = ZERO; +#else + b[ 6] = *(a02 + 2); + b[ 7] = *(a02 + 3); +#endif + + a01 += 2 * lda; + a02 += 2 * lda; + b += 8; + } + + X += 2; + i --; + } while (i > 0); + } + + if (m & 1) { + + if (X < posY) { + b[ 0] = *(a01 + 0); + b[ 1] = *(a01 + 1); + b[ 2] = *(a02 + 0); + b[ 3] = *(a02 + 1); + /* a01 += 2; + a02 += 2; */ + b += 4; + } else + if (X > posY) { + /* a01 += 2 * lda; + a02 += 2 * lda; */ + b += 4; + } else { +#ifdef UNIT + b[ 0] = ONE; + b[ 1] = ZERO; + b[ 2] = *(a02 + 0); + b[ 3] = *(a02 + 1); +#else + b[ 0] = *(a01 + 0); + b[ 1] = *(a01 + 1); + b[ 2] = *(a02 + 0); + b[ 3] = *(a02 + 1); +#endif + b += 2; + } + } + posY += 2; + } + + if (n & 1){ + X = posX; + + if (posX <= posY) { + a01 = a + posX * 2 + (posY + 0) * lda; + } else { + a01 = a + posY * 2 + (posX + 0) * lda; + } + + i = m; + if (m > 0) { + do { + if (X < posY) { + b[ 0] = *(a01 + 0); + b[ 1] = *(a01 + 1); + a01 += 2; + b += 2; + } else + if (X > posY) { + a01 += lda; + b += 2; + } else { +#ifdef UNIT + b[ 0] = ONE; + b[ 1] = ZERO; +#else + b[ 0] = *(a01 + 0); + b[ 1] = *(a01 + 1); +#endif + a01 += lda; + b += 2; + } + + X += 1; + i --; + } while (i > 0); + } + } + + return 0; +} diff --git a/kernel/generic/ztrmm_utcopy_16.c b/kernel/generic/ztrmm_utcopy_16.c new file mode 100644 index 000000000..5aba3727a --- /dev/null +++ b/kernel/generic/ztrmm_utcopy_16.c @@ -0,0 +1,2318 @@ +/******************************************************************************* +Copyright (c) 2024, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 +#include "common.h" + +int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG posX, BLASLONG posY, FLOAT *b){ + + BLASLONG i, js; + BLASLONG X, ii; + + FLOAT *a01, *a02, *a03, *a04, *a05, *a06, *a07, *a08; + FLOAT *a09, *a10, *a11, *a12, *a13, *a14, *a15, *a16; + + lda += lda; + + js = (n >> 4); + + if (js > 0){ + do { + X = posX; + + if (posX <= posY) { + a01 = a + posX * 2 + (posY + 0) * lda; + a02 = a + posX * 2 + (posY + 1) * lda; + a03 = a + posX * 2 + (posY + 2) * lda; + a04 = a + posX * 2 + (posY + 3) * lda; + a05 = a + posX * 2 + (posY + 4) * lda; + a06 = a + posX * 2 + (posY + 5) * lda; + a07 = a + posX * 2 + (posY + 6) * lda; + a08 = a + posX * 2 + (posY + 7) * lda; + a09 = a + posX * 2 + (posY + 8) * lda; + a10 = a + posX * 2 + (posY + 9) * lda; + a11 = a + posX * 2 + (posY + 10) * lda; + a12 = a + posX * 2 + (posY + 11) * lda; + a13 = a + posX * 2 + (posY + 12) * lda; + a14 = a + posX * 2 + (posY + 13) * lda; + a15 = a + posX * 2 + (posY + 14) * lda; + a16 = a + posX * 2 + (posY + 15) * lda; + } else { + a01 = a + posY * 2 + (posX + 0) * lda; + a02 = a + posY * 2 + (posX + 1) * lda; + a03 = a + posY * 2 + (posX + 2) * lda; + a04 = a + posY * 2 + (posX + 3) * lda; + a05 = a + posY * 2 + (posX + 4) * lda; + a06 = a + posY * 2 + (posX + 5) * lda; + a07 = a + posY * 2 + (posX + 6) * lda; + a08 = a + posY * 2 + (posX + 7) * lda; + a09 = a + posY * 2 + (posX + 8) * lda; + a10 = a + posY * 2 + (posX + 9) * lda; + a11 = a + posY * 2 + (posX + 10) * lda; + a12 = a + posY * 2 + (posX + 11) * lda; + a13 = a + posY * 2 + (posX + 12) * lda; + a14 = a + posY * 2 + (posX + 13) * lda; + a15 = a + posY * 2 + (posX + 14) * lda; + a16 = a + posY * 2 + (posX + 15) * lda; + } + + i = (m >> 4); + if (i > 0) { + do { + if (X < posY) { + a01 += 32; + a02 += 32; + a03 += 32; + a04 += 32; + a05 += 32; + a06 += 32; + a07 += 32; + a08 += 32; + a09 += 32; + a10 += 32; + a11 += 32; + a12 += 32; + a13 += 32; + a14 += 32; + a15 += 32; + a16 += 32; + + b += 512; + } else + if (X > posY) { + for (ii = 0; ii < 16; ii++){ + + b[ 0] = *(a01 + 0); + b[ 1] = *(a01 + 1); + b[ 2] = *(a01 + 2); + b[ 3] = *(a01 + 3); + b[ 4] = *(a01 + 4); + b[ 5] = *(a01 + 5); + b[ 6] = *(a01 + 6); + b[ 7] = *(a01 + 7); + + b[ 8] = *(a01 + 8); + b[ 9] = *(a01 + 9); + b[ 10] = *(a01 + 10); + b[ 11] = *(a01 + 11); + b[ 12] = *(a01 + 12); + b[ 13] = *(a01 + 13); + b[ 14] = *(a01 + 14); + b[ 15] = *(a01 + 15); + + b[ 16] = *(a01 + 16); + b[ 17] = *(a01 + 17); + b[ 18] = *(a01 + 18); + b[ 19] = *(a01 + 19); + b[ 20] = *(a01 + 20); + b[ 21] = *(a01 + 21); + b[ 22] = *(a01 + 22); + b[ 23] = *(a01 + 23); + + b[ 24] = *(a01 + 24); + b[ 25] = *(a01 + 25); + b[ 26] = *(a01 + 26); + b[ 27] = *(a01 + 27); + b[ 28] = *(a01 + 28); + b[ 29] = *(a01 + 29); + b[ 30] = *(a01 + 30); + b[ 31] = *(a01 + 31); + + a01 += lda; + b += 32; + } + + a02 += 16 * lda; + a03 += 16 * lda; + a04 += 16 * lda; + a05 += 16 * lda; + a06 += 16 * lda; + a07 += 16 * lda; + a08 += 16 * lda; + a09 += 16 * lda; + a10 += 16 * lda; + a11 += 16 * lda; + a12 += 16 * lda; + a13 += 16 * lda; + a14 += 16 * lda; + a15 += 16 * lda; + a16 += 16 * lda; + + } else { +#ifdef UNIT + b[ 0] = ONE; + b[ 1] = ZERO; +#else + b[ 0] = *(a01 + 0); + b[ 1] = *(a01 + 1); +#endif + b[ 2] = ZERO; + b[ 3] = ZERO; + b[ 4] = ZERO; + b[ 5] = ZERO; + b[ 6] = ZERO; + b[ 7] = ZERO; + b[ 8] = ZERO; + b[ 9] = ZERO; + b[ 10] = ZERO; + b[ 11] = ZERO; + b[ 12] = ZERO; + b[ 13] = ZERO; + b[ 14] = ZERO; + b[ 15] = ZERO; + b[ 16] = ZERO; + b[ 17] = ZERO; + b[ 18] = ZERO; + b[ 19] = ZERO; + b[ 20] = ZERO; + b[ 21] = ZERO; + b[ 22] = ZERO; + b[ 23] = ZERO; + b[ 24] = ZERO; + b[ 25] = ZERO; + b[ 26] = ZERO; + b[ 27] = ZERO; + b[ 28] = ZERO; + b[ 29] = ZERO; + b[ 30] = ZERO; + b[ 31] = ZERO; + + b[ 32] = *(a02 + 0); + b[ 33] = *(a02 + 1); +#ifdef UNIT + b[ 34] = ONE; + b[ 35] = ZERO; +#else + b[ 34] = *(a02 + 2); + b[ 35] = *(a02 + 3); +#endif + b[ 36] = ZERO; + b[ 37] = ZERO; + b[ 38] = ZERO; + b[ 39] = ZERO; + b[ 40] = ZERO; + b[ 41] = ZERO; + b[ 42] = ZERO; + b[ 43] = ZERO; + b[ 44] = ZERO; + b[ 45] = ZERO; + b[ 46] = ZERO; + b[ 47] = ZERO; + b[ 48] = ZERO; + b[ 49] = ZERO; + b[ 50] = ZERO; + b[ 51] = ZERO; + b[ 52] = ZERO; + b[ 53] = ZERO; + b[ 54] = ZERO; + b[ 55] = ZERO; + b[ 56] = ZERO; + b[ 57] = ZERO; + b[ 58] = ZERO; + b[ 59] = ZERO; + b[ 60] = ZERO; + b[ 61] = ZERO; + b[ 62] = ZERO; + b[ 63] = ZERO; + + b[ 64] = *(a03 + 0); + b[ 65] = *(a03 + 1); + b[ 66] = *(a03 + 2); + b[ 67] = *(a03 + 3); +#ifdef UNIT + b[ 68] = ONE; + b[ 69] = ZERO; +#else + b[ 68] = *(a03 + 4); + b[ 69] = *(a03 + 5); +#endif + b[ 70] = ZERO; + b[ 71] = ZERO; + b[ 72] = ZERO; + b[ 73] = ZERO; + b[ 74] = ZERO; + b[ 75] = ZERO; + b[ 76] = ZERO; + b[ 77] = ZERO; + b[ 78] = ZERO; + b[ 79] = ZERO; + b[ 80] = ZERO; + b[ 81] = ZERO; + b[ 82] = ZERO; + b[ 83] = ZERO; + b[ 84] = ZERO; + b[ 85] = ZERO; + b[ 86] = ZERO; + b[ 87] = ZERO; + b[ 88] = ZERO; + b[ 89] = ZERO; + b[ 90] = ZERO; + b[ 91] = ZERO; + b[ 92] = ZERO; + b[ 93] = ZERO; + b[ 94] = ZERO; + b[ 95] = ZERO; + + b[ 96] = *(a04 + 0); + b[ 97] = *(a04 + 1); + b[ 98] = *(a04 + 2); + b[ 99] = *(a04 + 3); + b[100] = *(a04 + 4); + b[101] = *(a04 + 5); +#ifdef UNIT + b[102] = ONE; + b[103] = ZERO; +#else + b[102] = *(a04 + 6); + b[103] = *(a04 + 7); +#endif + b[104] = ZERO; + b[105] = ZERO; + b[106] = ZERO; + b[107] = ZERO; + b[108] = ZERO; + b[109] = ZERO; + b[110] = ZERO; + b[111] = ZERO; + b[112] = ZERO; + b[113] = ZERO; + b[114] = ZERO; + b[115] = ZERO; + b[116] = ZERO; + b[117] = ZERO; + b[118] = ZERO; + b[119] = ZERO; + b[120] = ZERO; + b[121] = ZERO; + b[122] = ZERO; + b[123] = ZERO; + b[124] = ZERO; + b[125] = ZERO; + b[126] = ZERO; + b[127] = ZERO; + + b[128] = *(a05 + 0); + b[129] = *(a05 + 1); + b[130] = *(a05 + 2); + b[131] = *(a05 + 3); + b[132] = *(a05 + 4); + b[133] = *(a05 + 5); + b[134] = *(a05 + 6); + b[135] = *(a05 + 7); +#ifdef UNIT + b[136] = ONE; + b[137] = ZERO; +#else + b[136] = *(a05 + 8); + b[137] = *(a05 + 9); +#endif + b[138] = ZERO; + b[139] = ZERO; + b[140] = ZERO; + b[141] = ZERO; + b[142] = ZERO; + b[143] = ZERO; + b[144] = ZERO; + b[145] = ZERO; + b[146] = ZERO; + b[147] = ZERO; + b[148] = ZERO; + b[149] = ZERO; + b[150] = ZERO; + b[151] = ZERO; + b[152] = ZERO; + b[153] = ZERO; + b[154] = ZERO; + b[155] = ZERO; + b[156] = ZERO; + b[157] = ZERO; + b[158] = ZERO; + b[159] = ZERO; + + b[160] = *(a06 + 0); + b[161] = *(a06 + 1); + b[162] = *(a06 + 2); + b[163] = *(a06 + 3); + b[164] = *(a06 + 4); + b[165] = *(a06 + 5); + b[166] = *(a06 + 6); + b[167] = *(a06 + 7); + b[168] = *(a06 + 8); + b[169] = *(a06 + 9); +#ifdef UNIT + b[170] = ONE; + b[171] = ZERO; +#else + b[170] = *(a06 + 10); + b[171] = *(a06 + 11); +#endif + b[172] = ZERO; + b[173] = ZERO; + b[174] = ZERO; + b[175] = ZERO; + b[176] = ZERO; + b[177] = ZERO; + b[178] = ZERO; + b[179] = ZERO; + b[180] = ZERO; + b[181] = ZERO; + b[182] = ZERO; + b[183] = ZERO; + b[184] = ZERO; + b[185] = ZERO; + b[186] = ZERO; + b[187] = ZERO; + b[188] = ZERO; + b[189] = ZERO; + b[190] = ZERO; + b[191] = ZERO; + + b[192] = *(a07 + 0); + b[193] = *(a07 + 1); + b[194] = *(a07 + 2); + b[195] = *(a07 + 3); + b[196] = *(a07 + 4); + b[197] = *(a07 + 5); + b[198] = *(a07 + 6); + b[199] = *(a07 + 7); + b[200] = *(a07 + 8); + b[201] = *(a07 + 9); + b[202] = *(a07 + 10); + b[203] = *(a07 + 11); +#ifdef UNIT + b[204] = ONE; + b[205] = ZERO; +#else + b[204] = *(a07 + 12); + b[205] = *(a07 + 13); +#endif + b[206] = ZERO; + b[207] = ZERO; + b[208] = ZERO; + b[209] = ZERO; + b[210] = ZERO; + b[211] = ZERO; + b[212] = ZERO; + b[213] = ZERO; + b[214] = ZERO; + b[215] = ZERO; + b[216] = ZERO; + b[217] = ZERO; + b[218] = ZERO; + b[219] = ZERO; + b[220] = ZERO; + b[221] = ZERO; + b[222] = ZERO; + b[223] = ZERO; + + b[224] = *(a08 + 0); + b[225] = *(a08 + 1); + b[226] = *(a08 + 2); + b[227] = *(a08 + 3); + b[228] = *(a08 + 4); + b[229] = *(a08 + 5); + b[230] = *(a08 + 6); + b[231] = *(a08 + 7); + b[232] = *(a08 + 8); + b[233] = *(a08 + 9); + b[234] = *(a08 + 10); + b[235] = *(a08 + 11); + b[236] = *(a08 + 12); + b[237] = *(a08 + 13); +#ifdef UNIT + b[238] = ONE; + b[239] = ZERO; +#else + b[238] = *(a08 + 14); + b[239] = *(a08 + 15); +#endif + b[240] = ZERO; + b[241] = ZERO; + b[242] = ZERO; + b[243] = ZERO; + b[244] = ZERO; + b[245] = ZERO; + b[246] = ZERO; + b[247] = ZERO; + b[248] = ZERO; + b[249] = ZERO; + b[250] = ZERO; + b[251] = ZERO; + b[252] = ZERO; + b[253] = ZERO; + b[254] = ZERO; + b[255] = ZERO; + + b[256] = *(a09 + 0); + b[257] = *(a09 + 1); + b[258] = *(a09 + 2); + b[259] = *(a09 + 3); + b[260] = *(a09 + 4); + b[261] = *(a09 + 5); + b[262] = *(a09 + 6); + b[263] = *(a09 + 7); + b[264] = *(a09 + 8); + b[265] = *(a09 + 9); + b[266] = *(a09 + 10); + b[267] = *(a09 + 11); + b[268] = *(a09 + 12); + b[269] = *(a09 + 13); + b[270] = *(a09 + 14); + b[271] = *(a09 + 15); +#ifdef UNIT + b[272] = ONE; + b[273] = ZERO; +#else + b[272] = *(a09 + 16); + b[273] = *(a09 + 17); +#endif + b[274] = ZERO; + b[275] = ZERO; + b[276] = ZERO; + b[277] = ZERO; + b[278] = ZERO; + b[279] = ZERO; + b[280] = ZERO; + b[281] = ZERO; + b[282] = ZERO; + b[283] = ZERO; + b[284] = ZERO; + b[285] = ZERO; + b[286] = ZERO; + b[287] = ZERO; + + b[288] = *(a10 + 0); + b[289] = *(a10 + 1); + b[290] = *(a10 + 2); + b[291] = *(a10 + 3); + b[292] = *(a10 + 4); + b[293] = *(a10 + 5); + b[294] = *(a10 + 6); + b[295] = *(a10 + 7); + b[296] = *(a10 + 8); + b[297] = *(a10 + 9); + b[298] = *(a10 + 10); + b[299] = *(a10 + 11); + b[300] = *(a10 + 12); + b[301] = *(a10 + 13); + b[302] = *(a10 + 14); + b[303] = *(a10 + 15); + b[304] = *(a10 + 16); + b[305] = *(a10 + 17); +#ifdef UNIT + b[306] = ONE; + b[307] = ZERO; +#else + b[306] = *(a10 + 18); + b[307] = *(a10 + 19); +#endif + b[308] = ZERO; + b[309] = ZERO; + b[310] = ZERO; + b[311] = ZERO; + b[312] = ZERO; + b[313] = ZERO; + b[314] = ZERO; + b[315] = ZERO; + b[316] = ZERO; + b[317] = ZERO; + b[318] = ZERO; + b[319] = ZERO; + + b[320] = *(a11 + 0); + b[321] = *(a11 + 1); + b[322] = *(a11 + 2); + b[323] = *(a11 + 3); + b[324] = *(a11 + 4); + b[325] = *(a11 + 5); + b[326] = *(a11 + 6); + b[327] = *(a11 + 7); + b[328] = *(a11 + 8); + b[329] = *(a11 + 9); + b[330] = *(a11 + 10); + b[331] = *(a11 + 11); + b[332] = *(a11 + 12); + b[333] = *(a11 + 13); + b[334] = *(a11 + 14); + b[335] = *(a11 + 15); + b[336] = *(a11 + 16); + b[337] = *(a11 + 17); + b[338] = *(a11 + 18); + b[339] = *(a11 + 19); +#ifdef UNIT + b[340] = ONE; + b[341] = ZERO; +#else + b[340] = *(a11 + 20); + b[341] = *(a11 + 21); +#endif + b[342] = ZERO; + b[343] = ZERO; + b[344] = ZERO; + b[345] = ZERO; + b[346] = ZERO; + b[347] = ZERO; + b[348] = ZERO; + b[349] = ZERO; + b[350] = ZERO; + b[351] = ZERO; + + b[352] = *(a12 + 0); + b[353] = *(a12 + 1); + b[354] = *(a12 + 2); + b[355] = *(a12 + 3); + b[356] = *(a12 + 4); + b[357] = *(a12 + 5); + b[358] = *(a12 + 6); + b[359] = *(a12 + 7); + b[360] = *(a12 + 8); + b[361] = *(a12 + 9); + b[362] = *(a12 + 10); + b[363] = *(a12 + 11); + b[364] = *(a12 + 12); + b[365] = *(a12 + 13); + b[366] = *(a12 + 14); + b[367] = *(a12 + 15); + b[368] = *(a12 + 16); + b[369] = *(a12 + 17); + b[370] = *(a12 + 18); + b[371] = *(a12 + 19); + b[372] = *(a12 + 20); + b[373] = *(a12 + 21); +#ifdef UNIT + b[374] = ONE; + b[375] = ZERO; +#else + b[374] = *(a12 + 22); + b[375] = *(a12 + 23); +#endif + b[376] = ZERO; + b[377] = ZERO; + b[378] = ZERO; + b[379] = ZERO; + b[380] = ZERO; + b[381] = ZERO; + b[382] = ZERO; + b[383] = ZERO; + + b[384] = *(a13 + 0); + b[385] = *(a13 + 1); + b[386] = *(a13 + 2); + b[387] = *(a13 + 3); + b[388] = *(a13 + 4); + b[389] = *(a13 + 5); + b[390] = *(a13 + 6); + b[391] = *(a13 + 7); + b[392] = *(a13 + 8); + b[393] = *(a13 + 9); + b[394] = *(a13 + 10); + b[395] = *(a13 + 11); + b[396] = *(a13 + 12); + b[397] = *(a13 + 13); + b[398] = *(a13 + 14); + b[399] = *(a13 + 15); + b[400] = *(a13 + 16); + b[401] = *(a13 + 17); + b[402] = *(a13 + 18); + b[403] = *(a13 + 19); + b[404] = *(a13 + 20); + b[405] = *(a13 + 21); + b[406] = *(a13 + 22); + b[407] = *(a13 + 23); +#ifdef UNIT + b[408] = ONE; + b[409] = ZERO; +#else + b[408] = *(a13 + 24); + b[409] = *(a13 + 25); +#endif + b[410] = ZERO; + b[411] = ZERO; + b[412] = ZERO; + b[413] = ZERO; + b[414] = ZERO; + b[415] = ZERO; + + b[416] = *(a14 + 0); + b[417] = *(a14 + 1); + b[418] = *(a14 + 2); + b[419] = *(a14 + 3); + b[420] = *(a14 + 4); + b[421] = *(a14 + 5); + b[422] = *(a14 + 6); + b[423] = *(a14 + 7); + b[424] = *(a14 + 8); + b[425] = *(a14 + 9); + b[426] = *(a14 + 10); + b[427] = *(a14 + 11); + b[428] = *(a14 + 12); + b[429] = *(a14 + 13); + b[430] = *(a14 + 14); + b[431] = *(a14 + 15); + b[432] = *(a14 + 16); + b[433] = *(a14 + 17); + b[434] = *(a14 + 18); + b[435] = *(a14 + 19); + b[436] = *(a14 + 20); + b[437] = *(a14 + 21); + b[438] = *(a14 + 22); + b[439] = *(a14 + 23); + b[440] = *(a14 + 24); + b[441] = *(a14 + 25); +#ifdef UNIT + b[442] = ONE; + b[443] = ZERO; +#else + b[442] = *(a14 + 26); + b[443] = *(a14 + 27); +#endif + b[444] = ZERO; + b[445] = ZERO; + b[446] = ZERO; + b[447] = ZERO; + + b[448] = *(a15 + 0); + b[449] = *(a15 + 1); + b[450] = *(a15 + 2); + b[451] = *(a15 + 3); + b[452] = *(a15 + 4); + b[453] = *(a15 + 5); + b[454] = *(a15 + 6); + b[455] = *(a15 + 7); + b[456] = *(a15 + 8); + b[457] = *(a15 + 9); + b[458] = *(a15 + 10); + b[459] = *(a15 + 11); + b[460] = *(a15 + 12); + b[461] = *(a15 + 13); + b[462] = *(a15 + 14); + b[463] = *(a15 + 15); + b[464] = *(a15 + 16); + b[465] = *(a15 + 17); + b[466] = *(a15 + 18); + b[467] = *(a15 + 19); + b[468] = *(a15 + 20); + b[469] = *(a15 + 21); + b[470] = *(a15 + 22); + b[471] = *(a15 + 23); + b[472] = *(a15 + 24); + b[473] = *(a15 + 25); + b[474] = *(a15 + 26); + b[475] = *(a15 + 27); +#ifdef UNIT + b[476] = ONE; + b[477] = ZERO; +#else + b[476] = *(a15 + 28); + b[477] = *(a15 + 29); +#endif + b[478] = ZERO; + b[479] = ZERO; + + b[480] = *(a16 + 0); + b[481] = *(a16 + 1); + b[482] = *(a16 + 2); + b[483] = *(a16 + 3); + b[484] = *(a16 + 4); + b[485] = *(a16 + 5); + b[486] = *(a16 + 6); + b[487] = *(a16 + 7); + b[488] = *(a16 + 8); + b[489] = *(a16 + 9); + b[490] = *(a16 + 10); + b[491] = *(a16 + 11); + b[492] = *(a16 + 12); + b[493] = *(a16 + 13); + b[494] = *(a16 + 14); + b[495] = *(a16 + 15); + b[496] = *(a16 + 16); + b[497] = *(a16 + 17); + b[498] = *(a16 + 18); + b[499] = *(a16 + 19); + b[500] = *(a16 + 20); + b[501] = *(a16 + 21); + b[502] = *(a16 + 22); + b[503] = *(a16 + 23); + b[504] = *(a16 + 24); + b[505] = *(a16 + 25); + b[506] = *(a16 + 26); + b[507] = *(a16 + 27); + b[508] = *(a16 + 28); + b[509] = *(a16 + 29); +#ifdef UNIT + b[510] = ONE; + b[511] = ZERO; +#else + b[510] = *(a16 + 30); + b[511] = *(a16 + 31); +#endif + + a01 += 16 * lda; + a02 += 16 * lda; + a03 += 16 * lda; + a04 += 16 * lda; + a05 += 16 * lda; + a06 += 16 * lda; + a07 += 16 * lda; + a08 += 16 * lda; + a09 += 16 * lda; + a10 += 16 * lda; + a11 += 16 * lda; + a12 += 16 * lda; + a13 += 16 * lda; + a14 += 16 * lda; + a15 += 16 * lda; + a16 += 16 * lda; + b += 512; + } + + X += 16; + i --; + } while (i > 0); + } + + i = (m & 15); + if (i) { + + if (X < posY) { + // a01 += 2 * i; + // a02 += 2 * i; + // a03 += 2 * i; + // a04 += 2 * i; + // a05 += 2 * i; + // a06 += 2 * i; + // a07 += 2 * i; + // a08 += 2 * i; + // a09 += 2 * i; + // a10 += 2 * i; + // a11 += 2 * i; + // a12 += 2 * i; + // a13 += 2 * i; + // a14 += 2 * i; + // a15 += 2 * i; + // a16 += 2 * i; + b += 32 * i; + + } else + if (X > posY) { + for (ii = 0; ii < i; ii++){ + b[ 0] = *(a01 + 0); + b[ 1] = *(a01 + 1); + b[ 2] = *(a01 + 2); + b[ 3] = *(a01 + 3); + b[ 4] = *(a01 + 4); + b[ 5] = *(a01 + 5); + b[ 6] = *(a01 + 6); + b[ 7] = *(a01 + 7); + b[ 8] = *(a01 + 8); + b[ 9] = *(a01 + 9); + b[ 10] = *(a01 + 10); + b[ 11] = *(a01 + 11); + b[ 12] = *(a01 + 12); + b[ 13] = *(a01 + 13); + b[ 14] = *(a01 + 14); + b[ 15] = *(a01 + 15); + + b[ 16] = *(a01 + 16); + b[ 17] = *(a01 + 17); + b[ 18] = *(a01 + 18); + b[ 19] = *(a01 + 19); + b[ 20] = *(a01 + 20); + b[ 21] = *(a01 + 21); + b[ 22] = *(a01 + 22); + b[ 23] = *(a01 + 23); + b[ 24] = *(a01 + 24); + b[ 25] = *(a01 + 25); + b[ 26] = *(a01 + 26); + b[ 27] = *(a01 + 27); + b[ 28] = *(a01 + 28); + b[ 29] = *(a01 + 29); + b[ 30] = *(a01 + 30); + b[ 31] = *(a01 + 31); + + a01 += lda; + a02 += lda; + a03 += lda; + a04 += lda; + a05 += lda; + a06 += lda; + a07 += lda; + a08 += lda; + a09 += lda; + a10 += lda; + a11 += lda; + a12 += lda; + a13 += lda; + a14 += lda; + a15 += lda; + a16 += lda; + b += 32; + } + } else { +#ifdef UNIT + b[ 0] = ONE; + b[ 1] = ZERO; +#else + b[ 0] = *(a01 + 0); + b[ 1] = *(a01 + 1); +#endif + b[ 2] = ZERO; + b[ 3] = ZERO; + b[ 4] = ZERO; + b[ 5] = ZERO; + b[ 6] = ZERO; + b[ 7] = ZERO; + b[ 8] = ZERO; + b[ 9] = ZERO; + b[ 10] = ZERO; + b[ 11] = ZERO; + b[ 12] = ZERO; + b[ 13] = ZERO; + b[ 14] = ZERO; + b[ 15] = ZERO; + b[ 16] = ZERO; + b[ 17] = ZERO; + b[ 18] = ZERO; + b[ 19] = ZERO; + b[ 20] = ZERO; + b[ 21] = ZERO; + b[ 22] = ZERO; + b[ 23] = ZERO; + b[ 24] = ZERO; + b[ 25] = ZERO; + b[ 26] = ZERO; + b[ 27] = ZERO; + b[ 28] = ZERO; + b[ 29] = ZERO; + b[ 30] = ZERO; + b[ 31] = ZERO; + b += 32; + + if (i >= 2) { + b[ 0] = *(a02 + 0); + b[ 1] = *(a02 + 1); +#ifdef UNIT + b[ 2] = ONE; + b[ 3] = ZERO; +#else + b[ 2] = *(a02 + 2); + b[ 3] = *(a02 + 3); +#endif + b[ 4] = ZERO; + b[ 5] = ZERO; + b[ 6] = ZERO; + b[ 7] = ZERO; + b[ 8] = ZERO; + b[ 9] = ZERO; + b[ 10] = ZERO; + b[ 11] = ZERO; + b[ 12] = ZERO; + b[ 13] = ZERO; + b[ 14] = ZERO; + b[ 15] = ZERO; + b[ 16] = ZERO; + b[ 17] = ZERO; + b[ 18] = ZERO; + b[ 19] = ZERO; + b[ 20] = ZERO; + b[ 21] = ZERO; + b[ 22] = ZERO; + b[ 23] = ZERO; + b[ 24] = ZERO; + b[ 25] = ZERO; + b[ 26] = ZERO; + b[ 27] = ZERO; + b[ 28] = ZERO; + b[ 29] = ZERO; + b[ 30] = ZERO; + b[ 31] = ZERO; + b += 32; + } + + if (i >= 3) { + b[ 0] = *(a03 + 0); + b[ 1] = *(a03 + 1); + b[ 2] = *(a03 + 2); + b[ 3] = *(a03 + 3); +#ifdef UNIT + b[ 4] = ONE; + b[ 5] = ZERO; +#else + b[ 4] = *(a03 + 4); + b[ 5] = *(a03 + 5); +#endif + b[ 6] = ZERO; + b[ 7] = ZERO; + b[ 8] = ZERO; + b[ 9] = ZERO; + b[ 10] = ZERO; + b[ 11] = ZERO; + b[ 12] = ZERO; + b[ 13] = ZERO; + b[ 14] = ZERO; + b[ 15] = ZERO; + b[ 16] = ZERO; + b[ 17] = ZERO; + b[ 18] = ZERO; + b[ 19] = ZERO; + b[ 20] = ZERO; + b[ 21] = ZERO; + b[ 22] = ZERO; + b[ 23] = ZERO; + b[ 24] = ZERO; + b[ 25] = ZERO; + b[ 26] = ZERO; + b[ 27] = ZERO; + b[ 28] = ZERO; + b[ 29] = ZERO; + b[ 30] = ZERO; + b[ 31] = ZERO; + b += 32; + } + + if (i >= 4) { + b[ 0] = *(a04 + 0); + b[ 1] = *(a04 + 1); + b[ 2] = *(a04 + 2); + b[ 3] = *(a04 + 3); + b[ 4] = *(a04 + 4); + b[ 5] = *(a04 + 5); +#ifdef UNIT + b[ 6] = ONE; + b[ 7] = ZERO; +#else + b[ 6] = *(a04 + 6); + b[ 7] = *(a04 + 7); +#endif + b[ 8] = ZERO; + b[ 9] = ZERO; + b[ 10] = ZERO; + b[ 11] = ZERO; + b[ 12] = ZERO; + b[ 13] = ZERO; + b[ 14] = ZERO; + b[ 15] = ZERO; + b[ 16] = ZERO; + b[ 17] = ZERO; + b[ 18] = ZERO; + b[ 19] = ZERO; + b[ 20] = ZERO; + b[ 21] = ZERO; + b[ 22] = ZERO; + b[ 23] = ZERO; + b[ 24] = ZERO; + b[ 25] = ZERO; + b[ 26] = ZERO; + b[ 27] = ZERO; + b[ 28] = ZERO; + b[ 29] = ZERO; + b[ 30] = ZERO; + b[ 31] = ZERO; + b += 32; + } + + if (i >= 5) { + b[ 0] = *(a05 + 0); + b[ 1] = *(a05 + 1); + b[ 2] = *(a05 + 2); + b[ 3] = *(a05 + 3); + b[ 4] = *(a05 + 4); + b[ 5] = *(a05 + 5); + b[ 6] = *(a05 + 6); + b[ 7] = *(a05 + 7); +#ifdef UNIT + b[ 8] = ONE; + b[ 9] = ZERO; +#else + b[ 8] = *(a05 + 8); + b[ 9] = *(a05 + 9); +#endif + b[ 10] = ZERO; + b[ 11] = ZERO; + b[ 12] = ZERO; + b[ 13] = ZERO; + b[ 14] = ZERO; + b[ 15] = ZERO; + b[ 16] = ZERO; + b[ 17] = ZERO; + b[ 18] = ZERO; + b[ 19] = ZERO; + b[ 20] = ZERO; + b[ 21] = ZERO; + b[ 22] = ZERO; + b[ 23] = ZERO; + b[ 24] = ZERO; + b[ 25] = ZERO; + b[ 26] = ZERO; + b[ 27] = ZERO; + b[ 28] = ZERO; + b[ 29] = ZERO; + b[ 30] = ZERO; + b[ 31] = ZERO; + b += 32; + } + + if (i >= 6) { + b[ 0] = *(a06 + 0); + b[ 1] = *(a06 + 1); + b[ 2] = *(a06 + 2); + b[ 3] = *(a06 + 3); + b[ 4] = *(a06 + 4); + b[ 5] = *(a06 + 5); + b[ 6] = *(a06 + 6); + b[ 7] = *(a06 + 7); + b[ 8] = *(a06 + 8); + b[ 9] = *(a06 + 9); +#ifdef UNIT + b[10] = ONE; + b[11] = ZERO; +#else + b[10] = *(a06 + 10); + b[11] = *(a06 + 11); +#endif + b[ 12] = ZERO; + b[ 13] = ZERO; + b[ 14] = ZERO; + b[ 15] = ZERO; + b[ 16] = ZERO; + b[ 17] = ZERO; + b[ 18] = ZERO; + b[ 19] = ZERO; + b[ 20] = ZERO; + b[ 21] = ZERO; + b[ 22] = ZERO; + b[ 23] = ZERO; + b[ 24] = ZERO; + b[ 25] = ZERO; + b[ 26] = ZERO; + b[ 27] = ZERO; + b[ 28] = ZERO; + b[ 29] = ZERO; + b[ 30] = ZERO; + b[ 31] = ZERO; + b += 32; + } + + if (i >= 7) { + b[ 0] = *(a07 + 0); + b[ 1] = *(a07 + 1); + b[ 2] = *(a07 + 2); + b[ 3] = *(a07 + 3); + b[ 4] = *(a07 + 4); + b[ 5] = *(a07 + 5); + b[ 6] = *(a07 + 6); + b[ 7] = *(a07 + 7); + b[ 8] = *(a07 + 8); + b[ 9] = *(a07 + 9); + b[10] = *(a07 + 10); + b[11] = *(a07 + 11); +#ifdef UNIT + b[12] = ONE; + b[13] = ZERO; +#else + b[12] = *(a07 + 12); + b[13] = *(a07 + 13); +#endif + b[ 14] = ZERO; + b[ 15] = ZERO; + b[ 16] = ZERO; + b[ 17] = ZERO; + b[ 18] = ZERO; + b[ 19] = ZERO; + b[ 20] = ZERO; + b[ 21] = ZERO; + b[ 22] = ZERO; + b[ 23] = ZERO; + b[ 24] = ZERO; + b[ 25] = ZERO; + b[ 26] = ZERO; + b[ 27] = ZERO; + b[ 28] = ZERO; + b[ 29] = ZERO; + b[ 30] = ZERO; + b[ 31] = ZERO; + b += 32; + } + + if (i >= 8) { + b[ 0] = *(a08 + 0); + b[ 1] = *(a08 + 1); + b[ 2] = *(a08 + 2); + b[ 3] = *(a08 + 3); + b[ 4] = *(a08 + 4); + b[ 5] = *(a08 + 5); + b[ 6] = *(a08 + 6); + b[ 7] = *(a08 + 7); + b[ 8] = *(a08 + 8); + b[ 9] = *(a08 + 9); + b[ 10] = *(a08 + 10); + b[ 11] = *(a08 + 11); + b[ 12] = *(a08 + 12); + b[ 13] = *(a08 + 13); +#ifdef UNIT + b[ 14] = ONE; + b[ 15] = ZERO; +#else + b[ 14] = *(a08 + 14); + b[ 15] = *(a08 + 15); +#endif + b[ 16] = ZERO; + b[ 17] = ZERO; + b[ 18] = ZERO; + b[ 19] = ZERO; + b[ 20] = ZERO; + b[ 21] = ZERO; + b[ 22] = ZERO; + b[ 23] = ZERO; + b[ 24] = ZERO; + b[ 25] = ZERO; + b[ 26] = ZERO; + b[ 27] = ZERO; + b[ 28] = ZERO; + b[ 29] = ZERO; + b[ 30] = ZERO; + b[ 31] = ZERO; + b += 32; + } + + if (i >= 9) { + b[ 0] = *(a09 + 0); + b[ 1] = *(a09 + 1); + b[ 2] = *(a09 + 2); + b[ 3] = *(a09 + 3); + b[ 4] = *(a09 + 4); + b[ 5] = *(a09 + 5); + b[ 6] = *(a09 + 6); + b[ 7] = *(a09 + 7); + b[ 8] = *(a09 + 8); + b[ 9] = *(a09 + 9); + b[ 10] = *(a09 + 10); + b[ 11] = *(a09 + 11); + b[ 12] = *(a09 + 12); + b[ 13] = *(a09 + 13); + b[ 14] = *(a09 + 14); + b[ 15] = *(a09 + 15); +#ifdef UNIT + b[ 16] = ONE; + b[ 17] = ZERO; +#else + b[ 16] = *(a09 + 16); + b[ 17] = *(a09 + 17); +#endif + b[ 18] = ZERO; + b[ 19] = ZERO; + b[ 20] = ZERO; + b[ 21] = ZERO; + b[ 22] = ZERO; + b[ 23] = ZERO; + b[ 24] = ZERO; + b[ 25] = ZERO; + b[ 26] = ZERO; + b[ 27] = ZERO; + b[ 28] = ZERO; + b[ 29] = ZERO; + b[ 30] = ZERO; + b[ 31] = ZERO; + b += 32; + } + + if (i >= 10) { + b[ 0] = *(a10 + 0); + b[ 1] = *(a10 + 1); + b[ 2] = *(a10 + 2); + b[ 3] = *(a10 + 3); + b[ 4] = *(a10 + 4); + b[ 5] = *(a10 + 5); + b[ 6] = *(a10 + 6); + b[ 7] = *(a10 + 7); + b[ 8] = *(a10 + 8); + b[ 9] = *(a10 + 9); + b[ 10] = *(a10 + 10); + b[ 11] = *(a10 + 11); + b[ 12] = *(a10 + 12); + b[ 13] = *(a10 + 13); + b[ 14] = *(a10 + 14); + b[ 15] = *(a10 + 15); + b[ 16] = *(a10 + 16); + b[ 17] = *(a10 + 17); +#ifdef UNIT + b[ 18] = ONE; + b[ 19] = ZERO; +#else + b[ 18] = *(a10 + 18); + b[ 19] = *(a10 + 19); +#endif + b[ 20] = ZERO; + b[ 21] = ZERO; + b[ 22] = ZERO; + b[ 23] = ZERO; + b[ 24] = ZERO; + b[ 25] = ZERO; + b[ 26] = ZERO; + b[ 27] = ZERO; + b[ 28] = ZERO; + b[ 29] = ZERO; + b[ 30] = ZERO; + b[ 31] = ZERO; + b += 32; + } + + if (i >= 11) { + b[ 0] = *(a11 + 0); + b[ 1] = *(a11 + 1); + b[ 2] = *(a11 + 2); + b[ 3] = *(a11 + 3); + b[ 4] = *(a11 + 4); + b[ 5] = *(a11 + 5); + b[ 6] = *(a11 + 6); + b[ 7] = *(a11 + 7); + b[ 8] = *(a11 + 8); + b[ 9] = *(a11 + 9); + b[ 10] = *(a11 + 10); + b[ 11] = *(a11 + 11); + b[ 12] = *(a11 + 12); + b[ 13] = *(a11 + 13); + b[ 14] = *(a11 + 14); + b[ 15] = *(a11 + 15); + b[ 16] = *(a11 + 16); + b[ 17] = *(a11 + 17); + b[ 18] = *(a11 + 18); + b[ 19] = *(a11 + 19); +#ifdef UNIT + b[ 20] = ONE; + b[ 21] = ZERO; +#else + b[ 20] = *(a11 + 20); + b[ 21] = *(a11 + 21); +#endif + b[ 22] = ZERO; + b[ 23] = ZERO; + b[ 24] = ZERO; + b[ 25] = ZERO; + b[ 26] = ZERO; + b[ 27] = ZERO; + b[ 28] = ZERO; + b[ 29] = ZERO; + b[ 30] = ZERO; + b[ 31] = ZERO; + b += 32; + } + + if (i >= 12) { + b[ 0] = *(a12 + 0); + b[ 1] = *(a12 + 1); + b[ 2] = *(a12 + 2); + b[ 3] = *(a12 + 3); + b[ 4] = *(a12 + 4); + b[ 5] = *(a12 + 5); + b[ 6] = *(a12 + 6); + b[ 7] = *(a12 + 7); + b[ 8] = *(a12 + 8); + b[ 9] = *(a12 + 9); + b[ 10] = *(a12 + 10); + b[ 11] = *(a12 + 11); + b[ 12] = *(a12 + 12); + b[ 13] = *(a12 + 13); + b[ 14] = *(a12 + 14); + b[ 15] = *(a12 + 15); + b[ 16] = *(a12 + 16); + b[ 17] = *(a12 + 17); + b[ 18] = *(a12 + 18); + b[ 19] = *(a12 + 19); + b[ 20] = *(a12 + 20); + b[ 21] = *(a12 + 21); +#ifdef UNIT + b[ 22] = ONE; + b[ 23] = ZERO; +#else + b[ 22] = *(a12 + 22); + b[ 23] = *(a12 + 23); +#endif + b[ 24] = ZERO; + b[ 25] = ZERO; + b[ 26] = ZERO; + b[ 27] = ZERO; + b[ 28] = ZERO; + b[ 29] = ZERO; + b[ 30] = ZERO; + b[ 31] = ZERO; + b += 32; + } + + if (i >= 13) { + b[ 0] = *(a13 + 0); + b[ 1] = *(a13 + 1); + b[ 2] = *(a13 + 2); + b[ 3] = *(a13 + 3); + b[ 4] = *(a13 + 4); + b[ 5] = *(a13 + 5); + b[ 6] = *(a13 + 6); + b[ 7] = *(a13 + 7); + b[ 8] = *(a13 + 8); + b[ 9] = *(a13 + 9); + b[ 10] = *(a13 + 10); + b[ 11] = *(a13 + 11); + b[ 12] = *(a13 + 12); + b[ 13] = *(a13 + 13); + b[ 14] = *(a13 + 14); + b[ 15] = *(a13 + 15); + b[ 16] = *(a13 + 16); + b[ 17] = *(a13 + 17); + b[ 18] = *(a13 + 18); + b[ 19] = *(a13 + 19); + b[ 20] = *(a13 + 20); + b[ 21] = *(a13 + 21); + b[ 22] = *(a13 + 22); + b[ 23] = *(a13 + 23); +#ifdef UNIT + b[ 24] = ONE; + b[ 25] = ZERO; +#else + b[ 24] = *(a13 + 24); + b[ 25] = *(a13 + 25); +#endif + b[ 26] = ZERO; + b[ 27] = ZERO; + b[ 28] = ZERO; + b[ 29] = ZERO; + b[ 30] = ZERO; + b[ 31] = ZERO; + b += 32; + } + + if (i >= 14) { + b[ 0] = *(a14 + 0); + b[ 1] = *(a14 + 1); + b[ 2] = *(a14 + 2); + b[ 3] = *(a14 + 3); + b[ 4] = *(a14 + 4); + b[ 5] = *(a14 + 5); + b[ 6] = *(a14 + 6); + b[ 7] = *(a14 + 7); + b[ 8] = *(a14 + 8); + b[ 9] = *(a14 + 9); + b[ 10] = *(a14 + 10); + b[ 11] = *(a14 + 11); + b[ 12] = *(a14 + 12); + b[ 13] = *(a14 + 13); + b[ 14] = *(a14 + 14); + b[ 15] = *(a14 + 15); + b[ 16] = *(a14 + 16); + b[ 17] = *(a14 + 17); + b[ 18] = *(a14 + 18); + b[ 19] = *(a14 + 19); + b[ 20] = *(a14 + 20); + b[ 21] = *(a14 + 21); + b[ 22] = *(a14 + 22); + b[ 23] = *(a14 + 23); + b[ 24] = *(a14 + 24); + b[ 25] = *(a14 + 25); +#ifdef UNIT + b[ 26] = ONE; + b[ 27] = ZERO; +#else + b[ 26] = *(a14 + 26); + b[ 27] = *(a14 + 27); +#endif + b[ 28] = ZERO; + b[ 29] = ZERO; + b[ 30] = ZERO; + b[ 31] = ZERO; + b += 32; + } + + if (i >= 15) { + b[ 0] = *(a15 + 0); + b[ 1] = *(a15 + 1); + b[ 2] = *(a15 + 2); + b[ 3] = *(a15 + 3); + b[ 4] = *(a15 + 4); + b[ 5] = *(a15 + 5); + b[ 6] = *(a15 + 6); + b[ 7] = *(a15 + 7); + b[ 8] = *(a15 + 8); + b[ 9] = *(a15 + 9); + b[ 10] = *(a15 + 10); + b[ 11] = *(a15 + 11); + b[ 12] = *(a15 + 12); + b[ 13] = *(a15 + 13); + b[ 14] = *(a15 + 14); + b[ 15] = *(a15 + 15); + b[ 16] = *(a15 + 16); + b[ 17] = *(a15 + 17); + b[ 18] = *(a15 + 18); + b[ 19] = *(a15 + 19); + b[ 20] = *(a15 + 20); + b[ 21] = *(a15 + 21); + b[ 22] = *(a15 + 22); + b[ 23] = *(a15 + 23); + b[ 24] = *(a15 + 24); + b[ 25] = *(a15 + 25); + b[ 26] = *(a15 + 26); + b[ 27] = *(a15 + 27); +#ifdef UNIT + b[ 28] = ONE; + b[ 29] = ZERO; +#else + b[ 28] = *(a15 + 28); + b[ 29] = *(a15 + 29); +#endif + b[ 30] = ZERO; + b[ 31] = ZERO; + b += 32; + } + } + } + + posY += 16; + js --; + } while (js > 0); + } /* End of main loop */ + + + if (n & 8){ + X = posX; + + if (posX <= posY) { + a01 = a + posX * 2 + (posY + 0) * lda; + a02 = a + posX * 2 + (posY + 1) * lda; + a03 = a + posX * 2 + (posY + 2) * lda; + a04 = a + posX * 2 + (posY + 3) * lda; + a05 = a + posX * 2 + (posY + 4) * lda; + a06 = a + posX * 2 + (posY + 5) * lda; + a07 = a + posX * 2 + (posY + 6) * lda; + a08 = a + posX * 2 + (posY + 7) * lda; + } else { + a01 = a + posY * 2 + (posX + 0) * lda; + a02 = a + posY * 2 + (posX + 1) * lda; + a03 = a + posY * 2 + (posX + 2) * lda; + a04 = a + posY * 2 + (posX + 3) * lda; + a05 = a + posY * 2 + (posX + 4) * lda; + a06 = a + posY * 2 + (posX + 5) * lda; + a07 = a + posY * 2 + (posX + 6) * lda; + a08 = a + posY * 2 + (posX + 7) * lda; + } + + i = (m >> 3); + if (i > 0) { + do { + if (X < posY) { + a01 += 16; + a02 += 16; + a03 += 16; + a04 += 16; + a05 += 16; + a06 += 16; + a07 += 16; + a08 += 16; + b += 128; + } else + if (X > posY) { + for (ii = 0; ii < 8; ii++){ + + b[ 0] = *(a01 + 0); + b[ 1] = *(a01 + 1); + b[ 2] = *(a01 + 2); + b[ 3] = *(a01 + 3); + b[ 4] = *(a01 + 4); + b[ 5] = *(a01 + 5); + b[ 6] = *(a01 + 6); + b[ 7] = *(a01 + 7); + + b[ 8] = *(a01 + 8); + b[ 9] = *(a01 + 9); + b[ 10] = *(a01 + 10); + b[ 11] = *(a01 + 11); + b[ 12] = *(a01 + 12); + b[ 13] = *(a01 + 13); + b[ 14] = *(a01 + 14); + b[ 15] = *(a01 + 15); + + a01 += lda; + b += 16; + } + a02 += 8 * lda; + a03 += 8 * lda; + a04 += 8 * lda; + a05 += 8 * lda; + a06 += 8 * lda; + a07 += 8 * lda; + a08 += 8 * lda; + + } else { +#ifdef UNIT + b[ 0] = ONE; + b[ 1] = ZERO; +#else + b[ 0] = *(a01 + 0); + b[ 1] = *(a01 + 1); +#endif + b[ 2] = ZERO; + b[ 3] = ZERO; + b[ 4] = ZERO; + b[ 5] = ZERO; + b[ 6] = ZERO; + b[ 7] = ZERO; + + b[ 8] = ZERO; + b[ 9] = ZERO; + b[ 10] = ZERO; + b[ 11] = ZERO; + b[ 12] = ZERO; + b[ 13] = ZERO; + b[ 14] = ZERO; + b[ 15] = ZERO; + + b[ 16] = *(a02 + 0); + b[ 17] = *(a02 + 1); +#ifdef UNIT + b[ 18] = ONE; + b[ 19] = ZERO; +#else + b[ 18] = *(a02 + 2); + b[ 19] = *(a02 + 3); +#endif + b[ 20] = ZERO; + b[ 21] = ZERO; + b[ 22] = ZERO; + b[ 23] = ZERO; + b[ 24] = ZERO; + b[ 25] = ZERO; + b[ 26] = ZERO; + b[ 27] = ZERO; + b[ 28] = ZERO; + b[ 29] = ZERO; + b[ 30] = ZERO; + b[ 31] = ZERO; + + b[ 32] = *(a03 + 0); + b[ 33] = *(a03 + 1); + b[ 34] = *(a03 + 2); + b[ 35] = *(a03 + 3); +#ifdef UNIT + b[ 36] = ONE; + b[ 37] = ZERO; +#else + b[ 36] = *(a03 + 4); + b[ 37] = *(a03 + 5); +#endif + b[ 38] = ZERO; + b[ 39] = ZERO; + b[ 40] = ZERO; + b[ 41] = ZERO; + b[ 42] = ZERO; + b[ 43] = ZERO; + b[ 44] = ZERO; + b[ 45] = ZERO; + b[ 46] = ZERO; + b[ 47] = ZERO; + + b[ 48] = *(a04 + 0); + b[ 49] = *(a04 + 1); + b[ 50] = *(a04 + 2); + b[ 51] = *(a04 + 3); + b[ 52] = *(a04 + 4); + b[ 53] = *(a04 + 5); +#ifdef UNIT + b[ 54] = ONE; + b[ 55] = ZERO; +#else + b[ 54] = *(a04 + 6); + b[ 55] = *(a04 + 7); +#endif + b[ 56] = ZERO; + b[ 57] = ZERO; + b[ 58] = ZERO; + b[ 59] = ZERO; + b[ 60] = ZERO; + b[ 61] = ZERO; + b[ 62] = ZERO; + b[ 63] = ZERO; + + b[ 64] = *(a05 + 0); + b[ 65] = *(a05 + 1); + b[ 66] = *(a05 + 2); + b[ 67] = *(a05 + 3); + b[ 68] = *(a05 + 4); + b[ 69] = *(a05 + 5); + b[ 70] = *(a05 + 6); + b[ 71] = *(a05 + 7); +#ifdef UNIT + b[ 72] = ONE; + b[ 73] = ZERO; +#else + b[ 72] = *(a05 + 8); + b[ 73] = *(a05 + 9); +#endif + b[ 74] = ZERO; + b[ 75] = ZERO; + b[ 76] = ZERO; + b[ 77] = ZERO; + b[ 78] = ZERO; + b[ 79] = ZERO; + + b[ 80] = *(a06 + 0); + b[ 81] = *(a06 + 1); + b[ 82] = *(a06 + 2); + b[ 83] = *(a06 + 3); + b[ 84] = *(a06 + 4); + b[ 85] = *(a06 + 5); + b[ 86] = *(a06 + 6); + b[ 87] = *(a06 + 7); + b[ 88] = *(a06 + 8); + b[ 89] = *(a06 + 9); +#ifdef UNIT + b[ 90] = ONE; + b[ 91] = ZERO; +#else + b[ 90] = *(a06 + 10); + b[ 91] = *(a06 + 11); +#endif + b[ 92] = ZERO; + b[ 93] = ZERO; + b[ 94] = ZERO; + b[ 95] = ZERO; + + b[ 96] = *(a07 + 0); + b[ 97] = *(a07 + 1); + b[ 98] = *(a07 + 2); + b[ 99] = *(a07 + 3); + b[100] = *(a07 + 4); + b[101] = *(a07 + 5); + b[102] = *(a07 + 6); + b[103] = *(a07 + 7); + b[104] = *(a07 + 8); + b[105] = *(a07 + 9); + b[106] = *(a07 + 10); + b[107] = *(a07 + 11); +#ifdef UNIT + b[108] = ONE; + b[109] = ZERO; +#else + b[108] = *(a07 + 12); + b[109] = *(a07 + 13); +#endif + b[110] = ZERO; + b[111] = ZERO; + + b[112] = *(a08 + 0); + b[113] = *(a08 + 1); + b[114] = *(a08 + 2); + b[115] = *(a08 + 3); + b[116] = *(a08 + 4); + b[117] = *(a08 + 5); + b[118] = *(a08 + 6); + b[119] = *(a08 + 7); + b[120] = *(a08 + 8); + b[121] = *(a08 + 9); + b[122] = *(a08 + 10); + b[123] = *(a08 + 11); + b[124] = *(a08 + 12); + b[125] = *(a08 + 13); +#ifdef UNIT + b[126] = ONE; + b[127] = ZERO; +#else + b[126] = *(a08 + 14); + b[127] = *(a08 + 15); +#endif + + a01 += 8 * lda; + a02 += 8 * lda; + a03 += 8 * lda; + a04 += 8 * lda; + a05 += 8 * lda; + a06 += 8 * lda; + a07 += 8 * lda; + a08 += 8 * lda; + b += 128; + } + + X += 8; + i --; + } while (i > 0); + } + + i = (m & 7); + if (i) { + + if (X < posY) { + /* a01 += 2 * i; + a02 += 2 * i; + a03 += 2 * i; + a04 += 2 * i; + a05 += 2 * i; + a06 += 2 * i; + a07 += 2 * i; + a08 += 2 * i; */ + b += 16 * i; + } else + if (X > posY) { + for (ii = 0; ii < i; ii++){ + + b[ 0] = *(a01 + 0); + b[ 1] = *(a01 + 1); + b[ 2] = *(a01 + 2); + b[ 3] = *(a01 + 3); + b[ 4] = *(a01 + 4); + b[ 5] = *(a01 + 5); + b[ 6] = *(a01 + 6); + b[ 7] = *(a01 + 7); + + b[ 8] = *(a01 + 8); + b[ 9] = *(a01 + 9); + b[ 10] = *(a01 + 10); + b[ 11] = *(a01 + 11); + b[ 12] = *(a01 + 12); + b[ 13] = *(a01 + 13); + b[ 14] = *(a01 + 14); + b[ 15] = *(a01 + 15); + + a01 += lda; + a02 += lda; + a03 += lda; + a04 += lda; + a05 += lda; + a06 += lda; + a07 += lda; + a08 += lda; + b += 16; + } + } else { +#ifdef UNIT + b[ 0] = ONE; + b[ 1] = ZERO; +#else + b[ 0] = *(a01 + 0); + b[ 1] = *(a01 + 1); +#endif + b[ 2] = ZERO; + b[ 3] = ZERO; + b[ 4] = ZERO; + b[ 5] = ZERO; + b[ 6] = ZERO; + b[ 7] = ZERO; + b[ 8] = ZERO; + b[ 9] = ZERO; + b[10] = ZERO; + b[11] = ZERO; + b[12] = ZERO; + b[13] = ZERO; + b[14] = ZERO; + b[15] = ZERO; + b += 16; + + if(i >= 2) { + b[ 0] = *(a02 + 0); + b[ 1] = *(a02 + 1); +#ifdef UNIT + b[ 2] = ONE; + b[ 3] = ZERO; +#else + b[ 2] = *(a02 + 2); + b[ 3] = *(a02 + 3); +#endif + b[ 4] = ZERO; + b[ 5] = ZERO; + b[ 6] = ZERO; + b[ 7] = ZERO; + b[ 8] = ZERO; + b[ 9] = ZERO; + b[10] = ZERO; + b[11] = ZERO; + b[12] = ZERO; + b[13] = ZERO; + b[14] = ZERO; + b[15] = ZERO; + b += 16; + } + + if (i >= 3) { + b[ 0] = *(a03 + 0); + b[ 1] = *(a03 + 1); + b[ 2] = *(a03 + 2); + b[ 3] = *(a03 + 3); +#ifdef UNIT + b[ 4] = ONE; + b[ 5] = ZERO; +#else + b[ 4] = *(a03 + 4); + b[ 5] = *(a03 + 5); +#endif + b[ 6] = ZERO; + b[ 7] = ZERO; + b[ 8] = ZERO; + b[ 9] = ZERO; + b[10] = ZERO; + b[11] = ZERO; + b[12] = ZERO; + b[13] = ZERO; + b[14] = ZERO; + b[15] = ZERO; + b += 16; + } + + if (i >= 4) { + b[ 0] = *(a04 + 0); + b[ 1] = *(a04 + 1); + b[ 2] = *(a04 + 2); + b[ 3] = *(a04 + 3); + b[ 4] = *(a04 + 4); + b[ 5] = *(a04 + 5); +#ifdef UNIT + b[ 6] = ONE; + b[ 7] = ZERO; +#else + b[ 6] = *(a04 + 6); + b[ 7] = *(a04 + 7); +#endif + b[ 8] = ZERO; + b[ 9] = ZERO; + b[10] = ZERO; + b[11] = ZERO; + b[12] = ZERO; + b[13] = ZERO; + b[14] = ZERO; + b[15] = ZERO; + b += 16; + } + + if (i >= 5) { + b[ 0] = *(a05 + 0); + b[ 1] = *(a05 + 1); + b[ 2] = *(a05 + 2); + b[ 3] = *(a05 + 3); + b[ 4] = *(a05 + 4); + b[ 5] = *(a05 + 5); + b[ 6] = *(a05 + 6); + b[ 7] = *(a05 + 7); +#ifdef UNIT + b[ 8] = ONE; + b[ 9] = ZERO; +#else + b[ 8] = *(a05 + 8); + b[ 9] = *(a05 + 9); +#endif + b[10] = ZERO; + b[11] = ZERO; + b[12] = ZERO; + b[13] = ZERO; + b[14] = ZERO; + b[15] = ZERO; + b += 16; + } + + if (i >= 6) { + b[ 0] = *(a06 + 0); + b[ 1] = *(a06 + 1); + b[ 2] = *(a06 + 2); + b[ 3] = *(a06 + 3); + b[ 4] = *(a06 + 4); + b[ 5] = *(a06 + 5); + b[ 6] = *(a06 + 6); + b[ 7] = *(a06 + 7); + b[ 8] = *(a06 + 8); + b[ 9] = *(a06 + 9); +#ifdef UNIT + b[10] = ONE; + b[11] = ZERO; +#else + b[10] = *(a06 + 10); + b[11] = *(a06 + 11); +#endif + b[12] = ZERO; + b[13] = ZERO; + b[14] = ZERO; + b[15] = ZERO; + b += 16; + } + + if (i >= 7) { + b[ 0] = *(a07 + 0); + b[ 1] = *(a07 + 1); + b[ 2] = *(a07 + 2); + b[ 3] = *(a07 + 3); + b[ 4] = *(a07 + 4); + b[ 5] = *(a07 + 5); + b[ 6] = *(a07 + 6); + b[ 7] = *(a07 + 7); + b[ 8] = *(a07 + 8); + b[ 9] = *(a07 + 9); + b[10] = *(a07 + 10); + b[11] = *(a07 + 11); +#ifdef UNIT + b[12] = ONE; + b[13] = ZERO; +#else + b[12] = *(a07 + 12); + b[13] = *(a07 + 13); +#endif + b[14] = ZERO; + b[15] = ZERO; + b += 16; + } + } + } + + posY += 8; + } + + + if (n & 4){ + X = posX; + + if (posX <= posY) { + a01 = a + posX * 2 + (posY + 0) * lda; + a02 = a + posX * 2 + (posY + 1) * lda; + a03 = a + posX * 2 + (posY + 2) * lda; + a04 = a + posX * 2 + (posY + 3) * lda; + } else { + a01 = a + posY * 2 + (posX + 0) * lda; + a02 = a + posY * 2 + (posX + 1) * lda; + a03 = a + posY * 2 + (posX + 2) * lda; + a04 = a + posY * 2 + (posX + 3) * lda; + } + + i = (m >> 2); + if (i > 0) { + do { + if (X < posY) { + a01 += 8; + a02 += 8; + a03 += 8; + a04 += 8; + b += 32; + } else + if (X > posY) { + + for (ii = 0; ii < 4; ii++){ + + b[ 0] = *(a01 + 0); + b[ 1] = *(a01 + 1); + b[ 2] = *(a01 + 2); + b[ 3] = *(a01 + 3); + b[ 4] = *(a01 + 4); + b[ 5] = *(a01 + 5); + b[ 6] = *(a01 + 6); + b[ 7] = *(a01 + 7); + + a01 += lda; + b += 8; + } + + a02 += 4 * lda; + a03 += 4 * lda; + a04 += 4 * lda; + + } else { +#ifdef UNIT + b[ 0] = ONE; + b[ 1] = ZERO; +#else + b[ 0] = *(a01 + 0); + b[ 1] = *(a01 + 1); +#endif + b[ 2] = ZERO; + b[ 3] = ZERO; + b[ 4] = ZERO; + b[ 5] = ZERO; + b[ 6] = ZERO; + b[ 7] = ZERO; + + b[ 8] = *(a02 + 0); + b[ 9] = *(a02 + 1); +#ifdef UNIT + b[ 10] = ONE; + b[ 11] = ZERO; +#else + b[ 10] = *(a02 + 2); + b[ 11] = *(a02 + 3); +#endif + b[ 12] = ZERO; + b[ 13] = ZERO; + b[ 14] = ZERO; + b[ 15] = ZERO; + + b[ 16] = *(a03 + 0); + b[ 17] = *(a03 + 1); + b[ 18] = *(a03 + 2); + b[ 19] = *(a03 + 3); +#ifdef UNIT + b[ 20] = ONE; + b[ 21] = ZERO; +#else + b[ 20] = *(a03 + 4); + b[ 21] = *(a03 + 5); +#endif + b[ 22] = ZERO; + b[ 23] = ZERO; + + b[ 24] = *(a04 + 0); + b[ 25] = *(a04 + 1); + b[ 26] = *(a04 + 2); + b[ 27] = *(a04 + 3); + b[ 28] = *(a04 + 4); + b[ 29] = *(a04 + 5); +#ifdef UNIT + b[ 30] = ONE; + b[ 31] = ZERO; +#else + b[ 30] = *(a04 + 6); + b[ 31] = *(a04 + 7); +#endif + + a01 += 4 * lda; + a02 += 4 * lda; + a03 += 4 * lda; + a04 += 4 * lda; + b += 32; + } + + X += 4; + i --; + } while (i > 0); + } + + i = (m & 3); + if (i) { + + if (X < posY) { + /* a01 += 2 * i; + a02 += 2 * i; + a03 += 2 * i; + a04 += 2 * i; */ + b += 8 * i; + } else + if (X > posY) { + + for (ii = 0; ii < i; ii++){ + + b[ 0] = *(a01 + 0); + b[ 1] = *(a01 + 1); + b[ 2] = *(a01 + 2); + b[ 3] = *(a01 + 3); + b[ 4] = *(a01 + 4); + b[ 5] = *(a01 + 5); + b[ 6] = *(a01 + 6); + b[ 7] = *(a01 + 7); + + a01 += lda; + a02 += lda; + a03 += lda; + a04 += lda; + b += 8; + } + } else { + +#ifdef UNIT + b[ 0] = ONE; + b[ 1] = ZERO; +#else + b[ 0] = *(a01 + 0); + b[ 1] = *(a01 + 1); +#endif + b[ 2] = ZERO; + b[ 3] = ZERO; + b[ 4] = ZERO; + b[ 5] = ZERO; + b[ 6] = ZERO; + b[ 7] = ZERO; + b += 8; + + if(i >= 2) { + b[ 0] = *(a02 + 0); + b[ 1] = *(a02 + 1); +#ifdef UNIT + b[ 2] = ONE; + b[ 3] = ZERO; +#else + b[ 2] = *(a02 + 2); + b[ 3] = *(a02 + 3); +#endif + b[ 4] = ZERO; + b[ 5] = ZERO; + b[ 6] = ZERO; + b[ 7] = ZERO; + b += 8; + } + + if (i >= 3) { + b[ 0] = *(a03 + 0); + b[ 1] = *(a03 + 1); + b[ 2] = *(a03 + 2); + b[ 3] = *(a03 + 3); +#ifdef UNIT + b[ 4] = ONE; + b[ 5] = ZERO; +#else + b[ 4] = *(a03 + 4); + b[ 5] = *(a03 + 5); +#endif + b[ 6] = ZERO; + b[ 7] = ZERO; + b += 8; + } + } + } + + posY += 4; + } + + + if (n & 2){ + X = posX; + + if (posX <= posY) { + a01 = a + posX * 2 + (posY + 0) * lda; + a02 = a + posX * 2 + (posY + 1) * lda; + } else { + a01 = a + posY * 2 + (posX + 0) * lda; + a02 = a + posY * 2 + (posX + 1) * lda; + } + + i = (m >> 1); + if (i > 0) { + do { + if (X < posY) { + a01 += 4; + a02 += 4; + b += 8; + } else + if (X > posY) { + b[ 0] = *(a01 + 0); + b[ 1] = *(a01 + 1); + b[ 2] = *(a01 + 2); + b[ 3] = *(a01 + 3); + b[ 4] = *(a02 + 0); + b[ 5] = *(a02 + 1); + b[ 6] = *(a02 + 2); + b[ 7] = *(a02 + 3); + + a01 += 2 * lda; + a02 += 2 * lda; + b += 8; + } else { + +#ifdef UNIT + b[ 0] = ONE; + b[ 1] = ZERO; +#else + b[ 0] = *(a01 + 0); + b[ 1] = *(a01 + 1); +#endif + b[ 2] = ZERO; + b[ 3] = ZERO; + + b[ 4] = *(a02 + 0); + b[ 5] = *(a02 + 1); +#ifdef UNIT + b[ 6] = ONE; + b[ 7] = ZERO; +#else + b[ 6] = *(a02 + 2); + b[ 7] = *(a02 + 3); +#endif + + a01 += 2 * lda; + a02 += 2 * lda; + b += 8; + } + + X += 2; + i --; + } while (i > 0); + } + + i = (m & 1); + if (i) { + + if (X < posY) { + b += 4; + } else + if (X > posY) { + b[ 0] = *(a01 + 0); + b[ 1] = *(a01 + 1); + b[ 2] = *(a01 + 2); + b[ 3] = *(a01 + 3); + b += 4; + } +#if 1 + } +#else + } else { +#ifdef UNIT + b[ 0] = ONE; + b[ 1] = ZERO; +#else + b[ 0] = *(a01 + 0); + b[ 1] = *(a01 + 1); +#endif + b[ 2] = *(a02 + 0); + b[ 3] = *(a02 + 1); + b += 4; + } +#endif + posY += 2; + } + + if (n & 1){ + X = posX; + + if (posX <= posY) { + a01 = a + posX * 2 + (posY + 0) * lda; + } else { + a01 = a + posY * 2 + (posX + 0) * lda; + } + + i = m; + if (m > 0) { + do { + if (X < posY) { + a01 += 2; + } else { +#ifdef UNIT + if (X > posY) { +#endif + b[ 0] = *(a01 + 0); + b[ 1] = *(a01 + 1); +#ifdef UNIT + } else { + b[ 0] = ONE; + b[ 1] = ZERO; + } +#endif + a01 += lda; + } + b += 2; + X ++; + i --; + } while (i > 0); + } + } + + return 0; +} diff --git a/kernel/generic/ztrsm_lncopy_16.c b/kernel/generic/ztrsm_lncopy_16.c new file mode 100644 index 000000000..4fd72c13e --- /dev/null +++ b/kernel/generic/ztrsm_lncopy_16.c @@ -0,0 +1,308 @@ +/******************************************************************************* +Copyright (c) 2024, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 +#include "common.h" + +int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG offset, FLOAT *b){ + + BLASLONG i, ii, j, jj, k; + + FLOAT *a1, *a2, *a3, *a4, *a5, *a6, *a7, *a8; + FLOAT *a9, *a10, *a11, *a12, *a13, *a14, *a15, *a16; + + FLOAT data1, data2; + + lda *= 2; + jj = offset; + + j = (n >> 4); + while (j > 0){ + + a1 = a + 0 * lda; + a2 = a + 1 * lda; + a3 = a + 2 * lda; + a4 = a + 3 * lda; + a5 = a + 4 * lda; + a6 = a + 5 * lda; + a7 = a + 6 * lda; + a8 = a + 7 * lda; + a9 = a + 8 * lda; + a10 = a + 9 * lda; + a11 = a + 10 * lda; + a12 = a + 11 * lda; + a13 = a + 12 * lda; + a14 = a + 13 * lda; + a15 = a + 14 * lda; + a16 = a + 15 * lda; + + a += 16 * lda; + ii = 0; + + for (i = 0; i < m; i++) { + + if ((ii >= jj ) && (ii - jj < 16)) { + for (k = 0; k < ii - jj; k ++) { + *(b + k * 2 + 0) = *(a1 + k * lda + 0); + *(b + k * 2 + 1) = *(a1 + k * lda + 1); + } + data1 = *(a1 + (ii - jj) * lda + 0); + data2 = *(a1 + (ii - jj) * lda + 1); + + compinv(b + (ii - jj) * 2, data1, data2); + } + + if (ii - jj >= 16) { + *(b + 0) = *(a1 + 0); + *(b + 1) = *(a1 + 1); + *(b + 2) = *(a2 + 0); + *(b + 3) = *(a2 + 1); + *(b + 4) = *(a3 + 0); + *(b + 5) = *(a3 + 1); + *(b + 6) = *(a4 + 0); + *(b + 7) = *(a4 + 1); + *(b + 8) = *(a5 + 0); + *(b + 9) = *(a5 + 1); + *(b + 10) = *(a6 + 0); + *(b + 11) = *(a6 + 1); + *(b + 12) = *(a7 + 0); + *(b + 13) = *(a7 + 1); + *(b + 14) = *(a8 + 0); + *(b + 15) = *(a8 + 1); + *(b + 16) = *(a9 + 0); + *(b + 17) = *(a9 + 1); + *(b + 18) = *(a10 + 0); + *(b + 19) = *(a10 + 1); + *(b + 20) = *(a11 + 0); + *(b + 21) = *(a11 + 1); + *(b + 22) = *(a12 + 0); + *(b + 23) = *(a12 + 1); + *(b + 24) = *(a13 + 0); + *(b + 25) = *(a13 + 1); + *(b + 26) = *(a14 + 0); + *(b + 27) = *(a14 + 1); + *(b + 28) = *(a15 + 0); + *(b + 29) = *(a15 + 1); + *(b + 30) = *(a16 + 0); + *(b + 31) = *(a16 + 1); + } + + a1 += 2; + a2 += 2; + a3 += 2; + a4 += 2; + a5 += 2; + a6 += 2; + a7 += 2; + a8 += 2; + a9 += 2; + a10 += 2; + a11 += 2; + a12 += 2; + a13 += 2; + a14 += 2; + a15 += 2; + a16 += 2; + b += 32; + ii ++; + } + + jj += 16; + j --; + } + + if (n & 8) { + a1 = a + 0 * lda; + a2 = a + 1 * lda; + a3 = a + 2 * lda; + a4 = a + 3 * lda; + a5 = a + 4 * lda; + a6 = a + 5 * lda; + a7 = a + 6 * lda; + a8 = a + 7 * lda; + + a += 8 * lda; + ii = 0; + + for (i = 0; i < m; i++) { + + if ((ii >= jj ) && (ii - jj < 8)) { + for (k = 0; k < ii - jj; k ++) { + *(b + k * 2 + 0) = *(a1 + k * lda + 0); + *(b + k * 2 + 1) = *(a1 + k * lda + 1); + } + data1 = *(a1 + (ii - jj) * lda + 0); + data2 = *(a1 + (ii - jj) * lda + 1); + + compinv(b + (ii - jj) * 2, data1, data2); + } + + if (ii - jj >= 8) { + *(b + 0) = *(a1 + 0); + *(b + 1) = *(a1 + 1); + *(b + 2) = *(a2 + 0); + *(b + 3) = *(a2 + 1); + *(b + 4) = *(a3 + 0); + *(b + 5) = *(a3 + 1); + *(b + 6) = *(a4 + 0); + *(b + 7) = *(a4 + 1); + *(b + 8) = *(a5 + 0); + *(b + 9) = *(a5 + 1); + *(b + 10) = *(a6 + 0); + *(b + 11) = *(a6 + 1); + *(b + 12) = *(a7 + 0); + *(b + 13) = *(a7 + 1); + *(b + 14) = *(a8 + 0); + *(b + 15) = *(a8 + 1); + } + + a1 += 2; + a2 += 2; + a3 += 2; + a4 += 2; + a5 += 2; + a6 += 2; + a7 += 2; + a8 += 2; + b += 16; + ii ++; + } + + jj += 8; + } + + if (n & 4) { + + a1 = a + 0 * lda; + a2 = a + 1 * lda; + a3 = a + 2 * lda; + a4 = a + 3 * lda; + a += 4 * lda; + ii = 0; + + for (i = 0; i < m; i++) { + + if ((ii >= jj ) && (ii - jj < 4)) { + for (k = 0; k < ii - jj; k ++) { + *(b + k * 2 + 0) = *(a1 + k * lda + 0); + *(b + k * 2 + 1) = *(a1 + k * lda + 1); + } + data1 = *(a1 + (ii - jj) * lda + 0); + data2 = *(a1 + (ii - jj) * lda + 1); + + compinv(b + (ii - jj) * 2, data1, data2); + } + + if (ii - jj >= 4) { + *(b + 0) = *(a1 + 0); + *(b + 1) = *(a1 + 1); + *(b + 2) = *(a2 + 0); + *(b + 3) = *(a2 + 1); + *(b + 4) = *(a3 + 0); + *(b + 5) = *(a3 + 1); + *(b + 6) = *(a4 + 0); + *(b + 7) = *(a4 + 1); + } + + a1 += 2; + a2 += 2; + a3 += 2; + a4 += 2; + b += 8; + ii ++; + } + + jj += 4; + } + + if (n & 2) { + + a1 = a + 0 * lda; + a2 = a + 1 * lda; + a += 2 * lda; + ii = 0; + + for (i = 0; i < m; i++) { + + if ((ii >= jj ) && (ii - jj < 2)) { + for (k = 0; k < ii - jj; k ++) { + *(b + k * 2 + 0) = *(a1 + k * lda + 0); + *(b + k * 2 + 1) = *(a1 + k * lda + 1); + } + data1 = *(a1 + (ii - jj) * lda + 0); + data2 = *(a1 + (ii - jj) * lda + 1); + + compinv(b + (ii - jj) * 2, data1, data2); + } + + if (ii - jj >= 2) { + *(b + 0) = *(a1 + 0); + *(b + 1) = *(a1 + 1); + *(b + 2) = *(a2 + 0); + *(b + 3) = *(a2 + 1); + } + + a1 += 2; + a2 += 2; + b += 4; + ii ++; + } + + jj += 2; + } + + if (n & 1) { + + a1 = a + 0 * lda; + ii = 0; + + for (i = 0; i < m; i++) { + + if ((ii >= jj ) && (ii - jj < 1)) { + for (k = 0; k < ii - jj; k ++) { + *(b + k * 2 + 0) = *(a1 + k * lda + 0); + *(b + k * 2 + 1) = *(a1 + k * lda + 1); + } + data1 = *(a1 + (ii - jj) * lda + 0); + data2 = *(a1 + (ii - jj) * lda + 1); + + compinv(b + (ii - jj) * 2, data1, data2); + } + + if (ii - jj >= 1) { + *(b + 0) = *(a1 + 0); + *(b + 1) = *(a1 + 1); + } + + a1 += 2; + b += 2; + ii ++; + } + } + + return 0; +} diff --git a/kernel/generic/ztrsm_ltcopy_16.c b/kernel/generic/ztrsm_ltcopy_16.c new file mode 100644 index 000000000..e9aeae1ad --- /dev/null +++ b/kernel/generic/ztrsm_ltcopy_16.c @@ -0,0 +1,264 @@ +/******************************************************************************* +Copyright (c) 2024, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 +#include "common.h" + +int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG offset, FLOAT *b){ + + BLASLONG i, ii, j, jj, k; + + FLOAT *a1; + FLOAT data1, data2; + + lda *= 2; + jj = offset; + + j = (n >> 4); + while (j > 0){ + + a1 = a; + a += 32; + ii = 0; + + for (i = 0; i < m; i++) { + + if ((ii >= jj ) && (ii - jj < 16)) { + + data1 = *(a1 + (ii - jj) * 2 + 0); + data2 = *(a1 + (ii - jj) * 2 + 1); + + compinv(b + (ii - jj) * 2, data1, data2); + + for (k = ii - jj + 1; k < 16; k ++) { + *(b + k * 2 + 0) = *(a1 + k * 2 + 0); + *(b + k * 2 + 1) = *(a1 + k * 2 + 1); + } + + } + + if (ii - jj < 0) { + *(b + 0) = *(a1 + 0); + *(b + 1) = *(a1 + 1); + *(b + 2) = *(a1 + 2); + *(b + 3) = *(a1 + 3); + *(b + 4) = *(a1 + 4); + *(b + 5) = *(a1 + 5); + *(b + 6) = *(a1 + 6); + *(b + 7) = *(a1 + 7); + *(b + 8) = *(a1 + 8); + *(b + 9) = *(a1 + 9); + *(b + 10) = *(a1 + 10); + *(b + 11) = *(a1 + 11); + *(b + 12) = *(a1 + 12); + *(b + 13) = *(a1 + 13); + *(b + 14) = *(a1 + 14); + *(b + 15) = *(a1 + 15); + *(b + 16) = *(a1 + 16); + *(b + 17) = *(a1 + 17); + *(b + 18) = *(a1 + 18); + *(b + 19) = *(a1 + 19); + *(b + 20) = *(a1 + 20); + *(b + 21) = *(a1 + 21); + *(b + 22) = *(a1 + 22); + *(b + 23) = *(a1 + 23); + *(b + 24) = *(a1 + 24); + *(b + 25) = *(a1 + 25); + *(b + 26) = *(a1 + 26); + *(b + 27) = *(a1 + 27); + *(b + 28) = *(a1 + 28); + *(b + 29) = *(a1 + 29); + *(b + 30) = *(a1 + 30); + *(b + 31) = *(a1 + 31); + } + + b += 32; + a1 += lda; + ii ++; + } + + jj += 16; + j --; + } + + j = (n & 8); + if (j > 0) { + a1 = a; + a += 16; + ii = 0; + + for (i = 0; i < m; i++) { + + if ((ii >= jj ) && (ii - jj < 8)) { + + data1 = *(a1 + (ii - jj) * 2 + 0); + data2 = *(a1 + (ii - jj) * 2 + 1); + + compinv(b + (ii - jj) * 2, data1, data2); + + for (k = ii - jj + 1; k < 8; k ++) { + *(b + k * 2 + 0) = *(a1 + k * 2 + 0); + *(b + k * 2 + 1) = *(a1 + k * 2 + 1); + } + + } + + if (ii - jj < 0) { + *(b + 0) = *(a1 + 0); + *(b + 1) = *(a1 + 1); + *(b + 2) = *(a1 + 2); + *(b + 3) = *(a1 + 3); + *(b + 4) = *(a1 + 4); + *(b + 5) = *(a1 + 5); + *(b + 6) = *(a1 + 6); + *(b + 7) = *(a1 + 7); + *(b + 8) = *(a1 + 8); + *(b + 9) = *(a1 + 9); + *(b + 10) = *(a1 + 10); + *(b + 11) = *(a1 + 11); + *(b + 12) = *(a1 + 12); + *(b + 13) = *(a1 + 13); + *(b + 14) = *(a1 + 14); + *(b + 15) = *(a1 + 15); + } + + b += 16; + a1 += lda; + ii ++; + } + + jj += 8; + } + + j = (n & 4); + if (j > 0) { + + a1 = a; + a += 8; + ii = 0; + + for (i = 0; i < m; i++) { + + if ((ii >= jj ) && (ii - jj < 4)) { + + data1 = *(a1 + (ii - jj) * 2 + 0); + data2 = *(a1 + (ii - jj) * 2 + 1); + + compinv(b + (ii - jj) * 2, data1, data2); + + for (k = ii - jj + 1; k < 4; k ++) { + *(b + k * 2 + 0) = *(a1 + k * 2 + 0); + *(b + k * 2 + 1) = *(a1 + k * 2 + 1); + } + + } + + if (ii - jj < 0) { + *(b + 0) = *(a1 + 0); + *(b + 1) = *(a1 + 1); + *(b + 2) = *(a1 + 2); + *(b + 3) = *(a1 + 3); + *(b + 4) = *(a1 + 4); + *(b + 5) = *(a1 + 5); + *(b + 6) = *(a1 + 6); + *(b + 7) = *(a1 + 7); + } + + b += 8; + a1 += lda; + ii ++; + } + + jj += 4; + } + + j = (n & 2); + if (j > 0) { + + a1 = a; + a += 4; + ii = 0; + + for (i = 0; i < m; i++) { + + if ((ii >= jj ) && (ii - jj < 2)) { + + data1 = *(a1 + (ii - jj) * 2 + 0); + data2 = *(a1 + (ii - jj) * 2 + 1); + + compinv(b + (ii - jj) * 2, data1, data2); + + for (k = ii - jj + 1; k < 2; k ++) { + *(b + k * 2 + 0) = *(a1 + k * 2 + 0); + *(b + k * 2 + 1) = *(a1 + k * 2 + 1); + } + + } + + if (ii - jj < 0) { + *(b + 0) = *(a1 + 0); + *(b + 1) = *(a1 + 1); + *(b + 2) = *(a1 + 2); + *(b + 3) = *(a1 + 3); + } + + b += 4; + a1 += lda; + ii ++; + } + + jj += 2; + } + + j = (n & 1); + if (j > 0) { + + a1 = a; + ii = 0; + + for (i = 0; i < m; i++) { + + if ((ii >= jj ) && (ii - jj < 1)) { + data1 = *(a1 + (ii - jj) * 2 + 0); + data2 = *(a1 + (ii - jj) * 2 + 1); + + compinv(b + (ii - jj) * 2, data1, data2); + } + + if (ii - jj < 0) { + *(b + 0) = *(a1 + 0); + *(b + 1) = *(a1 + 1); + } + + b += 2; + a1 += lda; + ii ++; + } + } + + return 0; +} diff --git a/kernel/generic/ztrsm_uncopy_16.c b/kernel/generic/ztrsm_uncopy_16.c new file mode 100644 index 000000000..e84d96891 --- /dev/null +++ b/kernel/generic/ztrsm_uncopy_16.c @@ -0,0 +1,313 @@ +/******************************************************************************* +Copyright (c) 2024, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 +#include "common.h" + +int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG offset, FLOAT *b){ + + BLASLONG i, ii, j, jj, k; + + FLOAT *a1, *a2, *a3, *a4, *a5, *a6, *a7, *a8; + FLOAT *a9, *a10, *a11, *a12, *a13, *a14, *a15, *a16; + + FLOAT data1, data2; + + lda *= 2; + jj = offset; + + j = (n >> 4); + while (j > 0){ + + a1 = a + 0 * lda; + a2 = a + 1 * lda; + a3 = a + 2 * lda; + a4 = a + 3 * lda; + a5 = a + 4 * lda; + a6 = a + 5 * lda; + a7 = a + 6 * lda; + a8 = a + 7 * lda; + a9 = a + 8 * lda; + a10 = a + 9 * lda; + a11 = a + 10 * lda; + a12 = a + 11 * lda; + a13 = a + 12 * lda; + a14 = a + 13 * lda; + a15 = a + 14 * lda; + a16 = a + 15 * lda; + + a += 16 * lda; + ii = 0; + + for (i = 0; i < m; i++) { + + if ((ii >= jj ) && (ii - jj < 16)) { + + data1 = *(a1 + (ii - jj) * lda + 0); + data2 = *(a1 + (ii - jj) * lda + 1); + + compinv(b + (ii - jj) * 2, data1, data2); + + for (k = ii - jj + 1; k < 16; k ++) { + *(b + k * 2 + 0) = *(a1 + k * lda + 0); + *(b + k * 2 + 1) = *(a1 + k * lda + 1); + } + } + + if (ii - jj < 0) { + *(b + 0) = *(a1 + 0); + *(b + 1) = *(a1 + 1); + *(b + 2) = *(a2 + 0); + *(b + 3) = *(a2 + 1); + *(b + 4) = *(a3 + 0); + *(b + 5) = *(a3 + 1); + *(b + 6) = *(a4 + 0); + *(b + 7) = *(a4 + 1); + *(b + 8) = *(a5 + 0); + *(b + 9) = *(a5 + 1); + *(b + 10) = *(a6 + 0); + *(b + 11) = *(a6 + 1); + *(b + 12) = *(a7 + 0); + *(b + 13) = *(a7 + 1); + *(b + 14) = *(a8 + 0); + *(b + 15) = *(a8 + 1); + *(b + 16) = *(a9 + 0); + *(b + 17) = *(a9 + 1); + *(b + 18) = *(a10 + 0); + *(b + 19) = *(a10 + 1); + *(b + 20) = *(a11 + 0); + *(b + 21) = *(a11 + 1); + *(b + 22) = *(a12 + 0); + *(b + 23) = *(a12 + 1); + *(b + 24) = *(a13 + 0); + *(b + 25) = *(a13 + 1); + *(b + 26) = *(a14 + 0); + *(b + 27) = *(a14 + 1); + *(b + 28) = *(a15 + 0); + *(b + 29) = *(a15 + 1); + *(b + 30) = *(a16 + 0); + *(b + 31) = *(a16 + 1); + } + + a1 += 2; + a2 += 2; + a3 += 2; + a4 += 2; + a5 += 2; + a6 += 2; + a7 += 2; + a8 += 2; + a9 += 2; + a10 += 2; + a11 += 2; + a12 += 2; + a13 += 2; + a14 += 2; + a15 += 2; + a16 += 2; + b += 32; + ii ++; + } + + jj += 16; + j --; + } + + if (n & 8) { + a1 = a + 0 * lda; + a2 = a + 1 * lda; + a3 = a + 2 * lda; + a4 = a + 3 * lda; + a5 = a + 4 * lda; + a6 = a + 5 * lda; + a7 = a + 6 * lda; + a8 = a + 7 * lda; + + a += 8 * lda; + ii = 0; + + for (i = 0; i < m; i++) { + + if ((ii >= jj ) && (ii - jj < 8)) { + + data1 = *(a1 + (ii - jj) * lda + 0); + data2 = *(a1 + (ii - jj) * lda + 1); + + compinv(b + (ii - jj) * 2, data1, data2); + + for (k = ii - jj + 1; k < 8; k ++) { + *(b + k * 2 + 0) = *(a1 + k * lda + 0); + *(b + k * 2 + 1) = *(a1 + k * lda + 1); + } + } + + if (ii - jj < 0) { + *(b + 0) = *(a1 + 0); + *(b + 1) = *(a1 + 1); + *(b + 2) = *(a2 + 0); + *(b + 3) = *(a2 + 1); + *(b + 4) = *(a3 + 0); + *(b + 5) = *(a3 + 1); + *(b + 6) = *(a4 + 0); + *(b + 7) = *(a4 + 1); + *(b + 8) = *(a5 + 0); + *(b + 9) = *(a5 + 1); + *(b + 10) = *(a6 + 0); + *(b + 11) = *(a6 + 1); + *(b + 12) = *(a7 + 0); + *(b + 13) = *(a7 + 1); + *(b + 14) = *(a8 + 0); + *(b + 15) = *(a8 + 1); + } + + a1 += 2; + a2 += 2; + a3 += 2; + a4 += 2; + a5 += 2; + a6 += 2; + a7 += 2; + a8 += 2; + b += 16; + ii ++; + } + + jj += 8; + } + + if (n & 4) { + + a1 = a + 0 * lda; + a2 = a + 1 * lda; + a3 = a + 2 * lda; + a4 = a + 3 * lda; + a += 4 * lda; + ii = 0; + + for (i = 0; i < m; i++) { + + if ((ii >= jj ) && (ii - jj < 4)) { + data1 = *(a1 + (ii - jj) * lda + 0); + data2 = *(a1 + (ii - jj) * lda + 1); + + compinv(b + (ii - jj) * 2, data1, data2); + + for (k = ii - jj + 1; k < 4; k ++) { + *(b + k * 2 + 0) = *(a1 + k * lda + 0); + *(b + k * 2 + 1) = *(a1 + k * lda + 1); + } + } + + if (ii - jj < 0) { + *(b + 0) = *(a1 + 0); + *(b + 1) = *(a1 + 1); + *(b + 2) = *(a2 + 0); + *(b + 3) = *(a2 + 1); + *(b + 4) = *(a3 + 0); + *(b + 5) = *(a3 + 1); + *(b + 6) = *(a4 + 0); + *(b + 7) = *(a4 + 1); + } + + a1 += 2; + a2 += 2; + a3 += 2; + a4 += 2; + b += 8; + ii ++; + } + + jj += 4; + } + + if (n & 2) { + + a1 = a + 0 * lda; + a2 = a + 1 * lda; + a += 2 * lda; + ii = 0; + + for (i = 0; i < m; i++) { + + if ((ii >= jj ) && (ii - jj < 2)) { + data1 = *(a1 + (ii - jj) * lda + 0); + data2 = *(a1 + (ii - jj) * lda + 1); + + compinv(b + (ii - jj) * 2, data1, data2); + for (k = ii - jj + 1; k < 2; k ++) { + *(b + k * 2 + 0) = *(a1 + k * lda + 0); + *(b + k * 2 + 1) = *(a1 + k * lda + 1); + } + } + + if (ii - jj < 0) { + *(b + 0) = *(a1 + 0); + *(b + 1) = *(a1 + 1); + *(b + 2) = *(a2 + 0); + *(b + 3) = *(a2 + 1); + } + + a1 += 2; + a2 += 2; + b += 4; + ii ++; + } + + jj += 2; + } + + if (n & 1) { + + a1 = a + 0 * lda; + ii = 0; + + for (i = 0; i < m; i++) { + + if ((ii >= jj ) && (ii - jj < 1)) { + data1 = *(a1 + (ii - jj) * lda + 0); + data2 = *(a1 + (ii - jj) * lda + 1); + + compinv(b + (ii - jj) * 2, data1, data2); + for (k = ii - jj + 1; k < 1; k ++) { + *(b + k * 2 + 0) = *(a1 + k * lda + 0); + *(b + k * 2 + 1) = *(a1 + k * lda + 1); + } + } + + if (ii - jj < 0) { + *(b + 0) = *(a1 + 0); + *(b + 1) = *(a1 + 1); + } + + a1 += 2; + b += 2; + ii ++; + } + } + + return 0; +} diff --git a/kernel/generic/ztrsm_utcopy_16.c b/kernel/generic/ztrsm_utcopy_16.c new file mode 100644 index 000000000..efcea5c3f --- /dev/null +++ b/kernel/generic/ztrsm_utcopy_16.c @@ -0,0 +1,261 @@ +/******************************************************************************* +Copyright (c) 2024, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 +#include "common.h" + +int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG offset, FLOAT *b){ + + BLASLONG i, ii, j, jj, k; + + FLOAT *a1, data1, data2; + + lda *= 2; + + jj = offset; + + j = (n >> 4); + while (j > 0){ + + a1 = a; + a += 32; + ii = 0; + + for (i = 0; i < m; i++) { + + if ((ii >= jj ) && (ii - jj < 16)) { + for (k = 0; k < ii - jj; k ++) { + *(b + k * 2 + 0) = *(a1 + k * 2 + 0); + *(b + k * 2 + 1) = *(a1 + k * 2 + 1); + } + + data1 = *(a1 + (ii - jj) * 2 + 0); + data2 = *(a1 + (ii - jj) * 2 + 1); + + compinv(b + (ii - jj) * 2, data1, data2); + } + + if (ii - jj >= 16) { + *(b + 0) = *(a1 + 0); + *(b + 1) = *(a1 + 1); + *(b + 2) = *(a1 + 2); + *(b + 3) = *(a1 + 3); + *(b + 4) = *(a1 + 4); + *(b + 5) = *(a1 + 5); + *(b + 6) = *(a1 + 6); + *(b + 7) = *(a1 + 7); + *(b + 8) = *(a1 + 8); + *(b + 9) = *(a1 + 9); + *(b + 10) = *(a1 + 10); + *(b + 11) = *(a1 + 11); + *(b + 12) = *(a1 + 12); + *(b + 13) = *(a1 + 13); + *(b + 14) = *(a1 + 14); + *(b + 15) = *(a1 + 15); + *(b + 16) = *(a1 + 16); + *(b + 17) = *(a1 + 17); + *(b + 18) = *(a1 + 18); + *(b + 19) = *(a1 + 19); + *(b + 20) = *(a1 + 20); + *(b + 21) = *(a1 + 21); + *(b + 22) = *(a1 + 22); + *(b + 23) = *(a1 + 23); + *(b + 24) = *(a1 + 24); + *(b + 25) = *(a1 + 25); + *(b + 26) = *(a1 + 26); + *(b + 27) = *(a1 + 27); + *(b + 28) = *(a1 + 28); + *(b + 29) = *(a1 + 29); + *(b + 30) = *(a1 + 30); + *(b + 31) = *(a1 + 31); + } + + b += 32; + a1 += lda; + ii ++; + } + + jj += 16; + j --; + } + + j = (n & 8); + if (j > 0) { + a1 = a; + a += 16; + ii = 0; + + for (i = 0; i < m; i++) { + + if ((ii >= jj ) && (ii - jj < 8)) { + for (k = 0; k < ii - jj; k ++) { + *(b + k * 2 + 0) = *(a1 + k * 2 + 0); + *(b + k * 2 + 1) = *(a1 + k * 2 + 1); + } + + data1 = *(a1 + (ii - jj) * 2 + 0); + data2 = *(a1 + (ii - jj) * 2 + 1); + + compinv(b + (ii - jj) * 2, data1, data2); + } + + if (ii - jj >= 8) { + *(b + 0) = *(a1 + 0); + *(b + 1) = *(a1 + 1); + *(b + 2) = *(a1 + 2); + *(b + 3) = *(a1 + 3); + *(b + 4) = *(a1 + 4); + *(b + 5) = *(a1 + 5); + *(b + 6) = *(a1 + 6); + *(b + 7) = *(a1 + 7); + *(b + 8) = *(a1 + 8); + *(b + 9) = *(a1 + 9); + *(b + 10) = *(a1 + 10); + *(b + 11) = *(a1 + 11); + *(b + 12) = *(a1 + 12); + *(b + 13) = *(a1 + 13); + *(b + 14) = *(a1 + 14); + *(b + 15) = *(a1 + 15); + } + + b += 16; + a1 += lda; + ii ++; + } + + jj += 8; + } + + j = (n & 4); + if (j > 0) { + + a1 = a; + a += 8; + ii = 0; + + for (i = 0; i < m; i++) { + + if ((ii >= jj ) && (ii - jj < 4)) { + for (k = 0; k < ii - jj; k ++) { + *(b + k * 2 + 0) = *(a1 + k * 2 + 0); + *(b + k * 2 + 1) = *(a1 + k * 2 + 1); + } + + data1 = *(a1 + (ii - jj) * 2 + 0); + data2 = *(a1 + (ii - jj) * 2 + 1); + + compinv(b + (ii - jj) * 2, data1, data2); + } + + if (ii - jj >= 4) { + *(b + 0) = *(a1 + 0); + *(b + 1) = *(a1 + 1); + *(b + 2) = *(a1 + 2); + *(b + 3) = *(a1 + 3); + *(b + 4) = *(a1 + 4); + *(b + 5) = *(a1 + 5); + *(b + 6) = *(a1 + 6); + *(b + 7) = *(a1 + 7); + } + + b += 8; + a1 += lda; + ii ++; + } + + jj += 4; + } + + j = (n & 2); + if (j > 0) { + + a1 = a; + a += 4; + ii = 0; + + for (i = 0; i < m; i++) { + + if ((ii >= jj ) && (ii - jj < 2)) { + for (k = 0; k < ii - jj; k ++) { + *(b + k * 2 + 0) = *(a1 + k * 2 + 0); + *(b + k * 2 + 1) = *(a1 + k * 2 + 1); + } + + data1 = *(a1 + (ii - jj) * 2 + 0); + data2 = *(a1 + (ii - jj) * 2 + 1); + + compinv(b + (ii - jj) * 2, data1, data2); + } + + if (ii - jj >= 2) { + *(b + 0) = *(a1 + 0); + *(b + 1) = *(a1 + 1); + *(b + 2) = *(a1 + 2); + *(b + 3) = *(a1 + 3); + } + + b += 4; + a1 += lda; + ii ++; + } + + jj += 2; + } + + j = (n & 1); + if (j > 0) { + + a1 = a; + ii = 0; + + for (i = 0; i < m; i++) { + + if ((ii >= jj ) && (ii - jj < 1)) { + for (k = 0; k < ii - jj; k ++) { + *(b + k * 2 + 0) = *(a1 + k * 2 + 0); + *(b + k * 2 + 1) = *(a1 + k * 2 + 1); + } + + data1 = *(a1 + (ii - jj) * 2 + 0); + data2 = *(a1 + (ii - jj) * 2 + 1); + + compinv(b + (ii - jj) * 2, data1, data2); + } + + if (ii - jj >= 1) { + *(b + 0) = *(a1 + 0); + *(b + 1) = *(a1 + 1); + } + + b += 2; + a1 += lda; + ii ++; + } + } + + return 0; +} diff --git a/kernel/loongarch64/KERNEL.LOONGSON3R5 b/kernel/loongarch64/KERNEL.LOONGSON3R5 index 17d15656a..ce9268b93 100644 --- a/kernel/loongarch64/KERNEL.LOONGSON3R5 +++ b/kernel/loongarch64/KERNEL.LOONGSON3R5 @@ -111,9 +111,13 @@ SGEMMOTCOPYOBJ = sgemm_otcopy$(TSUFFIX).$(SUFFIX) SGEMVNKERNEL = sgemv_n_8_lasx.S SGEMVTKERNEL = sgemv_t_8_lasx.S -CGEMMKERNEL = cgemm_kernel_2x2_lsx.S -CGEMMONCOPY = cgemm_ncopy_2_lsx.S -CGEMMOTCOPY = cgemm_tcopy_2_lsx.S +CGEMMKERNEL = cgemm_kernel_16x4_lasx.S +CGEMMINCOPY = cgemm_ncopy_16_lasx.S +CGEMMITCOPY = cgemm_tcopy_16_lasx.S +CGEMMONCOPY = cgemm_ncopy_4_lasx.S +CGEMMOTCOPY = cgemm_tcopy_4_lasx.S +CGEMMINCOPYOBJ = cgemm_incopy$(TSUFFIX).$(SUFFIX) +CGEMMITCOPYOBJ = cgemm_itcopy$(TSUFFIX).$(SUFFIX) CGEMMONCOPYOBJ = cgemm_oncopy$(TSUFFIX).$(SUFFIX) CGEMMOTCOPYOBJ = cgemm_otcopy$(TSUFFIX).$(SUFFIX) diff --git a/kernel/loongarch64/cgemm_kernel_16x4_lasx.S b/kernel/loongarch64/cgemm_kernel_16x4_lasx.S new file mode 100644 index 000000000..249abe102 --- /dev/null +++ b/kernel/loongarch64/cgemm_kernel_16x4_lasx.S @@ -0,0 +1,3757 @@ +/******************************************************************************* +Copyright (c) 2024, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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. +*******************************************************************************/ +#define ASSEMBLER + +#include "common.h" + + +/* Function parameters */ +#define M $r4 // param 1: bm +#define N $r5 // param 2: bn +#define K $r6 // param 3: bk +#define ALPHA_R $f0 // param 4: alphar +#define ALPHA_I $f1 // param 5: alphai +#define A $r7 // param 6: ba +#define B $r8 // param 7: bb +#define C $r9 // param 8: bc +#define LDC $r10 // param 9: ldc + +#if defined (TRMMKERNEL) +#define OFFSET $r11 // param 10: offset +#endif +#define OFF $r26 + +#define I $r12 +#define J $r13 +#define L $r14 +#define TL $r15 +#define A0 $r16 +#define B0 $r17 +#define C0 $r18 +#define C1 $r19 +#define C2 $r20 +#define C3 $r23 +#define T0 $r24 +#define T1 $r25 +#define T2 $r26 +#define T3 $r27 + +#define a1 $f2 +#define a2 $f3 +#define a3 $f4 +#define a4 $f5 +#define a5 $f6 +#define a6 $f7 +#define a7 $f8 +#define a8 $f9 +#define b1 $f10 +#define b2 $f11 +#define b3 $f12 +#define b4 $f13 +#define b5 $f14 +#define b6 $f15 +#define b7 $f16 +#define b8 $f17 +#define c11 $f18 +#define c12 $f19 +#define c21 $f20 +#define c22 $f21 +#define c31 $f22 +#define c32 $f23 +#define c41 $f24 +#define c42 $f25 + +/* LASX vectors */ +#define U0 $xr30 +#define U1 $xr31 +#define U2 $xr2 +#define U3 $xr3 +#define U4 $xr4 +#define U5 $xr5 +#define U6 $xr6 +#define U7 $xr7 +#define U8 $xr8 +#define U9 $xr9 +#define U10 $xr10 +#define U11 $xr11 +#define U12 $xr12 +#define U13 $xr13 +#define U14 $xr14 +#define U15 $xr15 +#define D0 $xr16 +#define D1 $xr17 +#define D2 $xr18 +#define D3 $xr19 +#define D4 $xr20 +#define D5 $xr21 +#define D6 $xr22 +#define D7 $xr23 +#define D8 $xr24 +#define D9 $xr25 +#define D10 $xr26 +#define D11 $xr27 +#define D12 $xr28 +#define D13 $xr29 +#define VALPHAR $xr28 +#define VALPHAI $xr29 + + +#if defined(NN) || defined(NT) || defined(TN) || defined(TT) +#define XVMADD1 XVFMADD +#define XVMADD2 XVFMADD +#define XVMADD3 XVNMSUB +#define XVMADD4 XVFMADD + +#define VMADD1 VFMADD +#define VMADD2 VFMADD +#define VMADD3 VNMSUB +#define VMADD4 VFMADD + +#define MADD1 MADD +#define MADD2 MADD +#define MADD3 NMSUB +#define MADD4 MADD +#endif + +#if defined(NR) || defined(NC) || defined(TR) || defined(TC) +#define XVMADD1 XVFMADD +#define XVMADD2 XVFMADD +#define XVMADD3 XVFMADD +#define XVMADD4 XVNMSUB + +#define VMADD1 VFMADD +#define VMADD2 VFMADD +#define VMADD3 VFMADD +#define VMADD4 VNMSUB + +#define MADD1 MADD +#define MADD2 MADD +#define MADD3 MADD +#define MADD4 NMSUB +#endif + +#if defined(RN) || defined(RT) || defined(CN) || defined(CT) +#define XVMADD1 XVFMADD +#define XVMADD2 XVNMSUB +#define XVMADD3 XVFMADD +#define XVMADD4 XVFMADD + +#define VMADD1 VFMADD +#define VMADD2 VNMSUB +#define VMADD3 VFMADD +#define VMADD4 VFMADD + +#define MADD1 MADD +#define MADD2 NMSUB +#define MADD3 MADD +#define MADD4 MADD +#endif + +#if defined(RR) || defined(RC) || defined(CR) || defined(CC) +#define XVMADD1 XVFMADD +#define XVMADD2 XVNMSUB +#define XVMADD3 XVNMSUB +#define XVMADD4 XVNMSUB + +#define VMADD1 VFMADD +#define VMADD2 VNMSUB +#define VMADD3 VNMSUB +#define VMADD4 VNMSUB + +#define MADD1 MADD +#define MADD2 NMSUB +#define MADD3 NMSUB +#define MADD4 NMSUB +#endif + + PROLOGUE + + addi.d $sp, $sp, -128 + SDARG $r23, $sp, 0 + SDARG $r24, $sp, 8 + SDARG $r25, $sp, 16 + SDARG $r26, $sp, 24 + SDARG $r27, $sp, 32 + ST $f23, $sp, 40 + ST $f24, $sp, 48 + ST $f25, $sp, 56 + ST $f26, $sp, 64 + ST $f27, $sp, 72 + ST $f28, $sp, 80 + ST $f29, $sp, 88 + ST $f30, $sp, 96 + ST $f31, $sp, 104 + ST ALPHA_R,$sp, 112 + ST ALPHA_I,$sp, 120 + + xvldrepl.w VALPHAR, $sp, 112 + xvldrepl.w VALPHAI, $sp, 120 + +#if defined (TRMMKERNEL) && !defined(LEFT) + sub.d OFF, $r0, OFFSET +#else + xor OFF, OFF, OFF +#endif + + slli.d LDC, LDC, 2 + + move J, $r0 + srai.d T0, N, 2 //bn/4 + beq J, T0, .L19 + +.L10: /* for(j=0; j0) */ + xvld U0, S1, 0x00 //1 2 3 4 5 6 7 8 + xvld U1, S2, 0x00 //9 10 11 12 13 14 15 16 + + xvand.v D0, U0, U0 + xvand.v D1, U1, U1 + + xvshuf4i.d D0, U1, 0x88 //1 2 9 10 5 6 13 14 + xvshuf4i.d D1, U0, 0x77 //3 4 11 12 7 8 15 16 + + xvand.v U4, D0, D0 + + xvpermi.q U4, D1, 0x02 //1 2 9 10 3 4 11 12 + xvpermi.q D1, D0, 0x31 //5 6 13 14 7 8 15 16 + + xvst U4, TD, 0x00 + xvst D1, TD, 0x20 + + addi.d S1, S1, 0x20 // a_offset + addi.d S2, S2, 0x20 + addi.d TD, TD, 0x40 // b_offset + + addi.d I, I, -1 + blt ZERO, I, .L_N11 + +.L_N10: /* if(m&2) */ + andi I, M, 0x02 + beq I, ZERO, .L_N130 + + vld $vr0, S1, 0x00 + vld $vr1, S2, 0x00 + vand.v $vr8, $vr1, $vr1 + + vpermi.w $vr8, $vr0, 0x44 + vpermi.w $vr1, $vr0, 0xee + + vst $vr8, TD, 0x00 + vst $vr1, TD, 0x10 + + addi.d S1, S1, 0x10 // a_offset + addi.d S2, S2, 0x10 + addi.d TD, TD, 0x20 // b_offset + +.L_N130: /* if(m&1) */ + andi I, M, 0x01 + beq I, ZERO, .L_N20 + + fld.s F0, S1, 0x00 + fld.s F1, S1, 0x04 + + fld.s F2, S2, 0x00 + fld.s F3, S2, 0x04 + + fst.s F0, TD, 0x00 + fst.s F1, TD, 0x04 + fst.s F2, TD, 0x08 + fst.s F3, TD, 0x0c + + addi.d TD, TD, 0x10 + +.L_N20: /* if(n&1) */ + andi I, N, 0x01 + beq I, ZERO, .L_N00 + + move S1, TS + srai.d I, M, 0x02 + + beq I, ZERO, .L_N30 + +.L_N21: /* if(i>0) */ + xvld U0, S1, 0x00 + + xvst U0, TD, 0x00 + + addi.d S1, S1, 0x20 // aoffset1 + addi.d TD, TD, 0x20 // b_offset + + addi.d I, I, -1 + blt ZERO, I, .L_N21 + +.L_N30: /* if(m&2) */ + andi I, M, 0x02 + beq I, ZERO, .L_N330 + + vld $vr0, S1, 0x00 + + vst $vr0, TD, 0x00 + + addi.d S1, S1, 0x10 // aoffset1 + addi.d TD, TD, 0x10 // b_offset + +.L_N330: /* if(m&1) */ + andi I, M, 0x01 + beq I, ZERO, .L_N00 + + fld.s F0, S1, 0x00 + fld.s F1, S1, 0x04 + + fst.s F0, TD, 0x00 + fst.s F1, TD, 0x04 + +.L_N00: + LDARG $r23, $sp, 0 + addi.d $sp, $sp, 8 + jirl $r0, $r1, 0x00 + + EPILOGUE \ No newline at end of file diff --git a/kernel/loongarch64/cgemm_tcopy_16_lasx.S b/kernel/loongarch64/cgemm_tcopy_16_lasx.S new file mode 100644 index 000000000..7d9eb94c8 --- /dev/null +++ b/kernel/loongarch64/cgemm_tcopy_16_lasx.S @@ -0,0 +1,741 @@ +/******************************************************************************* +Copyright (c) 2024, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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. +*******************************************************************************/ +#define ASSEMBLER + +#include "common.h" +/* Function parameters */ +#define M $r4 // param 1: m +#define N $r5 // param 2: n +#define SRC $r6 // param 3: src +#define LDA $r7 // param 4: lda +#define DST $r8 // param 5: dst + +#define I $r9 +#define J $r10 +#define S0 $r11 +#define S1 $r12 +#define S2 $r13 +#define S3 $r14 +#define S4 $r15 +#define S5 $r16 +#define S6 $r17 +#define S7 $r18 +#define S8 $r19 +#define P0 $r20 +#define P1 $r23 +#define P2 $r24 +#define P3 $r25 +#define P4 $r26 +#define P5 $r27 +#define T0 $r28 +#define T1 $r29 +#define TL $r7 +#define ZERO $r0 + +#define F0 $f0 +#define F1 $f1 +#define F2 $f2 +#define F3 $f3 +#define F4 $f4 +#define F5 $f5 +#define F6 $f6 +#define F7 $f7 +#define F8 $f8 +#define F9 $f9 +#define F10 $f10 +#define F11 $f11 +#define F12 $f12 +#define F13 $f13 +#define F14 $f14 +#define F15 $f15 +/* LASX vectors */ +#define U0 $xr0 +#define U1 $xr1 +#define U2 $xr2 +#define U3 $xr3 +#define U4 $xr4 +#define U5 $xr5 +#define U6 $xr6 +#define U7 $xr7 + + PROLOGUE + + addi.d $sp, $sp, -56 + SDARG $r23, $sp, 0 + SDARG $r24, $sp, 8 + SDARG $r25, $sp, 16 + SDARG $r26, $sp, 24 + SDARG $r27, $sp, 32 + SDARG $r28, $sp, 40 + SDARG $r29, $sp, 48 + + move S0, SRC + move P0, DST + + srai.d T0, N, 0x04 + srai.d T1, N, 0x03 + slli.d T0, T0, 0x04 + slli.d T1, T1, 0x03 + mul.d P2, M, T0 + mul.d P3, M, T1 + slli.d P2, P2, 0x03 + slli.d P3, P3, 0x03 + add.d P2, DST, P2 + add.d P3, DST, P3 + + srai.d T0, N, 0x02 + srai.d T1, N, 0x01 + slli.d T0, T0, 0x02 + slli.d T1, T1, 0x01 + mul.d P4, M, T0 + mul.d P5, M, T1 + slli.d P4, P4, 0x03 + slli.d P5, P5, 0x03 + add.d P4, DST, P4 + add.d P5, DST, P5 + + slli.d TL, LDA, 0x03 + srai.d J, M, 0x03 + slli.d T0, TL, 0x01 + slli.d T1, M, 0x07 + beq ZERO, J, .L_M7 + +.L_J1: /* J-- */ + move S1, S0 + add.d S2, S0, TL + add.d S3, S1, T0 + add.d S4, S2, T0 + add.d S5, S3, T0 + add.d S6, S4, T0 + add.d S7, S5, T0 + add.d S8, S6, T0 + add.d S0, S7, T0 + + move P1, P0 + addi.d P0, P0, 0x400 + + srai.d I, N, 0x04 + addi.d J, J, -1 + beq ZERO, I, .L_N15 + +.L_I1: /* I-- */ + xvld U0, S1, 0x00 + xvld U1, S1, 0x20 + xvld U2, S1, 0x40 + xvld U3, S1, 0x60 + xvld U4, S2, 0x00 + xvld U5, S2, 0x20 + xvld U6, S2, 0x40 + xvld U7, S2, 0x60 + + xvst U0, P1, 0x00 + xvst U1, P1, 0x20 + xvst U2, P1, 0x40 + xvst U3, P1, 0x60 + xvst U4, P1, 0x80 + xvst U5, P1, 0xA0 + xvst U6, P1, 0xC0 + xvst U7, P1, 0xE0 + + xvld U0, S3, 0x00 + xvld U1, S3, 0x20 + xvld U2, S3, 0x40 + xvld U3, S3, 0x60 + xvld U4, S4, 0x00 + xvld U5, S4, 0x20 + xvld U6, S4, 0x40 + xvld U7, S4, 0x60 + + xvst U0, P1, 0x100 + xvst U1, P1, 0x120 + xvst U2, P1, 0x140 + xvst U3, P1, 0x160 + xvst U4, P1, 0x180 + xvst U5, P1, 0x1A0 + xvst U6, P1, 0x1C0 + xvst U7, P1, 0x1E0 + + xvld U0, S5, 0x00 + xvld U1, S5, 0x20 + xvld U2, S5, 0x40 + xvld U3, S5, 0x60 + xvld U4, S6, 0x00 + xvld U5, S6, 0x20 + xvld U6, S6, 0x40 + xvld U7, S6, 0x60 + + xvst U0, P1, 0x200 + xvst U1, P1, 0x220 + xvst U2, P1, 0x240 + xvst U3, P1, 0x260 + xvst U4, P1, 0x280 + xvst U5, P1, 0x2A0 + xvst U6, P1, 0x2C0 + xvst U7, P1, 0x2E0 + + xvld U0, S7, 0x00 + xvld U1, S7, 0x20 + xvld U2, S7, 0x40 + xvld U3, S7, 0x60 + xvld U4, S8, 0x00 + xvld U5, S8, 0x20 + xvld U6, S8, 0x40 + xvld U7, S8, 0x60 + + xvst U0, P1, 0x300 + xvst U1, P1, 0x320 + xvst U2, P1, 0x340 + xvst U3, P1, 0x360 + xvst U4, P1, 0x380 + xvst U5, P1, 0x3A0 + xvst U6, P1, 0x3C0 + xvst U7, P1, 0x3E0 + + addi.d S1, S1, 0x80 + addi.d S2, S2, 0x80 + addi.d S3, S3, 0x80 + addi.d S4, S4, 0x80 + addi.d S5, S5, 0x80 + addi.d S6, S6, 0x80 + addi.d S7, S7, 0x80 + addi.d S8, S8, 0x80 + addi.d I, I, -1 + add.d P1, P1, T1 + blt ZERO, I, .L_I1 + +.L_N15: + andi I, N, 0x08 + beq ZERO, I, .L_N7 + + xvld U0, S1, 0x00 + xvld U1, S1, 0x20 + xvld U2, S2, 0x00 + xvld U3, S2, 0x20 + xvld U4, S3, 0x00 + xvld U5, S3, 0x20 + xvld U6, S4, 0x00 + xvld U7, S4, 0x20 + + xvst U0, P2, 0x00 + xvst U1, P2, 0x20 + xvst U2, P2, 0x40 + xvst U3, P2, 0x60 + xvst U4, P2, 0x80 + xvst U5, P2, 0xA0 + xvst U6, P2, 0xC0 + xvst U7, P2, 0xE0 + + xvld U0, S5, 0x00 + xvld U1, S5, 0x20 + xvld U2, S6, 0x00 + xvld U3, S6, 0x20 + xvld U4, S7, 0x00 + xvld U5, S7, 0x20 + xvld U6, S8, 0x00 + xvld U7, S8, 0x20 + + xvst U0, P2, 0x100 + xvst U1, P2, 0x120 + xvst U2, P2, 0x140 + xvst U3, P2, 0x160 + xvst U4, P2, 0x180 + xvst U5, P2, 0x1A0 + xvst U6, P2, 0x1C0 + xvst U7, P2, 0x1E0 + + addi.d S1, S1, 0x40 + addi.d S2, S2, 0x40 + addi.d S3, S3, 0x40 + addi.d S4, S4, 0x40 + addi.d S5, S5, 0x40 + addi.d S6, S6, 0x40 + addi.d S7, S7, 0x40 + addi.d S8, S8, 0x40 + addi.d P2, P2, 0x200 + +.L_N7: + andi I, N, 0x04 + beq ZERO, I, .L_N3 + + xvld U0, S1, 0x00 + xvld U1, S2, 0x00 + xvld U2, S3, 0x00 + xvld U3, S4, 0x00 + xvld U4, S5, 0x00 + xvld U5, S6, 0x00 + xvld U6, S7, 0x00 + xvld U7, S8, 0x00 + + xvst U0, P3, 0x00 + xvst U1, P3, 0x20 + xvst U2, P3, 0x40 + xvst U3, P3, 0x60 + xvst U4, P3, 0x80 + xvst U5, P3, 0xA0 + xvst U6, P3, 0xC0 + xvst U7, P3, 0xE0 + + addi.d S1, S1, 0x20 + addi.d S2, S2, 0x20 + addi.d S3, S3, 0x20 + addi.d S4, S4, 0x20 + addi.d S5, S5, 0x20 + addi.d S6, S6, 0x20 + addi.d S7, S7, 0x20 + addi.d S8, S8, 0x20 + addi.d P3, P3, 0x100 + +.L_N3: + andi I, N, 0x02 + beq ZERO, I, .L_N1 + + xvld U0, S1, 0x00 + xvld U1, S2, 0x00 + xvld U2, S3, 0x00 + xvld U3, S4, 0x00 + xvld U4, S5, 0x00 + xvld U5, S6, 0x00 + xvld U6, S7, 0x00 + xvld U7, S8, 0x00 + + xvpermi.q U0, U1, 0x02 + xvpermi.q U2, U3, 0x02 + xvpermi.q U4, U5, 0x02 + xvpermi.q U6, U7, 0x02 + + xvst U0, P4, 0x00 + xvst U2, P4, 0x20 + xvst U4, P4, 0x40 + xvst U6, P4, 0x60 + + addi.d S1, S1, 0x10 + addi.d S2, S2, 0x10 + addi.d S3, S3, 0x10 + addi.d S4, S4, 0x10 + addi.d S5, S5, 0x10 + addi.d S6, S6, 0x10 + addi.d S7, S7, 0x10 + addi.d S8, S8, 0x10 + addi.d P4, P4, 0x80 + +.L_N1: + andi I, N, 0x01 + beq ZERO, I, .L_N0 + + fld.s F0, S1, 0x00 + fld.s F1, S1, 0x04 + + fld.s F2, S2, 0x00 + fld.s F3, S2, 0x04 + + fld.s F4, S3, 0x00 + fld.s F5, S3, 0x04 + + fld.s F6, S4, 0x00 + fld.s F7, S4, 0x04 + + fld.s F8, S5, 0x00 + fld.s F9, S5, 0x04 + + fld.s F10, S6, 0x00 + fld.s F11, S6, 0x04 + + fld.s F12, S7, 0x00 + fld.s F13, S7, 0x04 + + fld.s F14, S8, 0x00 + fld.s F15, S8, 0x04 + + fst.s F0, P5, 0x00 + fst.s F1, P5, 0x04 + fst.s F2, P5, 0x08 + fst.s F3, P5, 0x0c + fst.s F4, P5, 0x10 + fst.s F5, P5, 0x14 + fst.s F6, P5, 0x18 + fst.s F7, P5, 0x1c + fst.s F8, P5, 0x20 + fst.s F9, P5, 0x24 + fst.s F10, P5, 0x28 + fst.s F11, P5, 0x2c + fst.s F12, P5, 0x30 + fst.s F13, P5, 0x34 + fst.s F14, P5, 0x38 + fst.s F15, P5, 0x3c + + addi.d S1, S1, 0x08 + addi.d S2, S2, 0x08 + addi.d S3, S3, 0x08 + addi.d S4, S4, 0x08 + addi.d S5, S5, 0x08 + addi.d S6, S6, 0x08 + addi.d S7, S7, 0x08 + addi.d S8, S8, 0x08 + addi.d P5, P5, 0x40 + +.L_N0: + blt ZERO, J, .L_J1 + +.L_M7: + andi J, M, 0x04 + beq ZERO, J, .L_M3 + + move S1, S0 + add.d S2, S0, TL + add.d S3, S1, T0 + add.d S4, S2, T0 + add.d S0, S3, T0 + + move P1, P0 + addi.d P0, P0, 0x200 + + srai.d I, N, 0x04 + beq ZERO, I, .L_4N15 + +.L_4I1: /* I-- */ + xvld U0, S1, 0x00 + xvld U1, S1, 0x20 + xvld U2, S1, 0x40 + xvld U3, S1, 0x60 + xvld U4, S2, 0x00 + xvld U5, S2, 0x20 + xvld U6, S2, 0x40 + xvld U7, S2, 0x60 + + xvst U0, P1, 0x00 + xvst U1, P1, 0x20 + xvst U2, P1, 0x40 + xvst U3, P1, 0x60 + xvst U4, P1, 0x80 + xvst U5, P1, 0xA0 + xvst U6, P1, 0xC0 + xvst U7, P1, 0xE0 + + xvld U0, S3, 0x00 + xvld U1, S3, 0x20 + xvld U2, S3, 0x40 + xvld U3, S3, 0x60 + xvld U4, S4, 0x00 + xvld U5, S4, 0x20 + xvld U6, S4, 0x40 + xvld U7, S4, 0x60 + + xvst U0, P1, 0x100 + xvst U1, P1, 0x120 + xvst U2, P1, 0x140 + xvst U3, P1, 0x160 + xvst U4, P1, 0x180 + xvst U5, P1, 0x1A0 + xvst U6, P1, 0x1C0 + xvst U7, P1, 0x1E0 + + addi.d S1, S1, 0x80 + addi.d S2, S2, 0x80 + addi.d S3, S3, 0x80 + addi.d S4, S4, 0x80 + addi.d I, I, -1 + add.d P1, P1, T1 + blt ZERO, I, .L_4I1 + +.L_4N15: + andi I, N, 0x08 + beq ZERO, I, .L_4N7 + + xvld U0, S1, 0x00 + xvld U1, S1, 0x20 + xvld U2, S2, 0x00 + xvld U3, S2, 0x20 + xvld U4, S3, 0x00 + xvld U5, S3, 0x20 + xvld U6, S4, 0x00 + xvld U7, S4, 0x20 + + xvst U0, P2, 0x00 + xvst U1, P2, 0x20 + xvst U2, P2, 0x40 + xvst U3, P2, 0x60 + xvst U4, P2, 0x80 + xvst U5, P2, 0xA0 + xvst U6, P2, 0xC0 + xvst U7, P2, 0xE0 + + addi.d S1, S1, 0x40 + addi.d S2, S2, 0x40 + addi.d S3, S3, 0x40 + addi.d S4, S4, 0x40 + addi.d P2, P2, 0x100 + +.L_4N7: + andi I, N, 0x04 + beq ZERO, I, .L_4N3 + + xvld U0, S1, 0x00 + xvld U1, S2, 0x00 + xvld U2, S3, 0x00 + xvld U3, S4, 0x00 + + xvst U0, P3, 0x00 + xvst U1, P3, 0x20 + xvst U2, P3, 0x40 + xvst U3, P3, 0x60 + + addi.d S1, S1, 0x20 + addi.d S2, S2, 0x20 + addi.d S3, S3, 0x20 + addi.d S4, S4, 0x20 + addi.d P3, P3, 0x80 + +.L_4N3: + andi I, N, 0x02 + beq ZERO, I, .L_4N1 + + xvld U0, S1, 0x00 + xvld U1, S2, 0x00 + xvld U2, S3, 0x00 + xvld U3, S4, 0x00 + + xvpermi.q U0, U1, 0x02 + xvpermi.q U2, U3, 0x02 + + xvst U0, P4, 0x00 + xvst U2, P4, 0x20 + + addi.d S1, S1, 0x10 + addi.d S2, S2, 0x10 + addi.d S3, S3, 0x10 + addi.d S4, S4, 0x10 + addi.d P4, P4, 0x40 + +.L_4N1: + andi I, N, 0x01 + beq ZERO, I, .L_M3 + + fld.d F0, S1, 0x00 + fld.d F1, S2, 0x00 + fld.d F2, S3, 0x00 + fld.d F3, S4, 0x00 + + fst.d F0, P5, 0x00 + fst.d F1, P5, 0x08 + fst.d F2, P5, 0x10 + fst.d F3, P5, 0x18 + + addi.d S1, S1, 0x08 + addi.d S2, S2, 0x08 + addi.d S3, S3, 0x08 + addi.d S4, S4, 0x08 + addi.d P5, P5, 0x20 + +.L_M3: + andi J, M, 0x02 + beq ZERO, J, .L_M1 + + move S1, S0 + add.d S2, S0, TL + add.d S0, S0, T0 + + move P1, P0 + addi.d P0, P0, 0x100 + + srai.d I, N, 0x04 + beq ZERO, I, .L_2N15 + +.L_2I1: /* I-- */ + xvld U0, S1, 0x00 + xvld U1, S1, 0x20 + xvld U2, S1, 0x40 + xvld U3, S1, 0x60 + xvld U4, S2, 0x00 + xvld U5, S2, 0x20 + xvld U6, S2, 0x40 + xvld U7, S2, 0x60 + + xvst U0, P1, 0x00 + xvst U1, P1, 0x20 + xvst U2, P1, 0x40 + xvst U3, P1, 0x60 + xvst U4, P1, 0x80 + xvst U5, P1, 0xA0 + xvst U6, P1, 0xC0 + xvst U7, P1, 0xE0 + + addi.d S1, S1, 0x80 + addi.d S2, S2, 0x80 + addi.d I, I, -1 + add.d P1, P1, T1 + blt ZERO, I, .L_2I1 + +.L_2N15: + andi I, N, 0x08 + beq ZERO, I, .L_2N7 + + xvld U0, S1, 0x00 + xvld U1, S1, 0x20 + xvld U2, S2, 0x00 + xvld U3, S2, 0x20 + + xvst U0, P2, 0x00 + xvst U1, P2, 0x20 + xvst U2, P2, 0x40 + xvst U3, P2, 0x60 + + addi.d S1, S1, 0x40 + addi.d S2, S2, 0x40 + addi.d P2, P2, 0x80 + +.L_2N7: + andi I, N, 0x04 + beq ZERO, I, .L_2N3 + + xvld U0, S1, 0x00 + xvld U1, S2, 0x00 + + xvst U0, P3, 0x00 + xvst U1, P3, 0x20 + + addi.d S1, S1, 0x20 + addi.d S2, S2, 0x20 + addi.d P3, P3, 0x40 + +.L_2N3: + andi I, N, 0x02 + beq ZERO, I, .L_2N1 + + xvld U0, S1, 0x00 + xvld U1, S2, 0x00 + + xvpermi.q U0, U1, 0x02 + + xvst U0, P4, 0x00 + + addi.d S1, S1, 0x10 + addi.d S2, S2, 0x10 + addi.d P4, P4, 0x20 + +.L_2N1: + andi I, N, 0x01 + beq ZERO, I, .L_M1 + + fld.d F0, S1, 0x00 + fld.d F1, S2, 0x00 + + fst.d F0, P5, 0x00 + fst.d F1, P5, 0x08 + + addi.d S1, S1, 0x08 + addi.d S2, S2, 0x08 + addi.d P5, P5, 0x10 + +.L_M1: + andi J, M, 0x01 + beq ZERO, J, .L_M0 + + move S1, S0 + add.d S2, S0, TL + + move P1, P0 + addi.d P0, P0, 0x80 + + srai.d I, N, 0x04 + beq ZERO, I, .L_1N15 + +.L_1I1: /* I-- */ + xvld U0, S1, 0x00 + xvld U1, S1, 0x20 + xvld U2, S1, 0x40 + xvld U3, S1, 0x60 + + xvst U0, P1, 0x00 + xvst U1, P1, 0x20 + xvst U2, P1, 0x40 + xvst U3, P1, 0x60 + + addi.d S1, S1, 0x80 + addi.d I, I, -1 + add.d P1, P1, T1 + blt ZERO, I, .L_1I1 + +.L_1N15: + andi I, N, 0x08 + beq ZERO, I, .L_1N7 + + xvld U0, S1, 0x00 + xvld U1, S1, 0x20 + + xvst U0, P2, 0x00 + xvst U1, P2, 0x20 + + addi.d S1, S1, 0x40 + addi.d P2, P2, 0x40 + +.L_1N7: + andi I, N, 0x04 + beq ZERO, I, .L_1N3 + + xvld U0, S1, 0x00 + + xvst U0, P3, 0x00 + + addi.d S1, S1, 0x20 + addi.d P3, P3, 0x20 + +.L_1N3: + andi I, N, 0x02 + beq ZERO, I, .L_1N1 + + fld.d F0, S1, 0x00 + fld.d F1, S1, 0x08 + + fst.d F0, P4, 0x00 + fst.d F1, P4, 0x08 + + addi.d S1, S1, 0x10 + addi.d P4, P4, 0x10 + +.L_1N1: + andi I, N, 0x01 + beq ZERO, I, .L_M0 + + fld.d F0, S1, 0x00 + + fst.d F0, P5, 0x00 + + addi.d S1, S1, 0x08 + addi.d P5, P5, 0x08 + +.L_M0: + LDARG $r23, $sp, 0 + LDARG $r24, $sp, 8 + LDARG $r25, $sp, 16 + LDARG $r26, $sp, 24 + LDARG $r27, $sp, 32 + LDARG $r28, $sp, 40 + LDARG $r29, $sp, 48 + addi.d $sp, $sp, 56 + jirl $r0, $r1, 0x00 + + EPILOGUE \ No newline at end of file diff --git a/kernel/loongarch64/cgemm_tcopy_4_lasx.S b/kernel/loongarch64/cgemm_tcopy_4_lasx.S new file mode 100644 index 000000000..9ff8a35b8 --- /dev/null +++ b/kernel/loongarch64/cgemm_tcopy_4_lasx.S @@ -0,0 +1,306 @@ +/******************************************************************************* +Copyright (c) 2024, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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. +*******************************************************************************/ +#define ASSEMBLER + +#include "common.h" + +/* Function parameters */ +#define M $r4 // param 1: m +#define N $r5 // param 2: n +#define SRC $r6 // param 3: src +#define LDA $r7 // param 4: lda +#define DST $r8 // param 5: dst + +#define I $r9 +#define J $r10 +#define S1 $r12 +#define S2 $r13 +#define S3 $r14 +#define S4 $r15 +#define TD $r16 +#define TS $r17 +#define TL $r18 +#define T0 $r19 +#define S8 $r20 +#define S9 $r23 +#define S10 $r11 +#define ZERO $r0 + +#define F0 $f0 +#define F1 $f1 +#define F2 $f2 +#define F3 $f3 +#define F4 $f4 +#define F5 $f5 +#define F6 $f6 +#define F7 $f7 + +/* LASX vectors */ +#define U0 $xr0 +#define U1 $xr1 +#define U2 $xr2 +#define U3 $xr3 +#define U4 $xr4 +#define U5 $xr5 +#define U6 $xr6 +#define U7 $xr7 +#define U8 $xr8 +#define U9 $xr9 +#define U10 $xr10 +#define U11 $xr11 +#define U12 $xr12 +#define U13 $xr13 +#define U14 $xr14 +#define U15 $xr15 + + + PROLOGUE + + addi.d $sp, $sp, -8 + SDARG $r23, $sp, 0 + + move TS, SRC //aoffset + move TD, DST //boffset + slli.d TL, LDA, 0x02 //lda + slli.d TL, TL, 0x01 //lda + + ori T0, ZERO, 0x03 + andn T0, N, T0 + mul.w T0, M, T0 + slli.d T0, T0, 0x01 + slli.d T0, T0, 0x02 + add.d S9, DST, T0 //boffset2 + + ori T0, ZERO, 0x01 + andn T0, N, T0 + mul.w T0, M, T0 + slli.d T0, T0, 0x01 + slli.d T0, T0, 0x02 + add.d S10, DST, T0 //boffset3 + + srai.d J, M, 0x02 //j + + beq J, ZERO, .L_M1 + +.L_J1: /* if(j>0) j--*/ + move S1, TS //aoffset1 + add.d S2, S1, TL + add.d S3, S2, TL + add.d S4, S3, TL + + slli.d T0, TL, 0x02 + add.d TS, TS, T0 + + move S8, TD //boffset1 + addi.d TD, TD, 0x80 + + srai.d I, N, 0x02 + + beq ZERO, I, .L_JN1 + +.L_JI1: /* if(i>0) i--*/ + xvld U0, S1, 0x00 + xvld U1, S2, 0x00 + xvld U2, S3, 0x00 + xvld U3, S4, 0x00 + + xvst U0, S8, 0x00 + xvst U1, S8, 0x20 + xvst U2, S8, 0x40 + xvst U3, S8, 0x60 + + addi.d S1, S1, 0x20 + addi.d S2, S2, 0x20 + addi.d S3, S3, 0x20 + addi.d S4, S4, 0x20 + slli.d T0, M, 0x05 + add.d S8, S8, T0 + + addi.d I, I, -1 + blt ZERO, I, .L_JI1 + +.L_JN1: /* if(n&2) */ + andi I, N, 0x02 + beq ZERO, I, .L_JN2 + + vld $vr0, S1, 0x00 + vld $vr1, S2, 0x00 + vld $vr2, S3, 0x00 + vld $vr3, S4, 0x00 + + vst $vr0, S9, 0x00 + vst $vr1, S9, 0x10 + vst $vr2, S9, 0x20 + vst $vr3, S9, 0x30 + + addi.d S1, S1, 0x10 + addi.d S2, S2, 0x10 + addi.d S3, S3, 0x10 + addi.d S4, S4, 0x10 + addi.d S9, S9, 0x40 + +.L_JN2: /* if(n&1) */ + andi I, N, 0x01 + beq ZERO, I, .L_J0 + + fld.s F0, S1, 0x00 + fld.s F1, S1, 0x04 + + fld.s F2, S2, 0x00 + fld.s F3, S2, 0x04 + + fld.s F4, S3, 0x00 + fld.s F5, S3, 0x04 + + fld.s F6, S4, 0x00 + fld.s F7, S4, 0x04 + + fst.s F0, S10, 0x00 + fst.s F1, S10, 0x04 + fst.s F2, S10, 0x08 + fst.s F3, S10, 0x0c + fst.s F4, S10, 0x10 + fst.s F5, S10, 0x14 + fst.s F6, S10, 0x18 + fst.s F7, S10, 0x1c + + addi.d S10, S10, 0x20 + +.L_J0: + addi.d J, J, -1 + blt ZERO, J, .L_J1 + +.L_M1: /* if(m&2) */ + andi I, M, 0x02 + beq ZERO, I, .L_M2 + + move S1, TS //aoffset1 + add.d S2, S1, TL + + slli.d T0, TL, 0x01 + add.d TS, TS, T0 + + move S8, TD //boffset1 + addi.d TD, TD, 0x40 + + srai.d I, N, 0x02 + beq ZERO, I, .L_M1N1 + +.L_M1I1: /* if(i>0) */ + xvld U0, S1, 0x00 + xvld U1, S2, 0x00 + + xvst U0, S8, 0x00 + xvst U1, S8, 0x20 + + addi.d S1, S1, 0x20 + addi.d S2, S2, 0x20 + slli.d T0, M, 0x05 + add.d S8, S8, T0 + + addi.d I, I, -1 + blt ZERO, I, .L_M1I1 + +.L_M1N1: /* if(n&2) */ + andi I, N, 0x02 + beq ZERO, I, .L_M1N2 + + vld $vr0, S1, 0x00 + vld $vr1, S2, 0x00 + + vst $vr0, S9, 0x00 + vst $vr1, S9, 0x10 + + addi.d S1, S1, 0x10 + addi.d S2, S2, 0x10 + addi.d S9, S9, 0x20 + +.L_M1N2: /* if(n&1) */ + andi I, N, 0x01 + beq ZERO, I, .L_M2 + + fld.s F0, S1, 0x00 + fld.s F1, S1, 0x04 + + fld.s F2, S2, 0x00 + fld.s F3, S2, 0x04 + + fst.s F0, S10, 0x00 + fst.s F1, S10, 0x04 + fst.s F2, S10, 0x08 + fst.s F3, S10, 0x0c + + addi.d S10, S10, 0x10 + +.L_M2: /* if(m&1) */ + andi I, M, 0x01 + beq ZERO, I, .L_M0 + + move S1, TS //aoffset1 + move S8, TD //boffset1 + + srai.d I, N, 0x02 + beq ZERO, I, .L_M2N1 + +.L_M2I1: /* if(i>0) */ + xvld U0, S1, 0x00 + + xvst U0, S8, 0x00 + + addi.d S1, S1, 0x20 + slli.d T0, M, 0x05 + add.d S8, S8, T0 + + addi.d I, I, -1 + blt ZERO, I, .L_M2I1 + +.L_M2N1: /* if(n&2) */ + andi I, N, 0x02 + beq ZERO, I, .L_M2N2 + + vld $vr0, S1, 0x00 + + vst $vr0, S9, 0x00 + + addi.d S1, S1, 0x10 + +.L_M2N2: /* if(n&1) */ + andi I, N, 0x01 + beq ZERO, I, .L_M0 + + fld.s F0, S1, 0x00 + fld.s F1, S1, 0x04 + + fst.s F0, S10, 0x00 + fst.s F1, S10, 0x04 + +.L_M0: + LDARG $r23, $sp, 0 + addi.d $sp, $sp, 8 + jirl $r0, $r1, 0x00 + + EPILOGUE \ No newline at end of file diff --git a/param.h b/param.h index 5d2e960a2..8bdc03380 100644 --- a/param.h +++ b/param.h @@ -2845,21 +2845,25 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define DGEMM_DEFAULT_UNROLL_M 2 #define SGEMM_DEFAULT_UNROLL_N 8 #define SGEMM_DEFAULT_UNROLL_M 2 +#define CGEMM_DEFAULT_UNROLL_N 4 +#define CGEMM_DEFAULT_UNROLL_M 1 +#define ZGEMM_DEFAULT_UNROLL_N 4 +#define ZGEMM_DEFAULT_UNROLL_M 1 #else #define DGEMM_DEFAULT_UNROLL_N 4 #define DGEMM_DEFAULT_UNROLL_M 16 #define SGEMM_DEFAULT_UNROLL_N 8 #define SGEMM_DEFAULT_UNROLL_M 16 +#define CGEMM_DEFAULT_UNROLL_N 4 +#define CGEMM_DEFAULT_UNROLL_M 16 +#define ZGEMM_DEFAULT_UNROLL_N 4 +#define ZGEMM_DEFAULT_UNROLL_M 8 #endif #define QGEMM_DEFAULT_UNROLL_N 2 -#define CGEMM_DEFAULT_UNROLL_N 2 -#define ZGEMM_DEFAULT_UNROLL_N 4 #define XGEMM_DEFAULT_UNROLL_N 1 #define QGEMM_DEFAULT_UNROLL_M 2 -#define CGEMM_DEFAULT_UNROLL_M 2 -#define ZGEMM_DEFAULT_UNROLL_M 8 #define XGEMM_DEFAULT_UNROLL_M 1 #define SGEMM_DEFAULT_P 256 From bf2310442b7eda57ad8089878518b3f43733efaf Mon Sep 17 00:00:00 2001 From: Chip-Kerchner Date: Wed, 21 Feb 2024 13:26:28 -0600 Subject: [PATCH 160/311] Fix get_num_cores for AIX. --- getarch.c | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/getarch.c b/getarch.c index f879e6bbb..2b5459a5f 100644 --- a/getarch.c +++ b/getarch.c @@ -90,7 +90,9 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #include #include #endif -#if defined(AIX) +#if defined(_AIX) +#include +#include #include #endif @@ -1870,11 +1872,13 @@ static int get_num_cores(void) { return count; -#elif defined(AIX) +#elif defined(_AIX) //returns the number of processors which are currently online count = sysconf(_SC_NPROCESSORS_ONLN); if (count <= 0) count = 2; - + + return count; + #else return 2; #endif From 9b24b3141985de115e6191b376b435117a32404a Mon Sep 17 00:00:00 2001 From: frjohnst Date: Wed, 21 Feb 2024 15:52:29 -0500 Subject: [PATCH 161/311] resolve second_ conflict which breaks xlf timef --- lapack-netlib/SRC/Makefile | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/lapack-netlib/SRC/Makefile b/lapack-netlib/SRC/Makefile index de2242701..205a32d31 100644 --- a/lapack-netlib/SRC/Makefile +++ b/lapack-netlib/SRC/Makefile @@ -101,8 +101,10 @@ SCLAUX = la_constants.o \ slaset.o slasq1.o slasq2.o slasq3.o slasq4.o slasq5.o slasq6.o \ slasr.o slasrt.o slassq.o slasv2.o spttrf.o sstebz.o sstedc.o \ ssteqr.o ssterf.o slaisnan.o sisnan.o \ - slartgp.o slartgs.o scombssq.o ../INSTALL/sroundup_lwork.o \ - ../INSTALL/second_$(TIMER).o + slartgp.o slartgs.o scombssq.o ../INSTALL/sroundup_lwork.o +ifneq ($(F_COMPILER), IBM) +SCLAUX += ../INSTALL/second_$(TIMER).o +endif endif ifneq "$(or $(BUILD_DOUBLE),$(BUILD_COMPLEX16))" "" @@ -124,7 +126,10 @@ DZLAUX = la_constants.o\ dlasr.o dlasrt.o dlassq.o dlasv2.o dpttrf.o dstebz.o dstedc.o \ dsteqr.o dsterf.o dlaisnan.o disnan.o \ dlartgp.o dlartgs.o ../INSTALL/droundup_lwork.o \ - ../INSTALL/dlamch.o ../INSTALL/dsecnd_$(TIMER).o + ../INSTALL/dlamch.o +ifneq ($(F_COMPILER), IBM) +DZLAUX += ../INSTALL/dsecnd_$(TIMER).o +endif endif #ifeq ($(BUILD_SINGLE),1) From d51ffec3a20299532a1ef5a403df2760f7b5b653 Mon Sep 17 00:00:00 2001 From: gxw Date: Thu, 22 Feb 2024 10:46:45 +0800 Subject: [PATCH 162/311] LoongArch64: Opt cgemv with LASX --- kernel/loongarch64/KERNEL.LOONGSON3R5 | 3 + kernel/loongarch64/cgemv_n_8_lasx.S | 383 ++++++++++++++++++++++++++ kernel/loongarch64/cgemv_t_8_lasx.S | 342 +++++++++++++++++++++++ kernel/loongarch64/loongarch64_asm.S | 240 ++++++++++++++++ 4 files changed, 968 insertions(+) create mode 100644 kernel/loongarch64/cgemv_n_8_lasx.S create mode 100644 kernel/loongarch64/cgemv_t_8_lasx.S diff --git a/kernel/loongarch64/KERNEL.LOONGSON3R5 b/kernel/loongarch64/KERNEL.LOONGSON3R5 index ce9268b93..3b2ee6e55 100644 --- a/kernel/loongarch64/KERNEL.LOONGSON3R5 +++ b/kernel/loongarch64/KERNEL.LOONGSON3R5 @@ -121,6 +121,9 @@ CGEMMITCOPYOBJ = cgemm_itcopy$(TSUFFIX).$(SUFFIX) CGEMMONCOPYOBJ = cgemm_oncopy$(TSUFFIX).$(SUFFIX) CGEMMOTCOPYOBJ = cgemm_otcopy$(TSUFFIX).$(SUFFIX) +CGEMVNKERNEL = cgemv_n_8_lasx.S +CGEMVTKERNEL = cgemv_t_8_lasx.S + CTRSMKERNEL_LN = ../generic/trsm_kernel_LN.c CTRSMKERNEL_LT = ../generic/trsm_kernel_LT.c CTRSMKERNEL_RN = ../generic/trsm_kernel_RN.c diff --git a/kernel/loongarch64/cgemv_n_8_lasx.S b/kernel/loongarch64/cgemv_n_8_lasx.S new file mode 100644 index 000000000..b078e3227 --- /dev/null +++ b/kernel/loongarch64/cgemv_n_8_lasx.S @@ -0,0 +1,383 @@ +/******************************************************************************* +Copyright (c) 2024, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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. +*******************************************************************************/ +#define ASSEMBLER + +#include "common.h" +#include "loongarch64_asm.S" + +/********************************************************************* +* 2024/02/20 guxiwei +* UTEST : OK +* CTEST : OK +* TEST : OK +* +* +*********************************************************************/ + +/* int CNAME(BLASLONG m, BLASLONG n, BLASLONG dummy1, FLOAT alpha_r, FLOAT alpha_i, + * FLOAT *a, BLASLONG lda, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y, FLOAT *buffer) + */ +#define M $r4 +#define N $r5 +#define ALPHA_R $f0 +#define ALPHA_I $f1 +#define A $r7 +#define LDA $r8 +#define X $r9 +#define INC_X $r10 +#define Y $r11 +#define INC_Y $r6 + +#define J $r12 +#define I $r13 +#define K $r14 +#define Y_ORG $r15 +#define OFFSET $r16 +#define K_LDA $r17 +#define M8 $r18 +#define T0 $r19 +#define PA0 $r20 +#define PA1 $r23 +#define PA2 $r24 +#define PA3 $r25 +#define PA4 $r26 +#define PA5 $r27 +#define PA6 $r28 +#define PA7 $r29 + +#define VALPHA $xr1 +#define X0 $xr2 +#define X1 $xr3 +#define X2 $xr4 +#define X3 $xr5 +#define X4 $xr6 +#define X5 $xr7 +#define X6 $xr8 +#define X7 $xr9 +#define Y0 $xr10 +#define Y1 $xr11 +#define A0 $xr12 +#define A1 $xr13 +#define A2 $xr14 +#define A3 $xr15 +#define A4 $xr16 +#define A5 $xr17 +#define A6 $xr18 +#define A7 $xr19 +#define A8 $xr20 +#define A9 $xr21 +#define A10 $xr22 +#define A11 $xr23 +#define A12 $xr24 +#define A13 $xr25 +#define A14 $xr26 +#define A15 $xr27 +#define TMP0 $xr28 +#define TMP1 $xr29 +#define TMP2 $xr30 + +#if !defined(CONJ) +#if !defined(XCONJ) +#define GXCONJ 0 +#define GCONJ 0 +#else +#define GXCONJ 1 +#define GCONJ 0 +#endif +#else +#if !defined(XCONJ) +#define GXCONJ 0 +#define GCONJ 1 +#else +#define GXCONJ 1 +#define GCONJ 1 +#endif +#endif + +.macro CLOAD_X_8 + GLDREPL xv, d, X0, X, 0x00, X1, X, 0x08, X2, X, 0x10, X3, X, 0x18, \ + X4, X, 0x20, X5, X, 0x28, X6, X, 0x30, X7, X, 0x38 + GCOMPLEXMUL GXCONJ, \ + xvf, s, X0, X0, VALPHA, TMP0, TMP1, TMP2, \ + X1, X1, VALPHA, TMP0, TMP1, TMP2, \ + X2, X2, VALPHA, TMP0, TMP1, TMP2, \ + X3, X3, VALPHA, TMP0, TMP1, TMP2, \ + X4, X4, VALPHA, TMP0, TMP1, TMP2, \ + X5, X5, VALPHA, TMP0, TMP1, TMP2, \ + X6, X6, VALPHA, TMP0, TMP1, TMP2, \ + X7, X7, VALPHA, TMP0, TMP1, TMP2 +.endm + +.macro CLOAD_X_8_GAP + xvldrepl.d X0, X, 0x00 + PTR_ADD T0, X, INC_X + xvldrepl.d X1, T0, 0x00 + PTR_ADD T0, T0, INC_X + xvldrepl.d X2, T0, 0x00 + PTR_ADD T0, T0, INC_X + xvldrepl.d X3, T0, 0x00 + PTR_ADD T0, T0, INC_X + xvldrepl.d X4, T0, 0x00 + PTR_ADD T0, T0, INC_X + xvldrepl.d X5, T0, 0x00 + PTR_ADD T0, T0, INC_X + xvldrepl.d X6, T0, 0x00 + PTR_ADD T0, T0, INC_X + xvldrepl.d X7, T0, 0x00 + + GCOMPLEXMUL GXCONJ, \ + xvf, s, X0, X0, VALPHA, TMP0, TMP1, TMP2, \ + X1, X1, VALPHA, TMP0, TMP1, TMP2, \ + X2, X2, VALPHA, TMP0, TMP1, TMP2, \ + X3, X3, VALPHA, TMP0, TMP1, TMP2, \ + X4, X4, VALPHA, TMP0, TMP1, TMP2, \ + X5, X5, VALPHA, TMP0, TMP1, TMP2, \ + X6, X6, VALPHA, TMP0, TMP1, TMP2, \ + X7, X7, VALPHA, TMP0, TMP1, TMP2 +.endm + +.macro CLOAD_Y_8 + GLD xv, , Y0, Y, 0, Y1, Y, 0x20 +.endm + +.macro CLOAD_Y_8_GAP + fld.d $f10, Y, 0 + fldx.d $f13, Y, INC_Y + PTR_ALSL T0, INC_Y, Y, 1 + fld.d $f14, T0, 0 + fldx.d $f15, T0, INC_Y + PTR_ALSL T0, INC_Y, Y, 2 + fld.d $f11, T0, 0 + fldx.d $f17, T0, INC_Y + PTR_ADD T0, T0, INC_Y + PTR_ADD T0, T0, INC_Y + fld.d $f18, T0, 0 + fldx.d $f19, T0, INC_Y + GINSVE0 xv, d, Y0, A1, 1, Y0, A2, 2, Y0, A3, 3, Y1, A5, 1, Y1, A6, 2, Y1, A7, 3 +.endm + +.macro CSTORE_Y_8_GAP + xvstelm.d Y0, Y, 0, 0 + PTR_ADD T0, Y, INC_Y + xvstelm.d Y0, T0, 0, 1 + PTR_ADD T0, T0, INC_Y + xvstelm.d Y0, T0, 0, 2 + PTR_ADD T0, T0, INC_Y + xvstelm.d Y0, T0, 0, 3 + + PTR_ADD T0, T0, INC_Y + xvstelm.d Y1, T0, 0, 0 + PTR_ADD T0, T0, INC_Y + xvstelm.d Y1, T0, 0, 1 + PTR_ADD T0, T0, INC_Y + xvstelm.d Y1, T0, 0, 2 + PTR_ADD T0, T0, INC_Y + xvstelm.d Y1, T0, 0, 3 +.endm + +.macro CGEMV_N_8x8 + GLD_INC xv, , 0x20, \ + A0, PA0, 0, A1, PA0, 0, \ + A2, PA1, 0, A3, PA1, 0, \ + A4, PA2, 0, A5, PA2, 0, \ + A6, PA3, 0, A7, PA3, 0, \ + A8, PA4, 0, A9, PA4, 0, \ + A10, PA5, 0, A11, PA5, 0, \ + A12, PA6, 0, A13, PA6, 0, \ + A14, PA7, 0, A15, PA7, 0 + + GCOMPLEXMADD GXCONJ, GCONJ, \ + xvf, s, Y0, X0, A0, Y0, TMP0, TMP1, TMP2, Y1, X0, A1, Y1, TMP0, TMP1, TMP2, \ + Y0, X1, A2, Y0, TMP0, TMP1, TMP2, Y1, X1, A3, Y1, TMP0, TMP1, TMP2, \ + Y0, X2, A4, Y0, TMP0, TMP1, TMP2, Y1, X2, A5, Y1, TMP0, TMP1, TMP2, \ + Y0, X3, A6, Y0, TMP0, TMP1, TMP2, Y1, X3, A7, Y1, TMP0, TMP1, TMP2, \ + Y0, X4, A8, Y0, TMP0, TMP1, TMP2, Y1, X4, A9, Y1, TMP0, TMP1, TMP2, \ + Y0, X5, A10, Y0, TMP0, TMP1, TMP2, Y1, X5, A11, Y1, TMP0, TMP1, TMP2, \ + Y0, X6, A12, Y0, TMP0, TMP1, TMP2, Y1, X6, A13, Y1, TMP0, TMP1, TMP2, \ + Y0, X7, A14, Y0, TMP0, TMP1, TMP2, Y1, X7, A15, Y1, TMP0, TMP1, TMP2 +.endm + +.macro CSTORE_Y_8 + GST xv, , Y0, Y, 0, Y1, Y, 0x20 +.endm + +.macro CLOAD_X_1 + GLDREPL xv, d, X0, X, 0x00 + GCOMPLEXMUL GXCONJ, \ + xvf, s, X0, X0, VALPHA, TMP0, TMP1, TMP2 +.endm + +.macro CLOAD_Y_1 + fld.d $f10, Y, 0 +.endm + +.macro CGEMV_N_1x8 + GLD_INC f, d, 0x08, $f12, PA0, 0, $f14, PA1, 0, $f16, PA2, 0, $f18, PA3, 0, \ + $f20, PA4, 0, $f22, PA5, 0, $f24, PA6, 0, $f26, PA7, 0 + GCOMPLEXMADD GXCONJ, GCONJ, \ + xvf, s, Y0, X0, A0, Y0, TMP0, TMP1, TMP2, \ + Y0, X1, A2, Y0, TMP0, TMP1, TMP2, \ + Y0, X2, A4, Y0, TMP0, TMP1, TMP2, \ + Y0, X3, A6, Y0, TMP0, TMP1, TMP2, \ + Y0, X4, A8, Y0, TMP0, TMP1, TMP2, \ + Y0, X5, A10, Y0, TMP0, TMP1, TMP2, \ + Y0, X6, A12, Y0, TMP0, TMP1, TMP2, \ + Y0, X7, A14, Y0, TMP0, TMP1, TMP2 +.endm + +.macro CSTORE_Y_1 + fst.d $f10, Y, 0 +.endm + +.macro CGEMV_N_1x1 + fld.d $f12, PA0, 0 + PTR_ADDI PA0, PA0, 0x08 + GCOMPLEXMADD GXCONJ, GCONJ, \ + xvf, s, Y0, X0, A0, Y0, TMP0, TMP1, TMP2 +.endm + +.macro CGEMV_N_LASX XW:req, X_8:req, X_1:req, Y_8:req, Y_1:req + PTR_SRLI J, N, 3 + beqz J, .L_\XW\()_N_7 + PTR_SLLI K_LDA, LDA, 3 + PTR_SUB K_LDA, K_LDA, M8 +.L_\XW\()_N_L8: + CLOAD_\X_8 + xor K, K, K + move Y, Y_ORG + PTR_SRLI I, M, 3 + beqz I, .L_\XW\()_M_7 +.align 5 +.L_\XW\()_M_L8: + CLOAD_\Y_8 + CGEMV_N_8x8 + CSTORE_\Y_8 + PTR_ADDI I, I, -1 + PTR_ALSL Y, INC_Y, Y, 3 + PTR_ADDI K, K, 8 + bnez I, .L_\XW\()_M_L8 +.L_\XW\()_M_7: + andi I, M, 7 + beqz I, .L_\XW\()_M_END +.align 5 +.L_\XW\()_M_L1: + CLOAD_\Y_1 + CGEMV_N_1x8 + CSTORE_\Y_1 + PTR_ADDI I, I, -1 + PTR_ADD Y, Y, INC_Y + PTR_ADDI K, K, 1 + bnez I, .L_\XW\()_M_L1 +.L_\XW\()_M_END: + PTR_ADDI J, J, -1 +#if __loongarch_grlen == 64 + GADD , d, PA0, PA0, K_LDA, PA1, PA1, K_LDA, PA2, PA2, K_LDA, PA3, PA3, K_LDA, \ + PA4, PA4, K_LDA, PA5, PA5, K_LDA, PA6, PA6, K_LDA, PA7, PA7, K_LDA +#elif __loongarch_grlen == 32 + GADD , w, PA0, PA0, K_LDA, PA1, PA1, K_LDA, PA2, PA2, K_LDA, PA3, PA3, K_LDA, \ + PA4, PA4, K_LDA, PA5, PA5, K_LDA, PA6, PA6, K_LDA, PA7, PA7, K_LDA +#else + GADD , d, PA0, PA0, K_LDA, PA1, PA1, K_LDA, PA2, PA2, K_LDA, PA3, PA3, K_LDA, \ + PA4, PA4, K_LDA, PA5, PA5, K_LDA, PA6, PA6, K_LDA, PA7, PA7, K_LDA +#endif + PTR_ALSL X, INC_X, X, 3 + bnez J, .L_\XW\()_N_L8 +.L_\XW\()_N_7: + andi J, N, 7 + beqz J, .L_END +.L_\XW\()_N_L1: + CLOAD_\X_1 + xor K, K, K + move Y, Y_ORG + move I, M + beqz I, .L_END +.align 5 +.L_\XW\()_N_1_M_L1: + CLOAD_\Y_1 + CGEMV_N_1x1 + CSTORE_\Y_1 + PTR_ADDI I, I, -1 + PTR_ADD Y, Y, INC_Y + PTR_ADDI K, K, 1 + bnez I, .L_\XW\()_N_1_M_L1 +.L_\XW\()_N_1_M_END: + PTR_ADDI J, J, -1 + PTR_SUB K_LDA, LDA, M8 + PTR_ADD PA0, PA0, K_LDA + PTR_ADD X, X, INC_X + bnez J, .L_\XW\()_N_L1 + + b .L_END +.endm + + PROLOGUE + PTR_LD INC_Y, $sp, 0 + push_if_used 17 + 7, 31 + PTR_ADDI K, $r0, 0x01 + PTR_SUB I, INC_X, K + PTR_SUB J, INC_Y, K + maskeqz I, K, I /* if(inc_x == 1) I = 0; else I = 1; */ + maskeqz J, K, J /* if(inc_y == 1) j = 0; else j = 1; */ + PTR_ALSL I, I, J, 1 + GSLLI , d, LDA, LDA, 3, INC_X, INC_X, 3, INC_Y, INC_Y, 3, M8, M, 3 + // Init VALPHA + xvpackev.w $xr0, $xr1, $xr0 + xvreplve0.d VALPHA, $xr0 + move Y_ORG, Y + move PA0, A +#if __loongarch_grlen == 64 + GADD , d, PA1, PA0, LDA, PA2, PA1, LDA, PA3, PA2, LDA, PA4, PA3, LDA, \ + PA5, PA4, LDA, PA6, PA5, LDA, PA7, PA6, LDA +#elif __loongarch_grlen == 32 + GADD , w, PA1, PA0, LDA, PA2, PA1, LDA, PA3, PA2, LDA, PA4, PA3, LDA, \ + PA5, PA4, LDA, PA6, PA5, LDA, PA7, PA6, LDA +#else + GADD , d, PA1, PA0, LDA, PA2, PA1, LDA, PA3, PA2, LDA, PA4, PA3, LDA, \ + PA5, PA4, LDA, PA6, PA5, LDA, PA7, PA6, LDA +#endif + la.local T0, .L_GAP_TABLE + PTR_ALSL I, I, T0, 1 + ld.h K, I, 0 // Obtain the offset address + PTR_ADD T0, T0, K + jirl $r0, T0, 0 +.L_GAP_TABLE: + .hword .L_GAP_0_0 - .L_GAP_TABLE + .hword .L_GAP_0_1 - .L_GAP_TABLE + .hword .L_GAP_1_0 - .L_GAP_TABLE + .hword .L_GAP_1_1 - .L_GAP_TABLE +.L_GAP_0_0: /* if (inc_x == 1) && (incy == 1) */ + CGEMV_N_LASX GAP_0_0, X_8, X_1, Y_8, Y_1 +.L_GAP_0_1: /* if (inc_x == 1) && (incy != 1) */ + CGEMV_N_LASX GAP_0_1, X_8, X_1, Y_8_GAP, Y_1 +.L_GAP_1_0: /* if (inc_x != 1) && (incy == 1) */ + CGEMV_N_LASX GAP_1_0, X_8_GAP, X_1, Y_8, Y_1 +.L_GAP_1_1: /* if (inc_x != 1) && (incy != 1) */ + CGEMV_N_LASX GAP_1_1, X_8_GAP, X_1, Y_8_GAP, Y_1 +.L_END: + pop_if_used 17 + 7, 31 + jirl $r0, $r1, 0x0 + EPILOGUE diff --git a/kernel/loongarch64/cgemv_t_8_lasx.S b/kernel/loongarch64/cgemv_t_8_lasx.S new file mode 100644 index 000000000..94e4bd2eb --- /dev/null +++ b/kernel/loongarch64/cgemv_t_8_lasx.S @@ -0,0 +1,342 @@ +/******************************************************************************* +Copyright (c) 2024, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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. +*******************************************************************************/ +#define ASSEMBLER + +#include "common.h" +#include "loongarch64_asm.S" + +/********************************************************************* +* 2022/02/20 guxiwei +* UTEST : OK +* CTEST : OK +* TEST : OK +* +* +*********************************************************************/ + +/* int CNAME(BLASLONG m, BLASLONG n, BLASLONG dummy1, FLOAT alpha_r, FLOAT alpha_i, + * FLOAT *a, BLASLONG lda, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y, FLOAT *buffer) + */ +#define M $r4 +#define N $r5 +#define ALPHA_R $f0 +#define ALPHA_I $f1 +#define A $r7 +#define LDA $r8 +#define X $r9 +#define INC_X $r10 +#define Y $r11 +#define INC_Y $r6 + +#define J $r12 +#define I $r13 +#define K $r14 +#define PY0 $r14 +#define X_ORG $r15 +#define PY1 $r16 +#define K_LDA $r17 +#define PY2 $r18 +#define T0 $r19 +#define PA0 $r20 +#define PA1 $r23 +#define PA2 $r24 +#define PA3 $r25 +#define PA4 $r26 +#define PA5 $r27 +#define PA6 $r28 +#define PA7 $r29 +#define M8 $r30 + +#define VALPHA $xr0 +#define X0 $xr1 +#define X1 $xr2 +#define A0 $xr3 +#define A1 $xr4 +#define A2 $xr5 +#define A3 $xr6 +#define A4 $xr7 +#define A5 $xr8 +#define A6 $xr9 +#define A7 $xr10 +#define A8 $xr11 +#define A9 $xr12 +#define A10 $xr13 +#define A11 $xr14 +#define A12 $xr15 +#define A13 $xr16 +#define A14 $xr17 +#define A15 $xr18 +#define TP0 $xr19 +#define TP1 $xr20 +#define TP2 $xr21 +#define TP3 $xr22 +#define TP4 $xr23 +#define TP5 $xr24 +#define TP6 $xr25 +#define TP7 $xr26 +#define TMP0 $xr27 +#define TMP1 $xr28 +#define TMP2 $xr29 +#define Y0 $xr3 +#define Y1 $xr4 +#define Y2 $xr5 +#define Y3 $xr6 +#define Y4 $xr7 +#define Y5 $xr8 +#define Y6 $xr9 +#define Y7 $xr10 + +#if ( !defined(CONJ) && !defined(XCONJ) ) || ( defined(CONJ) && defined(XCONJ) ) +#define GXCONJ1 0 +#define GCONJ1 0 +#else +#define GXCONJ1 1 +#define GCONJ1 0 +#endif + +#if !defined(XCONJ) +#define GXCONJ2 0 +#define GCONJ2 0 +#else +#define GXCONJ2 0 +#define GCONJ2 1 +#endif + +.macro ZERO_Y8 + GXOR xv, v, TP0, TP0, TP0, TP1, TP1, TP1, TP2, TP2, TP2, TP3, TP3, TP3, \ + TP4, TP4, TP4, TP5, TP5, TP5, TP6, TP6, TP6, TP7, TP7, TP7 +.endm + +.macro ZERO_Y1 + GXOR xv, v, TP0, TP0, TP0 +.endm + +.macro CLOAD_X8 + GLD xv, , X0, X, 0x00, X1, X, 0x20 +.endm + +.macro CLOAD_X8_GAP + fld.d $f1, X, 0x00 + fldx.d $f2, X, INC_X + PTR_ALSL T0, INC_X, X, 1 + fld.d $f3, T0, 0x00 + fldx.d $f4, T0, INC_X + GINSVE0 xv, d, X0, X1, 1, X0, A0, 2, X0, A1, 3 + PTR_ALSL T0, INC_X, X, 2 + fld.d $f2, T0, 0x00 + fldx.d $f3, T0, INC_X + PTR_ALSL T0, INC_X, T0, 1 + fld.d $f4, T0, 0x00 + fldx.d $f5, T0, INC_X + GINSVE0 xv, d, X1, A0, 1, X1, A1, 2, X1, A2, 3 +.endm + +.macro CGEMV_T_8x8 + GLD_INC xv, , 0x20, \ + A0, PA0, 0, A1, PA0, 0, \ + A2, PA1, 0, A3, PA1, 0, \ + A4, PA2, 0, A5, PA2, 0, \ + A6, PA3, 0, A7, PA3, 0, \ + A8, PA4, 0, A9, PA4, 0, \ + A10, PA5, 0, A11, PA5, 0, \ + A12, PA6, 0, A13, PA6, 0, \ + A14, PA7, 0, A15, PA7, 0 + GCOMPLEXMADD GXCONJ1, GCONJ1, \ + xvf, s, TP0, A0, X0, TP0, TMP0, TMP1, TMP2, TP0, A1, X1, TP0, TMP0, TMP1, TMP2, \ + TP1, A2, X0, TP1, TMP0, TMP1, TMP2, TP1, A3, X1, TP1, TMP0, TMP1, TMP2, \ + TP2, A4, X0, TP2, TMP0, TMP1, TMP2, TP2, A5, X1, TP2, TMP0, TMP1, TMP2, \ + TP3, A6, X0, TP3, TMP0, TMP1, TMP2, TP3, A7, X1, TP3, TMP0, TMP1, TMP2, \ + TP4, A8, X0, TP4, TMP0, TMP1, TMP2, TP4, A9, X1, TP4, TMP0, TMP1, TMP2, \ + TP5, A10, X0, TP5, TMP0, TMP1, TMP2, TP5, A11, X1, TP5, TMP0, TMP1, TMP2, \ + TP6, A12, X0, TP6, TMP0, TMP1, TMP2, TP6, A13, X1, TP6, TMP0, TMP1, TMP2, \ + TP7, A14, X0, TP7, TMP0, TMP1, TMP2, TP7, A15, X1, TP7, TMP0, TMP1, TMP2 +.endm + +.macro CGEMV_T_LASX XW:req, X8:req + PTR_SRLI J, N, 3 + beqz J, .L_\XW\()_N_7 + PTR_SLLI K_LDA, LDA, 3 + PTR_SUB K_LDA, K_LDA, M8 +.L_\XW\()_N_L8: + ZERO_Y8 + move X, X_ORG + PTR_SRLI I, M, 3 + beqz I, .L_\XW\()_M_7 +.align 5 +.L_\XW\()_M_L8: + CLOAD_\X8 + CGEMV_T_8x8 + PTR_ADDI I, I, -1 + PTR_ALSL X, INC_X, X, 3 + bnez I, .L_\XW\()_M_L8 +.L_\XW\()_M_7: + // Accumulated + GCOMPLEXACC xvf, s, Y0, TP0, Y1, TP1, Y2, TP2, Y3, TP3, Y4, TP4, \ + Y5, TP5, Y6, TP6, Y7, TP7 + andi I, M, 7 + beqz I, .L_\XW\()_M_END +.align 5 +.L_\XW\()_M_L1: + fld.d $f1, X, 0x00 + fld.d $f11, PA0, 0x00 + fld.d $f12, PA1, 0x00 + fld.d $f13, PA2, 0x00 + fld.d $f14, PA3, 0x00 + fld.d $f15, PA4, 0x00 + fld.d $f16, PA5, 0x00 + fld.d $f17, PA6, 0x00 + fld.d $f18, PA7, 0x00 +#if __loongarch_grlen == 64 + GADDI , d, PA0, PA0, 0x08, PA1, PA1, 0x08, PA2, PA2, 0x08, PA3, PA3, 0x08, \ + PA4, PA4, 0x08, PA5, PA5, 0x08, PA6, PA6, 0x08, PA7, PA7, 0x08 +#elif __loongarch_grlen == 32 + GADDI , w, PA0, PA0, 0x08, PA1, PA1, 0x08, PA2, PA2, 0x08, PA3, PA3, 0x08, \ + PA4, PA4, 0x08, PA5, PA5, 0x08, PA6, PA6, 0x08, PA7, PA7, 0x08 +#else + GADDI , d, PA0, PA0, 0x08, PA1, PA1, 0x08, PA2, PA2, 0x08, PA3, PA3, 0x08, \ + PA4, PA4, 0x08, PA5, PA5, 0x08, PA6, PA6, 0x08, PA7, PA7, 0x08 +#endif + + GCOMPLEXMADD GXCONJ1, GCONJ1, \ + xvf, s, A0, A8, X0, A0, TMP0, TMP1, TMP2, A1, A9, X0, A1, TMP0, TMP1, TMP2, \ + A2, A10, X0, A2, TMP0, TMP1, TMP2, A3, A11, X0, A3, TMP0, TMP1, TMP2, \ + A4, A12, X0, A4, TMP0, TMP1, TMP2, A5, A13, X0, A5, TMP0, TMP1, TMP2, \ + A6, A14, X0, A6, TMP0, TMP1, TMP2, A7, A15, X0, A7, TMP0, TMP1, TMP2 + + PTR_ADDI I, I, -1 + PTR_ADD X, X, INC_X + bnez I, .L_\XW\()_M_L1 +.L_\XW\()_M_END: + fld.d $f11, Y, 0x00 + fldx.d $f12, Y, INC_Y + PTR_ALSL PY0, INC_Y, Y, 1 + fld.d $f13, PY0, 0x00 + fldx.d $f14, PY0, INC_Y + PTR_ALSL PY1, INC_Y, Y, 2 + fld.d $f15, PY1, 0x00 + fldx.d $f16, PY1, INC_Y + PTR_ALSL PY2, INC_Y, PY1, 1 + fld.d $f17, PY2, 0x00 + fldx.d $f18, PY2, INC_Y + + GCOMPLEXMADD GXCONJ2, GCONJ2, \ + xvf, s, A8, VALPHA, A0, A8, TMP0, TMP1, TMP2, A9, VALPHA, A1, A9, TMP0, TMP1, TMP2,\ + A10, VALPHA, A2, A10, TMP0, TMP1, TMP2, A11, VALPHA, A3, A11, TMP0, TMP1, TMP2,\ + A12, VALPHA, A4, A12, TMP0, TMP1, TMP2, A13, VALPHA, A5, A13, TMP0, TMP1, TMP2,\ + A14, VALPHA, A6, A14, TMP0, TMP1, TMP2, A15, VALPHA, A7, A15, TMP0, TMP1, TMP2 + + PTR_ADDI J, J, -1 +#if __loongarch_grlen == 64 + GADD , d, PA0, PA0, K_LDA, PA1, PA1, K_LDA, PA2, PA2, K_LDA, PA3, PA3, K_LDA, \ + PA4, PA4, K_LDA, PA5, PA5, K_LDA, PA6, PA6, K_LDA, PA7, PA7, K_LDA +#elif __loongarch_grlen == 32 + GADD , w, PA0, PA0, K_LDA, PA1, PA1, K_LDA, PA2, PA2, K_LDA, PA3, PA3, K_LDA, \ + PA4, PA4, K_LDA, PA5, PA5, K_LDA, PA6, PA6, K_LDA, PA7, PA7, K_LDA +#else + GADD , d, PA0, PA0, K_LDA, PA1, PA1, K_LDA, PA2, PA2, K_LDA, PA3, PA3, K_LDA, \ + PA4, PA4, K_LDA, PA5, PA5, K_LDA, PA6, PA6, K_LDA, PA7, PA7, K_LDA +#endif + fst.d $f11, Y, 0x00 + fstx.d $f12, Y, INC_Y + fst.d $f13, PY0, 0x00 + fstx.d $f14, PY0, INC_Y + fst.d $f15, PY1, 0x00 + fstx.d $f16, PY1, INC_Y + fst.d $f17, PY2, 0x00 + fstx.d $f18, PY2, INC_Y + PTR_ALSL Y, INC_Y, Y, 3 + bnez J, .L_\XW\()_N_L8 +.L_\XW\()_N_7: + andi J, N, 7 + beqz J, .L_END + PTR_SUB K_LDA, LDA, M8 +.L_\XW\()_N_1: + ZERO_Y1 + move X, X_ORG + move I, M + beqz I, .L_END +.align 5 +.L_\XW\()_N_1_M_L1: + fld.d $f3, PA0, 0x00 + fld.d $f1, X, 0x00 + GCOMPLEXMADD GXCONJ1, GCONJ1, \ + xvf, s, TP0, A0, X0, TP0, TMP0, TMP1, TMP2 + PTR_ADDI I, I, -1 + PTR_ADD X, X, INC_X + PTR_ADDI PA0, PA0, 0x08 + bnez I, .L_\XW\()_N_1_M_L1 +.L_\XW\()_N_1_M_END: + PTR_ADDI J, J, -1 + fld.d $f3, Y, 0x00 + GCOMPLEXMADD GXCONJ2, GCONJ2, \ + xvf, s, A0, VALPHA, TP0, A0, TMP0, TMP1, TMP2 + fst.d $f3, Y, 0x00 + PTR_ADD PA0, PA0, K_LDA + PTR_ADD Y, Y, INC_Y + bnez J, .L_\XW\()_N_1 + + b .L_END +.endm + + PROLOGUE + PTR_LD INC_Y, $sp, 0 + push_if_used 17 + 8, 30 + PTR_ADDI K, $r0, 0x01 + PTR_SUB I, INC_X, K + maskeqz I, K, I /* if(inc_x == 1) I = 0; else I = 1; */ + GSLLI , d, LDA, LDA, 3, INC_X, INC_X, 3, INC_Y, INC_Y, 3, M8, M, 3 + // Init VALPHA + xvpackev.w $xr0, $xr1, $xr0 + xvreplve0.d VALPHA, $xr0 + move X_ORG, X + move PA0, A +#if __loongarch_grlen == 64 + GADD , d, PA1, PA0, LDA, PA2, PA1, LDA, PA3, PA2, LDA, PA4, PA3, LDA, \ + PA5, PA4, LDA, PA6, PA5, LDA, PA7, PA6, LDA +#elif __loongarch_grlen == 32 + GADD , w, PA1, PA0, LDA, PA2, PA1, LDA, PA3, PA2, LDA, PA4, PA3, LDA, \ + PA5, PA4, LDA, PA6, PA5, LDA, PA7, PA6, LDA +#else + GADD , d, PA1, PA0, LDA, PA2, PA1, LDA, PA3, PA2, LDA, PA4, PA3, LDA, \ + PA5, PA4, LDA, PA6, PA5, LDA, PA7, PA6, LDA +#endif + la.local T0, .L_GAP_TABLE + PTR_ALSL I, I, T0, 1 + ld.h K, I, 0 + PTR_ADD T0, T0, K + jirl $r0, T0, 0 +.L_GAP_TABLE: + .hword .L_GAP_0 - .L_GAP_TABLE + .hword .L_GAP_1 - .L_GAP_TABLE +.L_GAP_0: /* if (incx == 1) */ + CGEMV_T_LASX GAP_0, X8 +.L_GAP_1: /* if (incx != 1) */ + CGEMV_T_LASX GAP_1, X8_GAP +.L_END: + pop_if_used 17 + 8, 30 + jirl $r0, $r1, 0x0 + EPILOGUE diff --git a/kernel/loongarch64/loongarch64_asm.S b/kernel/loongarch64/loongarch64_asm.S index 694dcdaa9..fee46d63e 100644 --- a/kernel/loongarch64/loongarch64_asm.S +++ b/kernel/loongarch64/loongarch64_asm.S @@ -384,6 +384,246 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. .endif .endm +// +// GCOMPLEXACC: Complex accumulate the values of vector registers +// pre_op: xvf or vf, differentiate between LSX or LASX instruction +// suf_op: s or d, differentiate between single precision or double precision complex numbers +// Note: When "pre_op = xvf && suf_op = s", in will be modified. +// +.macro GCOMPLEXACC pre_op:req, suf_op:req, out:req, in:req, more:vararg +.ifeqs "\pre_op", "xvf" + xvpermi.q \out, \in, 0x01 +.ifeqs "\suf_op", "s" + \pre_op\()add.\suf_op \in, \out, \in + xvpackod.d \out, \in, \in + \pre_op\()add.\suf_op \out, \out, \in +.else + \pre_op\()add.\suf_op \out, \out, \in +.endif +.endif + +.ifeqs "\pre_op", "vf" +.ifeqs "\suf_op", "s" + vpackod.d \out, \in, \in + \pre_op\()add.\suf_op \out, \out, \in +.endif +.endif + +.ifnb \more + GCOMPLEXACC \pre_op, \suf_op, \more +.endif +.endm + +// +// GCOMPLEXMUL: Complex multiplication, out = in0 * in1 +// xconj: default value 0. +// if !(xconj) +// out_r = in0_r * in1_r - in0_i * in1_i; +// out_i = in0_r * in1_i + in0_i * in1_r; +// else +// out_r = in0_r * in1_r + in0_i * in1_i; +// out_i = in0_r * in1_i - in0_i * in1_r; +// pre_op: xvf or vf, differentiate between LSX or LASX instruction +// suf_op: s or d, differentiate between single precision or double precision complex numbers +// +.macro GCOMPLEXMUL xconj=0, pre_op:req, suf_op:req, out:req, in0:req, in1:req, tmp0:req, tmp1:req, tmp2:req, more:vararg +.ifeqs "\pre_op", "xvf" + xvxor.v \tmp1, \tmp1, \tmp1 +.ifeqs "\suf_op", "s" + xvpackev.w \tmp0, \in0, \in0 +.else + xvpackev.d \tmp0, \in0, \in0 +.endif +.else + vxor.v \tmp1, \tmp1, \tmp1 +.ifeqs "\suf_op", "s" + vpackev.w \tmp0, \in0, \in0 +.else + vpackev.d \tmp0, \in0, \in0 +.endif +.endif + + \pre_op\()sub.\suf_op \tmp1, \tmp1, \in0 + +.ifeqs "\pre_op", "xvf" +.ifeqs "\suf_op", "s" +.ifeqs "\xconj", "0" + xvpackod.w \tmp1, \in0, \tmp1 +.else + xvpackod.w \tmp1, \tmp1, \in0 +.endif + xvshuf4i.w \tmp2, \in1, 0xb1 +.else +.ifeqs "\xconj", "0" + xvpackod.d \tmp1, \in0, \tmp1 +.else + xvpackod.d \tmp1, \tmp1, \in0 +.endif + xvshuf4i.d \tmp2, \in1, 0x0b +.endif +.else +.ifeqs "\suf_op", "s" +.ifeqs "\xconj", "0" + vpackod.w \tmp1, \in0, \tmp1 +.else + vpackod.w \tmp1, \tmp1, \in0 +.endif + vshuf4i.w \tmp2, \in1, 0xb1 +.else +.ifeqs "\xconj", "0" + vpackod.d \tmp1, \in0, \tmp1 +.else + vpackod.d \tmp1, \tmp1, \in0 +.endif + vshuf4i.d \tmp2, \in1, 0x0b +.endif +.endif + + \pre_op\()mul.\suf_op \out, \tmp0, \in1 + \pre_op\()madd.\suf_op \out, \tmp1, \tmp2, \out + +.ifnb \more + GCOMPLEXMUL \xconj, \pre_op, \suf_op, \more +.endif +.endm + +// +// GCOMPLEXMADD: Complex multiply-accumulate, out = in0 * in1 + in2 +// xconj: default value 0 +// conj: default value 0 +// if !(CONJ) +// if !(XCONJ) +// out_r = in0_r * in1_r - in0_i * in1_i + in2_r; +// out_i = in0_r * in1_i + in0_i * in1_r + in2_i; +// else +// out_r = in0_r * in1_r + in0_i * in1_i + in2_r; +// out_i = in0_r * in1_i - in0_i * in1_r + in2_i; +// else +// if !(XCONJ) +// out_r = in0_r * in1_r + in0_i * in1_i + in2_r; +// out_i = in2_i - (in0_r * in1_i - in0_i * in1_r); +// else +// out_r = in0_r * in1_r - in0_i * in1_i + in2_r; +// out_i = in2_i - (in0_r * in1_i + in0_i * in1_r); +// pre_op: xvf or vf, differentiate between LSX or LASX instruction +// suf_op: s or d, differentiate between single precision or double precision complex numbers +// +.macro GCOMPLEXMADD xconj=0, conj=0, pre_op:req, suf_op:req, out:req, in0:req, in1:req, in2:req, tmp0:req, tmp1:req, tmp2:req, more:vararg +.ifeqs "\pre_op", "xvf" + xvxor.v \tmp1, \tmp1, \tmp1 +.ifeqs "\suf_op", "s" + xvpackev.w \tmp0, \in0, \in0 +.else + xvpackev.d \tmp0, \in0, \in0 +.endif +.else + vxor.v \tmp1, \tmp1, \tmp1 +.ifeqs "\suf_op", "s" + vpackev.w \tmp0, \in0, \in0 +.else + vpackev.d \tmp0, \in0, \in0 +.endif +.endif + + \pre_op\()madd.\suf_op \tmp2, \tmp0, \in1, \in2 +.ifeqs "\conj", "1" + \pre_op\()nmsub.\suf_op \tmp0, \tmp0, \in1, \in2 +.ifeqs "\pre_op", "xvf" +.ifeqs "\suf_op", "s" + xvshuf4i.w \tmp0, \tmp0, 0xb1 + xvpackev.w \out, \tmp0, \tmp2 +.else + xvshuf4i.d \tmp0, \tmp0, 0x0b + xvpackev.d \out, \tmp0, \tmp2 +.endif +.else +.ifeqs "\suf_op", "s" + vshuf4i.w \tmp0, \tmp0, 0xb1 + vpackev.w \out, \tmp0, \tmp2 +.else + vshuf4i.d \tmp0, \tmp0, 0x0b + vpackev.d \out, \tmp0, \tmp2 +.endif +.endif /* pre_op = xvf */ +.else + \pre_op\()add.\suf_op \out, \tmp2, \tmp1 +.endif /* conj = 1 */ + + \pre_op\()sub.\suf_op \tmp1, \tmp1, \in0 + +.ifeqs "\pre_op", "xvf" +.ifeqs "\suf_op", "s" +.ifeqs "\conj", "0" +.ifeqs "\xconj", "0" + xvpackod.w \tmp1, \in0, \tmp1 +.else + xvpackod.w \tmp1, \tmp1, \in0 +.endif +.else +.ifeqs "\xconj", "0" + xvpackod.w \tmp1, \in0, \in0 +.else + xvpackod.w \tmp1, \tmp1, \tmp1 +.endif +.endif + xvshuf4i.w \tmp2, \in1, 0xb1 +.else +.ifeqs "\conj", "0" +.ifeqs "\xconj", "0" + xvpackod.d \tmp1, \in0, \tmp1 +.else + xvpackod.d \tmp1, \tmp1, \in0 +.endif +.else +.ifeqs "\xconj", "0" + xvpackod.d \tmp1, \in0, \in0 +.else + xvpackod.d \tmp1, \tmp1, \tmp1 +.endif +.endif + xvshuf4i.d \tmp2, \in1, 0x0b +.endif +.else +.ifeqs "\suf_op", "s" +.ifeqs "\conj", "0" +.ifeqs "\xconj", "0" + vpackod.w \tmp1, \in0, \tmp1 +.else + vpackod.w \tmp1, \tmp1, \in0 +.endif +.else +.ifeqs "\xconj", "0" + vpackod.w \tmp1, \in0, \in0 +.else + vpackod.w \tmp1, \tmp1, \tmp1 +.endif +.endif + vshuf4i.w \tmp2, \in1, 0xb1 +.else +.ifeqs "\conj", "0" +.ifeqs "\xconj", "0" + vpackod.d \tmp1, \in0, \tmp1 +.else + vpackod.d \tmp1, \tmp1, \in0 +.endif +.else +.ifeqs "\xconj", "0" + vpackod.d \tmp1, \in0, \in0 +.else + vpackod.d \tmp1, \tmp1, \tmp1 +.endif +.endif + vshuf4i.d \tmp2, \in1, 0x0b +.endif +.endif + + \pre_op\()madd.\suf_op \out, \tmp1, \tmp2, \out + +.ifnb \more + GCOMPLEXMADD \xconj, \conj, \pre_op, \suf_op, \more +.endif +.endm + // // Media Related Macros // From 990507e3b8f833de26da1b2ab6dff0972ae65c3f Mon Sep 17 00:00:00 2001 From: gxw Date: Thu, 22 Feb 2024 11:41:15 +0800 Subject: [PATCH 163/311] LoongArch64: Opt zgemv with LASX --- kernel/loongarch64/KERNEL.LOONGSON3R5 | 3 + kernel/loongarch64/zgemv_n_4_lasx.S | 343 ++++++++++++++++++++++++++ kernel/loongarch64/zgemv_t_4_lasx.S | 299 ++++++++++++++++++++++ 3 files changed, 645 insertions(+) create mode 100644 kernel/loongarch64/zgemv_n_4_lasx.S create mode 100644 kernel/loongarch64/zgemv_t_4_lasx.S diff --git a/kernel/loongarch64/KERNEL.LOONGSON3R5 b/kernel/loongarch64/KERNEL.LOONGSON3R5 index 3b2ee6e55..9b55d1bbb 100644 --- a/kernel/loongarch64/KERNEL.LOONGSON3R5 +++ b/kernel/loongarch64/KERNEL.LOONGSON3R5 @@ -139,6 +139,9 @@ ZGEMMITCOPYOBJ = zgemm_itcopy$(TSUFFIX).$(SUFFIX) ZGEMMONCOPYOBJ = zgemm_oncopy$(TSUFFIX).$(SUFFIX) ZGEMMOTCOPYOBJ = zgemm_otcopy$(TSUFFIX).$(SUFFIX) +ZGEMVNKERNEL = zgemv_n_4_lasx.S +ZGEMVTKERNEL = zgemv_t_4_lasx.S + ZTRSMKERNEL_LN = ../generic/trsm_kernel_LN.c ZTRSMKERNEL_LT = ../generic/trsm_kernel_LT.c ZTRSMKERNEL_RN = ../generic/trsm_kernel_RN.c diff --git a/kernel/loongarch64/zgemv_n_4_lasx.S b/kernel/loongarch64/zgemv_n_4_lasx.S new file mode 100644 index 000000000..98b1a6f7d --- /dev/null +++ b/kernel/loongarch64/zgemv_n_4_lasx.S @@ -0,0 +1,343 @@ +/******************************************************************************* +Copyright (c) 2024, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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. +*******************************************************************************/ +#define ASSEMBLER + +#include "common.h" +#include "loongarch64_asm.S" + +/********************************************************************* +* 2024/02/20 guxiwei +* UTEST : OK +* CTEST : OK +* TEST : OK +* +* +*********************************************************************/ + +/* int CNAME(BLASLONG m, BLASLONG n, BLASLONG dummy1, FLOAT alpha_r, FLOAT alpha_i, + * FLOAT *a, BLASLONG lda, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y, FLOAT *buffer) + */ +#define M $r4 +#define N $r5 +#define ALPHA_R $f0 +#define ALPHA_I $f1 +#define A $r7 +#define LDA $r8 +#define X $r9 +#define INC_X $r10 +#define Y $r11 +#define INC_Y $r6 + +#define J $r12 +#define I $r13 +#define K $r14 +#define Y_ORG $r15 +#define OFFSET $r16 +#define K_LDA $r17 +#define M16 $r18 +#define T0 $r19 +#define PA0 $r20 +#define PA1 $r23 +#define PA2 $r24 +#define PA3 $r25 +#define PA4 $r26 +#define PA5 $r27 +#define PA6 $r28 +#define PA7 $r29 + +#define VALPHA $xr1 +#define X0 $xr2 +#define X1 $xr3 +#define X2 $xr4 +#define X3 $xr5 +#define X4 $xr6 +#define X5 $xr7 +#define X6 $xr8 +#define X7 $xr9 +#define Y0 $xr10 +#define Y1 $xr11 +#define A0 $xr12 +#define A1 $xr13 +#define A2 $xr14 +#define A3 $xr15 +#define A4 $xr16 +#define A5 $xr17 +#define A6 $xr18 +#define A7 $xr19 +#define A8 $xr20 +#define A9 $xr21 +#define A10 $xr22 +#define A11 $xr23 +#define A12 $xr24 +#define A13 $xr25 +#define A14 $xr26 +#define A15 $xr27 +#define TMP0 $xr28 +#define TMP1 $xr29 +#define TMP2 $xr30 + +#if !defined(CONJ) +#if !defined(XCONJ) +#define GXCONJ 0 +#define GCONJ 0 +#else +#define GXCONJ 1 +#define GCONJ 0 +#endif +#else +#if !defined(XCONJ) +#define GXCONJ 0 +#define GCONJ 1 +#else +#define GXCONJ 1 +#define GCONJ 1 +#endif +#endif + +.macro ZLOAD_X_4 + GLD xv, , X0, X, 0x00, X1, X, 0x10, X2, X, 0x20, X3, X, 0x30 + GPERMI xv, q, X0, X0, 0, X1, X1, 0, X2, X2, 0, X3, X3, 0 + GCOMPLEXMUL GXCONJ, \ + xvf, d, X0, X0, VALPHA, TMP0, TMP1, TMP2, \ + X1, X1, VALPHA, TMP0, TMP1, TMP2, \ + X2, X2, VALPHA, TMP0, TMP1, TMP2, \ + X3, X3, VALPHA, TMP0, TMP1, TMP2 +.endm + +.macro ZLOAD_X_4_GAP + xvld X0, X, 0 + xvpermi.q X0, X0, 0 + + PTR_ADD T0, X, INC_X + xvld X1, T0, 0 + xvpermi.q X1, X1, 0 + + PTR_ADD T0, T0, INC_X + xvld X2, T0, 0 + xvpermi.q X2, X2, 0 + + PTR_ADD T0, T0, INC_X + xvld X3, T0, 0 + xvpermi.q X3, X3, 0 + + GCOMPLEXMUL GXCONJ, \ + xvf, d, X0, X0, VALPHA, TMP0, TMP1, TMP2, \ + X1, X1, VALPHA, TMP0, TMP1, TMP2, \ + X2, X2, VALPHA, TMP0, TMP1, TMP2, \ + X3, X3, VALPHA, TMP0, TMP1, TMP2 +.endm + +.macro ZLOAD_Y_4 + GLD xv, , Y0, Y, 0, Y1, Y, 0x20 +.endm + +.macro ZLOAD_Y_4_GAP + vld $vr10, Y, 0 + vldx $vr13, Y, INC_Y + PTR_ALSL T0, INC_Y, Y, 1 + vld $vr11, T0, 0 + vldx $vr14, T0, INC_Y + GPERMI xv, q, Y0, A1, 0x02, Y1, A2, 0x02 +.endm + +.macro ZGEMV_N_4x4 + GLD_INC xv, , 0x20, \ + A0, PA0, 0, A1, PA0, 0, \ + A2, PA1, 0, A3, PA1, 0, \ + A4, PA2, 0, A5, PA2, 0, \ + A6, PA3, 0, A7, PA3, 0 + GCOMPLEXMADD GXCONJ, GCONJ, \ + xvf, d, Y0, X0, A0, Y0, TMP0, TMP1, TMP2, Y1, X0, A1, Y1, TMP0, TMP1, TMP2, \ + Y0, X1, A2, Y0, TMP0, TMP1, TMP2, Y1, X1, A3, Y1, TMP0, TMP1, TMP2, \ + Y0, X2, A4, Y0, TMP0, TMP1, TMP2, Y1, X2, A5, Y1, TMP0, TMP1, TMP2, \ + Y0, X3, A6, Y0, TMP0, TMP1, TMP2, Y1, X3, A7, Y1, TMP0, TMP1, TMP2 +.endm + +.macro ZSTORE_Y_4 + GST xv, , Y0, Y, 0, Y1, Y, 0x20 +.endm + +.macro ZSTORE_Y_4_GAP + xvstelm.d Y0, Y, 0, 0 + xvstelm.d Y0, Y, 0x08, 1 + PTR_ADD T0, Y, INC_Y + xvstelm.d Y0, T0, 0, 2 + xvstelm.d Y0, T0, 0x08, 3 + PTR_ADD T0, T0, INC_Y + xvstelm.d Y1, T0, 0, 0 + xvstelm.d Y1, T0, 0x08, 1 + PTR_ADD T0, T0, INC_Y + xvstelm.d Y1, T0, 0, 2 + xvstelm.d Y1, T0, 0x08, 3 +.endm + +.macro ZLOAD_Y_1 + vld $vr10, Y, 0 +.endm + +.macro ZGEMV_N_1x4 + GLD_INC v, , 0x10, $vr12, PA0, 0, $vr14, PA1, 0, $vr16, PA2, 0, $vr18, PA3, 0 + GCOMPLEXMADD GXCONJ, GCONJ, \ + xvf, d, Y0, X0, A0, Y0, TMP0, TMP1, TMP2, \ + Y0, X1, A2, Y0, TMP0, TMP1, TMP2, \ + Y0, X2, A4, Y0, TMP0, TMP1, TMP2, \ + Y0, X3, A6, Y0, TMP0, TMP1, TMP2 +.endm + +.macro ZSTORE_Y_1 + vst $vr10, Y, 0 +.endm + +.macro ZLOAD_X_1 + GLD xv, , X0, X, 0x00 + GPERMI xv, q, X0, X0, 0 + GCOMPLEXMUL GXCONJ, \ + xvf, d, X0, X0, VALPHA, TMP0, TMP1, TMP2 +.endm + +.macro ZGEMV_N_1x1 + GLD_INC v, , 0x10, $vr12, PA0, 0 + GCOMPLEXMADD GXCONJ, GCONJ, \ + xvf, d, Y0, X0, A0, Y0, TMP0, TMP1, TMP2 +.endm + +.macro ZGEMV_N_LASX XW:req, X_4:req, X_1:req, Y_4:req, Y_1:req + PTR_SRLI J, N, 2 + beqz J, .L_\XW\()_N_3 + PTR_SLLI K_LDA, LDA, 2 + PTR_SUB K_LDA, K_LDA, M16 +.L_\XW\()_N_L4: + ZLOAD_\X_4 + xor K, K, K + move Y, Y_ORG + PTR_SRLI I, M, 2 + beqz I, .L_\XW\()_M_3 +.align 5 +.L_\XW\()_M_L4: + ZLOAD_\Y_4 + ZGEMV_N_4x4 + ZSTORE_\Y_4 + PTR_ADDI I, I, -1 + PTR_ALSL Y, INC_Y, Y, 2 + PTR_ADDI K, K, 4 + bnez I, .L_\XW\()_M_L4 +.L_\XW\()_M_3: + andi I, M, 3 + beqz I, .L_\XW\()_M_END +.align 5 +.L_\XW\()_M_L1: + ZLOAD_\Y_1 + ZGEMV_N_1x4 + ZSTORE_\Y_1 + PTR_ADDI I, I, -1 + PTR_ADD Y, Y, INC_Y + PTR_ADDI K, K, 1 + bnez I, .L_\XW\()_M_L1 +.L_\XW\()_M_END: + PTR_ADDI J, J, -1 +#if __loongarch_grlen == 64 + GADD , d, PA0, PA0, K_LDA, PA1, PA1, K_LDA, PA2, PA2, K_LDA, PA3, PA3, K_LDA +#elif __loongarch_grlen == 32 + GADD , w, PA0, PA0, K_LDA, PA1, PA1, K_LDA, PA2, PA2, K_LDA, PA3, PA3, K_LDA +#else + GADD , d, PA0, PA0, K_LDA, PA1, PA1, K_LDA, PA2, PA2, K_LDA, PA3, PA3, K_LDA +#endif + PTR_ALSL X, INC_X, X, 2 + bnez J, .L_\XW\()_N_L4 +.L_\XW\()_N_3: + andi J, N, 3 + beqz J, .L_END +.L_\XW\()_N_L1: + ZLOAD_\X_1 + xor K, K, K + move Y, Y_ORG + move I, M + beqz I, .L_END +.align 5 +.L_\XW\()_N_1_M_L1: + ZLOAD_\Y_1 + ZGEMV_N_1x1 + ZSTORE_\Y_1 + PTR_ADDI I, I, -1 + PTR_ADD Y, Y, INC_Y + PTR_ADDI K, K, 1 + bnez I, .L_\XW\()_N_1_M_L1 +.L_\XW\()_N_1_M_END: + PTR_ADDI J, J, -1 + PTR_SUB K_LDA, LDA, M16 + PTR_ADD PA0, PA0, K_LDA + PTR_ADD X, X, INC_X + bnez J, .L_\XW\()_N_L1 + + b .L_END +.endm + + PROLOGUE + PTR_LD INC_Y, $sp, 0 + push_if_used 17 + 7, 31 + PTR_ADDI K, $r0, 0x01 + PTR_SUB I, INC_X, K + PTR_SUB J, INC_Y, K + maskeqz I, K, I /* if(inc_x == 1) I = 0; else I = 1; */ + maskeqz J, K, J /* if(inc_y == 1) j = 0; else j = 1; */ + PTR_ALSL I, I, J, 1 + GSLLI , d, LDA, LDA, 4, INC_X, INC_X, 4, INC_Y, INC_Y, 4, M16, M, 4 + // Init VALPHA + xvpackev.d $xr0, $xr1, $xr0 + xvreplve0.q VALPHA, $xr0 + move Y_ORG, Y + move PA0, A +#if __loongarch_grlen == 64 + GADD , d, PA1, PA0, LDA, PA2, PA1, LDA, PA3, PA2, LDA +#elif __loongarch_grlen == 32 + GADD , w, PA1, PA0, LDA, PA2, PA1, LDA, PA3, PA2, LDA +#else + GADD , d, PA1, PA0, LDA, PA2, PA1, LDA, PA3, PA2, LDA +#endif + la.local T0, .L_GAP_TABLE + PTR_ALSL I, I, T0, 1 + ld.h K, I, 0 // Obtain the offset address + PTR_ADD T0, T0, K + jirl $r0, T0, 0 +.L_GAP_TABLE: + .hword .L_GAP_0_0 - .L_GAP_TABLE + .hword .L_GAP_0_1 - .L_GAP_TABLE + .hword .L_GAP_1_0 - .L_GAP_TABLE + .hword .L_GAP_1_1 - .L_GAP_TABLE +.L_GAP_0_0: /* if (inc_x == 1) && (incy == 1) */ + ZGEMV_N_LASX GAP_0_0, X_4, X_1, Y_4, Y_1 +.L_GAP_0_1: /* if (inc_x == 1) && (incy != 1) */ + ZGEMV_N_LASX GAP_0_1, X_4, X_1, Y_4_GAP, Y_1 +.L_GAP_1_0: /* if (inc_x != 1) && (incy == 1) */ + ZGEMV_N_LASX GAP_1_0, X_4_GAP, X_1, Y_4, Y_1 +.L_GAP_1_1: /* if (inc_x != 1) && (incy != 1) */ + ZGEMV_N_LASX GAP_1_1, X_4_GAP, X_1, Y_4_GAP, Y_1 +.L_END: + pop_if_used 17 + 7, 31 + jirl $r0, $r1, 0x0 + EPILOGUE + diff --git a/kernel/loongarch64/zgemv_t_4_lasx.S b/kernel/loongarch64/zgemv_t_4_lasx.S new file mode 100644 index 000000000..4d33b8f96 --- /dev/null +++ b/kernel/loongarch64/zgemv_t_4_lasx.S @@ -0,0 +1,299 @@ +/******************************************************************************* +Copyright (c) 2024, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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. +*******************************************************************************/ +#define ASSEMBLER + +#include "common.h" +#include "loongarch64_asm.S" + +/********************************************************************* +* 2024/02/20 guxiwei +* UTEST : OK +* CTEST : OK +* TEST : OK +* +* +*********************************************************************/ + +/* int CNAME(BLASLONG m, BLASLONG n, BLASLONG dummy1, FLOAT alpha_r, FLOAT alpha_i, + * FLOAT *a, BLASLONG lda, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y, FLOAT *buffer) + */ +#define M $r4 +#define N $r5 +#define ALPHA_R $f0 +#define ALPHA_I $f1 +#define A $r7 +#define LDA $r8 +#define X $r9 +#define INC_X $r10 +#define Y $r11 +#define INC_Y $r6 + +#define J $r12 +#define I $r13 +#define K $r14 +#define PY0 $r14 +#define X_ORG $r15 +#define PY1 $r16 +#define K_LDA $r17 +#define PY2 $r18 +#define T0 $r19 +#define PA0 $r20 +#define PA1 $r23 +#define PA2 $r24 +#define PA3 $r25 +#define PA4 $r26 +#define PA5 $r27 +#define PA6 $r28 +#define PA7 $r29 +#define M16 $r30 + +#define VALPHA $xr0 +#define X0 $xr1 +#define X1 $xr2 +#define A0 $xr3 +#define A1 $xr4 +#define A2 $xr5 +#define A3 $xr6 +#define A4 $xr7 +#define A5 $xr8 +#define A6 $xr9 +#define A7 $xr10 +#define A8 $xr11 +#define A9 $xr12 +#define A10 $xr13 +#define A11 $xr14 +#define A12 $xr15 +#define A13 $xr16 +#define A14 $xr17 +#define A15 $xr18 +#define TP0 $xr19 +#define TP1 $xr20 +#define TP2 $xr21 +#define TP3 $xr22 +#define TP4 $xr23 +#define TP5 $xr24 +#define TP6 $xr25 +#define TP7 $xr26 +#define TMP0 $xr27 +#define TMP1 $xr28 +#define TMP2 $xr29 +#define Y0 $xr3 +#define Y1 $xr4 +#define Y2 $xr5 +#define Y3 $xr6 +#define Y4 $xr7 +#define Y5 $xr8 +#define Y6 $xr9 +#define Y7 $xr10 + +#if ( !defined(CONJ) && !defined(XCONJ) ) || ( defined(CONJ) && defined(XCONJ) ) +#define GXCONJ1 0 +#define GCONJ1 0 +#else +#define GXCONJ1 1 +#define GCONJ1 0 +#endif + +#if !defined(XCONJ) +#define GXCONJ2 0 +#define GCONJ2 0 +#else +#define GXCONJ2 0 +#define GCONJ2 1 +#endif + +.macro ZERO_Y4 + GXOR xv, v, TP0, TP0, TP0, TP1, TP1, TP1, TP2, TP2, TP2, TP3, TP3, TP3 +.endm + +.macro ZERO_Y1 + GXOR xv, v, TP0, TP0, TP0 +.endm + +.macro ZLOAD_X4 + GLD xv, , X0, X, 0x00, X1, X, 0x20 +.endm + +.macro ZLOAD_X4_GAP + xvld X0, X, 0 + + PTR_ADD T0, X, INC_X + xvld A0, T0, 0 + xvpermi.q X0, A0, 0x02 + + PTR_ADD T0, T0, INC_X + xvld X1, T0, 0 + + PTR_ADD T0, T0, INC_X + xvld A0, T0, 0 + xvpermi.q X1, A0, 0x02 +.endm + +.macro ZGEMV_T_4x4 + GLD_INC xv, , 0x20, \ + A0, PA0, 0, A1, PA0, 0, \ + A2, PA1, 0, A3, PA1, 0, \ + A4, PA2, 0, A5, PA2, 0, \ + A6, PA3, 0, A7, PA3, 0 + GCOMPLEXMADD GXCONJ1, GCONJ1, \ + xvf, d, TP0, A0, X0, TP0, TMP0, TMP1, TMP2, TP0, A1, X1, TP0, TMP0, TMP1, TMP2, \ + TP1, A2, X0, TP1, TMP0, TMP1, TMP2, TP1, A3, X1, TP1, TMP0, TMP1, TMP2, \ + TP2, A4, X0, TP2, TMP0, TMP1, TMP2, TP2, A5, X1, TP2, TMP0, TMP1, TMP2, \ + TP3, A6, X0, TP3, TMP0, TMP1, TMP2, TP3, A7, X1, TP3, TMP0, TMP1, TMP2 +.endm + +.macro ZGEMV_T_LASX XW:req, X4:req + PTR_SRLI J, N, 2 + beqz J, .L_\XW\()_N_3 + PTR_SLLI K_LDA, LDA, 2 + PTR_SUB K_LDA, K_LDA, M16 +.L_\XW\()_N_L4: + ZERO_Y4 + move X, X_ORG + PTR_SRLI I, M, 2 + beqz I, .L_\XW\()_M_3 +.align 5 +.L_\XW\()_M_L4: + ZLOAD_\X4 + ZGEMV_T_4x4 + PTR_ADDI I, I, -1 + PTR_ALSL X, INC_X, X, 2 + bnez I, .L_\XW\()_M_L4 +.L_\XW\()_M_3: + // Accumulated + GCOMPLEXACC xvf, d, Y0, TP0, Y1, TP1, Y2, TP2, Y3, TP3 + andi I, M, 3 + beqz I, .L_\XW\()_M_END +.align 5 +.L_\XW\()_M_L1: + GLD xv, , X0, X, 0x00, A8, PA0, 0x00, A9, PA1, 0x00, A10, PA2, 0x00, A11, PA3, 0x00 +#if __loongarch_grlen == 64 + GADDI , d, PA0, PA0, 0x10, PA1, PA1, 0x10, PA2, PA2, 0x10, PA3, PA3, 0x10 +#elif __loongarch_grlen == 32 + GADDI , w, PA0, PA0, 0x10, PA1, PA1, 0x10, PA2, PA2, 0x10, PA3, PA3, 0x10 +#else + GADDI , d, PA0, PA0, 0x10, PA1, PA1, 0x10, PA2, PA2, 0x10, PA3, PA3, 0x10 +#endif + + GCOMPLEXMADD GXCONJ1, GCONJ1, \ + xvf, d, A0, A8, X0, A0, TMP0, TMP1, TMP2, A1, A9, X0, A1, TMP0, TMP1, TMP2, \ + A2, A10, X0, A2, TMP0, TMP1, TMP2, A3, A11, X0, A3, TMP0, TMP1, TMP2 + + PTR_ADDI I, I, -1 + PTR_ADD X, X, INC_X + bnez I, .L_\XW\()_M_L1 +.L_\XW\()_M_END: + xvld A8, Y, 0x00 + xvldx A9, Y, INC_Y + PTR_ALSL PY0, INC_Y, Y, 1 + xvld A10, PY0, 0x00 + xvldx A11, PY0, INC_Y + + GCOMPLEXMADD GXCONJ2, GCONJ2, \ + xvf, d, A8, VALPHA, A0, A8, TMP0, TMP1, TMP2, A9, VALPHA, A1, A9, TMP0, TMP1, TMP2,\ + A10, VALPHA, A2, A10, TMP0, TMP1, TMP2, A11, VALPHA, A3, A11, TMP0, TMP1, TMP2 + + PTR_ADDI J, J, -1 +#if __loongarch_grlen == 64 + GADD , d, PA0, PA0, K_LDA, PA1, PA1, K_LDA, PA2, PA2, K_LDA, PA3, PA3, K_LDA +#elif __loongarch_grlen == 32 + GADD , w, PA0, PA0, K_LDA, PA1, PA1, K_LDA, PA2, PA2, K_LDA, PA3, PA3, K_LDA +#else + GADD , d, PA0, PA0, K_LDA, PA1, PA1, K_LDA, PA2, PA2, K_LDA, PA3, PA3, K_LDA +#endif + vst $vr11, Y, 0x00 + vstx $vr12, Y, INC_Y + vst $vr13, PY0, 0x00 + vstx $vr14, PY0, INC_Y + PTR_ALSL Y, INC_Y, Y, 2 + bnez J, .L_\XW\()_N_L4 +.L_\XW\()_N_3: + andi J, N, 3 + beqz J, .L_END + PTR_SUB K_LDA, LDA, M16 +.L_\XW\()_N_1: + ZERO_Y1 + move X, X_ORG + move I, M + beqz I, .L_END +.align 5 +.L_\XW\()_N_1_M_L1: + GLD xv, , A0, PA0, 0x00, X0, X, 0x00 + GCOMPLEXMADD GXCONJ1, GCONJ1, \ + xvf, d, TP0, A0, X0, TP0, TMP0, TMP1, TMP2 + PTR_ADDI I, I, -1 + PTR_ADD X, X, INC_X + PTR_ADDI PA0, PA0, 0x10 + bnez I, .L_\XW\()_N_1_M_L1 +.L_\XW\()_N_1_M_END: + PTR_ADDI J, J, -1 + xvld A0, Y, 0x00 + GCOMPLEXMADD GXCONJ2, GCONJ2, \ + xvf, d, A0, VALPHA, TP0, A0, TMP0, TMP1, TMP2 + vst $vr3, Y, 0x00 + PTR_ADD PA0, PA0, K_LDA + PTR_ADD Y, Y, INC_Y + bnez J, .L_\XW\()_N_1 + + b .L_END +.endm + + PROLOGUE + PTR_LD INC_Y, $sp, 0 + push_if_used 17 + 8, 30 + PTR_ADDI K, $r0, 0x01 + PTR_SUB I, INC_X, K + maskeqz I, K, I /* if(inc_x == 1) I = 0; else I = 1; */ + GSLLI , d, LDA, LDA, 4, INC_X, INC_X, 4, INC_Y, INC_Y, 4, M16, M, 4 + // Init VALPHA + xvpackev.d $xr0, $xr1, $xr0 + xvreplve0.q VALPHA, $xr0 + move X_ORG, X + move PA0, A +#if __loongarch_grlen == 64 + GADD , d, PA1, PA0, LDA, PA2, PA1, LDA, PA3, PA2, LDA, PA4, PA3, LDA +#elif __loongarch_grlen == 32 + GADD , w, PA1, PA0, LDA, PA2, PA1, LDA, PA3, PA2, LDA, PA4, PA3, LDA +#else + GADD , d, PA1, PA0, LDA, PA2, PA1, LDA, PA3, PA2, LDA, PA4, PA3, LDA +#endif + la.local T0, .L_GAP_TABLE + PTR_ALSL I, I, T0, 1 + ld.h K, I, 0 + PTR_ADD T0, T0, K + jirl $r0, T0, 0 +.L_GAP_TABLE: + .hword .L_GAP_0 - .L_GAP_TABLE + .hword .L_GAP_1 - .L_GAP_TABLE +.L_GAP_0: /* if (incx == 1) */ + ZGEMV_T_LASX GAP_0, X4 +.L_GAP_1: /* if (incx != 1) */ + ZGEMV_T_LASX GAP_1, X4_GAP +.L_END: + pop_if_used 17 + 8, 30 + jirl $r0, $r1, 0x0 + EPILOGUE From 892f8ff3e55e24fda9af3f6364319cce3f60116b Mon Sep 17 00:00:00 2001 From: Ayappan Perumal Date: Thu, 22 Feb 2024 07:05:37 -0600 Subject: [PATCH 164/311] Shared library support for AIX --- Makefile | 3 +++ Makefile.system | 4 ---- exports/Makefile | 18 ++++++++++++++++++ 3 files changed, 21 insertions(+), 4 deletions(-) diff --git a/Makefile b/Makefile index b344abcd2..19bab2915 100644 --- a/Makefile +++ b/Makefile @@ -152,6 +152,9 @@ endif ifeq ($(OSNAME), CYGWIN_NT) @$(MAKE) -C exports dll endif +ifeq ($(OSNAME), AIX) + @$(MAKE) -C exports so +endif endif tests : shared diff --git a/Makefile.system b/Makefile.system index 0088eaff5..f7ccc7746 100644 --- a/Makefile.system +++ b/Makefile.system @@ -1707,11 +1707,7 @@ endif LIBDLLNAME = $(LIBPREFIX).dll IMPLIBNAME = lib$(LIBNAMEBASE).dll.a -ifneq ($(OSNAME), AIX) LIBSONAME = $(LIBNAME:.$(LIBSUFFIX)=.so) -else -LIBSONAME = $(LIBNAME:.$(LIBSUFFIX)=.a) -endif LIBDYNNAME = $(LIBNAME:.$(LIBSUFFIX)=.dylib) LIBDEFNAME = $(LIBNAME:.$(LIBSUFFIX)=.def) LIBEXPNAME = $(LIBNAME:.$(LIBSUFFIX)=.exp) diff --git a/exports/Makefile b/exports/Makefile index 7682f851d..cf948ccb2 100644 --- a/exports/Makefile +++ b/exports/Makefile @@ -73,6 +73,10 @@ endif endif endif +ifeq ($(F_COMPILER)$(OSNAME), IBMAIX) +EXTRALIB += -lxlf90 +endif + ifeq ($(C_COMPILER), PGI) EXTRALIB += -pgf90libs endif @@ -248,6 +252,20 @@ endif ifeq ($(OSNAME), AIX) +so : ../$(LIBSONAME) linktest.c + $(CC) $(CFLAGS) $(LDFLAGS) -w -o linktest linktest.c ../$(LIBSONAME) $(EXTRALIB) && echo OK. + rm -f linktest + +../$(LIBSONAME) : aix.exp + $(CC) $(CFLAGS) $(LDFLAGS) -shared -o ../$(LIBSONAME) \ + -Wl,-bE:aix.exp -Wl,-bbigtoc ../$(LIBNAME) $(EXTRALIB) + +aix.exp : + /usr/bin/nm -X32_64 -PCpgl ../$(LIBNAME) | /usr/bin/awk '{ if ((($$ 2 == "T") \ + || ($$ 2 == "D") || ($$ 2 == "B") || ($$ 2 == "W") || ($$ 2 == "V") || ($$ 2 == "Z")) && (substr($$ 1,1,1) != ".")) \ + { if (($$ 2 == "W") || ($$ 2 == "V") || ($$ 2 == "Z")) { print $$ 1 " weak" } else { print $$ 1 } } }' | \ + /usr/bin/sort -u > aix.exp + ifeq ($(COMPILER_F77), xlf) goto32.$(SUFFIX) : ../$(LIBNAME) aix.def From 82b81c0bbee5d1344dcd2fb0f50cba6a7c0ded9f Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Thu, 22 Feb 2024 22:11:50 +0100 Subject: [PATCH 165/311] Dont fail if there is no Fortran compiler --- cmake/f_check.cmake | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/cmake/f_check.cmake b/cmake/f_check.cmake index df3a4858d..4c4f5ac04 100644 --- a/cmake/f_check.cmake +++ b/cmake/f_check.cmake @@ -64,6 +64,7 @@ else () "#define NEEDBUNDERSCORE 1\n") endif() +if (CMAKE_Fortran_COMPILER) get_filename_component(F_COMPILER ${CMAKE_Fortran_COMPILER} NAME_WE) string(TOUPPER ${F_COMPILER} F_COMPILER) - +endif() From 8fc2c2db043eda5e415c1673779c8bdcd91870fd Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Thu, 22 Feb 2024 22:14:13 +0100 Subject: [PATCH 166/311] Fix missing support for INTERFACE64 on ARM64 and MIPS64 --- cmake/fc.cmake | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/cmake/fc.cmake b/cmake/fc.cmake index 5c30be843..bc85a2921 100644 --- a/cmake/fc.cmake +++ b/cmake/fc.cmake @@ -6,9 +6,6 @@ if (${F_COMPILER} STREQUAL "FLANG" AND NOT CMAKE_Fortran_COMPILER_ID STREQUAL "LLVMFlang") # This is for classic Flang. LLVM Flang is handled with gfortran below. set(CCOMMON_OPT "${CCOMMON_OPT} -DF_INTERFACE_FLANG") - if (BINARY64 AND INTERFACE64) - set(FCOMMON_OPT "${FCOMMON_OPT} -i8") - endif () if (USE_OPENMP) set(FCOMMON_OPT "${FCOMMON_OPT} -fopenmp") endif () @@ -55,6 +52,9 @@ if (${F_COMPILER} STREQUAL "GFORTRAN" OR ${F_COMPILER} STREQUAL "F95" OR CMAKE_F if (MIPS64) if (BINARY64) set(FCOMMON_OPT "${FCOMMON_OPT} -mabi=64") + if (INTERFACE64) + set(FCOMMON_OPT "${FCOMMON_OPT} -fdefault-integer-8") + endif () else () set(FCOMMON_OPT "${FCOMMON_OPT} -mabi=n32") endif () @@ -83,6 +83,9 @@ if (${F_COMPILER} STREQUAL "GFORTRAN" OR ${F_COMPILER} STREQUAL "F95" OR CMAKE_F endif () endif () endif () + if (ARM64 AND INTERFACE64) + set(FCOMMON_OPT "${FCOMMON_OPT} -fdefault-integer-8") + endif () else () if (BINARY64) set(FCOMMON_OPT "${FCOMMON_OPT} -m64") From 3516fff378cf5d9153d18c86d9a117b0976e777d Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Thu, 22 Feb 2024 22:15:28 +0100 Subject: [PATCH 167/311] Avoid linking both libgomp and libomp in mixed clang/gfortran builds --- ctest/CMakeLists.txt | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/ctest/CMakeLists.txt b/ctest/CMakeLists.txt index 91338b73b..6e0a7f309 100644 --- a/ctest/CMakeLists.txt +++ b/ctest/CMakeLists.txt @@ -40,6 +40,10 @@ else() c_${float_char}blas1.c) endif() target_link_libraries(x${float_char}cblat1 ${OpenBLAS_LIBNAME}) + if (USE_OPENMP AND (${CMAKE_Fortran_COMPILER_ID} STREQUAL GNU) AND (${CMAKE_C_COMPILER_ID} STREQUAL Clang)) + string(REGEX REPLACE "-fopenmp" "" CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS}") + target_link_libraries(x${float_char}cblat1 omp pthread) + endif() if(${CMAKE_SYSTEM_NAME} MATCHES "Linux" OR ${CMAKE_SYSTEM_NAME} MATCHES "FreeBSD" OR ${CMAKE_SYSTEM_NAME} MATCHES "QNX") target_link_libraries(x${float_char}cblat1 m) endif() @@ -65,6 +69,10 @@ else() constant.c) endif() target_link_libraries(x${float_char}cblat2 ${OpenBLAS_LIBNAME}) + if (USE_OPENMP AND (${CMAKE_Fortran_COMPILER_ID} STREQUAL GNU) AND (${CMAKE_C_COMPILER_ID} STREQUAL Clang)) + string(REGEX REPLACE "-fopenmp" "" CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS}") + target_link_libraries(x${float_char}cblat2 omp pthread) + endif() if(${CMAKE_SYSTEM_NAME} MATCHES "Linux" OR ${CMAKE_SYSTEM_NAME} MATCHES "FreeBSD" OR ${CMAKE_SYSTEM_NAME} MATCHES "QNX") target_link_libraries(x${float_char}cblat2 m) endif() @@ -90,6 +98,10 @@ else() constant.c) endif() target_link_libraries(x${float_char}cblat3 ${OpenBLAS_LIBNAME}) + if (USE_OPENMP AND (${CMAKE_Fortran_COMPILER_ID} STREQUAL GNU) AND (${CMAKE_C_COMPILER_ID} STREQUAL Clang)) + string(REGEX REPLACE "-fopenmp" "" CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS}") + target_link_libraries(x${float_char}cblat3 omp pthread) + endif() if(${CMAKE_SYSTEM_NAME} MATCHES "Linux" OR ${CMAKE_SYSTEM_NAME} MATCHES "FreeBSD" OR ${CMAKE_SYSTEM_NAME} MATCHES "QNX") target_link_libraries(x${float_char}cblat3 m) endif() From 4adfe4d53185233bfbeeb362734a2d80814d4457 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Thu, 22 Feb 2024 22:16:01 +0100 Subject: [PATCH 168/311] Avoid linking both libgomp and libomp in mixed clang/gfortran builds --- test/CMakeLists.txt | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/test/CMakeLists.txt b/test/CMakeLists.txt index d68b12d87..ace20dffc 100644 --- a/test/CMakeLists.txt +++ b/test/CMakeLists.txt @@ -21,10 +21,14 @@ endif() if (BUILD_COMPLEX16) list (APPEND OpenBLAS_Tests zblat1 zblat2 zblat3) endif() - +message (STATUS CCOMP ${CMAKE_C_COMPILER_ID} FCOMP ${CMAKE_Fortran_COMPILER_ID}) foreach(test_bin ${OpenBLAS_Tests}) add_executable(${test_bin} ${test_bin}.f) target_link_libraries(${test_bin} ${OpenBLAS_LIBNAME}) +if (USE_OPENMP AND (${CMAKE_Fortran_COMPILER_ID} STREQUAL GNU) AND (${CMAKE_C_COMPILER_ID} STREQUAL Clang)) + string(REGEX REPLACE "-fopenmp" "" CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS}") +target_link_libraries(${test_bin} omp pthread) +endif() endforeach() # $1 exec, $2 input, $3 output_result From ca121eb5eda1c635f1353d261de5783e079c21c1 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Thu, 22 Feb 2024 22:17:05 +0100 Subject: [PATCH 169/311] Avoid linking both libgomp and libomp in mixed clang/gfortran builds --- lapack-netlib/TESTING/EIG/CMakeLists.txt | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/lapack-netlib/TESTING/EIG/CMakeLists.txt b/lapack-netlib/TESTING/EIG/CMakeLists.txt index e7236677a..b69417853 100644 --- a/lapack-netlib/TESTING/EIG/CMakeLists.txt +++ b/lapack-netlib/TESTING/EIG/CMakeLists.txt @@ -107,6 +107,10 @@ set(ZDMDEIGTST zchkdmd.f90) macro(add_eig_executable name) add_executable(${name} ${ARGN}) target_link_libraries(${name} openblas${SUFFIX64_UNDERSCORE}) +if (USE_OPENMP AND (${CMAKE_Fortran_COMPILER_ID} STREQUAL GNU) AND (${CMAKE_C_COMPILER_ID} STREQUAL Clang)) + string(REGEX REPLACE "-fopenmp" "" CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS}") +target_link_libraries(${name} omp pthread) +endif() #${TMGLIB} ../${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) endmacro() From be20588a3c7c0725cd38846ce3408604fbfb2c95 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Thu, 22 Feb 2024 22:17:48 +0100 Subject: [PATCH 170/311] Avoid linking both libgomp and libomp in mixed clang/gfortran builds --- lapack-netlib/TESTING/LIN/CMakeLists.txt | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/lapack-netlib/TESTING/LIN/CMakeLists.txt b/lapack-netlib/TESTING/LIN/CMakeLists.txt index 143fd0597..9ae0cea79 100644 --- a/lapack-netlib/TESTING/LIN/CMakeLists.txt +++ b/lapack-netlib/TESTING/LIN/CMakeLists.txt @@ -240,6 +240,10 @@ set(ZLINTSTRFP zchkrfp.f zdrvrfp.f zdrvrf1.f zdrvrf2.f zdrvrf3.f zdrvrf4.f zerrr macro(add_lin_executable name) add_executable(${name} ${ARGN}) target_link_libraries(${name} openblas${SUFFIX64_UNDERSCORE}) + if (USE_OPENMP AND (${CMAKE_Fortran_COMPILER_ID} STREQUAL GNU) AND (${CMAKE_C_COMPILER_ID} STREQUAL Clang)) + string(REGEX REPLACE "-fopenmp" "" CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS}") + target_link_libraries(${name} omp pthread) + endif() #${TMGLIB} ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES}) endmacro() From 16b488cabe8c6113ba41bf140f4dfe3cace6b9ac Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Thu, 22 Feb 2024 22:38:05 +0100 Subject: [PATCH 171/311] CI: Add various Apple M1 build configurations to gh workflow --- .github/workflows/apple_m.yml | 149 ++++++++++++++++++++++++++++++++++ 1 file changed, 149 insertions(+) create mode 100644 .github/workflows/apple_m.yml diff --git a/.github/workflows/apple_m.yml b/.github/workflows/apple_m.yml new file mode 100644 index 000000000..e34eada86 --- /dev/null +++ b/.github/workflows/apple_m.yml @@ -0,0 +1,149 @@ +name: apple m + +on: [push, pull_request] + +concurrency: + group: ${{ github.workflow }}-${{ github.head_ref || github.run_id }} + cancel-in-progress: true + +permissions: + contents: read # to fetch code (actions/checkout) + +jobs: + build: + if: "github.repository == 'OpenMathLib/OpenBLAS'" + runs-on: macos-14 + + strategy: + fail-fast: false + matrix: + build: [cmake, make] + fortran: [gfortran] + openmp: [0, 1] + ilp64: [0, 1] + + steps: + - name: Checkout repository + uses: actions/checkout@v3 + + - name: Print system information + run: | + if [ "$RUNNER_OS" == "Linux" ]; then + cat /proc/cpuinfo + elif [ "$RUNNER_OS" == "macOS" ]; then + sysctl -a | grep machdep.cpu + else + echo "::error::$RUNNER_OS not supported" + exit 1 + fi + + - name: Install Dependencies + run: | + if [ "$RUNNER_OS" == "Linux" ]; then + sudo apt-get install -y gfortran cmake ccache libtinfo5 + elif [ "$RUNNER_OS" == "macOS" ]; then + # It looks like "gfortran" isn't working correctly unless "gcc" is re-installed. + brew reinstall gcc + brew install coreutils cmake ccache + brew install llvm + else + echo "::error::$RUNNER_OS not supported" + exit 1 + fi + + - name: Compilation cache + uses: actions/cache@v3 + with: + path: ~/.ccache + # We include the commit sha in the cache key, as new cache entries are + # only created if there is no existing entry for the key yet. + # GNU make and cmake call the compilers differently. It looks like + # that causes the cache to mismatch. Keep the ccache for both build + # tools separate to avoid polluting each other. + key: ccache-${{ runner.os }}-${{ matrix.build }}-${{ matrix.fortran }}-${{ github.ref }}-${{ github.sha }} + # Restore a matching ccache cache entry. Prefer same branch and same Fortran compiler. + restore-keys: | + ccache-${{ runner.os }}-${{ matrix.build }}-${{matrix.fortran }}-${{ github.ref }} + ccache-${{ runner.os }}-${{ matrix.build }}-${{matrix.fortran }} + ccache-${{ runner.os }}-${{ matrix.build }} + + - name: Configure ccache + run: | + if [ "${{ matrix.build }}" = "make" ]; then + # Add ccache to path + if [ "$RUNNER_OS" = "Linux" ]; then + echo "/usr/lib/ccache" >> $GITHUB_PATH + elif [ "$RUNNER_OS" = "macOS" ]; then + echo "$(brew --prefix)/opt/ccache/libexec" >> $GITHUB_PATH + echo "/opt/homebrew/opt/llvm/bin" >>$GITHUB_PATH + echo "" >>$GITHUB_PATH + else + echo "::error::$RUNNER_OS not supported" + exit 1 + fi + fi + # Limit the maximum size and switch on compression to avoid exceeding the total disk or cache quota (5 GB). + test -d ~/.ccache || mkdir -p ~/.ccache + echo "max_size = 300M" > ~/.ccache/ccache.conf + echo "compression = true" >> ~/.ccache/ccache.conf + ccache -s + + - name: Build OpenBLAS + run: | + export LDFLAGS="-L/opt/homebrew/opt/llvm/lib" + export CPPFLAGS="-I/opt/homebrew/opt/llvm/include" + export CC="/opt/homebrew/opt/llvm/bin/clang" + case "${{ matrix.build }}" in + "make") + make -j$(nproc) DYNAMIC_ARCH=1 USE_OPENMP=${{matrix.openmp}} INTERFACE64=${{matrix.ilp64}} FC="ccache ${{ matrix.fortran }}" + ;; + "cmake") + export LDFLAGS="$LDFLAGS -Wl,-ld_classic" + mkdir build && cd build + cmake -DDYNAMIC_ARCH=1 \ + -DUSE_OPENMP=${{matrix.openmp}} \ + -DINTERFACE64=${{matrix.ilp64}} \ + -DNOFORTRAN=0 \ + -DBUILD_WITHOUT_LAPACK=0 \ + -DCMAKE_VERBOSE_MAKEFILE=ON \ + -DCMAKE_BUILD_TYPE=Release \ + -DCMAKE_Fortran_COMPILER=${{ matrix.fortran }} \ + -DCMAKE_C_COMPILER_LAUNCHER=ccache \ + -DCMAKE_Fortran_COMPILER_LAUNCHER=ccache \ + .. + cmake --build . + ;; + *) + echo "::error::Configuration not supported" + exit 1 + ;; + esac + + - name: Show ccache status + continue-on-error: true + run: ccache -s + + - name: Run tests + timeout-minutes: 60 + run: | + case "${{ matrix.build }}" in + "make") + MAKE_FLAGS='DYNAMIC_ARCH=1 USE_OPENMP=0' + echo "::group::Tests in 'test' directory" + make -C test $MAKE_FLAGS FC="ccache ${{ matrix.fortran }}" + echo "::endgroup::" + echo "::group::Tests in 'ctest' directory" + make -C ctest $MAKE_FLAGS FC="ccache ${{ matrix.fortran }}" + echo "::endgroup::" + echo "::group::Tests in 'utest' directory" + make -C utest $MAKE_FLAGS FC="ccache ${{ matrix.fortran }}" + echo "::endgroup::" + ;; + "cmake") + cd build && ctest + ;; + *) + echo "::error::Configuration not supported" + exit 1 + ;; + esac From 5b953f2f8d3a3f138e4be4ed28624ee25826c968 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Thu, 22 Feb 2024 22:41:08 +0100 Subject: [PATCH 172/311] Disable most AppleM1 builds (replaced by gh workflows) --- .cirrus.yml | 70 ++++++++++++++++++++++++++--------------------------- 1 file changed, 35 insertions(+), 35 deletions(-) diff --git a/.cirrus.yml b/.cirrus.yml index b4c4870d0..9a898f421 100644 --- a/.cirrus.yml +++ b/.cirrus.yml @@ -1,44 +1,44 @@ macos_instance: image: ghcr.io/cirruslabs/macos-monterey-xcode:latest -task: - name: AppleM1/LLVM - compile_script: - - brew install llvm - - export PATH=/opt/homebrew/opt/llvm/bin:$PATH - - export LDFLAGS="-L/opt/homebrew/opt/llvm/lib" - - export CPPFLAGS="-I/opt/homebrew/opt/llvm/include" - - make TARGET=VORTEX USE_OPENMP=1 CC=clang +#task: +# name: AppleM1/LLVM +# compile_script: +# - brew install llvm +# - export PATH=/opt/homebrew/opt/llvm/bin:$PATH +# - export LDFLAGS="-L/opt/homebrew/opt/llvm/lib" +# - export CPPFLAGS="-I/opt/homebrew/opt/llvm/include" +# - make TARGET=VORTEX USE_OPENMP=1 CC=clang -task: - name: AppleM1/LLVM/ILP64 - compile_script: - - brew install llvm - - export PATH=/opt/homebrew/opt/llvm/bin:$PATH - - export LDFLAGS="-L/opt/homebrew/opt/llvm/lib" - - export CPPFLAGS="-I/opt/homebrew/opt/llvm/include" - - make TARGET=VORTEX USE_OPENMP=1 CC=clang INTERFACE64=1 +#task: +# name: AppleM1/LLVM/ILP64 +# compile_script: +# - brew install llvm +# - export PATH=/opt/homebrew/opt/llvm/bin:$PATH +# - export LDFLAGS="-L/opt/homebrew/opt/llvm/lib" +# - export CPPFLAGS="-I/opt/homebrew/opt/llvm/include" +# - make TARGET=VORTEX USE_OPENMP=1 CC=clang INTERFACE64=1 -task: - name: AppleM1/LLVM/CMAKE - compile_script: - - brew install llvm - - export PATH=/opt/homebrew/opt/llvm/bin:$PATH - - export LDFLAGS="-L/opt/homebrew/opt/llvm/lib" - - export CPPFLAGS="-I/opt/homebrew/opt/llvm/include" - - mkdir build - - cd build - - cmake -DTARGET=VORTEX -DCMAKE_C_COMPILER=clang -DBUILD_SHARED_LIBS=ON .. - - make -j 4 +#task: +# name: AppleM1/LLVM/CMAKE +# compile_script: +# - brew install llvm +# - export PATH=/opt/homebrew/opt/llvm/bin:$PATH +# - export LDFLAGS="-L/opt/homebrew/opt/llvm/lib" +# - export CPPFLAGS="-I/opt/homebrew/opt/llvm/include" +# - mkdir build +# - cd build +# - cmake -DTARGET=VORTEX -DCMAKE_C_COMPILER=clang -DBUILD_SHARED_LIBS=ON .. +# - make -j 4 -task: - name: AppleM1/GCC/MAKE/OPENMP - compile_script: - - brew install gcc@11 - - export PATH=/opt/homebrew/bin:$PATH - - export LDFLAGS="-L/opt/homebrew/lib" - - export CPPFLAGS="-I/opt/homebrew/include" - - make CC=gcc-11 FC=gfortran-11 USE_OPENMP=1 +#task: +# name: AppleM1/GCC/MAKE/OPENMP +# compile_script: +# - brew install gcc@11 +# - export PATH=/opt/homebrew/bin:$PATH +# - export LDFLAGS="-L/opt/homebrew/lib" +# - export CPPFLAGS="-I/opt/homebrew/include" +# - make CC=gcc-11 FC=gfortran-11 USE_OPENMP=1 macos_instance: image: ghcr.io/cirruslabs/macos-monterey-xcode:latest From bdaa6705ca7b0031223417402e3f87e85fef86ac Mon Sep 17 00:00:00 2001 From: frjohnst Date: Fri, 23 Feb 2024 10:20:48 -0500 Subject: [PATCH 173/311] fix conlict between PR 4515 and AIX shared obj support --- exports/Makefile | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/exports/Makefile b/exports/Makefile index 15f65aefe..27a291f34 100644 --- a/exports/Makefile +++ b/exports/Makefile @@ -315,6 +315,11 @@ test : linktest.c linktest.c : $(GENSYM) ../Makefile.system ../getarch.c ./$(GENSYM) linktest $(ARCH) "$(BU)" $(EXPRECISION) $(NO_CBLAS) $(NO_LAPACK) $(NO_LAPACKE) $(NEED2UNDERSCORES) $(ONLY_CBLAS) "$(SYMBOLPREFIX)" "$(SYMBOLSUFFIX)" $(BUILD_LAPACK_DEPRECATED) $(BUILD_BFLOAT16) $(BUILD_SINGLE) $(BUILD_DOUBLE) $(BUILD_COMPLEX) $(BUILD_COMPLEX16) > linktest.c +ifeq ($(F_COMPILER), IBM) + mv linktest.c linktest.c.FIRST + egrep -v 'second_|dsecnd_' linktest.c.FIRST > linktest.c + rm linktest.c.FIRST +endif clean :: @rm -f *.def *.dylib __.SYMDEF* *.renamed From be5e18c6f94716c6265f9e2cd58517fa138abcf5 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Sat, 24 Feb 2024 23:55:43 +0100 Subject: [PATCH 174/311] Add kernel definitions for CSUM and ZSUM --- kernel/x86_64/KERNEL | 2 ++ kernel/x86_64/KERNEL.SKYLAKEX | 2 ++ 2 files changed, 4 insertions(+) diff --git a/kernel/x86_64/KERNEL b/kernel/x86_64/KERNEL index f8278c3b4..ec4290e82 100644 --- a/kernel/x86_64/KERNEL +++ b/kernel/x86_64/KERNEL @@ -489,5 +489,7 @@ XGEMM3MKERNEL = xgemm3m_kernel_2x2.S SSUMKERNEL = ../arm/sum.c DSUMKERNEL = ../arm/sum.c +CSUMKERNEL = zsum_sse.S +ZSUMKERNEL = zsum_sse2.S SOMATCOPY_RT = omatcopy_rt.c diff --git a/kernel/x86_64/KERNEL.SKYLAKEX b/kernel/x86_64/KERNEL.SKYLAKEX index 548e5dcfc..7e946ef2e 100644 --- a/kernel/x86_64/KERNEL.SKYLAKEX +++ b/kernel/x86_64/KERNEL.SKYLAKEX @@ -46,3 +46,5 @@ ZGEMMKERNEL = zgemm_kernel_4x2_skylakex.c CASUMKERNEL = casum.c ZASUMKERNEL = zasum.c +CSUMKERNEL = csum.c +ZSUMKERNEL = zsum.c From 8f8ef3492a3eb753f8e6e1201dfe4c7107c5d779 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Sat, 24 Feb 2024 23:57:50 +0100 Subject: [PATCH 175/311] Add CSUM and ZSUM kernels (trivially derived from their existing ASUM counterparts) --- kernel/x86_64/csum.c | 131 +++++++++++ kernel/x86_64/csum_microk_skylakex-2.c | 289 ++++++++++++++++++++++++ kernel/x86_64/zsum.c | 131 +++++++++++ kernel/x86_64/zsum_microk_skylakex-2.c | 280 +++++++++++++++++++++++ kernel/x86_64/zsum_sse.S | 299 +++++++++++++++++++++++++ kernel/x86_64/zsum_sse2.S | 283 +++++++++++++++++++++++ 6 files changed, 1413 insertions(+) create mode 100644 kernel/x86_64/csum.c create mode 100644 kernel/x86_64/csum_microk_skylakex-2.c create mode 100644 kernel/x86_64/zsum.c create mode 100644 kernel/x86_64/zsum_microk_skylakex-2.c create mode 100644 kernel/x86_64/zsum_sse.S create mode 100644 kernel/x86_64/zsum_sse2.S diff --git a/kernel/x86_64/csum.c b/kernel/x86_64/csum.c new file mode 100644 index 000000000..e85b5cae1 --- /dev/null +++ b/kernel/x86_64/csum.c @@ -0,0 +1,131 @@ +#include "common.h" + +#if defined(SKYLAKEX) || defined(COOPERLAKE) || defined(SAPPHIRERAPIDS) +#include "csum_microk_skylakex-2.c" +#endif + +#ifndef HAVE_CSUM_KERNEL +static FLOAT csum_kernel(BLASLONG n, FLOAT *x) +{ + + BLASLONG i=0; + BLASLONG n_8 = n & -8; + FLOAT *x1 = x; + FLOAT temp0, temp1, temp2, temp3; + FLOAT temp4, temp5, temp6, temp7; + FLOAT sum0 = 0.0; + FLOAT sum1 = 0.0; + FLOAT sum2 = 0.0; + FLOAT sum3 = 0.0; + FLOAT sum4 = 0.0; + + while (i < n_8) { + sum0 += x1[0]; + sum1 += x1[1]; + sum2 += x1[2]; + sum3 += x1[3]; + + sum0 += x1[4]; + sum1 += x1[5]; + sum2 += x1[6]; + sum3 += x1[7]; + + x1+=8; + i+=4; + } + + while (i < n) { + sum4 += (x1[0] + x1[1]); + x1 += 2; + i++; + } + + return sum0+sum1+sum2+sum3+sum4; +} + +#endif + +static FLOAT sum_compute(BLASLONG n, FLOAT *x, BLASLONG inc_x) +{ + BLASLONG i = 0; + BLASLONG ip = 0; + BLASLONG inc_x2; + FLOAT sumf = 0.0; + + if (n <= 0 || inc_x <= 0) return(sumf); + if (inc_x == 1) { + sumf = csum_kernel(n, x); + } + else { + inc_x2 = 2 * inc_x; + + while (i < n) { + sumf += x[ip] + x[ip + 1]; + ip += inc_x2; + i++; + } + } + + return(sumf); +} + +#if defined(SMP) +static int sum_thread_function(BLASLONG n, + BLASLONG dummy0, BLASLONG dummy1, FLOAT dummy2, + FLOAT *x, BLASLONG inc_x, + FLOAT * dummy3, BLASLONG dummy4, + FLOAT * result, BLASLONG dummy5) +{ + *(FLOAT *) result = sum_compute(n, x, inc_x); + return 0; +} + +extern int blas_level1_thread_with_return_value(int mode, + BLASLONG m, BLASLONG n, BLASLONG k, void * alpha, + void *a, BLASLONG lda, + void *b, BLASLONG ldb, + void *c, BLASLONG ldc, + int (*function)(), + int nthread); +#endif + +FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) +{ +#if defined(SMP) + int nthreads; + FLOAT dummy_alpha[2]; +#endif + FLOAT sumf = 0.0; + +#if defined(SMP) + int num_cpu = num_cpu_avail(1); + if (n <= 10000 || inc_x <= 0) + nthreads = 1; + else + nthreads = num_cpu < n/10000 ? num_cpu : n/10000; + + if (nthreads == 1) { + sumf = sum_compute(n, x, inc_x); + } + else { + int mode, i; + char result[MAX_CPU_NUMBER * sizeof(double) *2]; + FLOAT *ptr; +#if !defined(DOUBLE) + mode = BLAS_SINGLE | BLAS_COMPLEX; +#else + mode = BLAS_DOUBLE | BLAS_COMPLEX; +#endif + blas_level1_thread_with_return_value(mode, n, 0, 0, dummy_alpha, x, inc_x, + NULL, 0, result, 0, (int (*)(void))sum_thread_function, nthreads); + ptr = (FLOAT *)result; + for (i = 0; i < nthreads; i++) { + sumf += (*ptr); + ptr = (FLOAT *)(((char *)ptr) + sizeof(double) *2); + } + } +#else + sumf = sum_compute(n, x, inc_x); +#endif + return(sumf); +} diff --git a/kernel/x86_64/csum_microk_skylakex-2.c b/kernel/x86_64/csum_microk_skylakex-2.c new file mode 100644 index 000000000..ec882efa1 --- /dev/null +++ b/kernel/x86_64/csum_microk_skylakex-2.c @@ -0,0 +1,289 @@ +/* need a new enough GCC for avx512 support */ +#ifdef __NVCOMPILER +#define NVCOMPVERS ( __NVCOMPILER_MAJOR__ * 100 + __NVCOMPILER_MINOR__ ) +#endif +#if ((( defined(__GNUC__) && __GNUC__ > 6 && defined(__AVX512CD__)) || (defined(__clang__) && __clang_major__ >= 9)) || (defined(__NVCOMPILER) && NVCOMPVERS >= 2203)) + +#if (!(defined(__NVCOMPILER) && NVCOMPVERS < 2203)) + +#define HAVE_CASUM_KERNEL 1 + +#include + +#include + +static FLOAT casum_kernel(BLASLONG n, FLOAT *x) +{ + FLOAT *x1 = x; + FLOAT sumf=0.0; + BLASLONG n2 = n + n; + + if (n2 < 64) { + __m128 accum_10, accum_11, accum_12, accum_13; + + accum_10 = _mm_setzero_ps(); + accum_11 = _mm_setzero_ps(); + accum_12 = _mm_setzero_ps(); + accum_13 = _mm_setzero_ps(); + + _mm_prefetch(&x1[0], _MM_HINT_T0); + + if (n2 >= 32){ + __m128 x00 = _mm_loadu_ps(&x1[ 0]); + __m128 x01 = _mm_loadu_ps(&x1[ 4]); + __m128 x02 = _mm_loadu_ps(&x1[ 8]); + __m128 x03 = _mm_loadu_ps(&x1[12]); + + _mm_prefetch(&x1[16], _MM_HINT_T0); + __m128 x04 = _mm_loadu_ps(&x1[16]); + __m128 x05 = _mm_loadu_ps(&x1[20]); + __m128 x06 = _mm_loadu_ps(&x1[24]); + __m128 x07 = _mm_loadu_ps(&x1[28]); + + accum_10 = _mm_add_ps(accum_10, x00); + accum_11 = _mm_add_ps(accum_11, x01); + accum_12 = _mm_add_ps(accum_12, x02); + accum_13 = _mm_add_ps(accum_13, x03); + + accum_10 = _mm_add_ps(accum_10, x04); + accum_11 = _mm_add_ps(accum_11, x05); + accum_12 = _mm_add_ps(accum_12, x06); + accum_13 = _mm_add_ps(accum_13, x07); + + n2 -= 32; + x1 += 32; + } + + if (n2 >= 16) { + __m128 x00 = _mm_loadu_ps(&x1[ 0]); + __m128 x01 = _mm_loadu_ps(&x1[ 4]); + __m128 x02 = _mm_loadu_ps(&x1[ 8]); + __m128 x03 = _mm_loadu_ps(&x1[12]); + + accum_10 = _mm_add_ps(accum_10, x00); + accum_11 = _mm_add_ps(accum_11, x01); + accum_12 = _mm_add_ps(accum_12, x02); + accum_13 = _mm_add_ps(accum_13, x03); + + n2 -= 16; + x1 += 16; + } + + if (n2 >= 8) { + __m128 x00 = _mm_loadu_ps(&x1[ 0]); + __m128 x01 = _mm_loadu_ps(&x1[ 4]); + accum_10 = _mm_add_ps(accum_10, x00); + accum_11 = _mm_add_ps(accum_11, x01); + + n2 -= 8; + x1 += 8; + } + + if (n2 >= 4) { + __m128 x00 = _mm_loadu_ps(&x1[ 0]); + accum_10 = _mm_add_ps(accum_10, x00); + + n2 -= 4; + x1 += 4; + } + + if (n2) { + sumf += (x1[0] + x1[1]); + } + + accum_10 = _mm_add_ps(accum_10, accum_11); + accum_12 = _mm_add_ps(accum_12, accum_13); + accum_10 = _mm_add_ps(accum_10, accum_12); + + accum_10 = _mm_hadd_ps(accum_10, accum_10); + accum_10 = _mm_hadd_ps(accum_10, accum_10); + + sumf += accum_10[0]; + } + else { + __m512 accum_0, accum_1, accum_2, accum_3; + __m512 x00, x01, x02, x03, x04, x05, x06, x07; + + accum_0 = _mm512_setzero_ps(); + accum_1 = _mm512_setzero_ps(); + accum_2 = _mm512_setzero_ps(); + accum_3 = _mm512_setzero_ps(); + + // alignment has side-effect when the size of input array is not large enough + if (n2 < 256) { + if (n2 >= 128) { + x00 = _mm512_loadu_ps(&x1[ 0]); + x01 = _mm512_loadu_ps(&x1[ 16]); + x02 = _mm512_loadu_ps(&x1[ 32]); + x03 = _mm512_loadu_ps(&x1[ 48]); + x04 = _mm512_loadu_ps(&x1[ 64]); + x05 = _mm512_loadu_ps(&x1[ 80]); + x06 = _mm512_loadu_ps(&x1[ 96]); + x07 = _mm512_loadu_ps(&x1[112]); + + accum_0 = _mm512_add_ps(accum_0, x00); + accum_1 = _mm512_add_ps(accum_1, x01); + accum_2 = _mm512_add_ps(accum_2, x02); + accum_3 = _mm512_add_ps(accum_3, x03); + + accum_0 = _mm512_add_ps(accum_0, x04); + accum_1 = _mm512_add_ps(accum_1, x05); + accum_2 = _mm512_add_ps(accum_2, x06); + accum_3 = _mm512_add_ps(accum_3, x07); + + n2 -= 128; + x1 += 128; + } + + if (n2 >= 64) { + x00 = _mm512_loadu_ps(&x1[ 0]); + x01 = _mm512_loadu_ps(&x1[16]); + x02 = _mm512_loadu_ps(&x1[32]); + x03 = _mm512_loadu_ps(&x1[48]); + accum_0 = _mm512_add_ps(accum_0, x00); + accum_1 = _mm512_add_ps(accum_1, x01); + accum_2 = _mm512_add_ps(accum_2, x02); + accum_3 = _mm512_add_ps(accum_3, x03); + + n2 -= 64; + x1 += 64; + } + + if (n2 >= 32) { + x00 = _mm512_loadu_ps(&x1[ 0]); + x01 = _mm512_loadu_ps(&x1[16]); + accum_0 = _mm512_add_ps(accum_0, x00); + accum_1 = _mm512_add_ps(accum_1, x01); + + n2 -= 32; + x1 += 32; + } + + if (n2 >= 16) { + x00 = _mm512_loadu_ps(&x1[ 0]); + accum_0 = _mm512_add_ps(accum_0, x00); + + n2 -= 16; + x1 += 16; + } + + if (n2) { + uint16_t tail_mask16 = (((uint16_t) 0xffff) >> (16 - n2)); + x00 = _mm512_maskz_loadu_ps(*((__mmask16*) &tail_mask16), &x1[ 0]); + accum_0 = _mm512_add_ps(accum_0, x00); + } + accum_0 = _mm512_add_ps(accum_0, accum_1); + accum_2 = _mm512_add_ps(accum_2, accum_3); + accum_0 = _mm512_add_ps(accum_0, accum_2); + + sumf = _mm512_reduce_add_ps(accum_0); + } + // n2 >= 256, doing alignment + else { + + int align_header = ((64 - ((uintptr_t)x1 & (uintptr_t)0x3f)) >> 2) & 0xf; + + if (0 != align_header) { + uint16_t align_mask16 = (((uint16_t)0xffff) >> (16 - align_header)); + x00 = _mm512_maskz_loadu_ps(*((__mmask16*) &align_mask16), &x1[0]); + accum_0 = _mm512_add_ps(accum_0, x00); + + n2 -= align_header; + x1 += align_header; + } + + x00 = _mm512_load_ps(&x1[ 0]); + x01 = _mm512_load_ps(&x1[ 16]); + x02 = _mm512_load_ps(&x1[ 32]); + x03 = _mm512_load_ps(&x1[ 48]); + x04 = _mm512_load_ps(&x1[ 64]); + x05 = _mm512_load_ps(&x1[ 80]); + x06 = _mm512_load_ps(&x1[ 96]); + x07 = _mm512_load_ps(&x1[112]); + + n2 -= 128; + x1 += 128; + + while (n2 >= 128) { + + accum_0 = _mm512_add_ps(accum_0, x00); + x00 = _mm512_load_ps(&x1[ 0]); + accum_1 = _mm512_add_ps(accum_1, x01); + x01 = _mm512_load_ps(&x1[ 16]); + accum_2 = _mm512_add_ps(accum_2, x02); + x02 = _mm512_load_ps(&x1[ 32]); + accum_3 = _mm512_add_ps(accum_3, x03); + x03 = _mm512_load_ps(&x1[ 48]); + + accum_0 = _mm512_add_ps(accum_0, x04); + x04 = _mm512_load_ps(&x1[ 64]); + accum_1 = _mm512_add_ps(accum_1, x05); + x05 = _mm512_load_ps(&x1[ 80]); + accum_2 = _mm512_add_ps(accum_2, x06); + x06 = _mm512_load_ps(&x1[ 96]); + accum_3 = _mm512_add_ps(accum_3, x07); + x07 = _mm512_load_ps(&x1[112]); + + n2 -= 128; + x1 += 128; + } + + accum_0 = _mm512_add_ps(accum_0, x00); + accum_1 = _mm512_add_ps(accum_1, x01); + accum_2 = _mm512_add_ps(accum_2, x02); + accum_3 = _mm512_add_ps(accum_3, x03); + + accum_0 = _mm512_add_ps(accum_0, x04); + accum_1 = _mm512_add_ps(accum_1, x05); + accum_2 = _mm512_add_ps(accum_2, x06); + accum_3 = _mm512_add_ps(accum_3, x07); + + if (n2 >= 64) { + x00 = _mm512_load_ps(&x1[ 0]); + x01 = _mm512_load_ps(&x1[16]); + x02 = _mm512_load_ps(&x1[32]); + x03 = _mm512_load_ps(&x1[48]); + accum_0 = _mm512_add_ps(accum_0, x00); + accum_1 = _mm512_add_ps(accum_1, x01); + accum_2 = _mm512_add_ps(accum_2, x02); + accum_3 = _mm512_add_ps(accum_3, x03); + + n2 -= 64; + x1 += 64; + } + + if (n2 >= 32) { + x00 = _mm512_load_ps(&x1[ 0]); + x01 = _mm512_load_ps(&x1[16]); + accum_0 = _mm512_add_ps(accum_0, x00); + accum_1 = _mm512_add_ps(accum_1, x01); + + n2 -= 32; + x1 += 32; + } + + if (n2 >= 16) { + x00 = _mm512_load_ps(&x1[ 0]); + accum_0 = _mm512_add_ps(accum_0, x00); + + n2 -= 16; + x1 += 16; + } + + if (n2) { + uint16_t tail_mask16 = (((uint16_t) 0xffff) >> (16 - n2)); + x00 = _mm512_maskz_load_ps(*((__mmask16*) &tail_mask16), &x1[ 0]); + accum_0 = _mm512_add_ps(accum_0, x00); + } + + accum_0 = _mm512_add_ps(accum_0, accum_1); + accum_2 = _mm512_add_ps(accum_2, accum_3); + accum_0 = _mm512_add_ps(accum_0, accum_2); + sumf = _mm512_reduce_add_ps(accum_0); + } + } + + return sumf; +} +#endif +#endif diff --git a/kernel/x86_64/zsum.c b/kernel/x86_64/zsum.c new file mode 100644 index 000000000..5973c1253 --- /dev/null +++ b/kernel/x86_64/zsum.c @@ -0,0 +1,131 @@ +#include "common.h" + +#if defined(SKYLAKEX) || defined(COOPERLAKE) || defined(SAPPHIRERAPIDS) +#include "zsum_microk_skylakex-2.c" +#endif + +#ifndef HAVE_ZASUM_KERNEL +static FLOAT zasum_kernel(BLASLONG n, FLOAT *x) +{ + + BLASLONG i=0; + BLASLONG n_8 = n & -8; + FLOAT *x1 = x; + FLOAT temp0, temp1, temp2, temp3; + FLOAT temp4, temp5, temp6, temp7; + FLOAT sum0 = 0.0; + FLOAT sum1 = 0.0; + FLOAT sum2 = 0.0; + FLOAT sum3 = 0.0; + FLOAT sum4 = 0.0; + + while (i < n_8) { + sum0 += x1[0]; + sum1 += x1[1]; + sum2 += x1[2]; + sum3 += x1[3]; + + sum0 += x1[4]; + sum1 += x1[5]; + sum2 += x1[6]; + sum3 += x1[7]; + + x1+=8; + i+=4; + } + + while (i < n) { + sum4 += x1[0] + x1[1]; + x1 += 2; + i++; + } + + return sum0+sum1+sum2+sum3+sum4; +} + +#endif + +static FLOAT sum_compute(BLASLONG n, FLOAT *x, BLASLONG inc_x) +{ + BLASLONG i = 0; + BLASLONG ip = 0; + BLASLONG inc_x2; + FLOAT sumf = 0.0; + + if (n <= 0 || inc_x <= 0) return(sumf); + if (inc_x == 1) { + sumf = zsum_kernel(n, x); + } + else { + inc_x2 = 2 * inc_x; + + while (i < n) { + sumf += x[ip] + x[ip + 1]; + ip += inc_x2; + i++; + } + } + + return(sumf); +} + +#if defined(SMP) +static int sum_thread_function(BLASLONG n, + BLASLONG dummy0, BLASLONG dummy1, FLOAT dummy2, + FLOAT *x, BLASLONG inc_x, + FLOAT * dummy3, BLASLONG dummy4, + FLOAT * result, BLASLONG dummy5) +{ + *(FLOAT *) result = sum_compute(n, x, inc_x); + return 0; +} + +extern int blas_level1_thread_with_return_value(int mode, + BLASLONG m, BLASLONG n, BLASLONG k, void * alpha, + void *a, BLASLONG lda, + void *b, BLASLONG ldb, + void *c, BLASLONG ldc, + int (*function)(), + int nthread); +#endif + +FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) +{ +#if defined(SMP) + int nthreads; + FLOAT dummy_alpha[2]; +#endif + FLOAT sumf = 0.0; + +#if defined(SMP) + int num_cpu = num_cpu_avail(1); + if (n <= 10000 || inc_x <= 0) + nthreads = 1; + else + nthreads = num_cpu < n/10000 ? num_cpu : n/10000; + + if (nthreads == 1) { + sumf = sum_compute(n, x, inc_x); + } + else { + int mode, i; + char result[MAX_CPU_NUMBER * sizeof(double) *2]; + FLOAT *ptr; +#if !defined(DOUBLE) + mode = BLAS_SINGLE | BLAS_COMPLEX; +#else + mode = BLAS_DOUBLE | BLAS_COMPLEX; +#endif + blas_level1_thread_with_return_value(mode, n, 0, 0, dummy_alpha, x, inc_x, + NULL, 0, result, 0, (int (*)(void))sum_thread_function, nthreads); + ptr = (FLOAT *)result; + for (i = 0; i < nthreads; i++) { + sumf += (*ptr); + ptr = (FLOAT *)(((char *)ptr) + sizeof(double) *2); + } + } +#else + sumf = sum_compute(n, x, inc_x); +#endif + return(sumf); +} diff --git a/kernel/x86_64/zsum_microk_skylakex-2.c b/kernel/x86_64/zsum_microk_skylakex-2.c new file mode 100644 index 000000000..0bca7ce6d --- /dev/null +++ b/kernel/x86_64/zsum_microk_skylakex-2.c @@ -0,0 +1,280 @@ +/* need a new enough GCC for avx512 support */ +#ifdef __NVCOMPILER +#define NVCOMPVERS ( __NVCOMPILER_MAJOR__ * 100 + __NVCOMPILER_MINOR__ ) +#endif +#if ((( defined(__GNUC__) && __GNUC__ > 6 && defined(__AVX512CD__)) || (defined(__clang__) && __clang_major__ >= 9)) || (defined(__NVCOMPILER) && NVCOMPVERS >= 2203)) + +#if (!(defined(__NVCOMPILER) && NVCOMPVERS < 2203)) + +#define HAVE_ZSUM_KERNEL 1 + +#include + +#include + +static FLOAT zsum_kernel(BLASLONG n, FLOAT *x) +{ + FLOAT *x1 = x; + FLOAT sumf=0.0; + BLASLONG n2 = n + n; + + + if (n2 < 32) { + __m128d accum_10, accum_11, accum_12, accum_13; + + accum_10 = _mm_setzero_pd(); + accum_11 = _mm_setzero_pd(); + accum_12 = _mm_setzero_pd(); + accum_13 = _mm_setzero_pd(); + + _mm_prefetch(&x1[0], _MM_HINT_T0); + if (n2 >= 16){ + __m128d x00 = _mm_loadu_pd(&x1[ 0]); + __m128d x01 = _mm_loadu_pd(&x1[ 2]); + __m128d x02 = _mm_loadu_pd(&x1[ 4]); + __m128d x03 = _mm_loadu_pd(&x1[ 6]); + + _mm_prefetch(&x1[8], _MM_HINT_T0); + __m128d x04 = _mm_loadu_pd(&x1[ 8]); + __m128d x05 = _mm_loadu_pd(&x1[10]); + __m128d x06 = _mm_loadu_pd(&x1[12]); + __m128d x07 = _mm_loadu_pd(&x1[14]); + + accum_10 = _mm_add_pd(accum_10, x00); + accum_11 = _mm_add_pd(accum_11, x01); + accum_12 = _mm_add_pd(accum_12, x02); + accum_13 = _mm_add_pd(accum_13, x03); + + accum_10 = _mm_add_pd(accum_10, x04); + accum_11 = _mm_add_pd(accum_11, x05); + accum_12 = _mm_add_pd(accum_12, x06); + accum_13 = _mm_add_pd(accum_13, x07); + + x1 += 16; + n2 -= 16; + } + + if (n2 >= 8) { + __m128d x00 = _mm_loadu_pd(&x1[ 0]); + __m128d x01 = _mm_loadu_pd(&x1[ 2]); + __m128d x02 = _mm_loadu_pd(&x1[ 4]); + __m128d x03 = _mm_loadu_pd(&x1[ 6]); + + accum_10 = _mm_add_pd(accum_10, x00); + accum_11 = _mm_add_pd(accum_11, x01); + accum_12 = _mm_add_pd(accum_12, x02); + accum_13 = _mm_add_pd(accum_13, x03); + + n2 -= 8; + x1 += 8; + } + + if (n2 >= 4) { + __m128d x00 = _mm_loadu_pd(&x1[ 0]); + __m128d x01 = _mm_loadu_pd(&x1[ 2]); + accum_10 = _mm_add_pd(accum_10, x00); + accum_11 = _mm_add_pd(accum_11, x01); + + n2 -= 4; + x1 += 4; + } + + if (n2) { + __m128d x00 = _mm_loadu_pd(&x1[ 0]); + accum_10 = _mm_add_pd(accum_10, x00); + } + + accum_10 = _mm_add_pd(accum_10, accum_11); + accum_12 = _mm_add_pd(accum_12, accum_13); + accum_10 = _mm_add_pd(accum_10, accum_12); + + accum_10 = _mm_hadd_pd(accum_10, accum_10); + + sumf = accum_10[0]; + } + else { + __m512d accum_0, accum_1, accum_2, accum_3; + __m512d x00, x01, x02, x03, x04, x05, x06, x07; + __m512d abs_mask = (__m512d)_mm512_set1_epi64(0x7fffffffffffffff); + + accum_0 = _mm512_setzero_pd(); + accum_1 = _mm512_setzero_pd(); + accum_2 = _mm512_setzero_pd(); + accum_3 = _mm512_setzero_pd(); + + // alignment has side-effect when the size of input array is not large enough + if (n2 < 128) { + if (n2 >= 64) { + x00 = _mm512_loadu_pd(&x1[ 0]); + x01 = _mm512_loadu_pd(&x1[ 8]); + x02 = _mm512_loadu_pd(&x1[16]); + x03 = _mm512_loadu_pd(&x1[24]); + x04 = _mm512_loadu_pd(&x1[32]); + x05 = _mm512_loadu_pd(&x1[40]); + x06 = _mm512_loadu_pd(&x1[48]); + x07 = _mm512_loadu_pd(&x1[56]); + + accum_0 = _mm512_add_pd(accum_0, x00); + accum_1 = _mm512_add_pd(accum_1, x01); + accum_2 = _mm512_add_pd(accum_2, x02); + accum_3 = _mm512_add_pd(accum_3, x03); + + accum_0 = _mm512_add_pd(accum_0, x04); + accum_1 = _mm512_add_pd(accum_1, x05); + accum_2 = _mm512_add_pd(accum_2, x06); + accum_3 = _mm512_add_pd(accum_3, x07); + + n2 -= 64; + x1 += 64; + } + + if (n2 >= 32) { + x00 = _mm512_loadu_pd(&x1[ 0]); + x01 = _mm512_loadu_pd(&x1[ 8]); + x02 = _mm512_loadu_pd(&x1[16]); + x03 = _mm512_loadu_pd(&x1[24]); + accum_0 = _mm512_add_pd(accum_0, x00); + accum_1 = _mm512_add_pd(accum_1, x01); + accum_2 = _mm512_add_pd(accum_2, x02); + accum_3 = _mm512_add_pd(accum_3, x03); + + n2 -= 32; + x1 += 32; + } + + if (n2 >= 16) { + x00 = _mm512_loadu_pd(&x1[ 0]); + x01 = _mm512_loadu_pd(&x1[ 8]); + accum_0 = _mm512_add_pd(accum_0, x00); + accum_1 = _mm512_add_pd(accum_1, x01); + + n2 -= 16; + x1 += 16; + } + + if (n2 >= 8) { + x00 = _mm512_loadu_pd(&x1[ 0]); + accum_0 = _mm512_add_pd(accum_0, x00); + + n2 -= 8; + x1 += 8; + } + + if (n2) { + unsigned char tail_mask8 = (((unsigned char) 0xff) >> (8 - n2)); + x00 = _mm512_maskz_loadu_pd(*((__mmask8*) &tail_mask8), &x1[ 0]); + accum_0 = _mm512_add_pd(accum_0, x00); + } + accum_0 = _mm512_add_pd(accum_0, accum_1); + accum_2 = _mm512_add_pd(accum_2, accum_3); + accum_0 = _mm512_add_pd(accum_0, accum_2); + sumf = _mm512_reduce_add_pd(accum_0); + } + // n2 >= 128, doing alignment + else { + + int align_header = ((64 - ((uintptr_t)x1 & (uintptr_t)0x3f)) >> 3) & 0x7; + + if (0 != align_header) { + unsigned char align_mask8 = (((unsigned char)0xff) >> (8 - align_header)); + x00 = _mm512_maskz_loadu_pd(*((__mmask8*) &align_mask8), &x1[0]); + accum_0 = _mm512_add_pd(accum_0, x00); + + n2 -= align_header; + x1 += align_header; + } + + x00 = _mm512_load_pd(&x1[ 0]); + x01 = _mm512_load_pd(&x1[ 8]); + x02 = _mm512_load_pd(&x1[16]); + x03 = _mm512_load_pd(&x1[24]); + x04 = _mm512_load_pd(&x1[32]); + x05 = _mm512_load_pd(&x1[40]); + x06 = _mm512_load_pd(&x1[48]); + x07 = _mm512_load_pd(&x1[56]); + + n2 -= 64; + x1 += 64; + + while (n2 >= 64) { + accum_0 = _mm512_add_pd(accum_0, x00); + x00 = _mm512_load_pd(&x1[ 0]); + accum_1 = _mm512_add_pd(accum_1, x01); + x01 = _mm512_load_pd(&x1[ 8]); + accum_2 = _mm512_add_pd(accum_2, x02); + x02 = _mm512_load_pd(&x1[16]); + accum_3 = _mm512_add_pd(accum_3, x03); + x03 = _mm512_load_pd(&x1[24]); + + accum_0 = _mm512_add_pd(accum_0, x04); + x04 = _mm512_load_pd(&x1[32]); + accum_1 = _mm512_add_pd(accum_1, x05); + x05 = _mm512_load_pd(&x1[40]); + accum_2 = _mm512_add_pd(accum_2, x06); + x06 = _mm512_load_pd(&x1[48]); + accum_3 = _mm512_add_pd(accum_3, x07); + x07 = _mm512_load_pd(&x1[56]); + + n2 -= 64; + x1 += 64; + } + + accum_0 = _mm512_add_pd(accum_0, x00); + accum_1 = _mm512_add_pd(accum_1, x01); + accum_2 = _mm512_add_pd(accum_2, x02); + accum_3 = _mm512_add_pd(accum_3, x03); + + accum_0 = _mm512_add_pd(accum_0, x04); + accum_1 = _mm512_add_pd(accum_1, x05); + accum_2 = _mm512_add_pd(accum_2, x06); + accum_3 = _mm512_add_pd(accum_3, x07); + + if (n2 >= 32) { + x00 = _mm512_load_pd(&x1[ 0]); + x01 = _mm512_load_pd(&x1[ 8]); + x02 = _mm512_load_pd(&x1[16]); + x03 = _mm512_load_pd(&x1[24]); + accum_0 = _mm512_add_pd(accum_0, x00); + accum_1 = _mm512_add_pd(accum_1, x01); + accum_2 = _mm512_add_pd(accum_2, x02); + accum_3 = _mm512_add_pd(accum_3, x03); + + n2 -= 32; + x1 += 32; + } + + if (n2 >= 16) { + x00 = _mm512_load_pd(&x1[ 0]); + x01 = _mm512_load_pd(&x1[ 8]); + accum_0 = _mm512_add_pd(accum_0, x00); + accum_1 = _mm512_add_pd(accum_1, x01); + + n2 -= 16; + x1 += 16; + } + + if (n2 >= 8) { + x00 = _mm512_load_pd(&x1[ 0]); + accum_0 = _mm512_add_pd(accum_0, x00); + + n2 -= 8; + x1 += 8; + } + + if (n2) { + unsigned char tail_mask8 = (((unsigned char) 0xff) >> (8 - n2)); + x00 = _mm512_maskz_load_pd(*((__mmask8*) &tail_mask8), &x1[ 0]); + accum_0 = _mm512_add_pd(accum_0, x00); + } + + accum_0 = _mm512_add_pd(accum_0, accum_1); + accum_2 = _mm512_add_pd(accum_2, accum_3); + accum_0 = _mm512_add_pd(accum_0, accum_2); + sumf = _mm512_reduce_add_pd(accum_0); + } + } + + return sumf; +} +#endif +#endif diff --git a/kernel/x86_64/zsum_sse.S b/kernel/x86_64/zsum_sse.S new file mode 100644 index 000000000..b679b42b0 --- /dev/null +++ b/kernel/x86_64/zsum_sse.S @@ -0,0 +1,299 @@ +/*********************************************************************/ +/* Copyright 2009, 2010 The University of Texas at Austin. */ +/* All rights reserved. */ +/* */ +/* Redistribution and use in source and binary forms, with or */ +/* without modification, are permitted provided that the following */ +/* conditions are met: */ +/* */ +/* 1. Redistributions of source code must retain the above */ +/* copyright notice, this list of conditions and the following */ +/* disclaimer. */ +/* */ +/* 2. 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. */ +/* */ +/* THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY OF TEXAS AT */ +/* AUSTIN ``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 UNIVERSITY OF TEXAS AT */ +/* AUSTIN 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. */ +/* */ +/* The views and conclusions contained in the software and */ +/* documentation are those of the authors and should not be */ +/* interpreted as representing official policies, either expressed */ +/* or implied, of The University of Texas at Austin. */ +/*********************************************************************/ + +#define ASSEMBLER +#include "common.h" + +#define M ARG1 /* rdi */ +#define X ARG2 /* rsi */ +#define INCX ARG3 /* rdx */ + +#define I %rax + +#include "l1param.h" + + PROLOGUE + PROFCODE + + SAVEREGISTERS + + pxor %xmm0, %xmm0 + testq M, M + jle .L999 + testq INCX, INCX + jle .L999 + + pxor %xmm1, %xmm1 + pxor %xmm2, %xmm2 + pxor %xmm3, %xmm3 + + salq $ZBASE_SHIFT, INCX + + cmpq $2 * SIZE, INCX + jne .L100 + + subq $-32 * SIZE, X + addq M, M + + cmpq $3, M + jle .L18 + + testq $4, X + je .L05 + movss -32 * SIZE(X), %xmm0 + addq $SIZE, X + decq M + jle .L998 + ALIGN_3 + +.L05: + testq $8, X + je .L10 + +#ifdef movsd + xorps %xmm1, %xmm1 +#endif + movsd -32 * SIZE(X), %xmm1 + addq $2 * SIZE, X + subq $2, M + jle .L998 + ALIGN_3 + +.L10: + movq M, I + sarq $5, I + jle .L14 + + movaps -32 * SIZE(X), %xmm4 + movaps -28 * SIZE(X), %xmm5 + movaps -24 * SIZE(X), %xmm6 + movaps -20 * SIZE(X), %xmm7 + + movaps -16 * SIZE(X), %xmm8 + movaps -12 * SIZE(X), %xmm9 + movaps -8 * SIZE(X), %xmm10 + movaps -4 * SIZE(X), %xmm11 + decq I + jle .L12 + ALIGN_3 + +.L11: +#ifdef PREFETCH + PREFETCH (PREFETCHSIZE + 0) - PREOFFSET(X) +#endif + + addps %xmm4, %xmm0 + movaps 0 * SIZE(X), %xmm4 + + addps %xmm5, %xmm1 + movaps 4 * SIZE(X), %xmm5 + + addps %xmm6, %xmm2 + movaps 8 * SIZE(X), %xmm6 + + addps %xmm7, %xmm3 + movaps 12 * SIZE(X), %xmm7 + +#if defined(PREFETCH) && !defined(FETCH128) + PREFETCH (PREFETCHSIZE + 64) - PREOFFSET(X) +#endif + + addps %xmm8, %xmm0 + movaps 16 * SIZE(X), %xmm8 + + addps %xmm9, %xmm1 + movaps 20 * SIZE(X), %xmm9 + + addps %xmm10, %xmm2 + movaps 24 * SIZE(X), %xmm10 + + addps %xmm11, %xmm3 + movaps 28 * SIZE(X), %xmm11 + + subq $-32 * SIZE, X + decq I + jg .L11 + ALIGN_3 + +.L12: + addps %xmm4, %xmm0 + addps %xmm5, %xmm1 + + addps %xmm6, %xmm2 + addps %xmm7, %xmm3 + + addps %xmm8, %xmm0 + addps %xmm9, %xmm1 + + addps %xmm10, %xmm2 + addps %xmm11, %xmm3 + + addq $32 * SIZE, X + ALIGN_3 + +.L14: + testq $31, M + jle .L998 + +.L15: + testq $16, M + je .L16 + + movaps -32 * SIZE(X), %xmm4 + addps %xmm4, %xmm0 + + movaps -28 * SIZE(X), %xmm5 + addps %xmm5, %xmm1 + + movaps -24 * SIZE(X), %xmm4 + addps %xmm4, %xmm0 + + movaps -20 * SIZE(X), %xmm5 + addps %xmm5, %xmm1 + + addq $16 * SIZE, X + ALIGN_3 + +.L16: + testq $8, M + je .L17 + + movaps -32 * SIZE(X), %xmm4 + addps %xmm4, %xmm0 + + movaps -28 * SIZE(X), %xmm5 + addps %xmm5, %xmm1 + + addq $8 * SIZE, X + ALIGN_3 + +.L17: + testq $4, M + je .L18 + + movaps -32 * SIZE(X), %xmm6 + addps %xmm6, %xmm2 + addq $4 * SIZE, X + ALIGN_3 + +.L18: + testq $2, M + je .L19 + +#ifdef movsd + xorps %xmm7, %xmm7 +#endif + movsd -32 * SIZE(X), %xmm7 + addps %xmm7, %xmm3 + addq $2 * SIZE, X + ALIGN_3 + +.L19: + testq $1, M + je .L998 + + movss -32 * SIZE(X), %xmm6 + addps %xmm6, %xmm2 + jmp .L998 + ALIGN_4 + +.L100: + movq M, I + sarq $2, I + jle .L105 + ALIGN_4 + +.L101: + movsd (X), %xmm4 + addq INCX, X + movhps (X), %xmm4 + addq INCX, X + + addps %xmm4, %xmm0 + + movsd (X), %xmm5 + addq INCX, X + movhps (X), %xmm5 + addq INCX, X + + addps %xmm5, %xmm1 + + decq I + jg .L101 + ALIGN_4 + +.L105: +#ifdef movsd + xorps %xmm4, %xmm4 +#endif + andq $3, M + jle .L998 + ALIGN_4 + +.L106: + movsd (X), %xmm4 + addps %xmm4, %xmm0 + addq INCX, X + decq M + jg .L106 + ALIGN_4 + +.L998: + addps %xmm1, %xmm0 + addps %xmm3, %xmm2 + addps %xmm2, %xmm0 + +#ifndef HAVE_SSE3 + movhlps %xmm0, %xmm1 + addps %xmm1, %xmm0 + + movaps %xmm0, %xmm1 + shufps $1, %xmm0, %xmm0 + addss %xmm1, %xmm0 +#else + haddps %xmm0, %xmm0 + haddps %xmm0, %xmm0 +#endif + ALIGN_4 + +.L999: + RESTOREREGISTERS + + ret + + EPILOGUE diff --git a/kernel/x86_64/zsum_sse2.S b/kernel/x86_64/zsum_sse2.S new file mode 100644 index 000000000..6f667164d --- /dev/null +++ b/kernel/x86_64/zsum_sse2.S @@ -0,0 +1,283 @@ +/*********************************************************************/ +/* Copyright 2009, 2010 The University of Texas at Austin. */ +/* All rights reserved. */ +/* */ +/* Redistribution and use in source and binary forms, with or */ +/* without modification, are permitted provided that the following */ +/* conditions are met: */ +/* */ +/* 1. Redistributions of source code must retain the above */ +/* copyright notice, this list of conditions and the following */ +/* disclaimer. */ +/* */ +/* 2. 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. */ +/* */ +/* THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY OF TEXAS AT */ +/* AUSTIN ``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 UNIVERSITY OF TEXAS AT */ +/* AUSTIN 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. */ +/* */ +/* The views and conclusions contained in the software and */ +/* documentation are those of the authors and should not be */ +/* interpreted as representing official policies, either expressed */ +/* or implied, of The University of Texas at Austin. */ +/*********************************************************************/ + +#define ASSEMBLER +#include "common.h" + +#define M ARG1 /* rdi */ +#define X ARG2 /* rsi */ +#define INCX ARG3 /* rdx */ + +#define I %rax + +#include "l1param.h" + + PROLOGUE + PROFCODE + + SAVEREGISTERS + + xorps %xmm0, %xmm0 + testq M, M + jle .L999 + testq INCX, INCX + jle .L999 + + xorps %xmm1, %xmm1 + xorps %xmm2, %xmm2 + xorps %xmm3, %xmm3 + + salq $ZBASE_SHIFT, INCX + + cmpq $2 * SIZE, INCX + jne .L40 + + subq $-16 * SIZE, X + addq M, M + + testq $SIZE, X + je .L05 + +#ifdef movsd + xorps %xmm0, %xmm0 +#endif + movsd -16 * SIZE(X), %xmm0 + addq $SIZE, X + + subq $1, M + jle .L999 + ALIGN_3 + +.L05: + movq M, I + sarq $4, I + jle .L20 + + movaps -16 * SIZE(X), %xmm4 + movaps -14 * SIZE(X), %xmm5 + movaps -12 * SIZE(X), %xmm6 + movaps -10 * SIZE(X), %xmm7 + + movaps -8 * SIZE(X), %xmm8 + movaps -6 * SIZE(X), %xmm9 + movaps -4 * SIZE(X), %xmm10 + movaps -2 * SIZE(X), %xmm11 + + decq I + jle .L11 + ALIGN_4 + +.L10: +#ifdef PREFETCH + PREFETCH (PREFETCHSIZE + 0) - PREOFFSET(X) +#endif + + addpd %xmm4, %xmm0 + movaps 0 * SIZE(X), %xmm4 + + addpd %xmm5, %xmm1 + movaps 2 * SIZE(X), %xmm5 + + addpd %xmm6, %xmm2 + movaps 4 * SIZE(X), %xmm6 + + addpd %xmm7, %xmm3 + movaps 6 * SIZE(X), %xmm7 + +#if defined(PREFETCH) && !defined(FETCH128) + PREFETCH (PREFETCHSIZE + 64) - PREOFFSET(X) +#endif + + addpd %xmm8, %xmm0 + movaps 8 * SIZE(X), %xmm8 + + addpd %xmm9, %xmm1 + movaps 10 * SIZE(X), %xmm9 + + addpd %xmm10, %xmm2 + movaps 12 * SIZE(X), %xmm10 + + addpd %xmm11, %xmm3 + movaps 14 * SIZE(X), %xmm11 + + subq $-16 * SIZE, X + decq I + jg .L10 + ALIGN_4 + +.L11: + + addpd %xmm4, %xmm0 + addpd %xmm5, %xmm1 + addpd %xmm6, %xmm2 + addpd %xmm7, %xmm3 + + addpd %xmm8, %xmm0 + addpd %xmm9, %xmm1 + addpd %xmm10, %xmm2 + addpd %xmm11, %xmm3 + + subq $-16 * SIZE, X + ALIGN_3 + +.L20: + andq $15, M + jle .L998 + + testq $8, M + je .L21 + + movaps -16 * SIZE(X), %xmm4 + movaps -14 * SIZE(X), %xmm5 + movaps -12 * SIZE(X), %xmm6 + movaps -10 * SIZE(X), %xmm7 + + addpd %xmm4, %xmm0 + addpd %xmm5, %xmm1 + addpd %xmm6, %xmm2 + addpd %xmm7, %xmm3 + addq $8 * SIZE, X + ALIGN_3 + +.L21: + testq $4, M + je .L22 + + movaps -16 * SIZE(X), %xmm4 + movaps -14 * SIZE(X), %xmm5 + + addpd %xmm4, %xmm0 + addpd %xmm5, %xmm1 + + addq $4 * SIZE, X + ALIGN_3 + +.L22: + testq $2, M + je .L23 + + movaps -16 * SIZE(X), %xmm6 + addpd %xmm6, %xmm3 + addq $2 * SIZE, X + +.L23: + testq $1, M + je .L998 + +#ifdef movsd + xorps %xmm4, %xmm4 +#endif + movsd -16 * SIZE(X), %xmm4 + addsd %xmm4, %xmm0 + jmp .L998 + ALIGN_3 + + +.L40: + movq M, I + sarq $2, I + jle .L60 + ALIGN_4 + +.L50: +#if defined(OPTERON) || defined(BARCELONA) || defined(SHANGHAI) + prefetcht0 PREFETCHSIZE * SIZE(X) +#endif + +#ifdef PENTIUM4 + prefetchnta PREFETCHSIZE * SIZE(X) +#endif + + movsd 0 * SIZE(X), %xmm4 + movhpd 1 * SIZE(X), %xmm4 + addq INCX, X + addpd %xmm4, %xmm0 + + movsd 0 * SIZE(X), %xmm5 + movhpd 1 * SIZE(X), %xmm5 + addq INCX, X + addpd %xmm5, %xmm1 + + movsd 0 * SIZE(X), %xmm6 + movhpd 1 * SIZE(X), %xmm6 + addq INCX, X + addpd %xmm6, %xmm2 + + movsd 0 * SIZE(X), %xmm7 + movhpd 1 * SIZE(X), %xmm7 + addq INCX, X + addpd %xmm7, %xmm3 + + decq I + jg .L50 + ALIGN_4 + +.L60: + andq $3, M + jle .L998 + ALIGN_4 + + +.L61: + movsd 0 * SIZE(X), %xmm4 + movhpd 1 * SIZE(X), %xmm4 + addpd %xmm4, %xmm0 + addq INCX, X + decq M + jg .L61 + ALIGN_4 + +.L998: + addpd %xmm1, %xmm0 + addpd %xmm3, %xmm2 + addpd %xmm2, %xmm0 + +#ifndef HAVE_SSE3 + movhlps %xmm0, %xmm1 + addsd %xmm1, %xmm0 +#else + haddpd %xmm0, %xmm0 +#endif + ALIGN_4 + +.L999: + RESTOREREGISTERS + + ret + + EPILOGUE From 12787775d92c700d9f5956ea35cbcb0576e4ab2a Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Sun, 25 Feb 2024 17:55:36 +0100 Subject: [PATCH 176/311] add csum/zsum kernels (trivially derived from the asum ones)s) --- kernel/arm64/KERNEL.ARMV8SVE | 3 + kernel/arm64/csum_thunderx2t99.c | 247 +++++++++++++++++++++++++++++++ kernel/arm64/zsum_thunderx2t99.c | 244 ++++++++++++++++++++++++++++++ 3 files changed, 494 insertions(+) create mode 100644 kernel/arm64/csum_thunderx2t99.c create mode 100644 kernel/arm64/zsum_thunderx2t99.c diff --git a/kernel/arm64/KERNEL.ARMV8SVE b/kernel/arm64/KERNEL.ARMV8SVE index ccbce27e1..eeb4844bf 100644 --- a/kernel/arm64/KERNEL.ARMV8SVE +++ b/kernel/arm64/KERNEL.ARMV8SVE @@ -1,3 +1,6 @@ + +CSUMKERNEL = csum_thunderx2t99.c +ZSUMKERNEL = zsum_thunderx2t99.c SAMINKERNEL = ../arm/amin.c DAMINKERNEL = ../arm/amin.c CAMINKERNEL = ../arm/zamin.c diff --git a/kernel/arm64/csum_thunderx2t99.c b/kernel/arm64/csum_thunderx2t99.c new file mode 100644 index 000000000..874f4eb5a --- /dev/null +++ b/kernel/arm64/csum_thunderx2t99.c @@ -0,0 +1,247 @@ +/*************************************************************************** +Copyright (c) 2017, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" + +#include + +#define N "x0" /* vector length */ +#define X "x1" /* "X" vector address */ +#define INC_X "x2" /* "X" stride */ +#define J "x5" /* loop variable */ + +#define REG0 "wzr" +#define SUMF "s0" +#define SUMFD "d0" + +/******************************************************************************/ + +#define KERNEL_F1 \ + "ldr d1, ["X"] \n" \ + "add "X", "X", #8 \n" \ + "ext v2.8b, v1.8b, v1.8b, #4 \n" \ + "fadd s1, s1, s2 \n" \ + "fadd "SUMF", "SUMF", s1 \n" + +#define KERNEL_F32 \ + "ldr q16, ["X"] \n" \ + "ldr q17, ["X", #16] \n" \ + "ldr q18, ["X", #32] \n" \ + "ldr q19, ["X", #48] \n" \ + "ldp q20, q21, ["X", #64] \n" \ + "ldp q22, q23, ["X", #96] \n" \ + "ldp q24, q25, ["X", #128] \n" \ + "ldp q26, q27, ["X", #160] \n" \ + "fadd v16.4s, v16.4s, v17.4s \n" \ + "fadd v18.4s, v18.4s, v19.4s \n" \ + "ldp q28, q29, ["X", #192] \n" \ + "ldp q30, q31, ["X", #224] \n" \ + "add "X", "X", #256 \n" \ + "fadd v20.4s, v20.4s, v21.4s \n" \ + "fadd v22.4s, v22.4s, v23.4s \n" \ + "PRFM PLDL1KEEP, ["X", #1024] \n" \ + "PRFM PLDL1KEEP, ["X", #1024+64] \n" \ + "fadd v24.4s, v24.4s, v25.4s \n" \ + "fadd v26.4s, v26.4s, v27.4s \n" \ + "fadd v0.4s, v0.4s, v16.4s \n" \ + "fadd v1.4s, v1.4s, v18.4s \n" \ + "fadd v2.4s, v2.4s, v20.4s \n" \ + "fadd v3.4s, v3.4s, v22.4s \n" \ + "PRFM PLDL1KEEP, ["X", #1024+128] \n" \ + "PRFM PLDL1KEEP, ["X", #1024+192] \n" \ + "fadd v28.4s, v28.4s, v29.4s \n" \ + "fadd v30.4s, v30.4s, v31.4s \n" \ + "fadd v4.4s, v4.4s, v24.4s \n" \ + "fadd v5.4s, v5.4s, v26.4s \n" \ + "fadd v6.4s, v6.4s, v28.4s \n" \ + "fadd v7.4s, v7.4s, v30.4s \n" + +#define KERNEL_F32_FINALIZE \ + "fadd v0.4s, v0.4s, v1.4s \n" \ + "fadd v2.4s, v2.4s, v3.4s \n" \ + "fadd v4.4s, v4.4s, v5.4s \n" \ + "fadd v6.4s, v6.4s, v7.4s \n" \ + "fadd v0.4s, v0.4s, v2.4s \n" \ + "fadd v4.4s, v4.4s, v6.4s \n" \ + "fadd v0.4s, v0.4s, v4.4s \n" \ + "ext v1.16b, v0.16b, v0.16b, #8 \n" \ + "fadd v0.2s, v0.2s, v1.2s \n" \ + "faddp "SUMF", v0.2s \n" + +#define INIT_S \ + "lsl "INC_X", "INC_X", #3 \n" + +#define KERNEL_S1 \ + "ldr d1, ["X"] \n" \ + "add "X", "X", "INC_X" \n" \ + "ext v2.8b, v1.8b, v1.8b, #4 \n" \ + "fadd s1, s1, s2 \n" \ + "fadd "SUMF", "SUMF", s1 \n" + + +#if defined(SMP) +extern int blas_level1_thread_with_return_value(int mode, BLASLONG m, BLASLONG n, + BLASLONG k, void *alpha, void *a, BLASLONG lda, void *b, BLASLONG ldb, + void *c, BLASLONG ldc, int (*function)(), int nthreads); +#endif + + +static FLOAT casum_compute(BLASLONG n, FLOAT *x, BLASLONG inc_x) +{ + FLOAT asum = 0.0 ; + + if ( n < 0 ) return(asum); + + __asm__ __volatile__ ( + " mov "N", %[N_] \n" + " mov "X", %[X_] \n" + " mov "INC_X", %[INCX_] \n" + " fmov "SUMF", "REG0" \n" + " fmov s1, "REG0" \n" + " fmov s2, "REG0" \n" + " fmov s3, "REG0" \n" + " fmov s4, "REG0" \n" + " fmov s5, "REG0" \n" + " fmov s6, "REG0" \n" + " fmov s7, "REG0" \n" + " cmp "N", xzr \n" + " ble 9f //asum_kernel_L999 \n" + " cmp "INC_X", xzr \n" + " ble 9f //asum_kernel_L999 \n" + " cmp "INC_X", #1 \n" + " bne 5f //asum_kernel_S_BEGIN \n" + + "1: //asum_kernel_F_BEGIN: \n" + " asr "J", "N", #5 \n" + " cmp "J", xzr \n" + " beq 3f //asum_kernel_F1 \n" + + "2: //asum_kernel_F32: \n" + " "KERNEL_F32" \n" + " subs "J", "J", #1 \n" + " bne 2b //asum_kernel_F32 \n" + " "KERNEL_F32_FINALIZE" \n" + + "3: //asum_kernel_F1: \n" + " ands "J", "N", #31 \n" + " ble 9f //asum_kernel_L999 \n" + + "4: //asum_kernel_F10: \n" + " "KERNEL_F1" \n" + " subs "J", "J", #1 \n" + " bne 4b //asum_kernel_F10 \n" + " b 9f //asum_kernel_L999 \n" + + "5: //asum_kernel_S_BEGIN: \n" + " "INIT_S" \n" + " asr "J", "N", #2 \n" + " cmp "J", xzr \n" + " ble 7f //asum_kernel_S1 \n" + + "6: //asum_kernel_S4: \n" + " "KERNEL_S1" \n" + " "KERNEL_S1" \n" + " "KERNEL_S1" \n" + " "KERNEL_S1" \n" + " subs "J", "J", #1 \n" + " bne 6b //asum_kernel_S4 \n" + + "7: //asum_kernel_S1: \n" + " ands "J", "N", #3 \n" + " ble 9f //asum_kernel_L999 \n" + + "8: //asum_kernel_S10: \n" + " "KERNEL_S1" \n" + " subs "J", "J", #1 \n" + " bne 8b //asum_kernel_S10 \n" + + "9: //asum_kernel_L999: \n" + " fmov %[ASUM_], "SUMFD" \n" + + : [ASUM_] "=r" (asum) //%0 + : [N_] "r" (n), //%1 + [X_] "r" (x), //%2 + [INCX_] "r" (inc_x) //%3 + : "cc", + "memory", + "x0", "x1", "x2", "x3", "x4", "x5", + "d0", "d1", "d2", "d3", "d4", "d5", "d6", "d7" + ); + + return asum; +} + +#if defined(SMP) +static int casum_thread_function(BLASLONG n, BLASLONG dummy0, + BLASLONG dummy1, FLOAT dummy2, FLOAT *x, BLASLONG inc_x, FLOAT *y, + BLASLONG inc_y, FLOAT *result, BLASLONG dummy3) +{ + *result = casum_compute(n, x, inc_x); + + return 0; +} +#endif + +FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) +{ +#if defined(SMP) + int nthreads; + FLOAT dummy_alpha; +#endif + FLOAT asum = 0.0; + +#if defined(SMP) + if (inc_x == 0 || n <= 10000) + nthreads = 1; + else + nthreads = num_cpu_avail(1); + + if (nthreads == 1) { + asum = casum_compute(n, x, inc_x); + } else { + int mode, i; + char result[MAX_CPU_NUMBER * sizeof(double) * 2]; + FLOAT *ptr; + + mode = BLAS_SINGLE | BLAS_COMPLEX; + + blas_level1_thread_with_return_value(mode, n, 0, 0, &dummy_alpha, + x, inc_x, NULL, 0, result, 0, + ( void *)casum_thread_function, nthreads); + + ptr = (FLOAT *)result; + for (i = 0; i < nthreads; i++) { + asum = asum + (*ptr); + ptr = (FLOAT *)(((char *)ptr) + sizeof(double) * 2); + } + } +#else + asum = casum_compute(n, x, inc_x); +#endif + + return asum; +} diff --git a/kernel/arm64/zsum_thunderx2t99.c b/kernel/arm64/zsum_thunderx2t99.c new file mode 100644 index 000000000..087dae2fe --- /dev/null +++ b/kernel/arm64/zsum_thunderx2t99.c @@ -0,0 +1,244 @@ +/*************************************************************************** +Copyright (c) 2017, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" + +#include + +#define N "x0" /* vector length */ +#define X "x1" /* "X" vector address */ +#define INC_X "x2" /* "X" stride */ +#define J "x5" /* loop variable */ + +#define REG0 "xzr" +#define SUMF "d0" +#define TMPF "d1" + +/******************************************************************************/ + +#define KERNEL_F1 \ + "ldr q1, ["X"] \n" \ + "add "X", "X", #16 \n" \ + "faddp d1, v1.2d \n" \ + "fadd "SUMF", "SUMF", d1 \n" + +#define KERNEL_F16 \ + "ldr q16, ["X"] \n" \ + "ldr q17, ["X", #16] \n" \ + "ldr q18, ["X", #32] \n" \ + "ldr q19, ["X", #48] \n" \ + "ldp q20, q21, ["X", #64] \n" \ + "ldp q22, q23, ["X", #96] \n" \ + "ldp q24, q25, ["X", #128] \n" \ + "ldp q26, q27, ["X", #160] \n" \ + "fadd v16.2d, v16.2d, v17.2d \n" \ + "fadd v18.2d, v18.2d, v19.2d \n" \ + "ldp q28, q29, ["X", #192] \n" \ + "ldp q30, q31, ["X", #224] \n" \ + "add "X", "X", #256 \n" \ + "fadd v20.2d, v20.2d, v21.2d \n" \ + "fadd v22.2d, v22.2d, v23.2d \n" \ + "PRFM PLDL1KEEP, ["X", #1024] \n" \ + "PRFM PLDL1KEEP, ["X", #1024+64] \n" \ + "fadd v24.2d, v24.2d, v25.2d \n" \ + "fadd v26.2d, v26.2d, v27.2d \n" \ + "fadd v28.2d, v28.2d, v29.2d \n" \ + "fadd v30.2d, v30.2d, v31.2d \n" \ + "fadd v0.2d, v0.2d, v16.2d \n" \ + "fadd v1.2d, v1.2d, v18.2d \n" \ + "fadd v2.2d, v2.2d, v20.2d \n" \ + "fadd v3.2d, v3.2d, v22.2d \n" \ + "PRFM PLDL1KEEP, ["X", #1024+128] \n" \ + "PRFM PLDL1KEEP, ["X", #1024+192] \n" \ + "fadd v4.2d, v4.2d, v24.2d \n" \ + "fadd v5.2d, v5.2d, v26.2d \n" \ + "fadd v6.2d, v6.2d, v28.2d \n" \ + "fadd v7.2d, v7.2d, v30.2d \n" + +#define KERNEL_F16_FINALIZE \ + "fadd v0.2d, v0.2d, v1.2d \n" \ + "fadd v2.2d, v2.2d, v3.2d \n" \ + "fadd v4.2d, v4.2d, v5.2d \n" \ + "fadd v6.2d, v6.2d, v7.2d \n" \ + "fadd v0.2d, v0.2d, v2.2d \n" \ + "fadd v4.2d, v4.2d, v6.2d \n" \ + "fadd v0.2d, v0.2d, v4.2d \n" \ + "faddp "SUMF", v0.2d \n" + +#define INIT_S \ + "lsl "INC_X", "INC_X", #4 \n" + +#define KERNEL_S1 \ + "ldr q1, ["X"] \n" \ + "add "X", "X", "INC_X" \n" \ + "faddp d1, v1.2d \n" \ + "fadd "SUMF", "SUMF", d1 \n" + + +#if defined(SMP) +extern int blas_level1_thread_with_return_value(int mode, BLASLONG m, BLASLONG n, + BLASLONG k, void *alpha, void *a, BLASLONG lda, void *b, BLASLONG ldb, + void *c, BLASLONG ldc, int (*function)(), int nthreads); +#endif + + +static FLOAT zasum_compute(BLASLONG n, FLOAT *x, BLASLONG inc_x) +{ + FLOAT asum = 0.0 ; + + if ( n < 0 ) return(asum); + + __asm__ __volatile__ ( + " mov "N", %[N_] \n" + " mov "X", %[X_] \n" + " mov "INC_X", %[INCX_] \n" + " fmov "SUMF", "REG0" \n" + " fmov d1, "REG0" \n" + " fmov d2, "REG0" \n" + " fmov d3, "REG0" \n" + " fmov d4, "REG0" \n" + " fmov d5, "REG0" \n" + " fmov d6, "REG0" \n" + " fmov d7, "REG0" \n" + " cmp "N", xzr \n" + " ble 9f //asum_kernel_L999 \n" + " cmp "INC_X", xzr \n" + " ble 9f //asum_kernel_L999 \n" + " cmp "INC_X", #1 \n" + " bne 5f //asum_kernel_S_BEGIN \n" + + "1: //asum_kernel_F_BEGIN: \n" + " asr "J", "N", #4 \n" + " cmp "J", xzr \n" + " beq 3f //asum_kernel_F1 \n" + + ".align 5 \n" + "2: //asum_kernel_F16: \n" + " "KERNEL_F16" \n" + " subs "J", "J", #1 \n" + " bne 2b //asum_kernel_F16 \n" + " "KERNEL_F16_FINALIZE" \n" + + "3: //asum_kernel_F1: \n" + " ands "J", "N", #15 \n" + " ble 9f //asum_kernel_L999 \n" + + "4: //asum_kernel_F10: \n" + " "KERNEL_F1" \n" + " subs "J", "J", #1 \n" + " bne 4b //asum_kernel_F10 \n" + " b 9f //asum_kernel_L999 \n" + + "5: //asum_kernel_S_BEGIN: \n" + " "INIT_S" \n" + " asr "J", "N", #2 \n" + " cmp "J", xzr \n" + " ble 7f //asum_kernel_S1 \n" + + "6: //asum_kernel_S4: \n" + " "KERNEL_S1" \n" + " "KERNEL_S1" \n" + " "KERNEL_S1" \n" + " "KERNEL_S1" \n" + " subs "J", "J", #1 \n" + " bne 6b //asum_kernel_S4 \n" + + "7: //asum_kernel_S1: \n" + " ands "J", "N", #3 \n" + " ble 9f //asum_kernel_L999 \n" + + "8: //asum_kernel_S10: \n" + " "KERNEL_S1" \n" + " subs "J", "J", #1 \n" + " bne 8b //asum_kernel_S10 \n" + + "9: //asum_kernel_L999: \n" + " fmov %[ASUM_], "SUMF" \n" + + : [ASUM_] "=r" (asum) //%0 + : [N_] "r" (n), //%1 + [X_] "r" (x), //%2 + [INCX_] "r" (inc_x) //%3 + : "cc", + "memory", + "x0", "x1", "x2", "x3", "x4", "x5", + "d0", "d1", "d2", "d3", "d4", "d5", "d6", "d7" + ); + + return asum; +} + +#if defined(SMP) +static int zasum_thread_function(BLASLONG n, BLASLONG dummy0, + BLASLONG dummy1, FLOAT dummy2, FLOAT *x, BLASLONG inc_x, FLOAT *y, + BLASLONG inc_y, FLOAT *result, BLASLONG dummy3) +{ + *result = zasum_compute(n, x, inc_x); + + return 0; +} +#endif + +FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) +{ +#if defined(SMP) + int nthreads; + FLOAT dummy_alpha; +#endif + FLOAT asum = 0.0; + +#if defined(SMP) + if (inc_x == 0 || n <= 10000) + nthreads = 1; + else + nthreads = num_cpu_avail(1); + + if (nthreads == 1) { + asum = zasum_compute(n, x, inc_x); + } else { + int mode, i; + char result[MAX_CPU_NUMBER * sizeof(double) * 2]; + FLOAT *ptr; + + mode = BLAS_DOUBLE | BLAS_COMPLEX; + + blas_level1_thread_with_return_value(mode, n, 0, 0, &dummy_alpha, + x, inc_x, NULL, 0, result, 0, + ( void *)zasum_thread_function, nthreads); + + ptr = (FLOAT *)result; + for (i = 0; i < nthreads; i++) { + asum = asum + (*ptr); + ptr = (FLOAT *)(((char *)ptr) + sizeof(double) * 2); + } + } +#else + asum = zasum_compute(n, x, inc_x); +#endif + + return asum; +} From 7d506984fa2c1d1f8dd981969d84788d087907f5 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Sun, 25 Feb 2024 17:57:11 +0100 Subject: [PATCH 177/311] fix assignment of default CSUM kernel --- kernel/arm64/KERNEL | 2 ++ 1 file changed, 2 insertions(+) diff --git a/kernel/arm64/KERNEL b/kernel/arm64/KERNEL index f936cdf47..7d7e648c4 100644 --- a/kernel/arm64/KERNEL +++ b/kernel/arm64/KERNEL @@ -1,3 +1,5 @@ +CSUMKERNEL=csum.S + ifndef SNRM2KERNEL SNRM2KERNEL = ../arm/nrm2.c endif From baf88564bcf857f088839158d07ec05380ed4c7f Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Sun, 25 Feb 2024 19:23:41 +0100 Subject: [PATCH 178/311] Fix potential buffer overflow --- interface/gemmt.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/interface/gemmt.c b/interface/gemmt.c index 018deb7fb..cae00877e 100644 --- a/interface/gemmt.c +++ b/interface/gemmt.c @@ -522,7 +522,7 @@ void CNAME(enum CBLAS_ORDER order, enum CBLAS_UPLO Uplo, IDEBUG_START; - buffer_size = j + k + 128 / sizeof(FLOAT); + buffer_size = 2 * (j + k) + 128 / sizeof(FLOAT); #ifdef WINDOWS_ABI buffer_size += 160 / sizeof(FLOAT); #endif @@ -611,7 +611,7 @@ void CNAME(enum CBLAS_ORDER order, enum CBLAS_UPLO Uplo, #endif IDEBUG_START; - buffer_size = j + k + 128 / sizeof(FLOAT); + buffer_size = 2 * (j + k) + 128 / sizeof(FLOAT); #ifdef WINDOWS_ABI buffer_size += 160 / sizeof(FLOAT); #endif From 0ce794f0c363754e0a9c7c3b2d997e9fe7465c12 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Sun, 25 Feb 2024 23:38:36 +0100 Subject: [PATCH 179/311] Enable GEMM3M tests on supported platforms --- ctest/CMakeLists.txt | 46 +++++++++++++++++++++++++++++++++++++++++++- ctest/Makefile | 36 ++++++++++++++++++++++++++++++++-- 2 files changed, 79 insertions(+), 3 deletions(-) diff --git a/ctest/CMakeLists.txt b/ctest/CMakeLists.txt index 6e0a7f309..d7baadee4 100644 --- a/ctest/CMakeLists.txt +++ b/ctest/CMakeLists.txt @@ -10,6 +10,11 @@ if (CMAKE_Fortran_COMPILER_ID STREQUAL GNU) set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -fno-tree-vectorize") endif() +set (USE_GEMM3M 0) +if (${ARCH} MATCHES x86|x86_64|ia64|mips) + set(USE_GEMM3M 1) +endif () + if(WIN32) FILE(WRITE ${CMAKE_CURRENT_BINARY_DIR}/test_cblas_helper.ps1 "$ErrorActionPreference = \"Stop\"\n" @@ -88,6 +93,17 @@ if (NOT NOFORTRAN) auxiliary.c c_xerbla.c constant.c) + if (USE_GEMM3M) + if ((${float_char} STREQUAL "c") OR (${float_char} STREQUAL "z")) + add_executable(x${float_char}cblat3_3m + c_${float_char}blat3_3m.f + c_${float_char}blas3_3m.c + c_${float_char}3chke_3m.c + auxiliary.c + c_xerbla.c + constant.c) + endif() + endif() else() add_executable(x${float_char}cblat3 c_${float_char}blat3c.c @@ -96,6 +112,17 @@ else() auxiliary.c c_xerbla.c constant.c) + if (USE_GEMM3M) + if ((${float_char} STREQUAL "c") OR (${float_char} STREQUAL "z")) + add_executable(x${float_char}cblat3_3m + c_${float_char}blat3c_3m.c + c_${float_char}blas3_3m.c + c_${float_char}3chke_3m.c + auxiliary.c + c_xerbla.c + constant.c) + endif() + endif() endif() target_link_libraries(x${float_char}cblat3 ${OpenBLAS_LIBNAME}) if (USE_OPENMP AND (${CMAKE_Fortran_COMPILER_ID} STREQUAL GNU) AND (${CMAKE_C_COMPILER_ID} STREQUAL Clang)) @@ -105,7 +132,24 @@ endif() if(${CMAKE_SYSTEM_NAME} MATCHES "Linux" OR ${CMAKE_SYSTEM_NAME} MATCHES "FreeBSD" OR ${CMAKE_SYSTEM_NAME} MATCHES "QNX") target_link_libraries(x${float_char}cblat3 m) endif() + if (USE_GEMM3M) + if ((${float_char} STREQUAL "c") OR (${float_char} STREQUAL "z")) + target_link_libraries(x${float_char}cblat3_3m ${OpenBLAS_LIBNAME}) + if (USE_OPENMP AND (${CMAKE_Fortran_COMPILER_ID} STREQUAL GNU) AND (${CMAKE_C_COMPILER_ID} STREQUAL Clang)) + string(REGEX REPLACE "-fopenmp" "" CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS}") + target_link_libraries(x${float_char}cblat3 omp pthread) + endif() + if(${CMAKE_SYSTEM_NAME} MATCHES "Linux" OR ${CMAKE_SYSTEM_NAME} MATCHES "FreeBSD" OR ${CMAKE_SYSTEM_NAME} MATCHES "QNX") + target_link_libraries(x${float_char}cblat3_3m m) + endif() + endif() + endif() add_test(NAME "x${float_char}cblat3" COMMAND ${test_helper} $ "${PROJECT_SOURCE_DIR}/ctest/${float_char}in3") - + if (USE_GEMM3M) + if ((${float_char} STREQUAL "c") OR (${float_char} STREQUAL "z")) + add_test(NAME "x${float_char}cblat3_3m" + COMMAND ${test_helper} $ "${PROJECT_SOURCE_DIR}/ctest/${float_char}in3_3m") + endif() + endif() endforeach() diff --git a/ctest/Makefile b/ctest/Makefile index ad960b35a..36682c7b6 100644 --- a/ctest/Makefile +++ b/ctest/Makefile @@ -5,6 +5,24 @@ TOPDIR = .. include $(TOPDIR)/Makefile.system +SUPPORT_GEMM3M = 0 + +ifeq ($(ARCH), x86) +SUPPORT_GEMM3M = 1 +endif + +ifeq ($(ARCH), x86_64) +SUPPORT_GEMM3M = 1 +endif + +ifeq ($(ARCH), ia64) +SUPPORT_GEMM3M = 1 +endif + +ifeq ($(ARCH), MIPS) +SUPPORT_GEMM3M = 1 +endif + override CFLAGS += -DADD$(BU) -DCBLAS ifeq ($(F_COMPILER),GFORTRAN) override FFLAGS += -fno-tree-vectorize @@ -43,7 +61,7 @@ ztestl3o = c_zblas3.o c_z3chke.o auxiliary.o c_xerbla.o constant.o ztestl3o_3m = c_zblas3_3m.o c_z3chke_3m.o auxiliary.o c_xerbla.o constant.o -all :: all1 all2 all3 +all :: all1 all2 all3 all3_3m ifeq ($(BUILD_SINGLE),1) all1targets += xscblat1 @@ -182,8 +200,9 @@ endif endif all3_3m: xzcblat3_3m xccblat3_3m +ifeq ($(SUPPORT_GEMM3M),1) ifeq ($(USE_OPENMP), 1) -ifeq ($(BUILD_SINGLE),1) +ifeq ($(BUILD_COMPLEX),1) OMP_NUM_THREADS=2 ./xccblat3_3m < cin3_3m endif ifeq ($(BUILD_COMPLEX16),1) @@ -197,6 +216,7 @@ ifeq ($(BUILD_COMPLEX16),1) OPENBLAS_NUM_THREADS=2 ./xzcblat3_3m < zin3_3m endif endif +endif @@ -271,8 +291,10 @@ xccblat2: $(ctestl2o) c_cblat2.o $(TOPDIR)/$(LIBNAME) $(FC) $(FLDFLAGS) -o xccblat2 c_cblat2.o $(ctestl2o) $(LIB) $(EXTRALIB) $(CEXTRALIB) xccblat3: $(ctestl3o) c_cblat3.o $(TOPDIR)/$(LIBNAME) $(FC) $(FLDFLAGS) -o xccblat3 c_cblat3.o $(ctestl3o) $(LIB) $(EXTRALIB) $(CEXTRALIB) +ifeq ($(SUPPORT_GEMM3M),1) xccblat3_3m: $(ctestl3o_3m) c_cblat3_3m.o $(TOPDIR)/$(LIBNAME) $(FC) $(FLDFLAGS) -o xccblat3_3m c_cblat3_3m.o $(ctestl3o_3m) $(LIB) $(EXTRALIB) $(CEXTRALIB) +endif else xccblat1: $(ctestl1o) c_cblat1c.o $(TOPDIR)/$(LIBNAME) $(CC) $(CFLAGS) -o xccblat1 c_cblat1c.o $(ctestl1o) $(LIB) $(CEXTRALIB) $(filter-out -lgfortran,$(EXTRALIB)) @@ -280,6 +302,10 @@ xccblat2: $(ctestl2o) c_cblat2c.o $(TOPDIR)/$(LIBNAME) $(CC) $(CFLAGS) -o xccblat2 c_cblat2c.o $(ctestl2o) $(LIB) $(CEXTRALIB) $(filter-out -lgfortran,$(EXTRALIB)) xccblat3: $(ctestl3o) c_cblat3c.o $(TOPDIR)/$(LIBNAME) $(CC) $(CFLAGS) -o xccblat3 c_cblat3c.o $(ctestl3o) $(LIB) $(CEXTRALIB) $(filter-out -lgfortran,$(EXTRALIB)) +ifeq ($(SUPPORT_GEMM3M),1) +xccblat3_3m: $(ctestl3o_3m) c_cblat3c_3m.o $(TOPDIR)/$(LIBNAME) + $(CC) $(CFLAGS) -o xccblat3_3m c_cblat3c_3m.o $(ctestl3o_3m) $(LIB) $(EXTRALIB) $(CEXTRALIB) +endif endif endif @@ -293,8 +319,10 @@ xzcblat2: $(ztestl2o) c_zblat2.o $(TOPDIR)/$(LIBNAME) $(FC) $(FLDFLAGS) -o xzcblat2 c_zblat2.o $(ztestl2o) $(LIB) $(EXTRALIB) $(CEXTRALIB) xzcblat3: $(ztestl3o) c_zblat3.o $(TOPDIR)/$(LIBNAME) $(FC) $(FLDFLAGS) -o xzcblat3 c_zblat3.o $(ztestl3o) $(LIB) $(EXTRALIB) $(CEXTRALIB) +ifeq ($(SUPPORT_GEMM3M),1) xzcblat3_3m: $(ztestl3o_3m) c_zblat3_3m.o $(TOPDIR)/$(LIBNAME) $(FC) $(FLDFLAGS) -o xzcblat3_3m c_zblat3_3m.o $(ztestl3o_3m) $(LIB) $(EXTRALIB) $(CEXTRALIB) +endif else xzcblat1: $(ztestl1o) c_zblat1c.o $(TOPDIR)/$(LIBNAME) $(CC) $(CFLAGS) -o xzcblat1 c_zblat1c.o $(ztestl1o) $(LIB) $(CEXTRALIB) $(filter-out -lgfortran,$(EXTRALIB)) @@ -302,6 +330,10 @@ xzcblat2: $(ztestl2o) c_zblat2c.o $(TOPDIR)/$(LIBNAME) $(CC) $(CFLAGS) -o xzcblat2 c_zblat2c.o $(ztestl2o) $(LIB) $(CEXTRALIB) $(filter-out -lgfortran,$(EXTRALIB)) xzcblat3: $(ztestl3o) c_zblat3c.o $(TOPDIR)/$(LIBNAME) $(CC) $(CFLAGS) -o xzcblat3 c_zblat3c.o $(ztestl3o) $(LIB) $(CEXTRALIB) $(filter-out -lgfortran,$(EXTRALIB)) +ifeq ($(SUPPORT_GEMM3M),1) +xzcblat3_3m: $(ztestl3o_3m) c_zblat3c_3m.o $(TOPDIR)/$(LIBNAME) + $(CC) $(CFLAGS) -o xzcblat3_3m c_zblat3c_3m.o $(ztestl3o_3m) $(LIB) $(EXTRALIB) $(CEXTRALIB) +endif endif endif From ba201c1939fbb2e68ccb384709ee29e9e4559158 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Sun, 25 Feb 2024 23:39:24 +0100 Subject: [PATCH 180/311] Enable GEMM3M tests on supported platforms --- test/CMakeLists.txt | 19 ++++++++++++++++++- test/Makefile | 27 +++++++++++++++++++++++++++ 2 files changed, 45 insertions(+), 1 deletion(-) diff --git a/test/CMakeLists.txt b/test/CMakeLists.txt index ace20dffc..b4bf36cee 100644 --- a/test/CMakeLists.txt +++ b/test/CMakeLists.txt @@ -21,7 +21,18 @@ endif() if (BUILD_COMPLEX16) list (APPEND OpenBLAS_Tests zblat1 zblat2 zblat3) endif() -message (STATUS CCOMP ${CMAKE_C_COMPILER_ID} FCOMP ${CMAKE_Fortran_COMPILER_ID}) + +set (USE_GEMM3M 0) +if (${ARCH} MATCHES x86|x86_64|ia64|mips) + set(USE_GEMM3M 1) + if (BUILD_COMPLEX) + list (APPEND OpenBLAS_Tests cblat3_3m) + endif () + if (BUILD_COMPLEX16) + list (APPEND OpenBLAS_Tests zblat3_3m) + endif () +endif () + foreach(test_bin ${OpenBLAS_Tests}) add_executable(${test_bin} ${test_bin}.f) target_link_libraries(${test_bin} ${OpenBLAS_LIBNAME}) @@ -82,4 +93,10 @@ add_test(NAME "${float_type}blas2" COMMAND ${helper_prefix} $ "${PROJECT_SOURCE_DIR}/test/${float_type}blat2.dat" ${float_type_upper}BLAT2.SUMM) add_test(NAME "${float_type}blas3" COMMAND ${helper_prefix} $ "${PROJECT_SOURCE_DIR}/test/${float_type}blat3.dat" ${float_type_upper}BLAT3.SUMM) +if (USE_GEMM3M) +if ((${float_type} STREQUAL "c") OR (${float_type} STREQUAL "z")) +add_test(NAME "${float_type}blas3_3m" + COMMAND ${helper_prefix} $ "${PROJECT_SOURCE_DIR}/test/${float_type}blat3_3m.dat" ${float_type_upper}BLAT3_3M.SUMM) +endif() +endif() endforeach() diff --git a/test/Makefile b/test/Makefile index 5a4694ce6..6a50b6c98 100644 --- a/test/Makefile +++ b/test/Makefile @@ -4,6 +4,24 @@ ifeq ($(F_COMPILER),GFORTRAN) override FFLAGS += -fno-tree-vectorize endif +SUPPORT_GEMM3M = 0 + +ifeq ($(ARCH), x86) +SUPPORT_GEMM3M = 1 +endif + +ifeq ($(ARCH), x86_64) +SUPPORT_GEMM3M = 1 +endif + +ifeq ($(ARCH), ia64) +SUPPORT_GEMM3M = 1 +endif + +ifeq ($(ARCH), MIPS) +SUPPORT_GEMM3M = 1 +endif + ifeq ($(NOFORTRAN),1) all :: else @@ -153,11 +171,20 @@ ifeq ($(BUILD_DOUBLE),1) D3=dblat3 endif ifeq ($(BUILD_COMPLEX),1) +ifeq ($(SUPPORT_GEMM3M),1) +C3=cblat3 cblat3_3m +else C3=cblat3 endif +endif ifeq ($(BUILD_COMPLEX16),1) +ifeq ($(SUPPORT_GEMM3M),1) +Z3=zblat3 zblat3_3m +else Z3=zblat3 endif +endif + level3: $(B3) $(S3) $(D3) $(C3) $(Z3) From 87dd1c710e5bec07f72b0e30d8c81db3446c456d Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Mon, 26 Feb 2024 07:37:30 +0100 Subject: [PATCH 181/311] fix conditional gemm3m build --- ctest/Makefile | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/ctest/Makefile b/ctest/Makefile index 36682c7b6..3a3ee5611 100644 --- a/ctest/Makefile +++ b/ctest/Makefile @@ -61,7 +61,7 @@ ztestl3o = c_zblas3.o c_z3chke.o auxiliary.o c_xerbla.o constant.o ztestl3o_3m = c_zblas3_3m.o c_z3chke_3m.o auxiliary.o c_xerbla.o constant.o -all :: all1 all2 all3 all3_3m +all :: all1 all2 all3 ifeq ($(BUILD_SINGLE),1) all1targets += xscblat1 @@ -162,9 +162,15 @@ all3targets += xdcblat3 endif ifeq ($(BUILD_COMPLEX),1) all3targets += xccblat3 +ifeq ($(USE_GEMM3M),1) +all3targets += xccblat3_3m +endif endif ifeq ($(BUILD_COMPLEX16),1) all3targets += xzcblat3 +ifeq ($(USE_GEMM3M),1) +all3targets += xzcblat3_3m +endif endif all3: $(all3targets) @@ -199,7 +205,6 @@ endif endif endif -all3_3m: xzcblat3_3m xccblat3_3m ifeq ($(SUPPORT_GEMM3M),1) ifeq ($(USE_OPENMP), 1) ifeq ($(BUILD_COMPLEX),1) From 8dea25ffffca03dee25db035e7197f83402b117f Mon Sep 17 00:00:00 2001 From: gxw Date: Mon, 26 Feb 2024 02:04:37 -0500 Subject: [PATCH 182/311] LoongArch64: Fixed utest kernel_regress:skx_avx --- kernel/loongarch64/rot_lasx.S | 2 +- kernel/loongarch64/rot_lsx.S | 7 +++---- 2 files changed, 4 insertions(+), 5 deletions(-) diff --git a/kernel/loongarch64/rot_lasx.S b/kernel/loongarch64/rot_lasx.S index 5d7e3d7cc..71378e0b2 100644 --- a/kernel/loongarch64/rot_lasx.S +++ b/kernel/loongarch64/rot_lasx.S @@ -1036,7 +1036,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. add.d Y, Y, INCY xvfmul.d VT0, VX1, VXC xvfmadd.d VT0, VX3, VXS, VT0 - xvfmul.d VT1, VX0, VXS + xvfmul.d VT1, VX1, VXS xvfmsub.d VT1, VX3, VXC, VT1 xvstelm.d VT0, XX, 0, 0 add.d XX, XX, INCX diff --git a/kernel/loongarch64/rot_lsx.S b/kernel/loongarch64/rot_lsx.S index 4b0e59310..3bb77aaec 100644 --- a/kernel/loongarch64/rot_lsx.S +++ b/kernel/loongarch64/rot_lsx.S @@ -1142,7 +1142,6 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #ifdef DOUBLE vinsgr2vr.d VX0, t1, 0 vinsgr2vr.d VX0, t2, 1 - add.d X, X, INCX ld.d t1, Y, 0 * SIZE add.d Y, Y, INCY ld.d t2, Y, 0 * SIZE @@ -1199,7 +1198,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. add.d Y, Y, INCY VMUL VT0, VX1, VXC VFMADD VT0, VX3, VXS, VT0 - VMUL VT1, VX0, VXS + VMUL VT1, VX1, VXS VMSUB VT1, VX3, VXC, VT1 vstelm.d VT0, XX, 0, 0 add.d XX, XX, INCX @@ -1223,7 +1222,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. add.d Y, Y, INCY VMUL VT0, VX1, VXC VFMADD VT0, VX3, VXS, VT0 - VMUL VT1, VX0, VXS + VMUL VT1, VX1, VXS VMSUB VT1, VX3, VXC, VT1 vstelm.d VT0, XX, 0, 0 add.d XX, XX, INCX @@ -1296,7 +1295,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. add.d Y, Y, INCY VMUL VT0, VX1, VXC VFMADD VT0, VX3, VXS, VT0 - VMUL VT1, VX0, VXS + VMUL VT1, VX1, VXS VMSUB VT1, VX3, VXC, VT1 vstelm.w VT0, XX, 0, 0 add.d XX, XX, INCX From 5aaeca2896464a21e8c7f435bb28b5a44378c49e Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Mon, 26 Feb 2024 09:26:14 +0100 Subject: [PATCH 183/311] fix name --- ctest/Makefile | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/ctest/Makefile b/ctest/Makefile index 3a3ee5611..bbaf96f8e 100644 --- a/ctest/Makefile +++ b/ctest/Makefile @@ -162,13 +162,13 @@ all3targets += xdcblat3 endif ifeq ($(BUILD_COMPLEX),1) all3targets += xccblat3 -ifeq ($(USE_GEMM3M),1) +ifeq ($(SUPPORT_GEMM3M),1) all3targets += xccblat3_3m endif endif ifeq ($(BUILD_COMPLEX16),1) all3targets += xzcblat3 -ifeq ($(USE_GEMM3M),1) +ifeq ($(SUPPORT_GEMM3M),1) all3targets += xzcblat3_3m endif endif From ea167328f112bddc82eb5ab8ab9c330b4e210c36 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Mon, 26 Feb 2024 14:14:58 +0100 Subject: [PATCH 184/311] Add f2c-converted sources for GEMM3M tests --- ctest/c_cblat3c_3m.c | 4854 +++++++++++++++++++++++++++++++++++++++++ ctest/c_zblat3c_3m.c | 4897 ++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 9751 insertions(+) create mode 100644 ctest/c_cblat3c_3m.c create mode 100644 ctest/c_zblat3c_3m.c diff --git a/ctest/c_cblat3c_3m.c b/ctest/c_cblat3c_3m.c new file mode 100644 index 000000000..9cfa26a41 --- /dev/null +++ b/ctest/c_cblat3c_3m.c @@ -0,0 +1,4854 @@ +#include +#include +#include +#include +#include +#ifdef complex +#undef complex +#endif +#ifdef I +#undef I +#endif + +#if defined(_WIN64) +typedef long long BLASLONG; +typedef unsigned long long BLASULONG; +#else +typedef long BLASLONG; +typedef unsigned long BLASULONG; +#endif + +#ifdef LAPACK_ILP64 +typedef BLASLONG blasint; +#if defined(_WIN64) +#define blasabs(x) llabs(x) +#else +#define blasabs(x) labs(x) +#endif +#else +typedef int blasint; +#define blasabs(x) abs(x) +#endif + +typedef blasint integer; + +typedef unsigned int uinteger; +typedef char *address; +typedef short int shortint; +typedef float real; +typedef double doublereal; +typedef struct { real r, i; } complex; +typedef struct { doublereal r, i; } doublecomplex; +#ifdef _MSC_VER +static inline _Fcomplex Cf(complex *z) {_Fcomplex zz={z->r , z->i}; return zz;} +static inline _Dcomplex Cd(doublecomplex *z) {_Dcomplex zz={z->r , z->i};return zz;} +static inline _Fcomplex * _pCf(complex *z) {return (_Fcomplex*)z;} +static inline _Dcomplex * _pCd(doublecomplex *z) {return (_Dcomplex*)z;} +#else +static inline _Complex float Cf(complex *z) {return z->r + z->i*_Complex_I;} +static inline _Complex double Cd(doublecomplex *z) {return z->r + z->i*_Complex_I;} +static inline _Complex float * _pCf(complex *z) {return (_Complex float*)z;} +static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double*)z;} +#endif +#define pCf(z) (*_pCf(z)) +#define pCd(z) (*_pCd(z)) +typedef int logical; +typedef short int shortlogical; +typedef char logical1; +typedef char integer1; + +#define TRUE_ (1) +#define FALSE_ (0) + +/* Extern is for use with -E */ +#ifndef Extern +#define Extern extern +#endif + +/* I/O stuff */ + +typedef int flag; +typedef int ftnlen; +typedef int ftnint; + +/*external read, write*/ +typedef struct +{ flag cierr; + ftnint ciunit; + flag ciend; + char *cifmt; + ftnint cirec; +} cilist; + +/*internal read, write*/ +typedef struct +{ flag icierr; + char *iciunit; + flag iciend; + char *icifmt; + ftnint icirlen; + ftnint icirnum; +} icilist; + +/*open*/ +typedef struct +{ flag oerr; + ftnint ounit; + char *ofnm; + ftnlen ofnmlen; + char *osta; + char *oacc; + char *ofm; + ftnint orl; + char *oblnk; +} olist; + +/*close*/ +typedef struct +{ flag cerr; + ftnint cunit; + char *csta; +} cllist; + +/*rewind, backspace, endfile*/ +typedef struct +{ flag aerr; + ftnint aunit; +} alist; + +/* inquire */ +typedef struct +{ flag inerr; + ftnint inunit; + char *infile; + ftnlen infilen; + ftnint *inex; /*parameters in standard's order*/ + ftnint *inopen; + ftnint *innum; + ftnint *innamed; + char *inname; + ftnlen innamlen; + char *inacc; + ftnlen inacclen; + char *inseq; + ftnlen inseqlen; + char *indir; + ftnlen indirlen; + char *infmt; + ftnlen infmtlen; + char *inform; + ftnint informlen; + char *inunf; + ftnlen inunflen; + ftnint *inrecl; + ftnint *innrec; + char *inblank; + ftnlen inblanklen; +} inlist; + +#define VOID void + +union Multitype { /* for multiple entry points */ + integer1 g; + shortint h; + integer i; + /* longint j; */ + real r; + doublereal d; + complex c; + doublecomplex z; + }; + +typedef union Multitype Multitype; + +struct Vardesc { /* for Namelist */ + char *name; + char *addr; + ftnlen *dims; + int type; + }; +typedef struct Vardesc Vardesc; + +struct Namelist { + char *name; + Vardesc **vars; + int nvars; + }; +typedef struct Namelist Namelist; + +#define abs(x) ((x) >= 0 ? (x) : -(x)) +#define dabs(x) (fabs(x)) +#define f2cmin(a,b) ((a) <= (b) ? (a) : (b)) +#define f2cmax(a,b) ((a) >= (b) ? (a) : (b)) +#define dmin(a,b) (f2cmin(a,b)) +#define dmax(a,b) (f2cmax(a,b)) +#define bit_test(a,b) ((a) >> (b) & 1) +#define bit_clear(a,b) ((a) & ~((uinteger)1 << (b))) +#define bit_set(a,b) ((a) | ((uinteger)1 << (b))) + +#define abort_() { sig_die("Fortran abort routine called", 1); } +#define c_abs(z) (cabsf(Cf(z))) +#define c_cos(R,Z) { pCf(R)=ccos(Cf(Z)); } +#ifdef _MSC_VER +#define c_div(c, a, b) {Cf(c)._Val[0] = (Cf(a)._Val[0]/Cf(b)._Val[0]); Cf(c)._Val[1]=(Cf(a)._Val[1]/Cf(b)._Val[1]);} +#define z_div(c, a, b) {Cd(c)._Val[0] = (Cd(a)._Val[0]/Cd(b)._Val[0]); Cd(c)._Val[1]=(Cd(a)._Val[1]/Cd(b)._Val[1]);} +#else +#define c_div(c, a, b) {pCf(c) = Cf(a)/Cf(b);} +#define z_div(c, a, b) {pCd(c) = Cd(a)/Cd(b);} +#endif +#define c_exp(R, Z) {pCf(R) = cexpf(Cf(Z));} +#define c_log(R, Z) {pCf(R) = clogf(Cf(Z));} +#define c_sin(R, Z) {pCf(R) = csinf(Cf(Z));} +//#define c_sqrt(R, Z) {*(R) = csqrtf(Cf(Z));} +#define c_sqrt(R, Z) {pCf(R) = csqrtf(Cf(Z));} +#define d_abs(x) (fabs(*(x))) +#define d_acos(x) (acos(*(x))) +#define d_asin(x) (asin(*(x))) +#define d_atan(x) (atan(*(x))) +#define d_atn2(x, y) (atan2(*(x),*(y))) +#define d_cnjg(R, Z) { pCd(R) = conj(Cd(Z)); } +#define r_cnjg(R, Z) { pCf(R) = conjf(Cf(Z)); } +#define d_cos(x) (cos(*(x))) +#define d_cosh(x) (cosh(*(x))) +#define d_dim(__a, __b) ( *(__a) > *(__b) ? *(__a) - *(__b) : 0.0 ) +#define d_exp(x) (exp(*(x))) +#define d_imag(z) (cimag(Cd(z))) +#define r_imag(z) (cimagf(Cf(z))) +#define d_int(__x) (*(__x)>0 ? floor(*(__x)) : -floor(- *(__x))) +#define r_int(__x) (*(__x)>0 ? floor(*(__x)) : -floor(- *(__x))) +#define d_lg10(x) ( 0.43429448190325182765 * log(*(x)) ) +#define r_lg10(x) ( 0.43429448190325182765 * log(*(x)) ) +#define d_log(x) (log(*(x))) +#define d_mod(x, y) (fmod(*(x), *(y))) +#define u_nint(__x) ((__x)>=0 ? floor((__x) + .5) : -floor(.5 - (__x))) +#define d_nint(x) u_nint(*(x)) +#define u_sign(__a,__b) ((__b) >= 0 ? ((__a) >= 0 ? (__a) : -(__a)) : -((__a) >= 0 ? (__a) : -(__a))) +#define d_sign(a,b) u_sign(*(a),*(b)) +#define r_sign(a,b) u_sign(*(a),*(b)) +#define d_sin(x) (sin(*(x))) +#define d_sinh(x) (sinh(*(x))) +#define d_sqrt(x) (sqrt(*(x))) +#define d_tan(x) (tan(*(x))) +#define d_tanh(x) (tanh(*(x))) +#define i_abs(x) abs(*(x)) +#define i_dnnt(x) ((integer)u_nint(*(x))) +#define i_len(s, n) (n) +#define i_nint(x) ((integer)u_nint(*(x))) +#define i_sign(a,b) ((integer)u_sign((integer)*(a),(integer)*(b))) +#define pow_dd(ap, bp) ( pow(*(ap), *(bp))) +#define pow_si(B,E) spow_ui(*(B),*(E)) +#define pow_ri(B,E) spow_ui(*(B),*(E)) +#define pow_di(B,E) dpow_ui(*(B),*(E)) +#define pow_zi(p, a, b) {pCd(p) = zpow_ui(Cd(a), *(b));} +#define pow_ci(p, a, b) {pCf(p) = cpow_ui(Cf(a), *(b));} +#define pow_zz(R,A,B) {pCd(R) = cpow(Cd(A),*(B));} +#define s_cat(lpp, rpp, rnp, np, llp) { ftnlen i, nc, ll; char *f__rp, *lp; ll = (llp); lp = (lpp); for(i=0; i < (int)*(np); ++i) { nc = ll; if((rnp)[i] < nc) nc = (rnp)[i]; ll -= nc; f__rp = (rpp)[i]; while(--nc >= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } +#define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) +#define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } +#define sig_die(s, kill) { exit(1); } +#define s_stop(s, n) {exit(0);} +static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; +#define z_abs(z) (cabs(Cd(z))) +#define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} +#define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} +#define myexit_() break; +#define mycycle_() continue; +#define myceiling_(w) {ceil(w)} +#define myhuge_(w) {HUGE_VAL} +//#define mymaxloc_(w,s,e,n) {if (sizeof(*(w)) == sizeof(double)) dmaxloc_((w),*(s),*(e),n); else dmaxloc_((w),*(s),*(e),n);} +#define mymaxloc_(w,s,e,n) dmaxloc_(w,*(s),*(e),n) + +/* procedure parameter types for -A and -C++ */ + +#define F2C_proc_par_types 1 +#ifdef __cplusplus +typedef logical (*L_fp)(...); +#else +typedef logical (*L_fp)(); +#endif + +static float spow_ui(float x, integer n) { + float pow=1.0; unsigned long int u; + if(n != 0) { + if(n < 0) n = -n, x = 1/x; + for(u = n; ; ) { + if(u & 01) pow *= x; + if(u >>= 1) x *= x; + else break; + } + } + return pow; +} +static double dpow_ui(double x, integer n) { + double pow=1.0; unsigned long int u; + if(n != 0) { + if(n < 0) n = -n, x = 1/x; + for(u = n; ; ) { + if(u & 01) pow *= x; + if(u >>= 1) x *= x; + else break; + } + } + return pow; +} +#ifdef _MSC_VER +static _Fcomplex cpow_ui(complex x, integer n) { + complex pow={1.0,0.0}; unsigned long int u; + if(n != 0) { + if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; + for(u = n; ; ) { + if(u & 01) pow.r *= x.r, pow.i *= x.i; + if(u >>= 1) x.r *= x.r, x.i *= x.i; + else break; + } + } + _Fcomplex p={pow.r, pow.i}; + return p; +} +#else +static _Complex float cpow_ui(_Complex float x, integer n) { + _Complex float pow=1.0; unsigned long int u; + if(n != 0) { + if(n < 0) n = -n, x = 1/x; + for(u = n; ; ) { + if(u & 01) pow *= x; + if(u >>= 1) x *= x; + else break; + } + } + return pow; +} +#endif +#ifdef _MSC_VER +static _Dcomplex zpow_ui(_Dcomplex x, integer n) { + _Dcomplex pow={1.0,0.0}; unsigned long int u; + if(n != 0) { + if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; + for(u = n; ; ) { + if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; + if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; + else break; + } + } + _Dcomplex p = {pow._Val[0], pow._Val[1]}; + return p; +} +#else +static _Complex double zpow_ui(_Complex double x, integer n) { + _Complex double pow=1.0; unsigned long int u; + if(n != 0) { + if(n < 0) n = -n, x = 1/x; + for(u = n; ; ) { + if(u & 01) pow *= x; + if(u >>= 1) x *= x; + else break; + } + } + return pow; +} +#endif +static integer pow_ii(integer x, integer n) { + integer pow; unsigned long int u; + if (n <= 0) { + if (n == 0 || x == 1) pow = 1; + else if (x != -1) pow = x == 0 ? 1/x : 0; + else n = -n; + } + if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { + u = n; + for(pow = 1; ; ) { + if(u & 01) pow *= x; + if(u >>= 1) x *= x; + else break; + } + } + return pow; +} +static integer dmaxloc_(double *w, integer s, integer e, integer *n) +{ + double m; integer i, mi; + for(m=w[s-1], mi=s, i=s+1; i<=e; i++) + if (w[i-1]>m) mi=i ,m=w[i-1]; + return mi-s+1; +} +static integer smaxloc_(float *w, integer s, integer e, integer *n) +{ + float m; integer i, mi; + for(m=w[s-1], mi=s, i=s+1; i<=e; i++) + if (w[i-1]>m) mi=i ,m=w[i-1]; + return mi-s+1; +} +static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { + integer n = *n_, incx = *incx_, incy = *incy_, i; +#ifdef _MSC_VER + _Fcomplex zdotc = {0.0, 0.0}; + if (incx == 1 && incy == 1) { + for (i=0;i= 0; + if (trace) { + o__1.oerr = 0; + o__1.ounit = ntra; + o__1.ofnmlen = 32; + o__1.ofnm = snaps; + o__1.orl = 0; + o__1.osta = 0; + o__1.oacc = 0; + o__1.ofm = 0; + o__1.oblnk = 0; + f_open(&o__1); + } +/* Read the flag that directs rewinding of the snapshot file. */ + s_rsle(&io___7); + do_lio(&c__8, &c__1, (char *)&rewi, (ftnlen)sizeof(logical)); + e_rsle(); + rewi = rewi && trace; +/* Read the flag that directs stopping on any failure. */ + s_rsle(&io___9); + do_lio(&c__8, &c__1, (char *)&sfatal, (ftnlen)sizeof(logical)); + e_rsle(); +/* Read the flag that indicates whether error exits are to be tested. */ + s_rsle(&io___11); + do_lio(&c__8, &c__1, (char *)&tsterr, (ftnlen)sizeof(logical)); + e_rsle(); +/* Read the flag that indicates whether row-major data layout to be tested. */ + s_rsle(&io___13); + do_lio(&c__3, &c__1, (char *)&layout, (ftnlen)sizeof(integer)); + e_rsle(); +/* Read the threshold value of the test ratio */ + s_rsle(&io___15); + do_lio(&c__4, &c__1, (char *)&thresh, (ftnlen)sizeof(real)); + e_rsle(); + +/* Read and check the parameter values for the tests. */ + +/* Values of N */ + s_rsle(&io___17); + do_lio(&c__3, &c__1, (char *)&nidim, (ftnlen)sizeof(integer)); + e_rsle(); + if (nidim < 1 || nidim > 9) { + s_wsfe(&io___19); + do_fio(&c__1, "N", (ftnlen)1); + do_fio(&c__1, (char *)&c__9, (ftnlen)sizeof(integer)); + e_wsfe(); + goto L220; + } + s_rsle(&io___20); + i__1 = nidim; + for (i__ = 1; i__ <= i__1; ++i__) { + do_lio(&c__3, &c__1, (char *)&idim[i__ - 1], (ftnlen)sizeof(integer)); + } + e_rsle(); + i__1 = nidim; + for (i__ = 1; i__ <= i__1; ++i__) { + if (idim[i__ - 1] < 0 || idim[i__ - 1] > 65) { + s_wsfe(&io___23); + do_fio(&c__1, (char *)&c__65, (ftnlen)sizeof(integer)); + e_wsfe(); + goto L220; + } +/* L10: */ + } +/* Values of ALPHA */ + s_rsle(&io___24); + do_lio(&c__3, &c__1, (char *)&nalf, (ftnlen)sizeof(integer)); + e_rsle(); + if (nalf < 1 || nalf > 7) { + s_wsfe(&io___26); + do_fio(&c__1, "ALPHA", (ftnlen)5); + do_fio(&c__1, (char *)&c__7, (ftnlen)sizeof(integer)); + e_wsfe(); + goto L220; + } + s_rsle(&io___27); + i__1 = nalf; + for (i__ = 1; i__ <= i__1; ++i__) { + do_lio(&c__6, &c__1, (char *)&alf[i__ - 1], (ftnlen)sizeof(complex)); + } + e_rsle(); +/* Values of BETA */ + s_rsle(&io___29); + do_lio(&c__3, &c__1, (char *)&nbet, (ftnlen)sizeof(integer)); + e_rsle(); + if (nbet < 1 || nbet > 7) { + s_wsfe(&io___31); + do_fio(&c__1, "BETA", (ftnlen)4); + do_fio(&c__1, (char *)&c__7, (ftnlen)sizeof(integer)); + e_wsfe(); + goto L220; + } + s_rsle(&io___32); + i__1 = nbet; + for (i__ = 1; i__ <= i__1; ++i__) { + do_lio(&c__6, &c__1, (char *)&bet[i__ - 1], (ftnlen)sizeof(complex)); + } + e_rsle(); + +/* Report values of parameters. */ + + s_wsfe(&io___34); + e_wsfe(); + s_wsfe(&io___35); + i__1 = nidim; + for (i__ = 1; i__ <= i__1; ++i__) { + do_fio(&c__1, (char *)&idim[i__ - 1], (ftnlen)sizeof(integer)); + } + e_wsfe(); + s_wsfe(&io___36); + i__1 = nalf; + for (i__ = 1; i__ <= i__1; ++i__) { + do_fio(&c__2, (char *)&alf[i__ - 1], (ftnlen)sizeof(real)); + } + e_wsfe(); + s_wsfe(&io___37); + i__1 = nbet; + for (i__ = 1; i__ <= i__1; ++i__) { + do_fio(&c__2, (char *)&bet[i__ - 1], (ftnlen)sizeof(real)); + } + e_wsfe(); + if (! tsterr) { + s_wsle(&io___38); + e_wsle(); + s_wsfe(&io___39); + e_wsfe(); + } + s_wsle(&io___40); + e_wsle(); + s_wsfe(&io___41); + do_fio(&c__1, (char *)&thresh, (ftnlen)sizeof(real)); + e_wsfe(); + s_wsle(&io___42); + e_wsle(); + rorder = FALSE_; + corder = FALSE_; + if (layout == 2) { + rorder = TRUE_; + corder = TRUE_; + s_wsfe(&io___45); + e_wsfe(); + } else if (layout == 1) { + rorder = TRUE_; + s_wsfe(&io___46); + e_wsfe(); + } else if (layout == 0) { + corder = TRUE_; + s_wsfe(&io___47); + e_wsfe(); + } + s_wsle(&io___48); + e_wsle(); + +/* Read names of subroutines and flags which indicate */ +/* whether they are to be tested. */ + + for (i__ = 1; i__ <= 9; ++i__) { + ltest[i__ - 1] = FALSE_; +/* L20: */ + } +L30: + i__1 = s_rsfe(&io___50); + if (i__1 != 0) { + goto L60; + } + i__1 = do_fio(&c__1, snamet, (ftnlen)13); + if (i__1 != 0) { + goto L60; + } + i__1 = do_fio(&c__1, (char *)<estt, (ftnlen)sizeof(logical)); + if (i__1 != 0) { + goto L60; + } + i__1 = e_rsfe(); + if (i__1 != 0) { + goto L60; + } + for (i__ = 1; i__ <= 9; ++i__) { + if (s_cmp(snamet, snames + (i__ - 1) * 13, (ftnlen)13, (ftnlen)13) == + 0) { + goto L50; + } +/* L40: */ + } + s_wsfe(&io___53); + do_fio(&c__1, snamet, (ftnlen)13); + e_wsfe(); + s_stop("", (ftnlen)0); +L50: + ltest[i__ - 1] = ltestt; + goto L30; + +L60: + cl__1.cerr = 0; + cl__1.cunit = 5; + cl__1.csta = 0; + f_clos(&cl__1); + +/* Compute EPS (the machine precision). */ + + eps = 1.f; +L70: + r__1 = eps + 1.f; + if (sdiff_(&r__1, &c_b91) == 0.f) { + goto L80; + } + eps *= .5f; + goto L70; +L80: + eps += eps; + s_wsfe(&io___55); + do_fio(&c__1, (char *)&eps, (ftnlen)sizeof(real)); + e_wsfe(); + +/* Check the reliability of CMMCH using exact data. */ + + n = 32; + i__1 = n; + for (j = 1; j <= i__1; ++j) { + i__2 = n; + for (i__ = 1; i__ <= i__2; ++i__) { + i__3 = i__ + j * 65 - 66; +/* Computing MAX */ + i__5 = i__ - j + 1; + i__4 = f2cmax(i__5,0); + ab[i__3].r = (real) i__4, ab[i__3].i = 0.f; +/* L90: */ + } + i__2 = j + 4224; + ab[i__2].r = (real) j, ab[i__2].i = 0.f; + i__2 = (j + 65) * 65 - 65; + ab[i__2].r = (real) j, ab[i__2].i = 0.f; + i__2 = j - 1; + c__[i__2].r = 0.f, c__[i__2].i = 0.f; +/* L100: */ + } + i__1 = n; + for (j = 1; j <= i__1; ++j) { + i__2 = j - 1; + i__3 = j * ((j + 1) * j) / 2 - (j + 1) * j * (j - 1) / 3; + cc[i__2].r = (real) i__3, cc[i__2].i = 0.f; +/* L110: */ + } +/* CC holds the exact result. On exit from CMMCH CT holds */ +/* the result computed by CMMCH. */ + *(unsigned char *)transa = 'N'; + *(unsigned char *)transb = 'N'; + cmmch_(transa, transb, &n, &c__1, &n, &c_b2, ab, &c__65, &ab[4225], & + c__65, &c_b1, c__, &c__65, ct, g, cc, &c__65, &eps, &err, &fatal, + &c__6, &c_true); + same = lce_(cc, ct, &n); + if (! same || err != 0.f) { + s_wsfe(&io___68); + do_fio(&c__1, transa, (ftnlen)1); + do_fio(&c__1, transb, (ftnlen)1); + do_fio(&c__1, (char *)&same, (ftnlen)sizeof(logical)); + do_fio(&c__1, (char *)&err, (ftnlen)sizeof(real)); + e_wsfe(); + s_stop("", (ftnlen)0); + } + *(unsigned char *)transb = 'C'; + cmmch_(transa, transb, &n, &c__1, &n, &c_b2, ab, &c__65, &ab[4225], & + c__65, &c_b1, c__, &c__65, ct, g, cc, &c__65, &eps, &err, &fatal, + &c__6, &c_true); + same = lce_(cc, ct, &n); + if (! same || err != 0.f) { + s_wsfe(&io___69); + do_fio(&c__1, transa, (ftnlen)1); + do_fio(&c__1, transb, (ftnlen)1); + do_fio(&c__1, (char *)&same, (ftnlen)sizeof(logical)); + do_fio(&c__1, (char *)&err, (ftnlen)sizeof(real)); + e_wsfe(); + s_stop("", (ftnlen)0); + } + i__1 = n; + for (j = 1; j <= i__1; ++j) { + i__2 = j + 4224; + i__3 = n - j + 1; + ab[i__2].r = (real) i__3, ab[i__2].i = 0.f; + i__2 = (j + 65) * 65 - 65; + i__3 = n - j + 1; + ab[i__2].r = (real) i__3, ab[i__2].i = 0.f; +/* L120: */ + } + i__1 = n; + for (j = 1; j <= i__1; ++j) { + i__2 = n - j; + i__3 = j * ((j + 1) * j) / 2 - (j + 1) * j * (j - 1) / 3; + cc[i__2].r = (real) i__3, cc[i__2].i = 0.f; +/* L130: */ + } + *(unsigned char *)transa = 'C'; + *(unsigned char *)transb = 'N'; + cmmch_(transa, transb, &n, &c__1, &n, &c_b2, ab, &c__65, &ab[4225], & + c__65, &c_b1, c__, &c__65, ct, g, cc, &c__65, &eps, &err, &fatal, + &c__6, &c_true); + same = lce_(cc, ct, &n); + if (! same || err != 0.f) { + s_wsfe(&io___70); + do_fio(&c__1, transa, (ftnlen)1); + do_fio(&c__1, transb, (ftnlen)1); + do_fio(&c__1, (char *)&same, (ftnlen)sizeof(logical)); + do_fio(&c__1, (char *)&err, (ftnlen)sizeof(real)); + e_wsfe(); + s_stop("", (ftnlen)0); + } + *(unsigned char *)transb = 'C'; + cmmch_(transa, transb, &n, &c__1, &n, &c_b2, ab, &c__65, &ab[4225], & + c__65, &c_b1, c__, &c__65, ct, g, cc, &c__65, &eps, &err, &fatal, + &c__6, &c_true); + same = lce_(cc, ct, &n); + if (! same || err != 0.f) { + s_wsfe(&io___71); + do_fio(&c__1, transa, (ftnlen)1); + do_fio(&c__1, transb, (ftnlen)1); + do_fio(&c__1, (char *)&same, (ftnlen)sizeof(logical)); + do_fio(&c__1, (char *)&err, (ftnlen)sizeof(real)); + e_wsfe(); + s_stop("", (ftnlen)0); + } + +/* Test each subroutine in turn. */ + + for (isnum = 1; isnum <= 9; ++isnum) { + s_wsle(&io___73); + e_wsle(); + if (! ltest[isnum - 1]) { +/* Subprogram is not to be tested. */ + s_wsfe(&io___74); + do_fio(&c__1, snames + (isnum - 1) * 13, (ftnlen)13); + e_wsfe(); + } else { + s_copy(srnamc_1.srnamt, snames + (isnum - 1) * 13, (ftnlen)13, ( + ftnlen)13); +/* Test error exits. */ + if (tsterr) { + cc3chke_(snames + (isnum - 1) * 13); + s_wsle(&io___75); + e_wsle(); + } +/* Test computations. */ + infoc_1.infot = 0; + infoc_1.ok = TRUE_; + fatal = FALSE_; + switch (isnum) { + case 1: goto L140; + case 2: goto L150; + case 3: goto L150; + case 4: goto L160; + case 5: goto L160; + case 6: goto L170; + case 7: goto L170; + case 8: goto L180; + case 9: goto L180; + } +/* Test CGEMM, 01. */ +L140: + if (corder) { + cchk1_(snames + (isnum - 1) * 13, &eps, &thresh, &c__6, &ntra, + &trace, &rewi, &fatal, &nidim, idim, &nalf, alf, & + nbet, bet, &c__65, ab, aa, as, &ab[4225], bb, bs, c__, + cc, cs, ct, g, &c__0); + } + if (rorder) { + cchk1_(snames + (isnum - 1) * 13, &eps, &thresh, &c__6, &ntra, + &trace, &rewi, &fatal, &nidim, idim, &nalf, alf, & + nbet, bet, &c__65, ab, aa, as, &ab[4225], bb, bs, c__, + cc, cs, ct, g, &c__1); + } + goto L190; +/* Test CHEMM, 02, CSYMM, 03. */ +L150: + if (corder) { + cchk2_(snames + (isnum - 1) * 13, &eps, &thresh, &c__6, &ntra, + &trace, &rewi, &fatal, &nidim, idim, &nalf, alf, & + nbet, bet, &c__65, ab, aa, as, &ab[4225], bb, bs, c__, + cc, cs, ct, g, &c__0); + } + if (rorder) { + cchk2_(snames + (isnum - 1) * 13, &eps, &thresh, &c__6, &ntra, + &trace, &rewi, &fatal, &nidim, idim, &nalf, alf, & + nbet, bet, &c__65, ab, aa, as, &ab[4225], bb, bs, c__, + cc, cs, ct, g, &c__1); + } + goto L190; +/* Test CTRMM, 04, CTRSM, 05. */ +L160: + if (corder) { + cchk3_(snames + (isnum - 1) * 13, &eps, &thresh, &c__6, &ntra, + &trace, &rewi, &fatal, &nidim, idim, &nalf, alf, & + c__65, ab, aa, as, &ab[4225], bb, bs, ct, g, c__, & + c__0); + } + if (rorder) { + cchk3_(snames + (isnum - 1) * 13, &eps, &thresh, &c__6, &ntra, + &trace, &rewi, &fatal, &nidim, idim, &nalf, alf, & + c__65, ab, aa, as, &ab[4225], bb, bs, ct, g, c__, & + c__1); + } + goto L190; +/* Test CHERK, 06, CSYRK, 07. */ +L170: + if (corder) { + cchk4_(snames + (isnum - 1) * 13, &eps, &thresh, &c__6, &ntra, + &trace, &rewi, &fatal, &nidim, idim, &nalf, alf, & + nbet, bet, &c__65, ab, aa, as, &ab[4225], bb, bs, c__, + cc, cs, ct, g, &c__0); + } + if (rorder) { + cchk4_(snames + (isnum - 1) * 13, &eps, &thresh, &c__6, &ntra, + &trace, &rewi, &fatal, &nidim, idim, &nalf, alf, & + nbet, bet, &c__65, ab, aa, as, &ab[4225], bb, bs, c__, + cc, cs, ct, g, &c__1); + } + goto L190; +/* Test CHER2K, 08, CSYR2K, 09. */ +L180: + if (corder) { + cchk5_(snames + (isnum - 1) * 13, &eps, &thresh, &c__6, &ntra, + &trace, &rewi, &fatal, &nidim, idim, &nalf, alf, & + nbet, bet, &c__65, ab, aa, as, bb, bs, c__, cc, cs, + ct, g, w, &c__0); + } + if (rorder) { + cchk5_(snames + (isnum - 1) * 13, &eps, &thresh, &c__6, &ntra, + &trace, &rewi, &fatal, &nidim, idim, &nalf, alf, & + nbet, bet, &c__65, ab, aa, as, bb, bs, c__, cc, cs, + ct, g, w, &c__1); + } + goto L190; + +L190: + if (fatal && sfatal) { + goto L210; + } + } +/* L200: */ + } + s_wsfe(&io___82); + e_wsfe(); + goto L230; + +L210: + s_wsfe(&io___83); + e_wsfe(); + goto L230; + +L220: + s_wsfe(&io___84); + e_wsfe(); + +L230: + if (trace) { + cl__1.cerr = 0; + cl__1.cunit = ntra; + cl__1.csta = 0; + f_clos(&cl__1); + } + cl__1.cerr = 0; + cl__1.cunit = 6; + cl__1.csta = 0; + f_clos(&cl__1); + s_stop("", (ftnlen)0); + + +/* End of CBLAT3. */ + + return 0; +} /* MAIN__ */ + +/* Subroutine */ int cchk1_(char *sname, real *eps, real *thresh, integer * + nout, integer *ntra, logical *trace, logical *rewi, logical *fatal, + integer *nidim, integer *idim, integer *nalf, complex *alf, integer * + nbet, complex *bet, integer *nmax, complex *a, complex *aa, complex * + as, complex *b, complex *bb, complex *bs, complex *c__, complex *cc, + complex *cs, complex *ct, real *g, integer *iorder) +{ + /* Initialized data */ + + static char ich[3] = "NTC"; + + /* Format strings */ + static char fmt_9994[] = "(\002 ****** FATAL ERROR - ERROR-CALL MYEXIT T" + "AKEN ON VALID\002,\002 CALL ******\002)"; + static char fmt_9998[] = "(\002 ******* FATAL ERROR - PARAMETER NUMBER" + " \002,i2,\002 WAS CH\002,\002ANGED INCORRECTLY *******\002)"; + static char fmt_10000[] = "(\002 \002,a13,\002 PASSED THE COLUMN-MAJOR C" + "OMPUTATIONAL TESTS\002,\002 (\002,i6,\002 CALL\002,\002S)\002)"; + static char fmt_10001[] = "(\002 \002,a13,\002 PASSED THE ROW-MAJOR C" + "OMPUTATIONAL TESTS\002,\002 (\002,i6,\002 CALL\002,\002S)\002)"; + static char fmt_10002[] = "(\002 \002,a13,\002 COMPLETED THE COLUMN-MAJO" + "R COMPUTATIONAL \002,\002TESTS (\002,i6,\002 CALLS)\002,/\002 **" + "***** BUT WITH MAXIMUM TEST \002,\002RATIO \002,f8.2,\002 - SUSP" + "ECT *******\002)"; + static char fmt_10003[] = "(\002 \002,a13,\002 COMPLETED THE ROW-MAJOR " + " COMPUTATIONAL \002,\002TESTS (\002,i6,\002 CALLS)\002,/\002 **" + "***** BUT WITH MAXIMUM TEST \002,\002RATIO \002,f8.2,\002 - SUSP" + "ECT *******\002)"; + static char fmt_9996[] = "(\002 ******* \002,a13,\002 FAILED ON CALL NUM" + "BER:\002)"; + + /* System generated locals */ + integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2, + i__3, i__4, i__5, i__6, i__7, i__8; + alist al__1; + + /* Local variables */ + complex beta; + integer ldas, ldbs, ldcs; + logical same, null; + integer i__, k, m, n; + extern /* Subroutine */ int cmake_(char *, char *, char *, integer *, + integer *, complex *, integer *, complex *, integer *, logical *, + complex *); + complex alpha; + extern /* Subroutine */ int cmmch_(char *, char *, integer *, integer *, + integer *, complex *, complex *, integer *, complex *, integer *, + complex *, complex *, integer *, complex *, real *, complex *, + integer *, real *, real *, logical *, integer *, logical *); + logical isame[13], trana, tranb; + integer nargs; + logical reset; + extern /* Subroutine */ int cprcn1_(integer *, integer *, char *, integer + *, char *, char *, integer *, integer *, integer *, complex *, + integer *, integer *, complex *, integer *); + integer ia, ib, ma, mb, na, nb, nc, ik, im, in, ks, ms, ns; + extern logical lceres_(char *, char *, integer *, integer *, complex *, + complex *, integer *); + char tranas[1], tranbs[1], transa[1], transb[1]; + real errmax; + integer ica, icb, laa, lbb, lda, lcc, ldb, ldc; + extern logical lce_(complex *, complex *, integer *); + complex als, bls; + real err; + extern /* Subroutine */ int ccgemm3m_(integer *, char *, char *, integer * + , integer *, integer *, complex *, complex *, integer *, complex * + , integer *, complex *, complex *, integer *); + + /* Fortran I/O blocks */ + static cilist io___128 = { 0, 0, 0, fmt_9994, 0 }; + static cilist io___131 = { 0, 0, 0, fmt_9998, 0 }; + static cilist io___133 = { 0, 0, 0, fmt_10000, 0 }; + static cilist io___134 = { 0, 0, 0, fmt_10001, 0 }; + static cilist io___135 = { 0, 0, 0, fmt_10002, 0 }; + static cilist io___136 = { 0, 0, 0, fmt_10003, 0 }; + static cilist io___137 = { 0, 0, 0, fmt_9996, 0 }; + + + +/* Tests CGEMM. */ + +/* Auxiliary routine for test program for Level 3 Blas. */ + +/* -- Written on 8-February-1989. */ +/* Jack Dongarra, Argonne National Laboratory. */ +/* Iain Duff, AERE Harwell. */ +/* Jeremy Du Croz, Numerical Algorithms Group Ltd. */ +/* Sven Hammarling, Numerical Algorithms Group Ltd. */ + + /* Parameter adjustments */ + --idim; + --alf; + --bet; + --g; + --ct; + --cs; + --cc; + c_dim1 = *nmax; + c_offset = 1 + c_dim1 * 1; + c__ -= c_offset; + --bs; + --bb; + b_dim1 = *nmax; + b_offset = 1 + b_dim1 * 1; + b -= b_offset; + --as; + --aa; + a_dim1 = *nmax; + a_offset = 1 + a_dim1 * 1; + a -= a_offset; + + /* Function Body */ + + nargs = 13; + nc = 0; + reset = TRUE_; + errmax = 0.f; + + i__1 = *nidim; + for (im = 1; im <= i__1; ++im) { + m = idim[im]; + + i__2 = *nidim; + for (in = 1; in <= i__2; ++in) { + n = idim[in]; +/* Set LDC to 1 more than minimum value if room. */ + ldc = m; + if (ldc < *nmax) { + ++ldc; + } +/* Skip tests if not enough room. */ + if (ldc > *nmax) { + goto L100; + } + lcc = ldc * n; + null = n <= 0 || m <= 0; + + i__3 = *nidim; + for (ik = 1; ik <= i__3; ++ik) { + k = idim[ik]; + + for (ica = 1; ica <= 3; ++ica) { + *(unsigned char *)transa = *(unsigned char *)&ich[ica - 1] + ; + trana = *(unsigned char *)transa == 'T' || *(unsigned + char *)transa == 'C'; + + if (trana) { + ma = k; + na = m; + } else { + ma = m; + na = k; + } +/* Set LDA to 1 more than minimum value if room. */ + lda = ma; + if (lda < *nmax) { + ++lda; + } +/* Skip tests if not enough room. */ + if (lda > *nmax) { + goto L80; + } + laa = lda * na; + +/* Generate the matrix A. */ + + cmake_("ge", " ", " ", &ma, &na, &a[a_offset], nmax, &aa[ + 1], &lda, &reset, &c_b1); + + for (icb = 1; icb <= 3; ++icb) { + *(unsigned char *)transb = *(unsigned char *)&ich[icb + - 1]; + tranb = *(unsigned char *)transb == 'T' || *(unsigned + char *)transb == 'C'; + + if (tranb) { + mb = n; + nb = k; + } else { + mb = k; + nb = n; + } +/* Set LDB to 1 more than minimum value if room. */ + ldb = mb; + if (ldb < *nmax) { + ++ldb; + } +/* Skip tests if not enough room. */ + if (ldb > *nmax) { + goto L70; + } + lbb = ldb * nb; + +/* Generate the matrix B. */ + + cmake_("ge", " ", " ", &mb, &nb, &b[b_offset], nmax, & + bb[1], &ldb, &reset, &c_b1); + + i__4 = *nalf; + for (ia = 1; ia <= i__4; ++ia) { + i__5 = ia; + alpha.r = alf[i__5].r, alpha.i = alf[i__5].i; + + i__5 = *nbet; + for (ib = 1; ib <= i__5; ++ib) { + i__6 = ib; + beta.r = bet[i__6].r, beta.i = bet[i__6].i; + +/* Generate the matrix C. */ + + cmake_("ge", " ", " ", &m, &n, &c__[c_offset], + nmax, &cc[1], &ldc, &reset, &c_b1); + + ++nc; + +/* Save every datum before calling the */ +/* subroutine. */ + + *(unsigned char *)tranas = *(unsigned char *) + transa; + *(unsigned char *)tranbs = *(unsigned char *) + transb; + ms = m; + ns = n; + ks = k; + als.r = alpha.r, als.i = alpha.i; + i__6 = laa; + for (i__ = 1; i__ <= i__6; ++i__) { + i__7 = i__; + i__8 = i__; + as[i__7].r = aa[i__8].r, as[i__7].i = aa[ + i__8].i; +/* L10: */ + } + ldas = lda; + i__6 = lbb; + for (i__ = 1; i__ <= i__6; ++i__) { + i__7 = i__; + i__8 = i__; + bs[i__7].r = bb[i__8].r, bs[i__7].i = bb[ + i__8].i; +/* L20: */ + } + ldbs = ldb; + bls.r = beta.r, bls.i = beta.i; + i__6 = lcc; + for (i__ = 1; i__ <= i__6; ++i__) { + i__7 = i__; + i__8 = i__; + cs[i__7].r = cc[i__8].r, cs[i__7].i = cc[ + i__8].i; +/* L30: */ + } + ldcs = ldc; + +/* Call the subroutine. */ + + if (*trace) { + cprcn1_(ntra, &nc, sname, iorder, transa, + transb, &m, &n, &k, &alpha, &lda, + &ldb, &beta, &ldc); + } + if (*rewi) { + al__1.aerr = 0; + al__1.aunit = *ntra; + f_rew(&al__1); + } + ccgemm3m_(iorder, transa, transb, &m, &n, &k, + &alpha, &aa[1], &lda, &bb[1], &ldb, & + beta, &cc[1], &ldc); + +/* Check if error-exit was taken incorrectly. */ + + if (! infoc_1.ok) { + io___128.ciunit = *nout; + s_wsfe(&io___128); + e_wsfe(); + *fatal = TRUE_; + goto L120; + } + +/* See what data changed inside subroutines. */ + + isame[0] = *(unsigned char *)transa == *( + unsigned char *)tranas; + isame[1] = *(unsigned char *)transb == *( + unsigned char *)tranbs; + isame[2] = ms == m; + isame[3] = ns == n; + isame[4] = ks == k; + isame[5] = als.r == alpha.r && als.i == + alpha.i; + isame[6] = lce_(&as[1], &aa[1], &laa); + isame[7] = ldas == lda; + isame[8] = lce_(&bs[1], &bb[1], &lbb); + isame[9] = ldbs == ldb; + isame[10] = bls.r == beta.r && bls.i == + beta.i; + if (null) { + isame[11] = lce_(&cs[1], &cc[1], &lcc); + } else { + isame[11] = lceres_("ge", " ", &m, &n, & + cs[1], &cc[1], &ldc); + } + isame[12] = ldcs == ldc; + +/* If data was incorrectly changed, report */ +/* and return. */ + + same = TRUE_; + i__6 = nargs; + for (i__ = 1; i__ <= i__6; ++i__) { + same = same && isame[i__ - 1]; + if (! isame[i__ - 1]) { + io___131.ciunit = *nout; + s_wsfe(&io___131); + do_fio(&c__1, (char *)&i__, (ftnlen) + sizeof(integer)); + e_wsfe(); + } +/* L40: */ + } + if (! same) { + *fatal = TRUE_; + goto L120; + } + + if (! null) { + +/* Check the result. */ + + cmmch_(transa, transb, &m, &n, &k, &alpha, + &a[a_offset], nmax, &b[b_offset], + nmax, &beta, &c__[c_offset], + nmax, &ct[1], &g[1], &cc[1], &ldc, + eps, &err, fatal, nout, &c_true); + errmax = f2cmax(errmax,err); +/* If got really bad answer, report and */ +/* return. */ + if (*fatal) { + goto L120; + } + } + +/* L50: */ + } + +/* L60: */ + } + +L70: + ; + } + +L80: + ; + } + +/* L90: */ + } + +L100: + ; + } + +/* L110: */ + } + +/* Report result. */ + + if (errmax < *thresh) { + if (*iorder == 0) { + io___133.ciunit = *nout; + s_wsfe(&io___133); + do_fio(&c__1, sname, (ftnlen)13); + do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer)); + e_wsfe(); + } + if (*iorder == 1) { + io___134.ciunit = *nout; + s_wsfe(&io___134); + do_fio(&c__1, sname, (ftnlen)13); + do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer)); + e_wsfe(); + } + } else { + if (*iorder == 0) { + io___135.ciunit = *nout; + s_wsfe(&io___135); + do_fio(&c__1, sname, (ftnlen)13); + do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer)); + do_fio(&c__1, (char *)&errmax, (ftnlen)sizeof(real)); + e_wsfe(); + } + if (*iorder == 1) { + io___136.ciunit = *nout; + s_wsfe(&io___136); + do_fio(&c__1, sname, (ftnlen)13); + do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer)); + do_fio(&c__1, (char *)&errmax, (ftnlen)sizeof(real)); + e_wsfe(); + } + } + goto L130; + +L120: + io___137.ciunit = *nout; + s_wsfe(&io___137); + do_fio(&c__1, sname, (ftnlen)13); + e_wsfe(); + cprcn1_(nout, &nc, sname, iorder, transa, transb, &m, &n, &k, &alpha, & + lda, &ldb, &beta, &ldc); + +L130: + return 0; + +/* L9995: */ + +/* End of CCHK1. */ + +} /* cchk1_ */ + + +/* Subroutine */ int cprcn1_(integer *nout, integer *nc, char *sname, integer + *iorder, char *transa, char *transb, integer *m, integer *n, integer * + k, complex *alpha, integer *lda, integer *ldb, complex *beta, integer + *ldc) +{ + /* Format strings */ + static char fmt_9995[] = "(1x,i6,\002: \002,a13,\002(\002,a14,\002,\002," + "a14,\002,\002,a14,\002,\002)"; + static char fmt_9994[] = "(10x,3(i3,\002,\002),\002 (\002,f4.1,\002,\002" + ",f4.1,\002) , A,\002,i3,\002, B,\002,i3,\002, (\002,f4.1,\002" + ",\002,f4.1,\002) , C,\002,i3,\002).\002)"; + + /* Local variables */ + char crc[14], cta[14], ctb[14]; + + /* Fortran I/O blocks */ + static cilist io___141 = { 0, 0, 0, fmt_9995, 0 }; + static cilist io___142 = { 0, 0, 0, fmt_9994, 0 }; + + + if (*(unsigned char *)transa == 'N') { + s_copy(cta, " CblasNoTrans", (ftnlen)14, (ftnlen)14); + } else if (*(unsigned char *)transa == 'T') { + s_copy(cta, " CblasTrans", (ftnlen)14, (ftnlen)14); + } else { + s_copy(cta, "CblasConjTrans", (ftnlen)14, (ftnlen)14); + } + if (*(unsigned char *)transb == 'N') { + s_copy(ctb, " CblasNoTrans", (ftnlen)14, (ftnlen)14); + } else if (*(unsigned char *)transb == 'T') { + s_copy(ctb, " CblasTrans", (ftnlen)14, (ftnlen)14); + } else { + s_copy(ctb, "CblasConjTrans", (ftnlen)14, (ftnlen)14); + } + if (*iorder == 1) { + s_copy(crc, " CblasRowMajor", (ftnlen)14, (ftnlen)14); + } else { + s_copy(crc, " CblasColMajor", (ftnlen)14, (ftnlen)14); + } + io___141.ciunit = *nout; + s_wsfe(&io___141); + do_fio(&c__1, (char *)&(*nc), (ftnlen)sizeof(integer)); + do_fio(&c__1, sname, (ftnlen)13); + do_fio(&c__1, crc, (ftnlen)14); + do_fio(&c__1, cta, (ftnlen)14); + do_fio(&c__1, ctb, (ftnlen)14); + e_wsfe(); + io___142.ciunit = *nout; + s_wsfe(&io___142); + do_fio(&c__1, (char *)&(*m), (ftnlen)sizeof(integer)); + do_fio(&c__1, (char *)&(*n), (ftnlen)sizeof(integer)); + do_fio(&c__1, (char *)&(*k), (ftnlen)sizeof(integer)); + do_fio(&c__2, (char *)&(*alpha), (ftnlen)sizeof(real)); + do_fio(&c__1, (char *)&(*lda), (ftnlen)sizeof(integer)); + do_fio(&c__1, (char *)&(*ldb), (ftnlen)sizeof(integer)); + do_fio(&c__2, (char *)&(*beta), (ftnlen)sizeof(real)); + do_fio(&c__1, (char *)&(*ldc), (ftnlen)sizeof(integer)); + e_wsfe(); + return 0; +} /* cprcn1_ */ + + +/* Subroutine */ int cchk2_(char *sname, real *eps, real *thresh, integer * + nout, integer *ntra, logical *trace, logical *rewi, logical *fatal, + integer *nidim, integer *idim, integer *nalf, complex *alf, integer * + nbet, complex *bet, integer *nmax, complex *a, complex *aa, complex * + as, complex *b, complex *bb, complex *bs, complex *c__, complex *cc, + complex *cs, complex *ct, real *g, integer *iorder) +{ + /* Initialized data */ + + static char ichs[2] = "LR"; + static char ichu[2] = "UL"; + + /* Format strings */ + static char fmt_9994[] = "(\002 ******* FATAL ERROR - ERROR-CALL MYEXIT " + "TAKEN ON VALID\002,\002 CALL *******\002)"; + static char fmt_9998[] = "(\002 ******* FATAL ERROR - PARAMETER NUMBER" + " \002,i2,\002 WAS CH\002,\002ANGED INCORRECTLY *******\002)"; + static char fmt_10000[] = "(\002 \002,a13,\002 PASSED THE COLUMN-MAJOR C" + "OMPUTATIONAL TESTS\002,\002 (\002,i6,\002 CALL\002,\002S)\002)"; + static char fmt_10001[] = "(\002 \002,a13,\002 PASSED THE ROW-MAJOR C" + "OMPUTATIONAL TESTS\002,\002 (\002,i6,\002 CALL\002,\002S)\002)"; + static char fmt_10002[] = "(\002 \002,a13,\002 COMPLETED THE COLUMN-MAJO" + "R COMPUTATIONAL \002,\002TESTS (\002,i6,\002 CALLS)\002,/\002 **" + "***** BUT WITH MAXIMUM TEST \002,\002RATIO \002,f8.2,\002 - SUSP" + "ECT *******\002)"; + static char fmt_10003[] = "(\002 \002,a13,\002 COMPLETED THE ROW-MAJOR " + " COMPUTATIONAL \002,\002TESTS (\002,i6,\002 CALLS)\002,/\002 **" + "***** BUT WITH MAXIMUM TEST \002,\002RATIO \002,f8.2,\002 - SUSP" + "ECT *******\002)"; + static char fmt_9996[] = "(\002 ******* \002,a13,\002 FAILED ON CALL NUM" + "BER:\002)"; + + /* System generated locals */ + integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2, + i__3, i__4, i__5, i__6, i__7; + alist al__1; + + /* Local variables */ + complex beta; + integer ldas, ldbs, ldcs; + logical same; + char side[1]; + logical conj, left, null; + char uplo[1]; + integer i__, m, n; + extern /* Subroutine */ int cmake_(char *, char *, char *, integer *, + integer *, complex *, integer *, complex *, integer *, logical *, + complex *); + complex alpha; + extern /* Subroutine */ int cmmch_(char *, char *, integer *, integer *, + integer *, complex *, complex *, integer *, complex *, integer *, + complex *, complex *, integer *, complex *, real *, complex *, + integer *, real *, real *, logical *, integer *, logical *); + logical isame[13]; + char sides[1]; + integer nargs; + logical reset; + char uplos[1]; + extern /* Subroutine */ int cprcn2_(integer *, integer *, char *, integer + *, char *, char *, integer *, integer *, complex *, integer *, + integer *, complex *, integer *); + integer ia, ib, na, nc, im, in; + extern /* Subroutine */ int cchemm_(integer *, char *, char *, integer *, + integer *, complex *, complex *, integer *, complex *, integer *, + complex *, complex *, integer *); + integer ms, ns; + extern logical lceres_(char *, char *, integer *, integer *, complex *, + complex *, integer *); + extern /* Subroutine */ int ccsymm_(integer *, char *, char *, integer *, + integer *, complex *, complex *, integer *, complex *, integer *, + complex *, complex *, integer *); + real errmax; + integer laa, lbb, lda, lcc, ldb, ldc; + extern logical lce_(complex *, complex *, integer *); + integer ics; + complex als, bls; + integer icu; + real err; + + /* Fortran I/O blocks */ + static cilist io___181 = { 0, 0, 0, fmt_9994, 0 }; + static cilist io___184 = { 0, 0, 0, fmt_9998, 0 }; + static cilist io___186 = { 0, 0, 0, fmt_10000, 0 }; + static cilist io___187 = { 0, 0, 0, fmt_10001, 0 }; + static cilist io___188 = { 0, 0, 0, fmt_10002, 0 }; + static cilist io___189 = { 0, 0, 0, fmt_10003, 0 }; + static cilist io___190 = { 0, 0, 0, fmt_9996, 0 }; + + + +/* Tests CHEMM and CSYMM. */ + +/* Auxiliary routine for test program for Level 3 Blas. */ + +/* -- Written on 8-February-1989. */ +/* Jack Dongarra, Argonne National Laboratory. */ +/* Iain Duff, AERE Harwell. */ +/* Jeremy Du Croz, Numerical Algorithms Group Ltd. */ +/* Sven Hammarling, Numerical Algorithms Group Ltd. */ + + /* Parameter adjustments */ + --idim; + --alf; + --bet; + --g; + --ct; + --cs; + --cc; + c_dim1 = *nmax; + c_offset = 1 + c_dim1 * 1; + c__ -= c_offset; + --bs; + --bb; + b_dim1 = *nmax; + b_offset = 1 + b_dim1 * 1; + b -= b_offset; + --as; + --aa; + a_dim1 = *nmax; + a_offset = 1 + a_dim1 * 1; + a -= a_offset; + + /* Function Body */ + conj = s_cmp(sname + 7, "he", (ftnlen)2, (ftnlen)2) == 0; + + nargs = 12; + nc = 0; + reset = TRUE_; + errmax = 0.f; + + i__1 = *nidim; + for (im = 1; im <= i__1; ++im) { + m = idim[im]; + + i__2 = *nidim; + for (in = 1; in <= i__2; ++in) { + n = idim[in]; +/* Set LDC to 1 more than minimum value if room. */ + ldc = m; + if (ldc < *nmax) { + ++ldc; + } +/* Skip tests if not enough room. */ + if (ldc > *nmax) { + goto L90; + } + lcc = ldc * n; + null = n <= 0 || m <= 0; +/* Set LDB to 1 more than minimum value if room. */ + ldb = m; + if (ldb < *nmax) { + ++ldb; + } +/* Skip tests if not enough room. */ + if (ldb > *nmax) { + goto L90; + } + lbb = ldb * n; + +/* Generate the matrix B. */ + + cmake_("ge", " ", " ", &m, &n, &b[b_offset], nmax, &bb[1], &ldb, & + reset, &c_b1); + + for (ics = 1; ics <= 2; ++ics) { + *(unsigned char *)side = *(unsigned char *)&ichs[ics - 1]; + left = *(unsigned char *)side == 'L'; + + if (left) { + na = m; + } else { + na = n; + } +/* Set LDA to 1 more than minimum value if room. */ + lda = na; + if (lda < *nmax) { + ++lda; + } +/* Skip tests if not enough room. */ + if (lda > *nmax) { + goto L80; + } + laa = lda * na; + + for (icu = 1; icu <= 2; ++icu) { + *(unsigned char *)uplo = *(unsigned char *)&ichu[icu - 1]; + +/* Generate the hermitian or symmetric matrix A. */ + + cmake_(sname + 7, uplo, " ", &na, &na, &a[a_offset], nmax, + &aa[1], &lda, &reset, &c_b1); + + i__3 = *nalf; + for (ia = 1; ia <= i__3; ++ia) { + i__4 = ia; + alpha.r = alf[i__4].r, alpha.i = alf[i__4].i; + + i__4 = *nbet; + for (ib = 1; ib <= i__4; ++ib) { + i__5 = ib; + beta.r = bet[i__5].r, beta.i = bet[i__5].i; + +/* Generate the matrix C. */ + + cmake_("ge", " ", " ", &m, &n, &c__[c_offset], + nmax, &cc[1], &ldc, &reset, &c_b1); + + ++nc; + +/* Save every datum before calling the */ +/* subroutine. */ + + *(unsigned char *)sides = *(unsigned char *)side; + *(unsigned char *)uplos = *(unsigned char *)uplo; + ms = m; + ns = n; + als.r = alpha.r, als.i = alpha.i; + i__5 = laa; + for (i__ = 1; i__ <= i__5; ++i__) { + i__6 = i__; + i__7 = i__; + as[i__6].r = aa[i__7].r, as[i__6].i = aa[i__7] + .i; +/* L10: */ + } + ldas = lda; + i__5 = lbb; + for (i__ = 1; i__ <= i__5; ++i__) { + i__6 = i__; + i__7 = i__; + bs[i__6].r = bb[i__7].r, bs[i__6].i = bb[i__7] + .i; +/* L20: */ + } + ldbs = ldb; + bls.r = beta.r, bls.i = beta.i; + i__5 = lcc; + for (i__ = 1; i__ <= i__5; ++i__) { + i__6 = i__; + i__7 = i__; + cs[i__6].r = cc[i__7].r, cs[i__6].i = cc[i__7] + .i; +/* L30: */ + } + ldcs = ldc; + +/* Call the subroutine. */ + + if (*trace) { + cprcn2_(ntra, &nc, sname, iorder, side, uplo, + &m, &n, &alpha, &lda, &ldb, &beta, & + ldc) + ; + } + if (*rewi) { + al__1.aerr = 0; + al__1.aunit = *ntra; + f_rew(&al__1); + } + if (conj) { + cchemm_(iorder, side, uplo, &m, &n, &alpha, & + aa[1], &lda, &bb[1], &ldb, &beta, &cc[ + 1], &ldc); + } else { + ccsymm_(iorder, side, uplo, &m, &n, &alpha, & + aa[1], &lda, &bb[1], &ldb, &beta, &cc[ + 1], &ldc); + } + +/* Check if error-exit was taken incorrectly. */ + + if (! infoc_1.ok) { + io___181.ciunit = *nout; + s_wsfe(&io___181); + e_wsfe(); + *fatal = TRUE_; + goto L110; + } + +/* See what data changed inside subroutines. */ + + isame[0] = *(unsigned char *)sides == *(unsigned + char *)side; + isame[1] = *(unsigned char *)uplos == *(unsigned + char *)uplo; + isame[2] = ms == m; + isame[3] = ns == n; + isame[4] = als.r == alpha.r && als.i == alpha.i; + isame[5] = lce_(&as[1], &aa[1], &laa); + isame[6] = ldas == lda; + isame[7] = lce_(&bs[1], &bb[1], &lbb); + isame[8] = ldbs == ldb; + isame[9] = bls.r == beta.r && bls.i == beta.i; + if (null) { + isame[10] = lce_(&cs[1], &cc[1], &lcc); + } else { + isame[10] = lceres_("ge", " ", &m, &n, &cs[1], + &cc[1], &ldc); + } + isame[11] = ldcs == ldc; + +/* If data was incorrectly changed, report and */ +/* return. */ + + same = TRUE_; + i__5 = nargs; + for (i__ = 1; i__ <= i__5; ++i__) { + same = same && isame[i__ - 1]; + if (! isame[i__ - 1]) { + io___184.ciunit = *nout; + s_wsfe(&io___184); + do_fio(&c__1, (char *)&i__, (ftnlen) + sizeof(integer)); + e_wsfe(); + } +/* L40: */ + } + if (! same) { + *fatal = TRUE_; + goto L110; + } + + if (! null) { + +/* Check the result. */ + + if (left) { + cmmch_("N", "N", &m, &n, &m, &alpha, &a[ + a_offset], nmax, &b[b_offset], + nmax, &beta, &c__[c_offset], nmax, + &ct[1], &g[1], &cc[1], &ldc, eps, + &err, fatal, nout, &c_true); + } else { + cmmch_("N", "N", &m, &n, &n, &alpha, &b[ + b_offset], nmax, &a[a_offset], + nmax, &beta, &c__[c_offset], nmax, + &ct[1], &g[1], &cc[1], &ldc, eps, + &err, fatal, nout, &c_true); + } + errmax = f2cmax(errmax,err); +/* If got really bad answer, report and */ +/* return. */ + if (*fatal) { + goto L110; + } + } + +/* L50: */ + } + +/* L60: */ + } + +/* L70: */ + } + +L80: + ; + } + +L90: + ; + } + +/* L100: */ + } + +/* Report result. */ + + if (errmax < *thresh) { + if (*iorder == 0) { + io___186.ciunit = *nout; + s_wsfe(&io___186); + do_fio(&c__1, sname, (ftnlen)13); + do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer)); + e_wsfe(); + } + if (*iorder == 1) { + io___187.ciunit = *nout; + s_wsfe(&io___187); + do_fio(&c__1, sname, (ftnlen)13); + do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer)); + e_wsfe(); + } + } else { + if (*iorder == 0) { + io___188.ciunit = *nout; + s_wsfe(&io___188); + do_fio(&c__1, sname, (ftnlen)13); + do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer)); + do_fio(&c__1, (char *)&errmax, (ftnlen)sizeof(real)); + e_wsfe(); + } + if (*iorder == 1) { + io___189.ciunit = *nout; + s_wsfe(&io___189); + do_fio(&c__1, sname, (ftnlen)13); + do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer)); + do_fio(&c__1, (char *)&errmax, (ftnlen)sizeof(real)); + e_wsfe(); + } + } + goto L120; + +L110: + io___190.ciunit = *nout; + s_wsfe(&io___190); + do_fio(&c__1, sname, (ftnlen)13); + e_wsfe(); + cprcn2_(nout, &nc, sname, iorder, side, uplo, &m, &n, &alpha, &lda, &ldb, + &beta, &ldc); + +L120: + return 0; + +/* L9995: */ + +/* End of CCHK2. */ + +} /* cchk2_ */ + + +/* Subroutine */ int cprcn2_(integer *nout, integer *nc, char *sname, integer + *iorder, char *side, char *uplo, integer *m, integer *n, complex * + alpha, integer *lda, integer *ldb, complex *beta, integer *ldc) +{ + /* Format strings */ + static char fmt_9995[] = "(1x,i6,\002: \002,a13,\002(\002,a14,\002,\002," + "a14,\002,\002,a14,\002,\002)"; + static char fmt_9994[] = "(10x,2(i3,\002,\002),\002 (\002,f4.1,\002,\002" + ",f4.1,\002), A,\002,i3,\002, B,\002,i3,\002, (\002,f4.1,\002," + "\002,f4.1,\002), \002,\002C,\002,i3,\002).\002)"; + + /* Local variables */ + char cs[14], cu[14], crc[14]; + + /* Fortran I/O blocks */ + static cilist io___194 = { 0, 0, 0, fmt_9995, 0 }; + static cilist io___195 = { 0, 0, 0, fmt_9994, 0 }; + + + if (*(unsigned char *)side == 'L') { + s_copy(cs, " CblasLeft", (ftnlen)14, (ftnlen)14); + } else { + s_copy(cs, " CblasRight", (ftnlen)14, (ftnlen)14); + } + if (*(unsigned char *)uplo == 'U') { + s_copy(cu, " CblasUpper", (ftnlen)14, (ftnlen)14); + } else { + s_copy(cu, " CblasLower", (ftnlen)14, (ftnlen)14); + } + if (*iorder == 1) { + s_copy(crc, " CblasRowMajor", (ftnlen)14, (ftnlen)14); + } else { + s_copy(crc, " CblasColMajor", (ftnlen)14, (ftnlen)14); + } + io___194.ciunit = *nout; + s_wsfe(&io___194); + do_fio(&c__1, (char *)&(*nc), (ftnlen)sizeof(integer)); + do_fio(&c__1, sname, (ftnlen)13); + do_fio(&c__1, crc, (ftnlen)14); + do_fio(&c__1, cs, (ftnlen)14); + do_fio(&c__1, cu, (ftnlen)14); + e_wsfe(); + io___195.ciunit = *nout; + s_wsfe(&io___195); + do_fio(&c__1, (char *)&(*m), (ftnlen)sizeof(integer)); + do_fio(&c__1, (char *)&(*n), (ftnlen)sizeof(integer)); + do_fio(&c__2, (char *)&(*alpha), (ftnlen)sizeof(real)); + do_fio(&c__1, (char *)&(*lda), (ftnlen)sizeof(integer)); + do_fio(&c__1, (char *)&(*ldb), (ftnlen)sizeof(integer)); + do_fio(&c__2, (char *)&(*beta), (ftnlen)sizeof(real)); + do_fio(&c__1, (char *)&(*ldc), (ftnlen)sizeof(integer)); + e_wsfe(); + return 0; +} /* cprcn2_ */ + + +/* Subroutine */ int cchk3_(char *sname, real *eps, real *thresh, integer * + nout, integer *ntra, logical *trace, logical *rewi, logical *fatal, + integer *nidim, integer *idim, integer *nalf, complex *alf, integer * + nmax, complex *a, complex *aa, complex *as, complex *b, complex *bb, + complex *bs, complex *ct, real *g, complex *c__, integer *iorder) +{ + /* Initialized data */ + + static char ichu[2] = "UL"; + static char icht[3] = "NTC"; + static char ichd[2] = "UN"; + static char ichs[2] = "LR"; + + /* Format strings */ + static char fmt_9994[] = "(\002 ******* FATAL ERROR - ERROR-CALL MYEXIT " + "TAKEN ON VALID\002,\002 CALL *******\002)"; + static char fmt_9998[] = "(\002 ******* FATAL ERROR - PARAMETER NUMBER" + " \002,i2,\002 WAS CH\002,\002ANGED INCORRECTLY *******\002)"; + static char fmt_10000[] = "(\002 \002,a13,\002 PASSED THE COLUMN-MAJOR C" + "OMPUTATIONAL TESTS\002,\002 (\002,i6,\002 CALL\002,\002S)\002)"; + static char fmt_10001[] = "(\002 \002,a13,\002 PASSED THE ROW-MAJOR C" + "OMPUTATIONAL TESTS\002,\002 (\002,i6,\002 CALL\002,\002S)\002)"; + static char fmt_10002[] = "(\002 \002,a13,\002 COMPLETED THE COLUMN-MAJO" + "R COMPUTATIONAL \002,\002TESTS (\002,i6,\002 CALLS)\002,/\002 **" + "***** BUT WITH MAXIMUM TEST \002,\002RATIO \002,f8.2,\002 - SUSP" + "ECT *******\002)"; + static char fmt_10003[] = "(\002 \002,a13,\002 COMPLETED THE ROW-MAJOR " + " COMPUTATIONAL \002,\002TESTS (\002,i6,\002 CALLS)\002,/\002 **" + "***** BUT WITH MAXIMUM TEST \002,\002RATIO \002,f8.2,\002 - SUSP" + "ECT *******\002)"; + static char fmt_9996[] = "(\002 ******* \002,a13,\002 FAILED ON CALL NUM" + "BER:\002)"; + + /* System generated locals */ + integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2, + i__3, i__4, i__5, i__6, i__7; + complex q__1; + alist al__1; + + /* Local variables */ + char diag[1]; + integer ldas, ldbs; + logical same; + char side[1]; + logical left, null; + char uplo[1]; + integer i__, j, m, n; + extern /* Subroutine */ int cmake_(char *, char *, char *, integer *, + integer *, complex *, integer *, complex *, integer *, logical *, + complex *); + complex alpha; + char diags[1]; + extern /* Subroutine */ int cmmch_(char *, char *, integer *, integer *, + integer *, complex *, complex *, integer *, complex *, integer *, + complex *, complex *, integer *, complex *, real *, complex *, + integer *, real *, real *, logical *, integer *, logical *); + logical isame[13]; + char sides[1]; + integer nargs; + logical reset; + char uplos[1]; + extern /* Subroutine */ int cprcn3_(integer *, integer *, char *, integer + *, char *, char *, char *, char *, integer *, integer *, complex * + , integer *, integer *); + integer ia, na, nc, im, in, ms, ns; + extern logical lceres_(char *, char *, integer *, integer *, complex *, + complex *, integer *); + extern /* Subroutine */ int cctrmm_(integer *, char *, char *, char *, + char *, integer *, integer *, complex *, complex *, integer *, + complex *, integer *); + char tranas[1], transa[1]; + extern /* Subroutine */ int cctrsm_(integer *, char *, char *, char *, + char *, integer *, integer *, complex *, complex *, integer *, + complex *, integer *); + real errmax; + integer laa, icd, lbb, lda, ldb; + extern logical lce_(complex *, complex *, integer *); + integer ics; + complex als; + integer ict, icu; + real err; + + /* Fortran I/O blocks */ + static cilist io___236 = { 0, 0, 0, fmt_9994, 0 }; + static cilist io___239 = { 0, 0, 0, fmt_9998, 0 }; + static cilist io___241 = { 0, 0, 0, fmt_10000, 0 }; + static cilist io___242 = { 0, 0, 0, fmt_10001, 0 }; + static cilist io___243 = { 0, 0, 0, fmt_10002, 0 }; + static cilist io___244 = { 0, 0, 0, fmt_10003, 0 }; + static cilist io___245 = { 0, 0, 0, fmt_9996, 0 }; + + + +/* Tests CTRMM and CTRSM. */ + +/* Auxiliary routine for test program for Level 3 Blas. */ + +/* -- Written on 8-February-1989. */ +/* Jack Dongarra, Argonne National Laboratory. */ +/* Iain Duff, AERE Harwell. */ +/* Jeremy Du Croz, Numerical Algorithms Group Ltd. */ +/* Sven Hammarling, Numerical Algorithms Group Ltd. */ + + /* Parameter adjustments */ + --idim; + --alf; + c_dim1 = *nmax; + c_offset = 1 + c_dim1 * 1; + c__ -= c_offset; + --g; + --ct; + --bs; + --bb; + b_dim1 = *nmax; + b_offset = 1 + b_dim1 * 1; + b -= b_offset; + --as; + --aa; + a_dim1 = *nmax; + a_offset = 1 + a_dim1 * 1; + a -= a_offset; + + /* Function Body */ + + nargs = 11; + nc = 0; + reset = TRUE_; + errmax = 0.f; +/* Set up zero matrix for CMMCH. */ + i__1 = *nmax; + for (j = 1; j <= i__1; ++j) { + i__2 = *nmax; + for (i__ = 1; i__ <= i__2; ++i__) { + i__3 = i__ + j * c_dim1; + c__[i__3].r = 0.f, c__[i__3].i = 0.f; +/* L10: */ + } +/* L20: */ + } + + i__1 = *nidim; + for (im = 1; im <= i__1; ++im) { + m = idim[im]; + + i__2 = *nidim; + for (in = 1; in <= i__2; ++in) { + n = idim[in]; +/* Set LDB to 1 more than minimum value if room. */ + ldb = m; + if (ldb < *nmax) { + ++ldb; + } +/* Skip tests if not enough room. */ + if (ldb > *nmax) { + goto L130; + } + lbb = ldb * n; + null = m <= 0 || n <= 0; + + for (ics = 1; ics <= 2; ++ics) { + *(unsigned char *)side = *(unsigned char *)&ichs[ics - 1]; + left = *(unsigned char *)side == 'L'; + if (left) { + na = m; + } else { + na = n; + } +/* Set LDA to 1 more than minimum value if room. */ + lda = na; + if (lda < *nmax) { + ++lda; + } +/* Skip tests if not enough room. */ + if (lda > *nmax) { + goto L130; + } + laa = lda * na; + + for (icu = 1; icu <= 2; ++icu) { + *(unsigned char *)uplo = *(unsigned char *)&ichu[icu - 1]; + + for (ict = 1; ict <= 3; ++ict) { + *(unsigned char *)transa = *(unsigned char *)&icht[ + ict - 1]; + + for (icd = 1; icd <= 2; ++icd) { + *(unsigned char *)diag = *(unsigned char *)&ichd[ + icd - 1]; + + i__3 = *nalf; + for (ia = 1; ia <= i__3; ++ia) { + i__4 = ia; + alpha.r = alf[i__4].r, alpha.i = alf[i__4].i; + +/* Generate the matrix A. */ + + cmake_("tr", uplo, diag, &na, &na, &a[ + a_offset], nmax, &aa[1], &lda, &reset, + &c_b1); + +/* Generate the matrix B. */ + + cmake_("ge", " ", " ", &m, &n, &b[b_offset], + nmax, &bb[1], &ldb, &reset, &c_b1); + + ++nc; + +/* Save every datum before calling the */ +/* subroutine. */ + + *(unsigned char *)sides = *(unsigned char *) + side; + *(unsigned char *)uplos = *(unsigned char *) + uplo; + *(unsigned char *)tranas = *(unsigned char *) + transa; + *(unsigned char *)diags = *(unsigned char *) + diag; + ms = m; + ns = n; + als.r = alpha.r, als.i = alpha.i; + i__4 = laa; + for (i__ = 1; i__ <= i__4; ++i__) { + i__5 = i__; + i__6 = i__; + as[i__5].r = aa[i__6].r, as[i__5].i = aa[ + i__6].i; +/* L30: */ + } + ldas = lda; + i__4 = lbb; + for (i__ = 1; i__ <= i__4; ++i__) { + i__5 = i__; + i__6 = i__; + bs[i__5].r = bb[i__6].r, bs[i__5].i = bb[ + i__6].i; +/* L40: */ + } + ldbs = ldb; + +/* Call the subroutine. */ + + if (s_cmp(sname + 9, "mm", (ftnlen)2, (ftnlen) + 2) == 0) { + if (*trace) { + cprcn3_(ntra, &nc, sname, iorder, + side, uplo, transa, diag, &m, + &n, &alpha, &lda, &ldb, ( + ftnlen)13, (ftnlen)1, (ftnlen) + 1, (ftnlen)1, (ftnlen)1); + } + if (*rewi) { + al__1.aerr = 0; + al__1.aunit = *ntra; + f_rew(&al__1); + } + cctrmm_(iorder, side, uplo, transa, diag, + &m, &n, &alpha, &aa[1], &lda, &bb[ + 1], &ldb); + } else if (s_cmp(sname + 9, "sm", (ftnlen)2, ( + ftnlen)2) == 0) { + if (*trace) { + cprcn3_(ntra, &nc, sname, iorder, + side, uplo, transa, diag, &m, + &n, &alpha, &lda, &ldb, ( + ftnlen)13, (ftnlen)1, (ftnlen) + 1, (ftnlen)1, (ftnlen)1); + } + if (*rewi) { + al__1.aerr = 0; + al__1.aunit = *ntra; + f_rew(&al__1); + } + cctrsm_(iorder, side, uplo, transa, diag, + &m, &n, &alpha, &aa[1], &lda, &bb[ + 1], &ldb); + } + +/* Check if error-exit was taken incorrectly. */ + + if (! infoc_1.ok) { + io___236.ciunit = *nout; + s_wsfe(&io___236); + e_wsfe(); + *fatal = TRUE_; + goto L150; + } + +/* See what data changed inside subroutines. */ + + isame[0] = *(unsigned char *)sides == *( + unsigned char *)side; + isame[1] = *(unsigned char *)uplos == *( + unsigned char *)uplo; + isame[2] = *(unsigned char *)tranas == *( + unsigned char *)transa; + isame[3] = *(unsigned char *)diags == *( + unsigned char *)diag; + isame[4] = ms == m; + isame[5] = ns == n; + isame[6] = als.r == alpha.r && als.i == + alpha.i; + isame[7] = lce_(&as[1], &aa[1], &laa); + isame[8] = ldas == lda; + if (null) { + isame[9] = lce_(&bs[1], &bb[1], &lbb); + } else { + isame[9] = lceres_("ge", " ", &m, &n, &bs[ + 1], &bb[1], &ldb); + } + isame[10] = ldbs == ldb; + +/* If data was incorrectly changed, report and */ +/* return. */ + + same = TRUE_; + i__4 = nargs; + for (i__ = 1; i__ <= i__4; ++i__) { + same = same && isame[i__ - 1]; + if (! isame[i__ - 1]) { + io___239.ciunit = *nout; + s_wsfe(&io___239); + do_fio(&c__1, (char *)&i__, (ftnlen) + sizeof(integer)); + e_wsfe(); + } +/* L50: */ + } + if (! same) { + *fatal = TRUE_; + goto L150; + } + + if (! null) { + if (s_cmp(sname + 9, "mm", (ftnlen)2, ( + ftnlen)2) == 0) { + +/* Check the result. */ + + if (left) { + cmmch_(transa, "N", &m, &n, &m, & + alpha, &a[a_offset], nmax, + &b[b_offset], nmax, & + c_b1, &c__[c_offset], + nmax, &ct[1], &g[1], &bb[ + 1], &ldb, eps, &err, + fatal, nout, &c_true, ( + ftnlen)1, (ftnlen)1); + } else { + cmmch_("N", transa, &m, &n, &n, & + alpha, &b[b_offset], nmax, + &a[a_offset], nmax, & + c_b1, &c__[c_offset], + nmax, &ct[1], &g[1], &bb[ + 1], &ldb, eps, &err, + fatal, nout, &c_true); + } + } else if (s_cmp(sname + 9, "sm", (ftnlen) + 2, (ftnlen)2) == 0) { + +/* Compute approximation to original */ +/* matrix. */ + + i__4 = n; + for (j = 1; j <= i__4; ++j) { + i__5 = m; + for (i__ = 1; i__ <= i__5; ++i__) + { + i__6 = i__ + j * c_dim1; + i__7 = i__ + (j - 1) * ldb; + c__[i__6].r = bb[i__7].r, c__[i__6].i = bb[i__7].i; + i__6 = i__ + (j - 1) * ldb; + i__7 = i__ + j * b_dim1; + q__1.r = alpha.r * b[i__7].r - alpha.i * b[i__7].i, + q__1.i = alpha.r * b[i__7].i + alpha.i * b[ + i__7].r; + bb[i__6].r = q__1.r, bb[i__6].i = q__1.i; +/* L60: */ + } +/* L70: */ + } + + if (left) { + cmmch_(transa, "N", &m, &n, &m, & + c_b2, &a[a_offset], nmax, + &c__[c_offset], nmax, & + c_b1, &b[b_offset], nmax, + &ct[1], &g[1], &bb[1], & + ldb, eps, &err, fatal, + nout, &c_false); + } else { + cmmch_("N", transa, &m, &n, &n, & + c_b2, &c__[c_offset], + nmax, &a[a_offset], nmax, + &c_b1, &b[b_offset], nmax, + &ct[1], &g[1], &bb[1], & + ldb, eps, &err, fatal, + nout, &c_false); + } + } + errmax = f2cmax(errmax,err); +/* If got really bad answer, report and */ +/* return. */ + if (*fatal) { + goto L150; + } + } + +/* L80: */ + } + +/* L90: */ + } + +/* L100: */ + } + +/* L110: */ + } + +/* L120: */ + } + +L130: + ; + } + +/* L140: */ + } + +/* Report result. */ + + if (errmax < *thresh) { + if (*iorder == 0) { + io___241.ciunit = *nout; + s_wsfe(&io___241); + do_fio(&c__1, sname, (ftnlen)13); + do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer)); + e_wsfe(); + } + if (*iorder == 1) { + io___242.ciunit = *nout; + s_wsfe(&io___242); + do_fio(&c__1, sname, (ftnlen)13); + do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer)); + e_wsfe(); + } + } else { + if (*iorder == 0) { + io___243.ciunit = *nout; + s_wsfe(&io___243); + do_fio(&c__1, sname, (ftnlen)13); + do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer)); + do_fio(&c__1, (char *)&errmax, (ftnlen)sizeof(real)); + e_wsfe(); + } + if (*iorder == 1) { + io___244.ciunit = *nout; + s_wsfe(&io___244); + do_fio(&c__1, sname, (ftnlen)13); + do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer)); + do_fio(&c__1, (char *)&errmax, (ftnlen)sizeof(real)); + e_wsfe(); + } + } + goto L160; + +L150: + io___245.ciunit = *nout; + s_wsfe(&io___245); + do_fio(&c__1, sname, (ftnlen)13); + e_wsfe(); + if (*trace) { + cprcn3_(ntra, &nc, sname, iorder, side, uplo, transa, diag, &m, &n, & + alpha, &lda, &ldb); + } + +L160: + return 0; + +/* L9995: */ + +/* End of CCHK3. */ + +} /* cchk3_ */ + + +/* Subroutine */ int cprcn3_(integer *nout, integer *nc, char *sname, integer + *iorder, char *side, char *uplo, char *transa, char *diag, integer *m, + integer *n, complex *alpha, integer *lda, integer *ldb) +{ + /* Format strings */ + static char fmt_9995[] = "(1x,i6,\002: \002,a13,\002(\002,a14,\002,\002," + "a14,\002,\002,a14,\002,\002)"; + static char fmt_9994[] = "(10x,2(a14,\002,\002),2(i3,\002,\002),\002 " + "(\002,f4.1,\002,\002,f4.1,\002), A,\002,i3,\002, B,\002,i3,\002)." + "\002)"; + + /* Local variables */ + char ca[14], cd[14], cs[14], cu[14], crc[14]; + + /* Fortran I/O blocks */ + static cilist io___251 = { 0, 0, 0, fmt_9995, 0 }; + static cilist io___252 = { 0, 0, 0, fmt_9994, 0 }; + + + if (*(unsigned char *)side == 'L') { + s_copy(cs, " CblasLeft", (ftnlen)14, (ftnlen)14); + } else { + s_copy(cs, " CblasRight", (ftnlen)14, (ftnlen)14); + } + if (*(unsigned char *)uplo == 'U') { + s_copy(cu, " CblasUpper", (ftnlen)14, (ftnlen)14); + } else { + s_copy(cu, " CblasLower", (ftnlen)14, (ftnlen)14); + } + if (*(unsigned char *)transa == 'N') { + s_copy(ca, " CblasNoTrans", (ftnlen)14, (ftnlen)14); + } else if (*(unsigned char *)transa == 'T') { + s_copy(ca, " CblasTrans", (ftnlen)14, (ftnlen)14); + } else { + s_copy(ca, "CblasConjTrans", (ftnlen)14, (ftnlen)14); + } + if (*(unsigned char *)diag == 'N') { + s_copy(cd, " CblasNonUnit", (ftnlen)14, (ftnlen)14); + } else { + s_copy(cd, " CblasUnit", (ftnlen)14, (ftnlen)14); + } + if (*iorder == 1) { + s_copy(crc, " CblasRowMajor", (ftnlen)14, (ftnlen)14); + } else { + s_copy(crc, " CblasColMajor", (ftnlen)14, (ftnlen)14); + } + io___251.ciunit = *nout; + s_wsfe(&io___251); + do_fio(&c__1, (char *)&(*nc), (ftnlen)sizeof(integer)); + do_fio(&c__1, sname, (ftnlen)13); + do_fio(&c__1, crc, (ftnlen)14); + do_fio(&c__1, cs, (ftnlen)14); + do_fio(&c__1, cu, (ftnlen)14); + e_wsfe(); + io___252.ciunit = *nout; + s_wsfe(&io___252); + do_fio(&c__1, ca, (ftnlen)14); + do_fio(&c__1, cd, (ftnlen)14); + do_fio(&c__1, (char *)&(*m), (ftnlen)sizeof(integer)); + do_fio(&c__1, (char *)&(*n), (ftnlen)sizeof(integer)); + do_fio(&c__2, (char *)&(*alpha), (ftnlen)sizeof(real)); + do_fio(&c__1, (char *)&(*lda), (ftnlen)sizeof(integer)); + do_fio(&c__1, (char *)&(*ldb), (ftnlen)sizeof(integer)); + e_wsfe(); + return 0; +} /* cprcn3_ */ + + +/* Subroutine */ int cchk4_(char *sname, real *eps, real *thresh, integer * + nout, integer *ntra, logical *trace, logical *rewi, logical *fatal, + integer *nidim, integer *idim, integer *nalf, complex *alf, integer * + nbet, complex *bet, integer *nmax, complex *a, complex *aa, complex * + as, complex *b, complex *bb, complex *bs, complex *c__, complex *cc, + complex *cs, complex *ct, real *g, integer *iorder) +{ + /* Initialized data */ + + static char icht[2] = "NC"; + static char ichu[2] = "UL"; + + /* Format strings */ + static char fmt_9992[] = "(\002 ******* FATAL ERROR - ERROR-CALL MYEXIT " + "TAKEN ON VALID\002,\002 CALL *******\002)"; + static char fmt_9998[] = "(\002 ******* FATAL ERROR - PARAMETER NUMBER" + " \002,i2,\002 WAS CH\002,\002ANGED INCORRECTLY *******\002)"; + static char fmt_10000[] = "(\002 \002,a13,\002 PASSED THE COLUMN-MAJOR C" + "OMPUTATIONAL TESTS\002,\002 (\002,i6,\002 CALL\002,\002S)\002)"; + static char fmt_10001[] = "(\002 \002,a13,\002 PASSED THE ROW-MAJOR C" + "OMPUTATIONAL TESTS\002,\002 (\002,i6,\002 CALL\002,\002S)\002)"; + static char fmt_10002[] = "(\002 \002,a13,\002 COMPLETED THE COLUMN-MAJO" + "R COMPUTATIONAL \002,\002TESTS (\002,i6,\002 CALLS)\002,/\002 **" + "***** BUT WITH MAXIMUM TEST \002,\002RATIO \002,f8.2,\002 - SUSP" + "ECT *******\002)"; + static char fmt_10003[] = "(\002 \002,a13,\002 COMPLETED THE ROW-MAJOR " + " COMPUTATIONAL \002,\002TESTS (\002,i6,\002 CALLS)\002,/\002 **" + "***** BUT WITH MAXIMUM TEST \002,\002RATIO \002,f8.2,\002 - SUSP" + "ECT *******\002)"; + static char fmt_9995[] = "(\002 THESE ARE THE RESULTS FOR COLUMN" + " \002,i3)"; + static char fmt_9996[] = "(\002 ******* \002,a13,\002 FAILED ON CALL NUM" + "BER:\002)"; + + /* System generated locals */ + integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2, + i__3, i__4, i__5, i__6, i__7; + complex q__1; + alist al__1; + + /* Local variables */ + complex beta; + integer ldas, ldcs; + logical same, conj; + complex bets; + real rals; + logical tran, null; + char uplo[1]; + integer i__, j, k, n; + extern /* Subroutine */ int cmake_(char *, char *, char *, integer *, + integer *, complex *, integer *, complex *, integer *, logical *, + complex *); + complex alpha; + extern /* Subroutine */ int cmmch_(char *, char *, integer *, integer *, + integer *, complex *, complex *, integer *, complex *, integer *, + complex *, complex *, integer *, complex *, real *, complex *, + integer *, real *, real *, logical *, integer *, logical *); + real rbeta; + logical isame[13]; + integer nargs; + real rbets; + logical reset; + char trans[1]; + logical upper; + char uplos[1]; + extern /* Subroutine */ int cprcn4_(integer *, integer *, char *, integer + *, char *, char *, integer *, integer *, complex *, integer *, + complex *, integer *), cprcn6_(integer *, + integer *, char *, integer *, char *, char *, integer *, integer * + , real *, integer *, real *, integer *); + integer ia, ib, jc, ma, na, nc, ik, in, jj, lj, ks; + extern /* Subroutine */ int ccherk_(integer *, char *, char *, integer *, + integer *, real *, complex *, integer *, real *, complex *, + integer *); + integer ns; + real ralpha; + extern logical lceres_(char *, char *, integer *, integer *, complex *, + complex *, integer *); + real errmax; + extern /* Subroutine */ int ccsyrk_(integer *, char *, char *, integer *, + integer *, complex *, complex *, integer *, complex *, complex *, + integer *); + char transs[1], transt[1]; + integer laa, lda, lcc, ldc; + extern logical lce_(complex *, complex *, integer *); + complex als; + integer ict, icu; + real err; + + /* Fortran I/O blocks */ + static cilist io___294 = { 0, 0, 0, fmt_9992, 0 }; + static cilist io___297 = { 0, 0, 0, fmt_9998, 0 }; + static cilist io___304 = { 0, 0, 0, fmt_10000, 0 }; + static cilist io___305 = { 0, 0, 0, fmt_10001, 0 }; + static cilist io___306 = { 0, 0, 0, fmt_10002, 0 }; + static cilist io___307 = { 0, 0, 0, fmt_10003, 0 }; + static cilist io___308 = { 0, 0, 0, fmt_9995, 0 }; + static cilist io___309 = { 0, 0, 0, fmt_9996, 0 }; + + + +/* Tests CHERK and CSYRK. */ + +/* Auxiliary routine for test program for Level 3 Blas. */ + +/* -- Written on 8-February-1989. */ +/* Jack Dongarra, Argonne National Laboratory. */ +/* Iain Duff, AERE Harwell. */ +/* Jeremy Du Croz, Numerical Algorithms Group Ltd. */ +/* Sven Hammarling, Numerical Algorithms Group Ltd. */ + + /* Parameter adjustments */ + --idim; + --alf; + --bet; + --g; + --ct; + --cs; + --cc; + c_dim1 = *nmax; + c_offset = 1 + c_dim1 * 1; + c__ -= c_offset; + --bs; + --bb; + b_dim1 = *nmax; + b_offset = 1 + b_dim1 * 1; + b -= b_offset; + --as; + --aa; + a_dim1 = *nmax; + a_offset = 1 + a_dim1 * 1; + a -= a_offset; + + /* Function Body */ + conj = s_cmp(sname + 7, "he", (ftnlen)2, (ftnlen)2) == 0; + + nargs = 10; + nc = 0; + reset = TRUE_; + errmax = 0.f; + + i__1 = *nidim; + for (in = 1; in <= i__1; ++in) { + n = idim[in]; +/* Set LDC to 1 more than minimum value if room. */ + ldc = n; + if (ldc < *nmax) { + ++ldc; + } +/* Skip tests if not enough room. */ + if (ldc > *nmax) { + goto L100; + } + lcc = ldc * n; + + i__2 = *nidim; + for (ik = 1; ik <= i__2; ++ik) { + k = idim[ik]; + + for (ict = 1; ict <= 2; ++ict) { + *(unsigned char *)trans = *(unsigned char *)&icht[ict - 1]; + tran = *(unsigned char *)trans == 'C'; + if (tran && ! conj) { + *(unsigned char *)trans = 'T'; + } + if (tran) { + ma = k; + na = n; + } else { + ma = n; + na = k; + } +/* Set LDA to 1 more than minimum value if room. */ + lda = ma; + if (lda < *nmax) { + ++lda; + } +/* Skip tests if not enough room. */ + if (lda > *nmax) { + goto L80; + } + laa = lda * na; + +/* Generate the matrix A. */ + + cmake_("ge", " ", " ", &ma, &na, &a[a_offset], nmax, &aa[1], & + lda, &reset, &c_b1); + + for (icu = 1; icu <= 2; ++icu) { + *(unsigned char *)uplo = *(unsigned char *)&ichu[icu - 1]; + upper = *(unsigned char *)uplo == 'U'; + + i__3 = *nalf; + for (ia = 1; ia <= i__3; ++ia) { + i__4 = ia; + alpha.r = alf[i__4].r, alpha.i = alf[i__4].i; + if (conj) { + ralpha = alpha.r; + q__1.r = ralpha, q__1.i = 0.f; + alpha.r = q__1.r, alpha.i = q__1.i; + } + + i__4 = *nbet; + for (ib = 1; ib <= i__4; ++ib) { + i__5 = ib; + beta.r = bet[i__5].r, beta.i = bet[i__5].i; + if (conj) { + rbeta = beta.r; + q__1.r = rbeta, q__1.i = 0.f; + beta.r = q__1.r, beta.i = q__1.i; + } + null = n <= 0; + if (conj) { + null = null || (k <= 0 || ralpha == 0.f) && + rbeta == 1.f; + } + +/* Generate the matrix C. */ + + cmake_(sname + 7, uplo, " ", &n, &n, &c__[ + c_offset], nmax, &cc[1], &ldc, &reset, & + c_b1); + + ++nc; + +/* Save every datum before calling the subroutine. */ + + *(unsigned char *)uplos = *(unsigned char *)uplo; + *(unsigned char *)transs = *(unsigned char *) + trans; + ns = n; + ks = k; + if (conj) { + rals = ralpha; + } else { + als.r = alpha.r, als.i = alpha.i; + } + i__5 = laa; + for (i__ = 1; i__ <= i__5; ++i__) { + i__6 = i__; + i__7 = i__; + as[i__6].r = aa[i__7].r, as[i__6].i = aa[i__7] + .i; +/* L10: */ + } + ldas = lda; + if (conj) { + rbets = rbeta; + } else { + bets.r = beta.r, bets.i = beta.i; + } + i__5 = lcc; + for (i__ = 1; i__ <= i__5; ++i__) { + i__6 = i__; + i__7 = i__; + cs[i__6].r = cc[i__7].r, cs[i__6].i = cc[i__7] + .i; +/* L20: */ + } + ldcs = ldc; + +/* Call the subroutine. */ + + if (conj) { + if (*trace) { + cprcn6_(ntra, &nc, sname, iorder, uplo, + trans, &n, &k, &ralpha, &lda, & + rbeta, &ldc); + } + if (*rewi) { + al__1.aerr = 0; + al__1.aunit = *ntra; + f_rew(&al__1); + } + ccherk_(iorder, uplo, trans, &n, &k, &ralpha, + &aa[1], &lda, &rbeta, &cc[1], &ldc); + } else { + if (*trace) { + cprcn4_(ntra, &nc, sname, iorder, uplo, + trans, &n, &k, &alpha, &lda, & + beta, &ldc); + } + if (*rewi) { + al__1.aerr = 0; + al__1.aunit = *ntra; + f_rew(&al__1); + } + ccsyrk_(iorder, uplo, trans, &n, &k, &alpha, & + aa[1], &lda, &beta, &cc[1], &ldc); + } + +/* Check if error-exit was taken incorrectly. */ + + if (! infoc_1.ok) { + io___294.ciunit = *nout; + s_wsfe(&io___294); + e_wsfe(); + *fatal = TRUE_; + goto L120; + } + +/* See what data changed inside subroutines. */ + + isame[0] = *(unsigned char *)uplos == *(unsigned + char *)uplo; + isame[1] = *(unsigned char *)transs == *(unsigned + char *)trans; + isame[2] = ns == n; + isame[3] = ks == k; + if (conj) { + isame[4] = rals == ralpha; + } else { + isame[4] = als.r == alpha.r && als.i == + alpha.i; + } + isame[5] = lce_(&as[1], &aa[1], &laa); + isame[6] = ldas == lda; + if (conj) { + isame[7] = rbets == rbeta; + } else { + isame[7] = bets.r == beta.r && bets.i == + beta.i; + } + if (null) { + isame[8] = lce_(&cs[1], &cc[1], &lcc); + } else { + isame[8] = lceres_(sname + 7, uplo, &n, &n, & + cs[1], &cc[1], &ldc); + } + isame[9] = ldcs == ldc; + +/* If data was incorrectly changed, report and */ +/* return. */ + + same = TRUE_; + i__5 = nargs; + for (i__ = 1; i__ <= i__5; ++i__) { + same = same && isame[i__ - 1]; + if (! isame[i__ - 1]) { + io___297.ciunit = *nout; + s_wsfe(&io___297); + do_fio(&c__1, (char *)&i__, (ftnlen) + sizeof(integer)); + e_wsfe(); + } +/* L30: */ + } + if (! same) { + *fatal = TRUE_; + goto L120; + } + + if (! null) { + +/* Check the result column by column. */ + + if (conj) { + *(unsigned char *)transt = 'C'; + } else { + *(unsigned char *)transt = 'T'; + } + jc = 1; + i__5 = n; + for (j = 1; j <= i__5; ++j) { + if (upper) { + jj = 1; + lj = j; + } else { + jj = j; + lj = n - j + 1; + } + if (tran) { + cmmch_(transt, "N", &lj, &c__1, &k, & + alpha, &a[jj * a_dim1 + 1], + nmax, &a[j * a_dim1 + 1], + nmax, &beta, &c__[jj + j * + c_dim1], nmax, &ct[1], &g[1], + &cc[jc], &ldc, eps, &err, + fatal, nout, &c_true); + } else { + cmmch_("N", transt, &lj, &c__1, &k, & + alpha, &a[jj + a_dim1], nmax, + &a[j + a_dim1], nmax, &beta, & + c__[jj + j * c_dim1], nmax, & + ct[1], &g[1], &cc[jc], &ldc, + eps, &err, fatal, nout, & + c_true); + } + if (upper) { + jc += ldc; + } else { + jc = jc + ldc + 1; + } + errmax = f2cmax(errmax,err); +/* If got really bad answer, report and */ +/* return. */ + if (*fatal) { + goto L110; + } +/* L40: */ + } + } + +/* L50: */ + } + +/* L60: */ + } + +/* L70: */ + } + +L80: + ; + } + +/* L90: */ + } + +L100: + ; + } + +/* Report result. */ + + if (errmax < *thresh) { + if (*iorder == 0) { + io___304.ciunit = *nout; + s_wsfe(&io___304); + do_fio(&c__1, sname, (ftnlen)13); + do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer)); + e_wsfe(); + } + if (*iorder == 1) { + io___305.ciunit = *nout; + s_wsfe(&io___305); + do_fio(&c__1, sname, (ftnlen)13); + do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer)); + e_wsfe(); + } + } else { + if (*iorder == 0) { + io___306.ciunit = *nout; + s_wsfe(&io___306); + do_fio(&c__1, sname, (ftnlen)13); + do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer)); + do_fio(&c__1, (char *)&errmax, (ftnlen)sizeof(real)); + e_wsfe(); + } + if (*iorder == 1) { + io___307.ciunit = *nout; + s_wsfe(&io___307); + do_fio(&c__1, sname, (ftnlen)13); + do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer)); + do_fio(&c__1, (char *)&errmax, (ftnlen)sizeof(real)); + e_wsfe(); + } + } + goto L130; + +L110: + if (n > 1) { + io___308.ciunit = *nout; + s_wsfe(&io___308); + do_fio(&c__1, (char *)&j, (ftnlen)sizeof(integer)); + e_wsfe(); + } + +L120: + io___309.ciunit = *nout; + s_wsfe(&io___309); + do_fio(&c__1, sname, (ftnlen)13); + e_wsfe(); + if (conj) { + cprcn6_(nout, &nc, sname, iorder, uplo, trans, &n, &k, &ralpha, &lda, + &rbeta, &ldc); + } else { + cprcn4_(nout, &nc, sname, iorder, uplo, trans, &n, &k, &alpha, &lda, & + beta, &ldc); + } + +L130: + return 0; + +/* L9994: */ +/* L9993: */ + +/* End of CCHK4. */ + +} /* cchk4_ */ + + +/* Subroutine */ int cprcn4_(integer *nout, integer *nc, char *sname, integer + *iorder, char *uplo, char *transa, integer *n, integer *k, complex * + alpha, integer *lda, complex *beta, integer *ldc) +{ + /* Format strings */ + static char fmt_9995[] = "(1x,i6,\002: \002,a13,\002(\002,3(a14,\002," + "\002))"; + static char fmt_9994[] = "(10x,2(i3,\002,\002),\002 (\002,f4.1,\002,\002" + ",f4.1,\002), A,\002,i3,\002, (\002,f4.1,\002,\002,f4.1,\002), C" + ",\002,i3,\002).\002)"; + + /* Local variables */ + char ca[14], cu[14], crc[14]; + + /* Fortran I/O blocks */ + static cilist io___313 = { 0, 0, 0, fmt_9995, 0 }; + static cilist io___314 = { 0, 0, 0, fmt_9994, 0 }; + + + if (*(unsigned char *)uplo == 'U') { + s_copy(cu, " CblasUpper", (ftnlen)14, (ftnlen)14); + } else { + s_copy(cu, " CblasLower", (ftnlen)14, (ftnlen)14); + } + if (*(unsigned char *)transa == 'N') { + s_copy(ca, " CblasNoTrans", (ftnlen)14, (ftnlen)14); + } else if (*(unsigned char *)transa == 'T') { + s_copy(ca, " CblasTrans", (ftnlen)14, (ftnlen)14); + } else { + s_copy(ca, "CblasConjTrans", (ftnlen)14, (ftnlen)14); + } + if (*iorder == 1) { + s_copy(crc, " CblasRowMajor", (ftnlen)14, (ftnlen)14); + } else { + s_copy(crc, " CblasColMajor", (ftnlen)14, (ftnlen)14); + } + io___313.ciunit = *nout; + s_wsfe(&io___313); + do_fio(&c__1, (char *)&(*nc), (ftnlen)sizeof(integer)); + do_fio(&c__1, sname, (ftnlen)13); + do_fio(&c__1, crc, (ftnlen)14); + do_fio(&c__1, cu, (ftnlen)14); + do_fio(&c__1, ca, (ftnlen)14); + e_wsfe(); + io___314.ciunit = *nout; + s_wsfe(&io___314); + do_fio(&c__1, (char *)&(*n), (ftnlen)sizeof(integer)); + do_fio(&c__1, (char *)&(*k), (ftnlen)sizeof(integer)); + do_fio(&c__2, (char *)&(*alpha), (ftnlen)sizeof(real)); + do_fio(&c__1, (char *)&(*lda), (ftnlen)sizeof(integer)); + do_fio(&c__2, (char *)&(*beta), (ftnlen)sizeof(real)); + do_fio(&c__1, (char *)&(*ldc), (ftnlen)sizeof(integer)); + e_wsfe(); + return 0; +} /* cprcn4_ */ + + + +/* Subroutine */ int cprcn6_(integer *nout, integer *nc, char *sname, integer + *iorder, char *uplo, char *transa, integer *n, integer *k, real * + alpha, integer *lda, real *beta, integer *ldc) +{ + /* Format strings */ + static char fmt_9995[] = "(1x,i6,\002: \002,a13,\002(\002,3(a14,\002," + "\002))"; + static char fmt_9994[] = "(10x,2(i3,\002,\002),f4.1,\002, A,\002,i3" + ",\002,\002,f4.1,\002, C,\002,i3,\002).\002)"; + + /* Local variables */ + char ca[14], cu[14], crc[14]; + + /* Fortran I/O blocks */ + static cilist io___318 = { 0, 0, 0, fmt_9995, 0 }; + static cilist io___319 = { 0, 0, 0, fmt_9994, 0 }; + + + if (*(unsigned char *)uplo == 'U') { + s_copy(cu, " CblasUpper", (ftnlen)14, (ftnlen)14); + } else { + s_copy(cu, " CblasLower", (ftnlen)14, (ftnlen)14); + } + if (*(unsigned char *)transa == 'N') { + s_copy(ca, " CblasNoTrans", (ftnlen)14, (ftnlen)14); + } else if (*(unsigned char *)transa == 'T') { + s_copy(ca, " CblasTrans", (ftnlen)14, (ftnlen)14); + } else { + s_copy(ca, "CblasConjTrans", (ftnlen)14, (ftnlen)14); + } + if (*iorder == 1) { + s_copy(crc, " CblasRowMajor", (ftnlen)14, (ftnlen)14); + } else { + s_copy(crc, " CblasColMajor", (ftnlen)14, (ftnlen)14); + } + io___318.ciunit = *nout; + s_wsfe(&io___318); + do_fio(&c__1, (char *)&(*nc), (ftnlen)sizeof(integer)); + do_fio(&c__1, sname, (ftnlen)13); + do_fio(&c__1, crc, (ftnlen)14); + do_fio(&c__1, cu, (ftnlen)14); + do_fio(&c__1, ca, (ftnlen)14); + e_wsfe(); + io___319.ciunit = *nout; + s_wsfe(&io___319); + do_fio(&c__1, (char *)&(*n), (ftnlen)sizeof(integer)); + do_fio(&c__1, (char *)&(*k), (ftnlen)sizeof(integer)); + do_fio(&c__1, (char *)&(*alpha), (ftnlen)sizeof(real)); + do_fio(&c__1, (char *)&(*lda), (ftnlen)sizeof(integer)); + do_fio(&c__1, (char *)&(*beta), (ftnlen)sizeof(real)); + do_fio(&c__1, (char *)&(*ldc), (ftnlen)sizeof(integer)); + e_wsfe(); + return 0; +} /* cprcn6_ */ + + +/* Subroutine */ int cchk5_(char *sname, real *eps, real *thresh, integer * + nout, integer *ntra, logical *trace, logical *rewi, logical *fatal, + integer *nidim, integer *idim, integer *nalf, complex *alf, integer * + nbet, complex *bet, integer *nmax, complex *ab, complex *aa, complex * + as, complex *bb, complex *bs, complex *c__, complex *cc, complex *cs, + complex *ct, real *g, complex *w, integer *iorder) +{ + /* Initialized data */ + + static char icht[2] = "NC"; + static char ichu[2] = "UL"; + + /* Format strings */ + static char fmt_9992[] = "(\002 ******* FATAL ERROR - ERROR-CALL MYEXIT " + "TAKEN ON VALID\002,\002 CALL *******\002)"; + static char fmt_9998[] = "(\002 ******* FATAL ERROR - PARAMETER NUMBER" + " \002,i2,\002 WAS CH\002,\002ANGED INCORRECTLY *******\002)"; + static char fmt_10000[] = "(\002 \002,a13,\002 PASSED THE COLUMN-MAJOR C" + "OMPUTATIONAL TESTS\002,\002 (\002,i6,\002 CALL\002,\002S)\002)"; + static char fmt_10001[] = "(\002 \002,a13,\002 PASSED THE ROW-MAJOR C" + "OMPUTATIONAL TESTS\002,\002 (\002,i6,\002 CALL\002,\002S)\002)"; + static char fmt_10002[] = "(\002 \002,a13,\002 COMPLETED THE COLUMN-MAJO" + "R COMPUTATIONAL \002,\002TESTS (\002,i6,\002 CALLS)\002,/\002 **" + "***** BUT WITH MAXIMUM TEST \002,\002RATIO \002,f8.2,\002 - SUSP" + "ECT *******\002)"; + static char fmt_10003[] = "(\002 \002,a13,\002 COMPLETED THE ROW-MAJOR " + " COMPUTATIONAL \002,\002TESTS (\002,i6,\002 CALLS)\002,/\002 **" + "***** BUT WITH MAXIMUM TEST \002,\002RATIO \002,f8.2,\002 - SUSP" + "ECT *******\002)"; + static char fmt_9995[] = "(\002 THESE ARE THE RESULTS FOR COLUMN" + " \002,i3)"; + static char fmt_9996[] = "(\002 ******* \002,a13,\002 FAILED ON CALL NUM" + "BER:\002)"; + + /* System generated locals */ + integer c_dim1, c_offset, i__1, i__2, i__3, i__4, i__5, i__6, i__7, i__8; + complex q__1, q__2; + alist al__1; + + /* Local variables */ + integer jjab; + complex beta; + integer ldas, ldbs, ldcs; + logical same, conj; + complex bets; + logical tran, null; + char uplo[1]; + integer i__, j, k, n; + extern /* Subroutine */ int cmake_(char *, char *, char *, integer *, + integer *, complex *, integer *, complex *, integer *, logical *, + complex *); + complex alpha; + extern /* Subroutine */ int cmmch_(char *, char *, integer *, integer *, + integer *, complex *, complex *, integer *, complex *, integer *, + complex *, complex *, integer *, complex *, real *, complex *, + integer *, real *, real *, logical *, integer *, logical *); + real rbeta; + logical isame[13]; + integer nargs; + real rbets; + logical reset; + char trans[1]; + logical upper; + char uplos[1]; + extern /* Subroutine */ int cprcn5_(integer *, integer *, char *, integer + *, char *, char *, integer *, integer *, complex *, integer *, + integer *, complex *, integer *), cprcn7_( + integer *, integer *, char *, integer *, char *, char *, integer * + , integer *, complex *, integer *, integer *, real *, integer *); + integer ia, ib, jc, ma, na, nc, ik, in, jj, lj, ks, ns; + extern logical lceres_(char *, char *, integer *, integer *, complex *, + complex *, integer *); + real errmax; + char transs[1], transt[1]; + extern /* Subroutine */ int ccher2k_(integer *, char *, char *, integer *, + integer *, complex *, complex *, integer *, complex *, integer *, + real *, complex *, integer *); + integer laa, lbb, lda, lcc, ldb, ldc; + extern logical lce_(complex *, complex *, integer *); + extern /* Subroutine */ int ccsyr2k_(integer *, char *, char *, integer *, + integer *, complex *, complex *, integer *, complex *, integer *, + complex *, complex *, integer *); + complex als; + integer ict, icu; + real err; + + /* Fortran I/O blocks */ + static cilist io___362 = { 0, 0, 0, fmt_9992, 0 }; + static cilist io___365 = { 0, 0, 0, fmt_9998, 0 }; + static cilist io___373 = { 0, 0, 0, fmt_10000, 0 }; + static cilist io___374 = { 0, 0, 0, fmt_10001, 0 }; + static cilist io___375 = { 0, 0, 0, fmt_10002, 0 }; + static cilist io___376 = { 0, 0, 0, fmt_10003, 0 }; + static cilist io___377 = { 0, 0, 0, fmt_9995, 0 }; + static cilist io___378 = { 0, 0, 0, fmt_9996, 0 }; + + + +/* Tests CHER2K and CSYR2K. */ + +/* Auxiliary routine for test program for Level 3 Blas. */ + +/* -- Written on 8-February-1989. */ +/* Jack Dongarra, Argonne National Laboratory. */ +/* Iain Duff, AERE Harwell. */ +/* Jeremy Du Croz, Numerical Algorithms Group Ltd. */ +/* Sven Hammarling, Numerical Algorithms Group Ltd. */ + + /* Parameter adjustments */ + --idim; + --alf; + --bet; + --w; + --g; + --ct; + --cs; + --cc; + c_dim1 = *nmax; + c_offset = 1 + c_dim1 * 1; + c__ -= c_offset; + --bs; + --bb; + --as; + --aa; + --ab; + + /* Function Body */ + conj = s_cmp(sname + 7, "he", (ftnlen)2, (ftnlen)2) == 0; + + nargs = 12; + nc = 0; + reset = TRUE_; + errmax = 0.f; + + i__1 = *nidim; + for (in = 1; in <= i__1; ++in) { + n = idim[in]; +/* Set LDC to 1 more than minimum value if room. */ + ldc = n; + if (ldc < *nmax) { + ++ldc; + } +/* Skip tests if not enough room. */ + if (ldc > *nmax) { + goto L130; + } + lcc = ldc * n; + + i__2 = *nidim; + for (ik = 1; ik <= i__2; ++ik) { + k = idim[ik]; + + for (ict = 1; ict <= 2; ++ict) { + *(unsigned char *)trans = *(unsigned char *)&icht[ict - 1]; + tran = *(unsigned char *)trans == 'C'; + if (tran && ! conj) { + *(unsigned char *)trans = 'T'; + } + if (tran) { + ma = k; + na = n; + } else { + ma = n; + na = k; + } +/* Set LDA to 1 more than minimum value if room. */ + lda = ma; + if (lda < *nmax) { + ++lda; + } +/* Skip tests if not enough room. */ + if (lda > *nmax) { + goto L110; + } + laa = lda * na; + +/* Generate the matrix A. */ + + if (tran) { + i__3 = *nmax << 1; + cmake_("ge", " ", " ", &ma, &na, &ab[1], &i__3, &aa[1], & + lda, &reset, &c_b1); + } else { + cmake_("ge", " ", " ", &ma, &na, &ab[1], nmax, &aa[1], & + lda, &reset, &c_b1); + } + +/* Generate the matrix B. */ + + ldb = lda; + lbb = laa; + if (tran) { + i__3 = *nmax << 1; + cmake_("ge", " ", " ", &ma, &na, &ab[k + 1], &i__3, &bb[1] + , &ldb, &reset, &c_b1); + } else { + cmake_("ge", " ", " ", &ma, &na, &ab[k * *nmax + 1], nmax, + &bb[1], &ldb, &reset, &c_b1); + } + + for (icu = 1; icu <= 2; ++icu) { + *(unsigned char *)uplo = *(unsigned char *)&ichu[icu - 1]; + upper = *(unsigned char *)uplo == 'U'; + + i__3 = *nalf; + for (ia = 1; ia <= i__3; ++ia) { + i__4 = ia; + alpha.r = alf[i__4].r, alpha.i = alf[i__4].i; + + i__4 = *nbet; + for (ib = 1; ib <= i__4; ++ib) { + i__5 = ib; + beta.r = bet[i__5].r, beta.i = bet[i__5].i; + if (conj) { + rbeta = beta.r; + q__1.r = rbeta, q__1.i = 0.f; + beta.r = q__1.r, beta.i = q__1.i; + } + null = n <= 0; + if (conj) { + null = null || (k <= 0 || alpha.r == 0.f && + alpha.i == 0.f) && rbeta == 1.f; + } + +/* Generate the matrix C. */ + + cmake_(sname + 7, uplo, " ", &n, &n, &c__[ + c_offset], nmax, &cc[1], &ldc, &reset, & + c_b1); + + ++nc; + +/* Save every datum before calling the subroutine. */ + + *(unsigned char *)uplos = *(unsigned char *)uplo; + *(unsigned char *)transs = *(unsigned char *) + trans; + ns = n; + ks = k; + als.r = alpha.r, als.i = alpha.i; + i__5 = laa; + for (i__ = 1; i__ <= i__5; ++i__) { + i__6 = i__; + i__7 = i__; + as[i__6].r = aa[i__7].r, as[i__6].i = aa[i__7] + .i; +/* L10: */ + } + ldas = lda; + i__5 = lbb; + for (i__ = 1; i__ <= i__5; ++i__) { + i__6 = i__; + i__7 = i__; + bs[i__6].r = bb[i__7].r, bs[i__6].i = bb[i__7] + .i; +/* L20: */ + } + ldbs = ldb; + if (conj) { + rbets = rbeta; + } else { + bets.r = beta.r, bets.i = beta.i; + } + i__5 = lcc; + for (i__ = 1; i__ <= i__5; ++i__) { + i__6 = i__; + i__7 = i__; + cs[i__6].r = cc[i__7].r, cs[i__6].i = cc[i__7] + .i; +/* L30: */ + } + ldcs = ldc; + +/* Call the subroutine. */ + + if (conj) { + if (*trace) { + cprcn7_(ntra, &nc, sname, iorder, uplo, + trans, &n, &k, &alpha, &lda, &ldb, + &rbeta, &ldc); + } + if (*rewi) { + al__1.aerr = 0; + al__1.aunit = *ntra; + f_rew(&al__1); + } + ccher2k_(iorder, uplo, trans, &n, &k, &alpha, + &aa[1], &lda, &bb[1], &ldb, &rbeta, & + cc[1], &ldc); + } else { + if (*trace) { + cprcn5_(ntra, &nc, sname, iorder, uplo, + trans, &n, &k, &alpha, &lda, &ldb, + &beta, &ldc); + } + if (*rewi) { + al__1.aerr = 0; + al__1.aunit = *ntra; + f_rew(&al__1); + } + ccsyr2k_(iorder, uplo, trans, &n, &k, &alpha, + &aa[1], &lda, &bb[1], &ldb, &beta, & + cc[1], &ldc); + } + +/* Check if error-exit was taken incorrectly. */ + + if (! infoc_1.ok) { + io___362.ciunit = *nout; + s_wsfe(&io___362); + e_wsfe(); + *fatal = TRUE_; + goto L150; + } + +/* See what data changed inside subroutines. */ + + isame[0] = *(unsigned char *)uplos == *(unsigned + char *)uplo; + isame[1] = *(unsigned char *)transs == *(unsigned + char *)trans; + isame[2] = ns == n; + isame[3] = ks == k; + isame[4] = als.r == alpha.r && als.i == alpha.i; + isame[5] = lce_(&as[1], &aa[1], &laa); + isame[6] = ldas == lda; + isame[7] = lce_(&bs[1], &bb[1], &lbb); + isame[8] = ldbs == ldb; + if (conj) { + isame[9] = rbets == rbeta; + } else { + isame[9] = bets.r == beta.r && bets.i == + beta.i; + } + if (null) { + isame[10] = lce_(&cs[1], &cc[1], &lcc); + } else { + isame[10] = lceres_("he", uplo, &n, &n, &cs[1] + , &cc[1], &ldc); + } + isame[11] = ldcs == ldc; + +/* If data was incorrectly changed, report and */ +/* return. */ + + same = TRUE_; + i__5 = nargs; + for (i__ = 1; i__ <= i__5; ++i__) { + same = same && isame[i__ - 1]; + if (! isame[i__ - 1]) { + io___365.ciunit = *nout; + s_wsfe(&io___365); + do_fio(&c__1, (char *)&i__, (ftnlen) + sizeof(integer)); + e_wsfe(); + } +/* L40: */ + } + if (! same) { + *fatal = TRUE_; + goto L150; + } + + if (! null) { + +/* Check the result column by column. */ + + if (conj) { + *(unsigned char *)transt = 'C'; + } else { + *(unsigned char *)transt = 'T'; + } + jjab = 1; + jc = 1; + i__5 = n; + for (j = 1; j <= i__5; ++j) { + if (upper) { + jj = 1; + lj = j; + } else { + jj = j; + lj = n - j + 1; + } + if (tran) { + i__6 = k; + for (i__ = 1; i__ <= i__6; ++i__) { + i__7 = i__; + i__8 = (j - 1 << 1) * *nmax + k + + i__; + q__1.r = alpha.r * ab[i__8].r - + alpha.i * ab[i__8].i, + q__1.i = alpha.r * ab[ + i__8].i + alpha.i * ab[ + i__8].r; + w[i__7].r = q__1.r, w[i__7].i = + q__1.i; + if (conj) { + i__7 = k + i__; + r_cnjg(&q__2, &alpha); + i__8 = (j - 1 << 1) * *nmax + i__; + q__1.r = q__2.r * ab[i__8].r - q__2.i * ab[i__8].i, + q__1.i = q__2.r * ab[i__8].i + q__2.i * ab[ + i__8].r; + w[i__7].r = q__1.r, w[i__7].i = q__1.i; + } else { + i__7 = k + i__; + i__8 = (j - 1 << 1) * *nmax + i__; + q__1.r = alpha.r * ab[i__8].r - alpha.i * ab[i__8] + .i, q__1.i = alpha.r * ab[i__8].i + alpha.i + * ab[i__8].r; + w[i__7].r = q__1.r, w[i__7].i = q__1.i; + } +/* L50: */ + } + i__6 = k << 1; + i__7 = *nmax << 1; + i__8 = *nmax << 1; + cmmch_(transt, "N", &lj, &c__1, &i__6, + &c_b2, &ab[jjab], &i__7, &w[ + 1], &i__8, &beta, &c__[jj + j + * c_dim1], nmax, &ct[1], &g[1] + , &cc[jc], &ldc, eps, &err, + fatal, nout, &c_true); + } else { + i__6 = k; + for (i__ = 1; i__ <= i__6; ++i__) { + if (conj) { + i__7 = i__; + r_cnjg(&q__2, &ab[(k + i__ - 1) * *nmax + j]); + q__1.r = alpha.r * q__2.r - alpha.i * q__2.i, + q__1.i = alpha.r * q__2.i + alpha.i * + q__2.r; + w[i__7].r = q__1.r, w[i__7].i = q__1.i; + i__7 = k + i__; + i__8 = (i__ - 1) * *nmax + j; + q__2.r = alpha.r * ab[i__8].r - alpha.i * ab[i__8] + .i, q__2.i = alpha.r * ab[i__8].i + alpha.i + * ab[i__8].r; + r_cnjg(&q__1, &q__2); + w[i__7].r = q__1.r, w[i__7].i = q__1.i; + } else { + i__7 = i__; + i__8 = (k + i__ - 1) * *nmax + j; + q__1.r = alpha.r * ab[i__8].r - alpha.i * ab[i__8] + .i, q__1.i = alpha.r * ab[i__8].i + alpha.i + * ab[i__8].r; + w[i__7].r = q__1.r, w[i__7].i = q__1.i; + i__7 = k + i__; + i__8 = (i__ - 1) * *nmax + j; + q__1.r = alpha.r * ab[i__8].r - alpha.i * ab[i__8] + .i, q__1.i = alpha.r * ab[i__8].i + alpha.i + * ab[i__8].r; + w[i__7].r = q__1.r, w[i__7].i = q__1.i; + } +/* L60: */ + } + i__6 = k << 1; + i__7 = *nmax << 1; + cmmch_("N", "N", &lj, &c__1, &i__6, & + c_b2, &ab[jj], nmax, &w[1], & + i__7, &beta, &c__[jj + j * + c_dim1], nmax, &ct[1], &g[1], + &cc[jc], &ldc, eps, &err, + fatal, nout, &c_true); + } + if (upper) { + jc += ldc; + } else { + jc = jc + ldc + 1; + if (tran) { + jjab += *nmax << 1; + } + } + errmax = f2cmax(errmax,err); +/* If got really bad answer, report and */ +/* return. */ + if (*fatal) { + goto L140; + } +/* L70: */ + } + } + +/* L80: */ + } + +/* L90: */ + } + +/* L100: */ + } + +L110: + ; + } + +/* L120: */ + } + +L130: + ; + } + +/* Report result. */ + + if (errmax < *thresh) { + if (*iorder == 0) { + io___373.ciunit = *nout; + s_wsfe(&io___373); + do_fio(&c__1, sname, (ftnlen)13); + do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer)); + e_wsfe(); + } + if (*iorder == 1) { + io___374.ciunit = *nout; + s_wsfe(&io___374); + do_fio(&c__1, sname, (ftnlen)13); + do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer)); + e_wsfe(); + } + } else { + if (*iorder == 0) { + io___375.ciunit = *nout; + s_wsfe(&io___375); + do_fio(&c__1, sname, (ftnlen)13); + do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer)); + do_fio(&c__1, (char *)&errmax, (ftnlen)sizeof(real)); + e_wsfe(); + } + if (*iorder == 1) { + io___376.ciunit = *nout; + s_wsfe(&io___376); + do_fio(&c__1, sname, (ftnlen)13); + do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer)); + do_fio(&c__1, (char *)&errmax, (ftnlen)sizeof(real)); + e_wsfe(); + } + } + goto L160; + +L140: + if (n > 1) { + io___377.ciunit = *nout; + s_wsfe(&io___377); + do_fio(&c__1, (char *)&j, (ftnlen)sizeof(integer)); + e_wsfe(); + } + +L150: + io___378.ciunit = *nout; + s_wsfe(&io___378); + do_fio(&c__1, sname, (ftnlen)13); + e_wsfe(); + if (conj) { + cprcn7_(nout, &nc, sname, iorder, uplo, trans, &n, &k, &alpha, &lda, & + ldb, &rbeta, &ldc); + } else { + cprcn5_(nout, &nc, sname, iorder, uplo, trans, &n, &k, &alpha, &lda, & + ldb, &beta, &ldc); + } + +L160: + return 0; + +/* L9994: */ +/* L9993: */ + +/* End of CCHK5. */ + +} /* cchk5_ */ + + +/* Subroutine */ int cprcn5_(integer *nout, integer *nc, char *sname, integer + *iorder, char *uplo, char *transa, integer *n, integer *k, complex * + alpha, integer *lda, integer *ldb, complex *beta, integer *ldc) +{ + /* Format strings */ + static char fmt_9995[] = "(1x,i6,\002: \002,a13,\002(\002,3(a14,\002," + "\002))"; + static char fmt_9994[] = "(10x,2(i3,\002,\002),\002 (\002,f4.1,\002,\002" + ",f4.1,\002), A,\002,i3,\002, B\002,i3,\002, (\002,f4.1,\002,\002" + ",f4.1,\002), C,\002,i3,\002).\002)"; + + /* Local variables */ + char ca[14], cu[14], crc[14]; + + /* Fortran I/O blocks */ + static cilist io___382 = { 0, 0, 0, fmt_9995, 0 }; + static cilist io___383 = { 0, 0, 0, fmt_9994, 0 }; + + + if (*(unsigned char *)uplo == 'U') { + s_copy(cu, " CblasUpper", (ftnlen)14, (ftnlen)14); + } else { + s_copy(cu, " CblasLower", (ftnlen)14, (ftnlen)14); + } + if (*(unsigned char *)transa == 'N') { + s_copy(ca, " CblasNoTrans", (ftnlen)14, (ftnlen)14); + } else if (*(unsigned char *)transa == 'T') { + s_copy(ca, " CblasTrans", (ftnlen)14, (ftnlen)14); + } else { + s_copy(ca, "CblasConjTrans", (ftnlen)14, (ftnlen)14); + } + if (*iorder == 1) { + s_copy(crc, " CblasRowMajor", (ftnlen)14, (ftnlen)14); + } else { + s_copy(crc, " CblasColMajor", (ftnlen)14, (ftnlen)14); + } + io___382.ciunit = *nout; + s_wsfe(&io___382); + do_fio(&c__1, (char *)&(*nc), (ftnlen)sizeof(integer)); + do_fio(&c__1, sname, (ftnlen)13); + do_fio(&c__1, crc, (ftnlen)14); + do_fio(&c__1, cu, (ftnlen)14); + do_fio(&c__1, ca, (ftnlen)14); + e_wsfe(); + io___383.ciunit = *nout; + s_wsfe(&io___383); + do_fio(&c__1, (char *)&(*n), (ftnlen)sizeof(integer)); + do_fio(&c__1, (char *)&(*k), (ftnlen)sizeof(integer)); + do_fio(&c__2, (char *)&(*alpha), (ftnlen)sizeof(real)); + do_fio(&c__1, (char *)&(*lda), (ftnlen)sizeof(integer)); + do_fio(&c__1, (char *)&(*ldb), (ftnlen)sizeof(integer)); + do_fio(&c__2, (char *)&(*beta), (ftnlen)sizeof(real)); + do_fio(&c__1, (char *)&(*ldc), (ftnlen)sizeof(integer)); + e_wsfe(); + return 0; +} /* cprcn5_ */ + + + +/* Subroutine */ int cprcn7_(integer *nout, integer *nc, char *sname, integer + *iorder, char *uplo, char *transa, integer *n, integer *k, complex * + alpha, integer *lda, integer *ldb, real *beta, integer *ldc) +{ + /* Format strings */ + static char fmt_9995[] = "(1x,i6,\002: \002,a13,\002(\002,3(a14,\002," + "\002))"; + static char fmt_9994[] = "(10x,2(i3,\002,\002),\002 (\002,f4.1,\002,\002" + ",f4.1,\002), A,\002,i3,\002, B\002,i3,\002,\002,f4.1,\002, C," + "\002,i3,\002).\002)"; + + /* Local variables */ + char ca[14], cu[14], crc[14]; + + /* Fortran I/O blocks */ + static cilist io___387 = { 0, 0, 0, fmt_9995, 0 }; + static cilist io___388 = { 0, 0, 0, fmt_9994, 0 }; + + + if (*(unsigned char *)uplo == 'U') { + s_copy(cu, " CblasUpper", (ftnlen)14, (ftnlen)14); + } else { + s_copy(cu, " CblasLower", (ftnlen)14, (ftnlen)14); + } + if (*(unsigned char *)transa == 'N') { + s_copy(ca, " CblasNoTrans", (ftnlen)14, (ftnlen)14); + } else if (*(unsigned char *)transa == 'T') { + s_copy(ca, " CblasTrans", (ftnlen)14, (ftnlen)14); + } else { + s_copy(ca, "CblasConjTrans", (ftnlen)14, (ftnlen)14); + } + if (*iorder == 1) { + s_copy(crc, " CblasRowMajor", (ftnlen)14, (ftnlen)14); + } else { + s_copy(crc, " CblasColMajor", (ftnlen)14, (ftnlen)14); + } + io___387.ciunit = *nout; + s_wsfe(&io___387); + do_fio(&c__1, (char *)&(*nc), (ftnlen)sizeof(integer)); + do_fio(&c__1, sname, (ftnlen)13); + do_fio(&c__1, crc, (ftnlen)14); + do_fio(&c__1, cu, (ftnlen)14); + do_fio(&c__1, ca, (ftnlen)14); + e_wsfe(); + io___388.ciunit = *nout; + s_wsfe(&io___388); + do_fio(&c__1, (char *)&(*n), (ftnlen)sizeof(integer)); + do_fio(&c__1, (char *)&(*k), (ftnlen)sizeof(integer)); + do_fio(&c__2, (char *)&(*alpha), (ftnlen)sizeof(real)); + do_fio(&c__1, (char *)&(*lda), (ftnlen)sizeof(integer)); + do_fio(&c__1, (char *)&(*ldb), (ftnlen)sizeof(integer)); + do_fio(&c__1, (char *)&(*beta), (ftnlen)sizeof(real)); + do_fio(&c__1, (char *)&(*ldc), (ftnlen)sizeof(integer)); + e_wsfe(); + return 0; +} /* cprcn7_ */ + + +/* Subroutine */ int cmake_(char *type__, char *uplo, char *diag, integer *m, + integer *n, complex *a, integer *nmax, complex *aa, integer *lda, + logical *reset, complex *transl) +{ + /* System generated locals */ + integer a_dim1, a_offset, i__1, i__2, i__3, i__4; + real r__1; + complex q__1, q__2; + + /* Local variables */ + extern /* Complex */ VOID cbeg_(complex *, logical *); + integer ibeg, iend; + logical unit; + integer i__, j; + logical lower, upper; + integer jj; + logical gen, her, tri, sym; + + +/* Generates values for an M by N matrix A. */ +/* Stores the values in the array AA in the data structure required */ +/* by the routine, with unwanted elements set to rogue value. */ + +/* TYPE is 'ge', 'he', 'sy' or 'tr'. */ + +/* Auxiliary routine for test program for Level 3 Blas. */ + +/* -- Written on 8-February-1989. */ +/* Jack Dongarra, Argonne National Laboratory. */ +/* Iain Duff, AERE Harwell. */ +/* Jeremy Du Croz, Numerical Algorithms Group Ltd. */ +/* Sven Hammarling, Numerical Algorithms Group Ltd. */ + + /* Parameter adjustments */ + a_dim1 = *nmax; + a_offset = 1 + a_dim1 * 1; + a -= a_offset; + --aa; + + /* Function Body */ + gen = s_cmp(type__, "ge", (ftnlen)2, (ftnlen)2) == 0; + her = s_cmp(type__, "he", (ftnlen)2, (ftnlen)2) == 0; + sym = s_cmp(type__, "sy", (ftnlen)2, (ftnlen)2) == 0; + tri = s_cmp(type__, "tr", (ftnlen)2, (ftnlen)2) == 0; + upper = (her || sym || tri) && *(unsigned char *)uplo == 'U'; + lower = (her || sym || tri) && *(unsigned char *)uplo == 'L'; + unit = tri && *(unsigned char *)diag == 'U'; + +/* Generate data in array A. */ + + i__1 = *n; + for (j = 1; j <= i__1; ++j) { + i__2 = *m; + for (i__ = 1; i__ <= i__2; ++i__) { + if (gen || upper && i__ <= j || lower && i__ >= j) { + i__3 = i__ + j * a_dim1; + cbeg_(&q__2, reset); + q__1.r = q__2.r + transl->r, q__1.i = q__2.i + transl->i; + a[i__3].r = q__1.r, a[i__3].i = q__1.i; + if (i__ != j) { +/* Set some elements to zero */ + if (*n > 3 && j == *n / 2) { + i__3 = i__ + j * a_dim1; + a[i__3].r = 0.f, a[i__3].i = 0.f; + } + if (her) { + i__3 = j + i__ * a_dim1; + r_cnjg(&q__1, &a[i__ + j * a_dim1]); + a[i__3].r = q__1.r, a[i__3].i = q__1.i; + } else if (sym) { + i__3 = j + i__ * a_dim1; + i__4 = i__ + j * a_dim1; + a[i__3].r = a[i__4].r, a[i__3].i = a[i__4].i; + } else if (tri) { + i__3 = j + i__ * a_dim1; + a[i__3].r = 0.f, a[i__3].i = 0.f; + } + } + } +/* L10: */ + } + if (her) { + i__2 = j + j * a_dim1; + i__3 = j + j * a_dim1; + r__1 = a[i__3].r; + q__1.r = r__1, q__1.i = 0.f; + a[i__2].r = q__1.r, a[i__2].i = q__1.i; + } + if (tri) { + i__2 = j + j * a_dim1; + i__3 = j + j * a_dim1; + q__1.r = a[i__3].r + 1.f, q__1.i = a[i__3].i + 0.f; + a[i__2].r = q__1.r, a[i__2].i = q__1.i; + } + if (unit) { + i__2 = j + j * a_dim1; + a[i__2].r = 1.f, a[i__2].i = 0.f; + } +/* L20: */ + } + +/* Store elements in array AS in data structure required by routine. */ + + if (s_cmp(type__, "ge", (ftnlen)2, (ftnlen)2) == 0) { + i__1 = *n; + for (j = 1; j <= i__1; ++j) { + i__2 = *m; + for (i__ = 1; i__ <= i__2; ++i__) { + i__3 = i__ + (j - 1) * *lda; + i__4 = i__ + j * a_dim1; + aa[i__3].r = a[i__4].r, aa[i__3].i = a[i__4].i; +/* L30: */ + } + i__2 = *lda; + for (i__ = *m + 1; i__ <= i__2; ++i__) { + i__3 = i__ + (j - 1) * *lda; + aa[i__3].r = -1e10f, aa[i__3].i = 1e10f; +/* L40: */ + } +/* L50: */ + } + } else if (s_cmp(type__, "he", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(type__, + "sy", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(type__, "tr", (ftnlen) + 2, (ftnlen)2) == 0) { + i__1 = *n; + for (j = 1; j <= i__1; ++j) { + if (upper) { + ibeg = 1; + if (unit) { + iend = j - 1; + } else { + iend = j; + } + } else { + if (unit) { + ibeg = j + 1; + } else { + ibeg = j; + } + iend = *n; + } + i__2 = ibeg - 1; + for (i__ = 1; i__ <= i__2; ++i__) { + i__3 = i__ + (j - 1) * *lda; + aa[i__3].r = -1e10f, aa[i__3].i = 1e10f; +/* L60: */ + } + i__2 = iend; + for (i__ = ibeg; i__ <= i__2; ++i__) { + i__3 = i__ + (j - 1) * *lda; + i__4 = i__ + j * a_dim1; + aa[i__3].r = a[i__4].r, aa[i__3].i = a[i__4].i; +/* L70: */ + } + i__2 = *lda; + for (i__ = iend + 1; i__ <= i__2; ++i__) { + i__3 = i__ + (j - 1) * *lda; + aa[i__3].r = -1e10f, aa[i__3].i = 1e10f; +/* L80: */ + } + if (her) { + jj = j + (j - 1) * *lda; + i__2 = jj; + i__3 = jj; + r__1 = aa[i__3].r; + q__1.r = r__1, q__1.i = -1e10f; + aa[i__2].r = q__1.r, aa[i__2].i = q__1.i; + } +/* L90: */ + } + } + return 0; + +/* End of CMAKE. */ + +} /* cmake_ */ + +/* Subroutine */ int cmmch_(char *transa, char *transb, integer *m, integer * + n, integer *kk, complex *alpha, complex *a, integer *lda, complex *b, + integer *ldb, complex *beta, complex *c__, integer *ldc, complex *ct, + real *g, complex *cc, integer *ldcc, real *eps, real *err, logical * + fatal, integer *nout, logical *mv) +{ + /* Format strings */ + static char fmt_9999[] = "(\002 ******* FATAL ERROR - COMPUTED RESULT IS" + " LESS THAN HAL\002,\002F ACCURATE *******\002,/\002 " + " EXPECTED RE\002,\002SULT COMPUTED R" + "ESULT\002)"; + static char fmt_9998[] = "(1x,i7,2(\002 (\002,g15.6,\002,\002,g15.6," + "\002)\002))"; + static char fmt_9997[] = "(\002 THESE ARE THE RESULTS FOR COLUMN" + " \002,i3)"; + + /* System generated locals */ + integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, cc_dim1, + cc_offset, i__1, i__2, i__3, i__4, i__5, i__6, i__7; + real r__1, r__2, r__3, r__4, r__5, r__6; + complex q__1, q__2, q__3, q__4; + + /* Local variables */ + real erri; + integer i__, j, k; + logical trana, tranb, ctrana, ctranb; + + /* Fortran I/O blocks */ + static cilist io___409 = { 0, 0, 0, fmt_9999, 0 }; + static cilist io___410 = { 0, 0, 0, fmt_9998, 0 }; + static cilist io___411 = { 0, 0, 0, fmt_9998, 0 }; + static cilist io___412 = { 0, 0, 0, fmt_9997, 0 }; + + + +/* Checks the results of the computational tests. */ + +/* Auxiliary routine for test program for Level 3 Blas. */ + +/* -- Written on 8-February-1989. */ +/* Jack Dongarra, Argonne National Laboratory. */ +/* Iain Duff, AERE Harwell. */ +/* Jeremy Du Croz, Numerical Algorithms Group Ltd. */ +/* Sven Hammarling, Numerical Algorithms Group Ltd. */ + + /* Parameter adjustments */ + a_dim1 = *lda; + a_offset = 1 + a_dim1 * 1; + a -= a_offset; + b_dim1 = *ldb; + b_offset = 1 + b_dim1 * 1; + b -= b_offset; + c_dim1 = *ldc; + c_offset = 1 + c_dim1 * 1; + c__ -= c_offset; + --ct; + --g; + cc_dim1 = *ldcc; + cc_offset = 1 + cc_dim1 * 1; + cc -= cc_offset; + + /* Function Body */ + trana = *(unsigned char *)transa == 'T' || *(unsigned char *)transa == + 'C'; + tranb = *(unsigned char *)transb == 'T' || *(unsigned char *)transb == + 'C'; + ctrana = *(unsigned char *)transa == 'C'; + ctranb = *(unsigned char *)transb == 'C'; + +/* Compute expected result, one column at a time, in CT using data */ +/* in A, B and C. */ +/* Compute gauges in G. */ + + i__1 = *n; + for (j = 1; j <= i__1; ++j) { + + i__2 = *m; + for (i__ = 1; i__ <= i__2; ++i__) { + i__3 = i__; + ct[i__3].r = 0.f, ct[i__3].i = 0.f; + g[i__] = 0.f; +/* L10: */ + } + if (! trana && ! tranb) { + i__2 = *kk; + for (k = 1; k <= i__2; ++k) { + i__3 = *m; + for (i__ = 1; i__ <= i__3; ++i__) { + i__4 = i__; + i__5 = i__; + i__6 = i__ + k * a_dim1; + i__7 = k + j * b_dim1; + q__2.r = a[i__6].r * b[i__7].r - a[i__6].i * b[i__7].i, + q__2.i = a[i__6].r * b[i__7].i + a[i__6].i * b[ + i__7].r; + q__1.r = ct[i__5].r + q__2.r, q__1.i = ct[i__5].i + + q__2.i; + ct[i__4].r = q__1.r, ct[i__4].i = q__1.i; + i__4 = i__ + k * a_dim1; + i__5 = k + j * b_dim1; + g[i__] += ((r__1 = a[i__4].r, abs(r__1)) + (r__2 = r_imag( + &a[i__ + k * a_dim1]), abs(r__2))) * ((r__3 = b[ + i__5].r, abs(r__3)) + (r__4 = r_imag(&b[k + j * + b_dim1]), abs(r__4))); +/* L20: */ + } +/* L30: */ + } + } else if (trana && ! tranb) { + if (ctrana) { + i__2 = *kk; + for (k = 1; k <= i__2; ++k) { + i__3 = *m; + for (i__ = 1; i__ <= i__3; ++i__) { + i__4 = i__; + i__5 = i__; + r_cnjg(&q__3, &a[k + i__ * a_dim1]); + i__6 = k + j * b_dim1; + q__2.r = q__3.r * b[i__6].r - q__3.i * b[i__6].i, + q__2.i = q__3.r * b[i__6].i + q__3.i * b[i__6] + .r; + q__1.r = ct[i__5].r + q__2.r, q__1.i = ct[i__5].i + + q__2.i; + ct[i__4].r = q__1.r, ct[i__4].i = q__1.i; + i__4 = k + i__ * a_dim1; + i__5 = k + j * b_dim1; + g[i__] += ((r__1 = a[i__4].r, abs(r__1)) + (r__2 = + r_imag(&a[k + i__ * a_dim1]), abs(r__2))) * (( + r__3 = b[i__5].r, abs(r__3)) + (r__4 = r_imag( + &b[k + j * b_dim1]), abs(r__4))); +/* L40: */ + } +/* L50: */ + } + } else { + i__2 = *kk; + for (k = 1; k <= i__2; ++k) { + i__3 = *m; + for (i__ = 1; i__ <= i__3; ++i__) { + i__4 = i__; + i__5 = i__; + i__6 = k + i__ * a_dim1; + i__7 = k + j * b_dim1; + q__2.r = a[i__6].r * b[i__7].r - a[i__6].i * b[i__7] + .i, q__2.i = a[i__6].r * b[i__7].i + a[i__6] + .i * b[i__7].r; + q__1.r = ct[i__5].r + q__2.r, q__1.i = ct[i__5].i + + q__2.i; + ct[i__4].r = q__1.r, ct[i__4].i = q__1.i; + i__4 = k + i__ * a_dim1; + i__5 = k + j * b_dim1; + g[i__] += ((r__1 = a[i__4].r, abs(r__1)) + (r__2 = + r_imag(&a[k + i__ * a_dim1]), abs(r__2))) * (( + r__3 = b[i__5].r, abs(r__3)) + (r__4 = r_imag( + &b[k + j * b_dim1]), abs(r__4))); +/* L60: */ + } +/* L70: */ + } + } + } else if (! trana && tranb) { + if (ctranb) { + i__2 = *kk; + for (k = 1; k <= i__2; ++k) { + i__3 = *m; + for (i__ = 1; i__ <= i__3; ++i__) { + i__4 = i__; + i__5 = i__; + i__6 = i__ + k * a_dim1; + r_cnjg(&q__3, &b[j + k * b_dim1]); + q__2.r = a[i__6].r * q__3.r - a[i__6].i * q__3.i, + q__2.i = a[i__6].r * q__3.i + a[i__6].i * + q__3.r; + q__1.r = ct[i__5].r + q__2.r, q__1.i = ct[i__5].i + + q__2.i; + ct[i__4].r = q__1.r, ct[i__4].i = q__1.i; + i__4 = i__ + k * a_dim1; + i__5 = j + k * b_dim1; + g[i__] += ((r__1 = a[i__4].r, abs(r__1)) + (r__2 = + r_imag(&a[i__ + k * a_dim1]), abs(r__2))) * (( + r__3 = b[i__5].r, abs(r__3)) + (r__4 = r_imag( + &b[j + k * b_dim1]), abs(r__4))); +/* L80: */ + } +/* L90: */ + } + } else { + i__2 = *kk; + for (k = 1; k <= i__2; ++k) { + i__3 = *m; + for (i__ = 1; i__ <= i__3; ++i__) { + i__4 = i__; + i__5 = i__; + i__6 = i__ + k * a_dim1; + i__7 = j + k * b_dim1; + q__2.r = a[i__6].r * b[i__7].r - a[i__6].i * b[i__7] + .i, q__2.i = a[i__6].r * b[i__7].i + a[i__6] + .i * b[i__7].r; + q__1.r = ct[i__5].r + q__2.r, q__1.i = ct[i__5].i + + q__2.i; + ct[i__4].r = q__1.r, ct[i__4].i = q__1.i; + i__4 = i__ + k * a_dim1; + i__5 = j + k * b_dim1; + g[i__] += ((r__1 = a[i__4].r, abs(r__1)) + (r__2 = + r_imag(&a[i__ + k * a_dim1]), abs(r__2))) * (( + r__3 = b[i__5].r, abs(r__3)) + (r__4 = r_imag( + &b[j + k * b_dim1]), abs(r__4))); +/* L100: */ + } +/* L110: */ + } + } + } else if (trana && tranb) { + if (ctrana) { + if (ctranb) { + i__2 = *kk; + for (k = 1; k <= i__2; ++k) { + i__3 = *m; + for (i__ = 1; i__ <= i__3; ++i__) { + i__4 = i__; + i__5 = i__; + r_cnjg(&q__3, &a[k + i__ * a_dim1]); + r_cnjg(&q__4, &b[j + k * b_dim1]); + q__2.r = q__3.r * q__4.r - q__3.i * q__4.i, + q__2.i = q__3.r * q__4.i + q__3.i * + q__4.r; + q__1.r = ct[i__5].r + q__2.r, q__1.i = ct[i__5].i + + q__2.i; + ct[i__4].r = q__1.r, ct[i__4].i = q__1.i; + i__4 = k + i__ * a_dim1; + i__5 = j + k * b_dim1; + g[i__] += ((r__1 = a[i__4].r, abs(r__1)) + (r__2 = + r_imag(&a[k + i__ * a_dim1]), abs(r__2))) + * ((r__3 = b[i__5].r, abs(r__3)) + (r__4 + = r_imag(&b[j + k * b_dim1]), abs(r__4))); +/* L120: */ + } +/* L130: */ + } + } else { + i__2 = *kk; + for (k = 1; k <= i__2; ++k) { + i__3 = *m; + for (i__ = 1; i__ <= i__3; ++i__) { + i__4 = i__; + i__5 = i__; + r_cnjg(&q__3, &a[k + i__ * a_dim1]); + i__6 = j + k * b_dim1; + q__2.r = q__3.r * b[i__6].r - q__3.i * b[i__6].i, + q__2.i = q__3.r * b[i__6].i + q__3.i * b[ + i__6].r; + q__1.r = ct[i__5].r + q__2.r, q__1.i = ct[i__5].i + + q__2.i; + ct[i__4].r = q__1.r, ct[i__4].i = q__1.i; + i__4 = k + i__ * a_dim1; + i__5 = j + k * b_dim1; + g[i__] += ((r__1 = a[i__4].r, abs(r__1)) + (r__2 = + r_imag(&a[k + i__ * a_dim1]), abs(r__2))) + * ((r__3 = b[i__5].r, abs(r__3)) + (r__4 + = r_imag(&b[j + k * b_dim1]), abs(r__4))); +/* L140: */ + } +/* L150: */ + } + } + } else { + if (ctranb) { + i__2 = *kk; + for (k = 1; k <= i__2; ++k) { + i__3 = *m; + for (i__ = 1; i__ <= i__3; ++i__) { + i__4 = i__; + i__5 = i__; + i__6 = k + i__ * a_dim1; + r_cnjg(&q__3, &b[j + k * b_dim1]); + q__2.r = a[i__6].r * q__3.r - a[i__6].i * q__3.i, + q__2.i = a[i__6].r * q__3.i + a[i__6].i * + q__3.r; + q__1.r = ct[i__5].r + q__2.r, q__1.i = ct[i__5].i + + q__2.i; + ct[i__4].r = q__1.r, ct[i__4].i = q__1.i; + i__4 = k + i__ * a_dim1; + i__5 = j + k * b_dim1; + g[i__] += ((r__1 = a[i__4].r, abs(r__1)) + (r__2 = + r_imag(&a[k + i__ * a_dim1]), abs(r__2))) + * ((r__3 = b[i__5].r, abs(r__3)) + (r__4 + = r_imag(&b[j + k * b_dim1]), abs(r__4))); +/* L160: */ + } +/* L170: */ + } + } else { + i__2 = *kk; + for (k = 1; k <= i__2; ++k) { + i__3 = *m; + for (i__ = 1; i__ <= i__3; ++i__) { + i__4 = i__; + i__5 = i__; + i__6 = k + i__ * a_dim1; + i__7 = j + k * b_dim1; + q__2.r = a[i__6].r * b[i__7].r - a[i__6].i * b[ + i__7].i, q__2.i = a[i__6].r * b[i__7].i + + a[i__6].i * b[i__7].r; + q__1.r = ct[i__5].r + q__2.r, q__1.i = ct[i__5].i + + q__2.i; + ct[i__4].r = q__1.r, ct[i__4].i = q__1.i; + i__4 = k + i__ * a_dim1; + i__5 = j + k * b_dim1; + g[i__] += ((r__1 = a[i__4].r, abs(r__1)) + (r__2 = + r_imag(&a[k + i__ * a_dim1]), abs(r__2))) + * ((r__3 = b[i__5].r, abs(r__3)) + (r__4 + = r_imag(&b[j + k * b_dim1]), abs(r__4))); +/* L180: */ + } +/* L190: */ + } + } + } + } + i__2 = *m; + for (i__ = 1; i__ <= i__2; ++i__) { + i__3 = i__; + i__4 = i__; + q__2.r = alpha->r * ct[i__4].r - alpha->i * ct[i__4].i, q__2.i = + alpha->r * ct[i__4].i + alpha->i * ct[i__4].r; + i__5 = i__ + j * c_dim1; + q__3.r = beta->r * c__[i__5].r - beta->i * c__[i__5].i, q__3.i = + beta->r * c__[i__5].i + beta->i * c__[i__5].r; + q__1.r = q__2.r + q__3.r, q__1.i = q__2.i + q__3.i; + ct[i__3].r = q__1.r, ct[i__3].i = q__1.i; + i__3 = i__ + j * c_dim1; + g[i__] = ((r__1 = alpha->r, abs(r__1)) + (r__2 = r_imag(alpha), + abs(r__2))) * g[i__] + ((r__3 = beta->r, abs(r__3)) + ( + r__4 = r_imag(beta), abs(r__4))) * ((r__5 = c__[i__3].r, + abs(r__5)) + (r__6 = r_imag(&c__[i__ + j * c_dim1]), abs( + r__6))); +/* L200: */ + } + +/* Compute the error ratio for this result. */ + + *err = 0.f; + i__2 = *m; + for (i__ = 1; i__ <= i__2; ++i__) { + i__3 = i__; + i__4 = i__ + j * cc_dim1; + q__2.r = ct[i__3].r - cc[i__4].r, q__2.i = ct[i__3].i - cc[i__4] + .i; + q__1.r = q__2.r, q__1.i = q__2.i; + erri = ((r__1 = q__1.r, abs(r__1)) + (r__2 = r_imag(&q__1), abs( + r__2))) / *eps; + if (g[i__] != 0.f) { + erri /= g[i__]; + } + *err = f2cmax(*err,erri); + if (*err * sqrt(*eps) >= 1.f) { + goto L230; + } +/* L210: */ + } + +/* L220: */ + } + +/* If the loop completes, all results are at least half accurate. */ + goto L250; + +/* Report fatal error. */ + +L230: + *fatal = TRUE_; + io___409.ciunit = *nout; + s_wsfe(&io___409); + e_wsfe(); + i__1 = *m; + for (i__ = 1; i__ <= i__1; ++i__) { + if (*mv) { + io___410.ciunit = *nout; + s_wsfe(&io___410); + do_fio(&c__1, (char *)&i__, (ftnlen)sizeof(integer)); + do_fio(&c__2, (char *)&ct[i__], (ftnlen)sizeof(real)); + do_fio(&c__2, (char *)&cc[i__ + j * cc_dim1], (ftnlen)sizeof(real) + ); + e_wsfe(); + } else { + io___411.ciunit = *nout; + s_wsfe(&io___411); + do_fio(&c__1, (char *)&i__, (ftnlen)sizeof(integer)); + do_fio(&c__2, (char *)&cc[i__ + j * cc_dim1], (ftnlen)sizeof(real) + ); + do_fio(&c__2, (char *)&ct[i__], (ftnlen)sizeof(real)); + e_wsfe(); + } +/* L240: */ + } + if (*n > 1) { + io___412.ciunit = *nout; + s_wsfe(&io___412); + do_fio(&c__1, (char *)&j, (ftnlen)sizeof(integer)); + e_wsfe(); + } + +L250: + return 0; + + +/* End of CMMCH. */ + +} /* cmmch_ */ + +logical lce_(complex *ri, complex *rj, integer *lr) +{ + /* System generated locals */ + integer i__1, i__2, i__3; + logical ret_val; + + /* Local variables */ + integer i__; + + +/* Tests if two arrays are identical. */ + +/* Auxiliary routine for test program for Level 3 Blas. */ + +/* -- Written on 8-February-1989. */ +/* Jack Dongarra, Argonne National Laboratory. */ +/* Iain Duff, AERE Harwell. */ +/* Jeremy Du Croz, Numerical Algorithms Group Ltd. */ +/* Sven Hammarling, Numerical Algorithms Group Ltd. */ + + /* Parameter adjustments */ + --rj; + --ri; + + /* Function Body */ + i__1 = *lr; + for (i__ = 1; i__ <= i__1; ++i__) { + i__2 = i__; + i__3 = i__; + if (ri[i__2].r != rj[i__3].r || ri[i__2].i != rj[i__3].i) { + goto L20; + } +/* L10: */ + } + ret_val = TRUE_; + goto L30; +L20: + ret_val = FALSE_; +L30: + return ret_val; + +/* End of LCE. */ + +} /* lce_ */ + +logical lceres_(char *type__, char *uplo, integer *m, integer *n, complex *aa, + complex *as, integer *lda) +{ + /* System generated locals */ + integer aa_dim1, aa_offset, as_dim1, as_offset, i__1, i__2, i__3, i__4; + logical ret_val; + + /* Local variables */ + integer ibeg, iend, i__, j; + logical upper; + + +/* Tests if selected elements in two arrays are equal. */ + +/* TYPE is 'ge' or 'he' or 'sy'. */ + +/* Auxiliary routine for test program for Level 3 Blas. */ + +/* -- Written on 8-February-1989. */ +/* Jack Dongarra, Argonne National Laboratory. */ +/* Iain Duff, AERE Harwell. */ +/* Jeremy Du Croz, Numerical Algorithms Group Ltd. */ +/* Sven Hammarling, Numerical Algorithms Group Ltd. */ + + /* Parameter adjustments */ + as_dim1 = *lda; + as_offset = 1 + as_dim1 * 1; + as -= as_offset; + aa_dim1 = *lda; + aa_offset = 1 + aa_dim1 * 1; + aa -= aa_offset; + + /* Function Body */ + upper = *(unsigned char *)uplo == 'U'; + if (s_cmp(type__, "ge", (ftnlen)2, (ftnlen)2) == 0) { + i__1 = *n; + for (j = 1; j <= i__1; ++j) { + i__2 = *lda; + for (i__ = *m + 1; i__ <= i__2; ++i__) { + i__3 = i__ + j * aa_dim1; + i__4 = i__ + j * as_dim1; + if (aa[i__3].r != as[i__4].r || aa[i__3].i != as[i__4].i) { + goto L70; + } +/* L10: */ + } +/* L20: */ + } + } else if (s_cmp(type__, "he", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(type__, + "sy", (ftnlen)2, (ftnlen)2) == 0) { + i__1 = *n; + for (j = 1; j <= i__1; ++j) { + if (upper) { + ibeg = 1; + iend = j; + } else { + ibeg = j; + iend = *n; + } + i__2 = ibeg - 1; + for (i__ = 1; i__ <= i__2; ++i__) { + i__3 = i__ + j * aa_dim1; + i__4 = i__ + j * as_dim1; + if (aa[i__3].r != as[i__4].r || aa[i__3].i != as[i__4].i) { + goto L70; + } +/* L30: */ + } + i__2 = *lda; + for (i__ = iend + 1; i__ <= i__2; ++i__) { + i__3 = i__ + j * aa_dim1; + i__4 = i__ + j * as_dim1; + if (aa[i__3].r != as[i__4].r || aa[i__3].i != as[i__4].i) { + goto L70; + } +/* L40: */ + } +/* L50: */ + } + } + +/* L60: */ + ret_val = TRUE_; + goto L80; +L70: + ret_val = FALSE_; +L80: + return ret_val; + +/* End of LCERES. */ + +} /* lceres_ */ + +/* Complex */ VOID cbeg_(complex * ret_val, logical *reset) +{ + /* System generated locals */ + real r__1, r__2; + complex q__1; + + /* Local variables */ + static integer i__, j, ic, mi, mj; + + +/* Generates complex numbers as pairs of random numbers uniformly */ +/* distributed between -0.5 and 0.5. */ + +/* Auxiliary routine for test program for Level 3 Blas. */ + +/* -- Written on 8-February-1989. */ +/* Jack Dongarra, Argonne National Laboratory. */ +/* Iain Duff, AERE Harwell. */ +/* Jeremy Du Croz, Numerical Algorithms Group Ltd. */ +/* Sven Hammarling, Numerical Algorithms Group Ltd. */ + + if (*reset) { +/* Initialize local variables. */ + mi = 891; + mj = 457; + i__ = 7; + j = 7; + ic = 0; + *reset = FALSE_; + } + +/* The sequence of values of I or J is bounded between 1 and 999. */ +/* If initial I or J = 1,2,3,6,7 or 9, the period will be 50. */ +/* If initial I or J = 4 or 8, the period will be 25. */ +/* If initial I or J = 5, the period will be 10. */ +/* IC is used to break up the period by skipping 1 value of I or J */ +/* in 6. */ + + ++ic; +L10: + i__ *= mi; + j *= mj; + i__ -= i__ / 1000 * 1000; + j -= j / 1000 * 1000; + if (ic >= 5) { + ic = 0; + goto L10; + } + r__1 = (i__ - 500) / 1001.f; + r__2 = (j - 500) / 1001.f; + q__1.r = r__1, q__1.i = r__2; + ret_val->r = q__1.r, ret_val->i = q__1.i; + return ; + +/* End of CBEG. */ + +} /* cbeg_ */ + +real sdiff_(real *x, real *y) +{ + /* System generated locals */ + real ret_val; + + +/* Auxiliary routine for test program for Level 3 Blas. */ + +/* -- Written on 8-February-1989. */ +/* Jack Dongarra, Argonne National Laboratory. */ +/* Iain Duff, AERE Harwell. */ +/* Jeremy Du Croz, Numerical Algorithms Group Ltd. */ +/* Sven Hammarling, Numerical Algorithms Group Ltd. */ + + ret_val = *x - *y; + return ret_val; + +/* End of SDIFF. */ + +} /* sdiff_ */ + +/* Main program alias */ int cblat3_ () { MAIN__ (); return 0; } diff --git a/ctest/c_zblat3c_3m.c b/ctest/c_zblat3c_3m.c new file mode 100644 index 000000000..059daccb5 --- /dev/null +++ b/ctest/c_zblat3c_3m.c @@ -0,0 +1,4897 @@ +#include +#include +#include +#include +#include +#ifdef complex +#undef complex +#endif +#ifdef I +#undef I +#endif + +#if defined(_WIN64) +typedef long long BLASLONG; +typedef unsigned long long BLASULONG; +#else +typedef long BLASLONG; +typedef unsigned long BLASULONG; +#endif + +#ifdef LAPACK_ILP64 +typedef BLASLONG blasint; +#if defined(_WIN64) +#define blasabs(x) llabs(x) +#else +#define blasabs(x) labs(x) +#endif +#else +typedef int blasint; +#define blasabs(x) abs(x) +#endif + +typedef blasint integer; + +typedef unsigned int uinteger; +typedef char *address; +typedef short int shortint; +typedef float real; +typedef double doublereal; +typedef struct { real r, i; } complex; +typedef struct { doublereal r, i; } doublecomplex; +#ifdef _MSC_VER +static inline _Fcomplex Cf(complex *z) {_Fcomplex zz={z->r , z->i}; return zz;} +static inline _Dcomplex Cd(doublecomplex *z) {_Dcomplex zz={z->r , z->i};return zz;} +static inline _Fcomplex * _pCf(complex *z) {return (_Fcomplex*)z;} +static inline _Dcomplex * _pCd(doublecomplex *z) {return (_Dcomplex*)z;} +#else +static inline _Complex float Cf(complex *z) {return z->r + z->i*_Complex_I;} +static inline _Complex double Cd(doublecomplex *z) {return z->r + z->i*_Complex_I;} +static inline _Complex float * _pCf(complex *z) {return (_Complex float*)z;} +static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double*)z;} +#endif +#define pCf(z) (*_pCf(z)) +#define pCd(z) (*_pCd(z)) +typedef int logical; +typedef short int shortlogical; +typedef char logical1; +typedef char integer1; + +#define TRUE_ (1) +#define FALSE_ (0) + +/* Extern is for use with -E */ +#ifndef Extern +#define Extern extern +#endif + +/* I/O stuff */ + +typedef int flag; +typedef int ftnlen; +typedef int ftnint; + +/*external read, write*/ +typedef struct +{ flag cierr; + ftnint ciunit; + flag ciend; + char *cifmt; + ftnint cirec; +} cilist; + +/*internal read, write*/ +typedef struct +{ flag icierr; + char *iciunit; + flag iciend; + char *icifmt; + ftnint icirlen; + ftnint icirnum; +} icilist; + +/*open*/ +typedef struct +{ flag oerr; + ftnint ounit; + char *ofnm; + ftnlen ofnmlen; + char *osta; + char *oacc; + char *ofm; + ftnint orl; + char *oblnk; +} olist; + +/*close*/ +typedef struct +{ flag cerr; + ftnint cunit; + char *csta; +} cllist; + +/*rewind, backspace, endfile*/ +typedef struct +{ flag aerr; + ftnint aunit; +} alist; + +/* inquire */ +typedef struct +{ flag inerr; + ftnint inunit; + char *infile; + ftnlen infilen; + ftnint *inex; /*parameters in standard's order*/ + ftnint *inopen; + ftnint *innum; + ftnint *innamed; + char *inname; + ftnlen innamlen; + char *inacc; + ftnlen inacclen; + char *inseq; + ftnlen inseqlen; + char *indir; + ftnlen indirlen; + char *infmt; + ftnlen infmtlen; + char *inform; + ftnint informlen; + char *inunf; + ftnlen inunflen; + ftnint *inrecl; + ftnint *innrec; + char *inblank; + ftnlen inblanklen; +} inlist; + +#define VOID void + +union Multitype { /* for multiple entry points */ + integer1 g; + shortint h; + integer i; + /* longint j; */ + real r; + doublereal d; + complex c; + doublecomplex z; + }; + +typedef union Multitype Multitype; + +struct Vardesc { /* for Namelist */ + char *name; + char *addr; + ftnlen *dims; + int type; + }; +typedef struct Vardesc Vardesc; + +struct Namelist { + char *name; + Vardesc **vars; + int nvars; + }; +typedef struct Namelist Namelist; + +#define abs(x) ((x) >= 0 ? (x) : -(x)) +#define dabs(x) (fabs(x)) +#define f2cmin(a,b) ((a) <= (b) ? (a) : (b)) +#define f2cmax(a,b) ((a) >= (b) ? (a) : (b)) +#define dmin(a,b) (f2cmin(a,b)) +#define dmax(a,b) (f2cmax(a,b)) +#define bit_test(a,b) ((a) >> (b) & 1) +#define bit_clear(a,b) ((a) & ~((uinteger)1 << (b))) +#define bit_set(a,b) ((a) | ((uinteger)1 << (b))) + +#define abort_() { sig_die("Fortran abort routine called", 1); } +#define c_abs(z) (cabsf(Cf(z))) +#define c_cos(R,Z) { pCf(R)=ccos(Cf(Z)); } +#ifdef _MSC_VER +#define c_div(c, a, b) {Cf(c)._Val[0] = (Cf(a)._Val[0]/Cf(b)._Val[0]); Cf(c)._Val[1]=(Cf(a)._Val[1]/Cf(b)._Val[1]);} +#define z_div(c, a, b) {Cd(c)._Val[0] = (Cd(a)._Val[0]/Cd(b)._Val[0]); Cd(c)._Val[1]=(Cd(a)._Val[1]/Cd(b)._Val[1]);} +#else +#define c_div(c, a, b) {pCf(c) = Cf(a)/Cf(b);} +#define z_div(c, a, b) {pCd(c) = Cd(a)/Cd(b);} +#endif +#define c_exp(R, Z) {pCf(R) = cexpf(Cf(Z));} +#define c_log(R, Z) {pCf(R) = clogf(Cf(Z));} +#define c_sin(R, Z) {pCf(R) = csinf(Cf(Z));} +//#define c_sqrt(R, Z) {*(R) = csqrtf(Cf(Z));} +#define c_sqrt(R, Z) {pCf(R) = csqrtf(Cf(Z));} +#define d_abs(x) (fabs(*(x))) +#define d_acos(x) (acos(*(x))) +#define d_asin(x) (asin(*(x))) +#define d_atan(x) (atan(*(x))) +#define d_atn2(x, y) (atan2(*(x),*(y))) +#define d_cnjg(R, Z) { pCd(R) = conj(Cd(Z)); } +#define r_cnjg(R, Z) { pCf(R) = conjf(Cf(Z)); } +#define d_cos(x) (cos(*(x))) +#define d_cosh(x) (cosh(*(x))) +#define d_dim(__a, __b) ( *(__a) > *(__b) ? *(__a) - *(__b) : 0.0 ) +#define d_exp(x) (exp(*(x))) +#define d_imag(z) (cimag(Cd(z))) +#define r_imag(z) (cimagf(Cf(z))) +#define d_int(__x) (*(__x)>0 ? floor(*(__x)) : -floor(- *(__x))) +#define r_int(__x) (*(__x)>0 ? floor(*(__x)) : -floor(- *(__x))) +#define d_lg10(x) ( 0.43429448190325182765 * log(*(x)) ) +#define r_lg10(x) ( 0.43429448190325182765 * log(*(x)) ) +#define d_log(x) (log(*(x))) +#define d_mod(x, y) (fmod(*(x), *(y))) +#define u_nint(__x) ((__x)>=0 ? floor((__x) + .5) : -floor(.5 - (__x))) +#define d_nint(x) u_nint(*(x)) +#define u_sign(__a,__b) ((__b) >= 0 ? ((__a) >= 0 ? (__a) : -(__a)) : -((__a) >= 0 ? (__a) : -(__a))) +#define d_sign(a,b) u_sign(*(a),*(b)) +#define r_sign(a,b) u_sign(*(a),*(b)) +#define d_sin(x) (sin(*(x))) +#define d_sinh(x) (sinh(*(x))) +#define d_sqrt(x) (sqrt(*(x))) +#define d_tan(x) (tan(*(x))) +#define d_tanh(x) (tanh(*(x))) +#define i_abs(x) abs(*(x)) +#define i_dnnt(x) ((integer)u_nint(*(x))) +#define i_len(s, n) (n) +#define i_nint(x) ((integer)u_nint(*(x))) +#define i_sign(a,b) ((integer)u_sign((integer)*(a),(integer)*(b))) +#define pow_dd(ap, bp) ( pow(*(ap), *(bp))) +#define pow_si(B,E) spow_ui(*(B),*(E)) +#define pow_ri(B,E) spow_ui(*(B),*(E)) +#define pow_di(B,E) dpow_ui(*(B),*(E)) +#define pow_zi(p, a, b) {pCd(p) = zpow_ui(Cd(a), *(b));} +#define pow_ci(p, a, b) {pCf(p) = cpow_ui(Cf(a), *(b));} +#define pow_zz(R,A,B) {pCd(R) = cpow(Cd(A),*(B));} +#define s_cat(lpp, rpp, rnp, np, llp) { ftnlen i, nc, ll; char *f__rp, *lp; ll = (llp); lp = (lpp); for(i=0; i < (int)*(np); ++i) { nc = ll; if((rnp)[i] < nc) nc = (rnp)[i]; ll -= nc; f__rp = (rpp)[i]; while(--nc >= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } +#define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) +#define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } +#define sig_die(s, kill) { exit(1); } +#define s_stop(s, n) {exit(0);} +static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; +#define z_abs(z) (cabs(Cd(z))) +#define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} +#define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} +#define myexit_() break; +#define mycycle_() continue; +#define myceiling_(w) {ceil(w)} +#define myhuge_(w) {HUGE_VAL} +//#define mymaxloc_(w,s,e,n) {if (sizeof(*(w)) == sizeof(double)) dmaxloc_((w),*(s),*(e),n); else dmaxloc_((w),*(s),*(e),n);} +#define mymaxloc_(w,s,e,n) dmaxloc_(w,*(s),*(e),n) + +/* procedure parameter types for -A and -C++ */ + +#define F2C_proc_par_types 1 +#ifdef __cplusplus +typedef logical (*L_fp)(...); +#else +typedef logical (*L_fp)(); +#endif + +static float spow_ui(float x, integer n) { + float pow=1.0; unsigned long int u; + if(n != 0) { + if(n < 0) n = -n, x = 1/x; + for(u = n; ; ) { + if(u & 01) pow *= x; + if(u >>= 1) x *= x; + else break; + } + } + return pow; +} +static double dpow_ui(double x, integer n) { + double pow=1.0; unsigned long int u; + if(n != 0) { + if(n < 0) n = -n, x = 1/x; + for(u = n; ; ) { + if(u & 01) pow *= x; + if(u >>= 1) x *= x; + else break; + } + } + return pow; +} +#ifdef _MSC_VER +static _Fcomplex cpow_ui(complex x, integer n) { + complex pow={1.0,0.0}; unsigned long int u; + if(n != 0) { + if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; + for(u = n; ; ) { + if(u & 01) pow.r *= x.r, pow.i *= x.i; + if(u >>= 1) x.r *= x.r, x.i *= x.i; + else break; + } + } + _Fcomplex p={pow.r, pow.i}; + return p; +} +#else +static _Complex float cpow_ui(_Complex float x, integer n) { + _Complex float pow=1.0; unsigned long int u; + if(n != 0) { + if(n < 0) n = -n, x = 1/x; + for(u = n; ; ) { + if(u & 01) pow *= x; + if(u >>= 1) x *= x; + else break; + } + } + return pow; +} +#endif +#ifdef _MSC_VER +static _Dcomplex zpow_ui(_Dcomplex x, integer n) { + _Dcomplex pow={1.0,0.0}; unsigned long int u; + if(n != 0) { + if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; + for(u = n; ; ) { + if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; + if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; + else break; + } + } + _Dcomplex p = {pow._Val[0], pow._Val[1]}; + return p; +} +#else +static _Complex double zpow_ui(_Complex double x, integer n) { + _Complex double pow=1.0; unsigned long int u; + if(n != 0) { + if(n < 0) n = -n, x = 1/x; + for(u = n; ; ) { + if(u & 01) pow *= x; + if(u >>= 1) x *= x; + else break; + } + } + return pow; +} +#endif +static integer pow_ii(integer x, integer n) { + integer pow; unsigned long int u; + if (n <= 0) { + if (n == 0 || x == 1) pow = 1; + else if (x != -1) pow = x == 0 ? 1/x : 0; + else n = -n; + } + if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { + u = n; + for(pow = 1; ; ) { + if(u & 01) pow *= x; + if(u >>= 1) x *= x; + else break; + } + } + return pow; +} +static integer dmaxloc_(double *w, integer s, integer e, integer *n) +{ + double m; integer i, mi; + for(m=w[s-1], mi=s, i=s+1; i<=e; i++) + if (w[i-1]>m) mi=i ,m=w[i-1]; + return mi-s+1; +} +static integer smaxloc_(float *w, integer s, integer e, integer *n) +{ + float m; integer i, mi; + for(m=w[s-1], mi=s, i=s+1; i<=e; i++) + if (w[i-1]>m) mi=i ,m=w[i-1]; + return mi-s+1; +} +static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { + integer n = *n_, incx = *incx_, incy = *incy_, i; +#ifdef _MSC_VER + _Fcomplex zdotc = {0.0, 0.0}; + if (incx == 1 && incy == 1) { + for (i=0;i= 0; + if (trace) { + o__1.oerr = 0; + o__1.ounit = ntra; + o__1.ofnmlen = 32; + o__1.ofnm = snaps; + o__1.orl = 0; + o__1.osta = "NEW"; + o__1.oacc = 0; + o__1.ofm = 0; + o__1.oblnk = 0; + f_open(&o__1); + } +/* Read the flag that directs rewinding of the snapshot file. */ + s_rsle(&io___7); + do_lio(&c__8, &c__1, (char *)&rewi, (ftnlen)sizeof(logical)); + e_rsle(); + rewi = rewi && trace; +/* Read the flag that directs stopping on any failure. */ + s_rsle(&io___9); + do_lio(&c__8, &c__1, (char *)&sfatal, (ftnlen)sizeof(logical)); + e_rsle(); +/* Read the flag that indicates whether error exits are to be tested. */ + s_rsle(&io___11); + do_lio(&c__8, &c__1, (char *)&tsterr, (ftnlen)sizeof(logical)); + e_rsle(); +/* Read the flag that indicates whether row-major data layout to be tested. */ + s_rsle(&io___13); + do_lio(&c__3, &c__1, (char *)&layout, (ftnlen)sizeof(integer)); + e_rsle(); +/* Read the threshold value of the test ratio */ + s_rsle(&io___15); + do_lio(&c__5, &c__1, (char *)&thresh, (ftnlen)sizeof(doublereal)); + e_rsle(); + +/* Read and check the parameter values for the tests. */ + +/* Values of N */ + s_rsle(&io___17); + do_lio(&c__3, &c__1, (char *)&nidim, (ftnlen)sizeof(integer)); + e_rsle(); + if (nidim < 1 || nidim > 9) { + s_wsfe(&io___19); + do_fio(&c__1, "N", (ftnlen)1); + do_fio(&c__1, (char *)&c__9, (ftnlen)sizeof(integer)); + e_wsfe(); + goto L220; + } + s_rsle(&io___20); + i__1 = nidim; + for (i__ = 1; i__ <= i__1; ++i__) { + do_lio(&c__3, &c__1, (char *)&idim[i__ - 1], (ftnlen)sizeof(integer)); + } + e_rsle(); + i__1 = nidim; + for (i__ = 1; i__ <= i__1; ++i__) { + if (idim[i__ - 1] < 0 || idim[i__ - 1] > 65) { + s_wsfe(&io___23); + do_fio(&c__1, (char *)&c__65, (ftnlen)sizeof(integer)); + e_wsfe(); + goto L220; + } +/* L10: */ + } +/* Values of ALPHA */ + s_rsle(&io___24); + do_lio(&c__3, &c__1, (char *)&nalf, (ftnlen)sizeof(integer)); + e_rsle(); + if (nalf < 1 || nalf > 7) { + s_wsfe(&io___26); + do_fio(&c__1, "ALPHA", (ftnlen)5); + do_fio(&c__1, (char *)&c__7, (ftnlen)sizeof(integer)); + e_wsfe(); + goto L220; + } + s_rsle(&io___27); + i__1 = nalf; + for (i__ = 1; i__ <= i__1; ++i__) { + do_lio(&c__7, &c__1, (char *)&alf[i__ - 1], (ftnlen)sizeof( + doublecomplex)); + } + e_rsle(); +/* Values of BETA */ + s_rsle(&io___29); + do_lio(&c__3, &c__1, (char *)&nbet, (ftnlen)sizeof(integer)); + e_rsle(); + if (nbet < 1 || nbet > 7) { + s_wsfe(&io___31); + do_fio(&c__1, "BETA", (ftnlen)4); + do_fio(&c__1, (char *)&c__7, (ftnlen)sizeof(integer)); + e_wsfe(); + goto L220; + } + s_rsle(&io___32); + i__1 = nbet; + for (i__ = 1; i__ <= i__1; ++i__) { + do_lio(&c__7, &c__1, (char *)&bet[i__ - 1], (ftnlen)sizeof( + doublecomplex)); + } + e_rsle(); + +/* Report values of parameters. */ + + s_wsfe(&io___34); + e_wsfe(); + s_wsfe(&io___35); + i__1 = nidim; + for (i__ = 1; i__ <= i__1; ++i__) { + do_fio(&c__1, (char *)&idim[i__ - 1], (ftnlen)sizeof(integer)); + } + e_wsfe(); + s_wsfe(&io___36); + i__1 = nalf; + for (i__ = 1; i__ <= i__1; ++i__) { + do_fio(&c__2, (char *)&alf[i__ - 1], (ftnlen)sizeof(doublereal)); + } + e_wsfe(); + s_wsfe(&io___37); + i__1 = nbet; + for (i__ = 1; i__ <= i__1; ++i__) { + do_fio(&c__2, (char *)&bet[i__ - 1], (ftnlen)sizeof(doublereal)); + } + e_wsfe(); + if (! tsterr) { + s_wsle(&io___38); + e_wsle(); + s_wsfe(&io___39); + e_wsfe(); + } + s_wsle(&io___40); + e_wsle(); + s_wsfe(&io___41); + do_fio(&c__1, (char *)&thresh, (ftnlen)sizeof(doublereal)); + e_wsfe(); + s_wsle(&io___42); + e_wsle(); + rorder = FALSE_; + corder = FALSE_; + if (layout == 2) { + rorder = TRUE_; + corder = TRUE_; + s_wsfe(&io___45); + e_wsfe(); + } else if (layout == 1) { + rorder = TRUE_; + s_wsfe(&io___46); + e_wsfe(); + } else if (layout == 0) { + corder = TRUE_; + s_wsfe(&io___47); + e_wsfe(); + } + s_wsle(&io___48); + e_wsle(); + +/* Read names of subroutines and flags which indicate */ +/* whether they are to be tested. */ + + for (i__ = 1; i__ <= 9; ++i__) { + ltest[i__ - 1] = FALSE_; +/* L20: */ + } +L30: + i__1 = s_rsfe(&io___50); + if (i__1 != 0) { + goto L60; + } + i__1 = do_fio(&c__1, snamet, (ftnlen)13); + if (i__1 != 0) { + goto L60; + } + i__1 = do_fio(&c__1, (char *)<estt, (ftnlen)sizeof(logical)); + if (i__1 != 0) { + goto L60; + } + i__1 = e_rsfe(); + if (i__1 != 0) { + goto L60; + } + for (i__ = 1; i__ <= 9; ++i__) { + if (s_cmp(snamet, snames + (i__ - 1) * 13, (ftnlen)13, (ftnlen)13) == + 0) { + goto L50; + } +/* L40: */ + } + s_wsfe(&io___53); + do_fio(&c__1, snamet, (ftnlen)13); + e_wsfe(); + s_stop("", (ftnlen)0); +L50: + ltest[i__ - 1] = ltestt; + goto L30; + +L60: + cl__1.cerr = 0; + cl__1.cunit = 5; + cl__1.csta = 0; + f_clos(&cl__1); + +/* Compute EPS (the machine precision). */ + + eps = 1.; +L70: + d__1 = eps + 1.; + if (ddiff_(&d__1, &c_b92) == 0.) { + goto L80; + } + eps *= .5; + goto L70; +L80: + eps += eps; + s_wsfe(&io___55); + do_fio(&c__1, (char *)&eps, (ftnlen)sizeof(doublereal)); + e_wsfe(); + +/* Check the reliability of ZMMCH using exact data. */ + + n = 32; + i__1 = n; + for (j = 1; j <= i__1; ++j) { + i__2 = n; + for (i__ = 1; i__ <= i__2; ++i__) { + i__3 = i__ + j * 65 - 66; +/* Computing MAX */ + i__5 = i__ - j + 1; + i__4 = f2cmax(i__5,0); + ab[i__3].r = (doublereal) i__4, ab[i__3].i = 0.; +/* L90: */ + } + i__2 = j + 4224; + ab[i__2].r = (doublereal) j, ab[i__2].i = 0.; + i__2 = (j + 65) * 65 - 65; + ab[i__2].r = (doublereal) j, ab[i__2].i = 0.; + i__2 = j - 1; + c__[i__2].r = 0., c__[i__2].i = 0.; +/* L100: */ + } + i__1 = n; + for (j = 1; j <= i__1; ++j) { + i__2 = j - 1; + i__3 = j * ((j + 1) * j) / 2 - (j + 1) * j * (j - 1) / 3; + cc[i__2].r = (doublereal) i__3, cc[i__2].i = 0.; +/* L110: */ + } +/* CC holds the exact result. On exit from ZMMCH CT holds */ +/* the result computed by ZMMCH. */ + *(unsigned char *)transa = 'N'; + *(unsigned char *)transb = 'N'; + zmmch_(transa, transb, &n, &c__1, &n, &c_b2, ab, &c__65, &ab[4225], & + c__65, &c_b1, c__, &c__65, ct, g, cc, &c__65, &eps, &err, &fatal, + &c__6, &c_true); + same = lze_(cc, ct, &n); + if (! same || err != 0.) { + s_wsfe(&io___68); + do_fio(&c__1, transa, (ftnlen)1); + do_fio(&c__1, transb, (ftnlen)1); + do_fio(&c__1, (char *)&same, (ftnlen)sizeof(logical)); + do_fio(&c__1, (char *)&err, (ftnlen)sizeof(doublereal)); + e_wsfe(); + s_stop("", (ftnlen)0); + } + *(unsigned char *)transb = 'C'; + zmmch_(transa, transb, &n, &c__1, &n, &c_b2, ab, &c__65, &ab[4225], & + c__65, &c_b1, c__, &c__65, ct, g, cc, &c__65, &eps, &err, &fatal, + &c__6, &c_true); + same = lze_(cc, ct, &n); + if (! same || err != 0.) { + s_wsfe(&io___69); + do_fio(&c__1, transa, (ftnlen)1); + do_fio(&c__1, transb, (ftnlen)1); + do_fio(&c__1, (char *)&same, (ftnlen)sizeof(logical)); + do_fio(&c__1, (char *)&err, (ftnlen)sizeof(doublereal)); + e_wsfe(); + s_stop("", (ftnlen)0); + } + i__1 = n; + for (j = 1; j <= i__1; ++j) { + i__2 = j + 4224; + i__3 = n - j + 1; + ab[i__2].r = (doublereal) i__3, ab[i__2].i = 0.; + i__2 = (j + 65) * 65 - 65; + i__3 = n - j + 1; + ab[i__2].r = (doublereal) i__3, ab[i__2].i = 0.; +/* L120: */ + } + i__1 = n; + for (j = 1; j <= i__1; ++j) { + i__2 = n - j; + i__3 = j * ((j + 1) * j) / 2 - (j + 1) * j * (j - 1) / 3; + cc[i__2].r = (doublereal) i__3, cc[i__2].i = 0.; +/* L130: */ + } + *(unsigned char *)transa = 'C'; + *(unsigned char *)transb = 'N'; + zmmch_(transa, transb, &n, &c__1, &n, &c_b2, ab, &c__65, &ab[4225], & + c__65, &c_b1, c__, &c__65, ct, g, cc, &c__65, &eps, &err, &fatal, + &c__6, &c_true); + same = lze_(cc, ct, &n); + if (! same || err != 0.) { + s_wsfe(&io___70); + do_fio(&c__1, transa, (ftnlen)1); + do_fio(&c__1, transb, (ftnlen)1); + do_fio(&c__1, (char *)&same, (ftnlen)sizeof(logical)); + do_fio(&c__1, (char *)&err, (ftnlen)sizeof(doublereal)); + e_wsfe(); + s_stop("", (ftnlen)0); + } + *(unsigned char *)transb = 'C'; + zmmch_(transa, transb, &n, &c__1, &n, &c_b2, ab, &c__65, &ab[4225], & + c__65, &c_b1, c__, &c__65, ct, g, cc, &c__65, &eps, &err, &fatal, + &c__6, &c_true); + same = lze_(cc, ct, &n); + if (! same || err != 0.) { + s_wsfe(&io___71); + do_fio(&c__1, transa, (ftnlen)1); + do_fio(&c__1, transb, (ftnlen)1); + do_fio(&c__1, (char *)&same, (ftnlen)sizeof(logical)); + do_fio(&c__1, (char *)&err, (ftnlen)sizeof(doublereal)); + e_wsfe(); + s_stop("", (ftnlen)0); + } + +/* Test each subroutine in turn. */ + + for (isnum = 1; isnum <= 9; ++isnum) { + s_wsle(&io___73); + e_wsle(); + if (! ltest[isnum - 1]) { +/* Subprogram is not to be tested. */ + s_wsfe(&io___74); + do_fio(&c__1, snames + (isnum - 1) * 13, (ftnlen)13); + e_wsfe(); + } else { + s_copy(srnamc_1.srnamt, snames + (isnum - 1) * 13, (ftnlen)13, ( + ftnlen)13); +/* Test error exits. */ + if (tsterr) { + cz3chke_(snames + (isnum - 1) * 13); + s_wsle(&io___75); + e_wsle(); + } +/* Test computations. */ + infoc_1.infot = 0; + infoc_1.ok = TRUE_; + fatal = FALSE_; + switch (isnum) { + case 1: goto L140; + case 2: goto L150; + case 3: goto L150; + case 4: goto L160; + case 5: goto L160; + case 6: goto L170; + case 7: goto L170; + case 8: goto L180; + case 9: goto L180; + } +/* Test ZGEMM, 01. */ +L140: + if (corder) { + zchk1_(snames + (isnum - 1) * 13, &eps, &thresh, &c__6, &ntra, + &trace, &rewi, &fatal, &nidim, idim, &nalf, alf, & + nbet, bet, &c__65, ab, aa, as, &ab[4225], bb, bs, c__, + cc, cs, ct, g, &c__0); + } + if (rorder) { + zchk1_(snames + (isnum - 1) * 13, &eps, &thresh, &c__6, &ntra, + &trace, &rewi, &fatal, &nidim, idim, &nalf, alf, & + nbet, bet, &c__65, ab, aa, as, &ab[4225], bb, bs, c__, + cc, cs, ct, g, &c__1); + } + goto L190; +/* Test ZHEMM, 02, ZSYMM, 03. */ +L150: + if (corder) { + zchk2_(snames + (isnum - 1) * 13, &eps, &thresh, &c__6, &ntra, + &trace, &rewi, &fatal, &nidim, idim, &nalf, alf, & + nbet, bet, &c__65, ab, aa, as, &ab[4225], bb, bs, c__, + cc, cs, ct, g, &c__0); + } + if (rorder) { + zchk2_(snames + (isnum - 1) * 13, &eps, &thresh, &c__6, &ntra, + &trace, &rewi, &fatal, &nidim, idim, &nalf, alf, & + nbet, bet, &c__65, ab, aa, as, &ab[4225], bb, bs, c__, + cc, cs, ct, g, &c__1); + } + goto L190; +/* Test ZTRMM, 04, ZTRSM, 05. */ +L160: + if (corder) { + zchk3_(snames + (isnum - 1) * 13, &eps, &thresh, &c__6, &ntra, + &trace, &rewi, &fatal, &nidim, idim, &nalf, alf, & + c__65, ab, aa, as, &ab[4225], bb, bs, ct, g, c__, & + c__0); + } + if (rorder) { + zchk3_(snames + (isnum - 1) * 13, &eps, &thresh, &c__6, &ntra, + &trace, &rewi, &fatal, &nidim, idim, &nalf, alf, & + c__65, ab, aa, as, &ab[4225], bb, bs, ct, g, c__, & + c__1); + } + goto L190; +/* Test ZHERK, 06, ZSYRK, 07. */ +L170: + if (corder) { + zchk4_(snames + (isnum - 1) * 13, &eps, &thresh, &c__6, &ntra, + &trace, &rewi, &fatal, &nidim, idim, &nalf, alf, & + nbet, bet, &c__65, ab, aa, as, &ab[4225], bb, bs, c__, + cc, cs, ct, g, &c__0); + } + if (rorder) { + zchk4_(snames + (isnum - 1) * 13, &eps, &thresh, &c__6, &ntra, + &trace, &rewi, &fatal, &nidim, idim, &nalf, alf, & + nbet, bet, &c__65, ab, aa, as, &ab[4225], bb, bs, c__, + cc, cs, ct, g, &c__1); + } + goto L190; +/* Test ZHER2K, 08, ZSYR2K, 09. */ +L180: + if (corder) { + zchk5_(snames + (isnum - 1) * 13, &eps, &thresh, &c__6, &ntra, + &trace, &rewi, &fatal, &nidim, idim, &nalf, alf, & + nbet, bet, &c__65, ab, aa, as, bb, bs, c__, cc, cs, + ct, g, w, &c__0); + } + if (rorder) { + zchk5_(snames + (isnum - 1) * 13, &eps, &thresh, &c__6, &ntra, + &trace, &rewi, &fatal, &nidim, idim, &nalf, alf, & + nbet, bet, &c__65, ab, aa, as, bb, bs, c__, cc, cs, + ct, g, w, &c__1); + } + goto L190; + +L190: + if (fatal && sfatal) { + goto L210; + } + } +/* L200: */ + } + s_wsfe(&io___82); + e_wsfe(); + goto L230; + +L210: + s_wsfe(&io___83); + e_wsfe(); + goto L230; + +L220: + s_wsfe(&io___84); + e_wsfe(); + +L230: + if (trace) { + cl__1.cerr = 0; + cl__1.cunit = ntra; + cl__1.csta = 0; + f_clos(&cl__1); + } + cl__1.cerr = 0; + cl__1.cunit = 6; + cl__1.csta = 0; + f_clos(&cl__1); + s_stop("", (ftnlen)0); + + +/* End of ZBLAT3. */ + + return 0; +} /* MAIN__ */ + +/* Subroutine */ int zchk1_(char *sname, doublereal *eps, doublereal *thresh, + integer *nout, integer *ntra, logical *trace, logical *rewi, logical * + fatal, integer *nidim, integer *idim, integer *nalf, doublecomplex * + alf, integer *nbet, doublecomplex *bet, integer *nmax, doublecomplex * + a, doublecomplex *aa, doublecomplex *as, doublecomplex *b, + doublecomplex *bb, doublecomplex *bs, doublecomplex *c__, + doublecomplex *cc, doublecomplex *cs, doublecomplex *ct, doublereal * + g, integer *iorder) +{ + /* Initialized data */ + + static char ich[3] = "NTC"; + + /* Format strings */ + static char fmt_9994[] = "(\002 ******* FATAL ERROR - ERROR-CALL MYEXIT " + "TAKEN ON VALID\002,\002 CALL *******\002)"; + static char fmt_9998[] = "(\002 ******* FATAL ERROR - PARAMETER NUMBER" + " \002,i2,\002 WAS CH\002,\002ANGED INCORRECTLY *******\002)"; + static char fmt_10000[] = "(\002 \002,a13,\002 PASSED THE COLUMN-MAJOR C" + "OMPUTATIONAL TESTS\002,\002 (\002,i6,\002 CALL\002,\002S)\002)"; + static char fmt_10001[] = "(\002 \002,a13,\002 PASSED THE ROW-MAJOR C" + "OMPUTATIONAL TESTS\002,\002 (\002,i6,\002 CALL\002,\002S)\002)"; + static char fmt_10002[] = "(\002 \002,a13,\002 COMPLETED THE COLUMN-MAJO" + "R COMPUTATIONAL \002,\002TESTS (\002,i6,\002 CALLS)\002,/\002 **" + "***** BUT WITH MAXIMUM TEST \002,\002RATIO \002,f8.2,\002 - SUSP" + "ECT *******\002)"; + static char fmt_10003[] = "(\002 \002,a13,\002 COMPLETED THE ROW-MAJOR " + " COMPUTATIONAL \002,\002TESTS (\002,i6,\002 CALLS)\002,/\002 **" + "***** BUT WITH MAXIMUM TEST \002,\002RATIO \002,f8.2,\002 - SUSP" + "ECT *******\002)"; + static char fmt_9996[] = "(\002 ******* \002,a13,\002 FAILED ON CALL NUM" + "BER:\002)"; + + /* System generated locals */ + integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2, + i__3, i__4, i__5, i__6, i__7, i__8; + alist al__1; + + /* Local variables */ + extern /* Subroutine */ int czgemm3m_(integer *, char *, char *, integer * + , integer *, integer *, doublecomplex *, doublecomplex *, integer + *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, + integer *); + doublecomplex beta; + integer ldas, ldbs, ldcs; + logical same, null; + integer i__, k, m, n; + doublecomplex alpha; + logical isame[13], trana, tranb; + extern /* Subroutine */ int zmake_(char *, char *, char *, integer *, + integer *, doublecomplex *, integer *, doublecomplex *, integer *, + logical *, doublecomplex *); + integer nargs; + extern /* Subroutine */ int zmmch_(char *, char *, integer *, integer *, + integer *, doublecomplex *, doublecomplex *, integer *, + doublecomplex *, integer *, doublecomplex *, doublecomplex *, + integer *, doublecomplex *, doublereal *, doublecomplex *, + integer *, doublereal *, doublereal *, logical *, integer *, + logical *); + logical reset; + integer ia, ib; + extern /* Subroutine */ int zprcn1_(integer *, integer *, char *, integer + *, char *, char *, integer *, integer *, integer *, doublecomplex + *, integer *, integer *, doublecomplex *, integer *); + integer ma, mb, na, nb, nc, ik, im, in, ks, ms, ns; + char tranas[1], tranbs[1], transa[1], transb[1]; + doublereal errmax; + extern logical lzeres_(char *, char *, integer *, integer *, + doublecomplex *, doublecomplex *, integer *); + integer ica, icb, laa, lbb, lda, lcc, ldb, ldc; + doublecomplex als, bls; + doublereal err; + extern logical lze_(doublecomplex *, doublecomplex *, integer *); + + /* Fortran I/O blocks */ + static cilist io___128 = { 0, 0, 0, fmt_9994, 0 }; + static cilist io___131 = { 0, 0, 0, fmt_9998, 0 }; + static cilist io___133 = { 0, 0, 0, fmt_10000, 0 }; + static cilist io___134 = { 0, 0, 0, fmt_10001, 0 }; + static cilist io___135 = { 0, 0, 0, fmt_10002, 0 }; + static cilist io___136 = { 0, 0, 0, fmt_10003, 0 }; + static cilist io___137 = { 0, 0, 0, fmt_9996, 0 }; + + + +/* Tests ZGEMM. */ + +/* Auxiliary routine for test program for Level 3 Blas. */ + +/* -- Written on 8-February-1989. */ +/* Jack Dongarra, Argonne National Laboratory. */ +/* Iain Duff, AERE Harwell. */ +/* Jeremy Du Croz, Numerical Algorithms Group Ltd. */ +/* Sven Hammarling, Numerical Algorithms Group Ltd. */ + + /* Parameter adjustments */ + --idim; + --alf; + --bet; + --g; + --ct; + --cs; + --cc; + c_dim1 = *nmax; + c_offset = 1 + c_dim1 * 1; + c__ -= c_offset; + --bs; + --bb; + b_dim1 = *nmax; + b_offset = 1 + b_dim1 * 1; + b -= b_offset; + --as; + --aa; + a_dim1 = *nmax; + a_offset = 1 + a_dim1 * 1; + a -= a_offset; + + /* Function Body */ + + nargs = 13; + nc = 0; + reset = TRUE_; + errmax = 0.; + + i__1 = *nidim; + for (im = 1; im <= i__1; ++im) { + m = idim[im]; + + i__2 = *nidim; + for (in = 1; in <= i__2; ++in) { + n = idim[in]; +/* Set LDC to 1 more than minimum value if room. */ + ldc = m; + if (ldc < *nmax) { + ++ldc; + } +/* Skip tests if not enough room. */ + if (ldc > *nmax) { + goto L100; + } + lcc = ldc * n; + null = n <= 0 || m <= 0; + + i__3 = *nidim; + for (ik = 1; ik <= i__3; ++ik) { + k = idim[ik]; + + for (ica = 1; ica <= 3; ++ica) { + *(unsigned char *)transa = *(unsigned char *)&ich[ica - 1] + ; + trana = *(unsigned char *)transa == 'T' || *(unsigned + char *)transa == 'C'; + + if (trana) { + ma = k; + na = m; + } else { + ma = m; + na = k; + } +/* Set LDA to 1 more than minimum value if room. */ + lda = ma; + if (lda < *nmax) { + ++lda; + } +/* Skip tests if not enough room. */ + if (lda > *nmax) { + goto L80; + } + laa = lda * na; + +/* Generate the matrix A. */ + + zmake_("ge", " ", " ", &ma, &na, &a[a_offset], nmax, &aa[ + 1], &lda, &reset, &c_b1); + + for (icb = 1; icb <= 3; ++icb) { + *(unsigned char *)transb = *(unsigned char *)&ich[icb + - 1]; + tranb = *(unsigned char *)transb == 'T' || *(unsigned + char *)transb == 'C'; + + if (tranb) { + mb = n; + nb = k; + } else { + mb = k; + nb = n; + } +/* Set LDB to 1 more than minimum value if room. */ + ldb = mb; + if (ldb < *nmax) { + ++ldb; + } +/* Skip tests if not enough room. */ + if (ldb > *nmax) { + goto L70; + } + lbb = ldb * nb; + +/* Generate the matrix B. */ + + zmake_("ge", " ", " ", &mb, &nb, &b[b_offset], nmax, & + bb[1], &ldb, &reset, &c_b1); + + i__4 = *nalf; + for (ia = 1; ia <= i__4; ++ia) { + i__5 = ia; + alpha.r = alf[i__5].r, alpha.i = alf[i__5].i; + + i__5 = *nbet; + for (ib = 1; ib <= i__5; ++ib) { + i__6 = ib; + beta.r = bet[i__6].r, beta.i = bet[i__6].i; + +/* Generate the matrix C. */ + + zmake_("ge", " ", " ", &m, &n, &c__[c_offset], + nmax, &cc[1], &ldc, &reset, &c_b1); + + ++nc; + +/* Save every datum before calling the */ +/* subroutine. */ + + *(unsigned char *)tranas = *(unsigned char *) + transa; + *(unsigned char *)tranbs = *(unsigned char *) + transb; + ms = m; + ns = n; + ks = k; + als.r = alpha.r, als.i = alpha.i; + i__6 = laa; + for (i__ = 1; i__ <= i__6; ++i__) { + i__7 = i__; + i__8 = i__; + as[i__7].r = aa[i__8].r, as[i__7].i = aa[ + i__8].i; +/* L10: */ + } + ldas = lda; + i__6 = lbb; + for (i__ = 1; i__ <= i__6; ++i__) { + i__7 = i__; + i__8 = i__; + bs[i__7].r = bb[i__8].r, bs[i__7].i = bb[ + i__8].i; +/* L20: */ + } + ldbs = ldb; + bls.r = beta.r, bls.i = beta.i; + i__6 = lcc; + for (i__ = 1; i__ <= i__6; ++i__) { + i__7 = i__; + i__8 = i__; + cs[i__7].r = cc[i__8].r, cs[i__7].i = cc[ + i__8].i; +/* L30: */ + } + ldcs = ldc; + +/* Call the subroutine. */ + + if (*trace) { + zprcn1_(ntra, &nc, sname, iorder, transa, + transb, &m, &n, &k, &alpha, &lda, + &ldb, &beta, &ldc); + } + if (*rewi) { + al__1.aerr = 0; + al__1.aunit = *ntra; + f_rew(&al__1); + } + czgemm3m_(iorder, transa, transb, &m, &n, &k, + &alpha, &aa[1], &lda, &bb[1], &ldb, & + beta, &cc[1], &ldc); + +/* Check if error-exit was taken incorrectly. */ + + if (! infoc_1.ok) { + io___128.ciunit = *nout; + s_wsfe(&io___128); + e_wsfe(); + *fatal = TRUE_; + goto L120; + } + +/* See what data changed inside subroutines. */ + + isame[0] = *(unsigned char *)transa == *( + unsigned char *)tranas; + isame[1] = *(unsigned char *)transb == *( + unsigned char *)tranbs; + isame[2] = ms == m; + isame[3] = ns == n; + isame[4] = ks == k; + isame[5] = als.r == alpha.r && als.i == + alpha.i; + isame[6] = lze_(&as[1], &aa[1], &laa); + isame[7] = ldas == lda; + isame[8] = lze_(&bs[1], &bb[1], &lbb); + isame[9] = ldbs == ldb; + isame[10] = bls.r == beta.r && bls.i == + beta.i; + if (null) { + isame[11] = lze_(&cs[1], &cc[1], &lcc); + } else { + isame[11] = lzeres_("ge", " ", &m, &n, & + cs[1], &cc[1], &ldc); + } + isame[12] = ldcs == ldc; + +/* If data was incorrectly changed, report */ +/* and return. */ + + same = TRUE_; + i__6 = nargs; + for (i__ = 1; i__ <= i__6; ++i__) { + same = same && isame[i__ - 1]; + if (! isame[i__ - 1]) { + io___131.ciunit = *nout; + s_wsfe(&io___131); + do_fio(&c__1, (char *)&i__, (ftnlen) + sizeof(integer)); + e_wsfe(); + } +/* L40: */ + } + if (! same) { + *fatal = TRUE_; + goto L120; + } + + if (! null) { + +/* Check the result. */ + + zmmch_(transa, transb, &m, &n, &k, &alpha, + &a[a_offset], nmax, &b[b_offset], + nmax, &beta, &c__[c_offset], + nmax, &ct[1], &g[1], &cc[1], &ldc, + eps, &err, fatal, nout, &c_true); + errmax = f2cmax(errmax,err); +/* If got really bad answer, report and */ +/* return. */ + if (*fatal) { + goto L120; + } + } + +/* L50: */ + } + +/* L60: */ + } + +L70: + ; + } + +L80: + ; + } + +/* L90: */ + } + +L100: + ; + } + +/* L110: */ + } + +/* Report result. */ + + if (errmax < *thresh) { + if (*iorder == 0) { + io___133.ciunit = *nout; + s_wsfe(&io___133); + do_fio(&c__1, sname, (ftnlen)13); + do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer)); + e_wsfe(); + } + if (*iorder == 1) { + io___134.ciunit = *nout; + s_wsfe(&io___134); + do_fio(&c__1, sname, (ftnlen)13); + do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer)); + e_wsfe(); + } + } else { + if (*iorder == 0) { + io___135.ciunit = *nout; + s_wsfe(&io___135); + do_fio(&c__1, sname, (ftnlen)13); + do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer)); + do_fio(&c__1, (char *)&errmax, (ftnlen)sizeof(doublereal)); + e_wsfe(); + } + if (*iorder == 1) { + io___136.ciunit = *nout; + s_wsfe(&io___136); + do_fio(&c__1, sname, (ftnlen)13); + do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer)); + do_fio(&c__1, (char *)&errmax, (ftnlen)sizeof(doublereal)); + e_wsfe(); + } + } + goto L130; + +L120: + io___137.ciunit = *nout; + s_wsfe(&io___137); + do_fio(&c__1, sname, (ftnlen)13); + e_wsfe(); + zprcn1_(nout, &nc, sname, iorder, transa, transb, &m, &n, &k, &alpha, & + lda, &ldb, &beta, &ldc); + +L130: + return 0; + +/* L9995: */ + +/* End of ZCHK1. */ + +} /* zchk1_ */ + + +/* Subroutine */ int zprcn1_(integer *nout, integer *nc, char *sname, integer + *iorder, char *transa, char *transb, integer *m, integer *n, integer * + k, doublecomplex *alpha, integer *lda, integer *ldb, doublecomplex * + beta, integer *ldc) +{ + /* Format strings */ + static char fmt_9995[] = "(1x,i6,\002: \002,a13,\002(\002,a15,\002,\002," + "a14,\002,\002,a14,\002,\002)"; + static char fmt_9994[] = "(10x,3(i3,\002,\002),\002 (\002,f4.1,\002,\002" + ",f4.1,\002) , A,\002,i3,\002, B,\002,i3,\002, (\002,f4.1,\002" + ",\002,f4.1,\002) , C,\002,i3,\002).\002)"; + + /* Local variables */ + char crc[14], cta[14], ctb[14]; + + /* Fortran I/O blocks */ + static cilist io___141 = { 0, 0, 0, fmt_9995, 0 }; + static cilist io___142 = { 0, 0, 0, fmt_9994, 0 }; + + + if (*(unsigned char *)transa == 'N') { + s_copy(cta, " CblasNoTrans", (ftnlen)14, (ftnlen)14); + } else if (*(unsigned char *)transa == 'T') { + s_copy(cta, " CblasTrans", (ftnlen)14, (ftnlen)14); + } else { + s_copy(cta, "CblasConjTrans", (ftnlen)14, (ftnlen)14); + } + if (*(unsigned char *)transb == 'N') { + s_copy(ctb, " CblasNoTrans", (ftnlen)14, (ftnlen)14); + } else if (*(unsigned char *)transb == 'T') { + s_copy(ctb, " CblasTrans", (ftnlen)14, (ftnlen)14); + } else { + s_copy(ctb, "CblasConjTrans", (ftnlen)14, (ftnlen)14); + } + if (*iorder == 1) { + s_copy(crc, " CblasRowMajor", (ftnlen)14, (ftnlen)14); + } else { + s_copy(crc, " CblasColMajor", (ftnlen)14, (ftnlen)14); + } + io___141.ciunit = *nout; + s_wsfe(&io___141); + do_fio(&c__1, (char *)&(*nc), (ftnlen)sizeof(integer)); + do_fio(&c__1, sname, (ftnlen)13); + do_fio(&c__1, crc, (ftnlen)14); + do_fio(&c__1, cta, (ftnlen)14); + do_fio(&c__1, ctb, (ftnlen)14); + e_wsfe(); + io___142.ciunit = *nout; + s_wsfe(&io___142); + do_fio(&c__1, (char *)&(*m), (ftnlen)sizeof(integer)); + do_fio(&c__1, (char *)&(*n), (ftnlen)sizeof(integer)); + do_fio(&c__1, (char *)&(*k), (ftnlen)sizeof(integer)); + do_fio(&c__2, (char *)&(*alpha), (ftnlen)sizeof(doublereal)); + do_fio(&c__1, (char *)&(*lda), (ftnlen)sizeof(integer)); + do_fio(&c__1, (char *)&(*ldb), (ftnlen)sizeof(integer)); + do_fio(&c__2, (char *)&(*beta), (ftnlen)sizeof(doublereal)); + do_fio(&c__1, (char *)&(*ldc), (ftnlen)sizeof(integer)); + e_wsfe(); + return 0; +} /* zprcn1_ */ + + +/* Subroutine */ int zchk2_(char *sname, doublereal *eps, doublereal *thresh, + integer *nout, integer *ntra, logical *trace, logical *rewi, logical * + fatal, integer *nidim, integer *idim, integer *nalf, doublecomplex * + alf, integer *nbet, doublecomplex *bet, integer *nmax, doublecomplex * + a, doublecomplex *aa, doublecomplex *as, doublecomplex *b, + doublecomplex *bb, doublecomplex *bs, doublecomplex *c__, + doublecomplex *cc, doublecomplex *cs, doublecomplex *ct, doublereal * + g, integer *iorder) +{ + /* Initialized data */ + + static char ichs[2] = "LR"; + static char ichu[2] = "UL"; + + /* Format strings */ + static char fmt_9994[] = "(\002 ******* FATAL ERROR - ERROR-CALL MYEXIT " + "TAKEN ON VALID\002,\002 CALL *******\002)"; + static char fmt_9998[] = "(\002 ******* FATAL ERROR - PARAMETER NUMBER" + " \002,i2,\002 WAS CH\002,\002ANGED INCORRECTLY *******\002)"; + static char fmt_10000[] = "(\002 \002,a13,\002 PASSED THE COLUMN-MAJOR C" + "OMPUTATIONAL TESTS\002,\002 (\002,i6,\002 CALL\002,\002S)\002)"; + static char fmt_10001[] = "(\002 \002,a13,\002 PASSED THE ROW-MAJOR C" + "OMPUTATIONAL TESTS\002,\002 (\002,i6,\002 CALL\002,\002S)\002)"; + static char fmt_10002[] = "(\002 \002,a13,\002 COMPLETED THE COLUMN-MAJO" + "R COMPUTATIONAL \002,\002TESTS (\002,i6,\002 CALLS)\002,/\002 **" + "***** BUT WITH MAXIMUM TEST \002,\002RATIO \002,f8.2,\002 - SUSP" + "ECT *******\002)"; + static char fmt_10003[] = "(\002 \002,a13,\002 COMPLETED THE ROW-MAJOR " + " COMPUTATIONAL \002,\002TESTS (\002,i6,\002 CALLS)\002,/\002 **" + "***** BUT WITH MAXIMUM TEST \002,\002RATIO \002,f8.2,\002 - SUSP" + "ECT *******\002)"; + static char fmt_9996[] = "(\002 ******* \002,a13,\002 FAILED ON CALL NUM" + "BER:\002)"; + + /* System generated locals */ + integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2, + i__3, i__4, i__5, i__6, i__7; + alist al__1; + + /* Local variables */ + doublecomplex beta; + integer ldas, ldbs, ldcs; + logical same; + char side[1]; + logical conj, left, null; + char uplo[1]; + integer i__, m, n; + doublecomplex alpha; + logical isame[13]; + char sides[1]; + extern /* Subroutine */ int zmake_(char *, char *, char *, integer *, + integer *, doublecomplex *, integer *, doublecomplex *, integer *, + logical *, doublecomplex *); + integer nargs; + extern /* Subroutine */ int zmmch_(char *, char *, integer *, integer *, + integer *, doublecomplex *, doublecomplex *, integer *, + doublecomplex *, integer *, doublecomplex *, doublecomplex *, + integer *, doublecomplex *, doublereal *, doublecomplex *, + integer *, doublereal *, doublereal *, logical *, integer *, + logical *); + logical reset; + char uplos[1]; + integer ia, ib; + extern /* Subroutine */ int zprcn2_(integer *, integer *, char *, integer + *, char *, char *, integer *, integer *, doublecomplex *, integer + *, integer *, doublecomplex *, integer *); + integer na, nc, im, in, ms, ns; + extern /* Subroutine */ int czhemm_(integer *, char *, char *, integer *, + integer *, doublecomplex *, doublecomplex *, integer *, + doublecomplex *, integer *, doublecomplex *, doublecomplex *, + integer *); + doublereal errmax; + extern logical lzeres_(char *, char *, integer *, integer *, + doublecomplex *, doublecomplex *, integer *); + extern /* Subroutine */ int czsymm_(integer *, char *, char *, integer *, + integer *, doublecomplex *, doublecomplex *, integer *, + doublecomplex *, integer *, doublecomplex *, doublecomplex *, + integer *); + integer laa, lbb, lda, lcc, ldb, ldc, ics; + doublecomplex als, bls; + integer icu; + doublereal err; + extern logical lze_(doublecomplex *, doublecomplex *, integer *); + + /* Fortran I/O blocks */ + static cilist io___181 = { 0, 0, 0, fmt_9994, 0 }; + static cilist io___184 = { 0, 0, 0, fmt_9998, 0 }; + static cilist io___186 = { 0, 0, 0, fmt_10000, 0 }; + static cilist io___187 = { 0, 0, 0, fmt_10001, 0 }; + static cilist io___188 = { 0, 0, 0, fmt_10002, 0 }; + static cilist io___189 = { 0, 0, 0, fmt_10003, 0 }; + static cilist io___190 = { 0, 0, 0, fmt_9996, 0 }; + + + +/* Tests ZHEMM and ZSYMM. */ + +/* Auxiliary routine for test program for Level 3 Blas. */ + +/* -- Written on 8-February-1989. */ +/* Jack Dongarra, Argonne National Laboratory. */ +/* Iain Duff, AERE Harwell. */ +/* Jeremy Du Croz, Numerical Algorithms Group Ltd. */ +/* Sven Hammarling, Numerical Algorithms Group Ltd. */ + + /* Parameter adjustments */ + --idim; + --alf; + --bet; + --g; + --ct; + --cs; + --cc; + c_dim1 = *nmax; + c_offset = 1 + c_dim1 * 1; + c__ -= c_offset; + --bs; + --bb; + b_dim1 = *nmax; + b_offset = 1 + b_dim1 * 1; + b -= b_offset; + --as; + --aa; + a_dim1 = *nmax; + a_offset = 1 + a_dim1 * 1; + a -= a_offset; + + /* Function Body */ + conj = s_cmp(sname + 7, "he", (ftnlen)2, (ftnlen)2) == 0; + + nargs = 12; + nc = 0; + reset = TRUE_; + errmax = 0.; + + i__1 = *nidim; + for (im = 1; im <= i__1; ++im) { + m = idim[im]; + + i__2 = *nidim; + for (in = 1; in <= i__2; ++in) { + n = idim[in]; +/* Set LDC to 1 more than minimum value if room. */ + ldc = m; + if (ldc < *nmax) { + ++ldc; + } +/* Skip tests if not enough room. */ + if (ldc > *nmax) { + goto L90; + } + lcc = ldc * n; + null = n <= 0 || m <= 0; +/* Set LDB to 1 more than minimum value if room. */ + ldb = m; + if (ldb < *nmax) { + ++ldb; + } +/* Skip tests if not enough room. */ + if (ldb > *nmax) { + goto L90; + } + lbb = ldb * n; + +/* Generate the matrix B. */ + + zmake_("ge", " ", " ", &m, &n, &b[b_offset], nmax, &bb[1], &ldb, & + reset, &c_b1); + + for (ics = 1; ics <= 2; ++ics) { + *(unsigned char *)side = *(unsigned char *)&ichs[ics - 1]; + left = *(unsigned char *)side == 'L'; + + if (left) { + na = m; + } else { + na = n; + } +/* Set LDA to 1 more than minimum value if room. */ + lda = na; + if (lda < *nmax) { + ++lda; + } +/* Skip tests if not enough room. */ + if (lda > *nmax) { + goto L80; + } + laa = lda * na; + + for (icu = 1; icu <= 2; ++icu) { + *(unsigned char *)uplo = *(unsigned char *)&ichu[icu - 1]; + +/* Generate the hermitian or symmetric matrix A. */ + + zmake_(sname + 7, uplo, " ", &na, &na, &a[a_offset], nmax, + &aa[1], &lda, &reset, &c_b1); + + i__3 = *nalf; + for (ia = 1; ia <= i__3; ++ia) { + i__4 = ia; + alpha.r = alf[i__4].r, alpha.i = alf[i__4].i; + + i__4 = *nbet; + for (ib = 1; ib <= i__4; ++ib) { + i__5 = ib; + beta.r = bet[i__5].r, beta.i = bet[i__5].i; + +/* Generate the matrix C. */ + + zmake_("ge", " ", " ", &m, &n, &c__[c_offset], + nmax, &cc[1], &ldc, &reset, &c_b1); + + ++nc; + +/* Save every datum before calling the */ +/* subroutine. */ + + *(unsigned char *)sides = *(unsigned char *)side; + *(unsigned char *)uplos = *(unsigned char *)uplo; + ms = m; + ns = n; + als.r = alpha.r, als.i = alpha.i; + i__5 = laa; + for (i__ = 1; i__ <= i__5; ++i__) { + i__6 = i__; + i__7 = i__; + as[i__6].r = aa[i__7].r, as[i__6].i = aa[i__7] + .i; +/* L10: */ + } + ldas = lda; + i__5 = lbb; + for (i__ = 1; i__ <= i__5; ++i__) { + i__6 = i__; + i__7 = i__; + bs[i__6].r = bb[i__7].r, bs[i__6].i = bb[i__7] + .i; +/* L20: */ + } + ldbs = ldb; + bls.r = beta.r, bls.i = beta.i; + i__5 = lcc; + for (i__ = 1; i__ <= i__5; ++i__) { + i__6 = i__; + i__7 = i__; + cs[i__6].r = cc[i__7].r, cs[i__6].i = cc[i__7] + .i; +/* L30: */ + } + ldcs = ldc; + +/* Call the subroutine. */ + + if (*trace) { + zprcn2_(ntra, &nc, sname, iorder, side, uplo, + &m, &n, &alpha, &lda, &ldb, &beta, & + ldc) + ; + } + if (*rewi) { + al__1.aerr = 0; + al__1.aunit = *ntra; + f_rew(&al__1); + } + if (conj) { + czhemm_(iorder, side, uplo, &m, &n, &alpha, & + aa[1], &lda, &bb[1], &ldb, &beta, &cc[ + 1], &ldc); + } else { + czsymm_(iorder, side, uplo, &m, &n, &alpha, & + aa[1], &lda, &bb[1], &ldb, &beta, &cc[ + 1], &ldc); + } + +/* Check if error-exit was taken incorrectly. */ + + if (! infoc_1.ok) { + io___181.ciunit = *nout; + s_wsfe(&io___181); + e_wsfe(); + *fatal = TRUE_; + goto L110; + } + +/* See what data changed inside subroutines. */ + + isame[0] = *(unsigned char *)sides == *(unsigned + char *)side; + isame[1] = *(unsigned char *)uplos == *(unsigned + char *)uplo; + isame[2] = ms == m; + isame[3] = ns == n; + isame[4] = als.r == alpha.r && als.i == alpha.i; + isame[5] = lze_(&as[1], &aa[1], &laa); + isame[6] = ldas == lda; + isame[7] = lze_(&bs[1], &bb[1], &lbb); + isame[8] = ldbs == ldb; + isame[9] = bls.r == beta.r && bls.i == beta.i; + if (null) { + isame[10] = lze_(&cs[1], &cc[1], &lcc); + } else { + isame[10] = lzeres_("ge", " ", &m, &n, &cs[1], + &cc[1], &ldc); + } + isame[11] = ldcs == ldc; + +/* If data was incorrectly changed, report and */ +/* return. */ + + same = TRUE_; + i__5 = nargs; + for (i__ = 1; i__ <= i__5; ++i__) { + same = same && isame[i__ - 1]; + if (! isame[i__ - 1]) { + io___184.ciunit = *nout; + s_wsfe(&io___184); + do_fio(&c__1, (char *)&i__, (ftnlen) + sizeof(integer)); + e_wsfe(); + } +/* L40: */ + } + if (! same) { + *fatal = TRUE_; + goto L110; + } + + if (! null) { + +/* Check the result. */ + + if (left) { + zmmch_("N", "N", &m, &n, &m, &alpha, &a[ + a_offset], nmax, &b[b_offset], + nmax, &beta, &c__[c_offset], nmax, + &ct[1], &g[1], &cc[1], &ldc, eps, + &err, fatal, nout, &c_true); + } else { + zmmch_("N", "N", &m, &n, &n, &alpha, &b[ + b_offset], nmax, &a[a_offset], + nmax, &beta, &c__[c_offset], nmax, + &ct[1], &g[1], &cc[1], &ldc, eps, + &err, fatal, nout, &c_true); + } + errmax = f2cmax(errmax,err); +/* If got really bad answer, report and */ +/* return. */ + if (*fatal) { + goto L110; + } + } + +/* L50: */ + } + +/* L60: */ + } + +/* L70: */ + } + +L80: + ; + } + +L90: + ; + } + +/* L100: */ + } + +/* Report result. */ + + if (errmax < *thresh) { + if (*iorder == 0) { + io___186.ciunit = *nout; + s_wsfe(&io___186); + do_fio(&c__1, sname, (ftnlen)13); + do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer)); + e_wsfe(); + } + if (*iorder == 1) { + io___187.ciunit = *nout; + s_wsfe(&io___187); + do_fio(&c__1, sname, (ftnlen)13); + do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer)); + e_wsfe(); + } + } else { + if (*iorder == 0) { + io___188.ciunit = *nout; + s_wsfe(&io___188); + do_fio(&c__1, sname, (ftnlen)13); + do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer)); + do_fio(&c__1, (char *)&errmax, (ftnlen)sizeof(doublereal)); + e_wsfe(); + } + if (*iorder == 1) { + io___189.ciunit = *nout; + s_wsfe(&io___189); + do_fio(&c__1, sname, (ftnlen)13); + do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer)); + do_fio(&c__1, (char *)&errmax, (ftnlen)sizeof(doublereal)); + e_wsfe(); + } + } + goto L120; + +L110: + io___190.ciunit = *nout; + s_wsfe(&io___190); + do_fio(&c__1, sname, (ftnlen)13); + e_wsfe(); + zprcn2_(nout, &nc, sname, iorder, side, uplo, &m, &n, &alpha, &lda, &ldb, + &beta, &ldc); + +L120: + return 0; + +/* L9995: */ + +/* End of ZCHK2. */ + +} /* zchk2_ */ + + +/* Subroutine */ int zprcn2_(integer *nout, integer *nc, char *sname, integer + *iorder, char *side, char *uplo, integer *m, integer *n, + doublecomplex *alpha, integer *lda, integer *ldb, doublecomplex *beta, + integer *ldc) +{ + /* Format strings */ + static char fmt_9995[] = "(1x,i6,\002: \002,a13,\002(\002,a15,\002,\002," + "a14,\002,\002,a14,\002,\002)"; + static char fmt_9994[] = "(10x,2(i3,\002,\002),\002 (\002,f4.1,\002,\002" + ",f4.1,\002), A,\002,i3,\002, B,\002,i3,\002, (\002,f4.1,\002," + "\002,f4.1,\002), \002,\002C,\002,i3,\002).\002)"; + + /* Local variables */ + char cs[14], cu[14], crc[14]; + + /* Fortran I/O blocks */ + static cilist io___194 = { 0, 0, 0, fmt_9995, 0 }; + static cilist io___195 = { 0, 0, 0, fmt_9994, 0 }; + + + if (*(unsigned char *)side == 'L') { + s_copy(cs, " CblasLeft", (ftnlen)14, (ftnlen)14); + } else { + s_copy(cs, " CblasRight", (ftnlen)14, (ftnlen)14); + } + if (*(unsigned char *)uplo == 'U') { + s_copy(cu, " CblasUpper", (ftnlen)14, (ftnlen)14); + } else { + s_copy(cu, " CblasLower", (ftnlen)14, (ftnlen)14); + } + if (*iorder == 1) { + s_copy(crc, " CblasRowMajor", (ftnlen)14, (ftnlen)14); + } else { + s_copy(crc, " CblasColMajor", (ftnlen)14, (ftnlen)14); + } + io___194.ciunit = *nout; + s_wsfe(&io___194); + do_fio(&c__1, (char *)&(*nc), (ftnlen)sizeof(integer)); + do_fio(&c__1, sname, (ftnlen)13); + do_fio(&c__1, crc, (ftnlen)14); + do_fio(&c__1, cs, (ftnlen)14); + do_fio(&c__1, cu, (ftnlen)14); + e_wsfe(); + io___195.ciunit = *nout; + s_wsfe(&io___195); + do_fio(&c__1, (char *)&(*m), (ftnlen)sizeof(integer)); + do_fio(&c__1, (char *)&(*n), (ftnlen)sizeof(integer)); + do_fio(&c__2, (char *)&(*alpha), (ftnlen)sizeof(doublereal)); + do_fio(&c__1, (char *)&(*lda), (ftnlen)sizeof(integer)); + do_fio(&c__1, (char *)&(*ldb), (ftnlen)sizeof(integer)); + do_fio(&c__2, (char *)&(*beta), (ftnlen)sizeof(doublereal)); + do_fio(&c__1, (char *)&(*ldc), (ftnlen)sizeof(integer)); + e_wsfe(); + return 0; +} /* zprcn2_ */ + + +/* Subroutine */ int zchk3_(char *sname, doublereal *eps, doublereal *thresh, + integer *nout, integer *ntra, logical *trace, logical *rewi, logical * + fatal, integer *nidim, integer *idim, integer *nalf, doublecomplex * + alf, integer *nmax, doublecomplex *a, doublecomplex *aa, + doublecomplex *as, doublecomplex *b, doublecomplex *bb, doublecomplex + *bs, doublecomplex *ct, doublereal *g, doublecomplex *c__, integer * + iorder) +{ + /* Initialized data */ + + static char ichu[2] = "UL"; + static char icht[3] = "NTC"; + static char ichd[2] = "UN"; + static char ichs[2] = "LR"; + + /* Format strings */ + static char fmt_9994[] = "(\002 ******* FATAL ERROR - ERROR-CALL MYEXIT " + "TAKEN ON VALID\002,\002 CALL *******\002)"; + static char fmt_9998[] = "(\002 ******* FATAL ERROR - PARAMETER NUMBER" + " \002,i2,\002 WAS CH\002,\002ANGED INCORRECTLY *******\002)"; + static char fmt_10000[] = "(\002 \002,a13,\002 PASSED THE COLUMN-MAJOR C" + "OMPUTATIONAL TESTS\002,\002 (\002,i6,\002 CALL\002,\002S)\002)"; + static char fmt_10001[] = "(\002 \002,a13,\002 PASSED THE ROW-MAJOR C" + "OMPUTATIONAL TESTS\002,\002 (\002,i6,\002 CALL\002,\002S)\002)"; + static char fmt_10002[] = "(\002 \002,a13,\002 COMPLETED THE COLUMN-MAJO" + "R COMPUTATIONAL \002,\002TESTS (\002,i6,\002 CALLS)\002,/\002 **" + "***** BUT WITH MAXIMUM TEST \002,\002RATIO \002,f8.2,\002 - SUSP" + "ECT *******\002)"; + static char fmt_10003[] = "(\002 \002,a13,\002 COMPLETED THE ROW-MAJOR " + " COMPUTATIONAL \002,\002TESTS (\002,i6,\002 CALLS)\002,/\002 **" + "***** BUT WITH MAXIMUM TEST \002,\002RATIO \002,f8.2,\002 - SUSP" + "ECT *******\002)"; + static char fmt_9996[] = "(\002 ******* \002,a13,\002 FAILED ON CALL NUM" + "BER:\002)"; + + /* System generated locals */ + integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2, + i__3, i__4, i__5, i__6, i__7; + doublecomplex z__1; + alist al__1; + + /* Local variables */ + char diag[1]; + integer ldas, ldbs; + logical same; + char side[1]; + logical left, null; + char uplo[1]; + integer i__, j, m, n; + doublecomplex alpha; + char diags[1]; + logical isame[13]; + char sides[1]; + extern /* Subroutine */ int zmake_(char *, char *, char *, integer *, + integer *, doublecomplex *, integer *, doublecomplex *, integer *, + logical *, doublecomplex *); + integer nargs; + extern /* Subroutine */ int zmmch_(char *, char *, integer *, integer *, + integer *, doublecomplex *, doublecomplex *, integer *, + doublecomplex *, integer *, doublecomplex *, doublecomplex *, + integer *, doublecomplex *, doublereal *, doublecomplex *, + integer *, doublereal *, doublereal *, logical *, integer *, + logical *); + logical reset; + char uplos[1]; + integer ia, na; + extern /* Subroutine */ int zprcn3_(integer *, integer *, char *, integer + *, char *, char *, char *, char *, integer *, integer *, + doublecomplex *, integer *, integer *); + integer nc, im, in, ms, ns; + char tranas[1], transa[1]; + doublereal errmax; + extern logical lzeres_(char *, char *, integer *, integer *, + doublecomplex *, doublecomplex *, integer *); + extern /* Subroutine */ int cztrmm_(integer *, char *, char *, char *, + char *, integer *, integer *, doublecomplex *, doublecomplex *, + integer *, doublecomplex *, integer *), cztrsm_(integer *, char *, char *, char *, char *, + integer *, integer *, doublecomplex *, doublecomplex *, integer *, + doublecomplex *, integer *); + integer laa, icd, lbb, lda, ldb, ics; + doublecomplex als; + integer ict, icu; + doublereal err; + extern logical lze_(doublecomplex *, doublecomplex *, integer *); + + /* Fortran I/O blocks */ + static cilist io___236 = { 0, 0, 0, fmt_9994, 0 }; + static cilist io___239 = { 0, 0, 0, fmt_9998, 0 }; + static cilist io___241 = { 0, 0, 0, fmt_10000, 0 }; + static cilist io___242 = { 0, 0, 0, fmt_10001, 0 }; + static cilist io___243 = { 0, 0, 0, fmt_10002, 0 }; + static cilist io___244 = { 0, 0, 0, fmt_10003, 0 }; + static cilist io___245 = { 0, 0, 0, fmt_9996, 0 }; + + + +/* Tests ZTRMM and ZTRSM. */ + +/* Auxiliary routine for test program for Level 3 Blas. */ + +/* -- Written on 8-February-1989. */ +/* Jack Dongarra, Argonne National Laboratory. */ +/* Iain Duff, AERE Harwell. */ +/* Jeremy Du Croz, Numerical Algorithms Group Ltd. */ +/* Sven Hammarling, Numerical Algorithms Group Ltd. */ + + /* Parameter adjustments */ + --idim; + --alf; + c_dim1 = *nmax; + c_offset = 1 + c_dim1 * 1; + c__ -= c_offset; + --g; + --ct; + --bs; + --bb; + b_dim1 = *nmax; + b_offset = 1 + b_dim1 * 1; + b -= b_offset; + --as; + --aa; + a_dim1 = *nmax; + a_offset = 1 + a_dim1 * 1; + a -= a_offset; + + /* Function Body */ + + nargs = 11; + nc = 0; + reset = TRUE_; + errmax = 0.; +/* Set up zero matrix for ZMMCH. */ + i__1 = *nmax; + for (j = 1; j <= i__1; ++j) { + i__2 = *nmax; + for (i__ = 1; i__ <= i__2; ++i__) { + i__3 = i__ + j * c_dim1; + c__[i__3].r = 0., c__[i__3].i = 0.; +/* L10: */ + } +/* L20: */ + } + + i__1 = *nidim; + for (im = 1; im <= i__1; ++im) { + m = idim[im]; + + i__2 = *nidim; + for (in = 1; in <= i__2; ++in) { + n = idim[in]; +/* Set LDB to 1 more than minimum value if room. */ + ldb = m; + if (ldb < *nmax) { + ++ldb; + } +/* Skip tests if not enough room. */ + if (ldb > *nmax) { + goto L130; + } + lbb = ldb * n; + null = m <= 0 || n <= 0; + + for (ics = 1; ics <= 2; ++ics) { + *(unsigned char *)side = *(unsigned char *)&ichs[ics - 1]; + left = *(unsigned char *)side == 'L'; + if (left) { + na = m; + } else { + na = n; + } +/* Set LDA to 1 more than minimum value if room. */ + lda = na; + if (lda < *nmax) { + ++lda; + } +/* Skip tests if not enough room. */ + if (lda > *nmax) { + goto L130; + } + laa = lda * na; + + for (icu = 1; icu <= 2; ++icu) { + *(unsigned char *)uplo = *(unsigned char *)&ichu[icu - 1]; + + for (ict = 1; ict <= 3; ++ict) { + *(unsigned char *)transa = *(unsigned char *)&icht[ + ict - 1]; + + for (icd = 1; icd <= 2; ++icd) { + *(unsigned char *)diag = *(unsigned char *)&ichd[ + icd - 1]; + + i__3 = *nalf; + for (ia = 1; ia <= i__3; ++ia) { + i__4 = ia; + alpha.r = alf[i__4].r, alpha.i = alf[i__4].i; + +/* Generate the matrix A. */ + + zmake_("tr", uplo, diag, &na, &na, &a[ + a_offset], nmax, &aa[1], &lda, &reset, + &c_b1); + +/* Generate the matrix B. */ + + zmake_("ge", " ", " ", &m, &n, &b[b_offset], + nmax, &bb[1], &ldb, &reset, &c_b1); + + ++nc; + +/* Save every datum before calling the */ +/* subroutine. */ + + *(unsigned char *)sides = *(unsigned char *) + side; + *(unsigned char *)uplos = *(unsigned char *) + uplo; + *(unsigned char *)tranas = *(unsigned char *) + transa; + *(unsigned char *)diags = *(unsigned char *) + diag; + ms = m; + ns = n; + als.r = alpha.r, als.i = alpha.i; + i__4 = laa; + for (i__ = 1; i__ <= i__4; ++i__) { + i__5 = i__; + i__6 = i__; + as[i__5].r = aa[i__6].r, as[i__5].i = aa[ + i__6].i; +/* L30: */ + } + ldas = lda; + i__4 = lbb; + for (i__ = 1; i__ <= i__4; ++i__) { + i__5 = i__; + i__6 = i__; + bs[i__5].r = bb[i__6].r, bs[i__5].i = bb[ + i__6].i; +/* L40: */ + } + ldbs = ldb; + +/* Call the subroutine. */ + + if (s_cmp(sname + 9, "mm", (ftnlen)2, (ftnlen) + 2) == 0) { + if (*trace) { + zprcn3_(ntra, &nc, sname, iorder, + side, uplo, transa, diag, &m, + &n, &alpha, &lda, &ldb, ( + ftnlen)13, (ftnlen)1, (ftnlen) + 1, (ftnlen)1, (ftnlen)1); + } + if (*rewi) { + al__1.aerr = 0; + al__1.aunit = *ntra; + f_rew(&al__1); + } + cztrmm_(iorder, side, uplo, transa, diag, + &m, &n, &alpha, &aa[1], &lda, &bb[ + 1], &ldb); + } else if (s_cmp(sname + 9, "sm", (ftnlen)2, ( + ftnlen)2) == 0) { + if (*trace) { + zprcn3_(ntra, &nc, sname, iorder, + side, uplo, transa, diag, &m, + &n, &alpha, &lda, &ldb, ( + ftnlen)13, (ftnlen)1, (ftnlen) + 1, (ftnlen)1, (ftnlen)1); + } + if (*rewi) { + al__1.aerr = 0; + al__1.aunit = *ntra; + f_rew(&al__1); + } + cztrsm_(iorder, side, uplo, transa, diag, + &m, &n, &alpha, &aa[1], &lda, &bb[ + 1], &ldb); + } + +/* Check if error-exit was taken incorrectly. */ + + if (! infoc_1.ok) { + io___236.ciunit = *nout; + s_wsfe(&io___236); + e_wsfe(); + *fatal = TRUE_; + goto L150; + } + +/* See what data changed inside subroutines. */ + + isame[0] = *(unsigned char *)sides == *( + unsigned char *)side; + isame[1] = *(unsigned char *)uplos == *( + unsigned char *)uplo; + isame[2] = *(unsigned char *)tranas == *( + unsigned char *)transa; + isame[3] = *(unsigned char *)diags == *( + unsigned char *)diag; + isame[4] = ms == m; + isame[5] = ns == n; + isame[6] = als.r == alpha.r && als.i == + alpha.i; + isame[7] = lze_(&as[1], &aa[1], &laa); + isame[8] = ldas == lda; + if (null) { + isame[9] = lze_(&bs[1], &bb[1], &lbb); + } else { + isame[9] = lzeres_("ge", " ", &m, &n, &bs[ + 1], &bb[1], &ldb); + } + isame[10] = ldbs == ldb; + +/* If data was incorrectly changed, report and */ +/* return. */ + + same = TRUE_; + i__4 = nargs; + for (i__ = 1; i__ <= i__4; ++i__) { + same = same && isame[i__ - 1]; + if (! isame[i__ - 1]) { + io___239.ciunit = *nout; + s_wsfe(&io___239); + do_fio(&c__1, (char *)&i__, (ftnlen) + sizeof(integer)); + e_wsfe(); + } +/* L50: */ + } + if (! same) { + *fatal = TRUE_; + goto L150; + } + + if (! null) { + if (s_cmp(sname + 9, "mm", (ftnlen)2, ( + ftnlen)2) == 0) { + +/* Check the result. */ + + if (left) { + zmmch_(transa, "N", &m, &n, &m, & + alpha, &a[a_offset], nmax, + &b[b_offset], nmax, & + c_b1, &c__[c_offset], + nmax, &ct[1], &g[1], &bb[ + 1], &ldb, eps, &err, + fatal, nout, &c_true, ( + ftnlen)1, (ftnlen)1); + } else { + zmmch_("N", transa, &m, &n, &n, & + alpha, &b[b_offset], nmax, + &a[a_offset], nmax, & + c_b1, &c__[c_offset], + nmax, &ct[1], &g[1], &bb[ + 1], &ldb, eps, &err, + fatal, nout, &c_true); + } + } else if (s_cmp(sname + 9, "sm", (ftnlen) + 2, (ftnlen)2) == 0) { + +/* Compute approximation to original */ +/* matrix. */ + + i__4 = n; + for (j = 1; j <= i__4; ++j) { + i__5 = m; + for (i__ = 1; i__ <= i__5; ++i__) + { + i__6 = i__ + j * c_dim1; + i__7 = i__ + (j - 1) * ldb; + c__[i__6].r = bb[i__7].r, c__[i__6].i = bb[i__7].i; + i__6 = i__ + (j - 1) * ldb; + i__7 = i__ + j * b_dim1; + z__1.r = alpha.r * b[i__7].r - alpha.i * b[i__7].i, + z__1.i = alpha.r * b[i__7].i + alpha.i * b[ + i__7].r; + bb[i__6].r = z__1.r, bb[i__6].i = z__1.i; +/* L60: */ + } +/* L70: */ + } + + if (left) { + zmmch_(transa, "N", &m, &n, &m, & + c_b2, &a[a_offset], nmax, + &c__[c_offset], nmax, & + c_b1, &b[b_offset], nmax, + &ct[1], &g[1], &bb[1], & + ldb, eps, &err, fatal, + nout, &c_false); + } else { + zmmch_("N", transa, &m, &n, &n, & + c_b2, &c__[c_offset], + nmax, &a[a_offset], nmax, + &c_b1, &b[b_offset], nmax, + &ct[1], &g[1], &bb[1], & + ldb, eps, &err, fatal, + nout, &c_false); + } + } + errmax = f2cmax(errmax,err); +/* If got really bad answer, report and */ +/* return. */ + if (*fatal) { + goto L150; + } + } + +/* L80: */ + } + +/* L90: */ + } + +/* L100: */ + } + +/* L110: */ + } + +/* L120: */ + } + +L130: + ; + } + +/* L140: */ + } + +/* Report result. */ + + if (errmax < *thresh) { + if (*iorder == 0) { + io___241.ciunit = *nout; + s_wsfe(&io___241); + do_fio(&c__1, sname, (ftnlen)13); + do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer)); + e_wsfe(); + } + if (*iorder == 1) { + io___242.ciunit = *nout; + s_wsfe(&io___242); + do_fio(&c__1, sname, (ftnlen)13); + do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer)); + e_wsfe(); + } + } else { + if (*iorder == 0) { + io___243.ciunit = *nout; + s_wsfe(&io___243); + do_fio(&c__1, sname, (ftnlen)13); + do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer)); + do_fio(&c__1, (char *)&errmax, (ftnlen)sizeof(doublereal)); + e_wsfe(); + } + if (*iorder == 1) { + io___244.ciunit = *nout; + s_wsfe(&io___244); + do_fio(&c__1, sname, (ftnlen)13); + do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer)); + do_fio(&c__1, (char *)&errmax, (ftnlen)sizeof(doublereal)); + e_wsfe(); + } + } + goto L160; + +L150: + io___245.ciunit = *nout; + s_wsfe(&io___245); + do_fio(&c__1, sname, (ftnlen)13); + e_wsfe(); + if (*trace) { + zprcn3_(ntra, &nc, sname, iorder, side, uplo, transa, diag, &m, &n, & + alpha, &lda, &ldb); + } + +L160: + return 0; + +/* L9995: */ + +/* End of ZCHK3. */ + +} /* zchk3_ */ + + +/* Subroutine */ int zprcn3_(integer *nout, integer *nc, char *sname, integer + *iorder, char *side, char *uplo, char *transa, char *diag, integer *m, + integer *n, doublecomplex *alpha, integer *lda, integer *ldb) +{ + /* Format strings */ + static char fmt_9995[] = "(1x,i6,\002: \002,a13,\002(\002,a15,\002,\002," + "a14,\002,\002,a14,\002,\002)"; + static char fmt_9994[] = "(10x,2(a15,\002,\002),2(i3,\002,\002),\002 " + "(\002,f4.1,\002,\002,f4.1,\002), A,\002,i3,\002, B,\002,i3,\002)." + "\002)"; + + /* Local variables */ + char ca[14], cd[14], cs[14], cu[14], crc[14]; + + /* Fortran I/O blocks */ + static cilist io___251 = { 0, 0, 0, fmt_9995, 0 }; + static cilist io___252 = { 0, 0, 0, fmt_9994, 0 }; + + + if (*(unsigned char *)side == 'L') { + s_copy(cs, " CblasLeft", (ftnlen)14, (ftnlen)14); + } else { + s_copy(cs, " CblasRight", (ftnlen)14, (ftnlen)14); + } + if (*(unsigned char *)uplo == 'U') { + s_copy(cu, " CblasUpper", (ftnlen)14, (ftnlen)14); + } else { + s_copy(cu, " CblasLower", (ftnlen)14, (ftnlen)14); + } + if (*(unsigned char *)transa == 'N') { + s_copy(ca, " CblasNoTrans", (ftnlen)14, (ftnlen)14); + } else if (*(unsigned char *)transa == 'T') { + s_copy(ca, " CblasTrans", (ftnlen)14, (ftnlen)14); + } else { + s_copy(ca, "CblasConjTrans", (ftnlen)14, (ftnlen)14); + } + if (*(unsigned char *)diag == 'N') { + s_copy(cd, " CblasNonUnit", (ftnlen)14, (ftnlen)14); + } else { + s_copy(cd, " CblasUnit", (ftnlen)14, (ftnlen)14); + } + if (*iorder == 1) { + s_copy(crc, " CblasRowMajor", (ftnlen)14, (ftnlen)14); + } else { + s_copy(crc, " CblasColMajor", (ftnlen)14, (ftnlen)14); + } + io___251.ciunit = *nout; + s_wsfe(&io___251); + do_fio(&c__1, (char *)&(*nc), (ftnlen)sizeof(integer)); + do_fio(&c__1, sname, (ftnlen)13); + do_fio(&c__1, crc, (ftnlen)14); + do_fio(&c__1, cs, (ftnlen)14); + do_fio(&c__1, cu, (ftnlen)14); + e_wsfe(); + io___252.ciunit = *nout; + s_wsfe(&io___252); + do_fio(&c__1, ca, (ftnlen)14); + do_fio(&c__1, cd, (ftnlen)14); + do_fio(&c__1, (char *)&(*m), (ftnlen)sizeof(integer)); + do_fio(&c__1, (char *)&(*n), (ftnlen)sizeof(integer)); + do_fio(&c__2, (char *)&(*alpha), (ftnlen)sizeof(doublereal)); + do_fio(&c__1, (char *)&(*lda), (ftnlen)sizeof(integer)); + do_fio(&c__1, (char *)&(*ldb), (ftnlen)sizeof(integer)); + e_wsfe(); + return 0; +} /* zprcn3_ */ + + +/* Subroutine */ int zchk4_(char *sname, doublereal *eps, doublereal *thresh, + integer *nout, integer *ntra, logical *trace, logical *rewi, logical * + fatal, integer *nidim, integer *idim, integer *nalf, doublecomplex * + alf, integer *nbet, doublecomplex *bet, integer *nmax, doublecomplex * + a, doublecomplex *aa, doublecomplex *as, doublecomplex *b, + doublecomplex *bb, doublecomplex *bs, doublecomplex *c__, + doublecomplex *cc, doublecomplex *cs, doublecomplex *ct, doublereal * + g, integer *iorder) +{ + /* Initialized data */ + + static char icht[2] = "NC"; + static char ichu[2] = "UL"; + + /* Format strings */ + static char fmt_9992[] = "(\002 ******* FATAL ERROR - ERROR-CALL MYEXIT " + "TAKEN ON VALID\002,\002 CALL *******\002)"; + static char fmt_9998[] = "(\002 ******* FATAL ERROR - PARAMETER NUMBER" + " \002,i2,\002 WAS CH\002,\002ANGED INCORRECTLY *******\002)"; + static char fmt_10000[] = "(\002 \002,a13,\002 PASSED THE COLUMN-MAJOR C" + "OMPUTATIONAL TESTS\002,\002 (\002,i6,\002 CALL\002,\002S)\002)"; + static char fmt_10001[] = "(\002 \002,a13,\002 PASSED THE ROW-MAJOR C" + "OMPUTATIONAL TESTS\002,\002 (\002,i6,\002 CALL\002,\002S)\002)"; + static char fmt_10002[] = "(\002 \002,a13,\002 COMPLETED THE COLUMN-MAJO" + "R COMPUTATIONAL \002,\002TESTS (\002,i6,\002 CALLS)\002,/\002 **" + "***** BUT WITH MAXIMUM TEST \002,\002RATIO \002,f8.2,\002 - SUSP" + "ECT *******\002)"; + static char fmt_10003[] = "(\002 \002,a13,\002 COMPLETED THE ROW-MAJOR " + " COMPUTATIONAL \002,\002TESTS (\002,i6,\002 CALLS)\002,/\002 **" + "***** BUT WITH MAXIMUM TEST \002,\002RATIO \002,f8.2,\002 - SUSP" + "ECT *******\002)"; + static char fmt_9995[] = "(\002 THESE ARE THE RESULTS FOR COLUMN" + " \002,i3)"; + static char fmt_9996[] = "(\002 ******* \002,a13,\002 FAILED ON CALL NUM" + "BER:\002)"; + + /* System generated locals */ + integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2, + i__3, i__4, i__5, i__6, i__7; + doublecomplex z__1; + alist al__1; + + /* Local variables */ + doublecomplex beta; + integer ldas, ldcs; + logical same, conj; + doublecomplex bets; + doublereal rals; + logical tran, null; + char uplo[1]; + integer i__, j, k, n; + doublecomplex alpha; + doublereal rbeta; + logical isame[13]; + extern /* Subroutine */ int zmake_(char *, char *, char *, integer *, + integer *, doublecomplex *, integer *, doublecomplex *, integer *, + logical *, doublecomplex *); + integer nargs; + extern /* Subroutine */ int zmmch_(char *, char *, integer *, integer *, + integer *, doublecomplex *, doublecomplex *, integer *, + doublecomplex *, integer *, doublecomplex *, doublecomplex *, + integer *, doublecomplex *, doublereal *, doublecomplex *, + integer *, doublereal *, doublereal *, logical *, integer *, + logical *); + doublereal rbets; + logical reset; + char trans[1]; + logical upper; + char uplos[1]; + integer ia, ib, jc, ma, na; + extern /* Subroutine */ int zprcn4_(integer *, integer *, char *, integer + *, char *, char *, integer *, integer *, doublecomplex *, integer + *, doublecomplex *, integer *); + integer nc; + extern /* Subroutine */ int zprcn6_(integer *, integer *, char *, integer + *, char *, char *, integer *, integer *, doublereal *, integer *, + doublereal *, integer *); + integer ik, in, jj, lj, ks, ns; + doublereal ralpha; + extern /* Subroutine */ int czherk_(integer *, char *, char *, integer *, + integer *, doublereal *, doublecomplex *, integer *, doublereal *, + doublecomplex *, integer *); + doublereal errmax; + extern logical lzeres_(char *, char *, integer *, integer *, + doublecomplex *, doublecomplex *, integer *); + char transs[1], transt[1]; + extern /* Subroutine */ int czsyrk_(integer *, char *, char *, integer *, + integer *, doublecomplex *, doublecomplex *, integer *, + doublecomplex *, doublecomplex *, integer *); + integer laa, lda, lcc, ldc; + doublecomplex als; + integer ict, icu; + doublereal err; + extern logical lze_(doublecomplex *, doublecomplex *, integer *); + + /* Fortran I/O blocks */ + static cilist io___294 = { 0, 0, 0, fmt_9992, 0 }; + static cilist io___297 = { 0, 0, 0, fmt_9998, 0 }; + static cilist io___304 = { 0, 0, 0, fmt_10000, 0 }; + static cilist io___305 = { 0, 0, 0, fmt_10001, 0 }; + static cilist io___306 = { 0, 0, 0, fmt_10002, 0 }; + static cilist io___307 = { 0, 0, 0, fmt_10003, 0 }; + static cilist io___308 = { 0, 0, 0, fmt_9995, 0 }; + static cilist io___309 = { 0, 0, 0, fmt_9996, 0 }; + + + +/* Tests ZHERK and ZSYRK. */ + +/* Auxiliary routine for test program for Level 3 Blas. */ + +/* -- Written on 8-February-1989. */ +/* Jack Dongarra, Argonne National Laboratory. */ +/* Iain Duff, AERE Harwell. */ +/* Jeremy Du Croz, Numerical Algorithms Group Ltd. */ +/* Sven Hammarling, Numerical Algorithms Group Ltd. */ + + /* Parameter adjustments */ + --idim; + --alf; + --bet; + --g; + --ct; + --cs; + --cc; + c_dim1 = *nmax; + c_offset = 1 + c_dim1 * 1; + c__ -= c_offset; + --bs; + --bb; + b_dim1 = *nmax; + b_offset = 1 + b_dim1 * 1; + b -= b_offset; + --as; + --aa; + a_dim1 = *nmax; + a_offset = 1 + a_dim1 * 1; + a -= a_offset; + + /* Function Body */ + conj = s_cmp(sname + 7, "he", (ftnlen)2, (ftnlen)2) == 0; + + nargs = 10; + nc = 0; + reset = TRUE_; + errmax = 0.; + + i__1 = *nidim; + for (in = 1; in <= i__1; ++in) { + n = idim[in]; +/* Set LDC to 1 more than minimum value if room. */ + ldc = n; + if (ldc < *nmax) { + ++ldc; + } +/* Skip tests if not enough room. */ + if (ldc > *nmax) { + goto L100; + } + lcc = ldc * n; + + i__2 = *nidim; + for (ik = 1; ik <= i__2; ++ik) { + k = idim[ik]; + + for (ict = 1; ict <= 2; ++ict) { + *(unsigned char *)trans = *(unsigned char *)&icht[ict - 1]; + tran = *(unsigned char *)trans == 'C'; + if (tran && ! conj) { + *(unsigned char *)trans = 'T'; + } + if (tran) { + ma = k; + na = n; + } else { + ma = n; + na = k; + } +/* Set LDA to 1 more than minimum value if room. */ + lda = ma; + if (lda < *nmax) { + ++lda; + } +/* Skip tests if not enough room. */ + if (lda > *nmax) { + goto L80; + } + laa = lda * na; + +/* Generate the matrix A. */ + + zmake_("ge", " ", " ", &ma, &na, &a[a_offset], nmax, &aa[1], & + lda, &reset, &c_b1); + + for (icu = 1; icu <= 2; ++icu) { + *(unsigned char *)uplo = *(unsigned char *)&ichu[icu - 1]; + upper = *(unsigned char *)uplo == 'U'; + + i__3 = *nalf; + for (ia = 1; ia <= i__3; ++ia) { + i__4 = ia; + alpha.r = alf[i__4].r, alpha.i = alf[i__4].i; + if (conj) { + ralpha = alpha.r; + z__1.r = ralpha, z__1.i = 0.; + alpha.r = z__1.r, alpha.i = z__1.i; + } + + i__4 = *nbet; + for (ib = 1; ib <= i__4; ++ib) { + i__5 = ib; + beta.r = bet[i__5].r, beta.i = bet[i__5].i; + if (conj) { + rbeta = beta.r; + z__1.r = rbeta, z__1.i = 0.; + beta.r = z__1.r, beta.i = z__1.i; + } + null = n <= 0; + if (conj) { + null = null || (k <= 0 || ralpha == 0.) && + rbeta == 1.; + } + +/* Generate the matrix C. */ + + zmake_(sname + 7, uplo, " ", &n, &n, &c__[ + c_offset], nmax, &cc[1], &ldc, &reset, & + c_b1); + + ++nc; + +/* Save every datum before calling the subroutine. */ + + *(unsigned char *)uplos = *(unsigned char *)uplo; + *(unsigned char *)transs = *(unsigned char *) + trans; + ns = n; + ks = k; + if (conj) { + rals = ralpha; + } else { + als.r = alpha.r, als.i = alpha.i; + } + i__5 = laa; + for (i__ = 1; i__ <= i__5; ++i__) { + i__6 = i__; + i__7 = i__; + as[i__6].r = aa[i__7].r, as[i__6].i = aa[i__7] + .i; +/* L10: */ + } + ldas = lda; + if (conj) { + rbets = rbeta; + } else { + bets.r = beta.r, bets.i = beta.i; + } + i__5 = lcc; + for (i__ = 1; i__ <= i__5; ++i__) { + i__6 = i__; + i__7 = i__; + cs[i__6].r = cc[i__7].r, cs[i__6].i = cc[i__7] + .i; +/* L20: */ + } + ldcs = ldc; + +/* Call the subroutine. */ + + if (conj) { + if (*trace) { + zprcn6_(ntra, &nc, sname, iorder, uplo, + trans, &n, &k, &ralpha, &lda, & + rbeta, &ldc); + } + if (*rewi) { + al__1.aerr = 0; + al__1.aunit = *ntra; + f_rew(&al__1); + } + czherk_(iorder, uplo, trans, &n, &k, &ralpha, + &aa[1], &lda, &rbeta, &cc[1], &ldc); + } else { + if (*trace) { + zprcn4_(ntra, &nc, sname, iorder, uplo, + trans, &n, &k, &alpha, &lda, & + beta, &ldc); + } + if (*rewi) { + al__1.aerr = 0; + al__1.aunit = *ntra; + f_rew(&al__1); + } + czsyrk_(iorder, uplo, trans, &n, &k, &alpha, & + aa[1], &lda, &beta, &cc[1], &ldc); + } + +/* Check if error-exit was taken incorrectly. */ + + if (! infoc_1.ok) { + io___294.ciunit = *nout; + s_wsfe(&io___294); + e_wsfe(); + *fatal = TRUE_; + goto L120; + } + +/* See what data changed inside subroutines. */ + + isame[0] = *(unsigned char *)uplos == *(unsigned + char *)uplo; + isame[1] = *(unsigned char *)transs == *(unsigned + char *)trans; + isame[2] = ns == n; + isame[3] = ks == k; + if (conj) { + isame[4] = rals == ralpha; + } else { + isame[4] = als.r == alpha.r && als.i == + alpha.i; + } + isame[5] = lze_(&as[1], &aa[1], &laa); + isame[6] = ldas == lda; + if (conj) { + isame[7] = rbets == rbeta; + } else { + isame[7] = bets.r == beta.r && bets.i == + beta.i; + } + if (null) { + isame[8] = lze_(&cs[1], &cc[1], &lcc); + } else { + isame[8] = lzeres_(sname + 7, uplo, &n, &n, & + cs[1], &cc[1], &ldc); + } + isame[9] = ldcs == ldc; + +/* If data was incorrectly changed, report and */ +/* return. */ + + same = TRUE_; + i__5 = nargs; + for (i__ = 1; i__ <= i__5; ++i__) { + same = same && isame[i__ - 1]; + if (! isame[i__ - 1]) { + io___297.ciunit = *nout; + s_wsfe(&io___297); + do_fio(&c__1, (char *)&i__, (ftnlen) + sizeof(integer)); + e_wsfe(); + } +/* L30: */ + } + if (! same) { + *fatal = TRUE_; + goto L120; + } + + if (! null) { + +/* Check the result column by column. */ + + if (conj) { + *(unsigned char *)transt = 'C'; + } else { + *(unsigned char *)transt = 'T'; + } + jc = 1; + i__5 = n; + for (j = 1; j <= i__5; ++j) { + if (upper) { + jj = 1; + lj = j; + } else { + jj = j; + lj = n - j + 1; + } + if (tran) { + zmmch_(transt, "N", &lj, &c__1, &k, & + alpha, &a[jj * a_dim1 + 1], + nmax, &a[j * a_dim1 + 1], + nmax, &beta, &c__[jj + j * + c_dim1], nmax, &ct[1], &g[1], + &cc[jc], &ldc, eps, &err, + fatal, nout, &c_true); + } else { + zmmch_("N", transt, &lj, &c__1, &k, & + alpha, &a[jj + a_dim1], nmax, + &a[j + a_dim1], nmax, &beta, & + c__[jj + j * c_dim1], nmax, & + ct[1], &g[1], &cc[jc], &ldc, + eps, &err, fatal, nout, & + c_true); + } + if (upper) { + jc += ldc; + } else { + jc = jc + ldc + 1; + } + errmax = f2cmax(errmax,err); +/* If got really bad answer, report and */ +/* return. */ + if (*fatal) { + goto L110; + } +/* L40: */ + } + } + +/* L50: */ + } + +/* L60: */ + } + +/* L70: */ + } + +L80: + ; + } + +/* L90: */ + } + +L100: + ; + } + +/* Report result. */ + + if (errmax < *thresh) { + if (*iorder == 0) { + io___304.ciunit = *nout; + s_wsfe(&io___304); + do_fio(&c__1, sname, (ftnlen)13); + do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer)); + e_wsfe(); + } + if (*iorder == 1) { + io___305.ciunit = *nout; + s_wsfe(&io___305); + do_fio(&c__1, sname, (ftnlen)13); + do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer)); + e_wsfe(); + } + } else { + if (*iorder == 0) { + io___306.ciunit = *nout; + s_wsfe(&io___306); + do_fio(&c__1, sname, (ftnlen)13); + do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer)); + do_fio(&c__1, (char *)&errmax, (ftnlen)sizeof(doublereal)); + e_wsfe(); + } + if (*iorder == 1) { + io___307.ciunit = *nout; + s_wsfe(&io___307); + do_fio(&c__1, sname, (ftnlen)13); + do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer)); + do_fio(&c__1, (char *)&errmax, (ftnlen)sizeof(doublereal)); + e_wsfe(); + } + } + goto L130; + +L110: + if (n > 1) { + io___308.ciunit = *nout; + s_wsfe(&io___308); + do_fio(&c__1, (char *)&j, (ftnlen)sizeof(integer)); + e_wsfe(); + } + +L120: + io___309.ciunit = *nout; + s_wsfe(&io___309); + do_fio(&c__1, sname, (ftnlen)13); + e_wsfe(); + if (conj) { + zprcn6_(nout, &nc, sname, iorder, uplo, trans, &n, &k, &ralpha, &lda, + &rbeta, &ldc); + } else { + zprcn4_(nout, &nc, sname, iorder, uplo, trans, &n, &k, &alpha, &lda, & + beta, &ldc); + } + +L130: + return 0; + +/* L9994: */ +/* L9993: */ + +/* End of CCHK4. */ + +} /* zchk4_ */ + + +/* Subroutine */ int zprcn4_(integer *nout, integer *nc, char *sname, integer + *iorder, char *uplo, char *transa, integer *n, integer *k, + doublecomplex *alpha, integer *lda, doublecomplex *beta, integer *ldc) +{ + /* Format strings */ + static char fmt_9995[] = "(1x,i6,\002: \002,a13,\002(\002,3(a15,\002," + "\002))"; + static char fmt_9994[] = "(10x,2(i3,\002,\002),\002 (\002,f4.1,\002,\002" + ",f4.1,\002), A,\002,i3,\002, (\002,f4.1,\002,\002,f4.1,\002), C" + ",\002,i3,\002).\002)"; + + /* Local variables */ + char ca[14], cu[14], crc[14]; + + /* Fortran I/O blocks */ + static cilist io___313 = { 0, 0, 0, fmt_9995, 0 }; + static cilist io___314 = { 0, 0, 0, fmt_9994, 0 }; + + + if (*(unsigned char *)uplo == 'U') { + s_copy(cu, " CblasUpper", (ftnlen)14, (ftnlen)14); + } else { + s_copy(cu, " CblasLower", (ftnlen)14, (ftnlen)14); + } + if (*(unsigned char *)transa == 'N') { + s_copy(ca, " CblasNoTrans", (ftnlen)14, (ftnlen)14); + } else if (*(unsigned char *)transa == 'T') { + s_copy(ca, " CblasTrans", (ftnlen)14, (ftnlen)14); + } else { + s_copy(ca, "CblasConjTrans", (ftnlen)14, (ftnlen)14); + } + if (*iorder == 1) { + s_copy(crc, " CblasRowMajor", (ftnlen)14, (ftnlen)14); + } else { + s_copy(crc, " CblasColMajor", (ftnlen)14, (ftnlen)14); + } + io___313.ciunit = *nout; + s_wsfe(&io___313); + do_fio(&c__1, (char *)&(*nc), (ftnlen)sizeof(integer)); + do_fio(&c__1, sname, (ftnlen)13); + do_fio(&c__1, crc, (ftnlen)14); + do_fio(&c__1, cu, (ftnlen)14); + do_fio(&c__1, ca, (ftnlen)14); + e_wsfe(); + io___314.ciunit = *nout; + s_wsfe(&io___314); + do_fio(&c__1, (char *)&(*n), (ftnlen)sizeof(integer)); + do_fio(&c__1, (char *)&(*k), (ftnlen)sizeof(integer)); + do_fio(&c__2, (char *)&(*alpha), (ftnlen)sizeof(doublereal)); + do_fio(&c__1, (char *)&(*lda), (ftnlen)sizeof(integer)); + do_fio(&c__2, (char *)&(*beta), (ftnlen)sizeof(doublereal)); + do_fio(&c__1, (char *)&(*ldc), (ftnlen)sizeof(integer)); + e_wsfe(); + return 0; +} /* zprcn4_ */ + + + +/* Subroutine */ int zprcn6_(integer *nout, integer *nc, char *sname, integer + *iorder, char *uplo, char *transa, integer *n, integer *k, doublereal + *alpha, integer *lda, doublereal *beta, integer *ldc) +{ + /* Format strings */ + static char fmt_9995[] = "(1x,i6,\002: \002,a13,\002(\002,3(a15,\002," + "\002))"; + static char fmt_9994[] = "(10x,2(i3,\002,\002),f4.1,\002, A,\002,i3" + ",\002,\002,f4.1,\002, C,\002,i3,\002).\002)"; + + /* Local variables */ + char ca[14], cu[14], crc[14]; + + /* Fortran I/O blocks */ + static cilist io___318 = { 0, 0, 0, fmt_9995, 0 }; + static cilist io___319 = { 0, 0, 0, fmt_9994, 0 }; + + + if (*(unsigned char *)uplo == 'U') { + s_copy(cu, " CblasUpper", (ftnlen)14, (ftnlen)14); + } else { + s_copy(cu, " CblasLower", (ftnlen)14, (ftnlen)14); + } + if (*(unsigned char *)transa == 'N') { + s_copy(ca, " CblasNoTrans", (ftnlen)14, (ftnlen)14); + } else if (*(unsigned char *)transa == 'T') { + s_copy(ca, " CblasTrans", (ftnlen)14, (ftnlen)14); + } else { + s_copy(ca, "CblasConjTrans", (ftnlen)14, (ftnlen)14); + } + if (*iorder == 1) { + s_copy(crc, " CblasRowMajor", (ftnlen)14, (ftnlen)14); + } else { + s_copy(crc, " CblasColMajor", (ftnlen)14, (ftnlen)14); + } + io___318.ciunit = *nout; + s_wsfe(&io___318); + do_fio(&c__1, (char *)&(*nc), (ftnlen)sizeof(integer)); + do_fio(&c__1, sname, (ftnlen)13); + do_fio(&c__1, crc, (ftnlen)14); + do_fio(&c__1, cu, (ftnlen)14); + do_fio(&c__1, ca, (ftnlen)14); + e_wsfe(); + io___319.ciunit = *nout; + s_wsfe(&io___319); + do_fio(&c__1, (char *)&(*n), (ftnlen)sizeof(integer)); + do_fio(&c__1, (char *)&(*k), (ftnlen)sizeof(integer)); + do_fio(&c__1, (char *)&(*alpha), (ftnlen)sizeof(doublereal)); + do_fio(&c__1, (char *)&(*lda), (ftnlen)sizeof(integer)); + do_fio(&c__1, (char *)&(*beta), (ftnlen)sizeof(doublereal)); + do_fio(&c__1, (char *)&(*ldc), (ftnlen)sizeof(integer)); + e_wsfe(); + return 0; +} /* zprcn6_ */ + + +/* Subroutine */ int zchk5_(char *sname, doublereal *eps, doublereal *thresh, + integer *nout, integer *ntra, logical *trace, logical *rewi, logical * + fatal, integer *nidim, integer *idim, integer *nalf, doublecomplex * + alf, integer *nbet, doublecomplex *bet, integer *nmax, doublecomplex * + ab, doublecomplex *aa, doublecomplex *as, doublecomplex *bb, + doublecomplex *bs, doublecomplex *c__, doublecomplex *cc, + doublecomplex *cs, doublecomplex *ct, doublereal *g, doublecomplex *w, + integer *iorder) +{ + /* Initialized data */ + + static char icht[2] = "NC"; + static char ichu[2] = "UL"; + + /* Format strings */ + static char fmt_9992[] = "(\002 ******* FATAL ERROR - ERROR-CALL MYEXIT " + "TAKEN ON VALID\002,\002 CALL *******\002)"; + static char fmt_9998[] = "(\002 ******* FATAL ERROR - PARAMETER NUMBER" + " \002,i2,\002 WAS CH\002,\002ANGED INCORRECTLY *******\002)"; + static char fmt_10000[] = "(\002 \002,a13,\002 PASSED THE COLUMN-MAJOR C" + "OMPUTATIONAL TESTS\002,\002 (\002,i6,\002 CALL\002,\002S)\002)"; + static char fmt_10001[] = "(\002 \002,a13,\002 PASSED THE ROW-MAJOR C" + "OMPUTATIONAL TESTS\002,\002 (\002,i6,\002 CALL\002,\002S)\002)"; + static char fmt_10002[] = "(\002 \002,a13,\002 COMPLETED THE COLUMN-MAJO" + "R COMPUTATIONAL \002,\002TESTS (\002,i6,\002 CALLS)\002,/\002 **" + "***** BUT WITH MAXIMUM TEST \002,\002RATIO \002,f8.2,\002 - SUSP" + "ECT *******\002)"; + static char fmt_10003[] = "(\002 \002,a13,\002 COMPLETED THE ROW-MAJOR " + " COMPUTATIONAL \002,\002TESTS (\002,i6,\002 CALLS)\002,/\002 **" + "***** BUT WITH MAXIMUM TEST \002,\002RATIO \002,f8.2,\002 - SUSP" + "ECT *******\002)"; + static char fmt_9995[] = "(\002 THESE ARE THE RESULTS FOR COLUMN" + " \002,i3)"; + static char fmt_9996[] = "(\002 ******* \002,a13,\002 FAILED ON CALL NUM" + "BER:\002)"; + + /* System generated locals */ + integer c_dim1, c_offset, i__1, i__2, i__3, i__4, i__5, i__6, i__7, i__8; + doublecomplex z__1, z__2; + alist al__1; + + /* Local variables */ + integer jjab; + doublecomplex beta; + integer ldas, ldbs, ldcs; + logical same, conj; + doublecomplex bets; + logical tran, null; + char uplo[1]; + integer i__, j, k, n; + doublecomplex alpha; + doublereal rbeta; + logical isame[13]; + extern /* Subroutine */ int zmake_(char *, char *, char *, integer *, + integer *, doublecomplex *, integer *, doublecomplex *, integer *, + logical *, doublecomplex *); + integer nargs; + extern /* Subroutine */ int zmmch_(char *, char *, integer *, integer *, + integer *, doublecomplex *, doublecomplex *, integer *, + doublecomplex *, integer *, doublecomplex *, doublecomplex *, + integer *, doublecomplex *, doublereal *, doublecomplex *, + integer *, doublereal *, doublereal *, logical *, integer *, + logical *); + doublereal rbets; + logical reset; + char trans[1]; + logical upper; + char uplos[1]; + integer ia, ib, jc, ma, na, nc; + extern /* Subroutine */ int zprcn5_(integer *, integer *, char *, integer + *, char *, char *, integer *, integer *, doublecomplex *, integer + *, integer *, doublecomplex *, integer *), + zprcn7_(integer *, integer *, char *, integer *, char *, char *, + integer *, integer *, doublecomplex *, integer *, integer *, + doublereal *, integer *); + integer ik, in, jj, lj, ks, ns; + doublereal errmax; + extern logical lzeres_(char *, char *, integer *, integer *, + doublecomplex *, doublecomplex *, integer *); + char transs[1], transt[1]; + extern /* Subroutine */ int czher2k_(integer *, char *, char *, integer *, + integer *, doublecomplex *, doublecomplex *, integer *, + doublecomplex *, integer *, doublereal *, doublecomplex *, + integer *); + integer laa, lbb, lda, lcc, ldb, ldc; + doublecomplex als; + integer ict, icu; + extern /* Subroutine */ int czsyr2k_(integer *, char *, char *, integer *, + integer *, doublecomplex *, doublecomplex *, integer *, + doublecomplex *, integer *, doublecomplex *, doublecomplex *, + integer *); + doublereal err; + extern logical lze_(doublecomplex *, doublecomplex *, integer *); + + /* Fortran I/O blocks */ + static cilist io___362 = { 0, 0, 0, fmt_9992, 0 }; + static cilist io___365 = { 0, 0, 0, fmt_9998, 0 }; + static cilist io___373 = { 0, 0, 0, fmt_10000, 0 }; + static cilist io___374 = { 0, 0, 0, fmt_10001, 0 }; + static cilist io___375 = { 0, 0, 0, fmt_10002, 0 }; + static cilist io___376 = { 0, 0, 0, fmt_10003, 0 }; + static cilist io___377 = { 0, 0, 0, fmt_9995, 0 }; + static cilist io___378 = { 0, 0, 0, fmt_9996, 0 }; + + + +/* Tests ZHER2K and ZSYR2K. */ + +/* Auxiliary routine for test program for Level 3 Blas. */ + +/* -- Written on 8-February-1989. */ +/* Jack Dongarra, Argonne National Laboratory. */ +/* Iain Duff, AERE Harwell. */ +/* Jeremy Du Croz, Numerical Algorithms Group Ltd. */ +/* Sven Hammarling, Numerical Algorithms Group Ltd. */ + + /* Parameter adjustments */ + --idim; + --alf; + --bet; + --w; + --g; + --ct; + --cs; + --cc; + c_dim1 = *nmax; + c_offset = 1 + c_dim1 * 1; + c__ -= c_offset; + --bs; + --bb; + --as; + --aa; + --ab; + + /* Function Body */ + conj = s_cmp(sname + 7, "he", (ftnlen)2, (ftnlen)2) == 0; + + nargs = 12; + nc = 0; + reset = TRUE_; + errmax = 0.; + + i__1 = *nidim; + for (in = 1; in <= i__1; ++in) { + n = idim[in]; +/* Set LDC to 1 more than minimum value if room. */ + ldc = n; + if (ldc < *nmax) { + ++ldc; + } +/* Skip tests if not enough room. */ + if (ldc > *nmax) { + goto L130; + } + lcc = ldc * n; + + i__2 = *nidim; + for (ik = 1; ik <= i__2; ++ik) { + k = idim[ik]; + + for (ict = 1; ict <= 2; ++ict) { + *(unsigned char *)trans = *(unsigned char *)&icht[ict - 1]; + tran = *(unsigned char *)trans == 'C'; + if (tran && ! conj) { + *(unsigned char *)trans = 'T'; + } + if (tran) { + ma = k; + na = n; + } else { + ma = n; + na = k; + } +/* Set LDA to 1 more than minimum value if room. */ + lda = ma; + if (lda < *nmax) { + ++lda; + } +/* Skip tests if not enough room. */ + if (lda > *nmax) { + goto L110; + } + laa = lda * na; + +/* Generate the matrix A. */ + + if (tran) { + i__3 = *nmax << 1; + zmake_("ge", " ", " ", &ma, &na, &ab[1], &i__3, &aa[1], & + lda, &reset, &c_b1); + } else { + zmake_("ge", " ", " ", &ma, &na, &ab[1], nmax, &aa[1], & + lda, &reset, &c_b1); + } + +/* Generate the matrix B. */ + + ldb = lda; + lbb = laa; + if (tran) { + i__3 = *nmax << 1; + zmake_("ge", " ", " ", &ma, &na, &ab[k + 1], &i__3, &bb[1] + , &ldb, &reset, &c_b1); + } else { + zmake_("ge", " ", " ", &ma, &na, &ab[k * *nmax + 1], nmax, + &bb[1], &ldb, &reset, &c_b1); + } + + for (icu = 1; icu <= 2; ++icu) { + *(unsigned char *)uplo = *(unsigned char *)&ichu[icu - 1]; + upper = *(unsigned char *)uplo == 'U'; + + i__3 = *nalf; + for (ia = 1; ia <= i__3; ++ia) { + i__4 = ia; + alpha.r = alf[i__4].r, alpha.i = alf[i__4].i; + + i__4 = *nbet; + for (ib = 1; ib <= i__4; ++ib) { + i__5 = ib; + beta.r = bet[i__5].r, beta.i = bet[i__5].i; + if (conj) { + rbeta = beta.r; + z__1.r = rbeta, z__1.i = 0.; + beta.r = z__1.r, beta.i = z__1.i; + } + null = n <= 0; + if (conj) { + null = null || (k <= 0 || alpha.r == 0. && + alpha.i == 0.) && rbeta == 1.; + } + +/* Generate the matrix C. */ + + zmake_(sname + 7, uplo, " ", &n, &n, &c__[ + c_offset], nmax, &cc[1], &ldc, &reset, & + c_b1); + + ++nc; + +/* Save every datum before calling the subroutine. */ + + *(unsigned char *)uplos = *(unsigned char *)uplo; + *(unsigned char *)transs = *(unsigned char *) + trans; + ns = n; + ks = k; + als.r = alpha.r, als.i = alpha.i; + i__5 = laa; + for (i__ = 1; i__ <= i__5; ++i__) { + i__6 = i__; + i__7 = i__; + as[i__6].r = aa[i__7].r, as[i__6].i = aa[i__7] + .i; +/* L10: */ + } + ldas = lda; + i__5 = lbb; + for (i__ = 1; i__ <= i__5; ++i__) { + i__6 = i__; + i__7 = i__; + bs[i__6].r = bb[i__7].r, bs[i__6].i = bb[i__7] + .i; +/* L20: */ + } + ldbs = ldb; + if (conj) { + rbets = rbeta; + } else { + bets.r = beta.r, bets.i = beta.i; + } + i__5 = lcc; + for (i__ = 1; i__ <= i__5; ++i__) { + i__6 = i__; + i__7 = i__; + cs[i__6].r = cc[i__7].r, cs[i__6].i = cc[i__7] + .i; +/* L30: */ + } + ldcs = ldc; + +/* Call the subroutine. */ + + if (conj) { + if (*trace) { + zprcn7_(ntra, &nc, sname, iorder, uplo, + trans, &n, &k, &alpha, &lda, &ldb, + &rbeta, &ldc); + } + if (*rewi) { + al__1.aerr = 0; + al__1.aunit = *ntra; + f_rew(&al__1); + } + czher2k_(iorder, uplo, trans, &n, &k, &alpha, + &aa[1], &lda, &bb[1], &ldb, &rbeta, & + cc[1], &ldc); + } else { + if (*trace) { + zprcn5_(ntra, &nc, sname, iorder, uplo, + trans, &n, &k, &alpha, &lda, &ldb, + &beta, &ldc); + } + if (*rewi) { + al__1.aerr = 0; + al__1.aunit = *ntra; + f_rew(&al__1); + } + czsyr2k_(iorder, uplo, trans, &n, &k, &alpha, + &aa[1], &lda, &bb[1], &ldb, &beta, & + cc[1], &ldc); + } + +/* Check if error-exit was taken incorrectly. */ + + if (! infoc_1.ok) { + io___362.ciunit = *nout; + s_wsfe(&io___362); + e_wsfe(); + *fatal = TRUE_; + goto L150; + } + +/* See what data changed inside subroutines. */ + + isame[0] = *(unsigned char *)uplos == *(unsigned + char *)uplo; + isame[1] = *(unsigned char *)transs == *(unsigned + char *)trans; + isame[2] = ns == n; + isame[3] = ks == k; + isame[4] = als.r == alpha.r && als.i == alpha.i; + isame[5] = lze_(&as[1], &aa[1], &laa); + isame[6] = ldas == lda; + isame[7] = lze_(&bs[1], &bb[1], &lbb); + isame[8] = ldbs == ldb; + if (conj) { + isame[9] = rbets == rbeta; + } else { + isame[9] = bets.r == beta.r && bets.i == + beta.i; + } + if (null) { + isame[10] = lze_(&cs[1], &cc[1], &lcc); + } else { + isame[10] = lzeres_("he", uplo, &n, &n, &cs[1] + , &cc[1], &ldc); + } + isame[11] = ldcs == ldc; + +/* If data was incorrectly changed, report and */ +/* return. */ + + same = TRUE_; + i__5 = nargs; + for (i__ = 1; i__ <= i__5; ++i__) { + same = same && isame[i__ - 1]; + if (! isame[i__ - 1]) { + io___365.ciunit = *nout; + s_wsfe(&io___365); + do_fio(&c__1, (char *)&i__, (ftnlen) + sizeof(integer)); + e_wsfe(); + } +/* L40: */ + } + if (! same) { + *fatal = TRUE_; + goto L150; + } + + if (! null) { + +/* Check the result column by column. */ + + if (conj) { + *(unsigned char *)transt = 'C'; + } else { + *(unsigned char *)transt = 'T'; + } + jjab = 1; + jc = 1; + i__5 = n; + for (j = 1; j <= i__5; ++j) { + if (upper) { + jj = 1; + lj = j; + } else { + jj = j; + lj = n - j + 1; + } + if (tran) { + i__6 = k; + for (i__ = 1; i__ <= i__6; ++i__) { + i__7 = i__; + i__8 = (j - 1 << 1) * *nmax + k + + i__; + z__1.r = alpha.r * ab[i__8].r - + alpha.i * ab[i__8].i, + z__1.i = alpha.r * ab[ + i__8].i + alpha.i * ab[ + i__8].r; + w[i__7].r = z__1.r, w[i__7].i = + z__1.i; + if (conj) { + i__7 = k + i__; + d_cnjg(&z__2, &alpha); + i__8 = (j - 1 << 1) * *nmax + i__; + z__1.r = z__2.r * ab[i__8].r - z__2.i * ab[i__8].i, + z__1.i = z__2.r * ab[i__8].i + z__2.i * ab[ + i__8].r; + w[i__7].r = z__1.r, w[i__7].i = z__1.i; + } else { + i__7 = k + i__; + i__8 = (j - 1 << 1) * *nmax + i__; + z__1.r = alpha.r * ab[i__8].r - alpha.i * ab[i__8] + .i, z__1.i = alpha.r * ab[i__8].i + alpha.i + * ab[i__8].r; + w[i__7].r = z__1.r, w[i__7].i = z__1.i; + } +/* L50: */ + } + i__6 = k << 1; + i__7 = *nmax << 1; + i__8 = *nmax << 1; + zmmch_(transt, "N", &lj, &c__1, &i__6, + &c_b2, &ab[jjab], &i__7, &w[ + 1], &i__8, &beta, &c__[jj + j + * c_dim1], nmax, &ct[1], &g[1] + , &cc[jc], &ldc, eps, &err, + fatal, nout, &c_true); + } else { + i__6 = k; + for (i__ = 1; i__ <= i__6; ++i__) { + if (conj) { + i__7 = i__; + d_cnjg(&z__2, &ab[(k + i__ - 1) * *nmax + j]); + z__1.r = alpha.r * z__2.r - alpha.i * z__2.i, + z__1.i = alpha.r * z__2.i + alpha.i * + z__2.r; + w[i__7].r = z__1.r, w[i__7].i = z__1.i; + i__7 = k + i__; + i__8 = (i__ - 1) * *nmax + j; + z__2.r = alpha.r * ab[i__8].r - alpha.i * ab[i__8] + .i, z__2.i = alpha.r * ab[i__8].i + alpha.i + * ab[i__8].r; + d_cnjg(&z__1, &z__2); + w[i__7].r = z__1.r, w[i__7].i = z__1.i; + } else { + i__7 = i__; + i__8 = (k + i__ - 1) * *nmax + j; + z__1.r = alpha.r * ab[i__8].r - alpha.i * ab[i__8] + .i, z__1.i = alpha.r * ab[i__8].i + alpha.i + * ab[i__8].r; + w[i__7].r = z__1.r, w[i__7].i = z__1.i; + i__7 = k + i__; + i__8 = (i__ - 1) * *nmax + j; + z__1.r = alpha.r * ab[i__8].r - alpha.i * ab[i__8] + .i, z__1.i = alpha.r * ab[i__8].i + alpha.i + * ab[i__8].r; + w[i__7].r = z__1.r, w[i__7].i = z__1.i; + } +/* L60: */ + } + i__6 = k << 1; + i__7 = *nmax << 1; + zmmch_("N", "N", &lj, &c__1, &i__6, & + c_b2, &ab[jj], nmax, &w[1], & + i__7, &beta, &c__[jj + j * + c_dim1], nmax, &ct[1], &g[1], + &cc[jc], &ldc, eps, &err, + fatal, nout, &c_true); + } + if (upper) { + jc += ldc; + } else { + jc = jc + ldc + 1; + if (tran) { + jjab += *nmax << 1; + } + } + errmax = f2cmax(errmax,err); +/* If got really bad answer, report and */ +/* return. */ + if (*fatal) { + goto L140; + } +/* L70: */ + } + } + +/* L80: */ + } + +/* L90: */ + } + +/* L100: */ + } + +L110: + ; + } + +/* L120: */ + } + +L130: + ; + } + +/* Report result. */ + + if (errmax < *thresh) { + if (*iorder == 0) { + io___373.ciunit = *nout; + s_wsfe(&io___373); + do_fio(&c__1, sname, (ftnlen)13); + do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer)); + e_wsfe(); + } + if (*iorder == 1) { + io___374.ciunit = *nout; + s_wsfe(&io___374); + do_fio(&c__1, sname, (ftnlen)13); + do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer)); + e_wsfe(); + } + } else { + if (*iorder == 0) { + io___375.ciunit = *nout; + s_wsfe(&io___375); + do_fio(&c__1, sname, (ftnlen)13); + do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer)); + do_fio(&c__1, (char *)&errmax, (ftnlen)sizeof(doublereal)); + e_wsfe(); + } + if (*iorder == 1) { + io___376.ciunit = *nout; + s_wsfe(&io___376); + do_fio(&c__1, sname, (ftnlen)13); + do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer)); + do_fio(&c__1, (char *)&errmax, (ftnlen)sizeof(doublereal)); + e_wsfe(); + } + } + goto L160; + +L140: + if (n > 1) { + io___377.ciunit = *nout; + s_wsfe(&io___377); + do_fio(&c__1, (char *)&j, (ftnlen)sizeof(integer)); + e_wsfe(); + } + +L150: + io___378.ciunit = *nout; + s_wsfe(&io___378); + do_fio(&c__1, sname, (ftnlen)13); + e_wsfe(); + if (conj) { + zprcn7_(nout, &nc, sname, iorder, uplo, trans, &n, &k, &alpha, &lda, & + ldb, &rbeta, &ldc); + } else { + zprcn5_(nout, &nc, sname, iorder, uplo, trans, &n, &k, &alpha, &lda, & + ldb, &beta, &ldc); + } + +L160: + return 0; + +/* L9994: */ +/* L9993: */ + +/* End of ZCHK5. */ + +} /* zchk5_ */ + + +/* Subroutine */ int zprcn5_(integer *nout, integer *nc, char *sname, integer + *iorder, char *uplo, char *transa, integer *n, integer *k, + doublecomplex *alpha, integer *lda, integer *ldb, doublecomplex *beta, + integer *ldc) +{ + /* Format strings */ + static char fmt_9995[] = "(1x,i6,\002: \002,a13,\002(\002,3(a15,\002," + "\002))"; + static char fmt_9994[] = "(10x,2(i3,\002,\002),\002 (\002,f4.1,\002,\002" + ",f4.1,\002), A,\002,i3,\002, B\002,i3,\002, (\002,f4.1,\002,\002" + ",f4.1,\002), C,\002,i3,\002).\002)"; + + /* Local variables */ + char ca[14], cu[14], crc[14]; + + /* Fortran I/O blocks */ + static cilist io___382 = { 0, 0, 0, fmt_9995, 0 }; + static cilist io___383 = { 0, 0, 0, fmt_9994, 0 }; + + + if (*(unsigned char *)uplo == 'U') { + s_copy(cu, " CblasUpper", (ftnlen)14, (ftnlen)14); + } else { + s_copy(cu, " CblasLower", (ftnlen)14, (ftnlen)14); + } + if (*(unsigned char *)transa == 'N') { + s_copy(ca, " CblasNoTrans", (ftnlen)14, (ftnlen)14); + } else if (*(unsigned char *)transa == 'T') { + s_copy(ca, " CblasTrans", (ftnlen)14, (ftnlen)14); + } else { + s_copy(ca, "CblasConjTrans", (ftnlen)14, (ftnlen)14); + } + if (*iorder == 1) { + s_copy(crc, " CblasRowMajor", (ftnlen)14, (ftnlen)14); + } else { + s_copy(crc, " CblasColMajor", (ftnlen)14, (ftnlen)14); + } + io___382.ciunit = *nout; + s_wsfe(&io___382); + do_fio(&c__1, (char *)&(*nc), (ftnlen)sizeof(integer)); + do_fio(&c__1, sname, (ftnlen)13); + do_fio(&c__1, crc, (ftnlen)14); + do_fio(&c__1, cu, (ftnlen)14); + do_fio(&c__1, ca, (ftnlen)14); + e_wsfe(); + io___383.ciunit = *nout; + s_wsfe(&io___383); + do_fio(&c__1, (char *)&(*n), (ftnlen)sizeof(integer)); + do_fio(&c__1, (char *)&(*k), (ftnlen)sizeof(integer)); + do_fio(&c__2, (char *)&(*alpha), (ftnlen)sizeof(doublereal)); + do_fio(&c__1, (char *)&(*lda), (ftnlen)sizeof(integer)); + do_fio(&c__1, (char *)&(*ldb), (ftnlen)sizeof(integer)); + do_fio(&c__2, (char *)&(*beta), (ftnlen)sizeof(doublereal)); + do_fio(&c__1, (char *)&(*ldc), (ftnlen)sizeof(integer)); + e_wsfe(); + return 0; +} /* zprcn5_ */ + + + +/* Subroutine */ int zprcn7_(integer *nout, integer *nc, char *sname, integer + *iorder, char *uplo, char *transa, integer *n, integer *k, + doublecomplex *alpha, integer *lda, integer *ldb, doublereal *beta, + integer *ldc) +{ + /* Format strings */ + static char fmt_9995[] = "(1x,i6,\002: \002,a13,\002(\002,3(a15,\002," + "\002))"; + static char fmt_9994[] = "(10x,2(i3,\002,\002),\002 (\002,f4.1,\002,\002" + ",f4.1,\002), A,\002,i3,\002, B\002,i3,\002,\002,f4.1,\002, C," + "\002,i3,\002).\002)"; + + /* Local variables */ + char ca[14], cu[14], crc[14]; + + /* Fortran I/O blocks */ + static cilist io___387 = { 0, 0, 0, fmt_9995, 0 }; + static cilist io___388 = { 0, 0, 0, fmt_9994, 0 }; + + + if (*(unsigned char *)uplo == 'U') { + s_copy(cu, " CblasUpper", (ftnlen)14, (ftnlen)14); + } else { + s_copy(cu, " CblasLower", (ftnlen)14, (ftnlen)14); + } + if (*(unsigned char *)transa == 'N') { + s_copy(ca, " CblasNoTrans", (ftnlen)14, (ftnlen)14); + } else if (*(unsigned char *)transa == 'T') { + s_copy(ca, " CblasTrans", (ftnlen)14, (ftnlen)14); + } else { + s_copy(ca, "CblasConjTrans", (ftnlen)14, (ftnlen)14); + } + if (*iorder == 1) { + s_copy(crc, " CblasRowMajor", (ftnlen)14, (ftnlen)14); + } else { + s_copy(crc, " CblasColMajor", (ftnlen)14, (ftnlen)14); + } + io___387.ciunit = *nout; + s_wsfe(&io___387); + do_fio(&c__1, (char *)&(*nc), (ftnlen)sizeof(integer)); + do_fio(&c__1, sname, (ftnlen)13); + do_fio(&c__1, crc, (ftnlen)14); + do_fio(&c__1, cu, (ftnlen)14); + do_fio(&c__1, ca, (ftnlen)14); + e_wsfe(); + io___388.ciunit = *nout; + s_wsfe(&io___388); + do_fio(&c__1, (char *)&(*n), (ftnlen)sizeof(integer)); + do_fio(&c__1, (char *)&(*k), (ftnlen)sizeof(integer)); + do_fio(&c__2, (char *)&(*alpha), (ftnlen)sizeof(doublereal)); + do_fio(&c__1, (char *)&(*lda), (ftnlen)sizeof(integer)); + do_fio(&c__1, (char *)&(*ldb), (ftnlen)sizeof(integer)); + do_fio(&c__1, (char *)&(*beta), (ftnlen)sizeof(doublereal)); + do_fio(&c__1, (char *)&(*ldc), (ftnlen)sizeof(integer)); + e_wsfe(); + return 0; +} /* zprcn7_ */ + + +/* Subroutine */ int zmake_(char *type__, char *uplo, char *diag, integer *m, + integer *n, doublecomplex *a, integer *nmax, doublecomplex *aa, + integer *lda, logical *reset, doublecomplex *transl) +{ + /* System generated locals */ + integer a_dim1, a_offset, i__1, i__2, i__3, i__4; + doublereal d__1; + doublecomplex z__1, z__2; + + /* Local variables */ + integer ibeg, iend; + extern /* Double Complex */ VOID zbeg_(doublecomplex *, logical *); + logical unit; + integer i__, j; + logical lower, upper; + integer jj; + logical gen, her, tri, sym; + + +/* Generates values for an M by N matrix A. */ +/* Stores the values in the array AA in the data structure required */ +/* by the routine, with unwanted elements set to rogue value. */ + +/* TYPE is 'ge', 'he', 'sy' or 'tr'. */ + +/* Auxiliary routine for test program for Level 3 Blas. */ + +/* -- Written on 8-February-1989. */ +/* Jack Dongarra, Argonne National Laboratory. */ +/* Iain Duff, AERE Harwell. */ +/* Jeremy Du Croz, Numerical Algorithms Group Ltd. */ +/* Sven Hammarling, Numerical Algorithms Group Ltd. */ + + /* Parameter adjustments */ + a_dim1 = *nmax; + a_offset = 1 + a_dim1 * 1; + a -= a_offset; + --aa; + + /* Function Body */ + gen = s_cmp(type__, "ge", (ftnlen)2, (ftnlen)2) == 0; + her = s_cmp(type__, "he", (ftnlen)2, (ftnlen)2) == 0; + sym = s_cmp(type__, "sy", (ftnlen)2, (ftnlen)2) == 0; + tri = s_cmp(type__, "tr", (ftnlen)2, (ftnlen)2) == 0; + upper = (her || sym || tri) && *(unsigned char *)uplo == 'U'; + lower = (her || sym || tri) && *(unsigned char *)uplo == 'L'; + unit = tri && *(unsigned char *)diag == 'U'; + +/* Generate data in array A. */ + + i__1 = *n; + for (j = 1; j <= i__1; ++j) { + i__2 = *m; + for (i__ = 1; i__ <= i__2; ++i__) { + if (gen || upper && i__ <= j || lower && i__ >= j) { + i__3 = i__ + j * a_dim1; + zbeg_(&z__2, reset); + z__1.r = z__2.r + transl->r, z__1.i = z__2.i + transl->i; + a[i__3].r = z__1.r, a[i__3].i = z__1.i; + if (i__ != j) { +/* Set some elements to zero */ + if (*n > 3 && j == *n / 2) { + i__3 = i__ + j * a_dim1; + a[i__3].r = 0., a[i__3].i = 0.; + } + if (her) { + i__3 = j + i__ * a_dim1; + d_cnjg(&z__1, &a[i__ + j * a_dim1]); + a[i__3].r = z__1.r, a[i__3].i = z__1.i; + } else if (sym) { + i__3 = j + i__ * a_dim1; + i__4 = i__ + j * a_dim1; + a[i__3].r = a[i__4].r, a[i__3].i = a[i__4].i; + } else if (tri) { + i__3 = j + i__ * a_dim1; + a[i__3].r = 0., a[i__3].i = 0.; + } + } + } +/* L10: */ + } + if (her) { + i__2 = j + j * a_dim1; + i__3 = j + j * a_dim1; + d__1 = a[i__3].r; + z__1.r = d__1, z__1.i = 0.; + a[i__2].r = z__1.r, a[i__2].i = z__1.i; + } + if (tri) { + i__2 = j + j * a_dim1; + i__3 = j + j * a_dim1; + z__1.r = a[i__3].r + 1., z__1.i = a[i__3].i + 0.; + a[i__2].r = z__1.r, a[i__2].i = z__1.i; + } + if (unit) { + i__2 = j + j * a_dim1; + a[i__2].r = 1., a[i__2].i = 0.; + } +/* L20: */ + } + +/* Store elements in array AS in data structure required by routine. */ + + if (s_cmp(type__, "ge", (ftnlen)2, (ftnlen)2) == 0) { + i__1 = *n; + for (j = 1; j <= i__1; ++j) { + i__2 = *m; + for (i__ = 1; i__ <= i__2; ++i__) { + i__3 = i__ + (j - 1) * *lda; + i__4 = i__ + j * a_dim1; + aa[i__3].r = a[i__4].r, aa[i__3].i = a[i__4].i; +/* L30: */ + } + i__2 = *lda; + for (i__ = *m + 1; i__ <= i__2; ++i__) { + i__3 = i__ + (j - 1) * *lda; + aa[i__3].r = -1e10, aa[i__3].i = 1e10; +/* L40: */ + } +/* L50: */ + } + } else if (s_cmp(type__, "he", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(type__, + "sy", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(type__, "tr", (ftnlen) + 2, (ftnlen)2) == 0) { + i__1 = *n; + for (j = 1; j <= i__1; ++j) { + if (upper) { + ibeg = 1; + if (unit) { + iend = j - 1; + } else { + iend = j; + } + } else { + if (unit) { + ibeg = j + 1; + } else { + ibeg = j; + } + iend = *n; + } + i__2 = ibeg - 1; + for (i__ = 1; i__ <= i__2; ++i__) { + i__3 = i__ + (j - 1) * *lda; + aa[i__3].r = -1e10, aa[i__3].i = 1e10; +/* L60: */ + } + i__2 = iend; + for (i__ = ibeg; i__ <= i__2; ++i__) { + i__3 = i__ + (j - 1) * *lda; + i__4 = i__ + j * a_dim1; + aa[i__3].r = a[i__4].r, aa[i__3].i = a[i__4].i; +/* L70: */ + } + i__2 = *lda; + for (i__ = iend + 1; i__ <= i__2; ++i__) { + i__3 = i__ + (j - 1) * *lda; + aa[i__3].r = -1e10, aa[i__3].i = 1e10; +/* L80: */ + } + if (her) { + jj = j + (j - 1) * *lda; + i__2 = jj; + i__3 = jj; + d__1 = aa[i__3].r; + z__1.r = d__1, z__1.i = -1e10; + aa[i__2].r = z__1.r, aa[i__2].i = z__1.i; + } +/* L90: */ + } + } + return 0; + +/* End of ZMAKE. */ + +} /* zmake_ */ + +/* Subroutine */ int zmmch_(char *transa, char *transb, integer *m, integer * + n, integer *kk, doublecomplex *alpha, doublecomplex *a, integer *lda, + doublecomplex *b, integer *ldb, doublecomplex *beta, doublecomplex * + c__, integer *ldc, doublecomplex *ct, doublereal *g, doublecomplex * + cc, integer *ldcc, doublereal *eps, doublereal *err, logical *fatal, + integer *nout, logical *mv) +{ + /* Format strings */ + static char fmt_9999[] = "(\002 ******* FATAL ERROR - COMPUTED RESULT IS" + " LESS THAN HAL\002,\002F ACCURATE *******\002,/\002 " + " EXPECTED RE\002,\002SULT COMPUTED R" + "ESULT\002)"; + static char fmt_9998[] = "(1x,i7,2(\002 (\002,g15.6,\002,\002,g15.6," + "\002)\002))"; + static char fmt_9997[] = "(\002 THESE ARE THE RESULTS FOR COLUMN" + " \002,i3)"; + + /* System generated locals */ + integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, cc_dim1, + cc_offset, i__1, i__2, i__3, i__4, i__5, i__6, i__7; + doublereal d__1, d__2, d__3, d__4, d__5, d__6; + doublecomplex z__1, z__2, z__3, z__4; + + /* Local variables */ + doublereal erri; + integer i__, j, k; + logical trana, tranb, ctrana, ctranb; + + /* Fortran I/O blocks */ + static cilist io___409 = { 0, 0, 0, fmt_9999, 0 }; + static cilist io___410 = { 0, 0, 0, fmt_9998, 0 }; + static cilist io___411 = { 0, 0, 0, fmt_9998, 0 }; + static cilist io___412 = { 0, 0, 0, fmt_9997, 0 }; + + + +/* Checks the results of the computational tests. */ + +/* Auxiliary routine for test program for Level 3 Blas. */ + +/* -- Written on 8-February-1989. */ +/* Jack Dongarra, Argonne National Laboratory. */ +/* Iain Duff, AERE Harwell. */ +/* Jeremy Du Croz, Numerical Algorithms Group Ltd. */ +/* Sven Hammarling, Numerical Algorithms Group Ltd. */ + + /* Parameter adjustments */ + a_dim1 = *lda; + a_offset = 1 + a_dim1 * 1; + a -= a_offset; + b_dim1 = *ldb; + b_offset = 1 + b_dim1 * 1; + b -= b_offset; + c_dim1 = *ldc; + c_offset = 1 + c_dim1 * 1; + c__ -= c_offset; + --ct; + --g; + cc_dim1 = *ldcc; + cc_offset = 1 + cc_dim1 * 1; + cc -= cc_offset; + + /* Function Body */ + trana = *(unsigned char *)transa == 'T' || *(unsigned char *)transa == + 'C'; + tranb = *(unsigned char *)transb == 'T' || *(unsigned char *)transb == + 'C'; + ctrana = *(unsigned char *)transa == 'C'; + ctranb = *(unsigned char *)transb == 'C'; + +/* Compute expected result, one column at a time, in CT using data */ +/* in A, B and C. */ +/* Compute gauges in G. */ + + i__1 = *n; + for (j = 1; j <= i__1; ++j) { + + i__2 = *m; + for (i__ = 1; i__ <= i__2; ++i__) { + i__3 = i__; + ct[i__3].r = 0., ct[i__3].i = 0.; + g[i__] = 0.; +/* L10: */ + } + if (! trana && ! tranb) { + i__2 = *kk; + for (k = 1; k <= i__2; ++k) { + i__3 = *m; + for (i__ = 1; i__ <= i__3; ++i__) { + i__4 = i__; + i__5 = i__; + i__6 = i__ + k * a_dim1; + i__7 = k + j * b_dim1; + z__2.r = a[i__6].r * b[i__7].r - a[i__6].i * b[i__7].i, + z__2.i = a[i__6].r * b[i__7].i + a[i__6].i * b[ + i__7].r; + z__1.r = ct[i__5].r + z__2.r, z__1.i = ct[i__5].i + + z__2.i; + ct[i__4].r = z__1.r, ct[i__4].i = z__1.i; + i__4 = i__ + k * a_dim1; + i__5 = k + j * b_dim1; + g[i__] += ((d__1 = a[i__4].r, abs(d__1)) + (d__2 = d_imag( + &a[i__ + k * a_dim1]), abs(d__2))) * ((d__3 = b[ + i__5].r, abs(d__3)) + (d__4 = d_imag(&b[k + j * + b_dim1]), abs(d__4))); +/* L20: */ + } +/* L30: */ + } + } else if (trana && ! tranb) { + if (ctrana) { + i__2 = *kk; + for (k = 1; k <= i__2; ++k) { + i__3 = *m; + for (i__ = 1; i__ <= i__3; ++i__) { + i__4 = i__; + i__5 = i__; + d_cnjg(&z__3, &a[k + i__ * a_dim1]); + i__6 = k + j * b_dim1; + z__2.r = z__3.r * b[i__6].r - z__3.i * b[i__6].i, + z__2.i = z__3.r * b[i__6].i + z__3.i * b[i__6] + .r; + z__1.r = ct[i__5].r + z__2.r, z__1.i = ct[i__5].i + + z__2.i; + ct[i__4].r = z__1.r, ct[i__4].i = z__1.i; + i__4 = k + i__ * a_dim1; + i__5 = k + j * b_dim1; + g[i__] += ((d__1 = a[i__4].r, abs(d__1)) + (d__2 = + d_imag(&a[k + i__ * a_dim1]), abs(d__2))) * (( + d__3 = b[i__5].r, abs(d__3)) + (d__4 = d_imag( + &b[k + j * b_dim1]), abs(d__4))); +/* L40: */ + } +/* L50: */ + } + } else { + i__2 = *kk; + for (k = 1; k <= i__2; ++k) { + i__3 = *m; + for (i__ = 1; i__ <= i__3; ++i__) { + i__4 = i__; + i__5 = i__; + i__6 = k + i__ * a_dim1; + i__7 = k + j * b_dim1; + z__2.r = a[i__6].r * b[i__7].r - a[i__6].i * b[i__7] + .i, z__2.i = a[i__6].r * b[i__7].i + a[i__6] + .i * b[i__7].r; + z__1.r = ct[i__5].r + z__2.r, z__1.i = ct[i__5].i + + z__2.i; + ct[i__4].r = z__1.r, ct[i__4].i = z__1.i; + i__4 = k + i__ * a_dim1; + i__5 = k + j * b_dim1; + g[i__] += ((d__1 = a[i__4].r, abs(d__1)) + (d__2 = + d_imag(&a[k + i__ * a_dim1]), abs(d__2))) * (( + d__3 = b[i__5].r, abs(d__3)) + (d__4 = d_imag( + &b[k + j * b_dim1]), abs(d__4))); +/* L60: */ + } +/* L70: */ + } + } + } else if (! trana && tranb) { + if (ctranb) { + i__2 = *kk; + for (k = 1; k <= i__2; ++k) { + i__3 = *m; + for (i__ = 1; i__ <= i__3; ++i__) { + i__4 = i__; + i__5 = i__; + i__6 = i__ + k * a_dim1; + d_cnjg(&z__3, &b[j + k * b_dim1]); + z__2.r = a[i__6].r * z__3.r - a[i__6].i * z__3.i, + z__2.i = a[i__6].r * z__3.i + a[i__6].i * + z__3.r; + z__1.r = ct[i__5].r + z__2.r, z__1.i = ct[i__5].i + + z__2.i; + ct[i__4].r = z__1.r, ct[i__4].i = z__1.i; + i__4 = i__ + k * a_dim1; + i__5 = j + k * b_dim1; + g[i__] += ((d__1 = a[i__4].r, abs(d__1)) + (d__2 = + d_imag(&a[i__ + k * a_dim1]), abs(d__2))) * (( + d__3 = b[i__5].r, abs(d__3)) + (d__4 = d_imag( + &b[j + k * b_dim1]), abs(d__4))); +/* L80: */ + } +/* L90: */ + } + } else { + i__2 = *kk; + for (k = 1; k <= i__2; ++k) { + i__3 = *m; + for (i__ = 1; i__ <= i__3; ++i__) { + i__4 = i__; + i__5 = i__; + i__6 = i__ + k * a_dim1; + i__7 = j + k * b_dim1; + z__2.r = a[i__6].r * b[i__7].r - a[i__6].i * b[i__7] + .i, z__2.i = a[i__6].r * b[i__7].i + a[i__6] + .i * b[i__7].r; + z__1.r = ct[i__5].r + z__2.r, z__1.i = ct[i__5].i + + z__2.i; + ct[i__4].r = z__1.r, ct[i__4].i = z__1.i; + i__4 = i__ + k * a_dim1; + i__5 = j + k * b_dim1; + g[i__] += ((d__1 = a[i__4].r, abs(d__1)) + (d__2 = + d_imag(&a[i__ + k * a_dim1]), abs(d__2))) * (( + d__3 = b[i__5].r, abs(d__3)) + (d__4 = d_imag( + &b[j + k * b_dim1]), abs(d__4))); +/* L100: */ + } +/* L110: */ + } + } + } else if (trana && tranb) { + if (ctrana) { + if (ctranb) { + i__2 = *kk; + for (k = 1; k <= i__2; ++k) { + i__3 = *m; + for (i__ = 1; i__ <= i__3; ++i__) { + i__4 = i__; + i__5 = i__; + d_cnjg(&z__3, &a[k + i__ * a_dim1]); + d_cnjg(&z__4, &b[j + k * b_dim1]); + z__2.r = z__3.r * z__4.r - z__3.i * z__4.i, + z__2.i = z__3.r * z__4.i + z__3.i * + z__4.r; + z__1.r = ct[i__5].r + z__2.r, z__1.i = ct[i__5].i + + z__2.i; + ct[i__4].r = z__1.r, ct[i__4].i = z__1.i; + i__4 = k + i__ * a_dim1; + i__5 = j + k * b_dim1; + g[i__] += ((d__1 = a[i__4].r, abs(d__1)) + (d__2 = + d_imag(&a[k + i__ * a_dim1]), abs(d__2))) + * ((d__3 = b[i__5].r, abs(d__3)) + (d__4 + = d_imag(&b[j + k * b_dim1]), abs(d__4))); +/* L120: */ + } +/* L130: */ + } + } else { + i__2 = *kk; + for (k = 1; k <= i__2; ++k) { + i__3 = *m; + for (i__ = 1; i__ <= i__3; ++i__) { + i__4 = i__; + i__5 = i__; + d_cnjg(&z__3, &a[k + i__ * a_dim1]); + i__6 = j + k * b_dim1; + z__2.r = z__3.r * b[i__6].r - z__3.i * b[i__6].i, + z__2.i = z__3.r * b[i__6].i + z__3.i * b[ + i__6].r; + z__1.r = ct[i__5].r + z__2.r, z__1.i = ct[i__5].i + + z__2.i; + ct[i__4].r = z__1.r, ct[i__4].i = z__1.i; + i__4 = k + i__ * a_dim1; + i__5 = j + k * b_dim1; + g[i__] += ((d__1 = a[i__4].r, abs(d__1)) + (d__2 = + d_imag(&a[k + i__ * a_dim1]), abs(d__2))) + * ((d__3 = b[i__5].r, abs(d__3)) + (d__4 + = d_imag(&b[j + k * b_dim1]), abs(d__4))); +/* L140: */ + } +/* L150: */ + } + } + } else { + if (ctranb) { + i__2 = *kk; + for (k = 1; k <= i__2; ++k) { + i__3 = *m; + for (i__ = 1; i__ <= i__3; ++i__) { + i__4 = i__; + i__5 = i__; + i__6 = k + i__ * a_dim1; + d_cnjg(&z__3, &b[j + k * b_dim1]); + z__2.r = a[i__6].r * z__3.r - a[i__6].i * z__3.i, + z__2.i = a[i__6].r * z__3.i + a[i__6].i * + z__3.r; + z__1.r = ct[i__5].r + z__2.r, z__1.i = ct[i__5].i + + z__2.i; + ct[i__4].r = z__1.r, ct[i__4].i = z__1.i; + i__4 = k + i__ * a_dim1; + i__5 = j + k * b_dim1; + g[i__] += ((d__1 = a[i__4].r, abs(d__1)) + (d__2 = + d_imag(&a[k + i__ * a_dim1]), abs(d__2))) + * ((d__3 = b[i__5].r, abs(d__3)) + (d__4 + = d_imag(&b[j + k * b_dim1]), abs(d__4))); +/* L160: */ + } +/* L170: */ + } + } else { + i__2 = *kk; + for (k = 1; k <= i__2; ++k) { + i__3 = *m; + for (i__ = 1; i__ <= i__3; ++i__) { + i__4 = i__; + i__5 = i__; + i__6 = k + i__ * a_dim1; + i__7 = j + k * b_dim1; + z__2.r = a[i__6].r * b[i__7].r - a[i__6].i * b[ + i__7].i, z__2.i = a[i__6].r * b[i__7].i + + a[i__6].i * b[i__7].r; + z__1.r = ct[i__5].r + z__2.r, z__1.i = ct[i__5].i + + z__2.i; + ct[i__4].r = z__1.r, ct[i__4].i = z__1.i; + i__4 = k + i__ * a_dim1; + i__5 = j + k * b_dim1; + g[i__] += ((d__1 = a[i__4].r, abs(d__1)) + (d__2 = + d_imag(&a[k + i__ * a_dim1]), abs(d__2))) + * ((d__3 = b[i__5].r, abs(d__3)) + (d__4 + = d_imag(&b[j + k * b_dim1]), abs(d__4))); +/* L180: */ + } +/* L190: */ + } + } + } + } + i__2 = *m; + for (i__ = 1; i__ <= i__2; ++i__) { + i__3 = i__; + i__4 = i__; + z__2.r = alpha->r * ct[i__4].r - alpha->i * ct[i__4].i, z__2.i = + alpha->r * ct[i__4].i + alpha->i * ct[i__4].r; + i__5 = i__ + j * c_dim1; + z__3.r = beta->r * c__[i__5].r - beta->i * c__[i__5].i, z__3.i = + beta->r * c__[i__5].i + beta->i * c__[i__5].r; + z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i; + ct[i__3].r = z__1.r, ct[i__3].i = z__1.i; + i__3 = i__ + j * c_dim1; + g[i__] = ((d__1 = alpha->r, abs(d__1)) + (d__2 = d_imag(alpha), + abs(d__2))) * g[i__] + ((d__3 = beta->r, abs(d__3)) + ( + d__4 = d_imag(beta), abs(d__4))) * ((d__5 = c__[i__3].r, + abs(d__5)) + (d__6 = d_imag(&c__[i__ + j * c_dim1]), abs( + d__6))); +/* L200: */ + } + +/* Compute the error ratio for this result. */ + + *err = 0.; + i__2 = *m; + for (i__ = 1; i__ <= i__2; ++i__) { + i__3 = i__; + i__4 = i__ + j * cc_dim1; + z__2.r = ct[i__3].r - cc[i__4].r, z__2.i = ct[i__3].i - cc[i__4] + .i; + z__1.r = z__2.r, z__1.i = z__2.i; + erri = ((d__1 = z__1.r, abs(d__1)) + (d__2 = d_imag(&z__1), abs( + d__2))) / *eps; + if (g[i__] != 0.) { + erri /= g[i__]; + } + *err = f2cmax(*err,erri); + if (*err * sqrt(*eps) >= 1.) { + goto L230; + } +/* L210: */ + } + +/* L220: */ + } + +/* If the loop completes, all results are at least half accurate. */ + goto L250; + +/* Report fatal error. */ + +L230: + *fatal = TRUE_; + io___409.ciunit = *nout; + s_wsfe(&io___409); + e_wsfe(); + i__1 = *m; + for (i__ = 1; i__ <= i__1; ++i__) { + if (*mv) { + io___410.ciunit = *nout; + s_wsfe(&io___410); + do_fio(&c__1, (char *)&i__, (ftnlen)sizeof(integer)); + do_fio(&c__2, (char *)&ct[i__], (ftnlen)sizeof(doublereal)); + do_fio(&c__2, (char *)&cc[i__ + j * cc_dim1], (ftnlen)sizeof( + doublereal)); + e_wsfe(); + } else { + io___411.ciunit = *nout; + s_wsfe(&io___411); + do_fio(&c__1, (char *)&i__, (ftnlen)sizeof(integer)); + do_fio(&c__2, (char *)&cc[i__ + j * cc_dim1], (ftnlen)sizeof( + doublereal)); + do_fio(&c__2, (char *)&ct[i__], (ftnlen)sizeof(doublereal)); + e_wsfe(); + } +/* L240: */ + } + if (*n > 1) { + io___412.ciunit = *nout; + s_wsfe(&io___412); + do_fio(&c__1, (char *)&j, (ftnlen)sizeof(integer)); + e_wsfe(); + } + +L250: + return 0; + + +/* End of ZMMCH. */ + +} /* zmmch_ */ + +logical lze_(doublecomplex *ri, doublecomplex *rj, integer *lr) +{ + /* System generated locals */ + integer i__1, i__2, i__3; + logical ret_val; + + /* Local variables */ + integer i__; + + +/* Tests if two arrays are identical. */ + +/* Auxiliary routine for test program for Level 3 Blas. */ + +/* -- Written on 8-February-1989. */ +/* Jack Dongarra, Argonne National Laboratory. */ +/* Iain Duff, AERE Harwell. */ +/* Jeremy Du Croz, Numerical Algorithms Group Ltd. */ +/* Sven Hammarling, Numerical Algorithms Group Ltd. */ + + /* Parameter adjustments */ + --rj; + --ri; + + /* Function Body */ + i__1 = *lr; + for (i__ = 1; i__ <= i__1; ++i__) { + i__2 = i__; + i__3 = i__; + if (ri[i__2].r != rj[i__3].r || ri[i__2].i != rj[i__3].i) { + goto L20; + } +/* L10: */ + } + ret_val = TRUE_; + goto L30; +L20: + ret_val = FALSE_; +L30: + return ret_val; + +/* End of LZE. */ + +} /* lze_ */ + +logical lzeres_(char *type__, char *uplo, integer *m, integer *n, + doublecomplex *aa, doublecomplex *as, integer *lda) +{ + /* System generated locals */ + integer aa_dim1, aa_offset, as_dim1, as_offset, i__1, i__2, i__3, i__4; + logical ret_val; + + /* Local variables */ + integer ibeg, iend, i__, j; + logical upper; + + +/* Tests if selected elements in two arrays are equal. */ + +/* TYPE is 'ge' or 'he' or 'sy'. */ + +/* Auxiliary routine for test program for Level 3 Blas. */ + +/* -- Written on 8-February-1989. */ +/* Jack Dongarra, Argonne National Laboratory. */ +/* Iain Duff, AERE Harwell. */ +/* Jeremy Du Croz, Numerical Algorithms Group Ltd. */ +/* Sven Hammarling, Numerical Algorithms Group Ltd. */ + + /* Parameter adjustments */ + as_dim1 = *lda; + as_offset = 1 + as_dim1 * 1; + as -= as_offset; + aa_dim1 = *lda; + aa_offset = 1 + aa_dim1 * 1; + aa -= aa_offset; + + /* Function Body */ + upper = *(unsigned char *)uplo == 'U'; + if (s_cmp(type__, "ge", (ftnlen)2, (ftnlen)2) == 0) { + i__1 = *n; + for (j = 1; j <= i__1; ++j) { + i__2 = *lda; + for (i__ = *m + 1; i__ <= i__2; ++i__) { + i__3 = i__ + j * aa_dim1; + i__4 = i__ + j * as_dim1; + if (aa[i__3].r != as[i__4].r || aa[i__3].i != as[i__4].i) { + goto L70; + } +/* L10: */ + } +/* L20: */ + } + } else if (s_cmp(type__, "he", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(type__, + "sy", (ftnlen)2, (ftnlen)2) == 0) { + i__1 = *n; + for (j = 1; j <= i__1; ++j) { + if (upper) { + ibeg = 1; + iend = j; + } else { + ibeg = j; + iend = *n; + } + i__2 = ibeg - 1; + for (i__ = 1; i__ <= i__2; ++i__) { + i__3 = i__ + j * aa_dim1; + i__4 = i__ + j * as_dim1; + if (aa[i__3].r != as[i__4].r || aa[i__3].i != as[i__4].i) { + goto L70; + } +/* L30: */ + } + i__2 = *lda; + for (i__ = iend + 1; i__ <= i__2; ++i__) { + i__3 = i__ + j * aa_dim1; + i__4 = i__ + j * as_dim1; + if (aa[i__3].r != as[i__4].r || aa[i__3].i != as[i__4].i) { + goto L70; + } +/* L40: */ + } +/* L50: */ + } + } + +/* L60: */ + ret_val = TRUE_; + goto L80; +L70: + ret_val = FALSE_; +L80: + return ret_val; + +/* End of LZERES. */ + +} /* lzeres_ */ + +/* Double Complex */ VOID zbeg_(doublecomplex * ret_val, logical *reset) +{ + /* System generated locals */ + doublereal d__1, d__2; + doublecomplex z__1; + + /* Local variables */ + static integer i__, j, ic, mi, mj; + + +/* Generates complex numbers as pairs of random numbers uniformly */ +/* distributed between -0.5 and 0.5. */ + +/* Auxiliary routine for test program for Level 3 Blas. */ + +/* -- Written on 8-February-1989. */ +/* Jack Dongarra, Argonne National Laboratory. */ +/* Iain Duff, AERE Harwell. */ +/* Jeremy Du Croz, Numerical Algorithms Group Ltd. */ +/* Sven Hammarling, Numerical Algorithms Group Ltd. */ + + if (*reset) { +/* Initialize local variables. */ + mi = 891; + mj = 457; + i__ = 7; + j = 7; + ic = 0; + *reset = FALSE_; + } + +/* The sequence of values of I or J is bounded between 1 and 999. */ +/* If initial I or J = 1,2,3,6,7 or 9, the period will be 50. */ +/* If initial I or J = 4 or 8, the period will be 25. */ +/* If initial I or J = 5, the period will be 10. */ +/* IC is used to break up the period by skipping 1 value of I or J */ +/* in 6. */ + + ++ic; +L10: + i__ *= mi; + j *= mj; + i__ -= i__ / 1000 * 1000; + j -= j / 1000 * 1000; + if (ic >= 5) { + ic = 0; + goto L10; + } + d__1 = (i__ - 500) / 1001.; + d__2 = (j - 500) / 1001.; + z__1.r = d__1, z__1.i = d__2; + ret_val->r = z__1.r, ret_val->i = z__1.i; + return ; + +/* End of ZBEG. */ + +} /* zbeg_ */ + +doublereal ddiff_(doublereal *x, doublereal *y) +{ + /* System generated locals */ + doublereal ret_val; + + +/* Auxiliary routine for test program for Level 3 Blas. */ + +/* -- Written on 8-February-1989. */ +/* Jack Dongarra, Argonne National Laboratory. */ +/* Iain Duff, AERE Harwell. */ +/* Jeremy Du Croz, Numerical Algorithms Group Ltd. */ +/* Sven Hammarling, Numerical Algorithms Group Ltd. */ + + ret_val = *x - *y; + return ret_val; + +/* End of DDIFF. */ + +} /* ddiff_ */ + +/* Main program alias */ int zblat3_ () { MAIN__ (); return 0; } From 175e357f5d576e493cba9f180ad78800462f0c3f Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Mon, 26 Feb 2024 14:19:50 +0100 Subject: [PATCH 185/311] run apt-get update before fetching Ubuntu packages --- .github/workflows/dynamic_arch.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/.github/workflows/dynamic_arch.yml b/.github/workflows/dynamic_arch.yml index 49721958a..669aa8116 100644 --- a/.github/workflows/dynamic_arch.yml +++ b/.github/workflows/dynamic_arch.yml @@ -42,6 +42,7 @@ jobs: - name: Install Dependencies run: | if [ "$RUNNER_OS" == "Linux" ]; then + sudo apt-get update sudo apt-get install -y gfortran cmake ccache libtinfo5 elif [ "$RUNNER_OS" == "macOS" ]; then # It looks like "gfortran" isn't working correctly unless "gcc" is re-installed. From a1ec94c258ac4151eb69012310e0f694f7067ea2 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Mon, 26 Feb 2024 17:46:07 +0100 Subject: [PATCH 186/311] Readd proper f2c'd sources for the GEMM3M tests --- ctest/c_cblat3c_3m.c | 1490 +++++-------------------- ctest/c_zblat3c_3m.c | 2454 +++++++++++++----------------------------- 2 files changed, 1043 insertions(+), 2901 deletions(-) diff --git a/ctest/c_cblat3c_3m.c b/ctest/c_cblat3c_3m.c index 9cfa26a41..b5d6bf9cb 100644 --- a/ctest/c_cblat3c_3m.c +++ b/ctest/c_cblat3c_3m.c @@ -10,25 +10,7 @@ #undef I #endif -#if defined(_WIN64) -typedef long long BLASLONG; -typedef unsigned long long BLASULONG; -#else -typedef long BLASLONG; -typedef unsigned long BLASULONG; -#endif - -#ifdef LAPACK_ILP64 -typedef BLASLONG blasint; -#if defined(_WIN64) -#define blasabs(x) llabs(x) -#else -#define blasabs(x) labs(x) -#endif -#else -typedef int blasint; -#define blasabs(x) abs(x) -#endif +#include "common.h" typedef blasint integer; @@ -247,7 +229,6 @@ typedef struct Namelist Namelist; #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; #define z_abs(z) (cabs(Cd(z))) #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} @@ -261,259 +242,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ #define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef logical (*L_fp)(...); -#else -typedef logical (*L_fp)(); -#endif - -static float spow_ui(float x, integer n) { - float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static double dpow_ui(double x, integer n) { - double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#ifdef _MSC_VER -static _Fcomplex cpow_ui(complex x, integer n) { - complex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; - for(u = n; ; ) { - if(u & 01) pow.r *= x.r, pow.i *= x.i; - if(u >>= 1) x.r *= x.r, x.i *= x.i; - else break; - } - } - _Fcomplex p={pow.r, pow.i}; - return p; -} -#else -static _Complex float cpow_ui(_Complex float x, integer n) { - _Complex float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -#ifdef _MSC_VER -static _Dcomplex zpow_ui(_Dcomplex x, integer n) { - _Dcomplex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; - for(u = n; ; ) { - if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; - if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; - else break; - } - } - _Dcomplex p = {pow._Val[0], pow._Val[1]}; - return p; -} -#else -static _Complex double zpow_ui(_Complex double x, integer n) { - _Complex double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -static integer pow_ii(integer x, integer n) { - integer pow; unsigned long int u; - if (n <= 0) { - if (n == 0 || x == 1) pow = 1; - else if (x != -1) pow = x == 0 ? 1/x : 0; - else n = -n; - } - if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { - u = n; - for(pow = 1; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static integer dmaxloc_(double *w, integer s, integer e, integer *n) -{ - double m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static integer smaxloc_(float *w, integer s, integer e, integer *n) -{ - float m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { - integer n = *n_, incx = *incx_, incy = *incy_, i; -#ifdef _MSC_VER - _Fcomplex zdotc = {0.0, 0.0}; - if (incx == 1 && incy == 1) { - for (i=0;i= 0; if (trace) { - o__1.oerr = 0; +/* o__1.oerr = 0; o__1.ounit = ntra; o__1.ofnmlen = 32; o__1.ofnm = snaps; @@ -774,147 +411,122 @@ static logical c_false = FALSE_; o__1.oacc = 0; o__1.ofm = 0; o__1.oblnk = 0; - f_open(&o__1); + f_open(&o__1);*/ } /* Read the flag that directs rewinding of the snapshot file. */ - s_rsle(&io___7); - do_lio(&c__8, &c__1, (char *)&rewi, (ftnlen)sizeof(logical)); - e_rsle(); - rewi = rewi && trace; + fgets(line,80,stdin); + sscanf(line,"%d",&rewi); + rewi = rewi && trace; /* Read the flag that directs stopping on any failure. */ - s_rsle(&io___9); - do_lio(&c__8, &c__1, (char *)&sfatal, (ftnlen)sizeof(logical)); - e_rsle(); -/* Read the flag that indicates whether error exits are to be tested. */ - s_rsle(&io___11); - do_lio(&c__8, &c__1, (char *)&tsterr, (ftnlen)sizeof(logical)); - e_rsle(); -/* Read the flag that indicates whether row-major data layout to be tested. */ - s_rsle(&io___13); - do_lio(&c__3, &c__1, (char *)&layout, (ftnlen)sizeof(integer)); - e_rsle(); -/* Read the threshold value of the test ratio */ - s_rsle(&io___15); - do_lio(&c__4, &c__1, (char *)&thresh, (ftnlen)sizeof(real)); - e_rsle(); + fgets(line,80,stdin); + sscanf(line,"%c",&tmpchar); + sfatal=FALSE_; + if (tmpchar=='T')sfatal=TRUE_; + fgets(line,80,stdin); + sscanf(line,"%c",&tmpchar); + tsterr=FALSE_; + if (tmpchar=='T')tsterr=TRUE_; + fgets(line,80,stdin); + sscanf(line,"%d",&layout); + fgets(line,80,stdin); + sscanf(line,"%f",&thresh); + /* Read and check the parameter values for the tests. */ /* Values of N */ - s_rsle(&io___17); - do_lio(&c__3, &c__1, (char *)&nidim, (ftnlen)sizeof(integer)); - e_rsle(); + fgets(line,80,stdin); +#ifdef USE64BITINT + sscanf(line,"%ld",&nidim); +#else + sscanf(line,"%d",&nidim); +#endif + if (nidim < 1 || nidim > 9) { - s_wsfe(&io___19); - do_fio(&c__1, "N", (ftnlen)1); - do_fio(&c__1, (char *)&c__9, (ftnlen)sizeof(integer)); - e_wsfe(); + fprintf(stderr,"NUMBER OF VALUES OF N IS LESS THAN 1 OR GREATER THAN 9"); goto L220; } - s_rsle(&io___20); - i__1 = nidim; - for (i__ = 1; i__ <= i__1; ++i__) { - do_lio(&c__3, &c__1, (char *)&idim[i__ - 1], (ftnlen)sizeof(integer)); - } - e_rsle(); + fgets(line,80,stdin); +#ifdef USE64BITINT + sscanf(line,"%ld %ld %ld %ld %ld %ld %ld %ld %ld",&idim[0],&idim[1],&idim[2], + &idim[3],&idim[4],&idim[5],&idim[6],&idim[7],&idim[8]); +#else + sscanf(line,"%d %d %d %d %d %d %d %d %d",&idim[0],&idim[1],&idim[2], + &idim[3],&idim[4],&idim[5],&idim[6],&idim[7],&idim[8]); +#endif i__1 = nidim; for (i__ = 1; i__ <= i__1; ++i__) { if (idim[i__ - 1] < 0 || idim[i__ - 1] > 65) { - s_wsfe(&io___23); - do_fio(&c__1, (char *)&c__65, (ftnlen)sizeof(integer)); - e_wsfe(); + fprintf(stderr,"VALUE OF N IS LESS THAN 0 OR GREATER THAN 65\n"); goto L220; } /* L10: */ } /* Values of ALPHA */ - s_rsle(&io___24); - do_lio(&c__3, &c__1, (char *)&nalf, (ftnlen)sizeof(integer)); - e_rsle(); + fgets(line,80,stdin); +#ifdef USE64BITINT + sscanf(line,"%ld",&nalf); +#else + sscanf(line,"%d",&nalf); +#endif if (nalf < 1 || nalf > 7) { - s_wsfe(&io___26); - do_fio(&c__1, "ALPHA", (ftnlen)5); - do_fio(&c__1, (char *)&c__7, (ftnlen)sizeof(integer)); - e_wsfe(); + fprintf(stderr,"VALUE OF ALPHA IS LESS THAN 0 OR GREATER THAN 7\n"); goto L220; } - s_rsle(&io___27); - i__1 = nalf; - for (i__ = 1; i__ <= i__1; ++i__) { - do_lio(&c__6, &c__1, (char *)&alf[i__ - 1], (ftnlen)sizeof(complex)); - } - e_rsle(); + fgets(line,80,stdin); + sscanf(line,"(%f,%f) (%f,%f) (%f,%f) (%f,%f) (%f,%f) (%f,%f) (%f,%f)",&alf[0].r,&alf[0].i,&alf[1].r,&alf[1].i,&alf[2].r,&alf[2].i,&alf[3].r,&alf[3].i, + &alf[4].r,&alf[4].i,&alf[5].r,&alf[5].i,&alf[6].r,&alf[6].i); + +// i__1 = nalf; +// for (i__ = 1; i__ <= i__1; ++i__) { +// do_lio(&c__6, &c__1, (char *)&alf[i__ - 1], (ftnlen)sizeof(complex)); +// } /* Values of BETA */ - s_rsle(&io___29); - do_lio(&c__3, &c__1, (char *)&nbet, (ftnlen)sizeof(integer)); - e_rsle(); - if (nbet < 1 || nbet > 7) { - s_wsfe(&io___31); - do_fio(&c__1, "BETA", (ftnlen)4); - do_fio(&c__1, (char *)&c__7, (ftnlen)sizeof(integer)); - e_wsfe(); + fgets(line,80,stdin); +#ifdef USE64BITINT + sscanf(line,"%ld",&nbet); +#else + sscanf(line,"%d",&nbet); +#endif + if (nalf < 1 || nbet > 7) { + fprintf(stderr,"VALUE OF BETA IS LESS THAN 0 OR GREATER THAN 7\n"); goto L220; } - s_rsle(&io___32); - i__1 = nbet; - for (i__ = 1; i__ <= i__1; ++i__) { - do_lio(&c__6, &c__1, (char *)&bet[i__ - 1], (ftnlen)sizeof(complex)); - } - e_rsle(); + fgets(line,80,stdin); + sscanf(line,"(%f,%f) (%f,%f) (%f,%f) (%f,%f) (%f,%f) (%f,%f) (%f,%f)",&bet[0].r,&bet[0].i,&bet[1].r,&bet[1].i,&bet[2].r,&bet[2].i,&bet[3].r,&bet[3].i, + &bet[4].r,&bet[4].i,&bet[5].r,&bet[5].i,&bet[6].r,&bet[6].i); + /* Report values of parameters. */ - s_wsfe(&io___34); - e_wsfe(); - s_wsfe(&io___35); - i__1 = nidim; - for (i__ = 1; i__ <= i__1; ++i__) { - do_fio(&c__1, (char *)&idim[i__ - 1], (ftnlen)sizeof(integer)); - } - e_wsfe(); - s_wsfe(&io___36); - i__1 = nalf; - for (i__ = 1; i__ <= i__1; ++i__) { - do_fio(&c__2, (char *)&alf[i__ - 1], (ftnlen)sizeof(real)); - } - e_wsfe(); - s_wsfe(&io___37); - i__1 = nbet; - for (i__ = 1; i__ <= i__1; ++i__) { - do_fio(&c__2, (char *)&bet[i__ - 1], (ftnlen)sizeof(real)); - } - e_wsfe(); + printf("TESTS OF THE COMPLEX LEVEL 3 BLAS\nTHE FOLLOWING PARAMETER VALUES WILL BE USED:\n"); + printf(" FOR N"); + for (i__ =1; i__ <=nidim;++i__) printf(" %d",idim[i__-1]); + printf("\n"); + printf(" FOR ALPHA"); + for (i__ =1; i__ <=nalf;++i__) printf(" (%f,%f)",alf[i__-1].r,alf[i__-1].i); + printf("\n"); + printf(" FOR BETA"); + for (i__ =1; i__ <=nbet;++i__) printf(" (%f,%f)",bet[i__-1].r,bet[i__-1].i); + printf("\n"); + if (! tsterr) { - s_wsle(&io___38); - e_wsle(); - s_wsfe(&io___39); - e_wsfe(); + printf(" ERROR-EXITS WILL NOT BE TESTED\n"); } - s_wsle(&io___40); - e_wsle(); - s_wsfe(&io___41); - do_fio(&c__1, (char *)&thresh, (ftnlen)sizeof(real)); - e_wsfe(); - s_wsle(&io___42); - e_wsle(); + printf("ROUTINES PASS COMPUTATIONAL TESTS IF TEST RATIO IS LESS THAN %f\n",thresh); rorder = FALSE_; corder = FALSE_; if (layout == 2) { rorder = TRUE_; corder = TRUE_; - s_wsfe(&io___45); - e_wsfe(); + printf("COLUMN-MAJOR AND ROW-MAJOR DATA LAYOUTS ARE TESTED\n"); } else if (layout == 1) { rorder = TRUE_; - s_wsfe(&io___46); - e_wsfe(); + printf("ROW-MAJOR DATA LAYOUT IS TESTED\n"); } else if (layout == 0) { corder = TRUE_; - s_wsfe(&io___47); - e_wsfe(); + printf("COLUMN-MAJOR DATA LAYOUT IS TESTED\n"); } - s_wsle(&io___48); - e_wsle(); /* Read names of subroutines and flags which indicate */ /* whether they are to be tested. */ @@ -924,42 +536,33 @@ static logical c_false = FALSE_; /* L20: */ } L30: - i__1 = s_rsfe(&io___50); - if (i__1 != 0) { + if (! fgets(line,80,stdin)) { goto L60; } - i__1 = do_fio(&c__1, snamet, (ftnlen)13); - if (i__1 != 0) { - goto L60; - } - i__1 = do_fio(&c__1, (char *)<estt, (ftnlen)sizeof(logical)); - if (i__1 != 0) { - goto L60; - } - i__1 = e_rsfe(); - if (i__1 != 0) { + i__1 = sscanf(line,"%12c %c",snamet,&tmpchar); + ltestt=FALSE_; + if (tmpchar=='T')ltestt=TRUE_; + if (i__1 < 2) { goto L60; } for (i__ = 1; i__ <= 9; ++i__) { - if (s_cmp(snamet, snames + (i__ - 1) * 13, (ftnlen)13, (ftnlen)13) == + if (s_cmp(snamet, snames[i__ - 1] , (ftnlen)12, (ftnlen)12) == 0) { goto L50; } /* L40: */ } - s_wsfe(&io___53); - do_fio(&c__1, snamet, (ftnlen)13); - e_wsfe(); - s_stop("", (ftnlen)0); + printf("SUBPROGRAM NAME %s NOT RECOGNIZED\n****** TESTS ABANDONED ******\n",snamet); + exit(1); L50: ltest[i__ - 1] = ltestt; goto L30; L60: - cl__1.cerr = 0; +/* cl__1.cerr = 0; cl__1.cunit = 5; cl__1.csta = 0; - f_clos(&cl__1); + f_clos(&cl__1);*/ /* Compute EPS (the machine precision). */ @@ -973,9 +576,7 @@ L70: goto L70; L80: eps += eps; - s_wsfe(&io___55); - do_fio(&c__1, (char *)&eps, (ftnlen)sizeof(real)); - e_wsfe(); + printf("RELATIVE MACHINE PRECISION IS TAKEN TO BE %9.1g\n",eps); /* Check the reliability of CMMCH using exact data. */ @@ -1015,13 +616,12 @@ L80: &c__6, &c_true); same = lce_(cc, ct, &n); if (! same || err != 0.f) { - s_wsfe(&io___68); - do_fio(&c__1, transa, (ftnlen)1); - do_fio(&c__1, transb, (ftnlen)1); - do_fio(&c__1, (char *)&same, (ftnlen)sizeof(logical)); - do_fio(&c__1, (char *)&err, (ftnlen)sizeof(real)); - e_wsfe(); - s_stop("", (ftnlen)0); + printf("ERROR IN CMMCH - IN-LINE DOT PRODUCTS ARE BEING EVALUATED WRONGLY\n"); + printf("CMMCH WAS CALLED WITH TRANSA = %s AND TRANSB = %s\n", transa,transb); + printf("AND RETURNED SAME = %c AND ERR = %12.3f.\n",(same==FALSE_? 'F':'T'),err); + printf("THIS MAY BE DUE TO FAULTS IN THE ARITHMETIC OR THE COMPILER.\n"); + printf("****** TESTS ABANDONED ******\n"); + exit(1); } *(unsigned char *)transb = 'C'; cmmch_(transa, transb, &n, &c__1, &n, &c_b2, ab, &c__65, &ab[4225], & @@ -1029,13 +629,12 @@ L80: &c__6, &c_true); same = lce_(cc, ct, &n); if (! same || err != 0.f) { - s_wsfe(&io___69); - do_fio(&c__1, transa, (ftnlen)1); - do_fio(&c__1, transb, (ftnlen)1); - do_fio(&c__1, (char *)&same, (ftnlen)sizeof(logical)); - do_fio(&c__1, (char *)&err, (ftnlen)sizeof(real)); - e_wsfe(); - s_stop("", (ftnlen)0); + printf("ERROR IN CMMCH - IN-LINE DOT PRODUCTS ARE BEING EVALUATED WRONGLY\n"); + printf("CMMCH WAS CALLED WITH TRANSA = %s AND TRANSB = %s\n", transa,transb); + printf("AND RETURNED SAME = %c AND ERR = %12.3f.\n",(same==FALSE_? 'F':'T'),err); + printf("THIS MAY BE DUE TO FAULTS IN THE ARITHMETIC OR THE COMPILER.\n"); + printf("****** TESTS ABANDONED ******\n"); + exit(1); } i__1 = n; for (j = 1; j <= i__1; ++j) { @@ -1061,13 +660,12 @@ L80: &c__6, &c_true); same = lce_(cc, ct, &n); if (! same || err != 0.f) { - s_wsfe(&io___70); - do_fio(&c__1, transa, (ftnlen)1); - do_fio(&c__1, transb, (ftnlen)1); - do_fio(&c__1, (char *)&same, (ftnlen)sizeof(logical)); - do_fio(&c__1, (char *)&err, (ftnlen)sizeof(real)); - e_wsfe(); - s_stop("", (ftnlen)0); + printf("ERROR IN CMMCH - IN-LINE DOT PRODUCTS ARE BEING EVALUATED WRONGLY\n"); + printf("CMMCH WAS CALLED WITH TRANSA = %s AND TRANSB = %s\n", transa,transb); + printf("AND RETURNED SAME = %c AND ERR = %12.3f.\n",(same==FALSE_? 'F':'T'),err); + printf("THIS MAY BE DUE TO FAULTS IN THE ARITHMETIC OR THE COMPILER.\n"); + printf("****** TESTS ABANDONED ******\n"); + exit(1); } *(unsigned char *)transb = 'C'; cmmch_(transa, transb, &n, &c__1, &n, &c_b2, ab, &c__65, &ab[4225], & @@ -1075,33 +673,26 @@ L80: &c__6, &c_true); same = lce_(cc, ct, &n); if (! same || err != 0.f) { - s_wsfe(&io___71); - do_fio(&c__1, transa, (ftnlen)1); - do_fio(&c__1, transb, (ftnlen)1); - do_fio(&c__1, (char *)&same, (ftnlen)sizeof(logical)); - do_fio(&c__1, (char *)&err, (ftnlen)sizeof(real)); - e_wsfe(); - s_stop("", (ftnlen)0); + printf("ERROR IN CMMCH - IN-LINE DOT PRODUCTS ARE BEING EVALUATED WRONGLY\n"); + printf("CMMCH WAS CALLED WITH TRANSA = %s AND TRANSB = %s\n", transa,transb); + printf("AND RETURNED SAME = %c AND ERR = %12.3f.\n",(same==FALSE_? 'F':'T'),err); + printf("THIS MAY BE DUE TO FAULTS IN THE ARITHMETIC OR THE COMPILER.\n"); + printf("****** TESTS ABANDONED ******\n"); + exit(1); } /* Test each subroutine in turn. */ for (isnum = 1; isnum <= 9; ++isnum) { - s_wsle(&io___73); - e_wsle(); if (! ltest[isnum - 1]) { /* Subprogram is not to be tested. */ - s_wsfe(&io___74); - do_fio(&c__1, snames + (isnum - 1) * 13, (ftnlen)13); - e_wsfe(); + printf("%12s WAS NOT TESTED\n",snames[isnum-1]); } else { - s_copy(srnamc_1.srnamt, snames + (isnum - 1) * 13, (ftnlen)13, ( - ftnlen)13); + s_copy(srnamc_1.srnamt, snames[isnum - 1], (ftnlen)12, ( + ftnlen)12); /* Test error exits. */ if (tsterr) { - cc3chke_(snames + (isnum - 1) * 13); - s_wsle(&io___75); - e_wsle(); + cc3chke_(snames[isnum - 1]); } /* Test computations. */ infoc_1.infot = 0; @@ -1121,13 +712,13 @@ L80: /* Test CGEMM, 01. */ L140: if (corder) { - cchk1_(snames + (isnum - 1) * 13, &eps, &thresh, &c__6, &ntra, + cchk1_(snames[isnum - 1], &eps, &thresh, &c__6, &ntra, &trace, &rewi, &fatal, &nidim, idim, &nalf, alf, & nbet, bet, &c__65, ab, aa, as, &ab[4225], bb, bs, c__, cc, cs, ct, g, &c__0); } if (rorder) { - cchk1_(snames + (isnum - 1) * 13, &eps, &thresh, &c__6, &ntra, + cchk1_(snames[isnum - 1], &eps, &thresh, &c__6, &ntra, &trace, &rewi, &fatal, &nidim, idim, &nalf, alf, & nbet, bet, &c__65, ab, aa, as, &ab[4225], bb, bs, c__, cc, cs, ct, g, &c__1); @@ -1136,13 +727,13 @@ L140: /* Test CHEMM, 02, CSYMM, 03. */ L150: if (corder) { - cchk2_(snames + (isnum - 1) * 13, &eps, &thresh, &c__6, &ntra, + cchk2_(snames[isnum - 1], &eps, &thresh, &c__6, &ntra, &trace, &rewi, &fatal, &nidim, idim, &nalf, alf, & nbet, bet, &c__65, ab, aa, as, &ab[4225], bb, bs, c__, cc, cs, ct, g, &c__0); } if (rorder) { - cchk2_(snames + (isnum - 1) * 13, &eps, &thresh, &c__6, &ntra, + cchk2_(snames[isnum - 1], &eps, &thresh, &c__6, &ntra, &trace, &rewi, &fatal, &nidim, idim, &nalf, alf, & nbet, bet, &c__65, ab, aa, as, &ab[4225], bb, bs, c__, cc, cs, ct, g, &c__1); @@ -1151,13 +742,13 @@ L150: /* Test CTRMM, 04, CTRSM, 05. */ L160: if (corder) { - cchk3_(snames + (isnum - 1) * 13, &eps, &thresh, &c__6, &ntra, + cchk3_(snames[isnum - 1], &eps, &thresh, &c__6, &ntra, &trace, &rewi, &fatal, &nidim, idim, &nalf, alf, & c__65, ab, aa, as, &ab[4225], bb, bs, ct, g, c__, & c__0); } if (rorder) { - cchk3_(snames + (isnum - 1) * 13, &eps, &thresh, &c__6, &ntra, + cchk3_(snames[isnum - 1], &eps, &thresh, &c__6, &ntra, &trace, &rewi, &fatal, &nidim, idim, &nalf, alf, & c__65, ab, aa, as, &ab[4225], bb, bs, ct, g, c__, & c__1); @@ -1166,13 +757,13 @@ L160: /* Test CHERK, 06, CSYRK, 07. */ L170: if (corder) { - cchk4_(snames + (isnum - 1) * 13, &eps, &thresh, &c__6, &ntra, + cchk4_(snames[isnum - 1], &eps, &thresh, &c__6, &ntra, &trace, &rewi, &fatal, &nidim, idim, &nalf, alf, & nbet, bet, &c__65, ab, aa, as, &ab[4225], bb, bs, c__, cc, cs, ct, g, &c__0); } if (rorder) { - cchk4_(snames + (isnum - 1) * 13, &eps, &thresh, &c__6, &ntra, + cchk4_(snames[isnum - 1], &eps, &thresh, &c__6, &ntra, &trace, &rewi, &fatal, &nidim, idim, &nalf, alf, & nbet, bet, &c__65, ab, aa, as, &ab[4225], bb, bs, c__, cc, cs, ct, g, &c__1); @@ -1181,13 +772,13 @@ L170: /* Test CHER2K, 08, CSYR2K, 09. */ L180: if (corder) { - cchk5_(snames + (isnum - 1) * 13, &eps, &thresh, &c__6, &ntra, + cchk5_(snames[isnum - 1], &eps, &thresh, &c__6, &ntra, &trace, &rewi, &fatal, &nidim, idim, &nalf, alf, & nbet, bet, &c__65, ab, aa, as, bb, bs, c__, cc, cs, ct, g, w, &c__0); } if (rorder) { - cchk5_(snames + (isnum - 1) * 13, &eps, &thresh, &c__6, &ntra, + cchk5_(snames[isnum - 1], &eps, &thresh, &c__6, &ntra, &trace, &rewi, &fatal, &nidim, idim, &nalf, alf, & nbet, bet, &c__65, ab, aa, as, bb, bs, c__, cc, cs, ct, g, w, &c__1); @@ -1201,32 +792,29 @@ L190: } /* L200: */ } - s_wsfe(&io___82); - e_wsfe(); + printf("\nEND OF TESTS\n"); goto L230; L210: - s_wsfe(&io___83); - e_wsfe(); + printf("\n****** FATAL ERROR - TESTS ABANDONED ******\n"); goto L230; L220: - s_wsfe(&io___84); - e_wsfe(); - + printf("AMEND DATA FILE OR INCREASE ARRAY SIZES IN PROGRAM\n"); + printf("****** TESTS ABANDONED ******\n"); L230: if (trace) { - cl__1.cerr = 0; +/* cl__1.cerr = 0; cl__1.cunit = ntra; cl__1.csta = 0; - f_clos(&cl__1); + f_clos(&cl__1);*/ } - cl__1.cerr = 0; +/* cl__1.cerr = 0; cl__1.cunit = 6; cl__1.csta = 0; f_clos(&cl__1); - s_stop("", (ftnlen)0); - + s_stop("", (ftnlen)0);*/ + exit(0); /* End of CBLAT3. */ @@ -1244,30 +832,9 @@ L230: static char ich[3] = "NTC"; - /* Format strings */ - static char fmt_9994[] = "(\002 ****** FATAL ERROR - ERROR-CALL MYEXIT T" - "AKEN ON VALID\002,\002 CALL ******\002)"; - static char fmt_9998[] = "(\002 ******* FATAL ERROR - PARAMETER NUMBER" - " \002,i2,\002 WAS CH\002,\002ANGED INCORRECTLY *******\002)"; - static char fmt_10000[] = "(\002 \002,a13,\002 PASSED THE COLUMN-MAJOR C" - "OMPUTATIONAL TESTS\002,\002 (\002,i6,\002 CALL\002,\002S)\002)"; - static char fmt_10001[] = "(\002 \002,a13,\002 PASSED THE ROW-MAJOR C" - "OMPUTATIONAL TESTS\002,\002 (\002,i6,\002 CALL\002,\002S)\002)"; - static char fmt_10002[] = "(\002 \002,a13,\002 COMPLETED THE COLUMN-MAJO" - "R COMPUTATIONAL \002,\002TESTS (\002,i6,\002 CALLS)\002,/\002 **" - "***** BUT WITH MAXIMUM TEST \002,\002RATIO \002,f8.2,\002 - SUSP" - "ECT *******\002)"; - static char fmt_10003[] = "(\002 \002,a13,\002 COMPLETED THE ROW-MAJOR " - " COMPUTATIONAL \002,\002TESTS (\002,i6,\002 CALLS)\002,/\002 **" - "***** BUT WITH MAXIMUM TEST \002,\002RATIO \002,f8.2,\002 - SUSP" - "ECT *******\002)"; - static char fmt_9996[] = "(\002 ******* \002,a13,\002 FAILED ON CALL NUM" - "BER:\002)"; - /* System generated locals */ integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2, i__3, i__4, i__5, i__6, i__7, i__8; - alist al__1; /* Local variables */ complex beta; @@ -1288,7 +855,11 @@ L230: extern /* Subroutine */ int cprcn1_(integer *, integer *, char *, integer *, char *, char *, integer *, integer *, integer *, complex *, integer *, integer *, complex *, integer *); - integer ia, ib, ma, mb, na, nb, nc, ik, im, in, ks, ms, ns; + integer ia, ib, ma, mb, na, nb, nc, ik, im, in; + extern /* Subroutine */ int ccgemm3m_(integer *, char *, char *, integer *, + integer *, integer *, complex *, complex *, integer *, complex *, + integer *, complex *, complex *, integer *); + integer ks, ms, ns; extern logical lceres_(char *, char *, integer *, integer *, complex *, complex *, integer *); char tranas[1], tranbs[1], transa[1], transb[1]; @@ -1297,20 +868,6 @@ L230: extern logical lce_(complex *, complex *, integer *); complex als, bls; real err; - extern /* Subroutine */ int ccgemm3m_(integer *, char *, char *, integer * - , integer *, integer *, complex *, complex *, integer *, complex * - , integer *, complex *, complex *, integer *); - - /* Fortran I/O blocks */ - static cilist io___128 = { 0, 0, 0, fmt_9994, 0 }; - static cilist io___131 = { 0, 0, 0, fmt_9998, 0 }; - static cilist io___133 = { 0, 0, 0, fmt_10000, 0 }; - static cilist io___134 = { 0, 0, 0, fmt_10001, 0 }; - static cilist io___135 = { 0, 0, 0, fmt_10002, 0 }; - static cilist io___136 = { 0, 0, 0, fmt_10003, 0 }; - static cilist io___137 = { 0, 0, 0, fmt_9996, 0 }; - - /* Tests CGEMM. */ @@ -1497,20 +1054,21 @@ L230: &ldb, &beta, &ldc); } if (*rewi) { - al__1.aerr = 0; +/* al__1.aerr = 0; al__1.aunit = *ntra; - f_rew(&al__1); + f_rew(&al__1); */ } - ccgemm3m_(iorder, transa, transb, &m, &n, &k, - &alpha, &aa[1], &lda, &bb[1], &ldb, & + ccgemm3m_(iorder, transa, transb, &m, &n, &k, & + alpha, &aa[1], &lda, &bb[1], &ldb, & beta, &cc[1], &ldc); /* Check if error-exit was taken incorrectly. */ if (! infoc_1.ok) { - io___128.ciunit = *nout; - s_wsfe(&io___128); - e_wsfe(); +// io___128.ciunit = *nout; +// s_wsfe(&io___128); +// e_wsfe(); + printf(" *** FATAL ERROR - ERROR-CALL MYEXIT TAKEN ON VALID CALL\n"); *fatal = TRUE_; goto L120; } @@ -1548,11 +1106,7 @@ L230: for (i__ = 1; i__ <= i__6; ++i__) { same = same && isame[i__ - 1]; if (! isame[i__ - 1]) { - io___131.ciunit = *nout; - s_wsfe(&io___131); - do_fio(&c__1, (char *)&i__, (ftnlen) - sizeof(integer)); - e_wsfe(); + printf(" ******* FATAL ERROR - PARAMETER NUMBER %d WAS CHANGED INCORRECTLY *******\n",i__);; } /* L40: */ } @@ -1606,51 +1160,34 @@ L100: if (errmax < *thresh) { if (*iorder == 0) { - io___133.ciunit = *nout; - s_wsfe(&io___133); - do_fio(&c__1, sname, (ftnlen)13); - do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer)); - e_wsfe(); + printf("%s PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS (%d CALLS)\n",sname,nc); } if (*iorder == 1) { - io___134.ciunit = *nout; - s_wsfe(&io___134); - do_fio(&c__1, sname, (ftnlen)13); - do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer)); - e_wsfe(); + printf("%s PASSED THE ROW-MAJOR COMPUTATIONAL TESTS (%d CALLS)\n",sname,nc); } } else { if (*iorder == 0) { - io___135.ciunit = *nout; - s_wsfe(&io___135); - do_fio(&c__1, sname, (ftnlen)13); - do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer)); - do_fio(&c__1, (char *)&errmax, (ftnlen)sizeof(real)); - e_wsfe(); + printf("%s COMPLETED THE COLUMN-MAJOR COMPUTATIONAL TESTS (%d CALLS)/n",sname,nc); + printf("***** BUT WITH MAXIMUM TEST RATIO %8.2f - SUSPECT *******/n",errmax); } if (*iorder == 1) { - io___136.ciunit = *nout; - s_wsfe(&io___136); - do_fio(&c__1, sname, (ftnlen)13); - do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer)); - do_fio(&c__1, (char *)&errmax, (ftnlen)sizeof(real)); - e_wsfe(); + printf("%s COMPLETED THE ROW-MAJOR COMPUTATIONAL TESTS (%d CALLS)/n",sname,nc); + printf("***** BUT WITH MAXIMUM TEST RATIO %8.2f - SUSPECT *******/n",errmax); } } goto L130; L120: - io___137.ciunit = *nout; - s_wsfe(&io___137); - do_fio(&c__1, sname, (ftnlen)13); - e_wsfe(); + printf(" ******* %s FAILED ON CALL NUMBER:\n",sname); cprcn1_(nout, &nc, sname, iorder, transa, transb, &m, &n, &k, &alpha, & lda, &ldb, &beta, &ldc); L130: return 0; -/* L9995: */ +/* 9995 FORMAT( 1X, I6, ': ', A12,'(''', A1, ''',''', A1, ''',', */ +/* $ 3( I3, ',' ), '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3, */ +/* $ ',(', F4.1, ',', F4.1, '), C,', I3, ').' ) */ /* End of CCHK1. */ @@ -1662,21 +1199,9 @@ L130: k, complex *alpha, integer *lda, integer *ldb, complex *beta, integer *ldc) { - /* Format strings */ - static char fmt_9995[] = "(1x,i6,\002: \002,a13,\002(\002,a14,\002,\002," - "a14,\002,\002,a14,\002,\002)"; - static char fmt_9994[] = "(10x,3(i3,\002,\002),\002 (\002,f4.1,\002,\002" - ",f4.1,\002) , A,\002,i3,\002, B,\002,i3,\002, (\002,f4.1,\002" - ",\002,f4.1,\002) , C,\002,i3,\002).\002)"; - /* Local variables */ char crc[14], cta[14], ctb[14]; - /* Fortran I/O blocks */ - static cilist io___141 = { 0, 0, 0, fmt_9995, 0 }; - static cilist io___142 = { 0, 0, 0, fmt_9994, 0 }; - - if (*(unsigned char *)transa == 'N') { s_copy(cta, " CblasNoTrans", (ftnlen)14, (ftnlen)14); } else if (*(unsigned char *)transa == 'T') { @@ -1696,25 +1221,8 @@ L130: } else { s_copy(crc, " CblasColMajor", (ftnlen)14, (ftnlen)14); } - io___141.ciunit = *nout; - s_wsfe(&io___141); - do_fio(&c__1, (char *)&(*nc), (ftnlen)sizeof(integer)); - do_fio(&c__1, sname, (ftnlen)13); - do_fio(&c__1, crc, (ftnlen)14); - do_fio(&c__1, cta, (ftnlen)14); - do_fio(&c__1, ctb, (ftnlen)14); - e_wsfe(); - io___142.ciunit = *nout; - s_wsfe(&io___142); - do_fio(&c__1, (char *)&(*m), (ftnlen)sizeof(integer)); - do_fio(&c__1, (char *)&(*n), (ftnlen)sizeof(integer)); - do_fio(&c__1, (char *)&(*k), (ftnlen)sizeof(integer)); - do_fio(&c__2, (char *)&(*alpha), (ftnlen)sizeof(real)); - do_fio(&c__1, (char *)&(*lda), (ftnlen)sizeof(integer)); - do_fio(&c__1, (char *)&(*ldb), (ftnlen)sizeof(integer)); - do_fio(&c__2, (char *)&(*beta), (ftnlen)sizeof(real)); - do_fio(&c__1, (char *)&(*ldc), (ftnlen)sizeof(integer)); - e_wsfe(); + printf("%6d: %s %s %s %s\n",*nc,sname,crc,cta,ctb); + printf("%d %d %d (%4.1f,%4.1f) , A, %d, B, %d, (%4.1f,%4.1f) , C, %d.\n",*m,*n,*k,alpha->r,alpha->i,*lda,*ldb,beta->r,beta->i,*ldc); return 0; } /* cprcn1_ */ @@ -1731,30 +1239,9 @@ L130: static char ichs[2] = "LR"; static char ichu[2] = "UL"; - /* Format strings */ - static char fmt_9994[] = "(\002 ******* FATAL ERROR - ERROR-CALL MYEXIT " - "TAKEN ON VALID\002,\002 CALL *******\002)"; - static char fmt_9998[] = "(\002 ******* FATAL ERROR - PARAMETER NUMBER" - " \002,i2,\002 WAS CH\002,\002ANGED INCORRECTLY *******\002)"; - static char fmt_10000[] = "(\002 \002,a13,\002 PASSED THE COLUMN-MAJOR C" - "OMPUTATIONAL TESTS\002,\002 (\002,i6,\002 CALL\002,\002S)\002)"; - static char fmt_10001[] = "(\002 \002,a13,\002 PASSED THE ROW-MAJOR C" - "OMPUTATIONAL TESTS\002,\002 (\002,i6,\002 CALL\002,\002S)\002)"; - static char fmt_10002[] = "(\002 \002,a13,\002 COMPLETED THE COLUMN-MAJO" - "R COMPUTATIONAL \002,\002TESTS (\002,i6,\002 CALLS)\002,/\002 **" - "***** BUT WITH MAXIMUM TEST \002,\002RATIO \002,f8.2,\002 - SUSP" - "ECT *******\002)"; - static char fmt_10003[] = "(\002 \002,a13,\002 COMPLETED THE ROW-MAJOR " - " COMPUTATIONAL \002,\002TESTS (\002,i6,\002 CALLS)\002,/\002 **" - "***** BUT WITH MAXIMUM TEST \002,\002RATIO \002,f8.2,\002 - SUSP" - "ECT *******\002)"; - static char fmt_9996[] = "(\002 ******* \002,a13,\002 FAILED ON CALL NUM" - "BER:\002)"; - /* System generated locals */ integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2, i__3, i__4, i__5, i__6, i__7; - alist al__1; /* Local variables */ complex beta; @@ -1798,17 +1285,6 @@ L130: integer icu; real err; - /* Fortran I/O blocks */ - static cilist io___181 = { 0, 0, 0, fmt_9994, 0 }; - static cilist io___184 = { 0, 0, 0, fmt_9998, 0 }; - static cilist io___186 = { 0, 0, 0, fmt_10000, 0 }; - static cilist io___187 = { 0, 0, 0, fmt_10001, 0 }; - static cilist io___188 = { 0, 0, 0, fmt_10002, 0 }; - static cilist io___189 = { 0, 0, 0, fmt_10003, 0 }; - static cilist io___190 = { 0, 0, 0, fmt_9996, 0 }; - - - /* Tests CHEMM and CSYMM. */ /* Auxiliary routine for test program for Level 3 Blas. */ @@ -1974,9 +1450,9 @@ L130: ; } if (*rewi) { - al__1.aerr = 0; +/* al__1.aerr = 0; al__1.aunit = *ntra; - f_rew(&al__1); + f_rew(&al__1);*/ } if (conj) { cchemm_(iorder, side, uplo, &m, &n, &alpha, & @@ -1991,9 +1467,7 @@ L130: /* Check if error-exit was taken incorrectly. */ if (! infoc_1.ok) { - io___181.ciunit = *nout; - s_wsfe(&io___181); - e_wsfe(); + printf("*** FATAL ERROR - ERROR-CALL MYEXIT TAKEN ON VALID CALL\n"); *fatal = TRUE_; goto L110; } @@ -2028,11 +1502,7 @@ L130: for (i__ = 1; i__ <= i__5; ++i__) { same = same && isame[i__ - 1]; if (! isame[i__ - 1]) { - io___184.ciunit = *nout; - s_wsfe(&io___184); - do_fio(&c__1, (char *)&i__, (ftnlen) - sizeof(integer)); - e_wsfe(); + printf(" ******* FATAL ERROR - PARAMETER NUMBER %d WAS CHANGED INCORRECTLY *******\n",i__); } /* L40: */ } @@ -2090,51 +1560,34 @@ L90: if (errmax < *thresh) { if (*iorder == 0) { - io___186.ciunit = *nout; - s_wsfe(&io___186); - do_fio(&c__1, sname, (ftnlen)13); - do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer)); - e_wsfe(); + printf("%s PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS (%d CALLS)\n",sname,nc); } if (*iorder == 1) { - io___187.ciunit = *nout; - s_wsfe(&io___187); - do_fio(&c__1, sname, (ftnlen)13); - do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer)); - e_wsfe(); + printf("%s PASSED THE ROW-MAJOR COMPUTATIONAL TESTS (%d CALLS)\n",sname,nc); } } else { if (*iorder == 0) { - io___188.ciunit = *nout; - s_wsfe(&io___188); - do_fio(&c__1, sname, (ftnlen)13); - do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer)); - do_fio(&c__1, (char *)&errmax, (ftnlen)sizeof(real)); - e_wsfe(); + printf("%s COMPLETED THE COLUMN-MAJOR COMPUTATIONAL TESTS (%d CALLS)/n",sname,nc); + printf("***** BUT WITH MAXIMUM TEST RATIO %8.2f - SUSPECT *******/n",errmax); } if (*iorder == 1) { - io___189.ciunit = *nout; - s_wsfe(&io___189); - do_fio(&c__1, sname, (ftnlen)13); - do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer)); - do_fio(&c__1, (char *)&errmax, (ftnlen)sizeof(real)); - e_wsfe(); + printf("%s COMPLETED THE ROW-MAJOR COMPUTATIONAL TESTS (%d CALLS)/n",sname,nc); + printf("***** BUT WITH MAXIMUM TEST RATIO %8.2f - SUSPECT *******/n",errmax); } } goto L120; L110: - io___190.ciunit = *nout; - s_wsfe(&io___190); - do_fio(&c__1, sname, (ftnlen)13); - e_wsfe(); + printf(" ******* %s FAILED ON CALL NUMBER:\n",sname); cprcn2_(nout, &nc, sname, iorder, side, uplo, &m, &n, &alpha, &lda, &ldb, &beta, &ldc); L120: return 0; -/* L9995: */ +/* 9995 FORMAT(1X, I6, ': ', A12,'(', 2( '''', A1, ''',' ), 2( I3, ',' ), */ +/* $ '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3, ',(', F4.1, */ +/* $ ',', F4.1, '), C,', I3, ') .' ) */ /* End of CCHK2. */ @@ -2145,21 +1598,9 @@ L120: *iorder, char *side, char *uplo, integer *m, integer *n, complex * alpha, integer *lda, integer *ldb, complex *beta, integer *ldc) { - /* Format strings */ - static char fmt_9995[] = "(1x,i6,\002: \002,a13,\002(\002,a14,\002,\002," - "a14,\002,\002,a14,\002,\002)"; - static char fmt_9994[] = "(10x,2(i3,\002,\002),\002 (\002,f4.1,\002,\002" - ",f4.1,\002), A,\002,i3,\002, B,\002,i3,\002, (\002,f4.1,\002," - "\002,f4.1,\002), \002,\002C,\002,i3,\002).\002)"; - /* Local variables */ char cs[14], cu[14], crc[14]; - /* Fortran I/O blocks */ - static cilist io___194 = { 0, 0, 0, fmt_9995, 0 }; - static cilist io___195 = { 0, 0, 0, fmt_9994, 0 }; - - if (*(unsigned char *)side == 'L') { s_copy(cs, " CblasLeft", (ftnlen)14, (ftnlen)14); } else { @@ -2175,24 +1616,8 @@ L120: } else { s_copy(crc, " CblasColMajor", (ftnlen)14, (ftnlen)14); } - io___194.ciunit = *nout; - s_wsfe(&io___194); - do_fio(&c__1, (char *)&(*nc), (ftnlen)sizeof(integer)); - do_fio(&c__1, sname, (ftnlen)13); - do_fio(&c__1, crc, (ftnlen)14); - do_fio(&c__1, cs, (ftnlen)14); - do_fio(&c__1, cu, (ftnlen)14); - e_wsfe(); - io___195.ciunit = *nout; - s_wsfe(&io___195); - do_fio(&c__1, (char *)&(*m), (ftnlen)sizeof(integer)); - do_fio(&c__1, (char *)&(*n), (ftnlen)sizeof(integer)); - do_fio(&c__2, (char *)&(*alpha), (ftnlen)sizeof(real)); - do_fio(&c__1, (char *)&(*lda), (ftnlen)sizeof(integer)); - do_fio(&c__1, (char *)&(*ldb), (ftnlen)sizeof(integer)); - do_fio(&c__2, (char *)&(*beta), (ftnlen)sizeof(real)); - do_fio(&c__1, (char *)&(*ldc), (ftnlen)sizeof(integer)); - e_wsfe(); + printf("%6d: %s %s %s %s\n",*nc,sname,crc,cs,cu); + printf("%d %d (%4.1f,%4.1f) , A, %d, B, %d, (%4.1f,%4.1f) , C, %d.\n",*m,*n,alpha->r,alpha->i,*lda,*ldb,beta->r,beta->i,*ldc); return 0; } /* cprcn2_ */ @@ -2210,31 +1635,10 @@ L120: static char ichd[2] = "UN"; static char ichs[2] = "LR"; - /* Format strings */ - static char fmt_9994[] = "(\002 ******* FATAL ERROR - ERROR-CALL MYEXIT " - "TAKEN ON VALID\002,\002 CALL *******\002)"; - static char fmt_9998[] = "(\002 ******* FATAL ERROR - PARAMETER NUMBER" - " \002,i2,\002 WAS CH\002,\002ANGED INCORRECTLY *******\002)"; - static char fmt_10000[] = "(\002 \002,a13,\002 PASSED THE COLUMN-MAJOR C" - "OMPUTATIONAL TESTS\002,\002 (\002,i6,\002 CALL\002,\002S)\002)"; - static char fmt_10001[] = "(\002 \002,a13,\002 PASSED THE ROW-MAJOR C" - "OMPUTATIONAL TESTS\002,\002 (\002,i6,\002 CALL\002,\002S)\002)"; - static char fmt_10002[] = "(\002 \002,a13,\002 COMPLETED THE COLUMN-MAJO" - "R COMPUTATIONAL \002,\002TESTS (\002,i6,\002 CALLS)\002,/\002 **" - "***** BUT WITH MAXIMUM TEST \002,\002RATIO \002,f8.2,\002 - SUSP" - "ECT *******\002)"; - static char fmt_10003[] = "(\002 \002,a13,\002 COMPLETED THE ROW-MAJOR " - " COMPUTATIONAL \002,\002TESTS (\002,i6,\002 CALLS)\002,/\002 **" - "***** BUT WITH MAXIMUM TEST \002,\002RATIO \002,f8.2,\002 - SUSP" - "ECT *******\002)"; - static char fmt_9996[] = "(\002 ******* \002,a13,\002 FAILED ON CALL NUM" - "BER:\002)"; - /* System generated locals */ integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2, i__3, i__4, i__5, i__6, i__7; complex q__1; - alist al__1; /* Local variables */ char diag[1]; @@ -2279,17 +1683,6 @@ L120: integer ict, icu; real err; - /* Fortran I/O blocks */ - static cilist io___236 = { 0, 0, 0, fmt_9994, 0 }; - static cilist io___239 = { 0, 0, 0, fmt_9998, 0 }; - static cilist io___241 = { 0, 0, 0, fmt_10000, 0 }; - static cilist io___242 = { 0, 0, 0, fmt_10001, 0 }; - static cilist io___243 = { 0, 0, 0, fmt_10002, 0 }; - static cilist io___244 = { 0, 0, 0, fmt_10003, 0 }; - static cilist io___245 = { 0, 0, 0, fmt_9996, 0 }; - - - /* Tests CTRMM and CTRSM. */ /* Auxiliary routine for test program for Level 3 Blas. */ @@ -2444,14 +1837,14 @@ L120: if (*trace) { cprcn3_(ntra, &nc, sname, iorder, side, uplo, transa, diag, &m, - &n, &alpha, &lda, &ldb, ( - ftnlen)13, (ftnlen)1, (ftnlen) - 1, (ftnlen)1, (ftnlen)1); + &n, &alpha, &lda, &ldb/*, ( + ftnlen)12, (ftnlen)1, (ftnlen) + 1, (ftnlen)1, (ftnlen)1*/); } if (*rewi) { - al__1.aerr = 0; +/* al__1.aerr = 0; al__1.aunit = *ntra; - f_rew(&al__1); + f_rew(&al__1);*/ } cctrmm_(iorder, side, uplo, transa, diag, &m, &n, &alpha, &aa[1], &lda, &bb[ @@ -2461,14 +1854,14 @@ L120: if (*trace) { cprcn3_(ntra, &nc, sname, iorder, side, uplo, transa, diag, &m, - &n, &alpha, &lda, &ldb, ( - ftnlen)13, (ftnlen)1, (ftnlen) - 1, (ftnlen)1, (ftnlen)1); + &n, &alpha, &lda, &ldb/*, ( + ftnlen)12, (ftnlen)1, (ftnlen) + 1, (ftnlen)1, (ftnlen)1*/); } if (*rewi) { - al__1.aerr = 0; +/* al__1.aerr = 0; al__1.aunit = *ntra; - f_rew(&al__1); + f_rew(&al__1);*/ } cctrsm_(iorder, side, uplo, transa, diag, &m, &n, &alpha, &aa[1], &lda, &bb[ @@ -2478,9 +1871,7 @@ L120: /* Check if error-exit was taken incorrectly. */ if (! infoc_1.ok) { - io___236.ciunit = *nout; - s_wsfe(&io___236); - e_wsfe(); + printf("*** FATAL ERROR - ERROR-CALL MYEXIT TAKEN ON VALID CALL\n"); *fatal = TRUE_; goto L150; } @@ -2517,11 +1908,7 @@ L120: for (i__ = 1; i__ <= i__4; ++i__) { same = same && isame[i__ - 1]; if (! isame[i__ - 1]) { - io___239.ciunit = *nout; - s_wsfe(&io___239); - do_fio(&c__1, (char *)&i__, (ftnlen) - sizeof(integer)); - e_wsfe(); + printf(" ******* FATAL ERROR - PARAMETER NUMBER %d WAS CHANGED INCORRECTLY *******\n",i__); } /* L50: */ } @@ -2543,8 +1930,8 @@ L120: c_b1, &c__[c_offset], nmax, &ct[1], &g[1], &bb[ 1], &ldb, eps, &err, - fatal, nout, &c_true, ( - ftnlen)1, (ftnlen)1); + fatal, nout, &c_true/*, ( + ftnlen)1, (ftnlen)1*/); } else { cmmch_("N", transa, &m, &n, &n, & alpha, &b[b_offset], nmax, @@ -2631,44 +2018,25 @@ L130: if (errmax < *thresh) { if (*iorder == 0) { - io___241.ciunit = *nout; - s_wsfe(&io___241); - do_fio(&c__1, sname, (ftnlen)13); - do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer)); - e_wsfe(); + printf("%s PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS (%d CALLS)\n",sname,nc); } if (*iorder == 1) { - io___242.ciunit = *nout; - s_wsfe(&io___242); - do_fio(&c__1, sname, (ftnlen)13); - do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer)); - e_wsfe(); + printf("%s PASSED THE ROW-MAJOR COMPUTATIONAL TESTS (%d CALLS)\n",sname,nc); } } else { if (*iorder == 0) { - io___243.ciunit = *nout; - s_wsfe(&io___243); - do_fio(&c__1, sname, (ftnlen)13); - do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer)); - do_fio(&c__1, (char *)&errmax, (ftnlen)sizeof(real)); - e_wsfe(); + printf("%s COMPLETED THE COLUMN-MAJOR COMPUTATIONAL TESTS (%d CALLS)/n",sname,nc); + printf("***** BUT WITH MAXIMUM TEST RATIO %8.2f - SUSPECT *******/n",errmax); } if (*iorder == 1) { - io___244.ciunit = *nout; - s_wsfe(&io___244); - do_fio(&c__1, sname, (ftnlen)13); - do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer)); - do_fio(&c__1, (char *)&errmax, (ftnlen)sizeof(real)); - e_wsfe(); + printf("%s COMPLETED THE ROW-MAJOR COMPUTATIONAL TESTS (%d CALLS)/n",sname,nc); + printf("***** BUT WITH MAXIMUM TEST RATIO %8.2f - SUSPECT *******/n",errmax); } } goto L160; L150: - io___245.ciunit = *nout; - s_wsfe(&io___245); - do_fio(&c__1, sname, (ftnlen)13); - e_wsfe(); + printf(" ******* %s FAILED ON CALL NUMBER:\n",sname); if (*trace) { cprcn3_(ntra, &nc, sname, iorder, side, uplo, transa, diag, &m, &n, & alpha, &lda, &ldb); @@ -2677,7 +2045,9 @@ L150: L160: return 0; -/* L9995: */ +/* 9995 FORMAT(1X, I6, ': ', A12,'(', 4( '''', A1, ''',' ), 2( I3, ',' ), */ +/* $ '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3, ') ', */ +/* $ ' .' ) */ /* End of CCHK3. */ @@ -2688,21 +2058,9 @@ L160: *iorder, char *side, char *uplo, char *transa, char *diag, integer *m, integer *n, complex *alpha, integer *lda, integer *ldb) { - /* Format strings */ - static char fmt_9995[] = "(1x,i6,\002: \002,a13,\002(\002,a14,\002,\002," - "a14,\002,\002,a14,\002,\002)"; - static char fmt_9994[] = "(10x,2(a14,\002,\002),2(i3,\002,\002),\002 " - "(\002,f4.1,\002,\002,f4.1,\002), A,\002,i3,\002, B,\002,i3,\002)." - "\002)"; - /* Local variables */ char ca[14], cd[14], cs[14], cu[14], crc[14]; - /* Fortran I/O blocks */ - static cilist io___251 = { 0, 0, 0, fmt_9995, 0 }; - static cilist io___252 = { 0, 0, 0, fmt_9994, 0 }; - - if (*(unsigned char *)side == 'L') { s_copy(cs, " CblasLeft", (ftnlen)14, (ftnlen)14); } else { @@ -2730,24 +2088,9 @@ L160: } else { s_copy(crc, " CblasColMajor", (ftnlen)14, (ftnlen)14); } - io___251.ciunit = *nout; - s_wsfe(&io___251); - do_fio(&c__1, (char *)&(*nc), (ftnlen)sizeof(integer)); - do_fio(&c__1, sname, (ftnlen)13); - do_fio(&c__1, crc, (ftnlen)14); - do_fio(&c__1, cs, (ftnlen)14); - do_fio(&c__1, cu, (ftnlen)14); - e_wsfe(); - io___252.ciunit = *nout; - s_wsfe(&io___252); - do_fio(&c__1, ca, (ftnlen)14); - do_fio(&c__1, cd, (ftnlen)14); - do_fio(&c__1, (char *)&(*m), (ftnlen)sizeof(integer)); - do_fio(&c__1, (char *)&(*n), (ftnlen)sizeof(integer)); - do_fio(&c__2, (char *)&(*alpha), (ftnlen)sizeof(real)); - do_fio(&c__1, (char *)&(*lda), (ftnlen)sizeof(integer)); - do_fio(&c__1, (char *)&(*ldb), (ftnlen)sizeof(integer)); - e_wsfe(); + printf("%6d: %s %s %s %s\n",*nc,sname,crc,cs,cu); + printf(" %s %s %d %d (%4.1f,%4.1f) A %d B %d\n",ca,cd,*m,*n,alpha->r,alpha->i,*lda,*ldb); + return 0; } /* cprcn3_ */ @@ -2764,33 +2107,10 @@ L160: static char icht[2] = "NC"; static char ichu[2] = "UL"; - /* Format strings */ - static char fmt_9992[] = "(\002 ******* FATAL ERROR - ERROR-CALL MYEXIT " - "TAKEN ON VALID\002,\002 CALL *******\002)"; - static char fmt_9998[] = "(\002 ******* FATAL ERROR - PARAMETER NUMBER" - " \002,i2,\002 WAS CH\002,\002ANGED INCORRECTLY *******\002)"; - static char fmt_10000[] = "(\002 \002,a13,\002 PASSED THE COLUMN-MAJOR C" - "OMPUTATIONAL TESTS\002,\002 (\002,i6,\002 CALL\002,\002S)\002)"; - static char fmt_10001[] = "(\002 \002,a13,\002 PASSED THE ROW-MAJOR C" - "OMPUTATIONAL TESTS\002,\002 (\002,i6,\002 CALL\002,\002S)\002)"; - static char fmt_10002[] = "(\002 \002,a13,\002 COMPLETED THE COLUMN-MAJO" - "R COMPUTATIONAL \002,\002TESTS (\002,i6,\002 CALLS)\002,/\002 **" - "***** BUT WITH MAXIMUM TEST \002,\002RATIO \002,f8.2,\002 - SUSP" - "ECT *******\002)"; - static char fmt_10003[] = "(\002 \002,a13,\002 COMPLETED THE ROW-MAJOR " - " COMPUTATIONAL \002,\002TESTS (\002,i6,\002 CALLS)\002,/\002 **" - "***** BUT WITH MAXIMUM TEST \002,\002RATIO \002,f8.2,\002 - SUSP" - "ECT *******\002)"; - static char fmt_9995[] = "(\002 THESE ARE THE RESULTS FOR COLUMN" - " \002,i3)"; - static char fmt_9996[] = "(\002 ******* \002,a13,\002 FAILED ON CALL NUM" - "BER:\002)"; - /* System generated locals */ integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2, i__3, i__4, i__5, i__6, i__7; complex q__1; - alist al__1; /* Local variables */ complex beta; @@ -2841,18 +2161,6 @@ L160: integer ict, icu; real err; - /* Fortran I/O blocks */ - static cilist io___294 = { 0, 0, 0, fmt_9992, 0 }; - static cilist io___297 = { 0, 0, 0, fmt_9998, 0 }; - static cilist io___304 = { 0, 0, 0, fmt_10000, 0 }; - static cilist io___305 = { 0, 0, 0, fmt_10001, 0 }; - static cilist io___306 = { 0, 0, 0, fmt_10002, 0 }; - static cilist io___307 = { 0, 0, 0, fmt_10003, 0 }; - static cilist io___308 = { 0, 0, 0, fmt_9995, 0 }; - static cilist io___309 = { 0, 0, 0, fmt_9996, 0 }; - - - /* Tests CHERK and CSYRK. */ /* Auxiliary routine for test program for Level 3 Blas. */ @@ -2892,6 +2200,8 @@ L160: nc = 0; reset = TRUE_; errmax = 0.f; + rals = 1.f; + rbets = 1.f; i__1 = *nidim; for (in = 1; in <= i__1; ++in) { @@ -2965,8 +2275,8 @@ L160: } null = n <= 0; if (conj) { - null = null || (k <= 0 || ralpha == 0.f) && - rbeta == 1.f; + null = null || ((k <= 0 || ralpha == 0.f) && + rbeta == 1.f); } /* Generate the matrix C. */ @@ -3022,9 +2332,9 @@ L160: rbeta, &ldc); } if (*rewi) { - al__1.aerr = 0; +/* al__1.aerr = 0; al__1.aunit = *ntra; - f_rew(&al__1); + f_rew(&al__1);*/ } ccherk_(iorder, uplo, trans, &n, &k, &ralpha, &aa[1], &lda, &rbeta, &cc[1], &ldc); @@ -3035,9 +2345,9 @@ L160: beta, &ldc); } if (*rewi) { - al__1.aerr = 0; +/* al__1.aerr = 0; al__1.aunit = *ntra; - f_rew(&al__1); + f_rew(&al__1);*/ } ccsyrk_(iorder, uplo, trans, &n, &k, &alpha, & aa[1], &lda, &beta, &cc[1], &ldc); @@ -3046,9 +2356,7 @@ L160: /* Check if error-exit was taken incorrectly. */ if (! infoc_1.ok) { - io___294.ciunit = *nout; - s_wsfe(&io___294); - e_wsfe(); + printf("*** FATAL ERROR - ERROR-CALL MYEXIT TAKEN ON VALID CALL\n"); *fatal = TRUE_; goto L120; } @@ -3091,11 +2399,7 @@ L160: for (i__ = 1; i__ <= i__5; ++i__) { same = same && isame[i__ - 1]; if (! isame[i__ - 1]) { - io___297.ciunit = *nout; - s_wsfe(&io___297); - do_fio(&c__1, (char *)&i__, (ftnlen) - sizeof(integer)); - e_wsfe(); + printf(" ******* FATAL ERROR - PARAMETER NUMBER %d WAS CHANGED INCORRECTLY *******\n",i__); } /* L30: */ } @@ -3179,52 +2483,30 @@ L100: if (errmax < *thresh) { if (*iorder == 0) { - io___304.ciunit = *nout; - s_wsfe(&io___304); - do_fio(&c__1, sname, (ftnlen)13); - do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer)); - e_wsfe(); + printf("%s PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS (%d CALLS)\n",sname,nc); } if (*iorder == 1) { - io___305.ciunit = *nout; - s_wsfe(&io___305); - do_fio(&c__1, sname, (ftnlen)13); - do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer)); - e_wsfe(); + printf("%s PASSED THE ROW-MAJOR COMPUTATIONAL TESTS (%d CALLS)\n",sname,nc); } } else { if (*iorder == 0) { - io___306.ciunit = *nout; - s_wsfe(&io___306); - do_fio(&c__1, sname, (ftnlen)13); - do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer)); - do_fio(&c__1, (char *)&errmax, (ftnlen)sizeof(real)); - e_wsfe(); + printf("%s COMPLETED THE COLUMN-MAJOR COMPUTATIONAL TESTS (%d CALLS)/n",sname,nc); + printf("***** BUT WITH MAXIMUM TEST RATIO %8.2f - SUSPECT *******/n",errmax); } if (*iorder == 1) { - io___307.ciunit = *nout; - s_wsfe(&io___307); - do_fio(&c__1, sname, (ftnlen)13); - do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer)); - do_fio(&c__1, (char *)&errmax, (ftnlen)sizeof(real)); - e_wsfe(); + printf("%s COMPLETED THE ROW-MAJOR COMPUTATIONAL TESTS (%d CALLS)/n",sname,nc); + printf("***** BUT WITH MAXIMUM TEST RATIO %8.2f - SUSPECT *******/n",errmax); } } goto L130; L110: if (n > 1) { - io___308.ciunit = *nout; - s_wsfe(&io___308); - do_fio(&c__1, (char *)&j, (ftnlen)sizeof(integer)); - e_wsfe(); + printf(" THESE ARE THE RESULTS FOR COLUMN %d:\n",j); } L120: - io___309.ciunit = *nout; - s_wsfe(&io___309); - do_fio(&c__1, sname, (ftnlen)13); - e_wsfe(); + printf(" ******* %s FAILED ON CALL NUMBER:\n",sname); if (conj) { cprcn6_(nout, &nc, sname, iorder, uplo, trans, &n, &k, &ralpha, &lda, &rbeta, &ldc); @@ -3236,8 +2518,12 @@ L120: L130: return 0; -/* L9994: */ -/* L9993: */ +/* 9994 FORMAT(1X, I6, ': ', A12,'(', 2( '''', A1, ''',' ), 2( I3, ',' ), */ +/* $ F4.1, ', A,', I3, ',', F4.1, ', C,', I3, ') ', */ +/* $ ' .' ) */ +/* 9993 FORMAT(1X, I6, ': ', A12,'(', 2( '''', A1, ''',' ), 2( I3, ',' ), */ +/* $ '(', F4.1, ',', F4.1, ') , A,', I3, ',(', F4.1, ',', F4.1, */ +/* $ '), C,', I3, ') .' ) */ /* End of CCHK4. */ @@ -3248,21 +2534,9 @@ L130: *iorder, char *uplo, char *transa, integer *n, integer *k, complex * alpha, integer *lda, complex *beta, integer *ldc) { - /* Format strings */ - static char fmt_9995[] = "(1x,i6,\002: \002,a13,\002(\002,3(a14,\002," - "\002))"; - static char fmt_9994[] = "(10x,2(i3,\002,\002),\002 (\002,f4.1,\002,\002" - ",f4.1,\002), A,\002,i3,\002, (\002,f4.1,\002,\002,f4.1,\002), C" - ",\002,i3,\002).\002)"; - /* Local variables */ char ca[14], cu[14], crc[14]; - /* Fortran I/O blocks */ - static cilist io___313 = { 0, 0, 0, fmt_9995, 0 }; - static cilist io___314 = { 0, 0, 0, fmt_9994, 0 }; - - if (*(unsigned char *)uplo == 'U') { s_copy(cu, " CblasUpper", (ftnlen)14, (ftnlen)14); } else { @@ -3280,23 +2554,8 @@ L130: } else { s_copy(crc, " CblasColMajor", (ftnlen)14, (ftnlen)14); } - io___313.ciunit = *nout; - s_wsfe(&io___313); - do_fio(&c__1, (char *)&(*nc), (ftnlen)sizeof(integer)); - do_fio(&c__1, sname, (ftnlen)13); - do_fio(&c__1, crc, (ftnlen)14); - do_fio(&c__1, cu, (ftnlen)14); - do_fio(&c__1, ca, (ftnlen)14); - e_wsfe(); - io___314.ciunit = *nout; - s_wsfe(&io___314); - do_fio(&c__1, (char *)&(*n), (ftnlen)sizeof(integer)); - do_fio(&c__1, (char *)&(*k), (ftnlen)sizeof(integer)); - do_fio(&c__2, (char *)&(*alpha), (ftnlen)sizeof(real)); - do_fio(&c__1, (char *)&(*lda), (ftnlen)sizeof(integer)); - do_fio(&c__2, (char *)&(*beta), (ftnlen)sizeof(real)); - do_fio(&c__1, (char *)&(*ldc), (ftnlen)sizeof(integer)); - e_wsfe(); + printf("%6d: %s %s %s %s\n",*nc,sname,crc,cu,ca); + printf("( %d %d (%4.1f,%4.1f) A %d (%4.1f,%4.1f) C %d\n",*n,*k,alpha->r,alpha->i,*lda,beta->r,beta->i,*ldc); return 0; } /* cprcn4_ */ @@ -3306,20 +2565,9 @@ L130: *iorder, char *uplo, char *transa, integer *n, integer *k, real * alpha, integer *lda, real *beta, integer *ldc) { - /* Format strings */ - static char fmt_9995[] = "(1x,i6,\002: \002,a13,\002(\002,3(a14,\002," - "\002))"; - static char fmt_9994[] = "(10x,2(i3,\002,\002),f4.1,\002, A,\002,i3" - ",\002,\002,f4.1,\002, C,\002,i3,\002).\002)"; - /* Local variables */ char ca[14], cu[14], crc[14]; - /* Fortran I/O blocks */ - static cilist io___318 = { 0, 0, 0, fmt_9995, 0 }; - static cilist io___319 = { 0, 0, 0, fmt_9994, 0 }; - - if (*(unsigned char *)uplo == 'U') { s_copy(cu, " CblasUpper", (ftnlen)14, (ftnlen)14); } else { @@ -3337,23 +2585,8 @@ L130: } else { s_copy(crc, " CblasColMajor", (ftnlen)14, (ftnlen)14); } - io___318.ciunit = *nout; - s_wsfe(&io___318); - do_fio(&c__1, (char *)&(*nc), (ftnlen)sizeof(integer)); - do_fio(&c__1, sname, (ftnlen)13); - do_fio(&c__1, crc, (ftnlen)14); - do_fio(&c__1, cu, (ftnlen)14); - do_fio(&c__1, ca, (ftnlen)14); - e_wsfe(); - io___319.ciunit = *nout; - s_wsfe(&io___319); - do_fio(&c__1, (char *)&(*n), (ftnlen)sizeof(integer)); - do_fio(&c__1, (char *)&(*k), (ftnlen)sizeof(integer)); - do_fio(&c__1, (char *)&(*alpha), (ftnlen)sizeof(real)); - do_fio(&c__1, (char *)&(*lda), (ftnlen)sizeof(integer)); - do_fio(&c__1, (char *)&(*beta), (ftnlen)sizeof(real)); - do_fio(&c__1, (char *)&(*ldc), (ftnlen)sizeof(integer)); - e_wsfe(); + printf("%6d: %s %s %s %s\n",*nc,sname,crc,cu,ca); + printf("( %d %d %4.1f A %d %4.1f C %d\n",*n,*k,*alpha,*lda,*beta,*ldc); return 0; } /* cprcn6_ */ @@ -3370,32 +2603,10 @@ L130: static char icht[2] = "NC"; static char ichu[2] = "UL"; - /* Format strings */ - static char fmt_9992[] = "(\002 ******* FATAL ERROR - ERROR-CALL MYEXIT " - "TAKEN ON VALID\002,\002 CALL *******\002)"; - static char fmt_9998[] = "(\002 ******* FATAL ERROR - PARAMETER NUMBER" - " \002,i2,\002 WAS CH\002,\002ANGED INCORRECTLY *******\002)"; - static char fmt_10000[] = "(\002 \002,a13,\002 PASSED THE COLUMN-MAJOR C" - "OMPUTATIONAL TESTS\002,\002 (\002,i6,\002 CALL\002,\002S)\002)"; - static char fmt_10001[] = "(\002 \002,a13,\002 PASSED THE ROW-MAJOR C" - "OMPUTATIONAL TESTS\002,\002 (\002,i6,\002 CALL\002,\002S)\002)"; - static char fmt_10002[] = "(\002 \002,a13,\002 COMPLETED THE COLUMN-MAJO" - "R COMPUTATIONAL \002,\002TESTS (\002,i6,\002 CALLS)\002,/\002 **" - "***** BUT WITH MAXIMUM TEST \002,\002RATIO \002,f8.2,\002 - SUSP" - "ECT *******\002)"; - static char fmt_10003[] = "(\002 \002,a13,\002 COMPLETED THE ROW-MAJOR " - " COMPUTATIONAL \002,\002TESTS (\002,i6,\002 CALLS)\002,/\002 **" - "***** BUT WITH MAXIMUM TEST \002,\002RATIO \002,f8.2,\002 - SUSP" - "ECT *******\002)"; - static char fmt_9995[] = "(\002 THESE ARE THE RESULTS FOR COLUMN" - " \002,i3)"; - static char fmt_9996[] = "(\002 ******* \002,a13,\002 FAILED ON CALL NUM" - "BER:\002)"; /* System generated locals */ integer c_dim1, c_offset, i__1, i__2, i__3, i__4, i__5, i__6, i__7, i__8; complex q__1, q__2; - alist al__1; /* Local variables */ integer jjab; @@ -3444,18 +2655,6 @@ L130: integer ict, icu; real err; - /* Fortran I/O blocks */ - static cilist io___362 = { 0, 0, 0, fmt_9992, 0 }; - static cilist io___365 = { 0, 0, 0, fmt_9998, 0 }; - static cilist io___373 = { 0, 0, 0, fmt_10000, 0 }; - static cilist io___374 = { 0, 0, 0, fmt_10001, 0 }; - static cilist io___375 = { 0, 0, 0, fmt_10002, 0 }; - static cilist io___376 = { 0, 0, 0, fmt_10003, 0 }; - static cilist io___377 = { 0, 0, 0, fmt_9995, 0 }; - static cilist io___378 = { 0, 0, 0, fmt_9996, 0 }; - - - /* Tests CHER2K and CSYR2K. */ /* Auxiliary routine for test program for Level 3 Blas. */ @@ -3578,8 +2777,8 @@ L130: } null = n <= 0; if (conj) { - null = null || (k <= 0 || alpha.r == 0.f && - alpha.i == 0.f) && rbeta == 1.f; + null = null || ((k <= 0 || (alpha.r == 0.f && + alpha.i == 0.f)) && rbeta == 1.f); } /* Generate the matrix C. */ @@ -3640,9 +2839,9 @@ L130: &rbeta, &ldc); } if (*rewi) { - al__1.aerr = 0; +/* al__1.aerr = 0; al__1.aunit = *ntra; - f_rew(&al__1); + f_rew(&al__1);*/ } ccher2k_(iorder, uplo, trans, &n, &k, &alpha, &aa[1], &lda, &bb[1], &ldb, &rbeta, & @@ -3654,9 +2853,9 @@ L130: &beta, &ldc); } if (*rewi) { - al__1.aerr = 0; +/* al__1.aerr = 0; al__1.aunit = *ntra; - f_rew(&al__1); + f_rew(&al__1);*/ } ccsyr2k_(iorder, uplo, trans, &n, &k, &alpha, &aa[1], &lda, &bb[1], &ldb, &beta, & @@ -3666,9 +2865,7 @@ L130: /* Check if error-exit was taken incorrectly. */ if (! infoc_1.ok) { - io___362.ciunit = *nout; - s_wsfe(&io___362); - e_wsfe(); + printf("*** FATAL ERROR - ERROR-CALL MYEXIT TAKEN ON VALID CALL\n"); *fatal = TRUE_; goto L150; } @@ -3708,11 +2905,7 @@ L130: for (i__ = 1; i__ <= i__5; ++i__) { same = same && isame[i__ - 1]; if (! isame[i__ - 1]) { - io___365.ciunit = *nout; - s_wsfe(&io___365); - do_fio(&c__1, (char *)&i__, (ftnlen) - sizeof(integer)); - e_wsfe(); + printf(" ******* FATAL ERROR - PARAMETER NUMBER %d WAS CHANGED INCORRECTLY *******\n",i__); } /* L40: */ } @@ -3745,7 +2938,7 @@ L130: i__6 = k; for (i__ = 1; i__ <= i__6; ++i__) { i__7 = i__; - i__8 = (j - 1 << 1) * *nmax + k + + i__8 = ((j - 1) << 1) * *nmax + k + i__; q__1.r = alpha.r * ab[i__8].r - alpha.i * ab[i__8].i, @@ -3757,14 +2950,14 @@ L130: if (conj) { i__7 = k + i__; r_cnjg(&q__2, &alpha); - i__8 = (j - 1 << 1) * *nmax + i__; + i__8 = ((j - 1) << 1) * *nmax + i__; q__1.r = q__2.r * ab[i__8].r - q__2.i * ab[i__8].i, q__1.i = q__2.r * ab[i__8].i + q__2.i * ab[ i__8].r; w[i__7].r = q__1.r, w[i__7].i = q__1.i; } else { i__7 = k + i__; - i__8 = (j - 1 << 1) * *nmax + i__; + i__8 = ((j - 1) << 1) * *nmax + i__; q__1.r = alpha.r * ab[i__8].r - alpha.i * ab[i__8] .i, q__1.i = alpha.r * ab[i__8].i + alpha.i * ab[i__8].r; @@ -3865,52 +3058,30 @@ L130: if (errmax < *thresh) { if (*iorder == 0) { - io___373.ciunit = *nout; - s_wsfe(&io___373); - do_fio(&c__1, sname, (ftnlen)13); - do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer)); - e_wsfe(); + printf("%s PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS (%d CALLS)\n",sname,nc); } if (*iorder == 1) { - io___374.ciunit = *nout; - s_wsfe(&io___374); - do_fio(&c__1, sname, (ftnlen)13); - do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer)); - e_wsfe(); + printf("%s PASSED THE ROW-MAJOR COMPUTATIONAL TESTS (%d CALLS)\n",sname,nc); } } else { if (*iorder == 0) { - io___375.ciunit = *nout; - s_wsfe(&io___375); - do_fio(&c__1, sname, (ftnlen)13); - do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer)); - do_fio(&c__1, (char *)&errmax, (ftnlen)sizeof(real)); - e_wsfe(); + printf("%s COMPLETED THE COLUMN-MAJOR COMPUTATIONAL TESTS (%d CALLS)/n",sname,nc); + printf("***** BUT WITH MAXIMUM TEST RATIO %8.2f - SUSPECT *******/n",errmax); } if (*iorder == 1) { - io___376.ciunit = *nout; - s_wsfe(&io___376); - do_fio(&c__1, sname, (ftnlen)13); - do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer)); - do_fio(&c__1, (char *)&errmax, (ftnlen)sizeof(real)); - e_wsfe(); + printf("%s COMPLETED THE ROW-MAJOR COMPUTATIONAL TESTS (%d CALLS)/n",sname,nc); + printf("***** BUT WITH MAXIMUM TEST RATIO %8.2f - SUSPECT *******/n",errmax); } } goto L160; L140: if (n > 1) { - io___377.ciunit = *nout; - s_wsfe(&io___377); - do_fio(&c__1, (char *)&j, (ftnlen)sizeof(integer)); - e_wsfe(); + printf(" THESE ARE THE RESULTS FOR COLUMN %d:\n",j); } L150: - io___378.ciunit = *nout; - s_wsfe(&io___378); - do_fio(&c__1, sname, (ftnlen)13); - e_wsfe(); + printf(" ******* %s FAILED ON CALL NUMBER:\n",sname); if (conj) { cprcn7_(nout, &nc, sname, iorder, uplo, trans, &n, &k, &alpha, &lda, & ldb, &rbeta, &ldc); @@ -3922,8 +3093,12 @@ L150: L160: return 0; -/* L9994: */ -/* L9993: */ +/* 9994 FORMAT(1X, I6, ': ', A12,'(', 2( '''', A1, ''',' ), 2( I3, ',' ), */ +/* $ '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3, ',', F4.1, */ +/* $ ', C,', I3, ') .' ) */ +/* 9993 FORMAT(1X, I6, ': ', A12,'(', 2( '''', A1, ''',' ), 2( I3, ',' ), */ +/* $ '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3, ',(', F4.1, */ +/* $ ',', F4.1, '), C,', I3, ') .' ) */ /* End of CCHK5. */ @@ -3934,21 +3109,10 @@ L160: *iorder, char *uplo, char *transa, integer *n, integer *k, complex * alpha, integer *lda, integer *ldb, complex *beta, integer *ldc) { - /* Format strings */ - static char fmt_9995[] = "(1x,i6,\002: \002,a13,\002(\002,3(a14,\002," - "\002))"; - static char fmt_9994[] = "(10x,2(i3,\002,\002),\002 (\002,f4.1,\002,\002" - ",f4.1,\002), A,\002,i3,\002, B\002,i3,\002, (\002,f4.1,\002,\002" - ",f4.1,\002), C,\002,i3,\002).\002)"; /* Local variables */ char ca[14], cu[14], crc[14]; - /* Fortran I/O blocks */ - static cilist io___382 = { 0, 0, 0, fmt_9995, 0 }; - static cilist io___383 = { 0, 0, 0, fmt_9994, 0 }; - - if (*(unsigned char *)uplo == 'U') { s_copy(cu, " CblasUpper", (ftnlen)14, (ftnlen)14); } else { @@ -3966,24 +3130,8 @@ L160: } else { s_copy(crc, " CblasColMajor", (ftnlen)14, (ftnlen)14); } - io___382.ciunit = *nout; - s_wsfe(&io___382); - do_fio(&c__1, (char *)&(*nc), (ftnlen)sizeof(integer)); - do_fio(&c__1, sname, (ftnlen)13); - do_fio(&c__1, crc, (ftnlen)14); - do_fio(&c__1, cu, (ftnlen)14); - do_fio(&c__1, ca, (ftnlen)14); - e_wsfe(); - io___383.ciunit = *nout; - s_wsfe(&io___383); - do_fio(&c__1, (char *)&(*n), (ftnlen)sizeof(integer)); - do_fio(&c__1, (char *)&(*k), (ftnlen)sizeof(integer)); - do_fio(&c__2, (char *)&(*alpha), (ftnlen)sizeof(real)); - do_fio(&c__1, (char *)&(*lda), (ftnlen)sizeof(integer)); - do_fio(&c__1, (char *)&(*ldb), (ftnlen)sizeof(integer)); - do_fio(&c__2, (char *)&(*beta), (ftnlen)sizeof(real)); - do_fio(&c__1, (char *)&(*ldc), (ftnlen)sizeof(integer)); - e_wsfe(); + printf("%6d: %s %s %s %s\n",*nc,sname,crc,cu,ca); + printf("%d %d (%4.1f,%4.1f) , A, %d, B, %d, (%4.1f,%4.1f) , C, %d.\n",*n,*k,alpha->r,alpha->i,*lda,*ldb,beta->r,beta->i,*ldc); return 0; } /* cprcn5_ */ @@ -3993,21 +3141,10 @@ L160: *iorder, char *uplo, char *transa, integer *n, integer *k, complex * alpha, integer *lda, integer *ldb, real *beta, integer *ldc) { - /* Format strings */ - static char fmt_9995[] = "(1x,i6,\002: \002,a13,\002(\002,3(a14,\002," - "\002))"; - static char fmt_9994[] = "(10x,2(i3,\002,\002),\002 (\002,f4.1,\002,\002" - ",f4.1,\002), A,\002,i3,\002, B\002,i3,\002,\002,f4.1,\002, C," - "\002,i3,\002).\002)"; /* Local variables */ char ca[14], cu[14], crc[14]; - /* Fortran I/O blocks */ - static cilist io___387 = { 0, 0, 0, fmt_9995, 0 }; - static cilist io___388 = { 0, 0, 0, fmt_9994, 0 }; - - if (*(unsigned char *)uplo == 'U') { s_copy(cu, " CblasUpper", (ftnlen)14, (ftnlen)14); } else { @@ -4025,24 +3162,8 @@ L160: } else { s_copy(crc, " CblasColMajor", (ftnlen)14, (ftnlen)14); } - io___387.ciunit = *nout; - s_wsfe(&io___387); - do_fio(&c__1, (char *)&(*nc), (ftnlen)sizeof(integer)); - do_fio(&c__1, sname, (ftnlen)13); - do_fio(&c__1, crc, (ftnlen)14); - do_fio(&c__1, cu, (ftnlen)14); - do_fio(&c__1, ca, (ftnlen)14); - e_wsfe(); - io___388.ciunit = *nout; - s_wsfe(&io___388); - do_fio(&c__1, (char *)&(*n), (ftnlen)sizeof(integer)); - do_fio(&c__1, (char *)&(*k), (ftnlen)sizeof(integer)); - do_fio(&c__2, (char *)&(*alpha), (ftnlen)sizeof(real)); - do_fio(&c__1, (char *)&(*lda), (ftnlen)sizeof(integer)); - do_fio(&c__1, (char *)&(*ldb), (ftnlen)sizeof(integer)); - do_fio(&c__1, (char *)&(*beta), (ftnlen)sizeof(real)); - do_fio(&c__1, (char *)&(*ldc), (ftnlen)sizeof(integer)); - e_wsfe(); + printf("%6d: %s %s %s %s\n",*nc,sname,crc,cu,ca); + printf("%d %d (%4.1f,%4.1f), A, %d, B, %d, %4.1f, C, %d.\n",*n,*k,alpha->r,alpha->i,*lda,*ldb,*beta,*ldc); return 0; } /* cprcn7_ */ @@ -4101,7 +3222,7 @@ L160: for (j = 1; j <= i__1; ++j) { i__2 = *m; for (i__ = 1; i__ <= i__2; ++i__) { - if (gen || upper && i__ <= j || lower && i__ >= j) { + if (gen || (upper && i__ <= j) || (lower && i__ >= j)) { i__3 = i__ + j * a_dim1; cbeg_(&q__2, reset); q__1.r = q__2.r + transl->r, q__1.i = q__2.i + transl->i; @@ -4230,15 +3351,6 @@ L160: real *g, complex *cc, integer *ldcc, real *eps, real *err, logical * fatal, integer *nout, logical *mv) { - /* Format strings */ - static char fmt_9999[] = "(\002 ******* FATAL ERROR - COMPUTED RESULT IS" - " LESS THAN HAL\002,\002F ACCURATE *******\002,/\002 " - " EXPECTED RE\002,\002SULT COMPUTED R" - "ESULT\002)"; - static char fmt_9998[] = "(1x,i7,2(\002 (\002,g15.6,\002,\002,g15.6," - "\002)\002))"; - static char fmt_9997[] = "(\002 THESE ARE THE RESULTS FOR COLUMN" - " \002,i3)"; /* System generated locals */ integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, cc_dim1, @@ -4251,14 +3363,6 @@ L160: integer i__, j, k; logical trana, tranb, ctrana, ctranb; - /* Fortran I/O blocks */ - static cilist io___409 = { 0, 0, 0, fmt_9999, 0 }; - static cilist io___410 = { 0, 0, 0, fmt_9998, 0 }; - static cilist io___411 = { 0, 0, 0, fmt_9998, 0 }; - static cilist io___412 = { 0, 0, 0, fmt_9997, 0 }; - - - /* Checks the results of the computational tests. */ /* Auxiliary routine for test program for Level 3 Blas. */ @@ -4595,35 +3699,19 @@ L160: L230: *fatal = TRUE_; - io___409.ciunit = *nout; - s_wsfe(&io___409); - e_wsfe(); + printf(" ******* FATAL ERROR - COMPUTED RESULT IS LESS THAN HALF ACCURATE *******\n"); + printf(" EXPECTED RESULT COMPUTED RESULT\n"); i__1 = *m; for (i__ = 1; i__ <= i__1; ++i__) { if (*mv) { - io___410.ciunit = *nout; - s_wsfe(&io___410); - do_fio(&c__1, (char *)&i__, (ftnlen)sizeof(integer)); - do_fio(&c__2, (char *)&ct[i__], (ftnlen)sizeof(real)); - do_fio(&c__2, (char *)&cc[i__ + j * cc_dim1], (ftnlen)sizeof(real) - ); - e_wsfe(); + printf("%7d (%15.6g,%15.6g) (%15.6g,%15.6g)\n",i__,ct[i__].r,ct[i__].i,cc[i__+j*cc_dim1].r,cc[i__+j*cc_dim1].i); } else { - io___411.ciunit = *nout; - s_wsfe(&io___411); - do_fio(&c__1, (char *)&i__, (ftnlen)sizeof(integer)); - do_fio(&c__2, (char *)&cc[i__ + j * cc_dim1], (ftnlen)sizeof(real) - ); - do_fio(&c__2, (char *)&ct[i__], (ftnlen)sizeof(real)); - e_wsfe(); + printf("%7d (%15.6g,%15.6g) (%15.6g,%15.6g)\n",i__,cc[i__+j*cc_dim1].r,cc[i__+j*cc_dim1].i,ct[i__].r,ct[i__].i); } /* L240: */ } if (*n > 1) { - io___412.ciunit = *nout; - s_wsfe(&io___412); - do_fio(&c__1, (char *)&j, (ftnlen)sizeof(integer)); - e_wsfe(); + printf(" THESE ARE THE RESULTS FOR COLUMN %d\n",j); } L250: @@ -4760,7 +3848,7 @@ logical lceres_(char *type__, char *uplo, integer *m, integer *n, complex *aa, } } -/* L60: */ +/* 60 CONTINUE */ ret_val = TRUE_; goto L80; L70: @@ -4851,4 +3939,4 @@ real sdiff_(real *x, real *y) } /* sdiff_ */ -/* Main program alias */ int cblat3_ () { MAIN__ (); return 0; } +/* Main program alias */ /*int cblat3_ () { MAIN__ (); return 0; }*/ diff --git a/ctest/c_zblat3c_3m.c b/ctest/c_zblat3c_3m.c index 059daccb5..0c76f11e7 100644 --- a/ctest/c_zblat3c_3m.c +++ b/ctest/c_zblat3c_3m.c @@ -10,25 +10,7 @@ #undef I #endif -#if defined(_WIN64) -typedef long long BLASLONG; -typedef unsigned long long BLASULONG; -#else -typedef long BLASLONG; -typedef unsigned long BLASULONG; -#endif - -#ifdef LAPACK_ILP64 -typedef BLASLONG blasint; -#if defined(_WIN64) -#define blasabs(x) llabs(x) -#else -#define blasabs(x) labs(x) -#endif -#else -typedef int blasint; -#define blasabs(x) abs(x) -#endif +#include "common.h" typedef blasint integer; @@ -40,14 +22,11 @@ typedef double doublereal; typedef struct { real r, i; } complex; typedef struct { doublereal r, i; } doublecomplex; #ifdef _MSC_VER -static inline _Fcomplex Cf(complex *z) {_Fcomplex zz={z->r , z->i}; return zz;} static inline _Dcomplex Cd(doublecomplex *z) {_Dcomplex zz={z->r , z->i};return zz;} -static inline _Fcomplex * _pCf(complex *z) {return (_Fcomplex*)z;} static inline _Dcomplex * _pCd(doublecomplex *z) {return (_Dcomplex*)z;} #else static inline _Complex float Cf(complex *z) {return z->r + z->i*_Complex_I;} static inline _Complex double Cd(doublecomplex *z) {return z->r + z->i*_Complex_I;} -static inline _Complex float * _pCf(complex *z) {return (_Complex float*)z;} static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double*)z;} #endif #define pCf(z) (*_pCf(z)) @@ -247,7 +226,6 @@ typedef struct Namelist Namelist; #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; #define z_abs(z) (cabs(Cd(z))) #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} @@ -261,259 +239,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ #define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef logical (*L_fp)(...); -#else -typedef logical (*L_fp)(); -#endif - -static float spow_ui(float x, integer n) { - float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static double dpow_ui(double x, integer n) { - double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#ifdef _MSC_VER -static _Fcomplex cpow_ui(complex x, integer n) { - complex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; - for(u = n; ; ) { - if(u & 01) pow.r *= x.r, pow.i *= x.i; - if(u >>= 1) x.r *= x.r, x.i *= x.i; - else break; - } - } - _Fcomplex p={pow.r, pow.i}; - return p; -} -#else -static _Complex float cpow_ui(_Complex float x, integer n) { - _Complex float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -#ifdef _MSC_VER -static _Dcomplex zpow_ui(_Dcomplex x, integer n) { - _Dcomplex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; - for(u = n; ; ) { - if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; - if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; - else break; - } - } - _Dcomplex p = {pow._Val[0], pow._Val[1]}; - return p; -} -#else -static _Complex double zpow_ui(_Complex double x, integer n) { - _Complex double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -static integer pow_ii(integer x, integer n) { - integer pow; unsigned long int u; - if (n <= 0) { - if (n == 0 || x == 1) pow = 1; - else if (x != -1) pow = x == 0 ? 1/x : 0; - else n = -n; - } - if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { - u = n; - for(pow = 1; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static integer dmaxloc_(double *w, integer s, integer e, integer *n) -{ - double m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static integer smaxloc_(float *w, integer s, integer e, integer *n) -{ - float m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { - integer n = *n_, incx = *incx_, incy = *incy_, i; -#ifdef _MSC_VER - _Fcomplex zdotc = {0.0, 0.0}; - if (incx == 1 && incy == 1) { - for (i=0;i= 0; if (trace) { - o__1.oerr = 0; +/* o__1.oerr = 0; o__1.ounit = ntra; o__1.ofnmlen = 32; o__1.ofnm = snaps; @@ -783,149 +401,119 @@ static logical c_false = FALSE_; o__1.oacc = 0; o__1.ofm = 0; o__1.oblnk = 0; - f_open(&o__1); + f_open(&o__1);*/ } /* Read the flag that directs rewinding of the snapshot file. */ - s_rsle(&io___7); - do_lio(&c__8, &c__1, (char *)&rewi, (ftnlen)sizeof(logical)); - e_rsle(); - rewi = rewi && trace; + fgets(line,80,stdin); + sscanf(line,"%d",&rewi); + rewi = rewi && trace; /* Read the flag that directs stopping on any failure. */ - s_rsle(&io___9); - do_lio(&c__8, &c__1, (char *)&sfatal, (ftnlen)sizeof(logical)); - e_rsle(); + fgets(line,80,stdin); + sscanf(line,"%c",&tmpchar); + sfatal=FALSE_; + if (tmpchar=='T')sfatal=TRUE_; /* Read the flag that indicates whether error exits are to be tested. */ - s_rsle(&io___11); - do_lio(&c__8, &c__1, (char *)&tsterr, (ftnlen)sizeof(logical)); - e_rsle(); + fgets(line,80,stdin); + sscanf(line,"%c",&tmpchar); + tsterr=FALSE_; + if (tmpchar=='T')tsterr=TRUE_; /* Read the flag that indicates whether row-major data layout to be tested. */ - s_rsle(&io___13); - do_lio(&c__3, &c__1, (char *)&layout, (ftnlen)sizeof(integer)); - e_rsle(); + fgets(line,80,stdin); + sscanf(line,"%d",&layout); /* Read the threshold value of the test ratio */ - s_rsle(&io___15); - do_lio(&c__5, &c__1, (char *)&thresh, (ftnlen)sizeof(doublereal)); - e_rsle(); + fgets(line,80,stdin); + sscanf(line,"%lf",&thresh); /* Read and check the parameter values for the tests. */ /* Values of N */ - s_rsle(&io___17); - do_lio(&c__3, &c__1, (char *)&nidim, (ftnlen)sizeof(integer)); - e_rsle(); + fgets(line,80,stdin); +#ifdef USE64BITINT + sscanf(line,"%d",&nidim); +#else + sscanf(line,"%d",&nidim); +#endif if (nidim < 1 || nidim > 9) { - s_wsfe(&io___19); - do_fio(&c__1, "N", (ftnlen)1); - do_fio(&c__1, (char *)&c__9, (ftnlen)sizeof(integer)); - e_wsfe(); - goto L220; + fprintf(stderr,"NUMBER OF VALUES OF N IS LESS THAN 1 OR GREATER THAN 9"); + goto L220; } - s_rsle(&io___20); - i__1 = nidim; - for (i__ = 1; i__ <= i__1; ++i__) { - do_lio(&c__3, &c__1, (char *)&idim[i__ - 1], (ftnlen)sizeof(integer)); - } - e_rsle(); + fgets(line,80,stdin); +#ifdef USE64BITINT + sscanf(line,"%ld %ld %ld %ld %ld %ld %ld %ld %ld",&idim[0],&idim[1],&idim[2], + &idim[3],&idim[4],&idim[5],&idim[6],&idim[7],&idim[8]); +#else + sscanf(line,"%d %d %d %d %d %d %d %d %d",&idim[0],&idim[1],&idim[2], + &idim[3],&idim[4],&idim[5],&idim[6],&idim[7],&idim[8]); +#endif i__1 = nidim; for (i__ = 1; i__ <= i__1; ++i__) { - if (idim[i__ - 1] < 0 || idim[i__ - 1] > 65) { - s_wsfe(&io___23); - do_fio(&c__1, (char *)&c__65, (ftnlen)sizeof(integer)); - e_wsfe(); - goto L220; - } + if (idim[i__ - 1] < 0 || idim[i__ - 1] > 65) { + fprintf(stderr,"VALUE OF N IS LESS THAN 0 OR GREATER THAN 65\n"); + goto L220; + } /* L10: */ } /* Values of ALPHA */ - s_rsle(&io___24); - do_lio(&c__3, &c__1, (char *)&nalf, (ftnlen)sizeof(integer)); - e_rsle(); + fgets(line,80,stdin); +#ifdef USE64BITINT + sscanf(line,"%ld",&nalf); +#else + sscanf(line,"%d",&nalf); +#endif if (nalf < 1 || nalf > 7) { - s_wsfe(&io___26); - do_fio(&c__1, "ALPHA", (ftnlen)5); - do_fio(&c__1, (char *)&c__7, (ftnlen)sizeof(integer)); - e_wsfe(); - goto L220; - } - s_rsle(&io___27); - i__1 = nalf; - for (i__ = 1; i__ <= i__1; ++i__) { - do_lio(&c__7, &c__1, (char *)&alf[i__ - 1], (ftnlen)sizeof( - doublecomplex)); + fprintf(stderr,"VALUE OF ALPHA IS LESS THAN 0 OR GREATER THAN 7\n"); + goto L220; } - e_rsle(); + fgets(line,80,stdin); + sscanf(line,"(%lf,%lf) (%lf,%lf) (%lf,%lf) (%lf,%lf) (%lf,%lf) (%lf,%lf) (%lf,%lf)",&alf[0].r,&alf[0].i,&alf[1].r,&alf[1].i,&alf[2].r,&alf[2].i,&alf[3].r,&alf[3].i, + &alf[4].r,&alf[4].i,&alf[5].r,&alf[5].i,&alf[6].r,&alf[6].i); + /* Values of BETA */ - s_rsle(&io___29); - do_lio(&c__3, &c__1, (char *)&nbet, (ftnlen)sizeof(integer)); - e_rsle(); - if (nbet < 1 || nbet > 7) { - s_wsfe(&io___31); - do_fio(&c__1, "BETA", (ftnlen)4); - do_fio(&c__1, (char *)&c__7, (ftnlen)sizeof(integer)); - e_wsfe(); - goto L220; - } - s_rsle(&io___32); - i__1 = nbet; - for (i__ = 1; i__ <= i__1; ++i__) { - do_lio(&c__7, &c__1, (char *)&bet[i__ - 1], (ftnlen)sizeof( - doublecomplex)); + fgets(line,80,stdin); +#ifdef USE64BITINT + sscanf(line,"%ld",&nbet); +#else + sscanf(line,"%d",&nbet); +#endif + if (nalf < 1 || nbet > 7) { + fprintf(stderr,"VALUE OF BETA IS LESS THAN 0 OR GREATER THAN 7\n"); + goto L220; } - e_rsle(); + fgets(line,80,stdin); + sscanf(line,"(%lf,%lf) (%lf,%lf) (%lf,%lf) (%lf,%lf) (%lf,%lf) (%lf,%lf) (%lf,%lf)",&bet[0].r,&bet[0].i,&bet[1].r,&bet[1].i,&bet[2].r,&bet[2].i,&bet[3].r,&bet[3].i, + &bet[4].r,&bet[4].i,&bet[5].r,&bet[5].i,&bet[6].r,&bet[6].i); /* Report values of parameters. */ - s_wsfe(&io___34); - e_wsfe(); - s_wsfe(&io___35); - i__1 = nidim; - for (i__ = 1; i__ <= i__1; ++i__) { - do_fio(&c__1, (char *)&idim[i__ - 1], (ftnlen)sizeof(integer)); - } - e_wsfe(); - s_wsfe(&io___36); - i__1 = nalf; - for (i__ = 1; i__ <= i__1; ++i__) { - do_fio(&c__2, (char *)&alf[i__ - 1], (ftnlen)sizeof(doublereal)); - } - e_wsfe(); - s_wsfe(&io___37); - i__1 = nbet; - for (i__ = 1; i__ <= i__1; ++i__) { - do_fio(&c__2, (char *)&bet[i__ - 1], (ftnlen)sizeof(doublereal)); - } - e_wsfe(); + printf("TESTS OF THE DOUBLE PRECISION COMPLEX LEVEL 3 BLAS\nTHE FOLLOWING PARAMETER VALUES WILL BE USED:\n"); + printf(" FOR N"); + for (i__ =1; i__ <=nidim;++i__) printf(" %d",idim[i__-1]); + printf("\n"); + printf(" FOR ALPHA"); + for (i__ =1; i__ <=nalf;++i__) printf(" (%lf,%lf)",alf[i__-1].r,alf[i__-1].i); + printf("\n"); + printf(" FOR BETA"); + for (i__ =1; i__ <=nbet;++i__) printf(" (%lf,%lf)",bet[i__-1].r,bet[i__-1].i); + printf("\n"); + if (! tsterr) { - s_wsle(&io___38); - e_wsle(); - s_wsfe(&io___39); - e_wsfe(); + printf(" ERROR-EXITS WILL NOT BE TESTED\n"); } - s_wsle(&io___40); - e_wsle(); - s_wsfe(&io___41); - do_fio(&c__1, (char *)&thresh, (ftnlen)sizeof(doublereal)); - e_wsfe(); - s_wsle(&io___42); - e_wsle(); + + printf("ROUTINES PASS COMPUTATIONAL TESTS IF TEST RATIO IS LESS THAN %lf\n",thresh); rorder = FALSE_; corder = FALSE_; if (layout == 2) { rorder = TRUE_; corder = TRUE_; - s_wsfe(&io___45); - e_wsfe(); + printf("COLUMN-MAJOR AND ROW-MAJOR DATA LAYOUTS ARE TESTED\n"); } else if (layout == 1) { rorder = TRUE_; - s_wsfe(&io___46); - e_wsfe(); + printf("ROW-MAJOR DATA LAYOUT IS TESTED\n"); } else if (layout == 0) { corder = TRUE_; - s_wsfe(&io___47); - e_wsfe(); + printf("COLUMN-MAJOR DATA LAYOUT IS TESTED\n"); } - s_wsle(&io___48); - e_wsle(); /* Read names of subroutines and flags which indicate */ /* whether they are to be tested. */ @@ -935,42 +523,33 @@ static logical c_false = FALSE_; /* L20: */ } L30: - i__1 = s_rsfe(&io___50); - if (i__1 != 0) { - goto L60; - } - i__1 = do_fio(&c__1, snamet, (ftnlen)13); - if (i__1 != 0) { - goto L60; - } - i__1 = do_fio(&c__1, (char *)<estt, (ftnlen)sizeof(logical)); - if (i__1 != 0) { - goto L60; + if (! fgets(line,80,stdin)) { + goto L60; } - i__1 = e_rsfe(); - if (i__1 != 0) { - goto L60; + i__1 = sscanf(line,"%12c %c",snamet,&tmpchar); + ltestt=FALSE_; + if (tmpchar=='T')ltestt=TRUE_; + if (i__1 < 2) { + goto L60; } for (i__ = 1; i__ <= 9; ++i__) { - if (s_cmp(snamet, snames + (i__ - 1) * 13, (ftnlen)13, (ftnlen)13) == - 0) { - goto L50; - } + if (s_cmp(snamet, snames[i__ - 1] , (ftnlen)12, (ftnlen)12) == + 0) { + goto L50; + } /* L40: */ } - s_wsfe(&io___53); - do_fio(&c__1, snamet, (ftnlen)13); - e_wsfe(); - s_stop("", (ftnlen)0); + printf("SUBPROGRAM NAME %s NOT RECOGNIZED\n****** TESTS ABANDONED ******\n",snamet); + exit(1); L50: ltest[i__ - 1] = ltestt; goto L30; L60: - cl__1.cerr = 0; +/* cl__1.cerr = 0; cl__1.cunit = 5; cl__1.csta = 0; - f_clos(&cl__1); + f_clos(&cl__1);*/ /* Compute EPS (the machine precision). */ @@ -984,9 +563,7 @@ L70: goto L70; L80: eps += eps; - s_wsfe(&io___55); - do_fio(&c__1, (char *)&eps, (ftnlen)sizeof(doublereal)); - e_wsfe(); + printf("RELATIVE MACHINE PRECISION IS TAKEN TO BE %9.1g\n",eps); /* Check the reliability of ZMMCH using exact data. */ @@ -1023,30 +600,28 @@ L80: *(unsigned char *)transb = 'N'; zmmch_(transa, transb, &n, &c__1, &n, &c_b2, ab, &c__65, &ab[4225], & c__65, &c_b1, c__, &c__65, ct, g, cc, &c__65, &eps, &err, &fatal, - &c__6, &c_true); + &c__6, &c_true, (ftnlen)1, (ftnlen)1); same = lze_(cc, ct, &n); if (! same || err != 0.) { - s_wsfe(&io___68); - do_fio(&c__1, transa, (ftnlen)1); - do_fio(&c__1, transb, (ftnlen)1); - do_fio(&c__1, (char *)&same, (ftnlen)sizeof(logical)); - do_fio(&c__1, (char *)&err, (ftnlen)sizeof(doublereal)); - e_wsfe(); - s_stop("", (ftnlen)0); + printf("ERROR IN ZMMCH - IN-LINE DOT PRODUCTS ARE BEING EVALUATED WRONGLY\n"); + printf("ZMMCH WAS CALLED WITH TRANSA = %s AND TRANSB = %s\n", transa,transb); + printf("AND RETURNED SAME = %c AND ERR = %12.3f.\n",(same==FALSE_? 'F':'T'),err); + printf("THIS MAY BE DUE TO FAULTS IN THE ARITHMETIC OR THE COMPILER.\n"); + printf("****** TESTS ABANDONED ******\n"); + exit(1); } *(unsigned char *)transb = 'C'; zmmch_(transa, transb, &n, &c__1, &n, &c_b2, ab, &c__65, &ab[4225], & c__65, &c_b1, c__, &c__65, ct, g, cc, &c__65, &eps, &err, &fatal, - &c__6, &c_true); + &c__6, &c_true, (ftnlen)1, (ftnlen)1); same = lze_(cc, ct, &n); if (! same || err != 0.) { - s_wsfe(&io___69); - do_fio(&c__1, transa, (ftnlen)1); - do_fio(&c__1, transb, (ftnlen)1); - do_fio(&c__1, (char *)&same, (ftnlen)sizeof(logical)); - do_fio(&c__1, (char *)&err, (ftnlen)sizeof(doublereal)); - e_wsfe(); - s_stop("", (ftnlen)0); + printf("ERROR IN ZMMCH - IN-LINE DOT PRODUCTS ARE BEING EVALUATED WRONGLY\n"); + printf("ZMMCH WAS CALLED WITH TRANSA = %s AND TRANSB = %s\n", transa,transb); + printf("AND RETURNED SAME = %c AND ERR = %12.3f.\n",(same==FALSE_? 'F':'T'),err); + printf("THIS MAY BE DUE TO FAULTS IN THE ARITHMETIC OR THE COMPILER.\n"); + printf("****** TESTS ABANDONED ******\n"); + exit(1); } i__1 = n; for (j = 1; j <= i__1; ++j) { @@ -1069,56 +644,48 @@ L80: *(unsigned char *)transb = 'N'; zmmch_(transa, transb, &n, &c__1, &n, &c_b2, ab, &c__65, &ab[4225], & c__65, &c_b1, c__, &c__65, ct, g, cc, &c__65, &eps, &err, &fatal, - &c__6, &c_true); + &c__6, &c_true, (ftnlen)1, (ftnlen)1); same = lze_(cc, ct, &n); if (! same || err != 0.) { - s_wsfe(&io___70); - do_fio(&c__1, transa, (ftnlen)1); - do_fio(&c__1, transb, (ftnlen)1); - do_fio(&c__1, (char *)&same, (ftnlen)sizeof(logical)); - do_fio(&c__1, (char *)&err, (ftnlen)sizeof(doublereal)); - e_wsfe(); - s_stop("", (ftnlen)0); + printf("ERROR IN ZMMCH - IN-LINE DOT PRODUCTS ARE BEING EVALUATED WRONGLY\n"); + printf("ZMMCH WAS CALLED WITH TRANSA = %s AND TRANSB = %s\n", transa,transb); + printf("AND RETURNED SAME = %c AND ERR = %12.3f.\n",(same==FALSE_? 'F':'T'),err); + printf("THIS MAY BE DUE TO FAULTS IN THE ARITHMETIC OR THE COMPILER.\n"); + printf("****** TESTS ABANDONED ******\n"); + exit(1); } *(unsigned char *)transb = 'C'; zmmch_(transa, transb, &n, &c__1, &n, &c_b2, ab, &c__65, &ab[4225], & c__65, &c_b1, c__, &c__65, ct, g, cc, &c__65, &eps, &err, &fatal, - &c__6, &c_true); + &c__6, &c_true, (ftnlen)1, (ftnlen)1); same = lze_(cc, ct, &n); if (! same || err != 0.) { - s_wsfe(&io___71); - do_fio(&c__1, transa, (ftnlen)1); - do_fio(&c__1, transb, (ftnlen)1); - do_fio(&c__1, (char *)&same, (ftnlen)sizeof(logical)); - do_fio(&c__1, (char *)&err, (ftnlen)sizeof(doublereal)); - e_wsfe(); - s_stop("", (ftnlen)0); + printf("ERROR IN ZMMCH - IN-LINE DOT PRODUCTS ARE BEING EVALUATED WRONGLY\n"); + printf("ZMMCH WAS CALLED WITH TRANSA = %s AND TRANSB = %s\n", transa,transb); + printf("AND RETURNED SAME = %c AND ERR = %12.3f.\n",(same==FALSE_? 'F':'T'),err); + printf("THIS MAY BE DUE TO FAULTS IN THE ARITHMETIC OR THE COMPILER.\n"); + printf("****** TESTS ABANDONED ******\n"); + exit(1); } /* Test each subroutine in turn. */ for (isnum = 1; isnum <= 9; ++isnum) { - s_wsle(&io___73); - e_wsle(); if (! ltest[isnum - 1]) { /* Subprogram is not to be tested. */ - s_wsfe(&io___74); - do_fio(&c__1, snames + (isnum - 1) * 13, (ftnlen)13); - e_wsfe(); + printf("%12s WAS NOT TESTED\n",snames[isnum-1]); } else { - s_copy(srnamc_1.srnamt, snames + (isnum - 1) * 13, (ftnlen)13, ( - ftnlen)13); + s_copy(srnamc_1.srnamt, snames[isnum - 1], (ftnlen)12, ( + ftnlen)12); /* Test error exits. */ if (tsterr) { - cz3chke_(snames + (isnum - 1) * 13); - s_wsle(&io___75); - e_wsle(); + cz3chke_(snames[isnum - 1], (ftnlen)12); } /* Test computations. */ infoc_1.infot = 0; infoc_1.ok = TRUE_; fatal = FALSE_; - switch (isnum) { + switch ((int)isnum) { case 1: goto L140; case 2: goto L150; case 3: goto L150; @@ -1132,76 +699,76 @@ L80: /* Test ZGEMM, 01. */ L140: if (corder) { - zchk1_(snames + (isnum - 1) * 13, &eps, &thresh, &c__6, &ntra, + zchk1_(snames[isnum - 1], &eps, &thresh, &c__6, &ntra, &trace, &rewi, &fatal, &nidim, idim, &nalf, alf, & nbet, bet, &c__65, ab, aa, as, &ab[4225], bb, bs, c__, - cc, cs, ct, g, &c__0); + cc, cs, ct, g, &c__0, (ftnlen)12); } if (rorder) { - zchk1_(snames + (isnum - 1) * 13, &eps, &thresh, &c__6, &ntra, + zchk1_(snames[isnum - 1], &eps, &thresh, &c__6, &ntra, &trace, &rewi, &fatal, &nidim, idim, &nalf, alf, & nbet, bet, &c__65, ab, aa, as, &ab[4225], bb, bs, c__, - cc, cs, ct, g, &c__1); + cc, cs, ct, g, &c__1, (ftnlen)12); } goto L190; /* Test ZHEMM, 02, ZSYMM, 03. */ L150: if (corder) { - zchk2_(snames + (isnum - 1) * 13, &eps, &thresh, &c__6, &ntra, + zchk2_(snames[isnum - 1], &eps, &thresh, &c__6, &ntra, &trace, &rewi, &fatal, &nidim, idim, &nalf, alf, & nbet, bet, &c__65, ab, aa, as, &ab[4225], bb, bs, c__, - cc, cs, ct, g, &c__0); + cc, cs, ct, g, &c__0, (ftnlen)12); } if (rorder) { - zchk2_(snames + (isnum - 1) * 13, &eps, &thresh, &c__6, &ntra, + zchk2_(snames[isnum - 1], &eps, &thresh, &c__6, &ntra, &trace, &rewi, &fatal, &nidim, idim, &nalf, alf, & nbet, bet, &c__65, ab, aa, as, &ab[4225], bb, bs, c__, - cc, cs, ct, g, &c__1); + cc, cs, ct, g, &c__1, (ftnlen)12); } goto L190; /* Test ZTRMM, 04, ZTRSM, 05. */ L160: if (corder) { - zchk3_(snames + (isnum - 1) * 13, &eps, &thresh, &c__6, &ntra, + zchk3_(snames[isnum - 1], &eps, &thresh, &c__6, &ntra, &trace, &rewi, &fatal, &nidim, idim, &nalf, alf, & c__65, ab, aa, as, &ab[4225], bb, bs, ct, g, c__, & - c__0); + c__0, (ftnlen)12); } if (rorder) { - zchk3_(snames + (isnum - 1) * 13, &eps, &thresh, &c__6, &ntra, + zchk3_(snames[isnum - 1], &eps, &thresh, &c__6, &ntra, &trace, &rewi, &fatal, &nidim, idim, &nalf, alf, & c__65, ab, aa, as, &ab[4225], bb, bs, ct, g, c__, & - c__1); + c__1, (ftnlen)12); } goto L190; /* Test ZHERK, 06, ZSYRK, 07. */ L170: if (corder) { - zchk4_(snames + (isnum - 1) * 13, &eps, &thresh, &c__6, &ntra, + zchk4_(snames[isnum - 1], &eps, &thresh, &c__6, &ntra, &trace, &rewi, &fatal, &nidim, idim, &nalf, alf, & nbet, bet, &c__65, ab, aa, as, &ab[4225], bb, bs, c__, - cc, cs, ct, g, &c__0); + cc, cs, ct, g, &c__0, (ftnlen)12); } if (rorder) { - zchk4_(snames + (isnum - 1) * 13, &eps, &thresh, &c__6, &ntra, + zchk4_(snames[isnum - 1], &eps, &thresh, &c__6, &ntra, &trace, &rewi, &fatal, &nidim, idim, &nalf, alf, & nbet, bet, &c__65, ab, aa, as, &ab[4225], bb, bs, c__, - cc, cs, ct, g, &c__1); + cc, cs, ct, g, &c__1, (ftnlen)12); } goto L190; /* Test ZHER2K, 08, ZSYR2K, 09. */ L180: if (corder) { - zchk5_(snames + (isnum - 1) * 13, &eps, &thresh, &c__6, &ntra, + zchk5_(snames[isnum - 1], &eps, &thresh, &c__6, &ntra, &trace, &rewi, &fatal, &nidim, idim, &nalf, alf, & nbet, bet, &c__65, ab, aa, as, bb, bs, c__, cc, cs, - ct, g, w, &c__0); + ct, g, w, &c__0, (ftnlen)12); } if (rorder) { - zchk5_(snames + (isnum - 1) * 13, &eps, &thresh, &c__6, &ntra, + zchk5_(snames[isnum - 1], &eps, &thresh, &c__6, &ntra, &trace, &rewi, &fatal, &nidim, idim, &nalf, alf, & nbet, bet, &c__65, ab, aa, as, bb, bs, c__, cc, cs, - ct, g, w, &c__1); + ct, g, w, &c__1, (ftnlen)12); } goto L190; @@ -1212,122 +779,66 @@ L190: } /* L200: */ } - s_wsfe(&io___82); - e_wsfe(); + printf("\nEND OF TESTS\n"); goto L230; L210: - s_wsfe(&io___83); - e_wsfe(); + printf("\n****** FATAL ERROR - TESTS ABANDONED ******\n"); goto L230; L220: - s_wsfe(&io___84); - e_wsfe(); + printf("AMEND DATA FILE OR INCREASE ARRAY SIZES IN PROGRAM\n"); + printf("****** TESTS ABANDONED ******\n"); L230: if (trace) { - cl__1.cerr = 0; +/* cl__1.cerr = 0; cl__1.cunit = ntra; cl__1.csta = 0; - f_clos(&cl__1); + f_clos(&cl__1);*/ } - cl__1.cerr = 0; +/* cl__1.cerr = 0; cl__1.cunit = 6; cl__1.csta = 0; - f_clos(&cl__1); - s_stop("", (ftnlen)0); - + f_clos(&cl__1);*/ + exit(0); /* End of ZBLAT3. */ - return 0; } /* MAIN__ */ -/* Subroutine */ int zchk1_(char *sname, doublereal *eps, doublereal *thresh, - integer *nout, integer *ntra, logical *trace, logical *rewi, logical * - fatal, integer *nidim, integer *idim, integer *nalf, doublecomplex * - alf, integer *nbet, doublecomplex *bet, integer *nmax, doublecomplex * - a, doublecomplex *aa, doublecomplex *as, doublecomplex *b, - doublecomplex *bb, doublecomplex *bs, doublecomplex *c__, - doublecomplex *cc, doublecomplex *cs, doublecomplex *ct, doublereal * - g, integer *iorder) +/* Subroutine */ int zchk1_(char* sname, doublereal* eps, doublereal* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nalf, doublecomplex* alf, integer* nbet, doublecomplex* bet, integer* nmax, doublecomplex* a, doublecomplex* aa, doublecomplex* as, doublecomplex* b, doublecomplex* bb, doublecomplex* bs, doublecomplex* c__, doublecomplex* cc, doublecomplex* cs, doublecomplex* ct, doublereal* g, integer* iorder, ftnlen sname_len) { /* Initialized data */ - static char ich[3] = "NTC"; - - /* Format strings */ - static char fmt_9994[] = "(\002 ******* FATAL ERROR - ERROR-CALL MYEXIT " - "TAKEN ON VALID\002,\002 CALL *******\002)"; - static char fmt_9998[] = "(\002 ******* FATAL ERROR - PARAMETER NUMBER" - " \002,i2,\002 WAS CH\002,\002ANGED INCORRECTLY *******\002)"; - static char fmt_10000[] = "(\002 \002,a13,\002 PASSED THE COLUMN-MAJOR C" - "OMPUTATIONAL TESTS\002,\002 (\002,i6,\002 CALL\002,\002S)\002)"; - static char fmt_10001[] = "(\002 \002,a13,\002 PASSED THE ROW-MAJOR C" - "OMPUTATIONAL TESTS\002,\002 (\002,i6,\002 CALL\002,\002S)\002)"; - static char fmt_10002[] = "(\002 \002,a13,\002 COMPLETED THE COLUMN-MAJO" - "R COMPUTATIONAL \002,\002TESTS (\002,i6,\002 CALLS)\002,/\002 **" - "***** BUT WITH MAXIMUM TEST \002,\002RATIO \002,f8.2,\002 - SUSP" - "ECT *******\002)"; - static char fmt_10003[] = "(\002 \002,a13,\002 COMPLETED THE ROW-MAJOR " - " COMPUTATIONAL \002,\002TESTS (\002,i6,\002 CALLS)\002,/\002 **" - "***** BUT WITH MAXIMUM TEST \002,\002RATIO \002,f8.2,\002 - SUSP" - "ECT *******\002)"; - static char fmt_9996[] = "(\002 ******* \002,a13,\002 FAILED ON CALL NUM" - "BER:\002)"; + static char ich[3+1] = "NTC"; /* System generated locals */ integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2, i__3, i__4, i__5, i__6, i__7, i__8; - alist al__1; /* Local variables */ - extern /* Subroutine */ int czgemm3m_(integer *, char *, char *, integer * - , integer *, integer *, doublecomplex *, doublecomplex *, integer - *, doublecomplex *, integer *, doublecomplex *, doublecomplex *, - integer *); - doublecomplex beta; - integer ldas, ldbs, ldcs; - logical same, null; - integer i__, k, m, n; - doublecomplex alpha; - logical isame[13], trana, tranb; - extern /* Subroutine */ int zmake_(char *, char *, char *, integer *, - integer *, doublecomplex *, integer *, doublecomplex *, integer *, - logical *, doublecomplex *); - integer nargs; - extern /* Subroutine */ int zmmch_(char *, char *, integer *, integer *, - integer *, doublecomplex *, doublecomplex *, integer *, - doublecomplex *, integer *, doublecomplex *, doublecomplex *, - integer *, doublecomplex *, doublereal *, doublecomplex *, - integer *, doublereal *, doublereal *, logical *, integer *, - logical *); - logical reset; - integer ia, ib; - extern /* Subroutine */ int zprcn1_(integer *, integer *, char *, integer - *, char *, char *, integer *, integer *, integer *, doublecomplex - *, integer *, integer *, doublecomplex *, integer *); - integer ma, mb, na, nb, nc, ik, im, in, ks, ms, ns; - char tranas[1], tranbs[1], transa[1], transb[1]; - doublereal errmax; - extern logical lzeres_(char *, char *, integer *, integer *, - doublecomplex *, doublecomplex *, integer *); - integer ica, icb, laa, lbb, lda, lcc, ldb, ldc; - doublecomplex als, bls; - doublereal err; - extern logical lze_(doublecomplex *, doublecomplex *, integer *); - - /* Fortran I/O blocks */ - static cilist io___128 = { 0, 0, 0, fmt_9994, 0 }; - static cilist io___131 = { 0, 0, 0, fmt_9998, 0 }; - static cilist io___133 = { 0, 0, 0, fmt_10000, 0 }; - static cilist io___134 = { 0, 0, 0, fmt_10001, 0 }; - static cilist io___135 = { 0, 0, 0, fmt_10002, 0 }; - static cilist io___136 = { 0, 0, 0, fmt_10003, 0 }; - static cilist io___137 = { 0, 0, 0, fmt_9996, 0 }; - - + static doublecomplex beta; + static integer ldas, ldbs, ldcs; + static logical same, null; + static integer i__, k, m, n; + static doublecomplex alpha; + static logical isame[13], trana, tranb; + extern /* Subroutine */ int zmake_(char*, char*, char*, integer*, integer*, doublecomplex*, integer*, doublecomplex*, integer*, logical*, doublecomplex*, ftnlen, ftnlen, ftnlen); + static integer nargs; + extern /* Subroutine */ int zmmch_(char*, char*, integer*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, doublereal*, doublecomplex*, integer*, doublereal*, doublereal*, logical*, integer*, logical*, ftnlen, ftnlen); + static logical reset; + static integer ia, ib; + extern /* Subroutine */ int zprcn1_(integer*, integer*, char*, integer*, char*, char*, integer*, integer*, integer*, doublecomplex*, integer*, integer*, doublecomplex*, integer*, ftnlen, ftnlen, ftnlen); + static integer ma, mb, na, nb, nc, ik, im, in, ks, ms, ns; + extern /* Subroutine */ void czgemm3m_(integer*, char*, char*, integer*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, integer*, doublecomplex*, doublecomplex*, integer*, ftnlen, ftnlen); + static char tranas[1], tranbs[1], transa[1], transb[1]; + static doublereal errmax; + extern logical lzeres_(char*, char*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, ftnlen, ftnlen); + static integer ica, icb, laa, lbb, lda, lcc, ldb, ldc; + static doublecomplex als, bls; + static doublereal err; + extern logical lze_(doublecomplex*, doublecomplex*, integer*); /* Tests ZGEMM. */ @@ -1339,6 +850,17 @@ L230: /* Jeremy Du Croz, Numerical Algorithms Group Ltd. */ /* Sven Hammarling, Numerical Algorithms Group Ltd. */ +/* .. Parameters .. */ +/* .. Scalar Arguments .. */ +/* .. Array Arguments .. */ +/* .. Local Scalars .. */ +/* .. Local Arrays .. */ +/* .. External Functions .. */ +/* .. External Subroutines .. */ +/* .. Intrinsic Functions .. */ +/* .. Scalars in Common .. */ +/* .. Common blocks .. */ +/* .. Data statements .. */ /* Parameter adjustments */ --idim; --alf; @@ -1362,6 +884,7 @@ L230: a -= a_offset; /* Function Body */ +/* .. Executable Statements .. */ nargs = 13; nc = 0; @@ -1418,7 +941,8 @@ L230: /* Generate the matrix A. */ zmake_("ge", " ", " ", &ma, &na, &a[a_offset], nmax, &aa[ - 1], &lda, &reset, &c_b1); + 1], &lda, &reset, &c_b1, (ftnlen)2, (ftnlen)1, ( + ftnlen)1); for (icb = 1; icb <= 3; ++icb) { *(unsigned char *)transb = *(unsigned char *)&ich[icb @@ -1447,7 +971,8 @@ L230: /* Generate the matrix B. */ zmake_("ge", " ", " ", &mb, &nb, &b[b_offset], nmax, & - bb[1], &ldb, &reset, &c_b1); + bb[1], &ldb, &reset, &c_b1, (ftnlen)2, ( + ftnlen)1, (ftnlen)1); i__4 = *nalf; for (ia = 1; ia <= i__4; ++ia) { @@ -1462,7 +987,8 @@ L230: /* Generate the matrix C. */ zmake_("ge", " ", " ", &m, &n, &c__[c_offset], - nmax, &cc[1], &ldc, &reset, &c_b1); + nmax, &cc[1], &ldc, &reset, &c_b1, ( + ftnlen)2, (ftnlen)1, (ftnlen)1); ++nc; @@ -1511,23 +1037,23 @@ L230: if (*trace) { zprcn1_(ntra, &nc, sname, iorder, transa, transb, &m, &n, &k, &alpha, &lda, - &ldb, &beta, &ldc); + &ldb, &beta, &ldc, (ftnlen)12, ( + ftnlen)1, (ftnlen)1); } if (*rewi) { - al__1.aerr = 0; +/* al__1.aerr = 0; al__1.aunit = *ntra; - f_rew(&al__1); + f_rew(&al__1);*/ } - czgemm3m_(iorder, transa, transb, &m, &n, &k, - &alpha, &aa[1], &lda, &bb[1], &ldb, & - beta, &cc[1], &ldc); + czgemm3m_(iorder, transa, transb, &m, &n, &k, & + alpha, &aa[1], &lda, &bb[1], &ldb, & + beta, &cc[1], &ldc, (ftnlen)1, ( + ftnlen)1); /* Check if error-exit was taken incorrectly. */ if (! infoc_1.ok) { - io___128.ciunit = *nout; - s_wsfe(&io___128); - e_wsfe(); + printf(" *** FATAL ERROR - ERROR-CALL MYEXIT TAKEN ON VALID CALL\n"); *fatal = TRUE_; goto L120; } @@ -1553,7 +1079,8 @@ L230: isame[11] = lze_(&cs[1], &cc[1], &lcc); } else { isame[11] = lzeres_("ge", " ", &m, &n, & - cs[1], &cc[1], &ldc); + cs[1], &cc[1], &ldc, (ftnlen)2, ( + ftnlen)1); } isame[12] = ldcs == ldc; @@ -1565,11 +1092,7 @@ L230: for (i__ = 1; i__ <= i__6; ++i__) { same = same && isame[i__ - 1]; if (! isame[i__ - 1]) { - io___131.ciunit = *nout; - s_wsfe(&io___131); - do_fio(&c__1, (char *)&i__, (ftnlen) - sizeof(integer)); - e_wsfe(); + printf(" ******* FATAL ERROR - PARAMETER NUMBER %d WAS CHANGED INCORRECTLY *******\n",i__); } /* L40: */ } @@ -1586,7 +1109,8 @@ L230: &a[a_offset], nmax, &b[b_offset], nmax, &beta, &c__[c_offset], nmax, &ct[1], &g[1], &cc[1], &ldc, - eps, &err, fatal, nout, &c_true); + eps, &err, fatal, nout, &c_true, + (ftnlen)1, (ftnlen)1); errmax = f2cmax(errmax,err); /* If got really bad answer, report and */ /* return. */ @@ -1623,76 +1147,44 @@ L100: if (errmax < *thresh) { if (*iorder == 0) { - io___133.ciunit = *nout; - s_wsfe(&io___133); - do_fio(&c__1, sname, (ftnlen)13); - do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer)); - e_wsfe(); + printf("%s PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS (%d CALLS)\n",sname,nc); } if (*iorder == 1) { - io___134.ciunit = *nout; - s_wsfe(&io___134); - do_fio(&c__1, sname, (ftnlen)13); - do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer)); - e_wsfe(); + printf("%s PASSED THE ROW-MAJOR COMPUTATIONAL TESTS (%d CALLS)\n",sname,nc); } } else { if (*iorder == 0) { - io___135.ciunit = *nout; - s_wsfe(&io___135); - do_fio(&c__1, sname, (ftnlen)13); - do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer)); - do_fio(&c__1, (char *)&errmax, (ftnlen)sizeof(doublereal)); - e_wsfe(); + printf("%s COMPLETED THE COLUMN-MAJOR COMPUTATIONAL TESTS (%d CALLS)/n",sname,nc); + printf("***** BUT WITH MAXIMUM TEST RATIO %8.2f - SUSPECT *******/n",errmax); } if (*iorder == 1) { - io___136.ciunit = *nout; - s_wsfe(&io___136); - do_fio(&c__1, sname, (ftnlen)13); - do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer)); - do_fio(&c__1, (char *)&errmax, (ftnlen)sizeof(doublereal)); - e_wsfe(); + printf("%s COMPLETED THE ROW-MAJOR COMPUTATIONAL TESTS (%d CALLS)/n",sname,nc); + printf("***** BUT WITH MAXIMUM TEST RATIO %8.2f - SUSPECT *******/n",errmax); } } goto L130; L120: - io___137.ciunit = *nout; - s_wsfe(&io___137); - do_fio(&c__1, sname, (ftnlen)13); - e_wsfe(); + printf(" ******* %s FAILED ON CALL NUMBER:\n",sname); zprcn1_(nout, &nc, sname, iorder, transa, transb, &m, &n, &k, &alpha, & - lda, &ldb, &beta, &ldc); + lda, &ldb, &beta, &ldc, (ftnlen)12, (ftnlen)1, (ftnlen)1); L130: return 0; -/* L9995: */ +/* 9995 FORMAT( 1X, I6, ': ', A12,'(''', A1, ''',''', A1, ''',', */ +/* $ 3( I3, ',' ), '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3, */ +/* $ ',(', F4.1, ',', F4.1, '), C,', I3, ').' ) */ /* End of ZCHK1. */ } /* zchk1_ */ -/* Subroutine */ int zprcn1_(integer *nout, integer *nc, char *sname, integer - *iorder, char *transa, char *transb, integer *m, integer *n, integer * - k, doublecomplex *alpha, integer *lda, integer *ldb, doublecomplex * - beta, integer *ldc) +/* Subroutine */ int zprcn1_(integer* nout, integer* nc, char* sname, integer* iorder, char* transa, char* transb, integer* m, integer* n, integer* k, doublecomplex* alpha, integer* lda, integer* ldb, doublecomplex* beta, integer* ldc, ftnlen sname_len, ftnlen transa_len, ftnlen transb_len) { - /* Format strings */ - static char fmt_9995[] = "(1x,i6,\002: \002,a13,\002(\002,a15,\002,\002," - "a14,\002,\002,a14,\002,\002)"; - static char fmt_9994[] = "(10x,3(i3,\002,\002),\002 (\002,f4.1,\002,\002" - ",f4.1,\002) , A,\002,i3,\002, B,\002,i3,\002, (\002,f4.1,\002" - ",\002,f4.1,\002) , C,\002,i3,\002).\002)"; - /* Local variables */ - char crc[14], cta[14], ctb[14]; - - /* Fortran I/O blocks */ - static cilist io___141 = { 0, 0, 0, fmt_9995, 0 }; - static cilist io___142 = { 0, 0, 0, fmt_9994, 0 }; - + static char crc[14], cta[14], ctb[14]; if (*(unsigned char *)transa == 'N') { s_copy(cta, " CblasNoTrans", (ftnlen)14, (ftnlen)14); @@ -1713,123 +1205,52 @@ L130: } else { s_copy(crc, " CblasColMajor", (ftnlen)14, (ftnlen)14); } - io___141.ciunit = *nout; - s_wsfe(&io___141); - do_fio(&c__1, (char *)&(*nc), (ftnlen)sizeof(integer)); - do_fio(&c__1, sname, (ftnlen)13); - do_fio(&c__1, crc, (ftnlen)14); - do_fio(&c__1, cta, (ftnlen)14); - do_fio(&c__1, ctb, (ftnlen)14); - e_wsfe(); - io___142.ciunit = *nout; - s_wsfe(&io___142); - do_fio(&c__1, (char *)&(*m), (ftnlen)sizeof(integer)); - do_fio(&c__1, (char *)&(*n), (ftnlen)sizeof(integer)); - do_fio(&c__1, (char *)&(*k), (ftnlen)sizeof(integer)); - do_fio(&c__2, (char *)&(*alpha), (ftnlen)sizeof(doublereal)); - do_fio(&c__1, (char *)&(*lda), (ftnlen)sizeof(integer)); - do_fio(&c__1, (char *)&(*ldb), (ftnlen)sizeof(integer)); - do_fio(&c__2, (char *)&(*beta), (ftnlen)sizeof(doublereal)); - do_fio(&c__1, (char *)&(*ldc), (ftnlen)sizeof(integer)); - e_wsfe(); - return 0; + printf("%6d: %s %s %s %s\n",*nc,sname,crc,cta,ctb); + printf("%d %d %d (%4.1lf,%4.1lf) , A, %d, B, %d, (%4.1lf,%4.1lf) , C, %d.\n",*m,*n,*k,alpha->r,alpha->i,*lda,*ldb,beta->r,beta->i,*ldc); + +return 0; } /* zprcn1_ */ -/* Subroutine */ int zchk2_(char *sname, doublereal *eps, doublereal *thresh, - integer *nout, integer *ntra, logical *trace, logical *rewi, logical * - fatal, integer *nidim, integer *idim, integer *nalf, doublecomplex * - alf, integer *nbet, doublecomplex *bet, integer *nmax, doublecomplex * - a, doublecomplex *aa, doublecomplex *as, doublecomplex *b, - doublecomplex *bb, doublecomplex *bs, doublecomplex *c__, - doublecomplex *cc, doublecomplex *cs, doublecomplex *ct, doublereal * - g, integer *iorder) +/* Subroutine */ int zchk2_(char* sname, doublereal* eps, doublereal* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nalf, doublecomplex* alf, integer* nbet, doublecomplex* bet, integer* nmax, doublecomplex* a, doublecomplex* aa, doublecomplex* as, doublecomplex* b, doublecomplex* bb, doublecomplex* bs, doublecomplex* c__, doublecomplex* cc, doublecomplex* cs, doublecomplex* ct, doublereal* g, integer* iorder, ftnlen sname_len) { /* Initialized data */ - static char ichs[2] = "LR"; - static char ichu[2] = "UL"; - - /* Format strings */ - static char fmt_9994[] = "(\002 ******* FATAL ERROR - ERROR-CALL MYEXIT " - "TAKEN ON VALID\002,\002 CALL *******\002)"; - static char fmt_9998[] = "(\002 ******* FATAL ERROR - PARAMETER NUMBER" - " \002,i2,\002 WAS CH\002,\002ANGED INCORRECTLY *******\002)"; - static char fmt_10000[] = "(\002 \002,a13,\002 PASSED THE COLUMN-MAJOR C" - "OMPUTATIONAL TESTS\002,\002 (\002,i6,\002 CALL\002,\002S)\002)"; - static char fmt_10001[] = "(\002 \002,a13,\002 PASSED THE ROW-MAJOR C" - "OMPUTATIONAL TESTS\002,\002 (\002,i6,\002 CALL\002,\002S)\002)"; - static char fmt_10002[] = "(\002 \002,a13,\002 COMPLETED THE COLUMN-MAJO" - "R COMPUTATIONAL \002,\002TESTS (\002,i6,\002 CALLS)\002,/\002 **" - "***** BUT WITH MAXIMUM TEST \002,\002RATIO \002,f8.2,\002 - SUSP" - "ECT *******\002)"; - static char fmt_10003[] = "(\002 \002,a13,\002 COMPLETED THE ROW-MAJOR " - " COMPUTATIONAL \002,\002TESTS (\002,i6,\002 CALLS)\002,/\002 **" - "***** BUT WITH MAXIMUM TEST \002,\002RATIO \002,f8.2,\002 - SUSP" - "ECT *******\002)"; - static char fmt_9996[] = "(\002 ******* \002,a13,\002 FAILED ON CALL NUM" - "BER:\002)"; + static char ichs[2+1] = "LR"; + static char ichu[2+1] = "UL"; /* System generated locals */ integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2, i__3, i__4, i__5, i__6, i__7; - alist al__1; /* Local variables */ - doublecomplex beta; - integer ldas, ldbs, ldcs; - logical same; - char side[1]; - logical conj, left, null; - char uplo[1]; - integer i__, m, n; - doublecomplex alpha; - logical isame[13]; - char sides[1]; - extern /* Subroutine */ int zmake_(char *, char *, char *, integer *, - integer *, doublecomplex *, integer *, doublecomplex *, integer *, - logical *, doublecomplex *); - integer nargs; - extern /* Subroutine */ int zmmch_(char *, char *, integer *, integer *, - integer *, doublecomplex *, doublecomplex *, integer *, - doublecomplex *, integer *, doublecomplex *, doublecomplex *, - integer *, doublecomplex *, doublereal *, doublecomplex *, - integer *, doublereal *, doublereal *, logical *, integer *, - logical *); - logical reset; - char uplos[1]; - integer ia, ib; - extern /* Subroutine */ int zprcn2_(integer *, integer *, char *, integer - *, char *, char *, integer *, integer *, doublecomplex *, integer - *, integer *, doublecomplex *, integer *); - integer na, nc, im, in, ms, ns; - extern /* Subroutine */ int czhemm_(integer *, char *, char *, integer *, - integer *, doublecomplex *, doublecomplex *, integer *, - doublecomplex *, integer *, doublecomplex *, doublecomplex *, - integer *); - doublereal errmax; - extern logical lzeres_(char *, char *, integer *, integer *, - doublecomplex *, doublecomplex *, integer *); - extern /* Subroutine */ int czsymm_(integer *, char *, char *, integer *, - integer *, doublecomplex *, doublecomplex *, integer *, - doublecomplex *, integer *, doublecomplex *, doublecomplex *, - integer *); - integer laa, lbb, lda, lcc, ldb, ldc, ics; - doublecomplex als, bls; - integer icu; - doublereal err; - extern logical lze_(doublecomplex *, doublecomplex *, integer *); - - /* Fortran I/O blocks */ - static cilist io___181 = { 0, 0, 0, fmt_9994, 0 }; - static cilist io___184 = { 0, 0, 0, fmt_9998, 0 }; - static cilist io___186 = { 0, 0, 0, fmt_10000, 0 }; - static cilist io___187 = { 0, 0, 0, fmt_10001, 0 }; - static cilist io___188 = { 0, 0, 0, fmt_10002, 0 }; - static cilist io___189 = { 0, 0, 0, fmt_10003, 0 }; - static cilist io___190 = { 0, 0, 0, fmt_9996, 0 }; - - + static doublecomplex beta; + static integer ldas, ldbs, ldcs; + static logical same; + static char side[1]; + static logical isconj, left, null; + static char uplo[1]; + static integer i__, m, n; + static doublecomplex alpha; + static logical isame[13]; + static char sides[1]; + extern /* Subroutine */ int zmake_(char*, char*, char*, integer*, integer*, doublecomplex*, integer*, doublecomplex*, integer*, logical*, doublecomplex*, ftnlen, ftnlen, ftnlen); + static integer nargs; + extern /* Subroutine */ int zmmch_(char*, char*, integer*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, doublereal*, doublecomplex*, integer*, doublereal*, doublereal*, logical*, integer*, logical*, ftnlen, ftnlen); + static logical reset; + static char uplos[1]; + static integer ia, ib; + extern /* Subroutine */ int zprcn2_(integer*, integer*, char*, integer*, char*, char*, integer*, integer*, doublecomplex*, integer*, integer*, doublecomplex*, integer*, ftnlen, ftnlen, ftnlen); + static integer na, nc, im, in, ms, ns; + extern /* Subroutine */ void czhemm_(integer*, char*, char*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, integer*, doublecomplex*, doublecomplex*, integer*, ftnlen, ftnlen); + static doublereal errmax; + extern logical lzeres_(char*, char*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, ftnlen, ftnlen); + extern /* Subroutine */ void czsymm_(integer*, char*, char*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, integer*, doublecomplex*, doublecomplex*, integer*, ftnlen, ftnlen); + static integer laa, lbb, lda, lcc, ldb, ldc, ics; + static doublecomplex als, bls; + static integer icu; + static doublereal err; + extern logical lze_(doublecomplex*, doublecomplex*, integer*); /* Tests ZHEMM and ZSYMM. */ @@ -1841,6 +1262,17 @@ L130: /* Jeremy Du Croz, Numerical Algorithms Group Ltd. */ /* Sven Hammarling, Numerical Algorithms Group Ltd. */ +/* .. Parameters .. */ +/* .. Scalar Arguments .. */ +/* .. Array Arguments .. */ +/* .. Local Scalars .. */ +/* .. Local Arrays .. */ +/* .. External Functions .. */ +/* .. External Subroutines .. */ +/* .. Intrinsic Functions .. */ +/* .. Scalars in Common .. */ +/* .. Common blocks .. */ +/* .. Data statements .. */ /* Parameter adjustments */ --idim; --alf; @@ -1864,7 +1296,8 @@ L130: a -= a_offset; /* Function Body */ - conj = s_cmp(sname + 7, "he", (ftnlen)2, (ftnlen)2) == 0; +/* .. Executable Statements .. */ + isconj = s_cmp(sname + 7, "he", (ftnlen)2, (ftnlen)2) == 0; nargs = 12; nc = 0; @@ -1903,7 +1336,7 @@ L130: /* Generate the matrix B. */ zmake_("ge", " ", " ", &m, &n, &b[b_offset], nmax, &bb[1], &ldb, & - reset, &c_b1); + reset, &c_b1, (ftnlen)2, (ftnlen)1, (ftnlen)1); for (ics = 1; ics <= 2; ++ics) { *(unsigned char *)side = *(unsigned char *)&ichs[ics - 1]; @@ -1931,7 +1364,8 @@ L130: /* Generate the hermitian or symmetric matrix A. */ zmake_(sname + 7, uplo, " ", &na, &na, &a[a_offset], nmax, - &aa[1], &lda, &reset, &c_b1); + &aa[1], &lda, &reset, &c_b1, (ftnlen)2, (ftnlen) + 1, (ftnlen)1); i__3 = *nalf; for (ia = 1; ia <= i__3; ++ia) { @@ -1946,7 +1380,8 @@ L130: /* Generate the matrix C. */ zmake_("ge", " ", " ", &m, &n, &c__[c_offset], - nmax, &cc[1], &ldc, &reset, &c_b1); + nmax, &cc[1], &ldc, &reset, &c_b1, ( + ftnlen)2, (ftnlen)1, (ftnlen)1); ++nc; @@ -1992,30 +1427,28 @@ L130: if (*trace) { zprcn2_(ntra, &nc, sname, iorder, side, uplo, &m, &n, &alpha, &lda, &ldb, &beta, & - ldc) + ldc, (ftnlen)12, (ftnlen)1, (ftnlen)1) ; } if (*rewi) { - al__1.aerr = 0; +/* al__1.aerr = 0; al__1.aunit = *ntra; - f_rew(&al__1); + f_rew(&al__1);*/ } - if (conj) { + if (isconj) { czhemm_(iorder, side, uplo, &m, &n, &alpha, & aa[1], &lda, &bb[1], &ldb, &beta, &cc[ - 1], &ldc); + 1], &ldc, (ftnlen)1, (ftnlen)1); } else { czsymm_(iorder, side, uplo, &m, &n, &alpha, & aa[1], &lda, &bb[1], &ldb, &beta, &cc[ - 1], &ldc); + 1], &ldc, (ftnlen)1, (ftnlen)1); } /* Check if error-exit was taken incorrectly. */ if (! infoc_1.ok) { - io___181.ciunit = *nout; - s_wsfe(&io___181); - e_wsfe(); + printf("*** FATAL ERROR - ERROR-CALL MYEXIT TAKEN ON VALID CALL\n"); *fatal = TRUE_; goto L110; } @@ -2038,7 +1471,7 @@ L130: isame[10] = lze_(&cs[1], &cc[1], &lcc); } else { isame[10] = lzeres_("ge", " ", &m, &n, &cs[1], - &cc[1], &ldc); + &cc[1], &ldc, (ftnlen)2, (ftnlen)1); } isame[11] = ldcs == ldc; @@ -2050,11 +1483,7 @@ L130: for (i__ = 1; i__ <= i__5; ++i__) { same = same && isame[i__ - 1]; if (! isame[i__ - 1]) { - io___184.ciunit = *nout; - s_wsfe(&io___184); - do_fio(&c__1, (char *)&i__, (ftnlen) - sizeof(integer)); - e_wsfe(); + printf(" ******* FATAL ERROR - PARAMETER NUMBER %d WAS CHANGED INCORRECTLY *******\n",i__); } /* L40: */ } @@ -2072,13 +1501,15 @@ L130: a_offset], nmax, &b[b_offset], nmax, &beta, &c__[c_offset], nmax, &ct[1], &g[1], &cc[1], &ldc, eps, - &err, fatal, nout, &c_true); + &err, fatal, nout, &c_true, ( + ftnlen)1, (ftnlen)1); } else { zmmch_("N", "N", &m, &n, &n, &alpha, &b[ b_offset], nmax, &a[a_offset], nmax, &beta, &c__[c_offset], nmax, &ct[1], &g[1], &cc[1], &ldc, eps, - &err, fatal, nout, &c_true); + &err, fatal, nout, &c_true, ( + ftnlen)1, (ftnlen)1); } errmax = f2cmax(errmax,err); /* If got really bad answer, report and */ @@ -2112,76 +1543,44 @@ L90: if (errmax < *thresh) { if (*iorder == 0) { - io___186.ciunit = *nout; - s_wsfe(&io___186); - do_fio(&c__1, sname, (ftnlen)13); - do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer)); - e_wsfe(); + printf("%s PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS (%d CALLS)\n",sname,nc); } if (*iorder == 1) { - io___187.ciunit = *nout; - s_wsfe(&io___187); - do_fio(&c__1, sname, (ftnlen)13); - do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer)); - e_wsfe(); + printf("%s PASSED THE ROW-MAJOR COMPUTATIONAL TESTS (%d CALLS)\n",sname,nc); } } else { if (*iorder == 0) { - io___188.ciunit = *nout; - s_wsfe(&io___188); - do_fio(&c__1, sname, (ftnlen)13); - do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer)); - do_fio(&c__1, (char *)&errmax, (ftnlen)sizeof(doublereal)); - e_wsfe(); + printf("%s COMPLETED THE COLUMN-MAJOR COMPUTATIONAL TESTS (%d CALLS)/n",sname,nc); + printf("***** BUT WITH MAXIMUM TEST RATIO %8.2f - SUSPECT *******/n",errmax); } if (*iorder == 1) { - io___189.ciunit = *nout; - s_wsfe(&io___189); - do_fio(&c__1, sname, (ftnlen)13); - do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer)); - do_fio(&c__1, (char *)&errmax, (ftnlen)sizeof(doublereal)); - e_wsfe(); + printf("%s COMPLETED THE ROW-MAJOR COMPUTATIONAL TESTS (%d CALLS)/n",sname,nc); + printf("***** BUT WITH MAXIMUM TEST RATIO %8.2f - SUSPECT *******/n",errmax); } } goto L120; L110: - io___190.ciunit = *nout; - s_wsfe(&io___190); - do_fio(&c__1, sname, (ftnlen)13); - e_wsfe(); + printf(" ******* %s FAILED ON CALL NUMBER:\n",sname); zprcn2_(nout, &nc, sname, iorder, side, uplo, &m, &n, &alpha, &lda, &ldb, - &beta, &ldc); + &beta, &ldc, (ftnlen)12, (ftnlen)1, (ftnlen)1); L120: return 0; -/* L9995: */ +/* 9995 FORMAT(1X, I6, ': ', A12,'(', 2( '''', A1, ''',' ), 2( I3, ',' ), */ +/* $ '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3, ',(', F4.1, */ +/* $ ',', F4.1, '), C,', I3, ') .' ) */ /* End of ZCHK2. */ } /* zchk2_ */ -/* Subroutine */ int zprcn2_(integer *nout, integer *nc, char *sname, integer - *iorder, char *side, char *uplo, integer *m, integer *n, - doublecomplex *alpha, integer *lda, integer *ldb, doublecomplex *beta, - integer *ldc) +/* Subroutine */ int zprcn2_(integer* nout, integer* nc, char* sname, integer* iorder, char* side, char* uplo, integer* m, integer* n, doublecomplex* alpha, integer* lda, integer* ldb, doublecomplex* beta, integer* ldc, ftnlen sname_len, ftnlen side_len, ftnlen uplo_len) { - /* Format strings */ - static char fmt_9995[] = "(1x,i6,\002: \002,a13,\002(\002,a15,\002,\002," - "a14,\002,\002,a14,\002,\002)"; - static char fmt_9994[] = "(10x,2(i3,\002,\002),\002 (\002,f4.1,\002,\002" - ",f4.1,\002), A,\002,i3,\002, B,\002,i3,\002, (\002,f4.1,\002," - "\002,f4.1,\002), \002,\002C,\002,i3,\002).\002)"; - /* Local variables */ - char cs[14], cu[14], crc[14]; - - /* Fortran I/O blocks */ - static cilist io___194 = { 0, 0, 0, fmt_9995, 0 }; - static cilist io___195 = { 0, 0, 0, fmt_9994, 0 }; - + static char cs[14], cu[14], crc[14]; if (*(unsigned char *)side == 'L') { s_copy(cs, " CblasLeft", (ftnlen)14, (ftnlen)14); @@ -2198,123 +1597,57 @@ L120: } else { s_copy(crc, " CblasColMajor", (ftnlen)14, (ftnlen)14); } - io___194.ciunit = *nout; - s_wsfe(&io___194); - do_fio(&c__1, (char *)&(*nc), (ftnlen)sizeof(integer)); - do_fio(&c__1, sname, (ftnlen)13); - do_fio(&c__1, crc, (ftnlen)14); - do_fio(&c__1, cs, (ftnlen)14); - do_fio(&c__1, cu, (ftnlen)14); - e_wsfe(); - io___195.ciunit = *nout; - s_wsfe(&io___195); - do_fio(&c__1, (char *)&(*m), (ftnlen)sizeof(integer)); - do_fio(&c__1, (char *)&(*n), (ftnlen)sizeof(integer)); - do_fio(&c__2, (char *)&(*alpha), (ftnlen)sizeof(doublereal)); - do_fio(&c__1, (char *)&(*lda), (ftnlen)sizeof(integer)); - do_fio(&c__1, (char *)&(*ldb), (ftnlen)sizeof(integer)); - do_fio(&c__2, (char *)&(*beta), (ftnlen)sizeof(doublereal)); - do_fio(&c__1, (char *)&(*ldc), (ftnlen)sizeof(integer)); - e_wsfe(); - return 0; + printf("%6d: %s %s %s %s\n",*nc,sname,crc,cs,cu); + printf("%d %d (%4.1lf,%4.1lf) , A, %d, B, %d, (%4.1lf,%4.1lf) , C, %d.\n",*m,*n,alpha->r,alpha->i,*lda,*ldb,beta->r,beta->i,*ldc); + +return 0; } /* zprcn2_ */ -/* Subroutine */ int zchk3_(char *sname, doublereal *eps, doublereal *thresh, - integer *nout, integer *ntra, logical *trace, logical *rewi, logical * - fatal, integer *nidim, integer *idim, integer *nalf, doublecomplex * - alf, integer *nmax, doublecomplex *a, doublecomplex *aa, - doublecomplex *as, doublecomplex *b, doublecomplex *bb, doublecomplex - *bs, doublecomplex *ct, doublereal *g, doublecomplex *c__, integer * - iorder) +/* Subroutine */ int zchk3_(char* sname, doublereal* eps, doublereal* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nalf, doublecomplex* alf, integer* nmax, doublecomplex* a, doublecomplex* aa, doublecomplex* as, doublecomplex* b, doublecomplex* bb, doublecomplex* bs, doublecomplex* ct, doublereal* g, doublecomplex* c__, integer* iorder, ftnlen sname_len) { /* Initialized data */ - static char ichu[2] = "UL"; - static char icht[3] = "NTC"; - static char ichd[2] = "UN"; - static char ichs[2] = "LR"; - - /* Format strings */ - static char fmt_9994[] = "(\002 ******* FATAL ERROR - ERROR-CALL MYEXIT " - "TAKEN ON VALID\002,\002 CALL *******\002)"; - static char fmt_9998[] = "(\002 ******* FATAL ERROR - PARAMETER NUMBER" - " \002,i2,\002 WAS CH\002,\002ANGED INCORRECTLY *******\002)"; - static char fmt_10000[] = "(\002 \002,a13,\002 PASSED THE COLUMN-MAJOR C" - "OMPUTATIONAL TESTS\002,\002 (\002,i6,\002 CALL\002,\002S)\002)"; - static char fmt_10001[] = "(\002 \002,a13,\002 PASSED THE ROW-MAJOR C" - "OMPUTATIONAL TESTS\002,\002 (\002,i6,\002 CALL\002,\002S)\002)"; - static char fmt_10002[] = "(\002 \002,a13,\002 COMPLETED THE COLUMN-MAJO" - "R COMPUTATIONAL \002,\002TESTS (\002,i6,\002 CALLS)\002,/\002 **" - "***** BUT WITH MAXIMUM TEST \002,\002RATIO \002,f8.2,\002 - SUSP" - "ECT *******\002)"; - static char fmt_10003[] = "(\002 \002,a13,\002 COMPLETED THE ROW-MAJOR " - " COMPUTATIONAL \002,\002TESTS (\002,i6,\002 CALLS)\002,/\002 **" - "***** BUT WITH MAXIMUM TEST \002,\002RATIO \002,f8.2,\002 - SUSP" - "ECT *******\002)"; - static char fmt_9996[] = "(\002 ******* \002,a13,\002 FAILED ON CALL NUM" - "BER:\002)"; + static char ichu[2+1] = "UL"; + static char icht[3+1] = "NTC"; + static char ichd[2+1] = "UN"; + static char ichs[2+1] = "LR"; /* System generated locals */ integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2, i__3, i__4, i__5, i__6, i__7; doublecomplex z__1; - alist al__1; /* Local variables */ - char diag[1]; - integer ldas, ldbs; - logical same; - char side[1]; - logical left, null; - char uplo[1]; - integer i__, j, m, n; - doublecomplex alpha; - char diags[1]; - logical isame[13]; - char sides[1]; - extern /* Subroutine */ int zmake_(char *, char *, char *, integer *, - integer *, doublecomplex *, integer *, doublecomplex *, integer *, - logical *, doublecomplex *); - integer nargs; - extern /* Subroutine */ int zmmch_(char *, char *, integer *, integer *, - integer *, doublecomplex *, doublecomplex *, integer *, - doublecomplex *, integer *, doublecomplex *, doublecomplex *, - integer *, doublecomplex *, doublereal *, doublecomplex *, - integer *, doublereal *, doublereal *, logical *, integer *, - logical *); - logical reset; - char uplos[1]; - integer ia, na; - extern /* Subroutine */ int zprcn3_(integer *, integer *, char *, integer - *, char *, char *, char *, char *, integer *, integer *, - doublecomplex *, integer *, integer *); - integer nc, im, in, ms, ns; - char tranas[1], transa[1]; - doublereal errmax; - extern logical lzeres_(char *, char *, integer *, integer *, - doublecomplex *, doublecomplex *, integer *); - extern /* Subroutine */ int cztrmm_(integer *, char *, char *, char *, - char *, integer *, integer *, doublecomplex *, doublecomplex *, - integer *, doublecomplex *, integer *), cztrsm_(integer *, char *, char *, char *, char *, - integer *, integer *, doublecomplex *, doublecomplex *, integer *, - doublecomplex *, integer *); - integer laa, icd, lbb, lda, ldb, ics; - doublecomplex als; - integer ict, icu; - doublereal err; - extern logical lze_(doublecomplex *, doublecomplex *, integer *); - - /* Fortran I/O blocks */ - static cilist io___236 = { 0, 0, 0, fmt_9994, 0 }; - static cilist io___239 = { 0, 0, 0, fmt_9998, 0 }; - static cilist io___241 = { 0, 0, 0, fmt_10000, 0 }; - static cilist io___242 = { 0, 0, 0, fmt_10001, 0 }; - static cilist io___243 = { 0, 0, 0, fmt_10002, 0 }; - static cilist io___244 = { 0, 0, 0, fmt_10003, 0 }; - static cilist io___245 = { 0, 0, 0, fmt_9996, 0 }; - - + static char diag[1]; + static integer ldas, ldbs; + static logical same; + static char side[1]; + static logical left, null; + static char uplo[1]; + static integer i__, j, m, n; + static doublecomplex alpha; + static char diags[1]; + static logical isame[13]; + static char sides[1]; + extern /* Subroutine */ int zmake_(char*, char*, char*, integer*, integer*, doublecomplex*, integer*, doublecomplex*, integer*, logical*, doublecomplex*, ftnlen, ftnlen, ftnlen); + static integer nargs; + extern /* Subroutine */ int zmmch_(char*, char*, integer*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, doublereal*, doublecomplex*, integer*, doublereal*, doublereal*, logical*, integer*, logical*, ftnlen, ftnlen); + static logical reset; + static char uplos[1]; + static integer ia, na; + extern /* Subroutine */ int zprcn3_(integer*, integer*, char*, integer*, char*, char*, char*, char*, integer*, integer*, doublecomplex*, integer*, integer*, ftnlen, ftnlen, ftnlen, ftnlen, ftnlen); + static integer nc, im, in, ms, ns; + static char tranas[1], transa[1]; + static doublereal errmax; + extern logical lzeres_(char*, char*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, ftnlen, ftnlen); + extern /* Subroutine */ void cztrmm_(integer*, char*, char*, char*, char*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, integer*, ftnlen, ftnlen, ftnlen, ftnlen); + extern /* Subroutine */ void cztrsm_(integer*, char*, char*, char*, char*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, integer*, ftnlen, ftnlen, ftnlen, ftnlen); + static integer laa, icd, lbb, lda, ldb, ics; + static doublecomplex als; + static integer ict, icu; + static doublereal err; + extern logical lze_(doublecomplex*, doublecomplex*, integer*); /* Tests ZTRMM and ZTRSM. */ @@ -2326,6 +1659,17 @@ L120: /* Jeremy Du Croz, Numerical Algorithms Group Ltd. */ /* Sven Hammarling, Numerical Algorithms Group Ltd. */ +/* .. Parameters .. */ +/* .. Scalar Arguments .. */ +/* .. Array Arguments .. */ +/* .. Local Scalars .. */ +/* .. Local Arrays .. */ +/* .. External Functions .. */ +/* .. External Subroutines .. */ +/* .. Intrinsic Functions .. */ +/* .. Scalars in Common .. */ +/* .. Common blocks .. */ +/* .. Data statements .. */ /* Parameter adjustments */ --idim; --alf; @@ -2346,6 +1690,7 @@ L120: a -= a_offset; /* Function Body */ +/* .. Executable Statements .. */ nargs = 11; nc = 0; @@ -2421,12 +1766,14 @@ L120: zmake_("tr", uplo, diag, &na, &na, &a[ a_offset], nmax, &aa[1], &lda, &reset, - &c_b1); + &c_b1, (ftnlen)2, (ftnlen)1, (ftnlen) + 1); /* Generate the matrix B. */ zmake_("ge", " ", " ", &m, &n, &b[b_offset], - nmax, &bb[1], &ldb, &reset, &c_b1); + nmax, &bb[1], &ldb, &reset, &c_b1, ( + ftnlen)2, (ftnlen)1, (ftnlen)1); ++nc; @@ -2471,42 +1818,42 @@ L120: zprcn3_(ntra, &nc, sname, iorder, side, uplo, transa, diag, &m, &n, &alpha, &lda, &ldb, ( - ftnlen)13, (ftnlen)1, (ftnlen) + ftnlen)12, (ftnlen)1, (ftnlen) 1, (ftnlen)1, (ftnlen)1); } if (*rewi) { - al__1.aerr = 0; +/* al__1.aerr = 0; al__1.aunit = *ntra; - f_rew(&al__1); + f_rew(&al__1);*/ } cztrmm_(iorder, side, uplo, transa, diag, &m, &n, &alpha, &aa[1], &lda, &bb[ - 1], &ldb); + 1], &ldb, (ftnlen)1, (ftnlen)1, ( + ftnlen)1, (ftnlen)1); } else if (s_cmp(sname + 9, "sm", (ftnlen)2, ( ftnlen)2) == 0) { if (*trace) { zprcn3_(ntra, &nc, sname, iorder, side, uplo, transa, diag, &m, &n, &alpha, &lda, &ldb, ( - ftnlen)13, (ftnlen)1, (ftnlen) + ftnlen)12, (ftnlen)1, (ftnlen) 1, (ftnlen)1, (ftnlen)1); } if (*rewi) { - al__1.aerr = 0; +/* al__1.aerr = 0; al__1.aunit = *ntra; - f_rew(&al__1); + f_rew(&al__1);*/ } cztrsm_(iorder, side, uplo, transa, diag, &m, &n, &alpha, &aa[1], &lda, &bb[ - 1], &ldb); + 1], &ldb, (ftnlen)1, (ftnlen)1, ( + ftnlen)1, (ftnlen)1); } /* Check if error-exit was taken incorrectly. */ if (! infoc_1.ok) { - io___236.ciunit = *nout; - s_wsfe(&io___236); - e_wsfe(); + printf("*** FATAL ERROR - ERROR-CALL MYEXIT TAKEN ON VALID CALL\n"); *fatal = TRUE_; goto L150; } @@ -2531,7 +1878,8 @@ L120: isame[9] = lze_(&bs[1], &bb[1], &lbb); } else { isame[9] = lzeres_("ge", " ", &m, &n, &bs[ - 1], &bb[1], &ldb); + 1], &bb[1], &ldb, (ftnlen)2, ( + ftnlen)1); } isame[10] = ldbs == ldb; @@ -2543,11 +1891,7 @@ L120: for (i__ = 1; i__ <= i__4; ++i__) { same = same && isame[i__ - 1]; if (! isame[i__ - 1]) { - io___239.ciunit = *nout; - s_wsfe(&io___239); - do_fio(&c__1, (char *)&i__, (ftnlen) - sizeof(integer)); - e_wsfe(); + printf(" ******* FATAL ERROR - PARAMETER NUMBER %d WAS CHANGED INCORRECTLY *******\n",i__); } /* L50: */ } @@ -2578,7 +1922,8 @@ L120: c_b1, &c__[c_offset], nmax, &ct[1], &g[1], &bb[ 1], &ldb, eps, &err, - fatal, nout, &c_true); + fatal, nout, &c_true, ( + ftnlen)1, (ftnlen)1); } } else if (s_cmp(sname + 9, "sm", (ftnlen) 2, (ftnlen)2) == 0) { @@ -2612,7 +1957,8 @@ L120: c_b1, &b[b_offset], nmax, &ct[1], &g[1], &bb[1], & ldb, eps, &err, fatal, - nout, &c_false); + nout, &c_false, (ftnlen)1, + (ftnlen)1); } else { zmmch_("N", transa, &m, &n, &n, & c_b2, &c__[c_offset], @@ -2620,7 +1966,8 @@ L120: &c_b1, &b[b_offset], nmax, &ct[1], &g[1], &bb[1], & ldb, eps, &err, fatal, - nout, &c_false); + nout, &c_false, (ftnlen)1, + (ftnlen)1); } } errmax = f2cmax(errmax,err); @@ -2657,77 +2004,48 @@ L130: if (errmax < *thresh) { if (*iorder == 0) { - io___241.ciunit = *nout; - s_wsfe(&io___241); - do_fio(&c__1, sname, (ftnlen)13); - do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer)); - e_wsfe(); + printf("%s PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS (%d CALLS)\n",sname,nc); } if (*iorder == 1) { - io___242.ciunit = *nout; - s_wsfe(&io___242); - do_fio(&c__1, sname, (ftnlen)13); - do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer)); - e_wsfe(); + printf("%s PASSED THE ROW-MAJOR COMPUTATIONAL TESTS (%d CALLS)\n",sname,nc); } } else { if (*iorder == 0) { - io___243.ciunit = *nout; - s_wsfe(&io___243); - do_fio(&c__1, sname, (ftnlen)13); - do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer)); - do_fio(&c__1, (char *)&errmax, (ftnlen)sizeof(doublereal)); - e_wsfe(); + printf("%s COMPLETED THE COLUMN-MAJOR COMPUTATIONAL TESTS (%d CALLS)/n",sname,nc); + printf("***** BUT WITH MAXIMUM TEST RATIO %8.2f - SUSPECT *******/n",errmax); } if (*iorder == 1) { - io___244.ciunit = *nout; - s_wsfe(&io___244); - do_fio(&c__1, sname, (ftnlen)13); - do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer)); - do_fio(&c__1, (char *)&errmax, (ftnlen)sizeof(doublereal)); - e_wsfe(); + printf("%s COMPLETED THE ROW-MAJOR COMPUTATIONAL TESTS (%d CALLS)/n",sname,nc); + printf("***** BUT WITH MAXIMUM TEST RATIO %8.2f - SUSPECT *******/n",errmax); } } goto L160; L150: - io___245.ciunit = *nout; - s_wsfe(&io___245); - do_fio(&c__1, sname, (ftnlen)13); - e_wsfe(); + printf(" ******* %s FAILED ON CALL NUMBER:\n",sname); if (*trace) { zprcn3_(ntra, &nc, sname, iorder, side, uplo, transa, diag, &m, &n, & - alpha, &lda, &ldb); + alpha, &lda, &ldb, (ftnlen)12, (ftnlen)1, (ftnlen)1, (ftnlen) + 1, (ftnlen)1); } L160: return 0; -/* L9995: */ +/* 9995 FORMAT(1X, I6, ': ', A12,'(', 4( '''', A1, ''',' ), 2( I3, ',' ), */ +/* $ '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3, ') ', */ +/* $ ' .' ) */ /* End of ZCHK3. */ } /* zchk3_ */ -/* Subroutine */ int zprcn3_(integer *nout, integer *nc, char *sname, integer - *iorder, char *side, char *uplo, char *transa, char *diag, integer *m, - integer *n, doublecomplex *alpha, integer *lda, integer *ldb) +/* Subroutine */ int zprcn3_(integer* nout, integer* nc, char* sname, integer* iorder, char* side, char* uplo, char* transa, char* diag, integer* m, integer* n, doublecomplex* alpha, integer* lda, integer* ldb, ftnlen sname_len, ftnlen side_len, ftnlen uplo_len, ftnlen transa_len, ftnlen diag_len) { - /* Format strings */ - static char fmt_9995[] = "(1x,i6,\002: \002,a13,\002(\002,a15,\002,\002," - "a14,\002,\002,a14,\002,\002)"; - static char fmt_9994[] = "(10x,2(a15,\002,\002),2(i3,\002,\002),\002 " - "(\002,f4.1,\002,\002,f4.1,\002), A,\002,i3,\002, B,\002,i3,\002)." - "\002)"; /* Local variables */ - char ca[14], cd[14], cs[14], cu[14], crc[14]; - - /* Fortran I/O blocks */ - static cilist io___251 = { 0, 0, 0, fmt_9995, 0 }; - static cilist io___252 = { 0, 0, 0, fmt_9994, 0 }; - + static char ca[14], cd[14], cs[14], cu[14], crc[14]; if (*(unsigned char *)side == 'L') { s_copy(cs, " CblasLeft", (ftnlen)14, (ftnlen)14); @@ -2756,134 +2074,61 @@ L160: } else { s_copy(crc, " CblasColMajor", (ftnlen)14, (ftnlen)14); } - io___251.ciunit = *nout; - s_wsfe(&io___251); - do_fio(&c__1, (char *)&(*nc), (ftnlen)sizeof(integer)); - do_fio(&c__1, sname, (ftnlen)13); - do_fio(&c__1, crc, (ftnlen)14); - do_fio(&c__1, cs, (ftnlen)14); - do_fio(&c__1, cu, (ftnlen)14); - e_wsfe(); - io___252.ciunit = *nout; - s_wsfe(&io___252); - do_fio(&c__1, ca, (ftnlen)14); - do_fio(&c__1, cd, (ftnlen)14); - do_fio(&c__1, (char *)&(*m), (ftnlen)sizeof(integer)); - do_fio(&c__1, (char *)&(*n), (ftnlen)sizeof(integer)); - do_fio(&c__2, (char *)&(*alpha), (ftnlen)sizeof(doublereal)); - do_fio(&c__1, (char *)&(*lda), (ftnlen)sizeof(integer)); - do_fio(&c__1, (char *)&(*ldb), (ftnlen)sizeof(integer)); - e_wsfe(); - return 0; + printf("%6d: %s %s %s %s\n",*nc,sname,crc,cs,cu); + printf(" %s %s %d %d (%4.1lf,%4.1lf) A %d B %d\n",ca,cd,*m,*n,alpha->r,alpha->i,*lda,*ldb); + +return 0; } /* zprcn3_ */ -/* Subroutine */ int zchk4_(char *sname, doublereal *eps, doublereal *thresh, - integer *nout, integer *ntra, logical *trace, logical *rewi, logical * - fatal, integer *nidim, integer *idim, integer *nalf, doublecomplex * - alf, integer *nbet, doublecomplex *bet, integer *nmax, doublecomplex * - a, doublecomplex *aa, doublecomplex *as, doublecomplex *b, - doublecomplex *bb, doublecomplex *bs, doublecomplex *c__, - doublecomplex *cc, doublecomplex *cs, doublecomplex *ct, doublereal * - g, integer *iorder) +/* Subroutine */ int zchk4_(char* sname, doublereal* eps, doublereal* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nalf, doublecomplex* alf, integer* nbet, doublecomplex* bet, integer* nmax, doublecomplex* a, doublecomplex* aa, doublecomplex* as, doublecomplex* b, doublecomplex* bb, doublecomplex* bs, doublecomplex* c__, doublecomplex* cc, doublecomplex* cs, doublecomplex* ct, doublereal* g, integer* iorder, ftnlen sname_len) { /* Initialized data */ - static char icht[2] = "NC"; - static char ichu[2] = "UL"; - - /* Format strings */ - static char fmt_9992[] = "(\002 ******* FATAL ERROR - ERROR-CALL MYEXIT " - "TAKEN ON VALID\002,\002 CALL *******\002)"; - static char fmt_9998[] = "(\002 ******* FATAL ERROR - PARAMETER NUMBER" - " \002,i2,\002 WAS CH\002,\002ANGED INCORRECTLY *******\002)"; - static char fmt_10000[] = "(\002 \002,a13,\002 PASSED THE COLUMN-MAJOR C" - "OMPUTATIONAL TESTS\002,\002 (\002,i6,\002 CALL\002,\002S)\002)"; - static char fmt_10001[] = "(\002 \002,a13,\002 PASSED THE ROW-MAJOR C" - "OMPUTATIONAL TESTS\002,\002 (\002,i6,\002 CALL\002,\002S)\002)"; - static char fmt_10002[] = "(\002 \002,a13,\002 COMPLETED THE COLUMN-MAJO" - "R COMPUTATIONAL \002,\002TESTS (\002,i6,\002 CALLS)\002,/\002 **" - "***** BUT WITH MAXIMUM TEST \002,\002RATIO \002,f8.2,\002 - SUSP" - "ECT *******\002)"; - static char fmt_10003[] = "(\002 \002,a13,\002 COMPLETED THE ROW-MAJOR " - " COMPUTATIONAL \002,\002TESTS (\002,i6,\002 CALLS)\002,/\002 **" - "***** BUT WITH MAXIMUM TEST \002,\002RATIO \002,f8.2,\002 - SUSP" - "ECT *******\002)"; - static char fmt_9995[] = "(\002 THESE ARE THE RESULTS FOR COLUMN" - " \002,i3)"; - static char fmt_9996[] = "(\002 ******* \002,a13,\002 FAILED ON CALL NUM" - "BER:\002)"; + static char icht[2+1] = "NC"; + static char ichu[2+1] = "UL"; /* System generated locals */ integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2, i__3, i__4, i__5, i__6, i__7; doublecomplex z__1; - alist al__1; /* Local variables */ - doublecomplex beta; - integer ldas, ldcs; - logical same, conj; - doublecomplex bets; - doublereal rals; - logical tran, null; - char uplo[1]; - integer i__, j, k, n; - doublecomplex alpha; - doublereal rbeta; - logical isame[13]; - extern /* Subroutine */ int zmake_(char *, char *, char *, integer *, - integer *, doublecomplex *, integer *, doublecomplex *, integer *, - logical *, doublecomplex *); - integer nargs; - extern /* Subroutine */ int zmmch_(char *, char *, integer *, integer *, - integer *, doublecomplex *, doublecomplex *, integer *, - doublecomplex *, integer *, doublecomplex *, doublecomplex *, - integer *, doublecomplex *, doublereal *, doublecomplex *, - integer *, doublereal *, doublereal *, logical *, integer *, - logical *); - doublereal rbets; - logical reset; - char trans[1]; - logical upper; - char uplos[1]; - integer ia, ib, jc, ma, na; - extern /* Subroutine */ int zprcn4_(integer *, integer *, char *, integer - *, char *, char *, integer *, integer *, doublecomplex *, integer - *, doublecomplex *, integer *); - integer nc; - extern /* Subroutine */ int zprcn6_(integer *, integer *, char *, integer - *, char *, char *, integer *, integer *, doublereal *, integer *, - doublereal *, integer *); - integer ik, in, jj, lj, ks, ns; - doublereal ralpha; - extern /* Subroutine */ int czherk_(integer *, char *, char *, integer *, - integer *, doublereal *, doublecomplex *, integer *, doublereal *, - doublecomplex *, integer *); - doublereal errmax; - extern logical lzeres_(char *, char *, integer *, integer *, - doublecomplex *, doublecomplex *, integer *); - char transs[1], transt[1]; - extern /* Subroutine */ int czsyrk_(integer *, char *, char *, integer *, - integer *, doublecomplex *, doublecomplex *, integer *, - doublecomplex *, doublecomplex *, integer *); - integer laa, lda, lcc, ldc; - doublecomplex als; - integer ict, icu; - doublereal err; - extern logical lze_(doublecomplex *, doublecomplex *, integer *); - - /* Fortran I/O blocks */ - static cilist io___294 = { 0, 0, 0, fmt_9992, 0 }; - static cilist io___297 = { 0, 0, 0, fmt_9998, 0 }; - static cilist io___304 = { 0, 0, 0, fmt_10000, 0 }; - static cilist io___305 = { 0, 0, 0, fmt_10001, 0 }; - static cilist io___306 = { 0, 0, 0, fmt_10002, 0 }; - static cilist io___307 = { 0, 0, 0, fmt_10003, 0 }; - static cilist io___308 = { 0, 0, 0, fmt_9995, 0 }; - static cilist io___309 = { 0, 0, 0, fmt_9996, 0 }; - - + static doublecomplex beta; + static integer ldas, ldcs; + static logical same, isconj; + static doublecomplex bets; + static doublereal rals; + static logical tran, null; + static char uplo[1]; + static integer i__, j, k, n; + static doublecomplex alpha; + static doublereal rbeta; + static logical isame[13]; + extern /* Subroutine */ int zmake_(char*, char*, char*, integer*, integer*, doublecomplex*, integer*, doublecomplex*, integer*, logical*, doublecomplex*, ftnlen, ftnlen, ftnlen); + static integer nargs; + extern /* Subroutine */ int zmmch_(char*, char*, integer*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, doublereal*, doublecomplex*, integer*, doublereal*, doublereal*, logical*, integer*, logical*, ftnlen, ftnlen); + static doublereal rbets; + static logical reset; + static char trans[1]; + static logical upper; + static char uplos[1]; + static integer ia, ib, jc, ma, na; + extern /* Subroutine */ int zprcn4_(integer*, integer*, char*, integer*, char*, char*, integer*, integer*, doublecomplex*, integer*, doublecomplex*, integer*, ftnlen, ftnlen, ftnlen); + static integer nc; + extern /* Subroutine */ int zprcn6_(integer*, integer*, char*, integer*, char*, char*, integer*, integer*, doublereal*, integer*, doublereal*, integer*, ftnlen, ftnlen, ftnlen); + static integer ik, in, jj, lj, ks, ns; + static doublereal ralpha; + extern /* Subroutine */ int czherk_(integer*, char*, char*, integer*, integer*, doublereal*, doublecomplex*, integer*, doublereal*, doublecomplex*, integer*, ftnlen, ftnlen); + static doublereal errmax; + extern logical lzeres_(char*, char*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, ftnlen, ftnlen); + static char transs[1], transt[1]; + extern /* Subroutine */ int czsyrk_(integer*, char*, char*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, doublecomplex*, integer*, ftnlen, ftnlen); + static integer laa, lda, lcc, ldc; + static doublecomplex als; + static integer ict, icu; + static doublereal err; + extern logical lze_(doublecomplex*, doublecomplex*, integer*); /* Tests ZHERK and ZSYRK. */ @@ -2895,6 +2140,17 @@ L160: /* Jeremy Du Croz, Numerical Algorithms Group Ltd. */ /* Sven Hammarling, Numerical Algorithms Group Ltd. */ +/* .. Parameters .. */ +/* .. Scalar Arguments .. */ +/* .. Array Arguments .. */ +/* .. Local Scalars .. */ +/* .. Local Arrays .. */ +/* .. External Functions .. */ +/* .. External Subroutines .. */ +/* .. Intrinsic Functions .. */ +/* .. Scalars in Common .. */ +/* .. Common blocks .. */ +/* .. Data statements .. */ /* Parameter adjustments */ --idim; --alf; @@ -2918,12 +2174,15 @@ L160: a -= a_offset; /* Function Body */ - conj = s_cmp(sname + 7, "he", (ftnlen)2, (ftnlen)2) == 0; +/* .. Executable Statements .. */ + isconj = s_cmp(sname + 7, "he", (ftnlen)2, (ftnlen)2) == 0; nargs = 10; nc = 0; reset = TRUE_; errmax = 0.; + rals = 1.; + rbets = 1.; i__1 = *nidim; for (in = 1; in <= i__1; ++in) { @@ -2946,7 +2205,7 @@ L160: for (ict = 1; ict <= 2; ++ict) { *(unsigned char *)trans = *(unsigned char *)&icht[ict - 1]; tran = *(unsigned char *)trans == 'C'; - if (tran && ! conj) { + if (tran && ! isconj) { *(unsigned char *)trans = 'T'; } if (tran) { @@ -2970,7 +2229,7 @@ L160: /* Generate the matrix A. */ zmake_("ge", " ", " ", &ma, &na, &a[a_offset], nmax, &aa[1], & - lda, &reset, &c_b1); + lda, &reset, &c_b1, (ftnlen)2, (ftnlen)1, (ftnlen)1); for (icu = 1; icu <= 2; ++icu) { *(unsigned char *)uplo = *(unsigned char *)&ichu[icu - 1]; @@ -2980,7 +2239,7 @@ L160: for (ia = 1; ia <= i__3; ++ia) { i__4 = ia; alpha.r = alf[i__4].r, alpha.i = alf[i__4].i; - if (conj) { + if (isconj) { ralpha = alpha.r; z__1.r = ralpha, z__1.i = 0.; alpha.r = z__1.r, alpha.i = z__1.i; @@ -2990,22 +2249,22 @@ L160: for (ib = 1; ib <= i__4; ++ib) { i__5 = ib; beta.r = bet[i__5].r, beta.i = bet[i__5].i; - if (conj) { + if (isconj) { rbeta = beta.r; z__1.r = rbeta, z__1.i = 0.; beta.r = z__1.r, beta.i = z__1.i; } null = n <= 0; - if (conj) { - null = null || (k <= 0 || ralpha == 0.) && - rbeta == 1.; + if (isconj) { + null = null ||( (k <= 0 || ralpha == 0.) && + rbeta == 1.); } /* Generate the matrix C. */ zmake_(sname + 7, uplo, " ", &n, &n, &c__[ c_offset], nmax, &cc[1], &ldc, &reset, & - c_b1); + c_b1, (ftnlen)2, (ftnlen)1, (ftnlen)1); ++nc; @@ -3016,7 +2275,7 @@ L160: trans; ns = n; ks = k; - if (conj) { + if (isconj) { rals = ralpha; } else { als.r = alpha.r, als.i = alpha.i; @@ -3030,7 +2289,7 @@ L160: /* L10: */ } ldas = lda; - if (conj) { + if (isconj) { rbets = rbeta; } else { bets.r = beta.r, bets.i = beta.i; @@ -3047,40 +2306,42 @@ L160: /* Call the subroutine. */ - if (conj) { + if (isconj) { if (*trace) { zprcn6_(ntra, &nc, sname, iorder, uplo, trans, &n, &k, &ralpha, &lda, & - rbeta, &ldc); + rbeta, &ldc, (ftnlen)12, (ftnlen) + 1, (ftnlen)1); } if (*rewi) { - al__1.aerr = 0; +/* al__1.aerr = 0; al__1.aunit = *ntra; - f_rew(&al__1); + f_rew(&al__1);*/ } czherk_(iorder, uplo, trans, &n, &k, &ralpha, - &aa[1], &lda, &rbeta, &cc[1], &ldc); + &aa[1], &lda, &rbeta, &cc[1], &ldc, ( + ftnlen)1, (ftnlen)1); } else { if (*trace) { zprcn4_(ntra, &nc, sname, iorder, uplo, trans, &n, &k, &alpha, &lda, & - beta, &ldc); + beta, &ldc, (ftnlen)12, (ftnlen)1, + (ftnlen)1); } if (*rewi) { - al__1.aerr = 0; +/* al__1.aerr = 0; al__1.aunit = *ntra; - f_rew(&al__1); + f_rew(&al__1);*/ } czsyrk_(iorder, uplo, trans, &n, &k, &alpha, & - aa[1], &lda, &beta, &cc[1], &ldc); + aa[1], &lda, &beta, &cc[1], &ldc, ( + ftnlen)1, (ftnlen)1); } /* Check if error-exit was taken incorrectly. */ if (! infoc_1.ok) { - io___294.ciunit = *nout; - s_wsfe(&io___294); - e_wsfe(); + printf("*** FATAL ERROR - ERROR-CALL MYEXIT TAKEN ON VALID CALL\n"); *fatal = TRUE_; goto L120; } @@ -3093,7 +2354,7 @@ L160: char *)trans; isame[2] = ns == n; isame[3] = ks == k; - if (conj) { + if (isconj) { isame[4] = rals == ralpha; } else { isame[4] = als.r == alpha.r && als.i == @@ -3101,7 +2362,7 @@ L160: } isame[5] = lze_(&as[1], &aa[1], &laa); isame[6] = ldas == lda; - if (conj) { + if (isconj) { isame[7] = rbets == rbeta; } else { isame[7] = bets.r == beta.r && bets.i == @@ -3111,7 +2372,8 @@ L160: isame[8] = lze_(&cs[1], &cc[1], &lcc); } else { isame[8] = lzeres_(sname + 7, uplo, &n, &n, & - cs[1], &cc[1], &ldc); + cs[1], &cc[1], &ldc, (ftnlen)2, ( + ftnlen)1); } isame[9] = ldcs == ldc; @@ -3123,11 +2385,7 @@ L160: for (i__ = 1; i__ <= i__5; ++i__) { same = same && isame[i__ - 1]; if (! isame[i__ - 1]) { - io___297.ciunit = *nout; - s_wsfe(&io___297); - do_fio(&c__1, (char *)&i__, (ftnlen) - sizeof(integer)); - e_wsfe(); + printf(" ******* FATAL ERROR - PARAMETER NUMBER %d WAS CHANGED INCORRECTLY *******\n",i__); } /* L30: */ } @@ -3140,7 +2398,7 @@ L160: /* Check the result column by column. */ - if (conj) { + if (isconj) { *(unsigned char *)transt = 'C'; } else { *(unsigned char *)transt = 'T'; @@ -3162,7 +2420,8 @@ L160: nmax, &beta, &c__[jj + j * c_dim1], nmax, &ct[1], &g[1], &cc[jc], &ldc, eps, &err, - fatal, nout, &c_true); + fatal, nout, &c_true, (ftnlen) + 1, (ftnlen)1); } else { zmmch_("N", transt, &lj, &c__1, &k, & alpha, &a[jj + a_dim1], nmax, @@ -3170,7 +2429,7 @@ L160: c__[jj + j * c_dim1], nmax, & ct[1], &g[1], &cc[jc], &ldc, eps, &err, fatal, nout, & - c_true); + c_true, (ftnlen)1, (ftnlen)1); } if (upper) { jc += ldc; @@ -3211,89 +2470,57 @@ L100: if (errmax < *thresh) { if (*iorder == 0) { - io___304.ciunit = *nout; - s_wsfe(&io___304); - do_fio(&c__1, sname, (ftnlen)13); - do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer)); - e_wsfe(); + printf("%s PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS (%d CALLS)\n",sname,nc); } if (*iorder == 1) { - io___305.ciunit = *nout; - s_wsfe(&io___305); - do_fio(&c__1, sname, (ftnlen)13); - do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer)); - e_wsfe(); + printf("%s PASSED THE ROW-MAJOR COMPUTATIONAL TESTS (%d CALLS)\n",sname,nc); } } else { if (*iorder == 0) { - io___306.ciunit = *nout; - s_wsfe(&io___306); - do_fio(&c__1, sname, (ftnlen)13); - do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer)); - do_fio(&c__1, (char *)&errmax, (ftnlen)sizeof(doublereal)); - e_wsfe(); + printf("%s COMPLETED THE COLUMN-MAJOR COMPUTATIONAL TESTS (%d CALLS)/n",sname,nc); + printf("***** BUT WITH MAXIMUM TEST RATIO %8.2f - SUSPECT *******/n",errmax); } if (*iorder == 1) { - io___307.ciunit = *nout; - s_wsfe(&io___307); - do_fio(&c__1, sname, (ftnlen)13); - do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer)); - do_fio(&c__1, (char *)&errmax, (ftnlen)sizeof(doublereal)); - e_wsfe(); + printf("%s COMPLETED THE ROW-MAJOR COMPUTATIONAL TESTS (%d CALLS)/n",sname,nc); + printf("***** BUT WITH MAXIMUM TEST RATIO %8.2f - SUSPECT *******/n",errmax); } } goto L130; L110: if (n > 1) { - io___308.ciunit = *nout; - s_wsfe(&io___308); - do_fio(&c__1, (char *)&j, (ftnlen)sizeof(integer)); - e_wsfe(); + printf(" THESE ARE THE RESULTS FOR COLUMN %d:\n",j); } L120: - io___309.ciunit = *nout; - s_wsfe(&io___309); - do_fio(&c__1, sname, (ftnlen)13); - e_wsfe(); - if (conj) { + printf(" ******* %s FAILED ON CALL NUMBER:\n",sname); + if (isconj) { zprcn6_(nout, &nc, sname, iorder, uplo, trans, &n, &k, &ralpha, &lda, - &rbeta, &ldc); + &rbeta, &ldc, (ftnlen)12, (ftnlen)1, (ftnlen)1); } else { zprcn4_(nout, &nc, sname, iorder, uplo, trans, &n, &k, &alpha, &lda, & - beta, &ldc); + beta, &ldc, (ftnlen)12, (ftnlen)1, (ftnlen)1); } L130: return 0; -/* L9994: */ -/* L9993: */ +/* 9994 FORMAT(1X, I6, ': ', A12,'(', 2( '''', A1, ''',' ), 2( I3, ',' ), */ +/* $ F4.1, ', A,', I3, ',', F4.1, ', C,', I3, ') ', */ +/* $ ' .' ) */ +/* 9993 FORMAT(1X, I6, ': ', A12,'(', 2( '''', A1, ''',' ), 2( I3, ',' ), */ +/* $ '(', F4.1, ',', F4.1, ') , A,', I3, ',(', F4.1, ',', F4.1, */ +/* $ '), C,', I3, ') .' ) */ /* End of CCHK4. */ } /* zchk4_ */ -/* Subroutine */ int zprcn4_(integer *nout, integer *nc, char *sname, integer - *iorder, char *uplo, char *transa, integer *n, integer *k, - doublecomplex *alpha, integer *lda, doublecomplex *beta, integer *ldc) +/* Subroutine */ int zprcn4_(integer* nout, integer* nc, char* sname, integer* iorder, char* uplo, char* transa, integer* n, integer* k, doublecomplex* alpha, integer* lda, doublecomplex* beta, integer* ldc, ftnlen sname_len, ftnlen uplo_len, ftnlen transa_len) { - /* Format strings */ - static char fmt_9995[] = "(1x,i6,\002: \002,a13,\002(\002,3(a15,\002," - "\002))"; - static char fmt_9994[] = "(10x,2(i3,\002,\002),\002 (\002,f4.1,\002,\002" - ",f4.1,\002), A,\002,i3,\002, (\002,f4.1,\002,\002,f4.1,\002), C" - ",\002,i3,\002).\002)"; - /* Local variables */ - char ca[14], cu[14], crc[14]; - - /* Fortran I/O blocks */ - static cilist io___313 = { 0, 0, 0, fmt_9995, 0 }; - static cilist io___314 = { 0, 0, 0, fmt_9994, 0 }; - + static char ca[14], cu[14], crc[14]; if (*(unsigned char *)uplo == 'U') { s_copy(cu, " CblasUpper", (ftnlen)14, (ftnlen)14); @@ -3312,45 +2539,19 @@ L130: } else { s_copy(crc, " CblasColMajor", (ftnlen)14, (ftnlen)14); } - io___313.ciunit = *nout; - s_wsfe(&io___313); - do_fio(&c__1, (char *)&(*nc), (ftnlen)sizeof(integer)); - do_fio(&c__1, sname, (ftnlen)13); - do_fio(&c__1, crc, (ftnlen)14); - do_fio(&c__1, cu, (ftnlen)14); - do_fio(&c__1, ca, (ftnlen)14); - e_wsfe(); - io___314.ciunit = *nout; - s_wsfe(&io___314); - do_fio(&c__1, (char *)&(*n), (ftnlen)sizeof(integer)); - do_fio(&c__1, (char *)&(*k), (ftnlen)sizeof(integer)); - do_fio(&c__2, (char *)&(*alpha), (ftnlen)sizeof(doublereal)); - do_fio(&c__1, (char *)&(*lda), (ftnlen)sizeof(integer)); - do_fio(&c__2, (char *)&(*beta), (ftnlen)sizeof(doublereal)); - do_fio(&c__1, (char *)&(*ldc), (ftnlen)sizeof(integer)); - e_wsfe(); - return 0; + printf("%6d: %s %s %s %s\n",*nc,sname,crc,cu,ca); + printf("( %d %d (%4.1lf,%4.1lf) A %d (%4.1lf,%4.1lf) C %d\n",*n,*k,alpha->r,alpha->i,*lda,beta->r,beta->i,*ldc); + +return 0; } /* zprcn4_ */ -/* Subroutine */ int zprcn6_(integer *nout, integer *nc, char *sname, integer - *iorder, char *uplo, char *transa, integer *n, integer *k, doublereal - *alpha, integer *lda, doublereal *beta, integer *ldc) +/* Subroutine */ int zprcn6_(integer* nout, integer* nc, char* sname, integer* iorder, char* uplo, char* transa, integer* n, integer* k, doublereal* alpha, integer* lda, doublereal* beta, integer* ldc, ftnlen sname_len, ftnlen uplo_len, ftnlen transa_len) { - /* Format strings */ - static char fmt_9995[] = "(1x,i6,\002: \002,a13,\002(\002,3(a15,\002," - "\002))"; - static char fmt_9994[] = "(10x,2(i3,\002,\002),f4.1,\002, A,\002,i3" - ",\002,\002,f4.1,\002, C,\002,i3,\002).\002)"; /* Local variables */ - char ca[14], cu[14], crc[14]; - - /* Fortran I/O blocks */ - static cilist io___318 = { 0, 0, 0, fmt_9995, 0 }; - static cilist io___319 = { 0, 0, 0, fmt_9994, 0 }; - + static char ca[14], cu[14], crc[14]; if (*(unsigned char *)uplo == 'U') { s_copy(cu, " CblasUpper", (ftnlen)14, (ftnlen)14); @@ -3369,132 +2570,58 @@ L130: } else { s_copy(crc, " CblasColMajor", (ftnlen)14, (ftnlen)14); } - io___318.ciunit = *nout; - s_wsfe(&io___318); - do_fio(&c__1, (char *)&(*nc), (ftnlen)sizeof(integer)); - do_fio(&c__1, sname, (ftnlen)13); - do_fio(&c__1, crc, (ftnlen)14); - do_fio(&c__1, cu, (ftnlen)14); - do_fio(&c__1, ca, (ftnlen)14); - e_wsfe(); - io___319.ciunit = *nout; - s_wsfe(&io___319); - do_fio(&c__1, (char *)&(*n), (ftnlen)sizeof(integer)); - do_fio(&c__1, (char *)&(*k), (ftnlen)sizeof(integer)); - do_fio(&c__1, (char *)&(*alpha), (ftnlen)sizeof(doublereal)); - do_fio(&c__1, (char *)&(*lda), (ftnlen)sizeof(integer)); - do_fio(&c__1, (char *)&(*beta), (ftnlen)sizeof(doublereal)); - do_fio(&c__1, (char *)&(*ldc), (ftnlen)sizeof(integer)); - e_wsfe(); - return 0; + printf("%6d: %s %s %s %s\n",*nc,sname,crc,cu,ca); + printf("( %d %d %4.1lf A %d %4.1lf C %d\n",*n,*k,*alpha,*lda,*beta,*ldc); + +return 0; } /* zprcn6_ */ -/* Subroutine */ int zchk5_(char *sname, doublereal *eps, doublereal *thresh, - integer *nout, integer *ntra, logical *trace, logical *rewi, logical * - fatal, integer *nidim, integer *idim, integer *nalf, doublecomplex * - alf, integer *nbet, doublecomplex *bet, integer *nmax, doublecomplex * - ab, doublecomplex *aa, doublecomplex *as, doublecomplex *bb, - doublecomplex *bs, doublecomplex *c__, doublecomplex *cc, - doublecomplex *cs, doublecomplex *ct, doublereal *g, doublecomplex *w, - integer *iorder) +/* Subroutine */ int zchk5_(char* sname, doublereal* eps, doublereal* thresh, integer* nout, integer* ntra, logical* trace, logical* rewi, logical* fatal, integer* nidim, integer* idim, integer* nalf, doublecomplex* alf, integer* nbet, doublecomplex* bet, integer* nmax, doublecomplex* ab, doublecomplex* aa, doublecomplex* as, doublecomplex* bb, doublecomplex* bs, doublecomplex* c__, doublecomplex* cc, doublecomplex* cs, doublecomplex* ct, doublereal* g, doublecomplex* w, integer* iorder, ftnlen sname_len) { /* Initialized data */ - static char icht[2] = "NC"; - static char ichu[2] = "UL"; - - /* Format strings */ - static char fmt_9992[] = "(\002 ******* FATAL ERROR - ERROR-CALL MYEXIT " - "TAKEN ON VALID\002,\002 CALL *******\002)"; - static char fmt_9998[] = "(\002 ******* FATAL ERROR - PARAMETER NUMBER" - " \002,i2,\002 WAS CH\002,\002ANGED INCORRECTLY *******\002)"; - static char fmt_10000[] = "(\002 \002,a13,\002 PASSED THE COLUMN-MAJOR C" - "OMPUTATIONAL TESTS\002,\002 (\002,i6,\002 CALL\002,\002S)\002)"; - static char fmt_10001[] = "(\002 \002,a13,\002 PASSED THE ROW-MAJOR C" - "OMPUTATIONAL TESTS\002,\002 (\002,i6,\002 CALL\002,\002S)\002)"; - static char fmt_10002[] = "(\002 \002,a13,\002 COMPLETED THE COLUMN-MAJO" - "R COMPUTATIONAL \002,\002TESTS (\002,i6,\002 CALLS)\002,/\002 **" - "***** BUT WITH MAXIMUM TEST \002,\002RATIO \002,f8.2,\002 - SUSP" - "ECT *******\002)"; - static char fmt_10003[] = "(\002 \002,a13,\002 COMPLETED THE ROW-MAJOR " - " COMPUTATIONAL \002,\002TESTS (\002,i6,\002 CALLS)\002,/\002 **" - "***** BUT WITH MAXIMUM TEST \002,\002RATIO \002,f8.2,\002 - SUSP" - "ECT *******\002)"; - static char fmt_9995[] = "(\002 THESE ARE THE RESULTS FOR COLUMN" - " \002,i3)"; - static char fmt_9996[] = "(\002 ******* \002,a13,\002 FAILED ON CALL NUM" - "BER:\002)"; + static char icht[2+1] = "NC"; + static char ichu[2+1] = "UL"; /* System generated locals */ integer c_dim1, c_offset, i__1, i__2, i__3, i__4, i__5, i__6, i__7, i__8; doublecomplex z__1, z__2; - alist al__1; /* Local variables */ - integer jjab; - doublecomplex beta; - integer ldas, ldbs, ldcs; - logical same, conj; - doublecomplex bets; - logical tran, null; - char uplo[1]; - integer i__, j, k, n; - doublecomplex alpha; - doublereal rbeta; - logical isame[13]; - extern /* Subroutine */ int zmake_(char *, char *, char *, integer *, - integer *, doublecomplex *, integer *, doublecomplex *, integer *, - logical *, doublecomplex *); - integer nargs; - extern /* Subroutine */ int zmmch_(char *, char *, integer *, integer *, - integer *, doublecomplex *, doublecomplex *, integer *, - doublecomplex *, integer *, doublecomplex *, doublecomplex *, - integer *, doublecomplex *, doublereal *, doublecomplex *, - integer *, doublereal *, doublereal *, logical *, integer *, - logical *); - doublereal rbets; - logical reset; - char trans[1]; - logical upper; - char uplos[1]; - integer ia, ib, jc, ma, na, nc; - extern /* Subroutine */ int zprcn5_(integer *, integer *, char *, integer - *, char *, char *, integer *, integer *, doublecomplex *, integer - *, integer *, doublecomplex *, integer *), - zprcn7_(integer *, integer *, char *, integer *, char *, char *, - integer *, integer *, doublecomplex *, integer *, integer *, - doublereal *, integer *); - integer ik, in, jj, lj, ks, ns; - doublereal errmax; - extern logical lzeres_(char *, char *, integer *, integer *, - doublecomplex *, doublecomplex *, integer *); - char transs[1], transt[1]; - extern /* Subroutine */ int czher2k_(integer *, char *, char *, integer *, - integer *, doublecomplex *, doublecomplex *, integer *, - doublecomplex *, integer *, doublereal *, doublecomplex *, - integer *); - integer laa, lbb, lda, lcc, ldb, ldc; - doublecomplex als; - integer ict, icu; - extern /* Subroutine */ int czsyr2k_(integer *, char *, char *, integer *, - integer *, doublecomplex *, doublecomplex *, integer *, - doublecomplex *, integer *, doublecomplex *, doublecomplex *, - integer *); - doublereal err; - extern logical lze_(doublecomplex *, doublecomplex *, integer *); - - /* Fortran I/O blocks */ - static cilist io___362 = { 0, 0, 0, fmt_9992, 0 }; - static cilist io___365 = { 0, 0, 0, fmt_9998, 0 }; - static cilist io___373 = { 0, 0, 0, fmt_10000, 0 }; - static cilist io___374 = { 0, 0, 0, fmt_10001, 0 }; - static cilist io___375 = { 0, 0, 0, fmt_10002, 0 }; - static cilist io___376 = { 0, 0, 0, fmt_10003, 0 }; - static cilist io___377 = { 0, 0, 0, fmt_9995, 0 }; - static cilist io___378 = { 0, 0, 0, fmt_9996, 0 }; - - + static integer jjab; + static doublecomplex beta; + static integer ldas, ldbs, ldcs; + static logical same, isconj; + static doublecomplex bets; + static logical tran, null; + static char uplo[1]; + static integer i__, j, k, n; + static doublecomplex alpha; + static doublereal rbeta; + static logical isame[13]; + extern /* Subroutine */ int zmake_(char*, char*, char*, integer*, integer*, doublecomplex*, integer*, doublecomplex*, integer*, logical*, doublecomplex*, ftnlen, ftnlen, ftnlen); + static integer nargs; + extern /* Subroutine */ int zmmch_(char*, char*, integer*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, doublereal*, doublecomplex*, integer*, doublereal*, doublereal*, logical*, integer*, logical*, ftnlen, ftnlen); + static doublereal rbets; + static logical reset; + static char trans[1]; + static logical upper; + static char uplos[1]; + static integer ia, ib, jc, ma, na, nc; + extern /* Subroutine */ int zprcn5_(integer*, integer*, char*, integer*, char*, char*, integer*, integer*, doublecomplex*, integer*, integer*, doublecomplex*, integer*, ftnlen, ftnlen, ftnlen); + extern /* Subroutine */ int zprcn7_(integer*, integer*, char*, integer*, char*, char*, integer*, integer*, doublecomplex*, integer*, integer*, doublereal*, integer*, ftnlen, ftnlen, ftnlen); + static integer ik, in, jj, lj, ks, ns; + static doublereal errmax; + extern logical lzeres_(char*, char*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, ftnlen, ftnlen); + static char transs[1], transt[1]; + extern /* Subroutine */ int czher2k_(integer*, char*, char*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, integer*, doublereal*, doublecomplex*, integer*, ftnlen, ftnlen); + static integer laa, lbb, lda, lcc, ldb, ldc; + static doublecomplex als; + static integer ict, icu; + extern /* Subroutine */ int czsyr2k_(integer*, char*, char*, integer*, integer*, doublecomplex*, doublecomplex*, integer*, doublecomplex*, integer*, doublecomplex*, doublecomplex*, integer*, ftnlen, ftnlen); + static doublereal err; + extern logical lze_(doublecomplex*, doublecomplex*, integer*); /* Tests ZHER2K and ZSYR2K. */ @@ -3506,6 +2633,17 @@ L130: /* Jeremy Du Croz, Numerical Algorithms Group Ltd. */ /* Sven Hammarling, Numerical Algorithms Group Ltd. */ +/* .. Parameters .. */ +/* .. Scalar Arguments .. */ +/* .. Array Arguments .. */ +/* .. Local Scalars .. */ +/* .. Local Arrays .. */ +/* .. External Functions .. */ +/* .. External Subroutines .. */ +/* .. Intrinsic Functions .. */ +/* .. Scalars in Common .. */ +/* .. Common blocks .. */ +/* .. Data statements .. */ /* Parameter adjustments */ --idim; --alf; @@ -3525,7 +2663,8 @@ L130: --ab; /* Function Body */ - conj = s_cmp(sname + 7, "he", (ftnlen)2, (ftnlen)2) == 0; +/* .. Executable Statements .. */ + isconj = s_cmp(sname + 7, "he", (ftnlen)2, (ftnlen)2) == 0; nargs = 12; nc = 0; @@ -3553,7 +2692,7 @@ L130: for (ict = 1; ict <= 2; ++ict) { *(unsigned char *)trans = *(unsigned char *)&icht[ict - 1]; tran = *(unsigned char *)trans == 'C'; - if (tran && ! conj) { + if (tran && ! isconj) { *(unsigned char *)trans = 'T'; } if (tran) { @@ -3579,10 +2718,12 @@ L130: if (tran) { i__3 = *nmax << 1; zmake_("ge", " ", " ", &ma, &na, &ab[1], &i__3, &aa[1], & - lda, &reset, &c_b1); + lda, &reset, &c_b1, (ftnlen)2, (ftnlen)1, (ftnlen) + 1); } else { zmake_("ge", " ", " ", &ma, &na, &ab[1], nmax, &aa[1], & - lda, &reset, &c_b1); + lda, &reset, &c_b1, (ftnlen)2, (ftnlen)1, (ftnlen) + 1); } /* Generate the matrix B. */ @@ -3592,10 +2733,12 @@ L130: if (tran) { i__3 = *nmax << 1; zmake_("ge", " ", " ", &ma, &na, &ab[k + 1], &i__3, &bb[1] - , &ldb, &reset, &c_b1); + , &ldb, &reset, &c_b1, (ftnlen)2, (ftnlen)1, ( + ftnlen)1); } else { zmake_("ge", " ", " ", &ma, &na, &ab[k * *nmax + 1], nmax, - &bb[1], &ldb, &reset, &c_b1); + &bb[1], &ldb, &reset, &c_b1, (ftnlen)2, (ftnlen) + 1, (ftnlen)1); } for (icu = 1; icu <= 2; ++icu) { @@ -3611,22 +2754,22 @@ L130: for (ib = 1; ib <= i__4; ++ib) { i__5 = ib; beta.r = bet[i__5].r, beta.i = bet[i__5].i; - if (conj) { + if (isconj) { rbeta = beta.r; z__1.r = rbeta, z__1.i = 0.; beta.r = z__1.r, beta.i = z__1.i; } null = n <= 0; - if (conj) { - null = null || (k <= 0 || alpha.r == 0. && - alpha.i == 0.) && rbeta == 1.; + if (isconj) { + null = null ||( (k <= 0 || (alpha.r == 0. && + alpha.i == 0.)) && rbeta == 1.); } /* Generate the matrix C. */ zmake_(sname + 7, uplo, " ", &n, &n, &c__[ c_offset], nmax, &cc[1], &ldc, &reset, & - c_b1); + c_b1, (ftnlen)2, (ftnlen)1, (ftnlen)1); ++nc; @@ -3656,7 +2799,7 @@ L130: /* L20: */ } ldbs = ldb; - if (conj) { + if (isconj) { rbets = rbeta; } else { bets.r = beta.r, bets.i = beta.i; @@ -3673,42 +2816,42 @@ L130: /* Call the subroutine. */ - if (conj) { + if (isconj) { if (*trace) { zprcn7_(ntra, &nc, sname, iorder, uplo, trans, &n, &k, &alpha, &lda, &ldb, - &rbeta, &ldc); + &rbeta, &ldc, (ftnlen)12, ( + ftnlen)1, (ftnlen)1); } if (*rewi) { - al__1.aerr = 0; +/* al__1.aerr = 0; al__1.aunit = *ntra; - f_rew(&al__1); + f_rew(&al__1);*/ } czher2k_(iorder, uplo, trans, &n, &k, &alpha, &aa[1], &lda, &bb[1], &ldb, &rbeta, & - cc[1], &ldc); + cc[1], &ldc, (ftnlen)1, (ftnlen)1); } else { if (*trace) { zprcn5_(ntra, &nc, sname, iorder, uplo, trans, &n, &k, &alpha, &lda, &ldb, - &beta, &ldc); + &beta, &ldc, (ftnlen)12, (ftnlen) + 1, (ftnlen)1); } if (*rewi) { - al__1.aerr = 0; +/* al__1.aerr = 0; al__1.aunit = *ntra; - f_rew(&al__1); + f_rew(&al__1);*/ } czsyr2k_(iorder, uplo, trans, &n, &k, &alpha, &aa[1], &lda, &bb[1], &ldb, &beta, & - cc[1], &ldc); + cc[1], &ldc, (ftnlen)1, (ftnlen)1); } /* Check if error-exit was taken incorrectly. */ if (! infoc_1.ok) { - io___362.ciunit = *nout; - s_wsfe(&io___362); - e_wsfe(); + printf("*** FATAL ERROR - ERROR-CALL MYEXIT TAKEN ON VALID CALL\n"); *fatal = TRUE_; goto L150; } @@ -3726,7 +2869,7 @@ L130: isame[6] = ldas == lda; isame[7] = lze_(&bs[1], &bb[1], &lbb); isame[8] = ldbs == ldb; - if (conj) { + if (isconj) { isame[9] = rbets == rbeta; } else { isame[9] = bets.r == beta.r && bets.i == @@ -3736,7 +2879,7 @@ L130: isame[10] = lze_(&cs[1], &cc[1], &lcc); } else { isame[10] = lzeres_("he", uplo, &n, &n, &cs[1] - , &cc[1], &ldc); + , &cc[1], &ldc, (ftnlen)2, (ftnlen)1); } isame[11] = ldcs == ldc; @@ -3748,12 +2891,8 @@ L130: for (i__ = 1; i__ <= i__5; ++i__) { same = same && isame[i__ - 1]; if (! isame[i__ - 1]) { - io___365.ciunit = *nout; - s_wsfe(&io___365); - do_fio(&c__1, (char *)&i__, (ftnlen) - sizeof(integer)); - e_wsfe(); - } + printf(" ******* FATAL ERROR - PARAMETER NUMBER %d WAS CHANGED INCORRECTLY *******\n",i__); + } /* L40: */ } if (! same) { @@ -3765,7 +2904,7 @@ L130: /* Check the result column by column. */ - if (conj) { + if (isconj) { *(unsigned char *)transt = 'C'; } else { *(unsigned char *)transt = 'T'; @@ -3785,7 +2924,7 @@ L130: i__6 = k; for (i__ = 1; i__ <= i__6; ++i__) { i__7 = i__; - i__8 = (j - 1 << 1) * *nmax + k + + i__8 = ((j - 1) << 1) * *nmax + k + i__; z__1.r = alpha.r * ab[i__8].r - alpha.i * ab[i__8].i, @@ -3794,17 +2933,17 @@ L130: i__8].r; w[i__7].r = z__1.r, w[i__7].i = z__1.i; - if (conj) { + if (isconj) { i__7 = k + i__; d_cnjg(&z__2, &alpha); - i__8 = (j - 1 << 1) * *nmax + i__; + i__8 = ((j - 1) << 1) * *nmax + i__; z__1.r = z__2.r * ab[i__8].r - z__2.i * ab[i__8].i, z__1.i = z__2.r * ab[i__8].i + z__2.i * ab[ i__8].r; w[i__7].r = z__1.r, w[i__7].i = z__1.i; } else { i__7 = k + i__; - i__8 = (j - 1 << 1) * *nmax + i__; + i__8 = ((j - 1) << 1) * *nmax + i__; z__1.r = alpha.r * ab[i__8].r - alpha.i * ab[i__8] .i, z__1.i = alpha.r * ab[i__8].i + alpha.i * ab[i__8].r; @@ -3820,11 +2959,12 @@ L130: 1], &i__8, &beta, &c__[jj + j * c_dim1], nmax, &ct[1], &g[1] , &cc[jc], &ldc, eps, &err, - fatal, nout, &c_true); + fatal, nout, &c_true, (ftnlen) + 1, (ftnlen)1); } else { i__6 = k; for (i__ = 1; i__ <= i__6; ++i__) { - if (conj) { + if (isconj) { i__7 = i__; d_cnjg(&z__2, &ab[(k + i__ - 1) * *nmax + j]); z__1.r = alpha.r * z__2.r - alpha.i * z__2.i, @@ -3861,7 +3001,8 @@ L130: i__7, &beta, &c__[jj + j * c_dim1], nmax, &ct[1], &g[1], &cc[jc], &ldc, eps, &err, - fatal, nout, &c_true); + fatal, nout, &c_true, (ftnlen) + 1, (ftnlen)1); } if (upper) { jc += ldc; @@ -3905,90 +3046,57 @@ L130: if (errmax < *thresh) { if (*iorder == 0) { - io___373.ciunit = *nout; - s_wsfe(&io___373); - do_fio(&c__1, sname, (ftnlen)13); - do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer)); - e_wsfe(); + printf("%s PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS (%d CALLS)\n",sname,nc); } if (*iorder == 1) { - io___374.ciunit = *nout; - s_wsfe(&io___374); - do_fio(&c__1, sname, (ftnlen)13); - do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer)); - e_wsfe(); + printf("%s PASSED THE ROW-MAJOR COMPUTATIONAL TESTS (%d CALLS)\n",sname,nc); } } else { if (*iorder == 0) { - io___375.ciunit = *nout; - s_wsfe(&io___375); - do_fio(&c__1, sname, (ftnlen)13); - do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer)); - do_fio(&c__1, (char *)&errmax, (ftnlen)sizeof(doublereal)); - e_wsfe(); + printf("%s COMPLETED THE COLUMN-MAJOR COMPUTATIONAL TESTS (%d CALLS)/n",sname,nc); + printf("***** BUT WITH MAXIMUM TEST RATIO %8.2f - SUSPECT *******/n",errmax); } if (*iorder == 1) { - io___376.ciunit = *nout; - s_wsfe(&io___376); - do_fio(&c__1, sname, (ftnlen)13); - do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer)); - do_fio(&c__1, (char *)&errmax, (ftnlen)sizeof(doublereal)); - e_wsfe(); + printf("%s COMPLETED THE ROW-MAJOR COMPUTATIONAL TESTS (%d CALLS)/n",sname,nc); + printf("***** BUT WITH MAXIMUM TEST RATIO %8.2f - SUSPECT *******/n",errmax); } } goto L160; L140: if (n > 1) { - io___377.ciunit = *nout; - s_wsfe(&io___377); - do_fio(&c__1, (char *)&j, (ftnlen)sizeof(integer)); - e_wsfe(); + printf(" THESE ARE THE RESULTS FOR COLUMN %d:\n",j); } L150: - io___378.ciunit = *nout; - s_wsfe(&io___378); - do_fio(&c__1, sname, (ftnlen)13); - e_wsfe(); - if (conj) { + printf(" ******* %s FAILED ON CALL NUMBER:\n",sname); + if (isconj) { zprcn7_(nout, &nc, sname, iorder, uplo, trans, &n, &k, &alpha, &lda, & - ldb, &rbeta, &ldc); + ldb, &rbeta, &ldc, (ftnlen)12, (ftnlen)1, (ftnlen)1); } else { zprcn5_(nout, &nc, sname, iorder, uplo, trans, &n, &k, &alpha, &lda, & - ldb, &beta, &ldc); + ldb, &beta, &ldc, (ftnlen)12, (ftnlen)1, (ftnlen)1); } L160: return 0; -/* L9994: */ -/* L9993: */ +/* 9994 FORMAT(1X, I6, ': ', A12,'(', 2( '''', A1, ''',' ), 2( I3, ',' ), */ +/* $ '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3, ',', F4.1, */ +/* $ ', C,', I3, ') .' ) */ +/* 9993 FORMAT(1X, I6, ': ', A12,'(', 2( '''', A1, ''',' ), 2( I3, ',' ), */ +/* $ '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3, ',(', F4.1, */ +/* $ ',', F4.1, '), C,', I3, ') .' ) */ /* End of ZCHK5. */ } /* zchk5_ */ -/* Subroutine */ int zprcn5_(integer *nout, integer *nc, char *sname, integer - *iorder, char *uplo, char *transa, integer *n, integer *k, - doublecomplex *alpha, integer *lda, integer *ldb, doublecomplex *beta, - integer *ldc) +/* Subroutine */ int zprcn5_(integer* nout, integer* nc, char* sname, integer* iorder, char* uplo, char* transa, integer* n, integer* k, doublecomplex* alpha, integer* lda, integer* ldb, doublecomplex* beta, integer* ldc, ftnlen sname_len, ftnlen uplo_len, ftnlen transa_len) { - /* Format strings */ - static char fmt_9995[] = "(1x,i6,\002: \002,a13,\002(\002,3(a15,\002," - "\002))"; - static char fmt_9994[] = "(10x,2(i3,\002,\002),\002 (\002,f4.1,\002,\002" - ",f4.1,\002), A,\002,i3,\002, B\002,i3,\002, (\002,f4.1,\002,\002" - ",f4.1,\002), C,\002,i3,\002).\002)"; - /* Local variables */ - char ca[14], cu[14], crc[14]; - - /* Fortran I/O blocks */ - static cilist io___382 = { 0, 0, 0, fmt_9995, 0 }; - static cilist io___383 = { 0, 0, 0, fmt_9994, 0 }; - + static char ca[14], cu[14], crc[14]; if (*(unsigned char *)uplo == 'U') { s_copy(cu, " CblasUpper", (ftnlen)14, (ftnlen)14); @@ -4007,48 +3115,19 @@ L160: } else { s_copy(crc, " CblasColMajor", (ftnlen)14, (ftnlen)14); } - io___382.ciunit = *nout; - s_wsfe(&io___382); - do_fio(&c__1, (char *)&(*nc), (ftnlen)sizeof(integer)); - do_fio(&c__1, sname, (ftnlen)13); - do_fio(&c__1, crc, (ftnlen)14); - do_fio(&c__1, cu, (ftnlen)14); - do_fio(&c__1, ca, (ftnlen)14); - e_wsfe(); - io___383.ciunit = *nout; - s_wsfe(&io___383); - do_fio(&c__1, (char *)&(*n), (ftnlen)sizeof(integer)); - do_fio(&c__1, (char *)&(*k), (ftnlen)sizeof(integer)); - do_fio(&c__2, (char *)&(*alpha), (ftnlen)sizeof(doublereal)); - do_fio(&c__1, (char *)&(*lda), (ftnlen)sizeof(integer)); - do_fio(&c__1, (char *)&(*ldb), (ftnlen)sizeof(integer)); - do_fio(&c__2, (char *)&(*beta), (ftnlen)sizeof(doublereal)); - do_fio(&c__1, (char *)&(*ldc), (ftnlen)sizeof(integer)); - e_wsfe(); - return 0; + printf("%6d: %s %s %s %s\n",*nc,sname,crc,cu,ca); + printf("%d %d (%4.1lf,%4.1lf) , A, %d, B, %d, (%4.1lf,%4.1lf) , C, %d.\n",*n,*k,alpha->r,alpha->i,*lda,*ldb,beta->r,beta->i,*ldc); + +return 0; } /* zprcn5_ */ -/* Subroutine */ int zprcn7_(integer *nout, integer *nc, char *sname, integer - *iorder, char *uplo, char *transa, integer *n, integer *k, - doublecomplex *alpha, integer *lda, integer *ldb, doublereal *beta, - integer *ldc) +/* Subroutine */ int zprcn7_(integer* nout, integer* nc, char* sname, integer* iorder, char* uplo, char* transa, integer* n, integer* k, doublecomplex* alpha, integer* lda, integer* ldb, doublereal* beta, integer* ldc, ftnlen sname_len, ftnlen uplo_len, ftnlen transa_len) { - /* Format strings */ - static char fmt_9995[] = "(1x,i6,\002: \002,a13,\002(\002,3(a15,\002," - "\002))"; - static char fmt_9994[] = "(10x,2(i3,\002,\002),\002 (\002,f4.1,\002,\002" - ",f4.1,\002), A,\002,i3,\002, B\002,i3,\002,\002,f4.1,\002, C," - "\002,i3,\002).\002)"; /* Local variables */ - char ca[14], cu[14], crc[14]; - - /* Fortran I/O blocks */ - static cilist io___387 = { 0, 0, 0, fmt_9995, 0 }; - static cilist io___388 = { 0, 0, 0, fmt_9994, 0 }; - + static char ca[14], cu[14], crc[14]; if (*(unsigned char *)uplo == 'U') { s_copy(cu, " CblasUpper", (ftnlen)14, (ftnlen)14); @@ -4067,31 +3146,14 @@ L160: } else { s_copy(crc, " CblasColMajor", (ftnlen)14, (ftnlen)14); } - io___387.ciunit = *nout; - s_wsfe(&io___387); - do_fio(&c__1, (char *)&(*nc), (ftnlen)sizeof(integer)); - do_fio(&c__1, sname, (ftnlen)13); - do_fio(&c__1, crc, (ftnlen)14); - do_fio(&c__1, cu, (ftnlen)14); - do_fio(&c__1, ca, (ftnlen)14); - e_wsfe(); - io___388.ciunit = *nout; - s_wsfe(&io___388); - do_fio(&c__1, (char *)&(*n), (ftnlen)sizeof(integer)); - do_fio(&c__1, (char *)&(*k), (ftnlen)sizeof(integer)); - do_fio(&c__2, (char *)&(*alpha), (ftnlen)sizeof(doublereal)); - do_fio(&c__1, (char *)&(*lda), (ftnlen)sizeof(integer)); - do_fio(&c__1, (char *)&(*ldb), (ftnlen)sizeof(integer)); - do_fio(&c__1, (char *)&(*beta), (ftnlen)sizeof(doublereal)); - do_fio(&c__1, (char *)&(*ldc), (ftnlen)sizeof(integer)); - e_wsfe(); - return 0; + printf("%6d: %s %s %s %s\n",*nc,sname,crc,cu,ca); + printf("%d %d (%4.1lf,%4.1lf), A, %d, B, %d, %4.1lf, C, %d.\n",*n,*k,alpha->r,alpha->i,*lda,*ldb,*beta,*ldc); + +return 0; } /* zprcn7_ */ -/* Subroutine */ int zmake_(char *type__, char *uplo, char *diag, integer *m, - integer *n, doublecomplex *a, integer *nmax, doublecomplex *aa, - integer *lda, logical *reset, doublecomplex *transl) +/* Subroutine */ int zmake_(char* type__, char* uplo, char* diag, integer* m, integer* n, doublecomplex* a, integer* nmax, doublecomplex* aa, integer* lda, logical* reset, doublecomplex* transl, ftnlen type_len, ftnlen uplo_len, ftnlen diag_len) { /* System generated locals */ integer a_dim1, a_offset, i__1, i__2, i__3, i__4; @@ -4099,13 +3161,13 @@ L160: doublecomplex z__1, z__2; /* Local variables */ - integer ibeg, iend; - extern /* Double Complex */ VOID zbeg_(doublecomplex *, logical *); - logical unit; - integer i__, j; - logical lower, upper; - integer jj; - logical gen, her, tri, sym; + static integer ibeg, iend; + extern /* Double Complex */ VOID zbeg_(doublecomplex*, logical*); + static logical unit; + static integer i__, j; + static logical lower, upper; + static integer jj; + static logical gen, her, tri, sym; /* Generates values for an M by N matrix A. */ @@ -4122,6 +3184,13 @@ L160: /* Jeremy Du Croz, Numerical Algorithms Group Ltd. */ /* Sven Hammarling, Numerical Algorithms Group Ltd. */ +/* .. Parameters .. */ +/* .. Scalar Arguments .. */ +/* .. Array Arguments .. */ +/* .. Local Scalars .. */ +/* .. External Functions .. */ +/* .. Intrinsic Functions .. */ +/* .. Executable Statements .. */ /* Parameter adjustments */ a_dim1 = *nmax; a_offset = 1 + a_dim1 * 1; @@ -4143,7 +3212,7 @@ L160: for (j = 1; j <= i__1; ++j) { i__2 = *m; for (i__ = 1; i__ <= i__2; ++i__) { - if (gen || upper && i__ <= j || lower && i__ >= j) { + if (gen || (upper && i__ <= j) || (lower && i__ >= j)) { i__3 = i__ + j * a_dim1; zbeg_(&z__2, reset); z__1.r = z__2.r + transl->r, z__1.i = z__2.i + transl->i; @@ -4266,22 +3335,8 @@ L160: } /* zmake_ */ -/* Subroutine */ int zmmch_(char *transa, char *transb, integer *m, integer * - n, integer *kk, doublecomplex *alpha, doublecomplex *a, integer *lda, - doublecomplex *b, integer *ldb, doublecomplex *beta, doublecomplex * - c__, integer *ldc, doublecomplex *ct, doublereal *g, doublecomplex * - cc, integer *ldcc, doublereal *eps, doublereal *err, logical *fatal, - integer *nout, logical *mv) +/* Subroutine */ int zmmch_(char* transa, char* transb, integer* m, integer* n, integer* kk, doublecomplex* alpha, doublecomplex* a, integer* lda, doublecomplex* b, integer* ldb, doublecomplex* beta, doublecomplex* c__, integer* ldc, doublecomplex* ct, doublereal* g, doublecomplex* cc, integer* ldcc, doublereal* eps, doublereal* err, logical* fatal, integer* nout, logical* mv, ftnlen transa_len, ftnlen transb_len) { - /* Format strings */ - static char fmt_9999[] = "(\002 ******* FATAL ERROR - COMPUTED RESULT IS" - " LESS THAN HAL\002,\002F ACCURATE *******\002,/\002 " - " EXPECTED RE\002,\002SULT COMPUTED R" - "ESULT\002)"; - static char fmt_9998[] = "(1x,i7,2(\002 (\002,g15.6,\002,\002,g15.6," - "\002)\002))"; - static char fmt_9997[] = "(\002 THESE ARE THE RESULTS FOR COLUMN" - " \002,i3)"; /* System generated locals */ integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, cc_dim1, @@ -4289,18 +3344,11 @@ L160: doublereal d__1, d__2, d__3, d__4, d__5, d__6; doublecomplex z__1, z__2, z__3, z__4; + double sqrt(double); /* Local variables */ - doublereal erri; - integer i__, j, k; - logical trana, tranb, ctrana, ctranb; - - /* Fortran I/O blocks */ - static cilist io___409 = { 0, 0, 0, fmt_9999, 0 }; - static cilist io___410 = { 0, 0, 0, fmt_9998, 0 }; - static cilist io___411 = { 0, 0, 0, fmt_9998, 0 }; - static cilist io___412 = { 0, 0, 0, fmt_9997, 0 }; - - + static doublereal erri; + static integer i__, j, k; + static logical trana, tranb, ctrana, ctranb; /* Checks the results of the computational tests. */ @@ -4312,6 +3360,14 @@ L160: /* Jeremy Du Croz, Numerical Algorithms Group Ltd. */ /* Sven Hammarling, Numerical Algorithms Group Ltd. */ +/* .. Parameters .. */ +/* .. Scalar Arguments .. */ +/* .. Array Arguments .. */ +/* .. Local Scalars .. */ +/* .. Intrinsic Functions .. */ +/* .. Statement Functions .. */ +/* .. Statement Function definitions .. */ +/* .. Executable Statements .. */ /* Parameter adjustments */ a_dim1 = *lda; a_offset = 1 + a_dim1 * 1; @@ -4638,35 +3694,19 @@ L160: L230: *fatal = TRUE_; - io___409.ciunit = *nout; - s_wsfe(&io___409); - e_wsfe(); + printf(" ******* FATAL ERROR - COMPUTED RESULT IS LESS THAN HALF ACCURATE *******\n"); + printf(" EXPECTED RESULT COMPUTED RESULT\n"); i__1 = *m; for (i__ = 1; i__ <= i__1; ++i__) { if (*mv) { - io___410.ciunit = *nout; - s_wsfe(&io___410); - do_fio(&c__1, (char *)&i__, (ftnlen)sizeof(integer)); - do_fio(&c__2, (char *)&ct[i__], (ftnlen)sizeof(doublereal)); - do_fio(&c__2, (char *)&cc[i__ + j * cc_dim1], (ftnlen)sizeof( - doublereal)); - e_wsfe(); - } else { - io___411.ciunit = *nout; - s_wsfe(&io___411); - do_fio(&c__1, (char *)&i__, (ftnlen)sizeof(integer)); - do_fio(&c__2, (char *)&cc[i__ + j * cc_dim1], (ftnlen)sizeof( - doublereal)); - do_fio(&c__2, (char *)&ct[i__], (ftnlen)sizeof(doublereal)); - e_wsfe(); + printf("%7d (%15.6g,%15.6g) (%15.6g,%15.6g)\n",i__,ct[i__].r,ct[i__].i,cc[i__+j*cc_dim1].r,cc[i__+j*cc_dim1].i); + } else { + printf("%7d (%15.6g,%15.6g) (%15.6g,%15.6g)\n",i__,cc[i__+j*cc_dim1].r,cc[i__+j*cc_dim1].i,ct[i__].r,ct[i__].i); } /* L240: */ } if (*n > 1) { - io___412.ciunit = *nout; - s_wsfe(&io___412); - do_fio(&c__1, (char *)&j, (ftnlen)sizeof(integer)); - e_wsfe(); + printf(" THESE ARE THE RESULTS FOR COLUMN %d\n",j); } L250: @@ -4677,14 +3717,14 @@ L250: } /* zmmch_ */ -logical lze_(doublecomplex *ri, doublecomplex *rj, integer *lr) +logical lze_(doublecomplex* ri, doublecomplex* rj, integer* lr) { /* System generated locals */ integer i__1, i__2, i__3; logical ret_val; /* Local variables */ - integer i__; + static integer i__; /* Tests if two arrays are identical. */ @@ -4697,6 +3737,10 @@ logical lze_(doublecomplex *ri, doublecomplex *rj, integer *lr) /* Jeremy Du Croz, Numerical Algorithms Group Ltd. */ /* Sven Hammarling, Numerical Algorithms Group Ltd. */ +/* .. Scalar Arguments .. */ +/* .. Array Arguments .. */ +/* .. Local Scalars .. */ +/* .. Executable Statements .. */ /* Parameter adjustments */ --rj; --ri; @@ -4722,16 +3766,15 @@ L30: } /* lze_ */ -logical lzeres_(char *type__, char *uplo, integer *m, integer *n, - doublecomplex *aa, doublecomplex *as, integer *lda) +logical lzeres_(char* type__, char* uplo, integer* m, integer* n, doublecomplex *aa, doublecomplex* as, integer* lda, ftnlen type_len, ftnlen uplo_len) { /* System generated locals */ integer aa_dim1, aa_offset, as_dim1, as_offset, i__1, i__2, i__3, i__4; logical ret_val; /* Local variables */ - integer ibeg, iend, i__, j; - logical upper; + static integer ibeg, iend, i__, j; + static logical upper; /* Tests if selected elements in two arrays are equal. */ @@ -4746,6 +3789,10 @@ logical lzeres_(char *type__, char *uplo, integer *m, integer *n, /* Jeremy Du Croz, Numerical Algorithms Group Ltd. */ /* Sven Hammarling, Numerical Algorithms Group Ltd. */ +/* .. Scalar Arguments .. */ +/* .. Array Arguments .. */ +/* .. Local Scalars .. */ +/* .. Executable Statements .. */ /* Parameter adjustments */ as_dim1 = *lda; as_offset = 1 + as_dim1 * 1; @@ -4803,7 +3850,7 @@ logical lzeres_(char *type__, char *uplo, integer *m, integer *n, } } -/* L60: */ +/* 60 CONTINUE */ ret_val = TRUE_; goto L80; L70: @@ -4815,7 +3862,7 @@ L80: } /* lzeres_ */ -/* Double Complex */ VOID zbeg_(doublecomplex * ret_val, logical *reset) +/* Double Complex */ VOID zbeg_(doublecomplex* ret_val, logical* reset) { /* System generated locals */ doublereal d__1, d__2; @@ -4836,6 +3883,11 @@ L80: /* Jeremy Du Croz, Numerical Algorithms Group Ltd. */ /* Sven Hammarling, Numerical Algorithms Group Ltd. */ +/* .. Scalar Arguments .. */ +/* .. Local Scalars .. */ +/* .. Save statement .. */ +/* .. Intrinsic Functions .. */ +/* .. Executable Statements .. */ if (*reset) { /* Initialize local variables. */ mi = 891; @@ -4873,7 +3925,7 @@ L10: } /* zbeg_ */ -doublereal ddiff_(doublereal *x, doublereal *y) +doublereal ddiff_(doublereal* x, doublereal* y) { /* System generated locals */ doublereal ret_val; @@ -4887,6 +3939,8 @@ doublereal ddiff_(doublereal *x, doublereal *y) /* Jeremy Du Croz, Numerical Algorithms Group Ltd. */ /* Sven Hammarling, Numerical Algorithms Group Ltd. */ +/* .. Scalar Arguments .. */ +/* .. Executable Statements .. */ ret_val = *x - *y; return ret_val; @@ -4894,4 +3948,4 @@ doublereal ddiff_(doublereal *x, doublereal *y) } /* ddiff_ */ -/* Main program alias */ int zblat3_ () { MAIN__ (); return 0; } +/* Main program alias */ /*int zblat3_ () { MAIN__ (); }*/ From 3e030cc5feef82b7ed6342e7e9cb2c49f581afa0 Mon Sep 17 00:00:00 2001 From: Chip-Kerchner Date: Mon, 26 Feb 2024 12:46:05 -0600 Subject: [PATCH 187/311] Fix LAPACK unit testing build issues. Limit AIX builds to 32 threads (to eliminate failures of some systems). --- Makefile | 4 ++++ Makefile.system | 2 +- getarch.c | 5 +++++ 3 files changed, 10 insertions(+), 1 deletion(-) diff --git a/Makefile b/Makefile index c04074795..fa210ad72 100644 --- a/Makefile +++ b/Makefile @@ -316,8 +316,12 @@ endif -@echo "PNOOPT = $(LAPACK_FPFLAGS) -O0" >> $(NETLIB_LAPACK_DIR)/make.inc ifeq ($(C_COMPILER)$(F_COMPILER)$(USE_OPENMP), CLANGGFORTRAN1) -@echo "LDFLAGS = $(FFLAGS) $(EXTRALIB) -lomp" >> $(NETLIB_LAPACK_DIR)/make.inc +else +ifeq ($(C_COMPILER)$(F_COMPILER)$(USE_OPENMP), CLANGIBM1) + -@echo "LDFLAGS = $(FFLAGS) $(EXTRALIB) -lomp" >> $(NETLIB_LAPACK_DIR)/make.inc else -@echo "LDFLAGS = $(FFLAGS) $(EXTRALIB)" >> $(NETLIB_LAPACK_DIR)/make.inc +endif endif -@echo "CC = $(CC)" >> $(NETLIB_LAPACK_DIR)/make.inc -@echo "override CFLAGS = $(LAPACK_CFLAGS)" >> $(NETLIB_LAPACK_DIR)/make.inc diff --git a/Makefile.system b/Makefile.system index cb5453cac..449069316 100644 --- a/Makefile.system +++ b/Makefile.system @@ -1181,7 +1181,7 @@ ifeq ($(F_COMPILER), IBM) CCOMMON_OPT += -DF_INTERFACE_IBM FEXTRALIB += -lxlf90 ifeq ($(C_COMPILER), $(filter $(C_COMPILER),GCC CLANG)) -FCOMMON_OPT += -qextname +FCOMMON_OPT += -qextname -qzerosize endif # FCOMMON_OPT += -qarch=440 ifdef BINARY64 diff --git a/getarch.c b/getarch.c index 2b5459a5f..436dc0990 100644 --- a/getarch.c +++ b/getarch.c @@ -2006,8 +2006,13 @@ printf("ELF_VERSION=2\n"); #endif #elif NO_PARALLEL_MAKE==1 printf("MAKEFLAGS += -j 1\n"); +#else +#ifdef _AIX + int count = get_num_cores(); + printf("MAKEFLAGS += -j %d\n", (count > 32) ? 32 : count); #else printf("MAKEFLAGS += -j %d\n", get_num_cores()); +#endif #endif break; From 5d929d2706f92b5fa70122b865dafe72aac6ea84 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Mon, 26 Feb 2024 21:00:57 +0100 Subject: [PATCH 188/311] avoid overriding the global USE_GEMM3M --- ctest/CMakeLists.txt | 5 ----- 1 file changed, 5 deletions(-) diff --git a/ctest/CMakeLists.txt b/ctest/CMakeLists.txt index d7baadee4..c56a78346 100644 --- a/ctest/CMakeLists.txt +++ b/ctest/CMakeLists.txt @@ -10,11 +10,6 @@ if (CMAKE_Fortran_COMPILER_ID STREQUAL GNU) set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -fno-tree-vectorize") endif() -set (USE_GEMM3M 0) -if (${ARCH} MATCHES x86|x86_64|ia64|mips) - set(USE_GEMM3M 1) -endif () - if(WIN32) FILE(WRITE ${CMAKE_CURRENT_BINARY_DIR}/test_cblas_helper.ps1 "$ErrorActionPreference = \"Stop\"\n" From 28f151808ea3fa3b39e02948d7b52616ce52cdfb Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Mon, 26 Feb 2024 21:01:46 +0100 Subject: [PATCH 189/311] Avoid overriding the global USE_GEMM3M --- test/CMakeLists.txt | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/test/CMakeLists.txt b/test/CMakeLists.txt index b4bf36cee..4ebd5348c 100644 --- a/test/CMakeLists.txt +++ b/test/CMakeLists.txt @@ -22,9 +22,7 @@ if (BUILD_COMPLEX16) list (APPEND OpenBLAS_Tests zblat1 zblat2 zblat3) endif() -set (USE_GEMM3M 0) -if (${ARCH} MATCHES x86|x86_64|ia64|mips) - set(USE_GEMM3M 1) +if (USE_GEMM3M) if (BUILD_COMPLEX) list (APPEND OpenBLAS_Tests cblat3_3m) endif () From ac08e3148df1dac62e0fcbb6f3c2a5536ce52658 Mon Sep 17 00:00:00 2001 From: Chip-Kerchner Date: Mon, 26 Feb 2024 14:57:53 -0600 Subject: [PATCH 190/311] Remove max num threads in AIX build. Use MAX_NB_JOBS instead. --- getarch.c | 5 ----- 1 file changed, 5 deletions(-) diff --git a/getarch.c b/getarch.c index 436dc0990..2b5459a5f 100644 --- a/getarch.c +++ b/getarch.c @@ -2006,13 +2006,8 @@ printf("ELF_VERSION=2\n"); #endif #elif NO_PARALLEL_MAKE==1 printf("MAKEFLAGS += -j 1\n"); -#else -#ifdef _AIX - int count = get_num_cores(); - printf("MAKEFLAGS += -j %d\n", (count > 32) ? 32 : count); #else printf("MAKEFLAGS += -j %d\n", get_num_cores()); -#endif #endif break; From 38283f678ed7683132f7b16f82fc6b13602f969a Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Mon, 26 Feb 2024 22:22:48 +0100 Subject: [PATCH 191/311] Fix portability problems --- utest/test_extensions/test_cgemv_t.c | 4 ++-- utest/test_extensions/test_csbmv.c | 6 +++--- utest/test_extensions/test_idamin.c | 8 +++++--- utest/test_extensions/test_isamin.c | 8 +++++--- utest/test_extensions/test_zgemv_t.c | 4 ++-- 5 files changed, 17 insertions(+), 13 deletions(-) diff --git a/utest/test_extensions/test_cgemv_t.c b/utest/test_extensions/test_cgemv_t.c index aa3281e66..cb4e5ad9e 100644 --- a/utest/test_extensions/test_cgemv_t.c +++ b/utest/test_extensions/test_cgemv_t.c @@ -126,7 +126,7 @@ static float check_cgemv(char api, char order, char trans, blasint m, blasint n, srand_generate(data_cgemv_t.y_test, m * inc_y * 2); // Copy vector y for reference funcs - for (int i = 0; i < m * inc_y * 2; i++) { + for (i = 0; i < m * inc_y * 2; i++) { data_cgemv_t.y_verify[i] = data_cgemv_t.y_test[i]; } @@ -1129,4 +1129,4 @@ CTEST(cgemv, c_api_xerbla_invalid_order_col_major) int passed = c_api_check_badargs(corder, ctrans, m, n, lda, inc_x, inc_y, expected_info); ASSERT_EQUAL(TRUE, passed); } -#endif \ No newline at end of file +#endif diff --git a/utest/test_extensions/test_csbmv.c b/utest/test_extensions/test_csbmv.c index 8e8ce4530..41c24a2b7 100644 --- a/utest/test_extensions/test_csbmv.c +++ b/utest/test_extensions/test_csbmv.c @@ -188,7 +188,7 @@ static float check_csbmv(char uplo, blasint n, blasint k, float *alpha, blasint char trans = 'N'; // Symmetric band packed matrix for sbmv - float a[lda * n * 2]; + float *a = (float*) malloc(lda * n * 2 * sizeof(float)); // Fill symmetric packed matrix sp_matrix, vector b_test, vector c_test srand_generate(data_csbmv.sp_matrix, n * (n + 1)); @@ -216,7 +216,7 @@ static float check_csbmv(char uplo, blasint n, blasint k, float *alpha, blasint // Find the differences between output vector caculated by csbmv and cgemv for (i = 0; i < n * inc_c * 2; i++) data_csbmv.c_test[i] -= data_csbmv.c_verify[i]; - + free(a); // Find the norm of differences return BLASFUNC(scnrm2)(&n, data_csbmv.c_test, &inc_c); } @@ -603,4 +603,4 @@ CTEST(csbmv, xerbla_lda_invalid) int passed = check_badargs(uplo, n, k, lda, inc_b, inc_c, expected_info); ASSERT_EQUAL(TRUE, passed); } -#endif \ No newline at end of file +#endif diff --git a/utest/test_extensions/test_idamin.c b/utest/test_extensions/test_idamin.c index 6a7ed9d1e..bebe76dba 100644 --- a/utest/test_extensions/test_idamin.c +++ b/utest/test_extensions/test_idamin.c @@ -402,13 +402,14 @@ CTEST(idamin, min_idx_in_vec_tail){ CTEST(idamin, min_idx_in_vec_tail_inc_1){ blasint i; blasint N = ELEMENTS, inc = 1; - double x[ELEMENTS * inc]; + double *x = (double*)malloc(ELEMENTS * inc * sizeof(double)); for (i = 0; i < N * inc; i ++) { x[i] = i + 1000; } x[(N - 1) * inc] = 0.0f; blasint index = BLASFUNC(idamin)(&N, x, &inc); + free(x); ASSERT_EQUAL(N, index); } @@ -775,13 +776,14 @@ CTEST(idamin, c_api_min_idx_in_vec_tail){ CTEST(idamin, c_api_min_idx_in_vec_tail_inc_1){ blasint i; blasint N = ELEMENTS, inc = 1; - double x[ELEMENTS * inc]; + double *x = (double*) malloc(ELEMENTS * inc * sizeof(double)); for (i = 0; i < N * inc; i ++) { x[i] = i + 1000; } x[(N - 1) * inc] = 0.0; blasint index = cblas_idamin(N, x, inc); + free(x); ASSERT_EQUAL(N - 1, index); } -#endif \ No newline at end of file +#endif diff --git a/utest/test_extensions/test_isamin.c b/utest/test_extensions/test_isamin.c index 4ff235b83..673e656df 100644 --- a/utest/test_extensions/test_isamin.c +++ b/utest/test_extensions/test_isamin.c @@ -402,13 +402,14 @@ CTEST(isamin, min_idx_in_vec_tail){ CTEST(isamin, min_idx_in_vec_tail_inc_1){ blasint i; blasint N = ELEMENTS, inc = 1; - float x[ELEMENTS * inc]; + float *x = (float*) (ELEMENTS * inc * sizeof(float)); for (i = 0; i < N * inc; i ++) { x[i] = i + 1000; } x[(N - 1) * inc] = 0.0f; blasint index = BLASFUNC(isamin)(&N, x, &inc); + free(x); ASSERT_EQUAL(N, index); } @@ -775,13 +776,14 @@ CTEST(isamin, c_api_min_idx_in_vec_tail){ CTEST(isamin, c_api_min_idx_in_vec_tail_inc_1){ blasint i; blasint N = ELEMENTS, inc = 1; - float x[ELEMENTS * inc]; + float *x = (float*)malloc(ELEMENTS * inc * sizeof(float)); for (i = 0; i < N * inc; i ++) { x[i] = i + 1000; } x[(N - 1) * inc] = 0.0f; blasint index = cblas_isamin(N, x, inc); + free(x); ASSERT_EQUAL(N - 1, index); } -#endif \ No newline at end of file +#endif diff --git a/utest/test_extensions/test_zgemv_t.c b/utest/test_extensions/test_zgemv_t.c index 2e0ee65f0..b2d0b2713 100644 --- a/utest/test_extensions/test_zgemv_t.c +++ b/utest/test_extensions/test_zgemv_t.c @@ -126,7 +126,7 @@ static double check_zgemv(char api, char order, char trans, blasint m, blasint n drand_generate(data_zgemv_t.y_test, m * inc_y * 2); // Copy vector y for reference funcs - for (int i = 0; i < m * inc_y * 2; i++) + for (i = 0; i < m * inc_y * 2; i++) { data_zgemv_t.y_verify[i] = data_zgemv_t.y_test[i]; } @@ -1133,4 +1133,4 @@ CTEST(zgemv, c_api_xerbla_invalid_order_col_major) int passed = c_api_check_badargs(corder, ctrans, m, n, lda, inc_x, inc_y, expected_info); ASSERT_EQUAL(TRUE, passed); } -#endif \ No newline at end of file +#endif From f7ffab870b6992d14173b0439b803da04ba1ab12 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Mon, 26 Feb 2024 23:03:10 +0100 Subject: [PATCH 192/311] fix missing malloc --- utest/test_extensions/test_isamin.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/utest/test_extensions/test_isamin.c b/utest/test_extensions/test_isamin.c index 673e656df..d93813e6f 100644 --- a/utest/test_extensions/test_isamin.c +++ b/utest/test_extensions/test_isamin.c @@ -402,7 +402,7 @@ CTEST(isamin, min_idx_in_vec_tail){ CTEST(isamin, min_idx_in_vec_tail_inc_1){ blasint i; blasint N = ELEMENTS, inc = 1; - float *x = (float*) (ELEMENTS * inc * sizeof(float)); + float *x = (float*) malloc(ELEMENTS * inc * sizeof(float)); for (i = 0; i < N * inc; i ++) { x[i] = i + 1000; } From f81c1d4b598e16205f31f8146ad64e4069fe12f9 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Tue, 27 Feb 2024 07:19:52 +0100 Subject: [PATCH 193/311] Fix portability problem --- utest/test_extensions/test_zsbmv.c | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/utest/test_extensions/test_zsbmv.c b/utest/test_extensions/test_zsbmv.c index afdb208c1..0e79dc0d8 100644 --- a/utest/test_extensions/test_zsbmv.c +++ b/utest/test_extensions/test_zsbmv.c @@ -188,7 +188,7 @@ static double check_zsbmv(char uplo, blasint n, blasint k, double *alpha, blasin char trans = 'N'; // Symmetric band packed matrix for sbmv - double a[lda * n * 2]; + double *a = (double*) malloc(lda * n * 2 * sizeof(double)); // Fill symmetric packed matrix sp_matrix, vector b_test, vector c_test drand_generate(data_zsbmv.sp_matrix, n * (n + 1)); @@ -213,6 +213,7 @@ static double check_zsbmv(char uplo, blasint n, blasint k, double *alpha, blasin BLASFUNC(zsbmv)(&uplo, &n, &k, alpha, a, &lda, data_zsbmv.b_test, &inc_b, beta, data_zsbmv.c_test, &inc_c); + free(a); // Find the differences between output vector caculated by zsbmv and zgemv for (i = 0; i < n * inc_c * 2; i++) data_zsbmv.c_test[i] -= data_zsbmv.c_verify[i]; @@ -603,4 +604,4 @@ CTEST(zsbmv, xerbla_lda_invalid) int passed = check_badargs(uplo, n, k, lda, inc_b, inc_c, expected_info); ASSERT_EQUAL(TRUE, passed); } -#endif \ No newline at end of file +#endif From 8e872a91a946c4fe646b9bb85732f92e3ae6424e Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Tue, 27 Feb 2024 11:28:50 +0100 Subject: [PATCH 194/311] Fix erroneous mapping of SUM kernels to ASUM --- kernel/zarch/KERNEL.Z13 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/kernel/zarch/KERNEL.Z13 b/kernel/zarch/KERNEL.Z13 index 3bcc32197..fe82d81e6 100644 --- a/kernel/zarch/KERNEL.Z13 +++ b/kernel/zarch/KERNEL.Z13 @@ -35,10 +35,10 @@ DASUMKERNEL = dasum.c CASUMKERNEL = ../arm/zasum.c ZASUMKERNEL = zasum.c -SSUMKERNEL = ../arm/asum.c -DSUMKERNEL = dasum.c -CSUMKERNEL = ../arm/zasum.c -ZSUMKERNEL = zasum.c +SSUMKERNEL = ../arm/sum.c +DSUMKERNEL = dsum.c +CSUMKERNEL = ../arm/zsum.c +ZSUMKERNEL = zsum.c SAXPYKERNEL = ../arm/axpy.c DAXPYKERNEL = daxpy.c From 4266b393046f2b12c9f2b5724889245380c0293d Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Tue, 27 Feb 2024 17:52:45 +0100 Subject: [PATCH 195/311] Make building the benchmarks optional and handle dependency on other options --- CMakeLists.txt | 23 ++++++++++++++++++++--- 1 file changed, 20 insertions(+), 3 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index af3050cf9..30adf3a66 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -24,6 +24,8 @@ option(BUILD_LAPACK_DEPRECATED "When building LAPACK, include also some older, d option(BUILD_TESTING "Build LAPACK testsuite when building LAPACK" ON) +option(BUILD_BENCHMARKS "Build the collection of BLAS/LAPACK benchmarks" OFF) + option(C_LAPACK "Build LAPACK from C sources instead of the original Fortran" OFF) option(BUILD_WITHOUT_CBLAS "Do not build the C interface (CBLAS) to the BLAS functions" OFF) @@ -458,9 +460,23 @@ if (BUILD_SHARED_LIBS AND NOT ${SYMBOLPREFIX}${SYMBOLSUFFIX} STREQUAL "") endif() endif() -if (BUILD_TESTING) - find_package(OpenMP REQUIRED) +if (BUILD_BENCHMARKS) + #find_package(OpenMP REQUIRED) file(GLOB SOURCES "benchmark/*.c") + if (NOT USE_OPENMP) + file(GLOB REMFILE "benchmark/smallscaling.c") + list(REMOVE_ITEM SOURCES ${REMFILE}) + endif() + if (BUILD_WITHOUT_LAPACK) + file(GLOB REMFILE "benchmark/cholesky.c") + list(REMOVE_ITEM SOURCES ${REMFILE}) + file(GLOB REMFILE "benchmark/geev.c") + list(REMOVE_ITEM SOURCES ${REMFILE}) + endif() + if (NOT USE_GEMM3M) + file(GLOB REMFILE "benchmark/gemm3m.c") + list(REMOVE_ITEM SOURCES ${REMFILE}) + endif() foreach(source ${SOURCES}) get_filename_component(name ${source} NAME_WE) if ((NOT ${name} STREQUAL "zdot-intel") AND (NOT ${name} STREQUAL "cula_wrapper")) @@ -477,7 +493,8 @@ if (BUILD_TESTING) (NOT ${target_name} STREQUAL "benchmark_min_COMPLEX") AND (NOT ${target_name} STREQUAL "benchmark_min_COMPLEX_DOUBLE")) add_executable(${target_name} ${source}) target_include_directories(${target_name} PRIVATE ${CMAKE_CURRENT_SOURCE_DIR} ${CMAKE_CURRENT_BINARY_DIR}) - target_link_libraries(${target_name} ${OpenBLAS_LIBNAME} OpenMP::OpenMP_C) + target_link_libraries(${target_name} ${OpenBLAS_LIBNAME} ) + # target_link_libraries(${target_name} ${OpenBLAS_LIBNAME} OpenMP::OpenMP_C) if (NOT "${define}" STREQUAL "DEFAULT") target_compile_definitions(${target_name} PRIVATE ${define}) endif() From cfc28c586ebcc840623d79560710a8485eea9ec2 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Tue, 27 Feb 2024 19:55:12 +0100 Subject: [PATCH 196/311] Exclude LAPACK testsuite and LAPACK-dependent benchmarks in no-LAPACK builds --- CMakeLists.txt | 14 +++++++++++++- 1 file changed, 13 insertions(+), 1 deletion(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 30adf3a66..9fbe878e6 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -330,7 +330,7 @@ if (NOT NOFORTRAN) # Build test and ctest add_subdirectory(test) endif() - if (BUILD_TESTING) + if (BUILD_TESTING AND NOT BUILD_WITHOUT_LAPACK) add_subdirectory(lapack-netlib/TESTING) endif() endif() @@ -472,6 +472,18 @@ if (BUILD_BENCHMARKS) list(REMOVE_ITEM SOURCES ${REMFILE}) file(GLOB REMFILE "benchmark/geev.c") list(REMOVE_ITEM SOURCES ${REMFILE}) + file(GLOB REMFILE "benchmark/gesv.c") + list(REMOVE_ITEM SOURCES ${REMFILE}) + file(GLOB REMFILE "benchmark/getri.c") + list(REMOVE_ITEM SOURCES ${REMFILE}) + file(GLOB REMFILE "benchmark/potrf.c") + list(REMOVE_ITEM SOURCES ${REMFILE}) + file(GLOB REMFILE "benchmark/spmv.c") + list(REMOVE_ITEM SOURCES ${REMFILE}) + file(GLOB REMFILE "benchmark/symv.c") + list(REMOVE_ITEM SOURCES ${REMFILE}) + file(GLOB REMFILE "benchmark/linpack.c") + list(REMOVE_ITEM SOURCES ${REMFILE}) endif() if (NOT USE_GEMM3M) file(GLOB REMFILE "benchmark/gemm3m.c") From d1409407a090a46512e1ecddc6633943ccef99be Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Tue, 27 Feb 2024 21:05:59 +0100 Subject: [PATCH 197/311] Omit redundant prefixes or suffixes in library naming --- Makefile.system | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/Makefile.system b/Makefile.system index cb5453cac..aadf3459a 100644 --- a/Makefile.system +++ b/Makefile.system @@ -1520,10 +1520,18 @@ ifndef LIBNAMEPREFIX LIBNAMEPREFIX = endif +SYMPREFIX=$(SYMBOLPREFIX) +ifeq ($(SYMBOLPREFIX),$(LIBNAMEPREFIX)) +SYMPREFIX= +endif +SYMSUFFIX=$(SYMBOLSUFFIX) +ifeq ($(SYMBOLSUFFIX),$(LIBNAMESUFFIX)) +SYMSUFFIX= +endif ifndef LIBNAMESUFFIX -LIBNAMEBASE = $(SYMBOLPREFIX)$(LIBSONAMEBASE)$(SYMBOLSUFFIX) +LIBNAMEBASE = $(SYMPREFIX)$(LIBSONAMEBASE)$(SYMSUFFIX) else -LIBNAMEBASE = $(SYMBOLPREFIX)$(LIBSONAMEBASE)$(SYMBOLSUFFIX)$(LIBNAMESUFFIX) +LIBNAMEBASE = $(SYMPREFIX)$(LIBSONAMEBASE)$(SYMSUFFIX)$(LIBNAMESUFFIX) endif ifeq ($(OSNAME), CYGWIN_NT) From c508a10cf2413fc5381376c4586303e0fa7ffbd0 Mon Sep 17 00:00:00 2001 From: gxw Date: Mon, 26 Feb 2024 20:09:42 -0500 Subject: [PATCH 198/311] LoongArch64: Add cgemv LSX opt --- kernel/loongarch64/KERNEL.LOONGSON2K1000 | 3 + kernel/loongarch64/cgemv_n_4_lsx.S | 323 +++++++++++++++++++++++ kernel/loongarch64/cgemv_t_4_lsx.S | 290 ++++++++++++++++++++ 3 files changed, 616 insertions(+) create mode 100644 kernel/loongarch64/cgemv_n_4_lsx.S create mode 100644 kernel/loongarch64/cgemv_t_4_lsx.S diff --git a/kernel/loongarch64/KERNEL.LOONGSON2K1000 b/kernel/loongarch64/KERNEL.LOONGSON2K1000 index c7ef44035..befe68451 100644 --- a/kernel/loongarch64/KERNEL.LOONGSON2K1000 +++ b/kernel/loongarch64/KERNEL.LOONGSON2K1000 @@ -100,6 +100,9 @@ DTRSMKERNEL_LT = ../generic/trsm_kernel_LT.c DTRSMKERNEL_RN = ../generic/trsm_kernel_RN.c DTRSMKERNEL_RT = ../generic/trsm_kernel_RT.c +CGEMVNKERNEL = cgemv_n_4_lsx.S +CGEMVTKERNEL = cgemv_t_4_lsx.S + CGEMMKERNEL = cgemm_kernel_8x4_lsx.S CGEMMINCOPY = cgemm_ncopy_8_lsx.S CGEMMITCOPY = cgemm_tcopy_8_lsx.S diff --git a/kernel/loongarch64/cgemv_n_4_lsx.S b/kernel/loongarch64/cgemv_n_4_lsx.S new file mode 100644 index 000000000..cf8273797 --- /dev/null +++ b/kernel/loongarch64/cgemv_n_4_lsx.S @@ -0,0 +1,323 @@ +/******************************************************************************* +Copyright (c) 2024, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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. +*******************************************************************************/ +#define ASSEMBLER + +#include "common.h" +#include "loongarch64_asm.S" + +/* int CNAME(BLASLONG m, BLASLONG n, BLASLONG dummy1, FLOAT alpha_r, FLOAT alpha_i, + * FLOAT *a, BLASLONG lda, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y, FLOAT *buffer) + */ +#define M $r4 +#define N $r5 +#define ALPHA_R $f0 +#define ALPHA_I $f1 +#define A $r7 +#define LDA $r8 +#define X $r9 +#define INC_X $r10 +#define Y $r11 +#define INC_Y $r6 + +#define J $r12 +#define I $r13 +#define K $r14 +#define Y_ORG $r15 +#define OFFSET $r16 +#define K_LDA $r17 +#define M8 $r18 +#define T0 $r19 +#define PA0 $r20 +#define PA1 $r23 +#define PA2 $r24 +#define PA3 $r25 +#define PA4 $r26 +#define PA5 $r27 +#define PA6 $r28 +#define PA7 $r29 + +#define VALPHA $vr1 +#define X0 $vr2 +#define X1 $vr3 +#define X2 $vr4 +#define X3 $vr5 +#define X4 $vr6 +#define X5 $vr7 +#define X6 $vr8 +#define X7 $vr9 +#define Y0 $vr10 +#define Y1 $vr11 +#define A0 $vr12 +#define A1 $vr13 +#define A2 $vr14 +#define A3 $vr15 +#define A4 $vr16 +#define A5 $vr17 +#define A6 $vr18 +#define A7 $vr19 +#define A8 $vr20 +#define A9 $vr21 +#define A10 $vr22 +#define A11 $vr23 +#define A12 $vr24 +#define A13 $vr25 +#define A14 $vr26 +#define A15 $vr27 +#define TMP0 $vr28 +#define TMP1 $vr29 +#define TMP2 $vr30 + +#if !defined(CONJ) +#if !defined(XCONJ) +#define GXCONJ 0 +#define GCONJ 0 +#else +#define GXCONJ 1 +#define GCONJ 0 +#endif +#else +#if !defined(XCONJ) +#define GXCONJ 0 +#define GCONJ 1 +#else +#define GXCONJ 1 +#define GCONJ 1 +#endif +#endif + +.macro CLOAD_X_4 + GLDREPL v, d, X0, X, 0x00, X1, X, 0x08, X2, X, 0x10, X3, X, 0x18 + GCOMPLEXMUL GXCONJ, \ + vf, s, X0, VALPHA, X0, TMP0, TMP1, TMP2, \ + X1, VALPHA, X1, TMP0, TMP1, TMP2, \ + X2, VALPHA, X2, TMP0, TMP1, TMP2, \ + X3, VALPHA, X3, TMP0, TMP1, TMP2 +.endm + +.macro CLOAD_X_4_GAP + vldrepl.d X0, X, 0x00 + PTR_ADD T0, X, INC_X + vldrepl.d X1, T0, 0x00 + PTR_ADD T0, T0, INC_X + vldrepl.d X2, T0, 0x00 + PTR_ADD T0, T0, INC_X + vldrepl.d X3, T0, 0x00 + + GCOMPLEXMUL GXCONJ, \ + vf, s, X0, VALPHA, X0, TMP0, TMP1, TMP2, \ + X1, VALPHA, X1, TMP0, TMP1, TMP2, \ + X2, VALPHA, X2, TMP0, TMP1, TMP2, \ + X3, VALPHA, X3, TMP0, TMP1, TMP2 +.endm + +.macro CLOAD_X_1 + GLDREPL v, d, X0, X, 0x00 + GCOMPLEXMUL GXCONJ, \ + vf, s, X0, VALPHA, X0, TMP0, TMP1, TMP2 +.endm + +.macro CLOAD_Y_4 + GLD v, , Y0, Y, 0, Y1, Y, 0x10 +.endm + +.macro CLOAD_Y_4_GAP + fld.d $f10, Y, 0 + fldx.d $f13, Y, INC_Y + PTR_ALSL T0, INC_Y, Y, 1 + fld.d $f11, T0, 0 + fldx.d $f17, T0, INC_Y + vpackev.d Y0, A1, Y0 + vpackev.d Y1, A5, Y1 +.endm + +.macro CLOAD_Y_1 + fld.d $f10, Y, 0 +.endm + +.macro CSTORE_Y_4 + GST v, , Y0, Y, 0, Y1, Y, 0x10 +.endm + +.macro CSTORE_Y_4_GAP + vstelm.d Y0, Y, 0, 0 + PTR_ADD T0, Y, INC_Y + vstelm.d Y0, T0, 0, 1 + PTR_ADD T0, T0, INC_Y + vstelm.d Y1, T0, 0, 0 + PTR_ADD T0, T0, INC_Y + vstelm.d Y1, T0, 0, 1 +.endm + +.macro CSTORE_Y_1 + fst.d $f10, Y, 0 +.endm + +.macro CGEMV_N_4x4 + GLD_INC v, , 0x10, \ + A0, PA0, 0, A1, PA0, 0, \ + A2, PA1, 0, A3, PA1, 0, \ + A4, PA2, 0, A5, PA2, 0, \ + A6, PA3, 0, A7, PA3, 0 + + GCOMPLEXMADD GXCONJ, GCONJ, \ + vf, s, Y0, X0, A0, Y0, TMP0, TMP1, TMP2, Y1, X0, A1, Y1, TMP0, TMP1, TMP2, \ + Y0, X1, A2, Y0, TMP0, TMP1, TMP2, Y1, X1, A3, Y1, TMP0, TMP1, TMP2, \ + Y0, X2, A4, Y0, TMP0, TMP1, TMP2, Y1, X2, A5, Y1, TMP0, TMP1, TMP2, \ + Y0, X3, A6, Y0, TMP0, TMP1, TMP2, Y1, X3, A7, Y1, TMP0, TMP1, TMP2 +.endm + +.macro CGEMV_N_1x4 + GLD_INC f, d, 0x08, $f12, PA0, 0, $f14, PA1, 0, $f16, PA2, 0, $f18, PA3, 0 + GCOMPLEXMADD GXCONJ, GCONJ, \ + vf, s, Y0, X0, A0, Y0, TMP0, TMP1, TMP2, \ + Y0, X1, A2, Y0, TMP0, TMP1, TMP2, \ + Y0, X2, A4, Y0, TMP0, TMP1, TMP2, \ + Y0, X3, A6, Y0, TMP0, TMP1, TMP2 +.endm + +.macro CGEMV_N_1x1 + fld.d $f12, PA0, 0 + PTR_ADDI PA0, PA0, 0x08 + GCOMPLEXMADD GXCONJ, GCONJ, \ + vf, s, Y0, X0, A0, Y0, TMP0, TMP1, TMP2 +.endm + +.macro CGEMV_N_LSX XW:req, X_4:req, X_1:req, Y_4:req, Y_1:req + PTR_SRLI J, N, 2 + beqz J, .L_\XW\()_N_3 + PTR_SLLI K_LDA, LDA, 2 + PTR_SUB K_LDA, K_LDA, M8 +.L_\XW\()_N_L4: + CLOAD_\X_4 + xor K, K, K + move Y, Y_ORG + PTR_SRLI I, M, 2 + beqz I, .L_\XW\()_M_3 +.align 5 +.L_\XW\()_M_L4: + CLOAD_\Y_4 + CGEMV_N_4x4 + CSTORE_\Y_4 + PTR_ADDI I, I, -1 + PTR_ALSL Y, INC_Y, Y, 2 + PTR_ADDI K, K, 4 + bnez I, .L_\XW\()_M_L4 +.L_\XW\()_M_3: + andi I, M, 3 + beqz I, .L_\XW\()_M_END +.align 5 +.L_\XW\()_M_L1: + CLOAD_\Y_1 + CGEMV_N_1x4 + CSTORE_\Y_1 + PTR_ADDI I, I, -1 + PTR_ADD Y, Y, INC_Y + PTR_ADDI K, K, 1 + bnez I, .L_\XW\()_M_L1 +.L_\XW\()_M_END: + PTR_ADDI J, J, -1 +#if __loongarch_grlen == 64 + GADD , d, PA0, PA0, K_LDA, PA1, PA1, K_LDA, PA2, PA2, K_LDA, PA3, PA3, K_LDA +#elif __loongarch_grlen == 32 + GADD , w, PA0, PA0, K_LDA, PA1, PA1, K_LDA, PA2, PA2, K_LDA, PA3, PA3, K_LDA +#else + GADD , d, PA0, PA0, K_LDA, PA1, PA1, K_LDA, PA2, PA2, K_LDA, PA3, PA3, K_LDA +#endif + PTR_ALSL X, INC_X, X, 2 + bnez J, .L_\XW\()_N_L4 +.L_\XW\()_N_3: + andi J, N, 3 + beqz J, .L_END +.L_\XW\()_N_L1: + CLOAD_\X_1 + xor K, K, K + move Y, Y_ORG + move I, M + beqz I, .L_END +.align 5 +.L_\XW\()_N_1_M_L1: + CLOAD_\Y_1 + CGEMV_N_1x1 + CSTORE_\Y_1 + PTR_ADDI I, I, -1 + PTR_ADD Y, Y, INC_Y + PTR_ADDI K, K, 1 + bnez I, .L_\XW\()_N_1_M_L1 +.L_\XW\()_N_1_M_END: + PTR_ADDI J, J, -1 + PTR_SUB K_LDA, LDA, M8 + PTR_ADD PA0, PA0, K_LDA + PTR_ADD X, X, INC_X + bnez J, .L_\XW\()_N_L1 + + b .L_END +.endm + + PROLOGUE + PTR_LD INC_Y, $sp, 0 + push_if_used 17 + 7, 31 + PTR_ADDI K, $r0, 0x01 + PTR_SUB I, INC_X, K + PTR_SUB J, INC_Y, K + maskeqz I, K, I /* if(inc_x == 1) I = 0; else I = 1; */ + maskeqz J, K, J /* if(inc_y == 1) j = 0; else j = 1; */ + PTR_ALSL I, I, J, 1 + GSLLI , d, LDA, LDA, 3, INC_X, INC_X, 3, INC_Y, INC_Y, 3, M8, M, 3 + // Init VALPHA + vpackev.w $vr0, $vr1, $vr0 + vpackev.d VALPHA, $vr0, $vr0 + move Y_ORG, Y + move PA0, A +#if __loongarch_grlen == 64 + GADD , d, PA1, PA0, LDA, PA2, PA1, LDA, PA3, PA2, LDA, PA4, PA3, LDA +#elif __loongarch_grlen == 32 + GADD , w, PA1, PA0, LDA, PA2, PA1, LDA, PA3, PA2, LDA, PA4, PA3, LDA +#else + GADD , d, PA1, PA0, LDA, PA2, PA1, LDA, PA3, PA2, LDA, PA4, PA3, LDA +#endif + la.local T0, .L_GAP_TABLE + PTR_ALSL I, I, T0, 1 + ld.h K, I, 0 // Obtain the offset address + PTR_ADD T0, T0, K + jirl $r0, T0, 0 +.L_GAP_TABLE: + .hword .L_GAP_0_0 - .L_GAP_TABLE + .hword .L_GAP_0_1 - .L_GAP_TABLE + .hword .L_GAP_1_0 - .L_GAP_TABLE + .hword .L_GAP_1_1 - .L_GAP_TABLE +.L_GAP_0_0: /* if (inc_x == 1) && (incy == 1) */ + CGEMV_N_LSX GAP_0_0, X_4, X_1, Y_4, Y_1 +.L_GAP_0_1: /* if (inc_x == 1) && (incy != 1) */ + CGEMV_N_LSX GAP_0_1, X_4, X_1, Y_4_GAP, Y_1 +.L_GAP_1_0: /* if (inc_x != 1) && (incy == 1) */ + CGEMV_N_LSX GAP_1_0, X_4_GAP, X_1, Y_4, Y_1 +.L_GAP_1_1: /* if (inc_x != 1) && (incy != 1) */ + CGEMV_N_LSX GAP_1_1, X_4_GAP, X_1, Y_4_GAP, Y_1 +.L_END: + pop_if_used 17 + 7, 31 + jirl $r0, $r1, 0x0 + EPILOGUE diff --git a/kernel/loongarch64/cgemv_t_4_lsx.S b/kernel/loongarch64/cgemv_t_4_lsx.S new file mode 100644 index 000000000..ada349364 --- /dev/null +++ b/kernel/loongarch64/cgemv_t_4_lsx.S @@ -0,0 +1,290 @@ +/******************************************************************************* +Copyright (c) 2024, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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. +*******************************************************************************/ +#define ASSEMBLER + +#include "common.h" +#include "loongarch64_asm.S" + +/* int CNAME(BLASLONG m, BLASLONG n, BLASLONG dummy1, FLOAT alpha_r, FLOAT alpha_i, + * FLOAT *a, BLASLONG lda, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y, FLOAT *buffer) + */ +#define M $r4 +#define N $r5 +#define ALPHA_R $f0 +#define ALPHA_I $f1 +#define A $r7 +#define LDA $r8 +#define X $r9 +#define INC_X $r10 +#define Y $r11 +#define INC_Y $r6 + +#define J $r12 +#define I $r13 +#define K $r14 +#define PY0 $r14 +#define X_ORG $r15 +#define PY1 $r16 +#define K_LDA $r17 +#define PY2 $r18 +#define T0 $r19 +#define PA0 $r20 +#define PA1 $r23 +#define PA2 $r24 +#define PA3 $r25 +#define PA4 $r26 +#define PA5 $r27 +#define PA6 $r28 +#define PA7 $r29 +#define M8 $r30 + +#define VALPHA $vr0 +#define X0 $vr1 +#define X1 $vr2 +#define A0 $vr3 +#define A1 $vr4 +#define A2 $vr5 +#define A3 $vr6 +#define A4 $vr7 +#define A5 $vr8 +#define A6 $vr9 +#define A7 $vr10 +#define A8 $vr11 +#define A9 $vr12 +#define A10 $vr13 +#define A11 $vr14 +#define A12 $vr15 +#define A13 $vr16 +#define A14 $vr17 +#define A15 $vr18 +#define TP0 $vr19 +#define TP1 $vr20 +#define TP2 $vr21 +#define TP3 $vr22 +#define TP4 $vr23 +#define TP5 $vr24 +#define TP6 $vr25 +#define TP7 $vr26 +#define TMP0 $vr27 +#define TMP1 $vr28 +#define TMP2 $vr29 +#define Y0 $vr3 +#define Y1 $vr4 +#define Y2 $vr5 +#define Y3 $vr6 +#define Y4 $vr7 +#define Y5 $vr8 +#define Y6 $vr9 +#define Y7 $vr10 + +#if ( !defined(CONJ) && !defined(XCONJ) ) || ( defined(CONJ) && defined(XCONJ) ) +#define GXCONJ1 0 +#define GCONJ1 0 +#else +#define GXCONJ1 1 +#define GCONJ1 0 +#endif + +#if !defined(XCONJ) +#define GXCONJ2 0 +#define GCONJ2 0 +#else +#define GXCONJ2 0 +#define GCONJ2 1 +#endif + +.macro ZERO_Y4 + GXOR v, v, TP0, TP0, TP0, TP1, TP1, TP1, TP2, TP2, TP2, TP3, TP3, TP3 +.endm + +.macro ZERO_Y1 + GXOR v, v, TP0, TP0, TP0 +.endm + +.macro CLOAD_X4 + GLD v, , X0, X, 0x00, X1, X, 0x10 +.endm + +.macro CLOAD_X4_GAP + fld.d $f1, X, 0x00 + fldx.d $f3, X, INC_X + PTR_ALSL T0, INC_X, X, 1 + fld.d $f2, T0, 0x00 + fldx.d $f4, T0, INC_X + vpackev.d X0, A0, X0 + vpackev.d X1, A1, X1 +.endm + +.macro CGEMV_T_4x4 + GLD_INC v, , 0x10, \ + A0, PA0, 0, A1, PA0, 0, \ + A2, PA1, 0, A3, PA1, 0, \ + A4, PA2, 0, A5, PA2, 0, \ + A6, PA3, 0, A7, PA3, 0 + GCOMPLEXMADD GXCONJ1, GCONJ1, \ + vf, s, TP0, A0, X0, TP0, TMP0, TMP1, TMP2, TP0, A1, X1, TP0, TMP0, TMP1, TMP2, \ + TP1, A2, X0, TP1, TMP0, TMP1, TMP2, TP1, A3, X1, TP1, TMP0, TMP1, TMP2, \ + TP2, A4, X0, TP2, TMP0, TMP1, TMP2, TP2, A5, X1, TP2, TMP0, TMP1, TMP2, \ + TP3, A6, X0, TP3, TMP0, TMP1, TMP2, TP3, A7, X1, TP3, TMP0, TMP1, TMP2 +.endm + +.macro CGEMV_T_LSX XW:req, X4:req + PTR_SRLI J, N, 2 + beqz J, .L_\XW\()_N_3 + PTR_SLLI K_LDA, LDA, 2 + PTR_SUB K_LDA, K_LDA, M8 +.L_\XW\()_N_L4: + ZERO_Y4 + move X, X_ORG + PTR_SRLI I, M, 2 + beqz I, .L_\XW\()_M_3 +.align 5 +.L_\XW\()_M_L4: + CLOAD_\X4 + CGEMV_T_4x4 + PTR_ADDI I, I, -1 + PTR_ALSL X, INC_X, X, 2 + bnez I, .L_\XW\()_M_L4 +.L_\XW\()_M_3: + // Accumulated + GCOMPLEXACC vf, s, Y0, TP0, Y1, TP1, Y2, TP2, Y3, TP3 + andi I, M, 3 + beqz I, .L_\XW\()_M_END +.align 5 +.L_\XW\()_M_L1: + fld.d $f1, X, 0x00 + fld.d $f11, PA0, 0x00 + fld.d $f12, PA1, 0x00 + fld.d $f13, PA2, 0x00 + fld.d $f14, PA3, 0x00 +#if __loongarch_grlen == 64 + GADDI , d, PA0, PA0, 0x08, PA1, PA1, 0x08, PA2, PA2, 0x08, PA3, PA3, 0x08 +#elif __loongarch_grlen == 32 + GADDI , w, PA0, PA0, 0x08, PA1, PA1, 0x08, PA2, PA2, 0x08, PA3, PA3, 0x08 +#else + GADDI , d, PA0, PA0, 0x08, PA1, PA1, 0x08, PA2, PA2, 0x08, PA3, PA3, 0x08 +#endif + + GCOMPLEXMADD GXCONJ1, GCONJ1, \ + vf, s, A0, A8, X0, A0, TMP0, TMP1, TMP2, A1, A9, X0, A1, TMP0, TMP1, TMP2, \ + A2, A10, X0, A2, TMP0, TMP1, TMP2, A3, A11, X0, A3, TMP0, TMP1, TMP2 + + PTR_ADDI I, I, -1 + PTR_ADD X, X, INC_X + bnez I, .L_\XW\()_M_L1 +.L_\XW\()_M_END: + fld.d $f11, Y, 0x00 + fldx.d $f12, Y, INC_Y + PTR_ALSL PY0, INC_Y, Y, 1 + fld.d $f13, PY0, 0x00 + fldx.d $f14, PY0, INC_Y + + GCOMPLEXMADD GXCONJ2, GCONJ2, \ + vf, s, A8, VALPHA, A0, A8, TMP0, TMP1, TMP2, A9, VALPHA, A1, A9, TMP0, TMP1, TMP2,\ + A10, VALPHA, A2, A10, TMP0, TMP1, TMP2, A11, VALPHA, A3, A11, TMP0, TMP1, TMP2 + + PTR_ADDI J, J, -1 +#if __loongarch_grlen == 64 + GADD , d, PA0, PA0, K_LDA, PA1, PA1, K_LDA, PA2, PA2, K_LDA, PA3, PA3, K_LDA +#elif __loongarch_grlen == 32 + GADD , w, PA0, PA0, K_LDA, PA1, PA1, K_LDA, PA2, PA2, K_LDA, PA3, PA3, K_LDA +#else + GADD , d, PA0, PA0, K_LDA, PA1, PA1, K_LDA, PA2, PA2, K_LDA, PA3, PA3, K_LDA +#endif + fst.d $f11, Y, 0x00 + fstx.d $f12, Y, INC_Y + fst.d $f13, PY0, 0x00 + fstx.d $f14, PY0, INC_Y + PTR_ALSL Y, INC_Y, Y, 2 + bnez J, .L_\XW\()_N_L4 +.L_\XW\()_N_3: + andi J, N, 3 + beqz J, .L_END + PTR_SUB K_LDA, LDA, M8 +.L_\XW\()_N_1: + ZERO_Y1 + move X, X_ORG + move I, M + beqz I, .L_END +.align 5 +.L_\XW\()_N_1_M_L1: + fld.d $f3, PA0, 0x00 + fld.d $f1, X, 0x00 + GCOMPLEXMADD GXCONJ1, GCONJ1, \ + vf, s, TP0, A0, X0, TP0, TMP0, TMP1, TMP2 + PTR_ADDI I, I, -1 + PTR_ADD X, X, INC_X + PTR_ADDI PA0, PA0, 0x08 + bnez I, .L_\XW\()_N_1_M_L1 +.L_\XW\()_N_1_M_END: + PTR_ADDI J, J, -1 + fld.d $f3, Y, 0x00 + GCOMPLEXMADD GXCONJ2, GCONJ2, \ + vf, s, A0, VALPHA, TP0, A0, TMP0, TMP1, TMP2 + fst.d $f3, Y, 0x00 + PTR_ADD PA0, PA0, K_LDA + PTR_ADD Y, Y, INC_Y + bnez J, .L_\XW\()_N_1 + + b .L_END +.endm + + PROLOGUE + PTR_LD INC_Y, $sp, 0 + push_if_used 17 + 8, 30 + PTR_ADDI K, $r0, 0x01 + PTR_SUB I, INC_X, K + maskeqz I, K, I /* if(inc_x == 1) I = 0; else I = 1; */ + GSLLI , d, LDA, LDA, 3, INC_X, INC_X, 3, INC_Y, INC_Y, 3, M8, M, 3 + // Init VALPHA + vpackev.w $vr0, $vr1, $vr0 + vpackev.d VALPHA, $vr0, $vr0 + move X_ORG, X + move PA0, A +#if __loongarch_grlen == 64 + GADD , d, PA1, PA0, LDA, PA2, PA1, LDA, PA3, PA2, LDA, PA4, PA3, LDA +#elif __loongarch_grlen == 32 + GADD , w, PA1, PA0, LDA, PA2, PA1, LDA, PA3, PA2, LDA, PA4, PA3, LDA +#else + GADD , d, PA1, PA0, LDA, PA2, PA1, LDA, PA3, PA2, LDA, PA4, PA3, LDA +#endif + la.local T0, .L_GAP_TABLE + PTR_ALSL I, I, T0, 1 + ld.h K, I, 0 + PTR_ADD T0, T0, K + jirl $r0, T0, 0 +.L_GAP_TABLE: + .hword .L_GAP_0 - .L_GAP_TABLE + .hword .L_GAP_1 - .L_GAP_TABLE +.L_GAP_0: /* if (incx == 1) */ + CGEMV_T_LSX GAP_0, X4 +.L_GAP_1: /* if (incx != 1) */ + CGEMV_T_LSX GAP_1, X4_GAP +.L_END: + pop_if_used 17 + 8, 30 + jirl $r0, $r1, 0x0 + EPILOGUE From 3f22fc22333ae7b739e0620d64710e3905ef1dc1 Mon Sep 17 00:00:00 2001 From: gxw Date: Tue, 27 Feb 2024 04:16:49 -0500 Subject: [PATCH 199/311] LoongArch64: Add zgemv LSX opt --- kernel/loongarch64/KERNEL.LOONGSON2K1000 | 3 + kernel/loongarch64/loongarch64_asm.S | 3 + kernel/loongarch64/zgemv_n_2_lsx.S | 296 +++++++++++++++++++++++ kernel/loongarch64/zgemv_t_2_lsx.S | 268 ++++++++++++++++++++ 4 files changed, 570 insertions(+) create mode 100644 kernel/loongarch64/zgemv_n_2_lsx.S create mode 100644 kernel/loongarch64/zgemv_t_2_lsx.S diff --git a/kernel/loongarch64/KERNEL.LOONGSON2K1000 b/kernel/loongarch64/KERNEL.LOONGSON2K1000 index befe68451..15d4358be 100644 --- a/kernel/loongarch64/KERNEL.LOONGSON2K1000 +++ b/kernel/loongarch64/KERNEL.LOONGSON2K1000 @@ -118,6 +118,9 @@ CTRSMKERNEL_LT = ../generic/trsm_kernel_LT.c CTRSMKERNEL_RN = ../generic/trsm_kernel_RN.c CTRSMKERNEL_RT = ../generic/trsm_kernel_RT.c +ZGEMVNKERNEL = zgemv_n_2_lsx.S +ZGEMVTKERNEL = zgemv_t_2_lsx.S + ZGEMMKERNEL = zgemm_kernel_4x4_lsx.S ZGEMMONCOPY = zgemm_ncopy_4_lsx.S ZGEMMOTCOPY = zgemm_tcopy_4_lsx.S diff --git a/kernel/loongarch64/loongarch64_asm.S b/kernel/loongarch64/loongarch64_asm.S index fee46d63e..d097b3045 100644 --- a/kernel/loongarch64/loongarch64_asm.S +++ b/kernel/loongarch64/loongarch64_asm.S @@ -406,9 +406,12 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. .ifeqs "\suf_op", "s" vpackod.d \out, \in, \in \pre_op\()add.\suf_op \out, \out, \in +.else + vor.v \out, \in, \in .endif .endif + .ifnb \more GCOMPLEXACC \pre_op, \suf_op, \more .endif diff --git a/kernel/loongarch64/zgemv_n_2_lsx.S b/kernel/loongarch64/zgemv_n_2_lsx.S new file mode 100644 index 000000000..efb376118 --- /dev/null +++ b/kernel/loongarch64/zgemv_n_2_lsx.S @@ -0,0 +1,296 @@ +/******************************************************************************* +Copyright (c) 2024, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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. +*******************************************************************************/ +#define ASSEMBLER + +#include "common.h" +#include "loongarch64_asm.S" + +/* int CNAME(BLASLONG m, BLASLONG n, BLASLONG dummy1, FLOAT alpha_r, FLOAT alpha_i, + * FLOAT *a, BLASLONG lda, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y, FLOAT *buffer) + */ +#define M $r4 +#define N $r5 +#define ALPHA_R $f0 +#define ALPHA_I $f1 +#define A $r7 +#define LDA $r8 +#define X $r9 +#define INC_X $r10 +#define Y $r11 +#define INC_Y $r6 + +#define J $r12 +#define I $r13 +#define K $r14 +#define Y_ORG $r15 +#define OFFSET $r16 +#define K_LDA $r17 +#define M16 $r18 +#define T0 $r19 +#define PA0 $r20 +#define PA1 $r23 +#define PA2 $r24 +#define PA3 $r25 +#define PA4 $r26 +#define PA5 $r27 +#define PA6 $r28 +#define PA7 $r29 + +#define VALPHA $vr1 +#define X0 $vr2 +#define X1 $vr3 +#define X2 $vr4 +#define X3 $vr5 +#define X4 $vr6 +#define X5 $vr7 +#define X6 $vr8 +#define X7 $vr9 +#define Y0 $vr10 +#define Y1 $vr11 +#define A0 $vr12 +#define A1 $vr13 +#define A2 $vr14 +#define A3 $vr15 +#define A4 $vr16 +#define A5 $vr17 +#define A6 $vr18 +#define A7 $vr19 +#define A8 $vr20 +#define A9 $vr21 +#define A10 $vr22 +#define A11 $vr23 +#define A12 $vr24 +#define A13 $vr25 +#define A14 $vr26 +#define A15 $vr27 +#define TMP0 $vr28 +#define TMP1 $vr29 +#define TMP2 $vr30 + +#if !defined(CONJ) +#if !defined(XCONJ) +#define GXCONJ 0 +#define GCONJ 0 +#else +#define GXCONJ 1 +#define GCONJ 0 +#endif +#else +#if !defined(XCONJ) +#define GXCONJ 0 +#define GCONJ 1 +#else +#define GXCONJ 1 +#define GCONJ 1 +#endif +#endif + +.macro ZLOAD_X_2 + GLD v, , X0, X, 0x00, X1, X, 0x10 + GCOMPLEXMUL GXCONJ, \ + vf, d, X0, VALPHA, X0, TMP0, TMP1, TMP2, \ + X1, VALPHA, X1, TMP0, TMP1, TMP2 +.endm + +.macro ZLOAD_X_2_GAP + vld X0, X, 0 + PTR_ADD T0, X, INC_X + vld X1, T0, 0 + + GCOMPLEXMUL GXCONJ, \ + vf, d, X0, VALPHA, X0, TMP0, TMP1, TMP2, \ + X1, VALPHA, X1, TMP0, TMP1, TMP2 +.endm + +.macro ZLOAD_X_1 + GLD v, , X0, X, 0x00 + GCOMPLEXMUL GXCONJ, \ + vf, d, X0, VALPHA, X0, TMP0, TMP1, TMP2 +.endm + +.macro ZLOAD_Y_2 + GLD v, , Y0, Y, 0, Y1, Y, 0x10 +.endm + +.macro ZLOAD_Y_2_GAP + vld $vr10, Y, 0 + vldx $vr11, Y, INC_Y +.endm + +.macro ZLOAD_Y_1 + vld $vr10, Y, 0 +.endm + +.macro ZGEMV_N_2x2 + GLD_INC v, , 0x10, \ + A0, PA0, 0, A1, PA0, 0, \ + A2, PA1, 0, A3, PA1, 0 + GCOMPLEXMADD GXCONJ, GCONJ, \ + vf, d, Y0, X0, A0, Y0, TMP0, TMP1, TMP2, Y1, X0, A1, Y1, TMP0, TMP1, TMP2, \ + Y0, X1, A2, Y0, TMP0, TMP1, TMP2, Y1, X1, A3, Y1, TMP0, TMP1, TMP2 +.endm + +.macro ZGEMV_N_1x2 + GLD_INC v, , 0x10, $vr12, PA0, 0, $vr14, PA1, 0 + GCOMPLEXMADD GXCONJ, GCONJ, \ + vf, d, Y0, X0, A0, Y0, TMP0, TMP1, TMP2, \ + Y0, X1, A2, Y0, TMP0, TMP1, TMP2 +.endm + +.macro ZGEMV_N_1x1 + GLD_INC v, , 0x10, $vr12, PA0, 0 + GCOMPLEXMADD GXCONJ, GCONJ, \ + vf, d, Y0, X0, A0, Y0, TMP0, TMP1, TMP2 +.endm + +.macro ZSTORE_Y_2 + GST v, , Y0, Y, 0, Y1, Y, 0x10 +.endm + +.macro ZSTORE_Y_2_GAP + vst Y0, Y, 0 + vstx Y1, Y, INC_Y +.endm + +.macro ZSTORE_Y_1 + vst $vr10, Y, 0 +.endm + +.macro ZGEMV_N_LSX XW:req, X_2:req, X_1:req, Y_2:req, Y_1:req + PTR_SRLI J, N, 1 + beqz J, .L_\XW\()_N_1 + PTR_SLLI K_LDA, LDA, 1 + PTR_SUB K_LDA, K_LDA, M16 +.L_\XW\()_N_L2: + ZLOAD_\X_2 + xor K, K, K + move Y, Y_ORG + PTR_SRLI I, M, 1 + beqz I, .L_\XW\()_M_1 +.align 5 +.L_\XW\()_M_L2: + ZLOAD_\Y_2 + ZGEMV_N_2x2 + ZSTORE_\Y_2 + PTR_ADDI I, I, -1 + PTR_ALSL Y, INC_Y, Y, 1 + PTR_ADDI K, K, 4 + bnez I, .L_\XW\()_M_L2 +.L_\XW\()_M_1: + andi I, M, 1 + beqz I, .L_\XW\()_M_END +.align 5 +.L_\XW\()_M_L1: + ZLOAD_\Y_1 + ZGEMV_N_1x2 + ZSTORE_\Y_1 + PTR_ADDI I, I, -1 + PTR_ADD Y, Y, INC_Y + PTR_ADDI K, K, 1 + bnez I, .L_\XW\()_M_L1 +.L_\XW\()_M_END: + PTR_ADDI J, J, -1 +#if __loongarch_grlen == 64 + GADD , d, PA0, PA0, K_LDA, PA1, PA1, K_LDA +#elif __loongarch_grlen == 32 + GADD , w, PA0, PA0, K_LDA, PA1, PA1, K_LDA +#else + GADD , d, PA0, PA0, K_LDA, PA1, PA1, K_LDA +#endif + PTR_ALSL X, INC_X, X, 1 + bnez J, .L_\XW\()_N_L2 +.L_\XW\()_N_1: + andi J, N, 1 + beqz J, .L_END +.L_\XW\()_N_L1: + ZLOAD_\X_1 + xor K, K, K + move Y, Y_ORG + move I, M + beqz I, .L_END +.align 5 +.L_\XW\()_N_1_M_L1: + ZLOAD_\Y_1 + ZGEMV_N_1x1 + ZSTORE_\Y_1 + PTR_ADDI I, I, -1 + PTR_ADD Y, Y, INC_Y + PTR_ADDI K, K, 1 + bnez I, .L_\XW\()_N_1_M_L1 +.L_\XW\()_N_1_M_END: + PTR_ADDI J, J, -1 + PTR_SUB K_LDA, LDA, M16 + PTR_ADD PA0, PA0, K_LDA + PTR_ADD X, X, INC_X + bnez J, .L_\XW\()_N_L1 + + b .L_END +.endm + + PROLOGUE + PTR_LD INC_Y, $sp, 0 + push_if_used 17 + 7, 31 + PTR_ADDI K, $r0, 0x01 + PTR_SUB I, INC_X, K + PTR_SUB J, INC_Y, K + maskeqz I, K, I /* if(inc_x == 1) I = 0; else I = 1; */ + maskeqz J, K, J /* if(inc_y == 1) j = 0; else j = 1; */ + PTR_ALSL I, I, J, 1 + GSLLI , d, LDA, LDA, 4, INC_X, INC_X, 4, INC_Y, INC_Y, 4, M16, M, 4 + // Init VALPHA + vpackev.d VALPHA, $vr1, $vr0 + move Y_ORG, Y + move PA0, A +#if __loongarch_grlen == 64 + GADD , d, PA1, PA0, LDA +#elif __loongarch_grlen == 32 + GADD , w, PA1, PA0, LDA +#else + GADD , d, PA1, PA0, LDA +#endif + la.local T0, .L_GAP_TABLE + PTR_ALSL I, I, T0, 1 + ld.h K, I, 0 // Obtain the offset address + PTR_ADD T0, T0, K + jirl $r0, T0, 0 +.L_GAP_TABLE: + .hword .L_GAP_0_0 - .L_GAP_TABLE + .hword .L_GAP_0_1 - .L_GAP_TABLE + .hword .L_GAP_1_0 - .L_GAP_TABLE + .hword .L_GAP_1_1 - .L_GAP_TABLE +.L_GAP_0_0: /* if (inc_x == 1) && (incy == 1) */ + ZGEMV_N_LSX GAP_0_0, X_2, X_1, Y_2, Y_1 +.L_GAP_0_1: /* if (inc_x == 1) && (incy != 1) */ + ZGEMV_N_LSX GAP_0_1, X_2, X_1, Y_2_GAP, Y_1 +.L_GAP_1_0: /* if (inc_x != 1) && (incy == 1) */ + ZGEMV_N_LSX GAP_1_0, X_2_GAP, X_1, Y_2, Y_1 +.L_GAP_1_1: /* if (inc_x != 1) && (incy != 1) */ + ZGEMV_N_LSX GAP_1_1, X_2_GAP, X_1, Y_2_GAP, Y_1 +.L_END: + pop_if_used 17 + 7, 31 + jirl $r0, $r1, 0x0 + EPILOGUE diff --git a/kernel/loongarch64/zgemv_t_2_lsx.S b/kernel/loongarch64/zgemv_t_2_lsx.S new file mode 100644 index 000000000..2a0fc172e --- /dev/null +++ b/kernel/loongarch64/zgemv_t_2_lsx.S @@ -0,0 +1,268 @@ +/******************************************************************************* +Copyright (c) 2024, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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. +*******************************************************************************/ +#define ASSEMBLER + +#include "common.h" +#include "loongarch64_asm.S" + +/* int CNAME(BLASLONG m, BLASLONG n, BLASLONG dummy1, FLOAT alpha_r, FLOAT alpha_i, + * FLOAT *a, BLASLONG lda, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y, FLOAT *buffer) + */ +#define M $r4 +#define N $r5 +#define ALPHA_R $f0 +#define ALPHA_I $f1 +#define A $r7 +#define LDA $r8 +#define X $r9 +#define INC_X $r10 +#define Y $r11 +#define INC_Y $r6 + +#define J $r12 +#define I $r13 +#define K $r14 +#define PY0 $r14 +#define X_ORG $r15 +#define PY1 $r16 +#define K_LDA $r17 +#define PY2 $r18 +#define T0 $r19 +#define PA0 $r20 +#define PA1 $r23 +#define PA2 $r24 +#define PA3 $r25 +#define PA4 $r26 +#define PA5 $r27 +#define PA6 $r28 +#define PA7 $r29 +#define M16 $r30 + +#define VALPHA $vr0 +#define X0 $vr1 +#define X1 $vr2 +#define A0 $vr3 +#define A1 $vr4 +#define A2 $vr5 +#define A3 $vr6 +#define A4 $vr7 +#define A5 $vr8 +#define A6 $vr9 +#define A7 $vr10 +#define A8 $vr11 +#define A9 $vr12 +#define A10 $vr13 +#define A11 $vr14 +#define A12 $vr15 +#define A13 $vr16 +#define A14 $vr17 +#define A15 $vr18 +#define TP0 $vr19 +#define TP1 $vr20 +#define TP2 $vr21 +#define TP3 $vr22 +#define TP4 $vr23 +#define TP5 $vr24 +#define TP6 $vr25 +#define TP7 $vr26 +#define TMP0 $vr27 +#define TMP1 $vr28 +#define TMP2 $vr29 +#define Y0 $vr3 +#define Y1 $vr4 +#define Y2 $vr5 +#define Y3 $vr6 +#define Y4 $vr7 +#define Y5 $vr8 +#define Y6 $vr9 +#define Y7 $vr10 + +#if ( !defined(CONJ) && !defined(XCONJ) ) || ( defined(CONJ) && defined(XCONJ) ) +#define GXCONJ1 0 +#define GCONJ1 0 +#else +#define GXCONJ1 1 +#define GCONJ1 0 +#endif + +#if !defined(XCONJ) +#define GXCONJ2 0 +#define GCONJ2 0 +#else +#define GXCONJ2 0 +#define GCONJ2 1 +#endif + +.macro ZERO_Y2 + GXOR v, v, TP0, TP0, TP0, TP1, TP1, TP1 +.endm + +.macro ZERO_Y1 + GXOR v, v, TP0, TP0, TP0 +.endm + +.macro ZLOAD_X2 + GLD v, , X0, X, 0x00, X1, X, 0x10 +.endm + +.macro ZLOAD_X2_GAP + vld X0, X, 0 + vldx X1, X, INC_X +.endm + +.macro ZGEMV_T_2x2 + GLD_INC v, , 0x10, \ + A0, PA0, 0, A1, PA0, 0, \ + A2, PA1, 0, A3, PA1, 0 + GCOMPLEXMADD GXCONJ1, GCONJ1, \ + vf, d, TP0, A0, X0, TP0, TMP0, TMP1, TMP2, TP0, A1, X1, TP0, TMP0, TMP1, TMP2, \ + TP1, A2, X0, TP1, TMP0, TMP1, TMP2, TP1, A3, X1, TP1, TMP0, TMP1, TMP2 +.endm + +.macro ZGEMV_T_LSX XW:req, X2:req + PTR_SRLI J, N, 1 + beqz J, .L_\XW\()_N_1 + PTR_SLLI K_LDA, LDA, 1 + PTR_SUB K_LDA, K_LDA, M16 +.L_\XW\()_N_L2: + ZERO_Y2 + move X, X_ORG + PTR_SRLI I, M, 1 + beqz I, .L_\XW\()_M_1 +.align 5 +.L_\XW\()_M_L2: + ZLOAD_\X2 + ZGEMV_T_2x2 + PTR_ADDI I, I, -1 + PTR_ALSL X, INC_X, X, 1 + bnez I, .L_\XW\()_M_L2 +.L_\XW\()_M_1: + // Accumulated + GCOMPLEXACC vf, d, Y0, TP0, Y1, TP1 + andi I, M, 1 + beqz I, .L_\XW\()_M_END +.align 5 +.L_\XW\()_M_L1: + GLD v, , X0, X, 0x00, A8, PA0, 0x00, A9, PA1, 0x00 +#if __loongarch_grlen == 64 + GADDI , d, PA0, PA0, 0x10, PA1, PA1, 0x10 +#elif __loongarch_grlen == 32 + GADDI , w, PA0, PA0, 0x10, PA1, PA1, 0x10 +#else + GADDI , d, PA0, PA0, 0x10, PA1, PA1, 0x10 +#endif + + GCOMPLEXMADD GXCONJ1, GCONJ1, \ + vf, d, A0, A8, X0, A0, TMP0, TMP1, TMP2, A1, A9, X0, A1, TMP0, TMP1, TMP2 + + PTR_ADDI I, I, -1 + PTR_ADD X, X, INC_X + bnez I, .L_\XW\()_M_L1 +.L_\XW\()_M_END: + vld A8, Y, 0x00 + vldx A9, Y, INC_Y + + GCOMPLEXMADD GXCONJ2, GCONJ2, \ + vf, d, A8, VALPHA, A0, A8, TMP0, TMP1, TMP2, A9, VALPHA, A1, A9, TMP0, TMP1, TMP2 + + PTR_ADDI J, J, -1 +#if __loongarch_grlen == 64 + GADD , d, PA0, PA0, K_LDA, PA1, PA1, K_LDA +#elif __loongarch_grlen == 32 + GADD , w, PA0, PA0, K_LDA, PA1, PA1, K_LDA +#else + GADD , d, PA0, PA0, K_LDA, PA1, PA1, K_LDA +#endif + vst $vr11, Y, 0x00 + vstx $vr12, Y, INC_Y + PTR_ALSL Y, INC_Y, Y, 1 + bnez J, .L_\XW\()_N_L2 +.L_\XW\()_N_1: + andi J, N, 1 + beqz J, .L_END + PTR_SUB K_LDA, LDA, M16 +.L_\XW\()_N_L1: + ZERO_Y1 + move X, X_ORG + move I, M + beqz I, .L_END +.align 5 +.L_\XW\()_N_1_M_L1: + GLD v, , A0, PA0, 0x00, X0, X, 0x00 + GCOMPLEXMADD GXCONJ1, GCONJ1, \ + vf, d, TP0, A0, X0, TP0, TMP0, TMP1, TMP2 + PTR_ADDI I, I, -1 + PTR_ADD X, X, INC_X + PTR_ADDI PA0, PA0, 0x10 + bnez I, .L_\XW\()_N_1_M_L1 +.L_\XW\()_N_1_M_END: + PTR_ADDI J, J, -1 + vld A0, Y, 0x00 + GCOMPLEXMADD GXCONJ2, GCONJ2, \ + vf, d, A0, VALPHA, TP0, A0, TMP0, TMP1, TMP2 + vst $vr3, Y, 0x00 + PTR_ADD PA0, PA0, K_LDA + PTR_ADD Y, Y, INC_Y + bnez J, .L_\XW\()_N_L1 + + b .L_END +.endm + + PROLOGUE + PTR_LD INC_Y, $sp, 0 + push_if_used 17 + 8, 30 + PTR_ADDI K, $r0, 0x01 + PTR_SUB I, INC_X, K + maskeqz I, K, I /* if(inc_x == 1) I = 0; else I = 1; */ + GSLLI , d, LDA, LDA, 4, INC_X, INC_X, 4, INC_Y, INC_Y, 4, M16, M, 4 + // Init VALPHA + vpackev.d VALPHA, $vr1, $vr0 + move X_ORG, X + move PA0, A +#if __loongarch_grlen == 64 + GADD , d, PA1, PA0, LDA +#elif __loongarch_grlen == 32 + GADD , w, PA1, PA0, LDA +#else + GADD , d, PA1, PA0, LDA +#endif + la.local T0, .L_GAP_TABLE + PTR_ALSL I, I, T0, 1 + ld.h K, I, 0 + PTR_ADD T0, T0, K + jirl $r0, T0, 0 +.L_GAP_TABLE: + .hword .L_GAP_0 - .L_GAP_TABLE + .hword .L_GAP_1 - .L_GAP_TABLE +.L_GAP_0: /* if (incx == 1) */ + ZGEMV_T_LSX GAP_0, X2 +.L_GAP_1: /* if (incx != 1) */ + ZGEMV_T_LSX GAP_1, X2_GAP +.L_END: + pop_if_used 17 + 8, 30 + jirl $r0, $r1, 0x0 + EPILOGUE From 8e05c053be8b889697b17f6847d94a8e4ce3c12b Mon Sep 17 00:00:00 2001 From: gxw Date: Tue, 27 Feb 2024 21:17:01 -0500 Subject: [PATCH 200/311] LoongArch64:Fixed the failed test cases test_{c/z}gemv_n in test_extensions --- kernel/loongarch64/cgemv_n_8_lasx.S | 34 ++++++++++++++--------------- kernel/loongarch64/zgemv_n_4_lasx.S | 18 +++++++-------- 2 files changed, 26 insertions(+), 26 deletions(-) diff --git a/kernel/loongarch64/cgemv_n_8_lasx.S b/kernel/loongarch64/cgemv_n_8_lasx.S index b078e3227..ba38a9573 100644 --- a/kernel/loongarch64/cgemv_n_8_lasx.S +++ b/kernel/loongarch64/cgemv_n_8_lasx.S @@ -122,14 +122,14 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. GLDREPL xv, d, X0, X, 0x00, X1, X, 0x08, X2, X, 0x10, X3, X, 0x18, \ X4, X, 0x20, X5, X, 0x28, X6, X, 0x30, X7, X, 0x38 GCOMPLEXMUL GXCONJ, \ - xvf, s, X0, X0, VALPHA, TMP0, TMP1, TMP2, \ - X1, X1, VALPHA, TMP0, TMP1, TMP2, \ - X2, X2, VALPHA, TMP0, TMP1, TMP2, \ - X3, X3, VALPHA, TMP0, TMP1, TMP2, \ - X4, X4, VALPHA, TMP0, TMP1, TMP2, \ - X5, X5, VALPHA, TMP0, TMP1, TMP2, \ - X6, X6, VALPHA, TMP0, TMP1, TMP2, \ - X7, X7, VALPHA, TMP0, TMP1, TMP2 + xvf, s, X0, VALPHA, X0, TMP0, TMP1, TMP2, \ + X1, VALPHA, X1, TMP0, TMP1, TMP2, \ + X2, VALPHA, X2, TMP0, TMP1, TMP2, \ + X3, VALPHA, X3, TMP0, TMP1, TMP2, \ + X4, VALPHA, X4, TMP0, TMP1, TMP2, \ + X5, VALPHA, X5, TMP0, TMP1, TMP2, \ + X6, VALPHA, X6, TMP0, TMP1, TMP2, \ + X7, VALPHA, X7, TMP0, TMP1, TMP2 .endm .macro CLOAD_X_8_GAP @@ -150,14 +150,14 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. xvldrepl.d X7, T0, 0x00 GCOMPLEXMUL GXCONJ, \ - xvf, s, X0, X0, VALPHA, TMP0, TMP1, TMP2, \ - X1, X1, VALPHA, TMP0, TMP1, TMP2, \ - X2, X2, VALPHA, TMP0, TMP1, TMP2, \ - X3, X3, VALPHA, TMP0, TMP1, TMP2, \ - X4, X4, VALPHA, TMP0, TMP1, TMP2, \ - X5, X5, VALPHA, TMP0, TMP1, TMP2, \ - X6, X6, VALPHA, TMP0, TMP1, TMP2, \ - X7, X7, VALPHA, TMP0, TMP1, TMP2 + xvf, s, X0, VALPHA, X0, TMP0, TMP1, TMP2, \ + X1, VALPHA, X1, TMP0, TMP1, TMP2, \ + X2, VALPHA, X2, TMP0, TMP1, TMP2, \ + X3, VALPHA, X3, TMP0, TMP1, TMP2, \ + X4, VALPHA, X4, TMP0, TMP1, TMP2, \ + X5, VALPHA, X5, TMP0, TMP1, TMP2, \ + X6, VALPHA, X6, TMP0, TMP1, TMP2, \ + X7, VALPHA, X7, TMP0, TMP1, TMP2 .endm .macro CLOAD_Y_8 @@ -228,7 +228,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. .macro CLOAD_X_1 GLDREPL xv, d, X0, X, 0x00 GCOMPLEXMUL GXCONJ, \ - xvf, s, X0, X0, VALPHA, TMP0, TMP1, TMP2 + xvf, s, X0, VALPHA, X0, TMP0, TMP1, TMP2 .endm .macro CLOAD_Y_1 diff --git a/kernel/loongarch64/zgemv_n_4_lasx.S b/kernel/loongarch64/zgemv_n_4_lasx.S index 98b1a6f7d..26edf1ed7 100644 --- a/kernel/loongarch64/zgemv_n_4_lasx.S +++ b/kernel/loongarch64/zgemv_n_4_lasx.S @@ -122,10 +122,10 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. GLD xv, , X0, X, 0x00, X1, X, 0x10, X2, X, 0x20, X3, X, 0x30 GPERMI xv, q, X0, X0, 0, X1, X1, 0, X2, X2, 0, X3, X3, 0 GCOMPLEXMUL GXCONJ, \ - xvf, d, X0, X0, VALPHA, TMP0, TMP1, TMP2, \ - X1, X1, VALPHA, TMP0, TMP1, TMP2, \ - X2, X2, VALPHA, TMP0, TMP1, TMP2, \ - X3, X3, VALPHA, TMP0, TMP1, TMP2 + xvf, d, X0, VALPHA, X0, TMP0, TMP1, TMP2, \ + X1, VALPHA, X1, TMP0, TMP1, TMP2, \ + X2, VALPHA, X2, TMP0, TMP1, TMP2, \ + X3, VALPHA, X3, TMP0, TMP1, TMP2 .endm .macro ZLOAD_X_4_GAP @@ -145,10 +145,10 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. xvpermi.q X3, X3, 0 GCOMPLEXMUL GXCONJ, \ - xvf, d, X0, X0, VALPHA, TMP0, TMP1, TMP2, \ - X1, X1, VALPHA, TMP0, TMP1, TMP2, \ - X2, X2, VALPHA, TMP0, TMP1, TMP2, \ - X3, X3, VALPHA, TMP0, TMP1, TMP2 + xvf, d, X0, VALPHA, X0, TMP0, TMP1, TMP2, \ + X1, VALPHA, X1, TMP0, TMP1, TMP2, \ + X2, VALPHA, X2, TMP0, TMP1, TMP2, \ + X3, VALPHA, X3, TMP0, TMP1, TMP2 .endm .macro ZLOAD_Y_4 @@ -216,7 +216,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. GLD xv, , X0, X, 0x00 GPERMI xv, q, X0, X0, 0 GCOMPLEXMUL GXCONJ, \ - xvf, d, X0, X0, VALPHA, TMP0, TMP1, TMP2 + xvf, d, X0, VALPHA, X0, TMP0, TMP1, TMP2 .endm .macro ZGEMV_N_1x1 From b2db064285bfaa36ac44b3a61cb4930cf0076d8d Mon Sep 17 00:00:00 2001 From: pengxu Date: Tue, 27 Feb 2024 10:47:49 +0800 Subject: [PATCH 201/311] Optimized sgemv and dgemv kernel LSX for LoongArch --- kernel/loongarch64/KERNEL.LOONGSON2K1000 | 12 + kernel/loongarch64/dgemv_n_lsx.S | 229 +++++++++++++++++++ kernel/loongarch64/dgemv_t_lsx.S | 279 +++++++++++++++++++++++ kernel/loongarch64/sgemv_n_lsx.S | 227 ++++++++++++++++++ kernel/loongarch64/sgemv_t_lsx.S | 275 ++++++++++++++++++++++ 5 files changed, 1022 insertions(+) create mode 100644 kernel/loongarch64/dgemv_n_lsx.S create mode 100644 kernel/loongarch64/dgemv_t_lsx.S create mode 100644 kernel/loongarch64/sgemv_n_lsx.S create mode 100644 kernel/loongarch64/sgemv_t_lsx.S diff --git a/kernel/loongarch64/KERNEL.LOONGSON2K1000 b/kernel/loongarch64/KERNEL.LOONGSON2K1000 index c7ef44035..5b54a2ada 100644 --- a/kernel/loongarch64/KERNEL.LOONGSON2K1000 +++ b/kernel/loongarch64/KERNEL.LOONGSON2K1000 @@ -85,6 +85,12 @@ ZSWAPKERNEL = cswap_lsx.S CSUMKERNEL = csum_lsx.S ZSUMKERNEL = csum_lsx.S +SGEMVNKERNEL = sgemv_n_lsx.S +SGEMVTKERNEL = sgemv_t_lsx.S + +DGEMVNKERNEL = dgemv_n_lsx.S +DGEMVTKERNEL = dgemv_t_lsx.S + DGEMMKERNEL = dgemm_kernel_8x4.S DGEMMINCOPY = dgemm_ncopy_8_lsx.S DGEMMITCOPY = dgemm_tcopy_8_lsx.S @@ -100,6 +106,9 @@ DTRSMKERNEL_LT = ../generic/trsm_kernel_LT.c DTRSMKERNEL_RN = ../generic/trsm_kernel_RN.c DTRSMKERNEL_RT = ../generic/trsm_kernel_RT.c +CGEMVNKERNEL = cgemv_n_4_lsx.S +CGEMVTKERNEL = cgemv_t_4_lsx.S + CGEMMKERNEL = cgemm_kernel_8x4_lsx.S CGEMMINCOPY = cgemm_ncopy_8_lsx.S CGEMMITCOPY = cgemm_tcopy_8_lsx.S @@ -115,6 +124,9 @@ CTRSMKERNEL_LT = ../generic/trsm_kernel_LT.c CTRSMKERNEL_RN = ../generic/trsm_kernel_RN.c CTRSMKERNEL_RT = ../generic/trsm_kernel_RT.c +ZGEMVNKERNEL = zgemv_n_2_lsx.S +ZGEMVTKERNEL = zgemv_t_2_lsx.S + ZGEMMKERNEL = zgemm_kernel_4x4_lsx.S ZGEMMONCOPY = zgemm_ncopy_4_lsx.S ZGEMMOTCOPY = zgemm_tcopy_4_lsx.S diff --git a/kernel/loongarch64/dgemv_n_lsx.S b/kernel/loongarch64/dgemv_n_lsx.S new file mode 100644 index 000000000..9a0141fb1 --- /dev/null +++ b/kernel/loongarch64/dgemv_n_lsx.S @@ -0,0 +1,229 @@ +/******************************************************************************* +Copyright (c) 2024, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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. +*******************************************************************************/ + +#define ASSEMBLER + +#include "common.h" + +/* Param */ +#define M $r4 +#define N $r5 +#define A $r7 +#define LDA $r8 +#define X $r9 +#define INCX $r10 +#define Y $r11 +#define INCY $r6 +#define BUFFER $r16 +#define ALPHA $f0 + +#define YORIG $r18 +#define T0 $r19 +#define T1 $r20 +#define XX $r12 +#define YY $r13 +#define I $r14 +#define J $r15 +#define AO1 $r23 +#define AO2 $r24 +#define IX $r25 +#define IY $r26 +#define II $r27 +#define T2 $r28 +#define T3 $r29 +#define T4 $r30 + +/* LSX vectors */ +#define U0 $vr11 +#define U1 $vr12 +#define U2 $vr2 +#define U3 $vr3 +#define U4 $vr4 +#define U5 $vr5 +#define U6 $vr6 +#define U7 $vr7 +#define U8 $vr8 +#define U9 $vr9 +#define VALPHA $vr10 + +#define a1 $f3 +#define a2 $f4 +#define a3 $f5 +#define a4 $f6 +#define a5 $f7 +#define a6 $f8 +#define a7 $f9 +#define a8 $f10 + + + PROLOGUE + + LDARG INCY, $sp, 0 + LDARG BUFFER, $sp, 8 + + addi.d $sp, $sp, -80 + + SDARG $r23, $sp, 0 + SDARG $r24, $sp, 8 + SDARG $r25, $sp, 16 + SDARG $r26, $sp, 32 + SDARG $r27, $sp, 40 + SDARG $r28, $sp, 48 + SDARG $r29, $sp, 56 + SDARG $r30, $sp, 64 + ST ALPHA, $sp, 72 + + vldrepl.d VALPHA, $sp, 72 + + slli.d LDA, LDA, BASE_SHIFT + slli.d INCX, INCX, BASE_SHIFT + slli.d INCY, INCY, BASE_SHIFT + + bge $r0, M, .L999 + bge $r0, N, .L999 + + move J, $r0 + move IX, $r0 + + move AO1, A //a_ptr + move XX, X + move YY, Y + + beq J, M, .L999 + +.L01: + vldx U0, XX, IX + vshuf4i.d U0, U0, 0x00 + + vfmul.d U1, VALPHA, U0 //temp1 + + move IY, $r0 + move II, $r0 + move I, $r0 + + srai.d T0, M, 2 //n/4 + beq I, T0, .L03 + +.L02: + vldx U2, AO1, II + addi.d II, II, 16 + vldx U7, AO1, II + + move T1, IY + add.d T2, T1, INCY + add.d T3, T2, INCY + add.d T4, T3, INCY + + fldx.d a1, YY, T1 + fldx.d a2, YY, T2 + fldx.d a3, YY, T3 + fldx.d a4, YY, T4 + + vextrins.d U3, U4, 0x10 + vextrins.d U5, U6, 0x10 + + vfmadd.d U3, U1, U2, U3 + vfmadd.d U5, U1, U7, U5 + + vextrins.d U4, U3, 0x01 + vextrins.d U6, U5, 0x01 + + fstx.d a1, YY, T1 + fstx.d a2, YY, T2 + fstx.d a3, YY, T3 + fstx.d a4, YY, T4 + + add.d IY, T4, INCY + addi.d II, II, 16 + addi.d I, I, 1 + blt I, T0, .L02 + +.L03: + andi T0, M, 2 + beq $r0, T0, .L04 + + addi.d T1, $r0, 4 + mod.d T1, M, T1 + sub.d II, M, T1 + slli.d II, II, BASE_SHIFT + + move T1, IY + add.d T2, T1, INCY + + vldx U2, AO1, II + + fldx.d a1, YY, T1 + fldx.d a2, YY, T2 + + vextrins.d U3, U4, 0x10 + + vfmadd.d U3, U1, U2, U3 + + vextrins.d U4, U3, 0x01 + + fstx.d a1, YY, T1 + fstx.d a2, YY, T2 + + add.d IY, T2, INCY + +.L04: + andi T0, M, 1 + beq $r0, T0, .L05 + + addi.d II, M, -1 + slli.d II, II, BASE_SHIFT + + fldx.d a1, AO1, II + fldx.d a3, YY, IY + + fmadd.d a3, $f12, a1, a3 + + fstx.d a3, YY, IY + + add.d IY, IY, INCY + +.L05: + add.d AO1, AO1, LDA + add.d IX, IX, INCX + + addi.d J, J, 1 + blt J, N, .L01 + +.L999: + LDARG $r23, $sp, 0 + LDARG $r24, $sp, 8 + LDARG $r25, $sp, 16 + LDARG $r26, $sp, 32 + LDARG $r27, $sp, 40 + LDARG $r28, $sp, 48 + LDARG $r29, $sp, 56 + LDARG $r30, $sp, 64 + LD ALPHA, $sp, 72 + addi.d $sp, $sp, 80 + jirl $r0, $r1, 0x0 + + EPILOGUE diff --git a/kernel/loongarch64/dgemv_t_lsx.S b/kernel/loongarch64/dgemv_t_lsx.S new file mode 100644 index 000000000..76f0d9bdc --- /dev/null +++ b/kernel/loongarch64/dgemv_t_lsx.S @@ -0,0 +1,279 @@ +/******************************************************************************* +Copyright (c) 2024, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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. +*******************************************************************************/ + +#define ASSEMBLER + +#include "common.h" + +/* Param */ +#define M $r4 +#define N $r5 +#define A $r7 +#define LDA $r8 +#define X $r9 +#define INCX $r10 +#define Y $r11 +#define INCY $r6 +#define BUFFER $r16 +#define ALPHA $f0 + +#define YORIG $r18 +#define T0 $r19 +#define T1 $r20 +#define AO3 $r12 +#define AO4 $r13 +#define I $r14 +#define J $r15 +#define AO1 $r23 +#define AO2 $r24 +#define IX $r25 +#define IY $r26 +#define II $r27 +#define T2 $r28 +#define T3 $r29 +#define T4 $r30 + +/* LSX vectors */ +#define U0 $vr11 +#define U1 $vr12 +#define U2 $vr2 +#define U3 $vr3 +#define U4 $vr4 +#define U5 $vr5 +#define U6 $vr6 +#define U7 $vr7 +#define U8 $vr8 +#define U9 $vr9 +#define VALPHA $vr10 + +#define a1 $f3 +#define a2 $f4 +#define a3 $f5 +#define a4 $f6 +#define a5 $f7 +#define a6 $f8 +#define a7 $f9 +#define a8 $f10 + + + PROLOGUE + + LDARG INCY, $sp, 0 + LDARG BUFFER, $sp, 8 + + addi.d $sp, $sp, -80 + + SDARG $r23, $sp, 0 + SDARG $r24, $sp, 8 + SDARG $r25, $sp, 16 + SDARG $r26, $sp, 32 + SDARG $r27, $sp, 40 + SDARG $r28, $sp, 48 + SDARG $r29, $sp, 56 + SDARG $r30, $sp, 64 + ST ALPHA, $sp, 72 + + vldrepl.d VALPHA, $sp, 72 + + slli.d LDA, LDA, BASE_SHIFT + slli.d INCX, INCX, BASE_SHIFT + slli.d INCY, INCY, BASE_SHIFT + + bge $r0, M, .L999 + bge $r0, N, .L999 + + move J, $r0 + move IY, $r0 + + move AO1, A //a_ptr1 + + srai.d T0, N, 2 //n/4 + beq J, T0, .L04 + +.L01: /* j Date: Fri, 23 Feb 2024 18:36:13 +0530 Subject: [PATCH 202/311] Using OpenMP locks with NUM_PARALLEL --- driver/level3/level3_thread.c | 78 ++++++++++++++++++++++++++------- driver/others/blas_server_omp.c | 4 -- 2 files changed, 62 insertions(+), 20 deletions(-) diff --git a/driver/level3/level3_thread.c b/driver/level3/level3_thread.c index 02b60b50d..ff32a74a9 100644 --- a/driver/level3/level3_thread.c +++ b/driver/level3/level3_thread.c @@ -548,13 +548,31 @@ static int gemm_driver(blas_arg_t *args, BLASLONG *range_m, BLASLONG *range_n, IFLOAT *sa, IFLOAT *sb, BLASLONG nthreads_m, BLASLONG nthreads_n) { -#ifndef USE_OPENMP -#ifndef OS_WINDOWS -static pthread_mutex_t level3_lock = PTHREAD_MUTEX_INITIALIZER; +#ifdef USE_OPENMP + static omp_lock_t level3_lock, critical_section_lock; + static volatile BLASLONG init_lock = 0, omp_lock_initialized = 0, + parallel_section_left = MAX_PARALLEL_NUMBER; + + // Lock initialization; Todo : Maybe this part can be moved to blas_init() in blas_server_omp.c + while(omp_lock_initialized == 0) + { + blas_lock(&init_lock); + { + if(omp_lock_initialized == 0) + { + omp_init_lock(&level3_lock); + omp_init_lock(&critical_section_lock); + omp_lock_initialized = 1; + WMB; + } + blas_unlock(&init_lock); + } + } +#elif defined(OS_WINDOWS) + CRITICAL_SECTION level3_lock; + InitializeCriticalSection((PCRITICAL_SECTION)&level3_lock); #else -CRITICAL_SECTION level3_lock; -InitializeCriticalSection((PCRITICAL_SECTION)&level3_lock); -#endif + static pthread_mutex_t level3_lock = PTHREAD_MUTEX_INITIALIZER; #endif blas_arg_t newarg; @@ -597,12 +615,28 @@ InitializeCriticalSection((PCRITICAL_SECTION)&level3_lock); #endif #endif -#ifndef USE_OPENMP -#ifndef OS_WINDOWS -pthread_mutex_lock(&level3_lock); +#ifdef USE_OPENMP + omp_set_lock(&level3_lock); + omp_set_lock(&critical_section_lock); + + parallel_section_left--; + + /* + How OpenMP locks works with NUM_PARALLEL + 1) parallel_section_left = Number of available concurrent executions of OpenBLAS - Number of currently executing OpenBLAS executions + 2) level3_lock is acting like a master lock or barrier which stops OpenBLAS calls when all the parallel_section are currently busy executing other OpenBLAS calls + 3) critical_section_lock is used for updating variables shared between threads executing OpenBLAS calls concurrently and for unlocking of master lock whenever required + 4) Unlock master lock only when we have not already exhausted all the parallel_sections and allow another thread with a OpenBLAS call to enter + */ + if(parallel_section_left != 0) + omp_unset_lock(&level3_lock); + + omp_unset_lock(&critical_section_lock); + +#elif defined(OS_WINDOWS) + EnterCriticalSection((PCRITICAL_SECTION)&level3_lock); #else -EnterCriticalSection((PCRITICAL_SECTION)&level3_lock); -#endif + pthread_mutex_lock(&level3_lock); #endif #ifdef USE_ALLOC_HEAP @@ -730,12 +764,24 @@ EnterCriticalSection((PCRITICAL_SECTION)&level3_lock); free(job); #endif -#ifndef USE_OPENMP -#ifndef OS_WINDOWS - pthread_mutex_unlock(&level3_lock); -#else +#ifdef USE_OPENMP + omp_set_lock(&critical_section_lock); + parallel_section_left++; + + /* + Unlock master lock only when all the parallel_sections are already exhausted and one of the thread has completed its OpenBLAS call + otherwise just increment the parallel_section_left + The master lock is only locked when we have exhausted all the parallel_sections, So only unlock it then and otherwise just increment the count + */ + if(parallel_section_left == 1) + omp_unset_lock(&level3_lock); + + omp_unset_lock(&critical_section_lock); + +#elif defined(OS_WINDOWS) LeaveCriticalSection((PCRITICAL_SECTION)&level3_lock); -#endif +#else + pthread_mutex_unlock(&level3_lock); #endif return 0; diff --git a/driver/others/blas_server_omp.c b/driver/others/blas_server_omp.c index 2e0c0f38c..bcd9c29b5 100644 --- a/driver/others/blas_server_omp.c +++ b/driver/others/blas_server_omp.c @@ -396,7 +396,6 @@ int exec_blas(BLASLONG num, blas_queue_t *queue){ } #endif - while(true) { for(i=0; i < MAX_PARALLEL_NUMBER; i++) { #ifdef HAVE_C11 _Bool inuse = false; @@ -409,9 +408,6 @@ int exec_blas(BLASLONG num, blas_queue_t *queue){ break; } } - if(i != MAX_PARALLEL_NUMBER) - break; - } if (openblas_omp_adaptive_env() != 0) { #pragma omp parallel for num_threads(num) schedule(OMP_SCHED) From 99384933ff1e4ff3959c3fe1acf001885f02e2d4 Mon Sep 17 00:00:00 2001 From: Chip-Kerchner Date: Fri, 1 Mar 2024 07:57:39 -0600 Subject: [PATCH 203/311] Revert "Merge pull request #4532 from austinpagan/cgemm_zgemm_c_code" This reverts commit accea1555159d0928a6aa2db740c042c7e8f0dd3, reversing changes made to b925353006da4fc0ccf7b9122da4f3d5ce6f60f5. --- kernel/power/KERNEL.POWER10 | 21 +- kernel/power/cgemm_kernel_power10.c | 1115 --------------------------- kernel/power/zgemm_kernel_power10.c | 736 ------------------ 3 files changed, 17 insertions(+), 1855 deletions(-) delete mode 100644 kernel/power/cgemm_kernel_power10.c delete mode 100644 kernel/power/zgemm_kernel_power10.c diff --git a/kernel/power/KERNEL.POWER10 b/kernel/power/KERNEL.POWER10 index a1cdc8639..c84cd91d2 100644 --- a/kernel/power/KERNEL.POWER10 +++ b/kernel/power/KERNEL.POWER10 @@ -16,8 +16,13 @@ SBGEMMOTCOPYOBJ = sbgemm_otcopy$(TSUFFIX).$(SUFFIX) STRMMKERNEL = sgemm_kernel_power10.c DTRMMKERNEL = dgemm_kernel_power10.c -CTRMMKERNEL = cgemm_kernel_power10.c -ZTRMMKERNEL = zgemm_kernel_power10.c +ifeq ($(OSNAME), AIX) +CTRMMKERNEL = ctrmm_kernel_8x4_power8.S +ZTRMMKERNEL = ztrmm_kernel_8x2_power8.S +else +CTRMMKERNEL = cgemm_kernel_power10.S +ZTRMMKERNEL = zgemm_kernel_power10.S +endif SGEMMKERNEL = sgemm_kernel_power10.c SGEMMINCOPY = sgemm_ncopy_16_power.c @@ -59,7 +64,11 @@ DGEMM_SMALL_K_B0_TT = dgemm_small_kernel_tt_power10.c DGEMM_SMALL_K_TN = dgemm_small_kernel_tn_power10.c DGEMM_SMALL_K_B0_TN = dgemm_small_kernel_tn_power10.c -CGEMMKERNEL = cgemm_kernel_power10.c +ifeq ($(OSNAME), AIX) +CGEMMKERNEL = cgemm_kernel_8x4_power8.S +else +CGEMMKERNEL = cgemm_kernel_power10.S +endif #CGEMMKERNEL = cgemm_kernel_8x4_power8.S CGEMMINCOPY = ../generic/zgemm_ncopy_8.c ifeq ($(OSNAME), AIX) @@ -74,7 +83,11 @@ CGEMMOTCOPYOBJ = cgemm_otcopy$(TSUFFIX).$(SUFFIX) CGEMMINCOPYOBJ = cgemm_incopy$(TSUFFIX).$(SUFFIX) CGEMMITCOPYOBJ = cgemm_itcopy$(TSUFFIX).$(SUFFIX) -ZGEMMKERNEL = zgemm_kernel_power10.c +ifeq ($(OSNAME), AIX) +ZGEMMKERNEL = zgemm_kernel_8x2_power8.S +else +ZGEMMKERNEL = zgemm_kernel_power10.S +endif ZGEMMONCOPY = ../generic/zgemm_ncopy_2.c ZGEMMOTCOPY = ../generic/zgemm_tcopy_2.c ZGEMMINCOPY = ../generic/zgemm_ncopy_8.c diff --git a/kernel/power/cgemm_kernel_power10.c b/kernel/power/cgemm_kernel_power10.c deleted file mode 100644 index 233768cef..000000000 --- a/kernel/power/cgemm_kernel_power10.c +++ /dev/null @@ -1,1115 +0,0 @@ -/********************************************************************************* -Copyright (c) 2020, The OpenBLAS Project -All rights reserved. -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are -met: -1. Redistributions of source code must retain the above copyright -notice, this list of conditions and the following disclaimer. -2. 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. -3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" -#include - -typedef __vector unsigned char vec_t; -typedef FLOAT v4sf_t __attribute__ ((vector_size (16))); -typedef FLOAT v2sf_t __attribute__ ((vector_size (8))); - -#define SET_ACC_ZERO() \ - __builtin_mma_xxsetaccz (&acc0); \ - __builtin_mma_xxsetaccz (&acc1); \ - __builtin_mma_xxsetaccz (&acc2); \ - __builtin_mma_xxsetaccz (&acc3); \ - __builtin_mma_xxsetaccz (&acc4); \ - __builtin_mma_xxsetaccz (&acc5); \ - __builtin_mma_xxsetaccz (&acc6); \ - __builtin_mma_xxsetaccz (&acc7); - -#if (defined(NN) || defined(NT) || defined(TN) || defined(TT)) -#define COMP_MUL(_real, _arbr, _aibi, _imag, _arbi, _aibr) { _real = _arbr - _aibi; _imag = _arbi + _aibr; } -#define COMP_MAC(_real, _arbr, _aibi, _imag, _arbi, _aibr) { _real += _arbr - _aibi; _imag += _arbi + _aibr; } -#endif - -#if (defined(NR) || defined(NC) || defined(TR) || defined(TC)) -#define COMP_MUL(_real, _arbr, _aibi, _imag, _arbi, _aibr) { _real = _arbr + _aibi; _imag = -_arbi + _aibr; } -#define COMP_MAC(_real, _arbr, _aibi, _imag, _arbi, _aibr) { _real += _arbr + _aibi; _imag += -_arbi + _aibr; } -#endif - -#if (defined(RN) || defined(RT) || defined(CN) || defined(CT)) -#define COMP_MUL(_real, _arbr, _aibi, _imag, _arbi, _aibr) { _real = _arbr + _aibi; _imag = _arbi - _aibr; } -#define COMP_MAC(_real, _arbr, _aibi, _imag, _arbi, _aibr) { _real += _arbr + _aibi; _imag += _arbi - _aibr; } -#endif - -#if (defined(RR) || defined(RC) || defined(CR) || defined(CC)) -#define COMP_MUL(_real, _arbr, _aibi, _imag, _arbi, _aibr) { _real = _arbr - _aibi; _imag = -_arbi - _aibr; } -#define COMP_MAC(_real, _arbr, _aibi, _imag, _arbi, _aibr) { _real += _arbr - _aibi; _imag += -_arbi - _aibr; } -#endif - -#if defined (TRMMKERNEL) -#define A_OP = -#else -#define A_OP += -#endif - -#define BUILTIN_MMA_DISASSEMBLE_ACC_8 \ - __builtin_mma_disassemble_acc ((void *)result, &acc0); \ - __builtin_mma_disassemble_acc ((void *)&result[ 4], &acc1); \ - __builtin_mma_disassemble_acc ((void *)&result[ 8], &acc2); \ - __builtin_mma_disassemble_acc ((void *)&result[12], &acc3); \ - __builtin_mma_disassemble_acc ((void *)&result[16], &acc4); \ - __builtin_mma_disassemble_acc ((void *)&result[20], &acc5); \ - __builtin_mma_disassemble_acc ((void *)&result[24], &acc6); \ - __builtin_mma_disassemble_acc ((void *)&result[28], &acc7); - -#define COMP_MUL_1 \ - COMP_MUL(tr[0], res[ 0], res[ 5], ti[0], res[ 1], res[ 4]) - -#define COMP_MAC_1(_offset) { \ - FLOAT *_ro = &res[_offset]; \ - COMP_MAC(tr[0], _ro[ 0], _ro[ 5], ti[0], _ro[ 1], _ro[ 4]) \ -} - -#define COMP_MUL_2A \ - COMP_MUL(tr[0], res[ 0], res[ 5], ti[0], res[ 1], res[ 4]) \ - COMP_MUL(tr[1], res[ 2], res[ 7], ti[1], res[ 3], res[ 6]) - -#define COMP_MAC_2A(_offset) { \ - FLOAT *_ro = &res[_offset]; \ - COMP_MAC(tr[0], _ro[ 0], _ro[ 5], ti[0], _ro[ 1], _ro[ 4]) \ - COMP_MAC(tr[1], _ro[ 2], _ro[ 7], ti[1], _ro[ 3], _ro[ 6]) \ -} - -#define COMP_MUL_2B \ - COMP_MUL(tr[0], res[ 0], res[ 5], ti[0], res[ 1], res[ 4]) \ - COMP_MUL(tr[1], res[ 8], res[13], ti[1], res[ 9], res[12]) - -#define COMP_MAC_2B(_offset) { \ - FLOAT *_ro = &res[_offset]; \ - COMP_MAC(tr[0], _ro[ 0], _ro[ 5], ti[0], _ro[ 1], _ro[ 4]) \ - COMP_MAC(tr[1], _ro[ 8], _ro[13], ti[1], _ro[ 9], _ro[12]) \ -} - -#define COMP_MUL_4A(_offset) { \ - FLOAT *_ro = &res[_offset]; \ - COMP_MUL(tr[0], _ro[ 0], _ro[ 5], ti[0], _ro[ 1], _ro[ 4]) \ - COMP_MUL(tr[1], _ro[ 8], _ro[13], ti[1], _ro[ 9], _ro[12]) \ - COMP_MUL(tr[2], _ro[16], _ro[21], ti[2], _ro[17], _ro[20]) \ - COMP_MUL(tr[3], _ro[24], _ro[29], ti[3], _ro[25], _ro[28]) \ -} - -#define COMP_MAC_4A(_offset) { \ - FLOAT *_ro = &res[_offset]; \ - COMP_MAC(tr[0], _ro[ 0], _ro[ 5], ti[0], _ro[ 1], _ro[ 4]) \ - COMP_MAC(tr[1], _ro[ 8], _ro[13], ti[1], _ro[ 9], _ro[12]) \ - COMP_MAC(tr[2], _ro[16], _ro[21], ti[2], _ro[17], _ro[20]) \ - COMP_MAC(tr[3], _ro[24], _ro[29], ti[3], _ro[25], _ro[28]) \ -} - -#define COMP_MUL_4B(_offset) { \ - FLOAT *_ro = &res[_offset]; \ - COMP_MUL(tr[0], _ro[ 0], _ro[ 5], ti[0], _ro[ 1], _ro[ 4]) \ - COMP_MUL(tr[1], _ro[ 8], _ro[13], ti[1], _ro[ 9], _ro[12]) \ - COMP_MUL(tr[2], _ro[ 2], _ro[ 7], ti[2], _ro[ 3], _ro[ 6]) \ - COMP_MUL(tr[3], _ro[10], _ro[15], ti[3], _ro[11], _ro[14]) \ -} - -#define COMP_MAC_4B(_offset) { \ - FLOAT *_ro = &res[_offset]; \ - COMP_MAC(tr[0], _ro[ 0], _ro[ 5], ti[0], _ro[ 1], _ro[ 4]) \ - COMP_MAC(tr[1], _ro[ 8], _ro[13], ti[1], _ro[ 9], _ro[12]) \ - COMP_MAC(tr[2], _ro[ 2], _ro[ 7], ti[2], _ro[ 3], _ro[ 6]) \ - COMP_MAC(tr[3], _ro[10], _ro[15], ti[3], _ro[11], _ro[14]) \ -} - - -#define SAVE_ACC_COMPLEX_11 \ - BUILTIN_MMA_DISASSEMBLE_ACC_8 \ - COMP_MUL_1 \ - COMP_MAC_1(16) \ - COMP_MAC_1(32) \ - COMP_MAC_1(48) \ - COMP_MAC_1(64) \ - COMP_MAC_1(80) \ - COMP_MAC_1(96) \ - COMP_MAC_1(112) \ - CO[0] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ - CO[1] A_OP ti[0] * alpha_r + tr[0] * alpha_i; - -#define SAVE_ACC_COMPLEX_12 \ - BUILTIN_MMA_DISASSEMBLE_ACC_8 \ - COMP_MUL_2A \ - COMP_MAC_2A(16) \ - COMP_MAC_2A(32) \ - COMP_MAC_2A(48) \ - COMP_MAC_2A(64) \ - COMP_MAC_2A(80) \ - COMP_MAC_2A(96) \ - COMP_MAC_2A(112) \ - CO[0] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ - CO[1] A_OP ti[0] * alpha_r + tr[0] * alpha_i; \ - CO[2*ldc+0] A_OP tr[1] * alpha_r - ti[1] * alpha_i; \ - CO[2*ldc+1] A_OP ti[1] * alpha_r + tr[1] * alpha_i; - -#define SAVE_ACC_COMPLEX_21_1 \ - BUILTIN_MMA_DISASSEMBLE_ACC_8 \ - COMP_MUL_2B \ - COMP_MAC_2B(16) \ - COMP_MAC_2B(32) \ - COMP_MAC_2B(48) \ - COMP_MAC_2B(64) \ - COMP_MAC_2B(80) \ - COMP_MAC_2B(96) \ - COMP_MAC_2B(112) \ - CO[0] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ - CO[1] A_OP ti[0] * alpha_r + tr[0] * alpha_i; \ - CO[2] A_OP tr[1] * alpha_r - ti[1] * alpha_i; \ - CO[3] A_OP ti[1] * alpha_r + tr[1] * alpha_i; - -#define SAVE_ACC_COMPLEX_21_2 \ - BUILTIN_MMA_DISASSEMBLE_ACC_8 \ - COMP_MUL_4A(0) \ - COMP_MAC_4A(32) \ - COMP_MAC_4A(64) \ - COMP_MAC_4A(96) \ - CO[0] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ - CO[1] A_OP ti[0] * alpha_r + tr[0] * alpha_i; \ - CO[2] A_OP tr[1] * alpha_r - ti[1] * alpha_i; \ - CO[3] A_OP ti[1] * alpha_r + tr[1] * alpha_i; \ - CO[4] A_OP tr[2] * alpha_r - ti[2] * alpha_i; \ - CO[5] A_OP ti[2] * alpha_r + tr[2] * alpha_i; \ - CO[6] A_OP tr[3] * alpha_r - ti[3] * alpha_i; \ - CO[7] A_OP ti[3] * alpha_r + tr[3] * alpha_i; - -#define SAVE_ACC_COMPLEX_21_4 \ - BUILTIN_MMA_DISASSEMBLE_ACC_8 \ - COMP_MUL_4A(0) \ - COMP_MAC_4A(64) \ - CO[ 0] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ - CO[ 1] A_OP ti[0] * alpha_r + tr[0] * alpha_i; \ - CO[ 2] A_OP tr[1] * alpha_r - ti[1] * alpha_i; \ - CO[ 3] A_OP ti[1] * alpha_r + tr[1] * alpha_i; \ - CO[ 4] A_OP tr[2] * alpha_r - ti[2] * alpha_i; \ - CO[ 5] A_OP ti[2] * alpha_r + tr[2] * alpha_i; \ - CO[ 6] A_OP tr[3] * alpha_r - ti[3] * alpha_i; \ - CO[ 7] A_OP ti[3] * alpha_r + tr[3] * alpha_i; \ - COMP_MUL_4A(32) \ - COMP_MAC_4A(96) \ - CO[ 8] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ - CO[ 9] A_OP ti[0] * alpha_r + tr[0] * alpha_i; \ - CO[10] A_OP tr[1] * alpha_r - ti[1] * alpha_i; \ - CO[11] A_OP ti[1] * alpha_r + tr[1] * alpha_i; \ - CO[12] A_OP tr[2] * alpha_r - ti[2] * alpha_i; \ - CO[13] A_OP ti[2] * alpha_r + tr[2] * alpha_i; \ - CO[14] A_OP tr[3] * alpha_r - ti[3] * alpha_i; \ - CO[15] A_OP ti[3] * alpha_r + tr[3] * alpha_i; - -#define SAVE_ACC_COMPLEX_22_4 \ - BUILTIN_MMA_DISASSEMBLE_ACC_8 \ - COMP_MUL_4B(0) \ - CO[ 0] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ - CO[ 1] A_OP ti[0] * alpha_r + tr[0] * alpha_i; \ - CO[ 2] A_OP tr[1] * alpha_r - ti[1] * alpha_i; \ - CO[ 3] A_OP ti[1] * alpha_r + tr[1] * alpha_i; \ - CO[2*ldc+ 0] A_OP tr[2] * alpha_r - ti[2] * alpha_i; \ - CO[2*ldc+ 1] A_OP ti[2] * alpha_r + tr[2] * alpha_i; \ - CO[2*ldc+ 2] A_OP tr[3] * alpha_r - ti[3] * alpha_i; \ - CO[2*ldc+ 3] A_OP ti[3] * alpha_r + tr[3] * alpha_i; \ - COMP_MUL_4B(16) \ - CO[ 4] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ - CO[ 5] A_OP ti[0] * alpha_r + tr[0] * alpha_i; \ - CO[ 6] A_OP tr[1] * alpha_r - ti[1] * alpha_i; \ - CO[ 7] A_OP ti[1] * alpha_r + tr[1] * alpha_i; \ - CO[2*ldc+ 4] A_OP tr[2] * alpha_r - ti[2] * alpha_i; \ - CO[2*ldc+ 5] A_OP ti[2] * alpha_r + tr[2] * alpha_i; \ - CO[2*ldc+ 6] A_OP tr[3] * alpha_r - ti[3] * alpha_i; \ - CO[2*ldc+ 7] A_OP ti[3] * alpha_r + tr[3] * alpha_i; \ - COMP_MUL_4B(32) \ - CO[ 8] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ - CO[ 9] A_OP ti[0] * alpha_r + tr[0] * alpha_i; \ - CO[10] A_OP tr[1] * alpha_r - ti[1] * alpha_i; \ - CO[11] A_OP ti[1] * alpha_r + tr[1] * alpha_i; \ - CO[2*ldc+ 8] A_OP tr[2] * alpha_r - ti[2] * alpha_i; \ - CO[2*ldc+ 9] A_OP ti[2] * alpha_r + tr[2] * alpha_i; \ - CO[2*ldc+10] A_OP tr[3] * alpha_r - ti[3] * alpha_i; \ - CO[2*ldc+11] A_OP ti[3] * alpha_r + tr[3] * alpha_i; \ - COMP_MUL_4B(48) \ - CO[12] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ - CO[13] A_OP ti[0] * alpha_r + tr[0] * alpha_i; \ - CO[14] A_OP tr[1] * alpha_r - ti[1] * alpha_i; \ - CO[15] A_OP ti[1] * alpha_r + tr[1] * alpha_i; \ - CO[2*ldc+12] A_OP tr[2] * alpha_r - ti[2] * alpha_i; \ - CO[2*ldc+13] A_OP ti[2] * alpha_r + tr[2] * alpha_i; \ - CO[2*ldc+14] A_OP tr[3] * alpha_r - ti[3] * alpha_i; \ - CO[2*ldc+15] A_OP ti[3] * alpha_r + tr[3] * alpha_i; - -#define SAVE_ACC_COMPLEX_22_2 \ - BUILTIN_MMA_DISASSEMBLE_ACC_8 \ - COMP_MUL_4B(0) \ - CO[0] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ - CO[1] A_OP ti[0] * alpha_r + tr[0] * alpha_i; \ - CO[2] A_OP tr[1] * alpha_r - ti[1] * alpha_i; \ - CO[3] A_OP ti[1] * alpha_r + tr[1] * alpha_i; \ - CO[2*ldc+0] A_OP tr[2] * alpha_r - ti[2] * alpha_i; \ - CO[2*ldc+1] A_OP ti[2] * alpha_r + tr[2] * alpha_i; \ - CO[2*ldc+2] A_OP tr[3] * alpha_r - ti[3] * alpha_i; \ - CO[2*ldc+3] A_OP ti[3] * alpha_r + tr[3] * alpha_i; \ - COMP_MUL_4B(16) \ - CO[4] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ - CO[5] A_OP ti[0] * alpha_r + tr[0] * alpha_i; \ - CO[6] A_OP tr[1] * alpha_r - ti[1] * alpha_i; \ - CO[7] A_OP ti[1] * alpha_r + tr[1] * alpha_i; \ - CO[2*ldc+4] A_OP tr[2] * alpha_r - ti[2] * alpha_i; \ - CO[2*ldc+5] A_OP ti[2] * alpha_r + tr[2] * alpha_i; \ - CO[2*ldc+6] A_OP tr[3] * alpha_r - ti[3] * alpha_i; \ - CO[2*ldc+7] A_OP ti[3] * alpha_r + tr[3] * alpha_i; - -#define SAVE_ACC_COMPLEX_22_1 \ - BUILTIN_MMA_DISASSEMBLE_ACC_8 \ - COMP_MUL_4B(0) \ - CO[0] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ - CO[1] A_OP ti[0] * alpha_r + tr[0] * alpha_i; \ - CO[2] A_OP tr[1] * alpha_r - ti[1] * alpha_i; \ - CO[3] A_OP ti[1] * alpha_r + tr[1] * alpha_i; \ - CO[2*ldc+0] A_OP tr[2] * alpha_r - ti[2] * alpha_i; \ - CO[2*ldc+1] A_OP ti[2] * alpha_r + tr[2] * alpha_i; \ - CO[2*ldc+2] A_OP tr[3] * alpha_r - ti[3] * alpha_i; \ - CO[2*ldc+3] A_OP ti[3] * alpha_r + tr[3] * alpha_i; - -#define SAVE_ACC_COMPLEX_24_ALL \ - __builtin_mma_disassemble_acc ((void *)result, &acc0); \ - __builtin_mma_disassemble_acc ((void *)(&result[4]), &acc4); \ - __builtin_mma_disassemble_acc ((void *)(&result[8]), &acc1); \ - __builtin_mma_disassemble_acc ((void *)(&result[12]), &acc5); \ - __builtin_mma_disassemble_acc ((void *)(&result[16]), &acc2); \ - __builtin_mma_disassemble_acc ((void *)(&result[20]), &acc6); \ - __builtin_mma_disassemble_acc ((void *)(&result[24]), &acc3); \ - __builtin_mma_disassemble_acc ((void *)(&result[28]), &acc7); \ - COMP_MUL(tr[ 0], res[ 0], res[ 5], ti[ 0], res[ 1], res[ 4]) \ - COMP_MUL(tr[ 1], res[ 8], res[ 13], ti[ 1], res[ 9], res[ 12]) \ - COMP_MUL(tr[ 2], res[ 2], res[ 7], ti[ 2], res[ 3], res[ 6]) \ - COMP_MUL(tr[ 3], res[ 10], res[ 15], ti[ 3], res[ 11], res[ 14]) \ - COMP_MUL(tr[ 4], res[ 16], res[ 21], ti[ 4], res[ 17], res[ 20]) \ - COMP_MUL(tr[ 5], res[ 24], res[ 29], ti[ 5], res[ 25], res[ 28]) \ - COMP_MUL(tr[ 6], res[ 18], res[ 23], ti[ 6], res[ 19], res[ 22]) \ - COMP_MUL(tr[ 7], res[ 26], res[ 31], ti[ 7], res[ 27], res[ 30]) \ - COMP_MUL(tr[ 8], res[ 32], res[ 37], ti[ 8], res[ 33], res[ 36]) \ - COMP_MUL(tr[ 9], res[ 40], res[ 45], ti[ 9], res[ 41], res[ 44]) \ - COMP_MUL(tr[10], res[ 34], res[ 39], ti[10], res[ 35], res[ 38]) \ - COMP_MUL(tr[11], res[ 42], res[ 47], ti[11], res[ 43], res[ 46]) \ - COMP_MUL(tr[12], res[ 48], res[ 53], ti[12], res[ 49], res[ 52]) \ - COMP_MUL(tr[13], res[ 56], res[ 61], ti[13], res[ 57], res[ 60]) \ - COMP_MUL(tr[14], res[ 50], res[ 55], ti[14], res[ 51], res[ 54]) \ - COMP_MUL(tr[15], res[ 58], res[ 63], ti[15], res[ 59], res[ 62]) \ - COMP_MUL(tr[16], res[ 64], res[ 69], ti[16], res[ 65], res[ 68]) \ - COMP_MUL(tr[17], res[ 72], res[ 77], ti[17], res[ 73], res[ 76]) \ - COMP_MUL(tr[18], res[ 66], res[ 71], ti[18], res[ 67], res[ 70]) \ - COMP_MUL(tr[19], res[ 74], res[ 79], ti[19], res[ 75], res[ 78]) \ - COMP_MUL(tr[20], res[ 80], res[ 85], ti[20], res[ 81], res[ 84]) \ - COMP_MUL(tr[21], res[ 88], res[ 93], ti[21], res[ 89], res[ 92]) \ - COMP_MUL(tr[22], res[ 82], res[ 87], ti[22], res[ 83], res[ 86]) \ - COMP_MUL(tr[23], res[ 90], res[ 95], ti[23], res[ 91], res[ 94]) \ - COMP_MUL(tr[24], res[ 96], res[101], ti[24], res[ 97], res[100]) \ - COMP_MUL(tr[25], res[104], res[109], ti[25], res[105], res[108]) \ - COMP_MUL(tr[26], res[ 98], res[103], ti[26], res[ 99], res[102]) \ - COMP_MUL(tr[27], res[106], res[111], ti[27], res[107], res[110]) \ - COMP_MUL(tr[28], res[112], res[117], ti[28], res[113], res[116]) \ - COMP_MUL(tr[29], res[120], res[125], ti[29], res[121], res[124]) \ - COMP_MUL(tr[30], res[114], res[119], ti[30], res[115], res[118]) \ - COMP_MUL(tr[31], res[122], res[127], ti[31], res[123], res[126]) \ - CO[ 0] A_OP tr[ 0] * alpha_r - ti[ 0] * alpha_i; \ - CO[ 1] A_OP ti[ 0] * alpha_r + tr[ 0] * alpha_i; \ - CO[ 2] A_OP tr[ 1] * alpha_r - ti[ 1] * alpha_i; \ - CO[ 3] A_OP ti[ 1] * alpha_r + tr[ 1] * alpha_i; \ - CO[2*ldc+ 0] A_OP tr[ 2] * alpha_r - ti[ 2] * alpha_i; \ - CO[2*ldc+ 1] A_OP ti[ 2] * alpha_r + tr[ 2] * alpha_i; \ - CO[2*ldc+ 2] A_OP tr[ 3] * alpha_r - ti[ 3] * alpha_i; \ - CO[2*ldc+ 3] A_OP ti[ 3] * alpha_r + tr[ 3] * alpha_i; \ - CO[4*ldc+ 0] A_OP tr[ 4] * alpha_r - ti[ 4] * alpha_i; \ - CO[4*ldc+ 1] A_OP ti[ 4] * alpha_r + tr[ 4] * alpha_i; \ - CO[4*ldc+ 2] A_OP tr[ 5] * alpha_r - ti[ 5] * alpha_i; \ - CO[4*ldc+ 3] A_OP ti[ 5] * alpha_r + tr[ 5] * alpha_i; \ - CO[6*ldc+ 0] A_OP tr[ 6] * alpha_r - ti[ 6] * alpha_i; \ - CO[6*ldc+ 1] A_OP ti[ 6] * alpha_r + tr[ 6] * alpha_i; \ - CO[6*ldc+ 2] A_OP tr[ 7] * alpha_r - ti[ 7] * alpha_i; \ - CO[6*ldc+ 3] A_OP ti[ 7] * alpha_r + tr[ 7] * alpha_i; \ - CO[ 4] A_OP tr[ 8] * alpha_r - ti[ 8] * alpha_i; \ - CO[ 5] A_OP ti[ 8] * alpha_r + tr[ 8] * alpha_i; \ - CO[ 6] A_OP tr[ 9] * alpha_r - ti[ 9] * alpha_i; \ - CO[ 7] A_OP ti[ 9] * alpha_r + tr[ 9] * alpha_i; \ - CO[2*ldc+ 4] A_OP tr[10] * alpha_r - ti[10] * alpha_i; \ - CO[2*ldc+ 5] A_OP ti[10] * alpha_r + tr[10] * alpha_i; \ - CO[2*ldc+ 6] A_OP tr[11] * alpha_r - ti[11] * alpha_i; \ - CO[2*ldc+ 7] A_OP ti[11] * alpha_r + tr[11] * alpha_i; \ - CO[4*ldc+ 4] A_OP tr[12] * alpha_r - ti[12] * alpha_i; \ - CO[4*ldc+ 5] A_OP ti[12] * alpha_r + tr[12] * alpha_i; \ - CO[4*ldc+ 6] A_OP tr[13] * alpha_r - ti[13] * alpha_i; \ - CO[4*ldc+ 7] A_OP ti[13] * alpha_r + tr[13] * alpha_i; \ - CO[6*ldc+ 4] A_OP tr[14] * alpha_r - ti[14] * alpha_i; \ - CO[6*ldc+ 5] A_OP ti[14] * alpha_r + tr[14] * alpha_i; \ - CO[6*ldc+ 6] A_OP tr[15] * alpha_r - ti[15] * alpha_i; \ - CO[6*ldc+ 7] A_OP ti[15] * alpha_r + tr[15] * alpha_i; \ - CO[ 8] A_OP tr[16] * alpha_r - ti[16] * alpha_i; \ - CO[ 9] A_OP ti[16] * alpha_r + tr[16] * alpha_i; \ - CO[ 10] A_OP tr[17] * alpha_r - ti[17] * alpha_i; \ - CO[ 11] A_OP ti[17] * alpha_r + tr[17] * alpha_i; \ - CO[2*ldc+ 8] A_OP tr[18] * alpha_r - ti[18] * alpha_i; \ - CO[2*ldc+ 9] A_OP ti[18] * alpha_r + tr[18] * alpha_i; \ - CO[2*ldc+10] A_OP tr[19] * alpha_r - ti[19] * alpha_i; \ - CO[2*ldc+11] A_OP ti[19] * alpha_r + tr[19] * alpha_i; \ - CO[4*ldc+ 8] A_OP tr[20] * alpha_r - ti[20] * alpha_i; \ - CO[4*ldc+ 9] A_OP ti[20] * alpha_r + tr[20] * alpha_i; \ - CO[4*ldc+10] A_OP tr[21] * alpha_r - ti[21] * alpha_i; \ - CO[4*ldc+11] A_OP ti[21] * alpha_r + tr[21] * alpha_i; \ - CO[6*ldc+ 8] A_OP tr[22] * alpha_r - ti[22] * alpha_i; \ - CO[6*ldc+ 9] A_OP ti[22] * alpha_r + tr[22] * alpha_i; \ - CO[6*ldc+10] A_OP tr[23] * alpha_r - ti[23] * alpha_i; \ - CO[6*ldc+11] A_OP ti[23] * alpha_r + tr[23] * alpha_i; \ - CO[ 12] A_OP tr[24] * alpha_r - ti[24] * alpha_i; \ - CO[ 13] A_OP ti[24] * alpha_r + tr[24] * alpha_i; \ - CO[ 14] A_OP tr[25] * alpha_r - ti[25] * alpha_i; \ - CO[ 15] A_OP ti[25] * alpha_r + tr[25] * alpha_i; \ - CO[2*ldc+12] A_OP tr[26] * alpha_r - ti[26] * alpha_i; \ - CO[2*ldc+13] A_OP ti[26] * alpha_r + tr[26] * alpha_i; \ - CO[2*ldc+14] A_OP tr[27] * alpha_r - ti[27] * alpha_i; \ - CO[2*ldc+15] A_OP ti[27] * alpha_r + tr[27] * alpha_i; \ - CO[4*ldc+12] A_OP tr[28] * alpha_r - ti[28] * alpha_i; \ - CO[4*ldc+13] A_OP ti[28] * alpha_r + tr[28] * alpha_i; \ - CO[4*ldc+14] A_OP tr[29] * alpha_r - ti[29] * alpha_i; \ - CO[4*ldc+15] A_OP ti[29] * alpha_r + tr[29] * alpha_i; \ - CO[6*ldc+12] A_OP tr[30] * alpha_r - ti[30] * alpha_i; \ - CO[6*ldc+13] A_OP ti[30] * alpha_r + tr[30] * alpha_i; \ - CO[6*ldc+14] A_OP tr[31] * alpha_r - ti[31] * alpha_i; \ - CO[6*ldc+15] A_OP ti[31] * alpha_r + tr[31] * alpha_i; - -#define SAVE_ACC_COMPLEX_24(ACC1, ACC2, CI) \ - __builtin_mma_disassemble_acc ((void *)result, ACC1); \ - __builtin_mma_disassemble_acc ((void *)(&result[4]), ACC2); \ - COMP_MUL(tr[0], res[0], res[5], ti[0], res[1], res[4]) \ - COMP_MUL(tr[1], res[8], res[13], ti[1], res[9], res[12]) \ - COMP_MUL(tr[2], res[2], res[7], ti[2], res[3], res[6]) \ - COMP_MUL(tr[3], res[10], res[15], ti[3], res[11], res[14]) \ - COMP_MUL(tr[4], res[16], res[21], ti[4], res[17], res[20]) \ - COMP_MUL(tr[5], res[24], res[29], ti[5], res[25], res[28]) \ - COMP_MUL(tr[6], res[18], res[23], ti[6], res[19], res[22]) \ - COMP_MUL(tr[7], res[26], res[31], ti[7], res[27], res[30]) \ - CO[CI+0] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ - CO[CI+1] A_OP ti[0] * alpha_r + tr[0] * alpha_i; \ - CO[CI+2] A_OP tr[1] * alpha_r - ti[1] * alpha_i; \ - CO[CI+3] A_OP ti[1] * alpha_r + tr[1] * alpha_i; \ - CO[CI+2*ldc+0] A_OP tr[2] * alpha_r - ti[2] * alpha_i; \ - CO[CI+2*ldc+1] A_OP ti[2] * alpha_r + tr[2] * alpha_i; \ - CO[CI+2*ldc+2] A_OP tr[3] * alpha_r - ti[3] * alpha_i; \ - CO[CI+2*ldc+3] A_OP ti[3] * alpha_r + tr[3] * alpha_i; \ - CO[CI+4*ldc+0] A_OP tr[4] * alpha_r - ti[4] * alpha_i; \ - CO[CI+4*ldc+1] A_OP ti[4] * alpha_r + tr[4] * alpha_i; \ - CO[CI+4*ldc+2] A_OP tr[5] * alpha_r - ti[5] * alpha_i; \ - CO[CI+4*ldc+3] A_OP ti[5] * alpha_r + tr[5] * alpha_i; \ - CO[CI+6*ldc+0] A_OP tr[6] * alpha_r - ti[6] * alpha_i; \ - CO[CI+6*ldc+1] A_OP ti[6] * alpha_r + tr[6] * alpha_i; \ - CO[CI+6*ldc+2] A_OP tr[7] * alpha_r - ti[7] * alpha_i; \ - CO[CI+6*ldc+3] A_OP ti[7] * alpha_r + tr[7] * alpha_i; - -#define SAVE_ACC_COMPLEX_14 \ - BUILTIN_MMA_DISASSEMBLE_ACC_8 \ - COMP_MUL(tr[0], res[ 0], res[ 5], ti[0], res[ 1], res[ 4]) \ - COMP_MUL(tr[1], res[ 2], res[ 7], ti[1], res[ 3], res[ 6]) \ - COMP_MUL(tr[2], res[ 16], res[ 21], ti[2], res[ 17], res[ 20]) \ - COMP_MUL(tr[3], res[ 18], res[ 23], ti[3], res[ 19], res[ 22]) \ - COMP_MAC(tr[0], res[ 32], res[ 37], ti[0], res[ 33], res[ 36]) \ - COMP_MAC(tr[1], res[ 34], res[ 39], ti[1], res[ 35], res[ 38]) \ - COMP_MAC(tr[2], res[ 48], res[ 53], ti[2], res[ 49], res[ 52]) \ - COMP_MAC(tr[3], res[ 50], res[ 55], ti[3], res[ 51], res[ 54]) \ - COMP_MAC(tr[0], res[ 64], res[ 69], ti[0], res[ 65], res[ 68]) \ - COMP_MAC(tr[1], res[ 66], res[ 71], ti[1], res[ 67], res[ 70]) \ - COMP_MAC(tr[2], res[ 80], res[ 85], ti[2], res[ 81], res[ 84]) \ - COMP_MAC(tr[3], res[ 82], res[ 87], ti[3], res[ 83], res[ 86]) \ - COMP_MAC(tr[0], res[ 96], res[101], ti[0], res[ 97], res[100]) \ - COMP_MAC(tr[1], res[ 98], res[103], ti[1], res[ 99], res[102]) \ - COMP_MAC(tr[2], res[112], res[117], ti[2], res[113], res[116]) \ - COMP_MAC(tr[3], res[114], res[119], ti[3], res[115], res[118]) \ - CO[0] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ - CO[1] A_OP ti[0] * alpha_r + tr[0] * alpha_i; \ - CO[2*ldc+0] A_OP tr[1] * alpha_r - ti[1] * alpha_i; \ - CO[2*ldc+1] A_OP ti[1] * alpha_r + tr[1] * alpha_i; \ - CO[4*ldc+0] A_OP tr[2] * alpha_r - ti[2] * alpha_i; \ - CO[4*ldc+1] A_OP ti[2] * alpha_r + tr[2] * alpha_i; \ - CO[6*ldc+0] A_OP tr[3] * alpha_r - ti[3] * alpha_i; \ - CO[6*ldc+1] A_OP ti[3] * alpha_r + tr[3] * alpha_i; - -#define PREFETCH1(x, y) asm volatile ("dcbt %0, %1" : : "r" (x), "b" (y) : "memory"); - -#if (defined(LEFT) && !defined(TRANSA)) || (!defined(LEFT) && defined(TRANSA)) -#define REFRESH_TEMP_BK(x, y) \ - temp = k - off; -#elif defined(LEFT) -#define REFRESH_TEMP_BK(x, y) \ - temp = off + x; -#else -#define REFRESH_TEMP_BK(x, y) \ - temp = off + y; -#endif -#if (defined(LEFT) && defined(TRANSA)) || (!defined(LEFT) && !defined(TRANSA)) -#define REFRESH_POINTERS(x, y) \ - BO = B; \ - REFRESH_TEMP_BK(x, y) -#else -#define REFRESH_POINTERS(x, y) \ - AO += off * (2*x); \ - BO = B + off * (2*y); \ - REFRESH_TEMP_BK(x, y) -#endif - -#ifdef LEFT -#define REFRESH_OFF(x) \ - off += x; -#else -#define REFRESH_OFF(x) -#endif - -#ifdef LEFT -#define UPDATE_TEMP(x, y) \ - temp -= x; -#else -#define UPDATE_TEMP(x, y) \ - temp -= y; -#endif - -#if (defined(LEFT) && defined(TRANSA)) || (!defined(LEFT) && !defined(TRANSA)) -#define REFRESH_TMP_AFTER_SAVE(x, y) \ - temp = k - off; \ - UPDATE_TEMP(x, y) \ - AO += temp * (2*x); \ - BO += temp * (2*y); -#else -#define REFRESH_TMP_AFTER_SAVE(x, y) -#endif - -#define REFRESH_AFTER_SAVE(x,y) \ - REFRESH_TMP_AFTER_SAVE(x, y) \ - REFRESH_OFF(x) -/************************************************************************************* -* GEMM Kernel -*************************************************************************************/ -int -#ifdef TRMMKERNEL -CNAME (BLASLONG m, BLASLONG n, BLASLONG k, FLOAT alpha_r, FLOAT alpha_i, - FLOAT * A, FLOAT * B, FLOAT * C, BLASLONG ldc, BLASLONG offset) -#else -CNAME (BLASLONG m, BLASLONG n, BLASLONG k, FLOAT alpha_r, FLOAT alpha_i, - FLOAT * A, FLOAT * B, FLOAT * C, BLASLONG ldc) -#endif -{ - BLASLONG i1, i, l, temp; - FLOAT *AO, *BO, *CO; -#if defined(TRMMKERNEL) - BLASLONG off; -#endif -#if defined(TRMMKERNEL) && !defined(LEFT) - off = -offset; -#endif - - __vector_quad acc0, acc1, acc2, acc3, acc4, acc5, acc6, acc7; - - v4sf_t result[32]; - FLOAT *res, tr[64], ti[64]; - res = (FLOAT *) result; - - for (i1 = 0; i1 < (n >> 2); i1++) { -#if defined(TRMMKERNEL) && defined(LEFT) - off = offset; -#endif - AO = A; - CO = C; - C += ldc << 3; - - for (i = 0; i < (m >> 3); i++) { -#if defined(TRMMKERNEL) - REFRESH_POINTERS (8, 4); -#else - BO = B; - temp = k; -#endif - SET_ACC_ZERO() - for (l = 0; l < temp; ++l) { - vec_t rowA1 = *(vec_t *) & AO[l<<4]; - vec_t rowB1 = *(vec_t *) & BO[l<<3]; - vec_t rowA2 = *(vec_t *) & AO[(l<<4)+4]; - vec_t rowB2 = *(vec_t *) & BO[(l<<3)+4]; - vec_t rowA3 = *(vec_t *) & AO[(l<<4)+8]; - vec_t rowA4 = *(vec_t *) & AO[(l<<4)+12]; - __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); - __builtin_mma_xvf32gerpp(&acc1, rowA2, rowB1); - __builtin_mma_xvf32gerpp(&acc2, rowA3, rowB1); - __builtin_mma_xvf32gerpp(&acc3, rowA4, rowB1); - __builtin_mma_xvf32gerpp(&acc4, rowA1, rowB2); - __builtin_mma_xvf32gerpp(&acc5, rowA2, rowB2); - __builtin_mma_xvf32gerpp(&acc6, rowA3, rowB2); - __builtin_mma_xvf32gerpp(&acc7, rowA4, rowB2); - } - SAVE_ACC_COMPLEX_24_ALL - CO += 16; - AO += temp << 4; - BO += temp << 3; -#if defined(TRMMKERNEL) - REFRESH_AFTER_SAVE (8, 4) -#endif - } - if (m & 4) { -#if defined(TRMMKERNEL) - REFRESH_POINTERS (4, 4); -#else - BO = B; - temp = k; -#endif - SET_ACC_ZERO() - for (l = 0; l < (temp & (~1)); l+=2) { - vec_t rowA1 = *(vec_t *) & AO[l<<3]; - vec_t rowA2 = *(vec_t *) & AO[(l<<3)+4]; - vec_t rowA3 = *(vec_t *) & AO[(l<<3)+8]; - vec_t rowA4 = *(vec_t *) & AO[(l<<3)+12]; - vec_t rowB1 = *(vec_t *) & BO[l<<3]; - vec_t rowB2 = *(vec_t *) & BO[(l<<3)+4]; - vec_t rowB3 = *(vec_t *) & BO[(l<<3)+8]; - vec_t rowB4 = *(vec_t *) & BO[(l<<3)+12]; - __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); - __builtin_mma_xvf32gerpp(&acc1, rowA2, rowB1); - __builtin_mma_xvf32gerpp(&acc2, rowA1, rowB2); - __builtin_mma_xvf32gerpp(&acc3, rowA2, rowB2); - __builtin_mma_xvf32gerpp(&acc0, rowA3, rowB3); - __builtin_mma_xvf32gerpp(&acc1, rowA4, rowB3); - __builtin_mma_xvf32gerpp(&acc2, rowA3, rowB4); - __builtin_mma_xvf32gerpp(&acc3, rowA4, rowB4); - } - for (l = (temp & (~1)); l < temp; ++l) { - vec_t rowA1 = *(vec_t *) & AO[l<<3]; - vec_t rowA2 = *(vec_t *) & AO[(l<<3)+4]; - vec_t rowB1 = *(vec_t *) & BO[l<<3]; - vec_t rowB2 = *(vec_t *) & BO[(l<<3)+4]; - __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); - __builtin_mma_xvf32gerpp(&acc1, rowA2, rowB1); - __builtin_mma_xvf32gerpp(&acc2, rowA1, rowB2); - __builtin_mma_xvf32gerpp(&acc3, rowA2, rowB2); - } - SAVE_ACC_COMPLEX_24(&acc0, &acc2, 0) - SAVE_ACC_COMPLEX_24(&acc1, &acc3, 4) - CO += 8; - AO += temp << 3; - BO += temp << 3; -#if defined(TRMMKERNEL) - REFRESH_AFTER_SAVE (4, 4) -#endif - } - if (m & 2) { -#if defined(TRMMKERNEL) - REFRESH_POINTERS (2, 4); -#else - BO = B; - temp = k; -#endif - SET_ACC_ZERO() - for (l = 0; l < (temp & (~3)); l+=4) { - vec_t rowA1 = *(vec_t *) & AO[l<<2]; - vec_t rowA2 = *(vec_t *) & AO[(l<<2)+4]; - vec_t rowA3 = *(vec_t *) & AO[(l<<2)+8]; - vec_t rowA4 = *(vec_t *) & AO[(l<<2)+12]; - vec_t rowB1 = *(vec_t *) & BO[l<<3]; - vec_t rowB2 = *(vec_t *) & BO[(l<<3)+4]; - vec_t rowB3 = *(vec_t *) & BO[(l<<3)+8]; - vec_t rowB4 = *(vec_t *) & BO[(l<<3)+12]; - vec_t rowB5 = *(vec_t *) & BO[(l<<3)+16]; - vec_t rowB6 = *(vec_t *) & BO[(l<<3)+20]; - vec_t rowB7 = *(vec_t *) & BO[(l<<3)+24]; - vec_t rowB8 = *(vec_t *) & BO[(l<<3)+28]; - __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); - __builtin_mma_xvf32gerpp(&acc1, rowA1, rowB2); - __builtin_mma_xvf32gerpp(&acc0, rowA2, rowB3); - __builtin_mma_xvf32gerpp(&acc1, rowA2, rowB4); - __builtin_mma_xvf32gerpp(&acc0, rowA3, rowB5); - __builtin_mma_xvf32gerpp(&acc1, rowA3, rowB6); - __builtin_mma_xvf32gerpp(&acc0, rowA4, rowB7); - __builtin_mma_xvf32gerpp(&acc1, rowA4, rowB8); - } - for (l = (temp & (~3)); l < temp; ++l) { - vec_t rowA1 = *(vec_t *) & AO[l<<2]; - vec_t rowB1 = *(vec_t *) & BO[l<<3]; - vec_t rowB2 = *(vec_t *) & BO[(l<<3)+4]; - __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); - __builtin_mma_xvf32gerpp(&acc1, rowA1, rowB2); - } - SAVE_ACC_COMPLEX_24(&acc0, &acc1, 0) - CO += 4; - AO += temp << 2; - BO += temp << 3; -#if defined(TRMMKERNEL) - REFRESH_AFTER_SAVE (2, 4) -#endif - } - if (m & 1) { -#if defined(TRMMKERNEL) - REFRESH_POINTERS (1, 4) -#else - BO = B; - temp = k; -#endif - SET_ACC_ZERO() - for (l = 0; l < (temp & (~3)); l+=4) { - vec_t rowA1 = *(vec_t *) & AO[l<<1]; - vec_t rowA2 = *(vec_t *) & AO[(l<<1)+2]; - vec_t rowA3 = *(vec_t *) & AO[(l<<1)+4]; - vec_t rowA4 = *(vec_t *) & AO[(l<<1)+6]; - vec_t rowB1 = *(vec_t *) & BO[l<<3]; - vec_t rowB2 = *(vec_t *) & BO[(l<<3)+4]; - vec_t rowB3 = *(vec_t *) & BO[(l<<3)+8]; - vec_t rowB4 = *(vec_t *) & BO[(l<<3)+12]; - vec_t rowB5 = *(vec_t *) & BO[(l<<3)+16]; - vec_t rowB6 = *(vec_t *) & BO[(l<<3)+20]; - vec_t rowB7 = *(vec_t *) & BO[(l<<3)+24]; - vec_t rowB8 = *(vec_t *) & BO[(l<<3)+28]; - __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); - __builtin_mma_xvf32gerpp(&acc1, rowA1, rowB2); - __builtin_mma_xvf32gerpp(&acc2, rowA2, rowB3); - __builtin_mma_xvf32gerpp(&acc3, rowA2, rowB4); - __builtin_mma_xvf32gerpp(&acc4, rowA3, rowB5); - __builtin_mma_xvf32gerpp(&acc5, rowA3, rowB6); - __builtin_mma_xvf32gerpp(&acc6, rowA4, rowB7); - __builtin_mma_xvf32gerpp(&acc7, rowA4, rowB8); - } - for (l = (temp & (~3)); l < temp; ++l) { - vec_t rowA1 = *(vec_t *) & AO[l<<1]; - vec_t rowB1 = *(vec_t *) & BO[l<<3]; - vec_t rowB2 = *(vec_t *) & BO[(l<<3)+4]; - __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); - __builtin_mma_xvf32gerpp(&acc1, rowA1, rowB2); - } - SAVE_ACC_COMPLEX_14 - CO += 2; - AO += temp << 1; - BO += temp << 3; -#if defined(TRMMKERNEL) - REFRESH_AFTER_SAVE (1, 4) -#endif - } -#if defined(TRMMKERNEL) && !defined(LEFT) - off += 4; // number of values in A -#endif - - B += k << 3; - } - - if (n & 2) { -#if defined(TRMMKERNEL) && defined(LEFT) - off = offset; -#endif - AO = A; - CO = C; - C += ldc << 2; - - for (i = 0; i < (m >> 3); i++) { -#if defined(TRMMKERNEL) - REFRESH_POINTERS (8, 2) -#else - BO = B; - temp = k; -#endif - SET_ACC_ZERO() - for (l = 0; l < (temp & (~1)); l+=2) { - vec_t rowA1 = *(vec_t *) & AO[l<<4]; - vec_t rowA2 = *(vec_t *) & AO[(l<<4)+4]; - vec_t rowA3 = *(vec_t *) & AO[(l<<4)+8]; - vec_t rowA4 = *(vec_t *) & AO[(l<<4)+12]; - vec_t rowA5 = *(vec_t *) & AO[(l<<4)+16]; - vec_t rowA6 = *(vec_t *) & AO[(l<<4)+20]; - vec_t rowA7 = *(vec_t *) & AO[(l<<4)+24]; - vec_t rowA8 = *(vec_t *) & AO[(l<<4)+28]; - vec_t rowB1 = *(vec_t *) & BO[l<<2]; - vec_t rowB2 = *(vec_t *) & BO[(l<<2)+4]; - __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); - __builtin_mma_xvf32gerpp(&acc1, rowA2, rowB1); - __builtin_mma_xvf32gerpp(&acc2, rowA3, rowB1); - __builtin_mma_xvf32gerpp(&acc3, rowA4, rowB1); - __builtin_mma_xvf32gerpp(&acc0, rowA5, rowB2); - __builtin_mma_xvf32gerpp(&acc1, rowA6, rowB2); - __builtin_mma_xvf32gerpp(&acc2, rowA7, rowB2); - __builtin_mma_xvf32gerpp(&acc3, rowA8, rowB2); - } - for (l = (temp & (~1)); l < temp; ++l) { - vec_t rowA1 = *(vec_t *) & AO[l<<4]; - vec_t rowA2 = *(vec_t *) & AO[(l<<4)+4]; - vec_t rowA3 = *(vec_t *) & AO[(l<<4)+8]; - vec_t rowA4 = *(vec_t *) & AO[(l<<4)+12]; - vec_t rowB1 = *(vec_t *) & BO[l<<2]; - __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); - __builtin_mma_xvf32gerpp(&acc1, rowA2, rowB1); - __builtin_mma_xvf32gerpp(&acc2, rowA3, rowB1); - __builtin_mma_xvf32gerpp(&acc3, rowA4, rowB1); - } - SAVE_ACC_COMPLEX_22_4 - AO += temp << 4; - BO += temp << 2; - CO += 16; -#if defined(TRMMKERNEL) - REFRESH_AFTER_SAVE (8, 2) -#endif - } - if (m & 4) { -#if defined(TRMMKERNEL) - REFRESH_POINTERS (4, 2) -#else - BO = B; - temp = k; -#endif - SET_ACC_ZERO() - for (l = 0; l < (temp & (~3)); l+=4) { - vec_t rowA1 = *(vec_t *) & AO[l<<3]; - vec_t rowA2 = *(vec_t *) & AO[(l<<3)+4]; - vec_t rowA3 = *(vec_t *) & AO[(l<<3)+8]; - vec_t rowA4 = *(vec_t *) & AO[(l<<3)+12]; - vec_t rowA5 = *(vec_t *) & AO[(l<<3)+16]; - vec_t rowA6 = *(vec_t *) & AO[(l<<3)+20]; - vec_t rowA7 = *(vec_t *) & AO[(l<<3)+24]; - vec_t rowA8 = *(vec_t *) & AO[(l<<3)+28]; - vec_t rowB1 = *(vec_t *) & BO[l<<2]; - vec_t rowB2 = *(vec_t *) & BO[(l<<2)+4]; - vec_t rowB3 = *(vec_t *) & BO[(l<<2)+8]; - vec_t rowB4 = *(vec_t *) & BO[(l<<2)+12]; - __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); - __builtin_mma_xvf32gerpp(&acc1, rowA2, rowB1); - __builtin_mma_xvf32gerpp(&acc0, rowA3, rowB2); - __builtin_mma_xvf32gerpp(&acc1, rowA4, rowB2); - __builtin_mma_xvf32gerpp(&acc0, rowA5, rowB3); - __builtin_mma_xvf32gerpp(&acc1, rowA6, rowB3); - __builtin_mma_xvf32gerpp(&acc0, rowA7, rowB4); - __builtin_mma_xvf32gerpp(&acc1, rowA8, rowB4); - } - for (l = (temp & (~3)); l < temp; ++l) { - vec_t rowA1 = *(vec_t *) & AO[l<<3]; - vec_t rowA2 = *(vec_t *) & AO[(l<<3)+4]; - vec_t rowB1 = *(vec_t *) & BO[l<<2]; - __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); - __builtin_mma_xvf32gerpp(&acc1, rowA2, rowB1); - } - SAVE_ACC_COMPLEX_22_2 - AO += temp << 3; - BO += temp << 2; - CO += 8; -#if defined(TRMMKERNEL) - REFRESH_AFTER_SAVE (4, 2) -#endif - } - if (m & 2) { -#if defined(TRMMKERNEL) - REFRESH_POINTERS (2, 2) -#else - BO = B; - temp = k; -#endif - SET_ACC_ZERO() - for (l = 0; l < (temp & (~7)); l+=8) { - vec_t rowA1 = *(vec_t *) & AO[l<<2]; - vec_t rowA2 = *(vec_t *) & AO[(l<<2)+4]; - vec_t rowA3 = *(vec_t *) & AO[(l<<2)+8]; - vec_t rowA4 = *(vec_t *) & AO[(l<<2)+12]; - vec_t rowA5 = *(vec_t *) & AO[(l<<2)+16]; - vec_t rowA6 = *(vec_t *) & AO[(l<<2)+20]; - vec_t rowA7 = *(vec_t *) & AO[(l<<2)+24]; - vec_t rowA8 = *(vec_t *) & AO[(l<<2)+28]; - vec_t rowB1 = *(vec_t *) & BO[l<<2]; - vec_t rowB2 = *(vec_t *) & BO[(l<<2)+4]; - vec_t rowB3 = *(vec_t *) & BO[(l<<2)+8]; - vec_t rowB4 = *(vec_t *) & BO[(l<<2)+12]; - vec_t rowB5 = *(vec_t *) & BO[(l<<2)+16]; - vec_t rowB6 = *(vec_t *) & BO[(l<<2)+20]; - vec_t rowB7 = *(vec_t *) & BO[(l<<2)+24]; - vec_t rowB8 = *(vec_t *) & BO[(l<<2)+28]; - __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); - __builtin_mma_xvf32gerpp(&acc0, rowA2, rowB2); - __builtin_mma_xvf32gerpp(&acc0, rowA3, rowB3); - __builtin_mma_xvf32gerpp(&acc0, rowA4, rowB4); - __builtin_mma_xvf32gerpp(&acc0, rowA5, rowB5); - __builtin_mma_xvf32gerpp(&acc0, rowA6, rowB6); - __builtin_mma_xvf32gerpp(&acc0, rowA7, rowB7); - __builtin_mma_xvf32gerpp(&acc0, rowA8, rowB8); - } - for (l = (temp & (~7)); l < temp; ++l) { - vec_t rowA1 = *(vec_t *) & AO[l<<2]; - vec_t rowB1 = *(vec_t *) & BO[l<<2]; - __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); - } - SAVE_ACC_COMPLEX_22_1 - AO += temp << 2; - BO += temp << 2; - CO += 4; -#if defined(TRMMKERNEL) - REFRESH_AFTER_SAVE (2, 2) -#endif - } - if (m & 1) { -#if defined(TRMMKERNEL) - REFRESH_POINTERS (1, 2) -#else - BO = B; - temp = k; -#endif - SET_ACC_ZERO() - for (l = 0; l < (temp & (~7)); l+=8) { - vec_t rowA1 = *(vec_t *) & AO[l<<1]; - vec_t rowA2 = *(vec_t *) & AO[(l<<1)+2]; - vec_t rowA3 = *(vec_t *) & AO[(l<<1)+4]; - vec_t rowA4 = *(vec_t *) & AO[(l<<1)+6]; - vec_t rowA5 = *(vec_t *) & AO[(l<<1)+8]; - vec_t rowA6 = *(vec_t *) & AO[(l<<1)+10]; - vec_t rowA7 = *(vec_t *) & AO[(l<<1)+12]; - vec_t rowA8 = *(vec_t *) & AO[(l<<1)+14]; - vec_t rowB1 = *(vec_t *) & BO[l<<2]; - vec_t rowB2 = *(vec_t *) & BO[(l<<2)+4]; - vec_t rowB3 = *(vec_t *) & BO[(l<<2)+8]; - vec_t rowB4 = *(vec_t *) & BO[(l<<2)+12]; - vec_t rowB5 = *(vec_t *) & BO[(l<<2)+16]; - vec_t rowB6 = *(vec_t *) & BO[(l<<2)+20]; - vec_t rowB7 = *(vec_t *) & BO[(l<<2)+24]; - vec_t rowB8 = *(vec_t *) & BO[(l<<2)+28]; - __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); - __builtin_mma_xvf32gerpp(&acc1, rowA2, rowB2); - __builtin_mma_xvf32gerpp(&acc2, rowA3, rowB3); - __builtin_mma_xvf32gerpp(&acc3, rowA4, rowB4); - __builtin_mma_xvf32gerpp(&acc4, rowA5, rowB5); - __builtin_mma_xvf32gerpp(&acc5, rowA6, rowB6); - __builtin_mma_xvf32gerpp(&acc6, rowA7, rowB7); - __builtin_mma_xvf32gerpp(&acc7, rowA8, rowB8); - } - for (l = (temp & (~7)); l < temp; ++l) { - vec_t rowA1 = *(vec_t *) & AO[l<<1]; - vec_t rowB1 = *(vec_t *) & BO[l<<2]; - __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); - } - SAVE_ACC_COMPLEX_12 - AO += temp<<1; - BO += temp<<2; - CO += 2; -#if defined(TRMMKERNEL) - REFRESH_AFTER_SAVE (1, 2) -#endif - } -#if defined(TRMMKERNEL) && !defined(LEFT) - off += 2; // number of values in A -#endif - B += k << 2; - } - - if (n & 1) { -#if defined(TRMMKERNEL) && defined(LEFT) - off = offset; -#endif - AO = A; - CO = C; - C += ldc << 1; - - for (i = 0; i < (m >> 3); i++) { -#if defined(TRMMKERNEL) - REFRESH_POINTERS (8, 1) -#else - BO = B; - temp = k; -#endif - SET_ACC_ZERO() - for (l = 0; l < (temp & (~1)); l+=2) { - vec_t rowA1 = *(vec_t *) & AO[l<<4]; - vec_t rowA2 = *(vec_t *) & AO[(l<<4)+4]; - vec_t rowA3 = *(vec_t *) & AO[(l<<4)+8]; - vec_t rowA4 = *(vec_t *) & AO[(l<<4)+12]; - vec_t rowA5 = *(vec_t *) & AO[(l<<4)+16]; - vec_t rowA6 = *(vec_t *) & AO[(l<<4)+20]; - vec_t rowA7 = *(vec_t *) & AO[(l<<4)+24]; - vec_t rowA8 = *(vec_t *) & AO[(l<<4)+28]; - vec_t rowB1 = *(vec_t *) & BO[l<<1]; - vec_t rowB2 = *(vec_t *) & BO[(l<<1)+2]; - __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); - __builtin_mma_xvf32gerpp(&acc1, rowA2, rowB1); - __builtin_mma_xvf32gerpp(&acc2, rowA3, rowB1); - __builtin_mma_xvf32gerpp(&acc3, rowA4, rowB1); - __builtin_mma_xvf32gerpp(&acc4, rowA5, rowB2); - __builtin_mma_xvf32gerpp(&acc5, rowA6, rowB2); - __builtin_mma_xvf32gerpp(&acc6, rowA7, rowB2); - __builtin_mma_xvf32gerpp(&acc7, rowA8, rowB2); - } - for (l = (temp & (~1)); l < temp; ++l) { - vec_t rowA1 = *(vec_t *) & AO[l<<4]; - vec_t rowA2 = *(vec_t *) & AO[(l<<4)+4]; - vec_t rowA3 = *(vec_t *) & AO[(l<<4)+8]; - vec_t rowA4 = *(vec_t *) & AO[(l<<4)+12]; - vec_t rowB1 = *(vec_t *) & BO[l<<1]; - __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); - __builtin_mma_xvf32gerpp(&acc1, rowA2, rowB1); - __builtin_mma_xvf32gerpp(&acc2, rowA3, rowB1); - __builtin_mma_xvf32gerpp(&acc3, rowA4, rowB1); - } - SAVE_ACC_COMPLEX_21_4 - AO += temp << 4; - BO += temp << 1; - CO += 16; -#if defined(TRMMKERNEL) - REFRESH_AFTER_SAVE (8, 1) -#endif - } - if (m & 4) { -#if defined(TRMMKERNEL) - REFRESH_POINTERS (4, 1) -#else - BO = B; - temp = k; -#endif - SET_ACC_ZERO() - for (l = 0; l < (temp & (~3)); l+=4) { - vec_t rowA1 = *(vec_t *) & AO[l<<3]; - vec_t rowA2 = *(vec_t *) & AO[(l<<3)+4]; - vec_t rowA3 = *(vec_t *) & AO[(l<<3)+8]; - vec_t rowA4 = *(vec_t *) & AO[(l<<3)+12]; - vec_t rowA5 = *(vec_t *) & AO[(l<<3)+16]; - vec_t rowA6 = *(vec_t *) & AO[(l<<3)+20]; - vec_t rowA7 = *(vec_t *) & AO[(l<<3)+24]; - vec_t rowA8 = *(vec_t *) & AO[(l<<3)+28]; - vec_t rowB1 = *(vec_t *) & BO[l<<1]; - vec_t rowB2 = *(vec_t *) & BO[(l<<1)+2]; - vec_t rowB3 = *(vec_t *) & BO[(l<<1)+4]; - vec_t rowB4 = *(vec_t *) & BO[(l<<1)+6]; - __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); - __builtin_mma_xvf32gerpp(&acc1, rowA2, rowB1); - __builtin_mma_xvf32gerpp(&acc2, rowA3, rowB2); - __builtin_mma_xvf32gerpp(&acc3, rowA4, rowB2); - __builtin_mma_xvf32gerpp(&acc4, rowA5, rowB3); - __builtin_mma_xvf32gerpp(&acc5, rowA6, rowB3); - __builtin_mma_xvf32gerpp(&acc6, rowA7, rowB4); - __builtin_mma_xvf32gerpp(&acc7, rowA8, rowB4); - } - for (l = (temp & (~3)); l < temp; ++l) { - vec_t rowA1 = *(vec_t *) & AO[l<<3]; - vec_t rowA2 = *(vec_t *) & AO[(l<<3)+4]; - vec_t rowB1 = *(vec_t *) & BO[l<<1]; - __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); - __builtin_mma_xvf32gerpp(&acc1, rowA2, rowB1); - } - SAVE_ACC_COMPLEX_21_2 - AO += temp << 3; - BO += temp << 1; - CO += 8; -#if defined(TRMMKERNEL) - REFRESH_AFTER_SAVE (4, 1) -#endif - } - if (m & 2) { -#if defined(TRMMKERNEL) - REFRESH_POINTERS (2, 1) -#else - BO = B; - temp = k; -#endif - SET_ACC_ZERO() - for (l = 0; l < (temp & (~7)); l+=8) { - vec_t rowA1 = *(vec_t *) & AO[l<<2]; - vec_t rowA2 = *(vec_t *) & AO[(l<<2)+4]; - vec_t rowA3 = *(vec_t *) & AO[(l<<2)+8]; - vec_t rowA4 = *(vec_t *) & AO[(l<<2)+12]; - vec_t rowA5 = *(vec_t *) & AO[(l<<2)+16]; - vec_t rowA6 = *(vec_t *) & AO[(l<<2)+20]; - vec_t rowA7 = *(vec_t *) & AO[(l<<2)+24]; - vec_t rowA8 = *(vec_t *) & AO[(l<<2)+28]; - vec_t rowB1 = *(vec_t *) & BO[l<<1]; - vec_t rowB2 = *(vec_t *) & BO[(l<<1)+2]; - vec_t rowB3 = *(vec_t *) & BO[(l<<1)+4]; - vec_t rowB4 = *(vec_t *) & BO[(l<<1)+6]; - vec_t rowB5 = *(vec_t *) & BO[(l<<1)+8]; - vec_t rowB6 = *(vec_t *) & BO[(l<<1)+10]; - vec_t rowB7 = *(vec_t *) & BO[(l<<1)+12]; - vec_t rowB8 = *(vec_t *) & BO[(l<<1)+14]; - __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); - __builtin_mma_xvf32gerpp(&acc1, rowA2, rowB2); - __builtin_mma_xvf32gerpp(&acc2, rowA3, rowB3); - __builtin_mma_xvf32gerpp(&acc3, rowA4, rowB4); - __builtin_mma_xvf32gerpp(&acc4, rowA5, rowB5); - __builtin_mma_xvf32gerpp(&acc5, rowA6, rowB6); - __builtin_mma_xvf32gerpp(&acc6, rowA7, rowB7); - __builtin_mma_xvf32gerpp(&acc7, rowA8, rowB8); - } - for (l = (temp & (~7)); l < temp; ++l) { - vec_t rowA1 = *(vec_t *) & AO[l<<2]; - vec_t rowB1 = *(vec_t *) & BO[l<<1]; - __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); - } - SAVE_ACC_COMPLEX_21_1 - AO += temp << 2; - BO += temp << 1; - CO += 4; -#if defined(TRMMKERNEL) - REFRESH_AFTER_SAVE (2, 1) -#endif - } - if (m & 1) { -#if defined(TRMMKERNEL) - REFRESH_POINTERS (1, 1) -#else - BO = B; - temp = k; -#endif - SET_ACC_ZERO() - for (l = 0; l < (temp & (~7)); l+=8) { - vec_t rowA1 = *(vec_t *) & AO[l<<1]; - vec_t rowA2 = *(vec_t *) & AO[(l<<1)+2]; - vec_t rowA3 = *(vec_t *) & AO[(l<<1)+4]; - vec_t rowA4 = *(vec_t *) & AO[(l<<1)+6]; - vec_t rowA5 = *(vec_t *) & AO[(l<<1)+8]; - vec_t rowA6 = *(vec_t *) & AO[(l<<1)+10]; - vec_t rowA7 = *(vec_t *) & AO[(l<<1)+12]; - vec_t rowA8 = *(vec_t *) & AO[(l<<1)+14]; - vec_t rowB1 = *(vec_t *) & BO[l<<1]; - vec_t rowB2 = *(vec_t *) & BO[(l<<1)+2]; - vec_t rowB3 = *(vec_t *) & BO[(l<<1)+4]; - vec_t rowB4 = *(vec_t *) & BO[(l<<1)+6]; - vec_t rowB5 = *(vec_t *) & BO[(l<<1)+8]; - vec_t rowB6 = *(vec_t *) & BO[(l<<1)+10]; - vec_t rowB7 = *(vec_t *) & BO[(l<<1)+12]; - vec_t rowB8 = *(vec_t *) & BO[(l<<1)+14]; - __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); - __builtin_mma_xvf32gerpp(&acc1, rowA2, rowB2); - __builtin_mma_xvf32gerpp(&acc2, rowA3, rowB3); - __builtin_mma_xvf32gerpp(&acc3, rowA4, rowB4); - __builtin_mma_xvf32gerpp(&acc4, rowA5, rowB5); - __builtin_mma_xvf32gerpp(&acc5, rowA6, rowB6); - __builtin_mma_xvf32gerpp(&acc6, rowA7, rowB7); - __builtin_mma_xvf32gerpp(&acc7, rowA8, rowB8); - } - for (l = (temp & (~7)); l < temp; ++l) { - vec_t rowA1 = *(vec_t *) & AO[l<<1]; - vec_t rowB1 = *(vec_t *) & BO[l<<1]; - __builtin_mma_xvf32gerpp(&acc0, rowA1, rowB1); - } - SAVE_ACC_COMPLEX_11 - AO += temp<<1; - BO += temp<<1; - CO += 2; -#if defined(TRMMKERNEL) - REFRESH_AFTER_SAVE (1, 1) -#endif - } -#if defined(TRMMKERNEL) && !defined(LEFT) - off += 1; // number of values in A -#endif - B += k << 1; - } - return 0; -} diff --git a/kernel/power/zgemm_kernel_power10.c b/kernel/power/zgemm_kernel_power10.c deleted file mode 100644 index 370d12af3..000000000 --- a/kernel/power/zgemm_kernel_power10.c +++ /dev/null @@ -1,736 +0,0 @@ -/********************************************************************************* -Copyright (c) 2020, The OpenBLAS Project -All rights reserved. -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are -met: -1. Redistributions of source code must retain the above copyright -notice, this list of conditions and the following disclaimer. -2. 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. -3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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 "common.h" -#include - -typedef __vector unsigned char vec_t; -typedef FLOAT v4sf_t __attribute__ ((vector_size (16))); - -#define SET_ACC_ZERO() \ - __builtin_mma_xxsetaccz (&acc0); \ - __builtin_mma_xxsetaccz (&acc1); \ - __builtin_mma_xxsetaccz (&acc2); \ - __builtin_mma_xxsetaccz (&acc3); \ - __builtin_mma_xxsetaccz (&acc4); \ - __builtin_mma_xxsetaccz (&acc5); \ - __builtin_mma_xxsetaccz (&acc6); \ - __builtin_mma_xxsetaccz (&acc7); - -#if (defined(NN) || defined(NT) || defined(TN) || defined(TT)) -#define COMP_MUL(_real, _arbr, _aibi, _imag, _arbi, _aibr) { _real = _arbr - _aibi; _imag = _arbi + _aibr; } -#define COMP_MAC(_real, _arbr, _aibi, _imag, _arbi, _aibr) { _real += _arbr - _aibi; _imag += _arbi + _aibr; } -#endif - -#if (defined(NR) || defined(NC) || defined(TR) || defined(TC)) -#define COMP_MUL(_real, _arbr, _aibi, _imag, _arbi, _aibr) { _real = _arbr + _aibi; _imag = -_arbi + _aibr; } -#define COMP_MAC(_real, _arbr, _aibi, _imag, _arbi, _aibr) { _real += _arbr + _aibi; _imag += -_arbi + _aibr; } -#endif - -#if (defined(RN) || defined(RT) || defined(CN) || defined(CT)) -#define COMP_MUL(_real, _arbr, _aibi, _imag, _arbi, _aibr) { _real = _arbr + _aibi; _imag = _arbi - _aibr; } -#define COMP_MAC(_real, _arbr, _aibi, _imag, _arbi, _aibr) { _real += _arbr + _aibi; _imag += _arbi - _aibr; } -#endif - -#if (defined(RR) || defined(RC) || defined(CR) || defined(CC)) -#define COMP_MUL(_real, _arbr, _aibi, _imag, _arbi, _aibr) { _real = _arbr - _aibi; _imag = -_arbi - _aibr; } -#define COMP_MAC(_real, _arbr, _aibi, _imag, _arbi, _aibr) { _real += _arbr - _aibi; _imag += -_arbi - _aibr; } -#endif - -#if defined(TRMMKERNEL) -#define A_OP = -#else -#define A_OP += -#endif - -#define BUILTIN_MMA_DISASSEMBLE_ACC_8 \ - __builtin_mma_disassemble_acc ((void *)result, &acc0); \ - __builtin_mma_disassemble_acc ((void *)&result[4], &acc1); \ - __builtin_mma_disassemble_acc ((void *)&result[8], &acc2); \ - __builtin_mma_disassemble_acc ((void *)&result[12], &acc3); \ - __builtin_mma_disassemble_acc ((void *)&result[16], &acc4); \ - __builtin_mma_disassemble_acc ((void *)&result[20], &acc5); \ - __builtin_mma_disassemble_acc ((void *)&result[24], &acc6); \ - __builtin_mma_disassemble_acc ((void *)&result[28], &acc7); - -#define SAVE_ACC_COMPLEX_11 \ - BUILTIN_MMA_DISASSEMBLE_ACC_8 \ - COMP_MUL(tr[0], res[ 0], res[ 3], ti[0], res[ 1], res[ 2]) \ - COMP_MAC(tr[0], res[ 8], res[11], ti[0], res[ 9], res[10]) \ - COMP_MAC(tr[0], res[16], res[19], ti[0], res[17], res[18]) \ - COMP_MAC(tr[0], res[24], res[27], ti[0], res[25], res[26]) \ - COMP_MAC(tr[0], res[32], res[35], ti[0], res[33], res[34]) \ - COMP_MAC(tr[0], res[40], res[43], ti[0], res[41], res[42]) \ - COMP_MAC(tr[0], res[48], res[51], ti[0], res[49], res[50]) \ - COMP_MAC(tr[0], res[56], res[59], ti[0], res[57], res[58]) \ - CO[0] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ - CO[1] A_OP ti[0] * alpha_r + tr[0] * alpha_i; - -#define SAVE_ACC_COMPLEX_12 \ - BUILTIN_MMA_DISASSEMBLE_ACC_8 \ - COMP_MUL(tr[0], res[ 0], res[ 3], ti[0], res[ 1], res[ 2]) \ - COMP_MUL(tr[1], res[ 8], res[11], ti[1], res[ 9], res[10]) \ - COMP_MAC(tr[0], res[16], res[19], ti[0], res[17], res[18]) \ - COMP_MAC(tr[1], res[24], res[27], ti[1], res[25], res[26]) \ - COMP_MAC(tr[0], res[32], res[35], ti[0], res[33], res[34]) \ - COMP_MAC(tr[1], res[40], res[43], ti[1], res[41], res[42]) \ - COMP_MAC(tr[0], res[48], res[51], ti[0], res[49], res[50]) \ - COMP_MAC(tr[1], res[56], res[59], ti[1], res[57], res[58]) \ - CO[0] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ - CO[1] A_OP ti[0] * alpha_r + tr[0] * alpha_i; \ - CO[2*ldc+0] A_OP tr[1] * alpha_r - ti[1] * alpha_i; \ - CO[2*ldc+1] A_OP ti[1] * alpha_r + tr[1] * alpha_i; - -#define SAVE_ACC_COMPLEX_21_1 \ - BUILTIN_MMA_DISASSEMBLE_ACC_8 \ - COMP_MUL(tr[0], res[ 0], res[ 3], ti[0], res[ 1], res[ 2]) \ - COMP_MUL(tr[1], res[ 4], res[ 7], ti[1], res[ 5], res[ 6]) \ - COMP_MAC(tr[0], res[ 8], res[11], ti[0], res[ 9], res[10]) \ - COMP_MAC(tr[1], res[12], res[15], ti[1], res[13], res[14]) \ - COMP_MAC(tr[0], res[16], res[19], ti[0], res[17], res[18]) \ - COMP_MAC(tr[1], res[20], res[23], ti[1], res[21], res[22]) \ - COMP_MAC(tr[0], res[24], res[27], ti[0], res[25], res[26]) \ - COMP_MAC(tr[1], res[28], res[31], ti[1], res[29], res[30]) \ - COMP_MAC(tr[0], res[32], res[35], ti[0], res[33], res[34]) \ - COMP_MAC(tr[1], res[36], res[39], ti[1], res[37], res[38]) \ - COMP_MAC(tr[0], res[40], res[43], ti[0], res[41], res[42]) \ - COMP_MAC(tr[1], res[44], res[47], ti[1], res[45], res[46]) \ - COMP_MAC(tr[0], res[48], res[51], ti[0], res[49], res[50]) \ - COMP_MAC(tr[1], res[52], res[55], ti[1], res[53], res[54]) \ - COMP_MAC(tr[0], res[56], res[59], ti[0], res[57], res[58]) \ - COMP_MAC(tr[1], res[60], res[63], ti[1], res[61], res[62]) \ - CO[0] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ - CO[1] A_OP ti[0] * alpha_r + tr[0] * alpha_i; \ - CO[2] A_OP tr[1] * alpha_r - ti[1] * alpha_i; \ - CO[3] A_OP ti[1] * alpha_r + tr[1] * alpha_i; - -#define SAVE_ACC_COMPLEX_21_2 \ - BUILTIN_MMA_DISASSEMBLE_ACC_8 \ - COMP_MUL(tr[0], res[ 0], res[ 3], ti[0], res[ 1], res[ 2]) \ - COMP_MUL(tr[1], res[ 4], res[ 7], ti[1], res[ 5], res[ 6]) \ - COMP_MUL(tr[2], res[ 8], res[11], ti[2], res[ 9], res[10]) \ - COMP_MUL(tr[3], res[12], res[15], ti[3], res[13], res[14]) \ - COMP_MAC(tr[0], res[16], res[19], ti[0], res[17], res[18]) \ - COMP_MAC(tr[1], res[20], res[23], ti[1], res[21], res[22]) \ - COMP_MAC(tr[2], res[24], res[27], ti[2], res[25], res[26]) \ - COMP_MAC(tr[3], res[28], res[31], ti[3], res[29], res[30]) \ - COMP_MAC(tr[0], res[32], res[35], ti[0], res[33], res[34]) \ - COMP_MAC(tr[1], res[36], res[39], ti[1], res[37], res[38]) \ - COMP_MAC(tr[2], res[40], res[43], ti[2], res[41], res[42]) \ - COMP_MAC(tr[3], res[44], res[47], ti[3], res[45], res[46]) \ - COMP_MAC(tr[0], res[48], res[51], ti[0], res[49], res[50]) \ - COMP_MAC(tr[1], res[52], res[55], ti[1], res[53], res[54]) \ - COMP_MAC(tr[2], res[56], res[59], ti[2], res[57], res[58]) \ - COMP_MAC(tr[3], res[60], res[63], ti[3], res[61], res[62]) \ - CO[0] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ - CO[1] A_OP ti[0] * alpha_r + tr[0] * alpha_i; \ - CO[2] A_OP tr[1] * alpha_r - ti[1] * alpha_i; \ - CO[3] A_OP ti[1] * alpha_r + tr[1] * alpha_i; \ - CO[4] A_OP tr[2] * alpha_r - ti[2] * alpha_i; \ - CO[5] A_OP ti[2] * alpha_r + tr[2] * alpha_i; \ - CO[6] A_OP tr[3] * alpha_r - ti[3] * alpha_i; \ - CO[7] A_OP ti[3] * alpha_r + tr[3] * alpha_i; - -#define SAVE_ACC_COMPLEX_21_4 \ - BUILTIN_MMA_DISASSEMBLE_ACC_8 \ - COMP_MUL(tr[0], res[ 0], res[ 3], ti[0], res[ 1], res[ 2]) \ - COMP_MUL(tr[1], res[ 4], res[ 7], ti[1], res[ 5], res[ 6]) \ - COMP_MUL(tr[2], res[ 8], res[11], ti[2], res[ 9], res[10]) \ - COMP_MUL(tr[3], res[12], res[15], ti[3], res[13], res[14]) \ - COMP_MUL(tr[4], res[16], res[19], ti[4], res[17], res[18]) \ - COMP_MUL(tr[5], res[20], res[23], ti[5], res[21], res[22]) \ - COMP_MUL(tr[6], res[24], res[27], ti[6], res[25], res[26]) \ - COMP_MUL(tr[7], res[28], res[31], ti[7], res[29], res[30]) \ - COMP_MAC(tr[0], res[32], res[35], ti[0], res[33], res[34]) \ - COMP_MAC(tr[1], res[36], res[39], ti[1], res[37], res[38]) \ - COMP_MAC(tr[2], res[40], res[43], ti[2], res[41], res[42]) \ - COMP_MAC(tr[3], res[44], res[47], ti[3], res[45], res[46]) \ - COMP_MAC(tr[4], res[48], res[51], ti[4], res[49], res[50]) \ - COMP_MAC(tr[5], res[52], res[55], ti[5], res[53], res[54]) \ - COMP_MAC(tr[6], res[56], res[59], ti[6], res[57], res[58]) \ - COMP_MAC(tr[7], res[60], res[63], ti[7], res[61], res[62]) \ - CO[ 0] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ - CO[ 1] A_OP ti[0] * alpha_r + tr[0] * alpha_i; \ - CO[ 2] A_OP tr[1] * alpha_r - ti[1] * alpha_i; \ - CO[ 3] A_OP ti[1] * alpha_r + tr[1] * alpha_i; \ - CO[ 4] A_OP tr[2] * alpha_r - ti[2] * alpha_i; \ - CO[ 5] A_OP ti[2] * alpha_r + tr[2] * alpha_i; \ - CO[ 6] A_OP tr[3] * alpha_r - ti[3] * alpha_i; \ - CO[ 7] A_OP ti[3] * alpha_r + tr[3] * alpha_i; \ - CO[ 8] A_OP tr[4] * alpha_r - ti[4] * alpha_i; \ - CO[ 9] A_OP ti[4] * alpha_r + tr[4] * alpha_i; \ - CO[10] A_OP tr[5] * alpha_r - ti[5] * alpha_i; \ - CO[11] A_OP ti[5] * alpha_r + tr[5] * alpha_i; \ - CO[12] A_OP tr[6] * alpha_r - ti[6] * alpha_i; \ - CO[13] A_OP ti[6] * alpha_r + tr[6] * alpha_i; \ - CO[14] A_OP tr[7] * alpha_r - ti[7] * alpha_i; \ - CO[15] A_OP ti[7] * alpha_r + tr[7] * alpha_i; - -#define SAVE_ACC_COMPLEX_22_1 \ - __builtin_mma_disassemble_acc ((void *)result, &acc0); \ - __builtin_mma_disassemble_acc ((void *)(&result[4]), &acc1); \ - COMP_MUL(tr[0], res[0], res[3], ti[0], res[1], res[2]) \ - COMP_MUL(tr[1], res[4], res[7], ti[1], res[5], res[6]) \ - COMP_MUL(tr[2], res[8], res[11], ti[2], res[9], res[10]) \ - COMP_MUL(tr[3], res[12], res[15], ti[3], res[13], res[14] ) \ - CO[0] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ - CO[1] A_OP ti[0] * alpha_r + tr[0] * alpha_i; \ - CO[2] A_OP tr[1] * alpha_r - ti[1] * alpha_i; \ - CO[3] A_OP ti[1] * alpha_r + tr[1] * alpha_i; \ - CO[2*ldc+0] A_OP tr[2] * alpha_r - ti[2] * alpha_i; \ - CO[2*ldc+1] A_OP ti[2] * alpha_r + tr[2] * alpha_i; \ - CO[2*ldc+2] A_OP tr[3] * alpha_r - ti[3] * alpha_i; \ - CO[2*ldc+3] A_OP ti[3] * alpha_r + tr[3] * alpha_i; - -#define SAVE_ACC_COMPLEX_22_2(ACC1, ACC2, CI) \ - __builtin_mma_disassemble_acc ((void *)result, ACC1); \ - __builtin_mma_disassemble_acc ((void *)(&result[4]), ACC2); \ - COMP_MUL(tr[0], res[0], res[3], ti[0], res[1], res[2]) \ - COMP_MUL(tr[1], res[4], res[7], ti[1], res[5], res[6]) \ - COMP_MUL(tr[2], res[8], res[11], ti[2], res[9], res[10]) \ - COMP_MUL(tr[3], res[12], res[15], ti[3], res[13], res[14]) \ - CO[CI+0] A_OP tr[0] * alpha_r - ti[0] * alpha_i; \ - CO[CI+1] A_OP ti[0] * alpha_r + tr[0] * alpha_i; \ - CO[CI+2] A_OP tr[1] * alpha_r - ti[1] * alpha_i; \ - CO[CI+3] A_OP ti[1] * alpha_r + tr[1] * alpha_i; \ - CO[2*ldc+CI+0] A_OP tr[2] * alpha_r - ti[2] * alpha_i; \ - CO[2*ldc+CI+1] A_OP ti[2] * alpha_r + tr[2] * alpha_i; \ - CO[2*ldc+CI+2] A_OP tr[3] * alpha_r - ti[3] * alpha_i; \ - CO[2*ldc+CI+3] A_OP ti[3] * alpha_r + tr[3] * alpha_i; - -#define PREFETCH1(x, y) asm volatile ("dcbt %0, %1" : : "r" (x), "b" (y) : "memory"); - -#if (defined(LEFT) && !defined(TRANSA)) || (!defined(LEFT) && defined(TRANSA)) -#define REFRESH_TEMP_BK(x, y) \ - temp = k - off; -#elif defined(LEFT) -#define REFRESH_TEMP_BK(x, y) \ - temp = off + x; -#else -#define REFRESH_TEMP_BK(x, y) \ - temp = off + y; -#endif -#if (defined(LEFT) && defined(TRANSA)) || (!defined(LEFT) && !defined(TRANSA)) -#define REFRESH_POINTERS(x, y) \ - BO = B; \ - REFRESH_TEMP_BK(x, y) -#else -#define REFRESH_POINTERS(x, y) \ - AO += off * (2*x); \ - BO = B + off * (2*y); \ - REFRESH_TEMP_BK(x, y) -#endif - -#ifdef LEFT -#define REFRESH_OFF(x) \ - off += x; -#else -#define REFRESH_OFF(x) -#endif - -#ifdef LEFT -#define UPDATE_TEMP(x, y) \ - temp -= x; -#else -#define UPDATE_TEMP(x, y) \ - temp -= y; -#endif - -#if (defined(LEFT) && defined(TRANSA)) || (!defined(LEFT) && !defined(TRANSA)) -#define REFRESH_TMP_AFTER_SAVE(x, y) \ - temp = k - off; \ - UPDATE_TEMP(x, y) \ - AO += temp * (2*x); \ - BO += temp * (2*y); -#else -#define REFRESH_TMP_AFTER_SAVE(x, y) -#endif - -#define REFRESH_AFTER_SAVE(x,y) \ - REFRESH_TMP_AFTER_SAVE(x, y) \ - REFRESH_OFF(x) -/************************************************************************************* -* GEMM Kernel -*************************************************************************************/ -int -#ifdef TRMMKERNEL -CNAME (BLASLONG m, BLASLONG n, BLASLONG k, FLOAT alpha_r, FLOAT alpha_i, - FLOAT * A, FLOAT * B, FLOAT * C, BLASLONG ldc, BLASLONG offset) -#else -CNAME (BLASLONG m, BLASLONG n, BLASLONG k, FLOAT alpha_r, FLOAT alpha_i, - FLOAT * A, FLOAT * B, FLOAT * C, BLASLONG ldc) -#endif -{ - BLASLONG i1, i, l, temp; - FLOAT *AO, *BO, *CO; -#if defined(TRMMKERNEL) - BLASLONG off; -#endif -#if defined(TRMMKERNEL) && !defined(LEFT) - off = -offset; -#endif - __vector_quad acc0, acc1, acc2, acc3, acc4, acc5, acc6, acc7; - - v4sf_t result[32]; - FLOAT *res, tr[16], ti[16]; - res = (FLOAT *) result; - - for (i1 = 0; i1 < (n >> 1); i1++) { -#if defined(TRMMKERNEL) && defined(LEFT) - off = offset; -#endif - AO = A; - CO = C; - C += ldc<<2; - for (i = 0; i < (m >> 3); i++) { -#if defined(TRMMKERNEL) - REFRESH_POINTERS (8, 2) -#else - BO = B; - temp = k; -#endif - SET_ACC_ZERO() - for (l = 0; l < temp; ++l) { - __vector_pair rowA1 = *((__vector_pair *)((void *)&AO[l<<4])); - __vector_pair rowA2 = *((__vector_pair *)((void *)&AO[(l<<4)+4])); - __vector_pair rowA3 = *((__vector_pair *)((void *)&AO[(l<<4)+8])); - __vector_pair rowA4 = *((__vector_pair *)((void *)&AO[(l<<4)+12])); - vec_t rowB1 = *(vec_t *) & BO[l<<2]; - vec_t rowB2 = *(vec_t *) & BO[(l<<2)+2]; - __builtin_mma_xvf64gerpp(&acc0, rowA1, rowB1); - __builtin_mma_xvf64gerpp(&acc1, rowA2, rowB1); - __builtin_mma_xvf64gerpp(&acc2, rowA3, rowB1); - __builtin_mma_xvf64gerpp(&acc3, rowA4, rowB1); - __builtin_mma_xvf64gerpp(&acc4, rowA1, rowB2); - __builtin_mma_xvf64gerpp(&acc5, rowA2, rowB2); - __builtin_mma_xvf64gerpp(&acc6, rowA3, rowB2); - __builtin_mma_xvf64gerpp(&acc7, rowA4, rowB2); - } - __builtin_mma_disassemble_acc ((void *)result, &acc0); - __builtin_mma_disassemble_acc ((void *)(&result[ 4]), &acc1); - __builtin_mma_disassemble_acc ((void *)(&result[ 8]), &acc2); - __builtin_mma_disassemble_acc ((void *)(&result[12]), &acc3); - __builtin_mma_disassemble_acc ((void *)(&result[16]), &acc4); - __builtin_mma_disassemble_acc ((void *)(&result[20]), &acc5); - __builtin_mma_disassemble_acc ((void *)(&result[24]), &acc6); - __builtin_mma_disassemble_acc ((void *)(&result[28]), &acc7); - COMP_MUL(tr[ 0], res[ 0], res[ 3], ti[ 0], res[ 1], res[ 2]) - COMP_MUL(tr[ 1], res[ 4], res[ 7], ti[ 1], res[ 5], res[ 6]) - COMP_MUL(tr[ 2], res[ 8], res[11], ti[ 2], res[ 9], res[10]) - COMP_MUL(tr[ 3], res[12], res[15], ti[ 3], res[13], res[14]) - COMP_MUL(tr[ 4], res[16], res[19], ti[ 4], res[17], res[18]) - COMP_MUL(tr[ 5], res[20], res[23], ti[ 5], res[21], res[22]) - COMP_MUL(tr[ 6], res[24], res[27], ti[ 6], res[25], res[26]) - COMP_MUL(tr[ 7], res[28], res[31], ti[ 7], res[29], res[30]) - COMP_MUL(tr[ 8], res[32], res[35], ti[ 8], res[33], res[34]) - COMP_MUL(tr[ 9], res[36], res[39], ti[ 9], res[37], res[38]) - COMP_MUL(tr[10], res[40], res[43], ti[10], res[41], res[42]) - COMP_MUL(tr[11], res[44], res[47], ti[11], res[45], res[46]) - COMP_MUL(tr[12], res[48], res[51], ti[12], res[49], res[50]) - COMP_MUL(tr[13], res[52], res[55], ti[13], res[53], res[54]) - COMP_MUL(tr[14], res[56], res[59], ti[14], res[57], res[58]) - COMP_MUL(tr[15], res[60], res[63], ti[15], res[61], res[62]) - CO[ 0] A_OP tr[0] * alpha_r - ti[0] * alpha_i; - CO[ 1] A_OP ti[0] * alpha_r + tr[0] * alpha_i; - CO[ 2] A_OP tr[1] * alpha_r - ti[1] * alpha_i; - CO[ 3] A_OP ti[1] * alpha_r + tr[1] * alpha_i; - CO[ 4] A_OP tr[2] * alpha_r - ti[2] * alpha_i; - CO[ 5] A_OP ti[2] * alpha_r + tr[2] * alpha_i; - CO[ 6] A_OP tr[3] * alpha_r - ti[3] * alpha_i; - CO[ 7] A_OP ti[3] * alpha_r + tr[3] * alpha_i; - CO[ 8] A_OP tr[4] * alpha_r - ti[4] * alpha_i; - CO[ 9] A_OP ti[4] * alpha_r + tr[4] * alpha_i; - CO[10] A_OP tr[5] * alpha_r - ti[5] * alpha_i; - CO[11] A_OP ti[5] * alpha_r + tr[5] * alpha_i; - CO[12] A_OP tr[6] * alpha_r - ti[6] * alpha_i; - CO[13] A_OP ti[6] * alpha_r + tr[6] * alpha_i; - CO[14] A_OP tr[7] * alpha_r - ti[7] * alpha_i; - CO[15] A_OP ti[7] * alpha_r + tr[7] * alpha_i; - CO[2*ldc+ 0] A_OP tr[ 8] * alpha_r - ti[ 8] * alpha_i; - CO[2*ldc+ 1] A_OP ti[ 8] * alpha_r + tr[ 8] * alpha_i; - CO[2*ldc+ 2] A_OP tr[ 9] * alpha_r - ti[ 9] * alpha_i; - CO[2*ldc+ 3] A_OP ti[ 9] * alpha_r + tr[ 9] * alpha_i; - CO[2*ldc+ 4] A_OP tr[10] * alpha_r - ti[10] * alpha_i; - CO[2*ldc+ 5] A_OP ti[10] * alpha_r + tr[10] * alpha_i; - CO[2*ldc+ 6] A_OP tr[11] * alpha_r - ti[11] * alpha_i; - CO[2*ldc+ 7] A_OP ti[11] * alpha_r + tr[11] * alpha_i; - CO[2*ldc+ 8] A_OP tr[12] * alpha_r - ti[12] * alpha_i; - CO[2*ldc+ 9] A_OP ti[12] * alpha_r + tr[12] * alpha_i; - CO[2*ldc+10] A_OP tr[13] * alpha_r - ti[13] * alpha_i; - CO[2*ldc+11] A_OP ti[13] * alpha_r + tr[13] * alpha_i; - CO[2*ldc+12] A_OP tr[14] * alpha_r - ti[14] * alpha_i; - CO[2*ldc+13] A_OP ti[14] * alpha_r + tr[14] * alpha_i; - CO[2*ldc+14] A_OP tr[15] * alpha_r - ti[15] * alpha_i; - CO[2*ldc+15] A_OP ti[15] * alpha_r + tr[15] * alpha_i; - - AO += temp << 4; - BO += temp << 2; - CO += 16; -#if defined(TRMMKERNEL) - REFRESH_AFTER_SAVE (8, 2) -#endif - } - if (m & 4) { -#if defined(TRMMKERNEL) - REFRESH_POINTERS (4, 2) -#else - BO = B; - temp = k; -#endif - SET_ACC_ZERO() - for (l = 0; l < (temp & (~1)); l+=2) { - __vector_pair rowA1 = *((__vector_pair *)((void *)&AO[l<<3])); - __vector_pair rowA2 = *((__vector_pair *)((void *)&AO[(l<<3)+4])); - __vector_pair rowA3 = *((__vector_pair *)((void *)&AO[(l<<3)+8])); - __vector_pair rowA4 = *((__vector_pair *)((void *)&AO[(l<<3)+12])); - vec_t rowB1 = *(vec_t *) & BO[l<<2]; - vec_t rowB2 = *(vec_t *) & BO[(l<<2)+2]; - vec_t rowB3 = *(vec_t *) & BO[(l<<2)+4]; - vec_t rowB4 = *(vec_t *) & BO[(l<<2)+6]; - __builtin_mma_xvf64gerpp(&acc0, rowA1, rowB1); - __builtin_mma_xvf64gerpp(&acc1, rowA2, rowB1); - __builtin_mma_xvf64gerpp(&acc2, rowA1, rowB2); - __builtin_mma_xvf64gerpp(&acc3, rowA2, rowB2); - __builtin_mma_xvf64gerpp(&acc0, rowA3, rowB3); - __builtin_mma_xvf64gerpp(&acc1, rowA4, rowB3); - __builtin_mma_xvf64gerpp(&acc2, rowA3, rowB4); - __builtin_mma_xvf64gerpp(&acc3, rowA4, rowB4); - } - for (l = (temp & (~1)); l < temp; ++l) { - __vector_pair rowA1 = *((__vector_pair *)((void *)&AO[l<<3])); - __vector_pair rowA2 = *((__vector_pair *)((void *)&AO[(l<<3)+4])); - vec_t rowB1 = *(vec_t *) & BO[l<<2]; - vec_t rowB2 = *(vec_t *) & BO[(l<<2)+2]; - __builtin_mma_xvf64gerpp(&acc0, rowA1, rowB1); - __builtin_mma_xvf64gerpp(&acc1, rowA2, rowB1); - __builtin_mma_xvf64gerpp(&acc2, rowA1, rowB2); - __builtin_mma_xvf64gerpp(&acc3, rowA2, rowB2); - } - SAVE_ACC_COMPLEX_22_2(&acc0, &acc2, 0) - SAVE_ACC_COMPLEX_22_2(&acc1, &acc3, 4) - AO += temp << 3; - BO += temp << 2; - CO += 8; -#if defined(TRMMKERNEL) - REFRESH_AFTER_SAVE (4, 2) -#endif - } - if (m & 2) { -#if defined(TRMMKERNEL) - REFRESH_POINTERS (2, 2) -#else - BO = B; - temp = k; -#endif - SET_ACC_ZERO() - for (l = 0; l < (temp & (~3)); l+=4) { - __vector_pair rowA1 = *((__vector_pair *)((void *)&AO[l<<2])); - __vector_pair rowA2 = *((__vector_pair *)((void *)&AO[(l<<2)+4])); - __vector_pair rowA3 = *((__vector_pair *)((void *)&AO[(l<<2)+8])); - __vector_pair rowA4 = *((__vector_pair *)((void *)&AO[(l<<2)+12])); - vec_t rowB1 = *(vec_t *) & BO[l<<2]; - vec_t rowB2 = *(vec_t *) & BO[(l<<2)+2]; - vec_t rowB3 = *(vec_t *) & BO[(l<<2)+4]; - vec_t rowB4 = *(vec_t *) & BO[(l<<2)+6]; - vec_t rowB5 = *(vec_t *) & BO[(l<<2)+8]; - vec_t rowB6 = *(vec_t *) & BO[(l<<2)+10]; - vec_t rowB7 = *(vec_t *) & BO[(l<<2)+12]; - vec_t rowB8 = *(vec_t *) & BO[(l<<2)+14]; - __builtin_mma_xvf64gerpp(&acc0, rowA1, rowB1); - __builtin_mma_xvf64gerpp(&acc1, rowA1, rowB2); - __builtin_mma_xvf64gerpp(&acc0, rowA2, rowB3); - __builtin_mma_xvf64gerpp(&acc1, rowA2, rowB4); - __builtin_mma_xvf64gerpp(&acc0, rowA3, rowB5); - __builtin_mma_xvf64gerpp(&acc1, rowA3, rowB6); - __builtin_mma_xvf64gerpp(&acc0, rowA4, rowB7); - __builtin_mma_xvf64gerpp(&acc1, rowA4, rowB8); - } - for (l = (temp & (~3)); l < temp; ++l) { - __vector_pair rowA1 = *((__vector_pair *)((void *)&AO[l<<2])); - vec_t rowB1 = *(vec_t *) & BO[l<<2]; - vec_t rowB2 = *(vec_t *) & BO[(l<<2)+2]; - __builtin_mma_xvf64gerpp(&acc0, rowA1, rowB1); - __builtin_mma_xvf64gerpp(&acc1, rowA1, rowB2); - } - SAVE_ACC_COMPLEX_22_1 - AO += temp << 2; - BO += temp << 2; - CO += 4; -#if defined(TRMMKERNEL) - REFRESH_AFTER_SAVE (2, 2) -#endif - } - if (m & 1) { -#if defined(TRMMKERNEL) - REFRESH_POINTERS (1, 2) -#else - BO = B; - temp = k; -#endif - SET_ACC_ZERO() - for (l = 0; l < (temp & (~3)); l+=4) { - __vector_pair rowA1 = *((__vector_pair *)((void *)&AO[l<<1])); - __vector_pair rowA2 = *((__vector_pair *)((void *)&AO[(l<<1)+2])); - __vector_pair rowA3 = *((__vector_pair *)((void *)&AO[(l<<1)+4])); - __vector_pair rowA4 = *((__vector_pair *)((void *)&AO[(l<<1)+6])); - vec_t rowB1 = *(vec_t *) & BO[l<<2]; - vec_t rowB2 = *(vec_t *) & BO[(l<<2)+2]; - vec_t rowB3 = *(vec_t *) & BO[(l<<2)+4]; - vec_t rowB4 = *(vec_t *) & BO[(l<<2)+6]; - vec_t rowB5 = *(vec_t *) & BO[(l<<2)+8]; - vec_t rowB6 = *(vec_t *) & BO[(l<<2)+10]; - vec_t rowB7 = *(vec_t *) & BO[(l<<2)+12]; - vec_t rowB8 = *(vec_t *) & BO[(l<<2)+14]; - __builtin_mma_xvf64gerpp(&acc0, rowA1, rowB1); - __builtin_mma_xvf64gerpp(&acc1, rowA1, rowB2); - __builtin_mma_xvf64gerpp(&acc0, rowA2, rowB3); - __builtin_mma_xvf64gerpp(&acc1, rowA2, rowB4); - __builtin_mma_xvf64gerpp(&acc0, rowA3, rowB5); - __builtin_mma_xvf64gerpp(&acc1, rowA3, rowB6); - __builtin_mma_xvf64gerpp(&acc0, rowA4, rowB7); - __builtin_mma_xvf64gerpp(&acc1, rowA4, rowB8); - } - for (l = (temp & (~3)); l < temp; ++l) { - __vector_pair rowA1 = *((__vector_pair *)((void *)&AO[l<<1])); - vec_t rowB1 = *(vec_t *) & BO[l<<2]; - vec_t rowB2 = *(vec_t *) & BO[(l<<2)+2]; - __builtin_mma_xvf64gerpp(&acc0, rowA1, rowB1); - __builtin_mma_xvf64gerpp(&acc1, rowA1, rowB2); - } - SAVE_ACC_COMPLEX_12 - AO += temp << 1; - BO += temp << 2; - CO += 2; -#if defined(TRMMKERNEL) - REFRESH_AFTER_SAVE (1, 2) -#endif - } -#if defined(TRMMKERNEL) && !defined(LEFT) - off += 2; // number of values in A -#endif - B += k << 2; - } - if (n & 1) { -#if defined(TRMMKERNEL) && defined(LEFT) - off = offset; -#endif - AO = A; - CO = C; - C += ldc<<1; - for (i = 0; i < (m >> 3); i++) { -#if defined(TRMMKERNEL) - REFRESH_POINTERS (8, 1) -#else - BO = B; - temp = k; -#endif - SET_ACC_ZERO() - for (l = 0; l < (temp & (~1)); l+=2) { - __vector_pair rowA1 = *((__vector_pair *)((void *)&AO[l<<4])); - __vector_pair rowA2 = *((__vector_pair *)((void *)&AO[(l<<4)+4])); - __vector_pair rowA3 = *((__vector_pair *)((void *)&AO[(l<<4)+8])); - __vector_pair rowA4 = *((__vector_pair *)((void *)&AO[(l<<4)+12])); - __vector_pair rowA5 = *((__vector_pair *)((void *)&AO[(l<<4)+16])); - __vector_pair rowA6 = *((__vector_pair *)((void *)&AO[(l<<4)+20])); - __vector_pair rowA7 = *((__vector_pair *)((void *)&AO[(l<<4)+24])); - __vector_pair rowA8 = *((__vector_pair *)((void *)&AO[(l<<4)+28])); - vec_t rowB1 = *(vec_t *) & BO[l<<1]; - vec_t rowB2 = *(vec_t *) & BO[(l<<1)+2]; - __builtin_mma_xvf64gerpp(&acc0, rowA1, rowB1); - __builtin_mma_xvf64gerpp(&acc1, rowA2, rowB1); - __builtin_mma_xvf64gerpp(&acc2, rowA3, rowB1); - __builtin_mma_xvf64gerpp(&acc3, rowA4, rowB1); - __builtin_mma_xvf64gerpp(&acc0, rowA5, rowB2); - __builtin_mma_xvf64gerpp(&acc1, rowA6, rowB2); - __builtin_mma_xvf64gerpp(&acc2, rowA7, rowB2); - __builtin_mma_xvf64gerpp(&acc3, rowA8, rowB2); - } - for (l = (temp & (~1)); l < temp; ++l) { - __vector_pair rowA1 = *((__vector_pair *)((void *)&AO[l<<4])); - __vector_pair rowA2 = *((__vector_pair *)((void *)&AO[(l<<4)+4])); - __vector_pair rowA3 = *((__vector_pair *)((void *)&AO[(l<<4)+8])); - __vector_pair rowA4 = *((__vector_pair *)((void *)&AO[(l<<4)+12])); - vec_t rowB1 = *(vec_t *) & BO[l<<1]; - __builtin_mma_xvf64gerpp(&acc0, rowA1, rowB1); - __builtin_mma_xvf64gerpp(&acc1, rowA2, rowB1); - __builtin_mma_xvf64gerpp(&acc2, rowA3, rowB1); - __builtin_mma_xvf64gerpp(&acc3, rowA4, rowB1); - } - SAVE_ACC_COMPLEX_21_4 - - AO += temp << 4; - BO += temp << 1; - CO += 16; -#if defined(TRMMKERNEL) - REFRESH_AFTER_SAVE (8, 1) -#endif - } - if (m & 4) { -#if defined(TRMMKERNEL) - REFRESH_POINTERS (4, 1) -#else - BO = B; - temp = k; -#endif - SET_ACC_ZERO() - for (l = 0; l < (temp & (~3)); l+=4) { - __vector_pair rowA1 = *((__vector_pair *)((void *)&AO[l<<3])); - __vector_pair rowA2 = *((__vector_pair *)((void *)&AO[(l<<3)+4])); - __vector_pair rowA3 = *((__vector_pair *)((void *)&AO[(l<<3)+8])); - __vector_pair rowA4 = *((__vector_pair *)((void *)&AO[(l<<3)+12])); - __vector_pair rowA5 = *((__vector_pair *)((void *)&AO[(l<<3)+16])); - __vector_pair rowA6 = *((__vector_pair *)((void *)&AO[(l<<3)+20])); - __vector_pair rowA7 = *((__vector_pair *)((void *)&AO[(l<<3)+24])); - __vector_pair rowA8 = *((__vector_pair *)((void *)&AO[(l<<3)+28])); - vec_t rowB1 = *(vec_t *) & BO[l<<1]; - vec_t rowB2 = *(vec_t *) & BO[(l<<1)+2]; - vec_t rowB3 = *(vec_t *) & BO[(l<<1)+4]; - vec_t rowB4 = *(vec_t *) & BO[(l<<1)+6]; - __builtin_mma_xvf64gerpp(&acc0, rowA1, rowB1); - __builtin_mma_xvf64gerpp(&acc1, rowA2, rowB1); - __builtin_mma_xvf64gerpp(&acc2, rowA3, rowB2); - __builtin_mma_xvf64gerpp(&acc3, rowA4, rowB2); - __builtin_mma_xvf64gerpp(&acc4, rowA5, rowB3); - __builtin_mma_xvf64gerpp(&acc5, rowA6, rowB3); - __builtin_mma_xvf64gerpp(&acc6, rowA7, rowB4); - __builtin_mma_xvf64gerpp(&acc7, rowA8, rowB4); - } - for (l = (temp & (~3)); l < temp; ++l) { - __vector_pair rowA1 = *((__vector_pair *)((void *)&AO[l<<3])); - __vector_pair rowA2 = *((__vector_pair *)((void *)&AO[(l<<3)+4])); - vec_t rowB1 = *(vec_t *) & BO[l<<1]; - __builtin_mma_xvf64gerpp(&acc0, rowA1, rowB1); - __builtin_mma_xvf64gerpp(&acc1, rowA2, rowB1); - } - SAVE_ACC_COMPLEX_21_2 - AO += temp << 3; - BO += temp << 1; - CO += 8; -#if defined(TRMMKERNEL) - REFRESH_AFTER_SAVE (4, 1) -#endif - } - if (m & 2) { -#if defined(TRMMKERNEL) - REFRESH_POINTERS (2, 1) -#else - BO = B; - temp = k; -#endif - SET_ACC_ZERO() - for (l = 0; l < (temp & (~7)); l+=8) { - __vector_pair rowA1 = *((__vector_pair *)((void *)&AO[l<<2])); - __vector_pair rowA2 = *((__vector_pair *)((void *)&AO[(l<<2)+4])); - __vector_pair rowA3 = *((__vector_pair *)((void *)&AO[(l<<2)+8])); - __vector_pair rowA4 = *((__vector_pair *)((void *)&AO[(l<<2)+12])); - __vector_pair rowA5 = *((__vector_pair *)((void *)&AO[(l<<2)+16])); - __vector_pair rowA6 = *((__vector_pair *)((void *)&AO[(l<<2)+20])); - __vector_pair rowA7 = *((__vector_pair *)((void *)&AO[(l<<2)+24])); - __vector_pair rowA8 = *((__vector_pair *)((void *)&AO[(l<<2)+28])); - vec_t rowB1 = *(vec_t *) & BO[l<<1]; - vec_t rowB2 = *(vec_t *) & BO[(l<<1)+2]; - vec_t rowB3 = *(vec_t *) & BO[(l<<1)+4]; - vec_t rowB4 = *(vec_t *) & BO[(l<<1)+6]; - vec_t rowB5 = *(vec_t *) & BO[(l<<1)+8]; - vec_t rowB6 = *(vec_t *) & BO[(l<<1)+10]; - vec_t rowB7 = *(vec_t *) & BO[(l<<1)+12]; - vec_t rowB8 = *(vec_t *) & BO[(l<<1)+14]; - __builtin_mma_xvf64gerpp(&acc0, rowA1, rowB1); - __builtin_mma_xvf64gerpp(&acc1, rowA2, rowB2); - __builtin_mma_xvf64gerpp(&acc2, rowA3, rowB3); - __builtin_mma_xvf64gerpp(&acc3, rowA4, rowB4); - __builtin_mma_xvf64gerpp(&acc4, rowA5, rowB5); - __builtin_mma_xvf64gerpp(&acc5, rowA6, rowB6); - __builtin_mma_xvf64gerpp(&acc6, rowA7, rowB7); - __builtin_mma_xvf64gerpp(&acc7, rowA8, rowB8); - } - for (l = (temp & (~7)); l < temp; ++l) { - __vector_pair rowA1 = *((__vector_pair *)((void *)&AO[l<<2])); - vec_t rowB1 = *(vec_t *) & BO[l<<1]; - __builtin_mma_xvf64gerpp(&acc0, rowA1, rowB1); - } - SAVE_ACC_COMPLEX_21_1 - AO += temp << 2; - BO += temp << 1; - CO += 4; -#if defined(TRMMKERNEL) - REFRESH_AFTER_SAVE (2, 1) -#endif - } - if (m & 1) { -#if defined(TRMMKERNEL) - REFRESH_POINTERS (1, 1) -#else - BO = B; - temp = k; -#endif - SET_ACC_ZERO() - for (l = 0; l < (temp & (~7)); l+=8) { - __vector_pair rowA1 = *((__vector_pair *)((void *)&AO[l<<1])); - __vector_pair rowA2 = *((__vector_pair *)((void *)&AO[(l<<1)+2])); - __vector_pair rowA3 = *((__vector_pair *)((void *)&AO[(l<<1)+4])); - __vector_pair rowA4 = *((__vector_pair *)((void *)&AO[(l<<1)+6])); - __vector_pair rowA5 = *((__vector_pair *)((void *)&AO[(l<<1)+8])); - __vector_pair rowA6 = *((__vector_pair *)((void *)&AO[(l<<1)+10])); - __vector_pair rowA7 = *((__vector_pair *)((void *)&AO[(l<<1)+12])); - __vector_pair rowA8 = *((__vector_pair *)((void *)&AO[(l<<1)+14])); - vec_t rowB1 = *(vec_t *) & BO[l<<1]; - vec_t rowB2 = *(vec_t *) & BO[(l<<1)+2]; - vec_t rowB3 = *(vec_t *) & BO[(l<<1)+4]; - vec_t rowB4 = *(vec_t *) & BO[(l<<1)+6]; - vec_t rowB5 = *(vec_t *) & BO[(l<<1)+8]; - vec_t rowB6 = *(vec_t *) & BO[(l<<1)+10]; - vec_t rowB7 = *(vec_t *) & BO[(l<<1)+12]; - vec_t rowB8 = *(vec_t *) & BO[(l<<1)+14]; - __builtin_mma_xvf64gerpp(&acc0, rowA1, rowB1); - __builtin_mma_xvf64gerpp(&acc1, rowA2, rowB2); - __builtin_mma_xvf64gerpp(&acc2, rowA3, rowB3); - __builtin_mma_xvf64gerpp(&acc3, rowA4, rowB4); - __builtin_mma_xvf64gerpp(&acc4, rowA5, rowB5); - __builtin_mma_xvf64gerpp(&acc5, rowA6, rowB6); - __builtin_mma_xvf64gerpp(&acc6, rowA7, rowB7); - __builtin_mma_xvf64gerpp(&acc7, rowA8, rowB8); - } - for (l = (temp & (~7)); l < temp; ++l) { - __vector_pair rowA1 = *((__vector_pair *)((void *)&AO[l<<1])); - vec_t rowB1 = *(vec_t *) & BO[l<<1]; - __builtin_mma_xvf64gerpp(&acc0, rowA1, rowB1); - } - SAVE_ACC_COMPLEX_11 - AO += temp << 1; - BO += temp << 1; - CO += 2; -#if defined(TRMMKERNEL) - REFRESH_AFTER_SAVE (1, 1) -#endif - } -#if defined(TRMMKERNEL) && !defined(LEFT) - off += 1; // number of values in A -#endif - B += k << 1; - } - return 0; -} From 654660034223f0b6020b353db945242dd8c0a8e1 Mon Sep 17 00:00:00 2001 From: pengxu Date: Mon, 4 Mar 2024 10:02:01 +0800 Subject: [PATCH 204/311] Optimized ssymv and dsymv kernel LASX for LoongArch --- kernel/loongarch64/KERNEL.LOONGSON3R5 | 6 + kernel/loongarch64/dsymv_L_lasx.S | 440 ++++++++++++++++++++++++++ kernel/loongarch64/dsymv_U_lasx.S | 428 +++++++++++++++++++++++++ kernel/loongarch64/ssymv_L_lasx.S | 436 +++++++++++++++++++++++++ kernel/loongarch64/ssymv_U_lasx.S | 424 +++++++++++++++++++++++++ 5 files changed, 1734 insertions(+) create mode 100644 kernel/loongarch64/dsymv_L_lasx.S create mode 100644 kernel/loongarch64/dsymv_U_lasx.S create mode 100644 kernel/loongarch64/ssymv_L_lasx.S create mode 100644 kernel/loongarch64/ssymv_U_lasx.S diff --git a/kernel/loongarch64/KERNEL.LOONGSON3R5 b/kernel/loongarch64/KERNEL.LOONGSON3R5 index 9b55d1bbb..20d0769f4 100644 --- a/kernel/loongarch64/KERNEL.LOONGSON3R5 +++ b/kernel/loongarch64/KERNEL.LOONGSON3R5 @@ -98,6 +98,9 @@ DGEMMOTCOPYOBJ = dgemm_otcopy$(TSUFFIX).$(SUFFIX) DGEMVNKERNEL = dgemv_n_8_lasx.S DGEMVTKERNEL = dgemv_t_8_lasx.S +DSYMV_U_KERNEL = dsymv_U_lasx.S +DSYMV_L_KERNEL = dsymv_L_lasx.S + SGEMMKERNEL = sgemm_kernel_16x8_lasx.S SGEMMINCOPY = sgemm_ncopy_16_lasx.S SGEMMITCOPY = sgemm_tcopy_16_lasx.S @@ -111,6 +114,9 @@ SGEMMOTCOPYOBJ = sgemm_otcopy$(TSUFFIX).$(SUFFIX) SGEMVNKERNEL = sgemv_n_8_lasx.S SGEMVTKERNEL = sgemv_t_8_lasx.S +SSYMV_U_KERNEL = ssymv_U_lasx.S +SSYMV_L_KERNEL = ssymv_L_lasx.S + CGEMMKERNEL = cgemm_kernel_16x4_lasx.S CGEMMINCOPY = cgemm_ncopy_16_lasx.S CGEMMITCOPY = cgemm_tcopy_16_lasx.S diff --git a/kernel/loongarch64/dsymv_L_lasx.S b/kernel/loongarch64/dsymv_L_lasx.S new file mode 100644 index 000000000..2259966d8 --- /dev/null +++ b/kernel/loongarch64/dsymv_L_lasx.S @@ -0,0 +1,440 @@ +/******************************************************************************* +Copyright (c) 2024, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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. +*******************************************************************************/ + +#define ASSEMBLER + +#include "common.h" + +/* Param */ +#define M $r4 +#define N $r5 +#define A $r6 +#define LDA $r7 +#define X $r8 +#define INCX $r9 +#define Y $r10 +#define INCY $r11 +#define BUFFER $r16 +#define ALPHA $f0 + +#define JY $r18 +#define JX $r31 +#define T0 $r19 +#define T1 $r20 +#define AO3 $r12 +#define AO4 $r13 +#define I $r14 +#define J $r15 +#define AO1 $r23 +#define AO2 $r24 +#define IX $r25 +#define IY $r26 +#define II $r27 +#define T2 $r28 +#define T3 $r29 +#define T4 $r30 + +/* LSX vectors */ +#define U0 $xr31 +#define U1 $xr1 +#define U2 $xr2 +#define U3 $xr3 +#define U4 $xr4 +#define U5 $xr5 +#define U6 $xr6 +#define U7 $xr7 +#define U8 $xr8 +#define U9 $xr9 +#define U10 $xr10 +#define U11 $xr11 +#define U12 $xr12 +#define U13 $xr13 +#define U14 $xr14 +#define U15 $xr15 +#define U16 $xr16 +#define VALPHA $xr17 + +#define a2 $f2 +#define a3 $f3 +#define a4 $f4 +#define a5 $f5 +#define a6 $f6 +#define a7 $f7 +#define a8 $f8 +#define a9 $f9 + + + PROLOGUE + + LDARG BUFFER, $sp, 0 + + addi.d $sp, $sp, -88 + + SDARG $r23, $sp, 0 + SDARG $r24, $sp, 8 + SDARG $r25, $sp, 16 + SDARG $r26, $sp, 32 + SDARG $r27, $sp, 40 + SDARG $r28, $sp, 48 + SDARG $r29, $sp, 56 + SDARG $r30, $sp, 64 + SDARG $r31, $sp, 72 + ST ALPHA, $sp, 80 + + xvldrepl.d VALPHA, $sp, 80 + + slli.d LDA, LDA, BASE_SHIFT + slli.d INCX, INCX, BASE_SHIFT + slli.d INCY, INCY, BASE_SHIFT + + bge $r0, M, .L999 + bge $r0, N, .L999 + + move J, $r0 + move JY, $r0 + move JX, $r0 + move AO1, A + + beq J, N, .L999 + +.L01: + MTC a2, $r0 //temp2 + fldx.d a6, X, JX + fmul.d a3, ALPHA, a6 //temp1 + xvreplve0.d U3, U3 + xvreplve0.d U2, U2 + + mul.d T0, J, LDA + slli.d T1, J, BASE_SHIFT + add.d T0, T0, T1 + fldx.d a6, AO1, T0 + fldx.d a4, Y, JY + fmadd.d a4, a3, a6, a4 + fstx.d a4, Y, JY + + move IY, JY + move IX, JX + addi.d II, J, 1 + move I, II + slli.d II, II, BASE_SHIFT + + sub.d T0, M, J + addi.d T0, T0, -1 + srai.d T0, T0, 3 + add.d T0, T0, J + addi.d T0, T0, 1 + beq I, T0, .L03 + bge I, T0, .L03 + + mul.d T1, J, LDA + add.d T1, T1, II + +.L02: /* /8 */ + xvldx U1, AO1, T1 + addi.d T1, T1, 32 + xvldx U14, AO1, T1 + addi.d T1, T1, 32 + + add.d T2, IY, INCY + fldx.d $f4, Y, T2 + add.d T2, T2, INCY + fldx.d $f5, Y, T2 + add.d T2, T2, INCY + fldx.d $f6, Y, T2 + add.d T2, T2, INCY + fldx.d $f7, Y, T2 + + add.d T2, T2, INCY + fldx.d $f8, Y, T2 + add.d T2, T2, INCY + fldx.d $f9, Y, T2 + add.d T2, T2, INCY + fldx.d $f10, Y, T2 + add.d T2, T2, INCY + fldx.d $f11, Y, T2 + + vextrins.d $vr4, $vr5, 0x10 + vextrins.d $vr6, $vr7, 0x10 + xvpermi.q U4, U6, 0x02 + + vextrins.d $vr8, $vr9, 0x10 + vextrins.d $vr10, $vr11, 0x10 + xvpermi.q U8, U10, 0x02 + + xvfmadd.d U4, U3, U1, U4 + xvfmadd.d U8, U3, U14, U8 + + xvpermi.d U6, U4, 0xee + vextrins.d $vr5, $vr4, 0x01 + vextrins.d $vr7, $vr6, 0x01 + + xvpermi.d U10, U8, 0xee + vextrins.d $vr9, $vr8, 0x01 + vextrins.d $vr11, $vr10, 0x01 + + add.d T2, IY, INCY + fstx.d $f4, Y, T2 + add.d T2, T2, INCY + fstx.d $f5, Y, T2 + add.d T2, T2, INCY + fstx.d $f6, Y, T2 + add.d T2, T2, INCY + fstx.d $f7, Y, T2 + + add.d T2, T2, INCY + fstx.d $f8, Y, T2 + add.d T2, T2, INCY + fstx.d $f9, Y, T2 + add.d T2, T2, INCY + fstx.d $f10, Y, T2 + add.d T2, T2, INCY + fstx.d $f11, Y, T2 + + slli.d T2, INCY, 3 + add.d IY, IY, T2 + + add.d T2, IX, INCX + fldx.d $f4, X, T2 + add.d T2, T2, INCX + fldx.d $f5, X, T2 + add.d T2, T2, INCX + fldx.d $f6, X, T2 + add.d T2, T2, INCX + fldx.d $f7, X, T2 + + add.d T2, T2, INCX + fldx.d $f8, X, T2 + add.d T2, T2, INCX + fldx.d $f9, X, T2 + add.d T2, T2, INCX + fldx.d $f10, X, T2 + add.d T2, T2, INCX + fldx.d $f11, X, T2 + + vextrins.d $vr4, $vr5, 0x10 + vextrins.d $vr6, $vr7, 0x10 + xvpermi.q U4, U6, 0x02 + + vextrins.d $vr8, $vr9, 0x10 + vextrins.d $vr10, $vr11, 0x10 + xvpermi.q U8, U10, 0x02 + + xvand.v $xr12, $xr2, $xr2 + + xvfmadd.d U2, U1, U4, U2 + xvfsub.d U2, U2, $xr12 + xvfmadd.d U2, U14, U8, U2 + + xvpermi.d U4, U2, 0x01 + xvpermi.d U5, U2, 0x02 + xvpermi.d U6, U2, 0x03 + + fadd.d $f2, $f2, $f4 + fadd.d $f2, $f2, $f5 + fadd.d $f2, $f2, $f6 + fadd.d $f2, $f2, $f12 + + xvreplve0.d U2, U2 + + slli.d T2, INCX, 3 + add.d IX, IX, T2 + + addi.d II, II, 64 + addi.d I, I, 1 + blt I, T0, .L02 + +.L03: /* &4 */ + sub.d T0, M, J + addi.d T0, T0, -1 + andi T0, T0, 4 + beq $r0, T0, .L04 + + mul.d T1, J, LDA + add.d T1, T1, II + + xvldx U1, AO1, T1 + + add.d T1, IY, INCY + add.d T2, T1, INCY + add.d T3, T2, INCY + add.d T4, T3, INCY + + fldx.d $f4, Y, T1 + fldx.d $f5, Y, T2 + fldx.d $f6, Y, T3 + fldx.d $f7, Y, T4 + + vextrins.d $vr4, $vr5, 0x10 + vextrins.d $vr6, $vr7, 0x10 + xvpermi.q U4, U6, 0x02 + + xvfmadd.d U4, U3, U1, U4 + + xvpermi.d U6, U4, 0xee + vextrins.d $vr5, $vr4, 0x01 + vextrins.d $vr7, $vr6, 0x01 + + fstx.d $f4, Y, T1 + fstx.d $f5, Y, T2 + fstx.d $f6, Y, T3 + fstx.d $f7, Y, T4 + + slli.d T1, INCY, 2 + add.d IY, IY, T1 + + add.d T1, IX, INCX + add.d T2, T1, INCX + add.d T3, T2, INCX + add.d T4, T3, INCX + + fldx.d $f4, X, T1 + fldx.d $f5, X, T2 + fldx.d $f6, X, T3 + fldx.d $f7, X, T4 + + vextrins.d $vr4, $vr5, 0x10 + vextrins.d $vr6, $vr7, 0x10 + xvpermi.q U4, U6, 0x02 + + xvand.v $xr12, $xr2, $xr2 + + xvfmadd.d U2, U1, U4, U2 + xvfsub.d U2, U2, $xr12 + + xvpermi.d U4, U2, 0x01 + xvpermi.d U5, U2, 0x02 + xvpermi.d U6, U2, 0x03 + + fadd.d $f2, $f2, $f4 + fadd.d $f2, $f2, $f5 + fadd.d $f2, $f2, $f6 + fadd.d $f2, $f2, $f12 + + xvreplve0.d U2, U2 + + slli.d T2, INCX, 2 + add.d IX, IX, T2 + + addi.d II, II, 32 + +.L04: /* &2 */ + sub.d T0, M, J + addi.d T0, T0, -1 + andi T0, T0, 2 + beq $r0, T0, .L05 + + mul.d T1, J, LDA + add.d T1, T1, II + + vldx $vr1, AO1, T1 + + add.d T1, IY, INCY + add.d T2, T1, INCY + + fldx.d $f6, Y, T1 + fldx.d $f7, Y, T2 + + vextrins.d $vr6, $vr7, 0x10 + vfmadd.d $vr6, $vr3, $vr1, $vr6 + vextrins.d $vr7, $vr6, 0x01 + + fstx.d $f6, Y, T1 + fstx.d $f7, Y, T2 + + slli.d T1, INCY, 1 + add.d IY, IY, T1 + + add.d T1, IX, INCX + add.d T2, T1, INCX + + fldx.d $f6, X, T1 + fldx.d $f7, X, T2 + + vextrins.d $vr6, $vr7, 0x10 + vand.v $vr12, $vr2, $vr2 + + vfmadd.d $vr2, $vr1, $vr6, $vr2 + vfsub.d $vr2, $vr2, $vr12 + + vextrins.d $vr4, $vr2, 0x01 + fadd.d $f2, $f2, $f4 + fadd.d $f2, $f2, $f12 + + vextrins.d $vr2, $vr2, 0x10 + + slli.d T2, INCX, 1 + add.d IX, IX, T2 + + addi.d II, II, 16 + +.L05: /* &1 */ + sub.d T0, M, J + addi.d T0, T0, -1 + andi T0, T0, 1 + beq $r0, T0, .L06 + + mul.d T1, J, LDA + add.d T1, T1, II + + fldx.d $f4, AO1, T1 + add.d IY, IY, INCY + fldx.d $f6, Y, IY + fmadd.d $f6, $f3, $f4, $f6 + fstx.d $f6, Y, IY + + add.d IX, IX, INCX + fldx.d $f6, X, IX + fmadd.d $f2, $f4, $f6, $f2 + + addi.d II, II, 8 + +.L06: + fldx.d $f6, Y, JY + fmadd.d $f6, ALPHA, $f2, $f6 + fstx.d $f6, Y, JY + + add.d JX, JX, INCX + add.d JY, JY, INCY + + addi.d J, J, 1 + blt J, N, .L01 + +.L999: + LDARG $r23, $sp, 0 + LDARG $r24, $sp, 8 + LDARG $r25, $sp, 16 + LDARG $r26, $sp, 32 + LDARG $r27, $sp, 40 + LDARG $r28, $sp, 48 + LDARG $r29, $sp, 56 + LDARG $r30, $sp, 64 + LDARG $r31, $sp, 72 + + addi.d $sp, $sp, 88 + jirl $r0, $r1, 0x0 + + EPILOGUE \ No newline at end of file diff --git a/kernel/loongarch64/dsymv_U_lasx.S b/kernel/loongarch64/dsymv_U_lasx.S new file mode 100644 index 000000000..57eb90aae --- /dev/null +++ b/kernel/loongarch64/dsymv_U_lasx.S @@ -0,0 +1,428 @@ +/******************************************************************************* +Copyright (c) 2024, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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. +*******************************************************************************/ + +#define ASSEMBLER + +#include "common.h" + +/* Param */ +#define M $r4 +#define N $r5 +#define A $r6 +#define LDA $r7 +#define X $r8 +#define INCX $r9 +#define Y $r10 +#define INCY $r11 +#define BUFFER $r16 +#define ALPHA $f0 + +#define JY $r18 +#define JX $r31 +#define T0 $r19 +#define T1 $r20 +#define M1 $r12 +#define AO4 $r13 +#define I $r14 +#define J $r15 +#define AO1 $r23 +#define AO2 $r24 +#define IX $r25 +#define IY $r26 +#define II $r27 +#define T2 $r28 +#define T3 $r29 +#define T4 $r30 + +/* LSX vectors */ +#define U0 $xr31 +#define U1 $xr1 +#define U2 $xr2 +#define U3 $xr3 +#define U4 $xr4 +#define U5 $xr5 +#define U6 $xr6 +#define U7 $xr7 +#define U8 $xr8 +#define U9 $xr9 +#define U10 $xr10 +#define U11 $xr11 +#define U12 $xr12 +#define U13 $xr13 +#define U14 $xr14 +#define U15 $xr15 +#define U16 $xr16 +#define VALPHA $xr17 + +#define a2 $f2 +#define a3 $f3 +#define a4 $f4 +#define a5 $f5 +#define a6 $f6 +#define a7 $f7 +#define a8 $f8 +#define a9 $f9 + + + PROLOGUE + + LDARG BUFFER, $sp, 0 + + addi.d $sp, $sp, -88 + + SDARG $r23, $sp, 0 + SDARG $r24, $sp, 8 + SDARG $r25, $sp, 16 + SDARG $r26, $sp, 32 + SDARG $r27, $sp, 40 + SDARG $r28, $sp, 48 + SDARG $r29, $sp, 56 + SDARG $r30, $sp, 64 + SDARG $r31, $sp, 72 + ST ALPHA, $sp, 80 + + xvldrepl.d VALPHA, $sp, 80 + + slli.d LDA, LDA, BASE_SHIFT + slli.d INCX, INCX, BASE_SHIFT + slli.d INCY, INCY, BASE_SHIFT + + bge $r0, M, .L999 + bge $r0, N, .L999 + + sub.d M1, M, N + + mul.d JY, M1, INCY + mul.d JX, M1, INCX + + move J, M1 + move AO1, A + + beq J, M, .L999 + +.L01: + MTC $f2, $r0 //temp2 + fldx.d $f6, X, JX + fmul.d $f3, ALPHA, $f6 //temp1 + xvreplve0.d U3, U3 + xvreplve0.d U2, U2 + + move IY, $r0 + move IX, $r0 + move II, $r0 + move I, $r0 + + srai.d T0, J, 3 + beq I, T0, .L03 + + mul.d T1, J, LDA + add.d T1, T1, II + +.L02: /* /8 */ + xvldx U1, AO1, T1 + addi.d T1, T1, 32 + xvldx U14, AO1, T1 + addi.d T1, T1, 32 + + fldx.d $f4, Y, IY + add.d T2, IY, INCY + fldx.d $f5, Y, T2 + add.d T2, T2, INCY + fldx.d $f6, Y, T2 + add.d T2, T2, INCY + fldx.d $f7, Y, T2 + + add.d T2, T2, INCY + fldx.d $f8, Y, T2 + add.d T2, T2, INCY + fldx.d $f9, Y, T2 + add.d T2, T2, INCY + fldx.d $f10, Y, T2 + add.d T2, T2, INCY + fldx.d $f11, Y, T2 + + vextrins.d $vr4, $vr5, 0x10 + vextrins.d $vr6, $vr7, 0x10 + xvpermi.q U4, U6, 0x02 + + vextrins.d $vr8, $vr9, 0x10 + vextrins.d $vr10, $vr11, 0x10 + xvpermi.q U8, U10, 0x02 + + xvfmadd.d U4, U3, U1, U4 + xvfmadd.d U8, U3, U14, U8 + + xvpermi.d U6, U4, 0xee + vextrins.d $vr5, $vr4, 0x01 + vextrins.d $vr7, $vr6, 0x01 + + xvpermi.d U10, U8, 0xee + vextrins.d $vr9, $vr8, 0x01 + vextrins.d $vr11, $vr10, 0x01 + + fstx.d $f4, Y, IY + add.d T2, IY, INCY + fstx.d $f5, Y, T2 + add.d T2, T2, INCY + fstx.d $f6, Y, T2 + add.d T2, T2, INCY + fstx.d $f7, Y, T2 + + add.d T2, T2, INCY + fstx.d $f8, Y, T2 + add.d T2, T2, INCY + fstx.d $f9, Y, T2 + add.d T2, T2, INCY + fstx.d $f10, Y, T2 + add.d T2, T2, INCY + fstx.d $f11, Y, T2 + + slli.d T2, INCY, 3 + add.d IY, IY, T2 + + fldx.d $f4, X, IX + add.d T2, IX, INCX + fldx.d $f5, X, T2 + add.d T2, T2, INCX + fldx.d $f6, X, T2 + add.d T2, T2, INCX + fldx.d $f7, X, T2 + + add.d T2, T2, INCX + fldx.d $f8, X, T2 + add.d T2, T2, INCX + fldx.d $f9, X, T2 + add.d T2, T2, INCX + fldx.d $f10, X, T2 + add.d T2, T2, INCX + fldx.d $f11, X, T2 + + vextrins.d $vr4, $vr5, 0x10 + vextrins.d $vr6, $vr7, 0x10 + xvpermi.q U4, U6, 0x02 + + vextrins.d $vr8, $vr9, 0x10 + vextrins.d $vr10, $vr11, 0x10 + xvpermi.q U8, U10, 0x02 + + xvand.v $xr12, $xr2, $xr2 + + xvfmadd.d U2, U1, U4, U2 + xvfsub.d U2, U2, $xr12 + xvfmadd.d U2, U14, U8, U2 + + xvpermi.d U4, U2, 0x01 + xvpermi.d U5, U2, 0x02 + xvpermi.d U6, U2, 0x03 + + fadd.d $f2, $f2, $f4 + fadd.d $f2, $f2, $f5 + fadd.d $f2, $f2, $f6 + fadd.d $f2, $f2, $f12 + + xvreplve0.d U2, U2 + + slli.d T2, INCX, 3 + add.d IX, IX, T2 + + addi.d II, II, 64 + addi.d I, I, 1 + blt I, T0, .L02 + +.L03: /* &4 */ + andi T0, J, 4 + beq $r0, T0, .L04 + + mul.d T1, J, LDA + add.d T1, T1, II + + xvldx U1, AO1, T1 + + move T1, IY + add.d T2, T1, INCY + add.d T3, T2, INCY + add.d T4, T3, INCY + + fldx.d $f4, Y, T1 + fldx.d $f5, Y, T2 + fldx.d $f6, Y, T3 + fldx.d $f7, Y, T4 + + vextrins.d $vr4, $vr5, 0x10 + vextrins.d $vr6, $vr7, 0x10 + xvpermi.q U4, U6, 0x02 + + xvfmadd.d U4, U3, U1, U4 + + xvpermi.d U6, U4, 0xee + vextrins.d $vr5, $vr4, 0x01 + vextrins.d $vr7, $vr6, 0x01 + + fstx.d $f4, Y, T1 + fstx.d $f5, Y, T2 + fstx.d $f6, Y, T3 + fstx.d $f7, Y, T4 + + slli.d T1, INCY, 2 + add.d IY, IY, T1 + + move T1, IX + add.d T2, T1, INCX + add.d T3, T2, INCX + add.d T4, T3, INCX + + fldx.d $f4, X, T1 + fldx.d $f5, X, T2 + fldx.d $f6, X, T3 + fldx.d $f7, X, T4 + + vextrins.d $vr4, $vr5, 0x10 + vextrins.d $vr6, $vr7, 0x10 + xvpermi.q U4, U6, 0x02 + + xvand.v $xr12, $xr2, $xr2 + + xvfmadd.d U2, U1, U4, U2 + xvfsub.d U2, U2, $xr12 + + xvpermi.d U4, U2, 0x01 + xvpermi.d U5, U2, 0x02 + xvpermi.d U6, U2, 0x03 + + fadd.d $f2, $f2, $f4 + fadd.d $f2, $f2, $f5 + fadd.d $f2, $f2, $f6 + fadd.d $f2, $f2, $f12 + + xvreplve0.d U2, U2 + + slli.d T2, INCX, 2 + add.d IX, IX, T2 + + addi.d II, II, 32 + +.L04: /* &2 */ + andi T0, J, 2 + beq $r0, T0, .L05 + + mul.d T1, J, LDA + add.d T1, T1, II + + vldx $vr1, AO1, T1 + + move T1, IY + add.d T2, T1, INCY + + fldx.d $f6, Y, T1 + fldx.d $f7, Y, T2 + + vextrins.d $vr6, $vr7, 0x10 + vfmadd.d $vr6, $vr3, $vr1, $vr6 + vextrins.d $vr7, $vr6, 0x01 + + fstx.d $f6, Y, T1 + fstx.d $f7, Y, T2 + + slli.d T1, INCY, 1 + add.d IY, IY, T1 + + move T1, IX + add.d T2, T1, INCX + + fldx.d $f6, X, T1 + fldx.d $f7, X, T2 + + vextrins.d $vr6, $vr7, 0x10 + vand.v $vr12, $vr2, $vr2 + + vfmadd.d $vr2, $vr1, $vr6, $vr2 + vfsub.d $vr2, $vr2, $vr12 + + vextrins.d $vr4, $vr2, 0x01 + fadd.d $f2, $f2, $f4 + fadd.d $f2, $f2, $f12 + + xvreplve0.d U2, U2 + + slli.d T2, INCX, 1 + add.d IX, IX, T2 + + addi.d II, II, 16 + +.L05: /* &1 */ + andi T0, J, 1 + beq $r0, T0, .L06 + + mul.d T1, J, LDA + add.d T1, T1, II + + fldx.d $f4, AO1, T1 + fldx.d $f6, Y, IY + fmadd.d $f6, $f3, $f4, $f6 + fstx.d $f6, Y, IY + add.d IY, IY, INCY + + fldx.d $f6, X, IX + fmadd.d $f2, $f4, $f6, $f2 + add.d IX, IX, INCX + + addi.d II, II, 8 + +.L06: + mul.d T1, J, LDA + slli.d T2, J, BASE_SHIFT + add.d T1, T1, T2 + + fldx.d $f6, Y, JY + fldx.d $f4, AO1, T1 + fmadd.d $f6, $f3, $f4, $f6 + fmul.d $f7, ALPHA, $f2 + fadd.d $f6, $f6, $f7 + + fstx.d $f6, Y, JY + + add.d JX, JX, INCX + add.d JY, JY, INCY + + addi.d J, J, 1 + blt J, M, .L01 + +.L999: + LDARG $r23, $sp, 0 + LDARG $r24, $sp, 8 + LDARG $r25, $sp, 16 + LDARG $r26, $sp, 32 + LDARG $r27, $sp, 40 + LDARG $r28, $sp, 48 + LDARG $r29, $sp, 56 + LDARG $r30, $sp, 64 + LDARG $r31, $sp, 72 + + addi.d $sp, $sp, 88 + jirl $r0, $r1, 0x0 + + EPILOGUE \ No newline at end of file diff --git a/kernel/loongarch64/ssymv_L_lasx.S b/kernel/loongarch64/ssymv_L_lasx.S new file mode 100644 index 000000000..980c10fd7 --- /dev/null +++ b/kernel/loongarch64/ssymv_L_lasx.S @@ -0,0 +1,436 @@ +/******************************************************************************* +Copyright (c) 2024, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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. +*******************************************************************************/ + +#define ASSEMBLER + +#include "common.h" + +/* Param */ +#define M $r4 +#define N $r5 +#define A $r6 +#define LDA $r7 +#define X $r8 +#define INCX $r9 +#define Y $r10 +#define INCY $r11 +#define BUFFER $r16 +#define ALPHA $f0 + +#define JY $r18 +#define JX $r31 +#define T0 $r19 +#define T1 $r20 +#define AO3 $r12 +#define AO4 $r13 +#define I $r14 +#define J $r15 +#define AO1 $r23 +#define AO2 $r24 +#define IX $r25 +#define IY $r26 +#define II $r27 +#define T2 $r28 +#define T3 $r29 +#define T4 $r30 + +/* LSX vectors */ +#define U0 $xr31 +#define U1 $xr1 +#define U2 $xr2 +#define U3 $xr3 +#define U4 $xr4 +#define U5 $xr5 +#define U6 $xr6 +#define U7 $xr7 +#define U8 $xr8 +#define U9 $xr9 +#define U10 $xr10 +#define U11 $xr11 +#define U12 $xr12 +#define U13 $xr13 +#define U14 $xr14 +#define U15 $xr15 +#define U16 $xr16 +#define VALPHA $xr17 + +#define a2 $f2 +#define a3 $f3 +#define a4 $f4 +#define a5 $f5 +#define a6 $f6 +#define a7 $f7 +#define a8 $f8 +#define a9 $f9 + + + PROLOGUE + + LDARG BUFFER, $sp, 0 + + addi.d $sp, $sp, -88 + + SDARG $r23, $sp, 0 + SDARG $r24, $sp, 8 + SDARG $r25, $sp, 16 + SDARG $r26, $sp, 32 + SDARG $r27, $sp, 40 + SDARG $r28, $sp, 48 + SDARG $r29, $sp, 56 + SDARG $r30, $sp, 64 + SDARG $r31, $sp, 72 + ST ALPHA, $sp, 80 + + xvldrepl.w VALPHA, $sp, 80 + + slli.d LDA, LDA, BASE_SHIFT + slli.d INCX, INCX, BASE_SHIFT + slli.d INCY, INCY, BASE_SHIFT + + bge $r0, M, .L999 + bge $r0, N, .L999 + + move J, $r0 + move JY, $r0 + move JX, $r0 + move AO1, A + + beq J, N, .L999 + +.L01: + MTC a2, $r0 //temp2 + fldx.s a6, X, JX + fmul.s a3, ALPHA, a6 //temp1 + xvreplve0.w U3, U3 + xvreplve0.w U2, U2 + + mul.w T0, J, LDA + slli.d T1, J, BASE_SHIFT + add.w T0, T0, T1 + fldx.s a6, AO1, T0 + fldx.s a4, Y, JY + fmadd.s a4, a3, a6, a4 + fstx.s a4, Y, JY + + move IY, JY + move IX, JX + addi.d II, J, 1 + move I, II + slli.d II, II, BASE_SHIFT + + sub.d T0, M, J + addi.d T0, T0, -1 + srai.d T0, T0, 3 + add.d T0, T0, J + addi.d T0, T0, 1 + beq I, T0, .L03 + bge I, T0, .L03 + + mul.w T1, J, LDA + add.d T1, T1, II + +.L02: /* /8 */ + xvldx U1, AO1, T1 + + add.d T2, IY, INCY + fldx.s $f4, Y, T2 + add.d T2, T2, INCY + fldx.s $f5, Y, T2 + add.d T2, T2, INCY + fldx.s $f6, Y, T2 + add.d T2, T2, INCY + fldx.s $f7, Y, T2 + + add.d T2, T2, INCY + fldx.s $f8, Y, T2 + add.d T2, T2, INCY + fldx.s $f9, Y, T2 + add.d T2, T2, INCY + fldx.s $f10, Y, T2 + add.d T2, T2, INCY + fldx.s $f11, Y, T2 + + vextrins.w $vr4, $vr5, 0x10 + vextrins.w $vr4, $vr6, 0x20 + vextrins.w $vr4, $vr7, 0x30 + vextrins.w $vr8, $vr9, 0x10 + vextrins.w $vr8, $vr10, 0x20 + vextrins.w $vr8, $vr11, 0x30 + xvpermi.q U4, U8, 0x02 + + xvfmadd.s U4, U3, U1, U4 + + xvpermi.d U8, U4, 0xee + vextrins.w $vr5, $vr4, 0x01 + vextrins.w $vr6, $vr4, 0x02 + vextrins.w $vr7, $vr4, 0x03 + vextrins.w $vr9, $vr8, 0x01 + vextrins.w $vr10, $vr8, 0x02 + vextrins.w $vr11, $vr8, 0x03 + + add.d T2, IY, INCY + fstx.s $f4, Y, T2 + add.d T2, T2, INCY + fstx.s $f5, Y, T2 + add.d T2, T2, INCY + fstx.s $f6, Y, T2 + add.d T2, T2, INCY + fstx.s $f7, Y, T2 + + add.d T2, T2, INCY + fstx.s $f8, Y, T2 + add.d T2, T2, INCY + fstx.s $f9, Y, T2 + add.d T2, T2, INCY + fstx.s $f10, Y, T2 + add.d T2, T2, INCY + fstx.s $f11, Y, T2 + + slli.d T2, INCY, 3 + add.d IY, IY, T2 + + add.d T2, IX, INCX + fldx.s $f4, X, T2 + add.d T2, T2, INCX + fldx.s $f5, X, T2 + add.d T2, T2, INCX + fldx.s $f6, X, T2 + add.d T2, T2, INCX + fldx.s $f7, X, T2 + + add.d T2, T2, INCX + fldx.s $f8, X, T2 + add.d T2, T2, INCX + fldx.s $f9, X, T2 + add.d T2, T2, INCX + fldx.s $f10, X, T2 + add.d T2, T2, INCX + fldx.s $f11, X, T2 + + vextrins.w $vr4, $vr5, 0x10 + vextrins.w $vr4, $vr6, 0x20 + vextrins.w $vr4, $vr7, 0x30 + vextrins.w $vr8, $vr9, 0x10 + vextrins.w $vr8, $vr10, 0x20 + vextrins.w $vr8, $vr11, 0x30 + xvpermi.q U4, U8, 0x02 + + xvand.v $xr12, $xr2, $xr2 + + xvfmadd.s U2, U1, U4, U2 + xvfsub.s U2, U2, $xr12 + + xvpickve.w U4, U2, 0x01 + xvpickve.w U5, U2, 0x02 + xvpickve.w U6, U2, 0x03 + xvpickve.w U7, U2, 0x04 + xvpickve.w U8, U2, 0x05 + xvpickve.w U9, U2, 0x06 + xvpickve.w U10, U2, 0x07 + + fadd.s $f2, $f2, $f4 + fadd.s $f2, $f2, $f5 + fadd.s $f2, $f2, $f6 + fadd.s $f2, $f2, $f7 + fadd.s $f2, $f2, $f8 + fadd.s $f2, $f2, $f9 + fadd.s $f2, $f2, $f10 + fadd.s $f2, $f2, $f12 + + xvreplve0.d U2, U2 + + slli.d T2, INCX, 3 + add.d IX, IX, T2 + + addi.d II, II, 32 + addi.d T1, T1, 32 + addi.d I, I, 1 + blt I, T0, .L02 + +.L03: /* &4 */ + sub.d T0, M, J + addi.d T0, T0, -1 + andi T0, T0, 4 + beq $r0, T0, .L04 + + mul.w T1, J, LDA + add.d T1, T1, II + + vldx $vr1, AO1, T1 + + add.d T1, IY, INCY + add.d T2, T1, INCY + add.d T3, T2, INCY + add.d T4, T3, INCY + + fldx.s $f4, Y, T1 + fldx.s $f5, Y, T2 + fldx.s $f6, Y, T3 + fldx.s $f7, Y, T4 + + vextrins.w $vr4, $vr5, 0x10 + vextrins.w $vr4, $vr6, 0x20 + vextrins.w $vr4, $vr7, 0x30 + + vfmadd.s $vr4, $vr3, $vr1, $vr4 + + vextrins.w $vr5, $vr4, 0x01 + vextrins.w $vr6, $vr4, 0x02 + vextrins.w $vr7, $vr4, 0x03 + + fstx.s $f4, Y, T1 + fstx.s $f5, Y, T2 + fstx.s $f6, Y, T3 + fstx.s $f7, Y, T4 + + slli.d T1, INCY, 2 + add.d IY, IY, T1 + + add.d T1, IX, INCX + add.d T2, T1, INCX + add.d T3, T2, INCX + add.d T4, T3, INCX + + fldx.s $f4, X, T1 + fldx.s $f5, X, T2 + fldx.s $f6, X, T3 + fldx.s $f7, X, T4 + + vextrins.w $vr4, $vr5, 0x10 + vextrins.w $vr4, $vr6, 0x20 + vextrins.w $vr4, $vr7, 0x30 + + vand.v $vr12, $vr2, $vr2 + + vfmadd.s $vr2, $vr1, $vr4, $vr2 + vfsub.s $vr2, $vr2, $vr12 + + vextrins.w $vr5, $vr2, 0x01 + vextrins.w $vr6, $vr2, 0x02 + vextrins.w $vr7, $vr2, 0x03 + + fadd.s $f2, $f2, $f5 + fadd.s $f2, $f2, $f6 + fadd.s $f2, $f2, $f7 + fadd.s $f2, $f2, $f12 + + xvreplve0.d U2, U2 + + slli.d T2, INCX, 2 + add.d IX, IX, T2 + + addi.d II, II, 16 + +.L04: /* &2 */ + sub.d T0, M, J + addi.d T0, T0, -1 + andi T0, T0, 2 + beq $r0, T0, .L05 + + mul.w T1, J, LDA + add.d T1, T1, II + addi.d T2, T1, 4 + + fldx.s $f4, AO1, T1 + fldx.s $f5, AO1, T2 + + add.d T1, IY, INCY + add.d T2, T1, INCY + + fldx.s $f6, Y, T1 + fldx.s $f7, Y, T2 + + fmadd.s $f6, $f3, $f4, $f6 + fmadd.s $f7, $f3, $f5, $f7 + + fstx.s $f6, Y, T1 + fstx.s $f7, Y, T2 + + slli.d T1, INCY, 1 + add.d IY, IY, T1 + + add.d T1, IX, INCX + add.d T2, T1, INCX + + fldx.s $f6, X, T1 + fldx.s $f7, X, T2 + + fmadd.s $f2, $f4, $f6, $f2 + fmadd.s $f2, $f5, $f7, $f2 + + slli.d T2, INCX, 1 + add.d IX, IX, T2 + + addi.d II, II, 8 + +.L05: /* &1 */ + sub.d T0, M, J + addi.d T0, T0, -1 + andi T0, T0, 1 + beq $r0, T0, .L06 + + mul.w T1, J, LDA + add.d T1, T1, II + + fldx.s $f4, AO1, T1 + add.d IY, IY, INCY + fldx.s $f6, Y, IY + fmadd.s $f6, $f3, $f4, $f6 + fstx.s $f6, Y, IY + + add.d IX, IX, INCX + fldx.s $f6, X, IX + fmadd.s $f2, $f4, $f6, $f2 + + addi.d II, II, 4 + +.L06: + fldx.s $f6, Y, JY + fmadd.s $f6, ALPHA, $f2, $f6 + fstx.s $f6, Y, JY + + add.d JX, JX, INCX + add.d JY, JY, INCY + + addi.d J, J, 1 + blt J, N, .L01 + +.L999: + LDARG $r23, $sp, 0 + LDARG $r24, $sp, 8 + LDARG $r25, $sp, 16 + LDARG $r26, $sp, 32 + LDARG $r27, $sp, 40 + LDARG $r28, $sp, 48 + LDARG $r29, $sp, 56 + LDARG $r30, $sp, 64 + LDARG $r31, $sp, 72 + + addi.d $sp, $sp, 88 + jirl $r0, $r1, 0x0 + + EPILOGUE \ No newline at end of file diff --git a/kernel/loongarch64/ssymv_U_lasx.S b/kernel/loongarch64/ssymv_U_lasx.S new file mode 100644 index 000000000..bd6fd3dd7 --- /dev/null +++ b/kernel/loongarch64/ssymv_U_lasx.S @@ -0,0 +1,424 @@ +/******************************************************************************* +Copyright (c) 2024, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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. +*******************************************************************************/ + +#define ASSEMBLER + +#include "common.h" + +/* Param */ +#define M $r4 +#define N $r5 +#define A $r6 +#define LDA $r7 +#define X $r8 +#define INCX $r9 +#define Y $r10 +#define INCY $r11 +#define BUFFER $r16 +#define ALPHA $f0 + +#define JY $r18 +#define JX $r31 +#define T0 $r19 +#define T1 $r20 +#define M1 $r12 +#define AO4 $r13 +#define I $r14 +#define J $r15 +#define AO1 $r23 +#define AO2 $r24 +#define IX $r25 +#define IY $r26 +#define II $r27 +#define T2 $r28 +#define T3 $r29 +#define T4 $r30 + +/* LSX vectors */ +#define U0 $xr31 +#define U1 $xr1 +#define U2 $xr2 +#define U3 $xr3 +#define U4 $xr4 +#define U5 $xr5 +#define U6 $xr6 +#define U7 $xr7 +#define U8 $xr8 +#define U9 $xr9 +#define U10 $xr10 +#define U11 $xr11 +#define U12 $xr12 +#define U13 $xr13 +#define U14 $xr14 +#define U15 $xr15 +#define U16 $xr16 +#define VALPHA $xr17 + +#define a2 $f2 +#define a3 $f3 +#define a4 $f4 +#define a5 $f5 +#define a6 $f6 +#define a7 $f7 +#define a8 $f8 +#define a9 $f9 + + + PROLOGUE + + LDARG BUFFER, $sp, 0 + + addi.d $sp, $sp, -88 + + SDARG $r23, $sp, 0 + SDARG $r24, $sp, 8 + SDARG $r25, $sp, 16 + SDARG $r26, $sp, 32 + SDARG $r27, $sp, 40 + SDARG $r28, $sp, 48 + SDARG $r29, $sp, 56 + SDARG $r30, $sp, 64 + SDARG $r31, $sp, 72 + ST ALPHA, $sp, 80 + + xvldrepl.w VALPHA, $sp, 80 + + slli.d LDA, LDA, BASE_SHIFT + slli.d INCX, INCX, BASE_SHIFT + slli.d INCY, INCY, BASE_SHIFT + + bge $r0, M, .L999 + bge $r0, N, .L999 + + sub.d M1, M, N + + mul.d JY, M1, INCY + mul.d JX, M1, INCX + + move J, M1 + move AO1, A + + beq J, M, .L999 + +.L01: + MTC $f2, $r0 //temp2 + fldx.s $f6, X, JX + fmul.s $f3, ALPHA, $f6 //temp1 + xvreplve0.w U3, U3 + xvreplve0.w U2, U2 + + move IY, $r0 + move IX, $r0 + move II, $r0 + move I, $r0 + + srai.d T0, J, 3 + beq I, T0, .L03 + + mul.w T1, J, LDA + add.d T1, T1, II + +.L02: /* /8 */ + xvldx U1, AO1, T1 + + fldx.s $f4, Y, IY + add.d T2, IY, INCY + fldx.s $f5, Y, T2 + add.d T2, T2, INCY + fldx.s $f6, Y, T2 + add.d T2, T2, INCY + fldx.s $f7, Y, T2 + + add.d T2, T2, INCY + fldx.s $f8, Y, T2 + add.d T2, T2, INCY + fldx.s $f9, Y, T2 + add.d T2, T2, INCY + fldx.s $f10, Y, T2 + add.d T2, T2, INCY + fldx.s $f11, Y, T2 + + vextrins.w $vr4, $vr5, 0x10 + vextrins.w $vr4, $vr6, 0x20 + vextrins.w $vr4, $vr7, 0x30 + vextrins.w $vr8, $vr9, 0x10 + vextrins.w $vr8, $vr10, 0x20 + vextrins.w $vr8, $vr11, 0x30 + xvpermi.q U4, U8, 0x02 + + xvfmadd.s U4, U3, U1, U4 + + xvpermi.d U8, U4, 0xee + vextrins.w $vr5, $vr4, 0x01 + vextrins.w $vr6, $vr4, 0x02 + vextrins.w $vr7, $vr4, 0x03 + vextrins.w $vr9, $vr8, 0x01 + vextrins.w $vr10, $vr8, 0x02 + vextrins.w $vr11, $vr8, 0x03 + + fstx.s $f4, Y, IY + add.d T2, IY, INCY + fstx.s $f5, Y, T2 + add.d T2, T2, INCY + fstx.s $f6, Y, T2 + add.d T2, T2, INCY + fstx.s $f7, Y, T2 + + add.d T2, T2, INCY + fstx.s $f8, Y, T2 + add.d T2, T2, INCY + fstx.s $f9, Y, T2 + add.d T2, T2, INCY + fstx.s $f10, Y, T2 + add.d T2, T2, INCY + fstx.s $f11, Y, T2 + + slli.d T2, INCY, 3 + add.d IY, IY, T2 + + fldx.s $f4, X, IX + add.d T2, IX, INCX + fldx.s $f5, X, T2 + add.d T2, T2, INCX + fldx.s $f6, X, T2 + add.d T2, T2, INCX + fldx.s $f7, X, T2 + + add.d T2, T2, INCX + fldx.s $f8, X, T2 + add.d T2, T2, INCX + fldx.s $f9, X, T2 + add.d T2, T2, INCX + fldx.s $f10, X, T2 + add.d T2, T2, INCX + fldx.s $f11, X, T2 + + vextrins.w $vr4, $vr5, 0x10 + vextrins.w $vr4, $vr6, 0x20 + vextrins.w $vr4, $vr7, 0x30 + vextrins.w $vr8, $vr9, 0x10 + vextrins.w $vr8, $vr10, 0x20 + vextrins.w $vr8, $vr11, 0x30 + xvpermi.q U4, U8, 0x02 + + xvand.v $xr12, $xr2, $xr2 + + xvfmadd.s U2, U1, U4, U2 + xvfsub.s U2, U2, $xr12 + + xvpickve.w U4, U2, 0x01 + xvpickve.w U5, U2, 0x02 + xvpickve.w U6, U2, 0x03 + xvpickve.w U7, U2, 0x04 + xvpickve.w U8, U2, 0x05 + xvpickve.w U9, U2, 0x06 + xvpickve.w U10, U2, 0x07 + + fadd.s $f2, $f2, $f4 + fadd.s $f2, $f2, $f5 + fadd.s $f2, $f2, $f6 + fadd.s $f2, $f2, $f7 + fadd.s $f2, $f2, $f8 + fadd.s $f2, $f2, $f9 + fadd.s $f2, $f2, $f10 + fadd.s $f2, $f2, $f12 + + xvreplve0.d U2, U2 + + slli.d T2, INCX, 3 + add.d IX, IX, T2 + + addi.d II, II, 32 + addi.d T1, T1, 32 + addi.d I, I, 1 + blt I, T0, .L02 + +.L03: /* &4 */ + andi T0, J, 4 + beq $r0, T0, .L04 + + mul.w T1, J, LDA + add.d T1, T1, II + + vldx $vr1, AO1, T1 + + move T1, IY + add.d T2, T1, INCY + add.d T3, T2, INCY + add.d T4, T3, INCY + + fldx.s $f4, Y, T1 + fldx.s $f5, Y, T2 + fldx.s $f6, Y, T3 + fldx.s $f7, Y, T4 + + vextrins.w $vr4, $vr5, 0x10 + vextrins.w $vr4, $vr6, 0x20 + vextrins.w $vr4, $vr7, 0x30 + + vfmadd.s $vr4, $vr3, $vr1, $vr4 + + vextrins.w $vr5, $vr4, 0x01 + vextrins.w $vr6, $vr4, 0x02 + vextrins.w $vr7, $vr4, 0x03 + + fstx.s $f4, Y, T1 + fstx.s $f5, Y, T2 + fstx.s $f6, Y, T3 + fstx.s $f7, Y, T4 + + slli.d T1, INCY, 2 + add.d IY, IY, T1 + + move T1, IX + add.d T2, T1, INCX + add.d T3, T2, INCX + add.d T4, T3, INCX + + fldx.s $f4, X, T1 + fldx.s $f5, X, T2 + fldx.s $f6, X, T3 + fldx.s $f7, X, T4 + + vextrins.w $vr4, $vr5, 0x10 + vextrins.w $vr4, $vr6, 0x20 + vextrins.w $vr4, $vr7, 0x30 + + vand.v $vr12, $vr2, $vr2 + + vfmadd.s $vr2, $vr1, $vr4, $vr2 + vfsub.s $vr2, $vr2, $vr12 + + vextrins.w $vr5, $vr2, 0x01 + vextrins.w $vr6, $vr2, 0x02 + vextrins.w $vr7, $vr2, 0x03 + + fadd.s $f2, $f2, $f5 + fadd.s $f2, $f2, $f6 + fadd.s $f2, $f2, $f7 + fadd.s $f2, $f2, $f12 + + xvreplve0.d U2, U2 + + slli.d T2, INCX, 2 + add.d IX, IX, T2 + + addi.d II, II, 16 + +.L04: /* &2 */ + andi T0, J, 2 + beq $r0, T0, .L05 + + mul.w T1, J, LDA + add.d T1, T1, II + addi.d T2, T1, 4 + + fldx.s $f4, AO1, T1 + fldx.s $f5, AO1, T2 + + move T1, IY + add.d T2, T1, INCY + + fldx.s $f6, Y, T1 + fldx.s $f7, Y, T2 + + fmadd.s $f6, $f3, $f4, $f6 + fmadd.s $f7, $f3, $f5, $f7 + + fstx.s $f6, Y, T1 + fstx.s $f7, Y, T2 + + slli.d T1, INCY, 1 + add.d IY, IY, T1 + + move T1, IX + add.d T2, T1, INCX + + fldx.s $f6, X, T1 + fldx.s $f7, X, T2 + + fmadd.s $f2, $f4, $f6, $f2 + fmadd.s $f2, $f5, $f7, $f2 + + slli.d T2, INCX, 1 + add.d IX, IX, T2 + + addi.d II, II, 8 + +.L05: /* &1 */ + andi T0, J, 1 + beq $r0, T0, .L06 + + mul.w T1, J, LDA + add.d T1, T1, II + + fldx.s $f4, AO1, T1 + fldx.s $f6, Y, IY + fmadd.s $f6, $f3, $f4, $f6 + fstx.s $f6, Y, IY + add.d IY, IY, INCY + + fldx.s $f6, X, IX + fmadd.s $f2, $f4, $f6, $f2 + add.d IX, IX, INCX + + addi.d II, II, 4 + +.L06: + mul.w T1, J, LDA + slli.d T2, J, BASE_SHIFT + add.d T1, T1, T2 + + fldx.s $f6, Y, JY + fldx.s $f4, AO1, T1 + fmadd.s $f6, $f3, $f4, $f6 + fmul.s $f7, ALPHA, $f2 + fadd.s $f6, $f6, $f7 + + fstx.s $f6, Y, JY + + add.d JX, JX, INCX + add.d JY, JY, INCY + + addi.d J, J, 1 + blt J, M, .L01 + +.L999: + LDARG $r23, $sp, 0 + LDARG $r24, $sp, 8 + LDARG $r25, $sp, 16 + LDARG $r26, $sp, 32 + LDARG $r27, $sp, 40 + LDARG $r28, $sp, 48 + LDARG $r29, $sp, 56 + LDARG $r30, $sp, 64 + LDARG $r31, $sp, 72 + + addi.d $sp, $sp, 88 + jirl $r0, $r1, 0x0 + + EPILOGUE \ No newline at end of file From 680a77fafc322696f07dcf18c1ca0247c5613a12 Mon Sep 17 00:00:00 2001 From: pengxu Date: Tue, 5 Mar 2024 20:36:59 +0800 Subject: [PATCH 205/311] Optimized ssymv and dsymv kernel LSX for LoongArch --- kernel/loongarch64/KERNEL.LOONGSON2K1000 | 6 + kernel/loongarch64/dsymv_L_lsx.S | 432 +++++++++++++++++++++++ kernel/loongarch64/dsymv_U_lsx.S | 420 ++++++++++++++++++++++ kernel/loongarch64/ssymv_L_lsx.S | 429 ++++++++++++++++++++++ kernel/loongarch64/ssymv_U_lsx.S | 417 ++++++++++++++++++++++ 5 files changed, 1704 insertions(+) create mode 100644 kernel/loongarch64/dsymv_L_lsx.S create mode 100644 kernel/loongarch64/dsymv_U_lsx.S create mode 100644 kernel/loongarch64/ssymv_L_lsx.S create mode 100644 kernel/loongarch64/ssymv_U_lsx.S diff --git a/kernel/loongarch64/KERNEL.LOONGSON2K1000 b/kernel/loongarch64/KERNEL.LOONGSON2K1000 index 5b54a2ada..068b3cf4c 100644 --- a/kernel/loongarch64/KERNEL.LOONGSON2K1000 +++ b/kernel/loongarch64/KERNEL.LOONGSON2K1000 @@ -88,9 +88,15 @@ ZSUMKERNEL = csum_lsx.S SGEMVNKERNEL = sgemv_n_lsx.S SGEMVTKERNEL = sgemv_t_lsx.S +SSYMV_U_KERNEL = ssymv_U_lsx.S +SSYMV_L_KERNEL = ssymv_L_lsx.S + DGEMVNKERNEL = dgemv_n_lsx.S DGEMVTKERNEL = dgemv_t_lsx.S +DSYMV_U_KERNEL = dsymv_U_lsx.S +DSYMV_L_KERNEL = dsymv_L_lsx.S + DGEMMKERNEL = dgemm_kernel_8x4.S DGEMMINCOPY = dgemm_ncopy_8_lsx.S DGEMMITCOPY = dgemm_tcopy_8_lsx.S diff --git a/kernel/loongarch64/dsymv_L_lsx.S b/kernel/loongarch64/dsymv_L_lsx.S new file mode 100644 index 000000000..1fd0d26f5 --- /dev/null +++ b/kernel/loongarch64/dsymv_L_lsx.S @@ -0,0 +1,432 @@ +/******************************************************************************* +Copyright (c) 2024, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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. +*******************************************************************************/ + +#define ASSEMBLER + +#include "common.h" + +/* Param */ +#define M $r4 +#define N $r5 +#define A $r6 +#define LDA $r7 +#define X $r8 +#define INCX $r9 +#define Y $r10 +#define INCY $r11 +#define BUFFER $r16 +#define ALPHA $f0 + +#define JY $r18 +#define JX $r31 +#define T0 $r19 +#define T1 $r20 +#define AO3 $r12 +#define AO4 $r13 +#define I $r14 +#define J $r15 +#define AO1 $r23 +#define AO2 $r24 +#define IX $r25 +#define IY $r26 +#define II $r27 +#define T2 $r28 +#define T3 $r29 +#define T4 $r30 + +/* LSX vectors */ +#define U0 $vr31 +#define U1 $vr1 +#define U2 $vr2 +#define U3 $vr3 +#define U4 $vr4 +#define U5 $vr5 +#define U6 $vr6 +#define U7 $vr7 +#define U8 $vr8 +#define U9 $vr9 +#define U10 $vr10 +#define U11 $vr11 +#define U12 $vr12 +#define U13 $vr13 +#define U14 $vr14 +#define U15 $vr15 +#define U16 $vr16 +#define VALPHA $vr17 + +#define a2 $f2 +#define a3 $f3 +#define a4 $f4 +#define a5 $f5 +#define a6 $f6 +#define a7 $f7 +#define a8 $f8 +#define a9 $f9 + + + PROLOGUE + + LDARG BUFFER, $sp, 0 + + addi.d $sp, $sp, -88 + + SDARG $r23, $sp, 0 + SDARG $r24, $sp, 8 + SDARG $r25, $sp, 16 + SDARG $r26, $sp, 32 + SDARG $r27, $sp, 40 + SDARG $r28, $sp, 48 + SDARG $r29, $sp, 56 + SDARG $r30, $sp, 64 + SDARG $r31, $sp, 72 + ST ALPHA, $sp, 80 + + vldrepl.d VALPHA, $sp, 80 + + slli.d LDA, LDA, BASE_SHIFT + slli.d INCX, INCX, BASE_SHIFT + slli.d INCY, INCY, BASE_SHIFT + + bge $r0, M, .L999 + bge $r0, N, .L999 + + move J, $r0 + move JY, $r0 + move JX, $r0 + move AO1, A + + beq J, N, .L999 + +.L01: + MTC a2, $r0 //temp2 + fldx.d a6, X, JX + fmul.d a3, ALPHA, a6 //temp1 + vshuf4i.d U3, U3, 0x00 + vshuf4i.d U2, U2, 0x00 + + mul.d T0, J, LDA + slli.d T1, J, BASE_SHIFT + add.d T0, T0, T1 + fldx.d a6, AO1, T0 + fldx.d a4, Y, JY + fmadd.d a4, a3, a6, a4 + fstx.d a4, Y, JY + + move IY, JY + move IX, JX + addi.d II, J, 1 + move I, II + slli.d II, II, BASE_SHIFT + + sub.d T0, M, J + addi.d T0, T0, -1 + srai.d T0, T0, 3 + add.d T0, T0, J + addi.d T0, T0, 1 + beq I, T0, .L03 + bge I, T0, .L03 + + mul.d T1, J, LDA + add.d T1, T1, II + +.L02: /* /8 */ + vldx U1, AO1, T1 + addi.d T1, T1, 16 + vldx U14, AO1, T1 + addi.d T1, T1, 16 + vldx U15, AO1, T1 + addi.d T1, T1, 16 + vldx U16, AO1, T1 + addi.d T1, T1, 16 + + add.d T2, IY, INCY + fldx.d $f4, Y, T2 + add.d T2, T2, INCY + fldx.d $f5, Y, T2 + add.d T2, T2, INCY + fldx.d $f6, Y, T2 + add.d T2, T2, INCY + fldx.d $f7, Y, T2 + + add.d T2, T2, INCY + fldx.d $f8, Y, T2 + add.d T2, T2, INCY + fldx.d $f9, Y, T2 + add.d T2, T2, INCY + fldx.d $f10, Y, T2 + add.d T2, T2, INCY + fldx.d $f11, Y, T2 + + vextrins.d U4, U5, 0x10 + vextrins.d U6, U7, 0x10 + vextrins.d U8, U9, 0x10 + vextrins.d U10, U11, 0x10 + + vfmadd.d U4, U3, U1, U4 + vfmadd.d U6, U3, U14, U6 + vfmadd.d U8, U3, U15, U8 + vfmadd.d U10, U3, U16, U10 + + vextrins.d U5, U4, 0x01 + vextrins.d U7, U6, 0x01 + vextrins.d U9, U8, 0x01 + vextrins.d U11, U10, 0x01 + + add.d T2, IY, INCY + fstx.d $f4, Y, T2 + add.d T2, T2, INCY + fstx.d $f5, Y, T2 + add.d T2, T2, INCY + fstx.d $f6, Y, T2 + add.d T2, T2, INCY + fstx.d $f7, Y, T2 + + add.d T2, T2, INCY + fstx.d $f8, Y, T2 + add.d T2, T2, INCY + fstx.d $f9, Y, T2 + add.d T2, T2, INCY + fstx.d $f10, Y, T2 + add.d T2, T2, INCY + fstx.d $f11, Y, T2 + + slli.d T2, INCY, 3 + add.d IY, IY, T2 + + add.d T2, IX, INCX + fldx.d $f4, X, T2 + add.d T2, T2, INCX + fldx.d $f5, X, T2 + add.d T2, T2, INCX + fldx.d $f6, X, T2 + add.d T2, T2, INCX + fldx.d $f7, X, T2 + + add.d T2, T2, INCX + fldx.d $f8, X, T2 + add.d T2, T2, INCX + fldx.d $f9, X, T2 + add.d T2, T2, INCX + fldx.d $f10, X, T2 + add.d T2, T2, INCX + fldx.d $f11, X, T2 + + vextrins.d U4, U5, 0x10 + vextrins.d U6, U7, 0x10 + vextrins.d U8, U9, 0x10 + vextrins.d U10, U11, 0x10 + + vand.v $vr12, $vr2, $vr2 + + vfmadd.d U2, U1, U4, U2 + vfsub.d U2, U2, $vr12 + vfmadd.d U2, U14, U6, U2 + vfmadd.d U2, U15, U8, U2 + vfmadd.d U2, U16, U10, U2 + + vextrins.d U4, U2, 0x01 + + fadd.d $f2, $f2, $f4 + fadd.d $f2, $f2, $f12 + + vextrins.d U2, U2, 0x10 + + slli.d T2, INCX, 3 + add.d IX, IX, T2 + + addi.d II, II, 64 + addi.d I, I, 1 + blt I, T0, .L02 + +.L03: /* &4 */ + sub.d T0, M, J + addi.d T0, T0, -1 + andi T0, T0, 4 + beq $r0, T0, .L04 + + mul.d T1, J, LDA + add.d T1, T1, II + addi.d T2, T1, 16 + + vldx U1, AO1, T1 + vldx U14, AO1, T2 + + add.d T1, IY, INCY + add.d T2, T1, INCY + add.d T3, T2, INCY + add.d T4, T3, INCY + + fldx.d $f4, Y, T1 + fldx.d $f5, Y, T2 + fldx.d $f6, Y, T3 + fldx.d $f7, Y, T4 + + vextrins.d U4, U5, 0x10 + vextrins.d U6, U7, 0x10 + + vfmadd.d U4, U3, U1, U4 + vfmadd.d U6, U3, U14, U6 + + vextrins.d U5, U4, 0x01 + vextrins.d U7, U6, 0x01 + + fstx.d $f4, Y, T1 + fstx.d $f5, Y, T2 + fstx.d $f6, Y, T3 + fstx.d $f7, Y, T4 + + slli.d T1, INCY, 2 + add.d IY, IY, T1 + + add.d T1, IX, INCX + add.d T2, T1, INCX + add.d T3, T2, INCX + add.d T4, T3, INCX + + fldx.d $f4, X, T1 + fldx.d $f5, X, T2 + fldx.d $f6, X, T3 + fldx.d $f7, X, T4 + + vextrins.d U4, U5, 0x10 + vextrins.d U6, U7, 0x10 + + vand.v $vr12, $vr2, $vr2 + + vfmadd.d U2, U1, U4, U2 + vfsub.d U2, U2, $vr12 + vfmadd.d U2, U14, U6, U2 + + vextrins.d U4, U2, 0x01 + + fadd.d $f2, $f2, $f4 + fadd.d $f2, $f2, $f12 + + vextrins.d U2, U2, 0x10 + + slli.d T2, INCX, 2 + add.d IX, IX, T2 + + addi.d II, II, 32 + +.L04: /* &2 */ + sub.d T0, M, J + addi.d T0, T0, -1 + andi T0, T0, 2 + beq $r0, T0, .L05 + + mul.d T1, J, LDA + add.d T1, T1, II + + vldx U1, AO1, T1 + + add.d T1, IY, INCY + add.d T2, T1, INCY + + fldx.d $f6, Y, T1 + fldx.d $f7, Y, T2 + + vextrins.d U6, U7, 0x10 + vfmadd.d U6, U3, U1, U6 + vextrins.d U7, U6, 0x01 + + fstx.d $f6, Y, T1 + fstx.d $f7, Y, T2 + + slli.d T1, INCY, 1 + add.d IY, IY, T1 + + add.d T1, IX, INCX + add.d T2, T1, INCX + + fldx.d $f6, X, T1 + fldx.d $f7, X, T2 + + vextrins.d U6, U7, 0x10 + vand.v U12, U2, U2 + + vfmadd.d U2, U1, U6, U2 + vfsub.d U2, U2, U12 + + vextrins.d U4, U2, 0x01 + fadd.d $f2, $f2, $f4 + fadd.d $f2, $f2, $f12 + + vextrins.d U2, U2, 0x10 + + slli.d T2, INCX, 1 + add.d IX, IX, T2 + + addi.d II, II, 16 + +.L05: /* &1 */ + sub.d T0, M, J + addi.d T0, T0, -1 + andi T0, T0, 1 + beq $r0, T0, .L06 + + mul.d T1, J, LDA + add.d T1, T1, II + + fldx.d $f4, AO1, T1 + add.d IY, IY, INCY + fldx.d $f6, Y, IY + fmadd.d $f6, $f3, $f4, $f6 + fstx.d $f6, Y, IY + + add.d IX, IX, INCX + fldx.d $f6, X, IX + fmadd.d $f2, $f4, $f6, $f2 + + addi.d II, II, 8 + +.L06: + fldx.d $f6, Y, JY + fmadd.d $f6, ALPHA, $f2, $f6 + fstx.d $f6, Y, JY + + add.d JX, JX, INCX + add.d JY, JY, INCY + + addi.d J, J, 1 + blt J, N, .L01 + +.L999: + LDARG $r23, $sp, 0 + LDARG $r24, $sp, 8 + LDARG $r25, $sp, 16 + LDARG $r26, $sp, 32 + LDARG $r27, $sp, 40 + LDARG $r28, $sp, 48 + LDARG $r29, $sp, 56 + LDARG $r30, $sp, 64 + LDARG $r31, $sp, 72 + + addi.d $sp, $sp, 88 + jirl $r0, $r1, 0x0 + + EPILOGUE \ No newline at end of file diff --git a/kernel/loongarch64/dsymv_U_lsx.S b/kernel/loongarch64/dsymv_U_lsx.S new file mode 100644 index 000000000..f708196aa --- /dev/null +++ b/kernel/loongarch64/dsymv_U_lsx.S @@ -0,0 +1,420 @@ +/******************************************************************************* +Copyright (c) 2024, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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. +*******************************************************************************/ + +#define ASSEMBLER + +#include "common.h" + +/* Param */ +#define M $r4 +#define N $r5 +#define A $r6 +#define LDA $r7 +#define X $r8 +#define INCX $r9 +#define Y $r10 +#define INCY $r11 +#define BUFFER $r16 +#define ALPHA $f0 + +#define JY $r18 +#define JX $r31 +#define T0 $r19 +#define T1 $r20 +#define M1 $r12 +#define AO4 $r13 +#define I $r14 +#define J $r15 +#define AO1 $r23 +#define AO2 $r24 +#define IX $r25 +#define IY $r26 +#define II $r27 +#define T2 $r28 +#define T3 $r29 +#define T4 $r30 + +/* LSX vectors */ +#define U0 $vr31 +#define U1 $vr1 +#define U2 $vr2 +#define U3 $vr3 +#define U4 $vr4 +#define U5 $vr5 +#define U6 $vr6 +#define U7 $vr7 +#define U8 $vr8 +#define U9 $vr9 +#define U10 $vr10 +#define U11 $vr11 +#define U12 $vr12 +#define U13 $vr13 +#define U14 $vr14 +#define U15 $vr15 +#define U16 $vr16 +#define VALPHA $vr17 + +#define a2 $f2 +#define a3 $f3 +#define a4 $f4 +#define a5 $f5 +#define a6 $f6 +#define a7 $f7 +#define a8 $f8 +#define a9 $f9 + + + PROLOGUE + + LDARG BUFFER, $sp, 0 + + addi.d $sp, $sp, -88 + + SDARG $r23, $sp, 0 + SDARG $r24, $sp, 8 + SDARG $r25, $sp, 16 + SDARG $r26, $sp, 32 + SDARG $r27, $sp, 40 + SDARG $r28, $sp, 48 + SDARG $r29, $sp, 56 + SDARG $r30, $sp, 64 + SDARG $r31, $sp, 72 + ST ALPHA, $sp, 80 + + vldrepl.d VALPHA, $sp, 80 + + slli.d LDA, LDA, BASE_SHIFT + slli.d INCX, INCX, BASE_SHIFT + slli.d INCY, INCY, BASE_SHIFT + + bge $r0, M, .L999 + bge $r0, N, .L999 + + sub.d M1, M, N + + mul.d JY, M1, INCY + mul.d JX, M1, INCX + + move J, M1 + move AO1, A + + beq J, M, .L999 + +.L01: + MTC $f2, $r0 //temp2 + fldx.d $f6, X, JX + fmul.d $f3, ALPHA, $f6 //temp1 + vshuf4i.d U3, U3, 0x00 + vshuf4i.d U2, U2, 0x00 + + move IY, $r0 + move IX, $r0 + move II, $r0 + move I, $r0 + + srai.d T0, J, 3 + beq I, T0, .L03 + + mul.d T1, J, LDA + add.d T1, T1, II + +.L02: /* /8 */ + vldx U1, AO1, T1 + addi.d T1, T1, 16 + vldx U14, AO1, T1 + addi.d T1, T1, 16 + vldx U15, AO1, T1 + addi.d T1, T1, 16 + vldx U16, AO1, T1 + addi.d T1, T1, 16 + + fldx.d $f4, Y, IY + add.d T2, IY, INCY + fldx.d $f5, Y, T2 + add.d T2, T2, INCY + fldx.d $f6, Y, T2 + add.d T2, T2, INCY + fldx.d $f7, Y, T2 + + add.d T2, T2, INCY + fldx.d $f8, Y, T2 + add.d T2, T2, INCY + fldx.d $f9, Y, T2 + add.d T2, T2, INCY + fldx.d $f10, Y, T2 + add.d T2, T2, INCY + fldx.d $f11, Y, T2 + + vextrins.d U4, U5, 0x10 + vextrins.d U6, U7, 0x10 + vextrins.d U8, U9, 0x10 + vextrins.d U10, U11, 0x10 + + vfmadd.d U4, U3, U1, U4 + vfmadd.d U6, U3, U14, U6 + vfmadd.d U8, U3, U15, U8 + vfmadd.d U10, U3, U16, U10 + + vextrins.d U5, U4, 0x01 + vextrins.d U7, U6, 0x01 + vextrins.d U9, U8, 0x01 + vextrins.d U11, U10, 0x01 + + fstx.d $f4, Y, IY + add.d T2, IY, INCY + fstx.d $f5, Y, T2 + add.d T2, T2, INCY + fstx.d $f6, Y, T2 + add.d T2, T2, INCY + fstx.d $f7, Y, T2 + + add.d T2, T2, INCY + fstx.d $f8, Y, T2 + add.d T2, T2, INCY + fstx.d $f9, Y, T2 + add.d T2, T2, INCY + fstx.d $f10, Y, T2 + add.d T2, T2, INCY + fstx.d $f11, Y, T2 + + slli.d T2, INCY, 3 + add.d IY, IY, T2 + + fldx.d $f4, X, IX + add.d T2, IX, INCX + fldx.d $f5, X, T2 + add.d T2, T2, INCX + fldx.d $f6, X, T2 + add.d T2, T2, INCX + fldx.d $f7, X, T2 + + add.d T2, T2, INCX + fldx.d $f8, X, T2 + add.d T2, T2, INCX + fldx.d $f9, X, T2 + add.d T2, T2, INCX + fldx.d $f10, X, T2 + add.d T2, T2, INCX + fldx.d $f11, X, T2 + + vextrins.d U4, U5, 0x10 + vextrins.d U6, U7, 0x10 + vextrins.d U8, U9, 0x10 + vextrins.d U10, U11, 0x10 + + vand.v $vr12, $vr2, $vr2 + + vfmadd.d U2, U1, U4, U2 + vfsub.d U2, U2, $vr12 + vfmadd.d U2, U14, U6, U2 + vfmadd.d U2, U15, U8, U2 + vfmadd.d U2, U16, U10, U2 + + vextrins.d U4, U2, 0x01 + + fadd.d $f2, $f2, $f4 + fadd.d $f2, $f2, $f12 + + vextrins.d U2, U2, 0x10 + + slli.d T2, INCX, 3 + add.d IX, IX, T2 + + addi.d II, II, 64 + addi.d I, I, 1 + blt I, T0, .L02 + +.L03: /* &4 */ + andi T0, J, 4 + beq $r0, T0, .L04 + + mul.d T1, J, LDA + add.d T1, T1, II + addi.d T2, T1, 16 + + vldx U1, AO1, T1 + vldx U14, AO1, T2 + + move T1, IY + add.d T2, T1, INCY + add.d T3, T2, INCY + add.d T4, T3, INCY + + fldx.d $f4, Y, T1 + fldx.d $f5, Y, T2 + fldx.d $f6, Y, T3 + fldx.d $f7, Y, T4 + + vextrins.d U4, U5, 0x10 + vextrins.d U6, U7, 0x10 + + vfmadd.d U4, U3, U1, U4 + vfmadd.d U6, U3, U14, U6 + + vextrins.d U5, U4, 0x01 + vextrins.d U7, U6, 0x01 + + fstx.d $f4, Y, T1 + fstx.d $f5, Y, T2 + fstx.d $f6, Y, T3 + fstx.d $f7, Y, T4 + + slli.d T1, INCY, 2 + add.d IY, IY, T1 + + move T1, IX + add.d T2, T1, INCX + add.d T3, T2, INCX + add.d T4, T3, INCX + + fldx.d $f4, X, T1 + fldx.d $f5, X, T2 + fldx.d $f6, X, T3 + fldx.d $f7, X, T4 + + vextrins.d U4, U5, 0x10 + vextrins.d U6, U7, 0x10 + + vand.v $vr12, $vr2, $vr2 + + vfmadd.d U2, U1, U4, U2 + vfsub.d U2, U2, $vr12 + vfmadd.d U2, U14, U6, U2 + + vextrins.d U4, U2, 0x01 + + fadd.d $f2, $f2, $f4 + fadd.d $f2, $f2, $f12 + + vextrins.d U2, U2, 0x10 + + slli.d T2, INCX, 2 + add.d IX, IX, T2 + + addi.d II, II, 32 + +.L04: /* &2 */ + andi T0, J, 2 + beq $r0, T0, .L05 + + mul.d T1, J, LDA + add.d T1, T1, II + + vldx $vr1, AO1, T1 + + move T1, IY + add.d T2, T1, INCY + + fldx.d $f6, Y, T1 + fldx.d $f7, Y, T2 + + vextrins.d U6, U7, 0x10 + vfmadd.d U6, U3, U1, U6 + vextrins.d U7, U6, 0x01 + + fstx.d $f6, Y, T1 + fstx.d $f7, Y, T2 + + slli.d T1, INCY, 1 + add.d IY, IY, T1 + + move T1, IX + add.d T2, T1, INCX + + fldx.d $f6, X, T1 + fldx.d $f7, X, T2 + + vextrins.d U6, U7, 0x10 + vand.v U12, U2, U2 + + vfmadd.d U2, U1, U6, U2 + vfsub.d U2, U2, U12 + + vextrins.d U4, U2, 0x01 + fadd.d $f2, $f2, $f4 + fadd.d $f2, $f2, $f12 + + vextrins.d U2, U2, 0x10 + + slli.d T2, INCX, 1 + add.d IX, IX, T2 + + addi.d II, II, 16 + +.L05: /* &1 */ + andi T0, J, 1 + beq $r0, T0, .L06 + + mul.d T1, J, LDA + add.d T1, T1, II + + fldx.d $f4, AO1, T1 + fldx.d $f6, Y, IY + fmadd.d $f6, $f3, $f4, $f6 + fstx.d $f6, Y, IY + add.d IY, IY, INCY + + fldx.d $f6, X, IX + fmadd.d $f2, $f4, $f6, $f2 + add.d IX, IX, INCX + + addi.d II, II, 8 + +.L06: + mul.d T1, J, LDA + slli.d T2, J, BASE_SHIFT + add.d T1, T1, T2 + + fldx.d $f6, Y, JY + fldx.d $f4, AO1, T1 + fmadd.d $f6, $f3, $f4, $f6 + fmul.d $f7, ALPHA, $f2 + fadd.d $f6, $f6, $f7 + + fstx.d $f6, Y, JY + + add.d JX, JX, INCX + add.d JY, JY, INCY + + addi.d J, J, 1 + blt J, M, .L01 + +.L999: + LDARG $r23, $sp, 0 + LDARG $r24, $sp, 8 + LDARG $r25, $sp, 16 + LDARG $r26, $sp, 32 + LDARG $r27, $sp, 40 + LDARG $r28, $sp, 48 + LDARG $r29, $sp, 56 + LDARG $r30, $sp, 64 + LDARG $r31, $sp, 72 + + addi.d $sp, $sp, 88 + jirl $r0, $r1, 0x0 + + EPILOGUE \ No newline at end of file diff --git a/kernel/loongarch64/ssymv_L_lsx.S b/kernel/loongarch64/ssymv_L_lsx.S new file mode 100644 index 000000000..949e9e902 --- /dev/null +++ b/kernel/loongarch64/ssymv_L_lsx.S @@ -0,0 +1,429 @@ +/******************************************************************************* +Copyright (c) 2024, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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. +*******************************************************************************/ + +#define ASSEMBLER + +#include "common.h" + +/* Param */ +#define M $r4 +#define N $r5 +#define A $r6 +#define LDA $r7 +#define X $r8 +#define INCX $r9 +#define Y $r10 +#define INCY $r11 +#define BUFFER $r16 +#define ALPHA $f0 + +#define JY $r18 +#define JX $r31 +#define T0 $r19 +#define T1 $r20 +#define AO3 $r12 +#define AO4 $r13 +#define I $r14 +#define J $r15 +#define AO1 $r23 +#define AO2 $r24 +#define IX $r25 +#define IY $r26 +#define II $r27 +#define T2 $r28 +#define T3 $r29 +#define T4 $r30 + +/* LSX vectors */ +#define U0 $vr31 +#define U1 $vr1 +#define U2 $vr2 +#define U3 $vr3 +#define U4 $vr4 +#define U5 $vr5 +#define U6 $vr6 +#define U7 $vr7 +#define U8 $vr8 +#define U9 $vr9 +#define U10 $vr10 +#define U11 $vr11 +#define U12 $vr12 +#define U13 $vr13 +#define U14 $vr14 +#define U15 $vr15 +#define U16 $vr16 +#define VALPHA $vr17 + +#define a2 $f2 +#define a3 $f3 +#define a4 $f4 +#define a5 $f5 +#define a6 $f6 +#define a7 $f7 +#define a8 $f8 +#define a9 $f9 + + + PROLOGUE + + LDARG BUFFER, $sp, 0 + + addi.d $sp, $sp, -88 + + SDARG $r23, $sp, 0 + SDARG $r24, $sp, 8 + SDARG $r25, $sp, 16 + SDARG $r26, $sp, 32 + SDARG $r27, $sp, 40 + SDARG $r28, $sp, 48 + SDARG $r29, $sp, 56 + SDARG $r30, $sp, 64 + SDARG $r31, $sp, 72 + ST ALPHA, $sp, 80 + + vldrepl.w VALPHA, $sp, 80 + + slli.d LDA, LDA, BASE_SHIFT + slli.d INCX, INCX, BASE_SHIFT + slli.d INCY, INCY, BASE_SHIFT + + bge $r0, M, .L999 + bge $r0, N, .L999 + + move J, $r0 + move JY, $r0 + move JX, $r0 + move AO1, A + + beq J, N, .L999 + +.L01: + MTC a2, $r0 //temp2 + fldx.s a6, X, JX + fmul.s a3, ALPHA, a6 //temp1 + vpermi.w U3, U3, 0x00 + vpermi.w U2, U2, 0x00 + + mul.w T0, J, LDA + slli.d T1, J, BASE_SHIFT + add.w T0, T0, T1 + fldx.s a6, AO1, T0 + fldx.s a4, Y, JY + fmadd.s a4, a3, a6, a4 + fstx.s a4, Y, JY + + move IY, JY + move IX, JX + addi.d II, J, 1 + move I, II + slli.d II, II, BASE_SHIFT + + sub.d T0, M, J + addi.d T0, T0, -1 + srai.d T0, T0, 3 + add.d T0, T0, J + addi.d T0, T0, 1 + beq I, T0, .L03 + bge I, T0, .L03 + + mul.w T1, J, LDA + add.d T1, T1, II + +.L02: /* /8 */ + vldx U1, AO1, T1 + addi.d T1, T1, 16 + vldx U14, AO1, T1 + addi.d T1, T1, 16 + + add.d T2, IY, INCY + fldx.s $f4, Y, T2 + add.d T2, T2, INCY + fldx.s $f5, Y, T2 + add.d T2, T2, INCY + fldx.s $f6, Y, T2 + add.d T2, T2, INCY + fldx.s $f7, Y, T2 + + add.d T2, T2, INCY + fldx.s $f8, Y, T2 + add.d T2, T2, INCY + fldx.s $f9, Y, T2 + add.d T2, T2, INCY + fldx.s $f10, Y, T2 + add.d T2, T2, INCY + fldx.s $f11, Y, T2 + + vextrins.w U4, U5, 0x10 + vextrins.w U4, U6, 0x20 + vextrins.w U4, U7, 0x30 + vextrins.w U8, U9, 0x10 + vextrins.w U8, U10, 0x20 + vextrins.w U8, U11, 0x30 + + vfmadd.s U4, U3, U1, U4 + vfmadd.s U8, U3, U14, U8 + + vextrins.w U5, U4, 0x01 + vextrins.w U6, U4, 0x02 + vextrins.w U7, U4, 0x03 + vextrins.w U9, U8, 0x01 + vextrins.w U10, U8, 0x02 + vextrins.w U11, U8, 0x03 + + add.d T2, IY, INCY + fstx.s $f4, Y, T2 + add.d T2, T2, INCY + fstx.s $f5, Y, T2 + add.d T2, T2, INCY + fstx.s $f6, Y, T2 + add.d T2, T2, INCY + fstx.s $f7, Y, T2 + + add.d T2, T2, INCY + fstx.s $f8, Y, T2 + add.d T2, T2, INCY + fstx.s $f9, Y, T2 + add.d T2, T2, INCY + fstx.s $f10, Y, T2 + add.d T2, T2, INCY + fstx.s $f11, Y, T2 + + slli.d T2, INCY, 3 + add.d IY, IY, T2 + + add.d T2, IX, INCX + fldx.s $f4, X, T2 + add.d T2, T2, INCX + fldx.s $f5, X, T2 + add.d T2, T2, INCX + fldx.s $f6, X, T2 + add.d T2, T2, INCX + fldx.s $f7, X, T2 + + add.d T2, T2, INCX + fldx.s $f8, X, T2 + add.d T2, T2, INCX + fldx.s $f9, X, T2 + add.d T2, T2, INCX + fldx.s $f10, X, T2 + add.d T2, T2, INCX + fldx.s $f11, X, T2 + + vextrins.w $vr4, $vr5, 0x10 + vextrins.w $vr4, $vr6, 0x20 + vextrins.w $vr4, $vr7, 0x30 + vextrins.w $vr8, $vr9, 0x10 + vextrins.w $vr8, $vr10, 0x20 + vextrins.w $vr8, $vr11, 0x30 + + vand.v $vr12, $vr2, $vr2 + + vfmadd.s U2, U1, U4, U2 + vfsub.s U2, U2, $vr12 + vfmadd.s U2, U14, U8, U2 + + vextrins.w U4, U2, 0x01 + vextrins.w U5, U2, 0x02 + vextrins.w U6, U2, 0x03 + + fadd.s $f2, $f2, $f4 + fadd.s $f2, $f2, $f5 + fadd.s $f2, $f2, $f6 + fadd.s $f2, $f2, $f12 + + vpermi.w U2, U2, 0x00 + + slli.d T2, INCX, 3 + add.d IX, IX, T2 + + addi.d II, II, 32 + addi.d I, I, 1 + blt I, T0, .L02 + +.L03: /* &4 */ + sub.d T0, M, J + addi.d T0, T0, -1 + andi T0, T0, 4 + beq $r0, T0, .L04 + + mul.w T1, J, LDA + add.d T1, T1, II + + vldx U1, AO1, T1 + + add.d T1, IY, INCY + add.d T2, T1, INCY + add.d T3, T2, INCY + add.d T4, T3, INCY + + fldx.s $f4, Y, T1 + fldx.s $f5, Y, T2 + fldx.s $f6, Y, T3 + fldx.s $f7, Y, T4 + + vextrins.w U4, U5, 0x10 + vextrins.w U4, U6, 0x20 + vextrins.w U4, U7, 0x30 + + vfmadd.s U4, U3, U1, U4 + + vextrins.w U5, U4, 0x01 + vextrins.w U6, U4, 0x02 + vextrins.w U7, U4, 0x03 + + fstx.s $f4, Y, T1 + fstx.s $f5, Y, T2 + fstx.s $f6, Y, T3 + fstx.s $f7, Y, T4 + + slli.d T1, INCY, 2 + add.d IY, IY, T1 + + add.d T1, IX, INCX + add.d T2, T1, INCX + add.d T3, T2, INCX + add.d T4, T3, INCX + + fldx.s $f4, X, T1 + fldx.s $f5, X, T2 + fldx.s $f6, X, T3 + fldx.s $f7, X, T4 + + vextrins.w U4, U5, 0x10 + vextrins.w U4, U6, 0x20 + vextrins.w U4, U7, 0x30 + + vand.v $vr12, $vr2, $vr2 + + vfmadd.s U2, U1, U4, U2 + vfsub.s $vr2, $vr2, $vr12 + + vextrins.w U4, U2, 0x01 + vextrins.w U5, U2, 0x02 + vextrins.w U6, U2, 0x03 + + fadd.s $f2, $f2, $f4 + fadd.s $f2, $f2, $f5 + fadd.s $f2, $f2, $f6 + fadd.s $f2, $f2, $f12 + + vpermi.w U2, U2, 0x00 + + slli.d T2, INCX, 2 + add.d IX, IX, T2 + + addi.d II, II, 16 + +.L04: /* &2 */ + sub.d T0, M, J + addi.d T0, T0, -1 + andi T0, T0, 2 + beq $r0, T0, .L05 + + mul.w T1, J, LDA + add.d T1, T1, II + addi.d T2, T1, 4 + + fldx.s $f4, AO1, T1 + fldx.s $f5, AO1, T2 + + add.d T1, IY, INCY + add.d T2, T1, INCY + + fldx.s $f6, Y, T1 + fldx.s $f7, Y, T2 + + fmadd.s $f6, $f3, $f4, $f6 + fmadd.s $f7, $f3, $f5, $f7 + + fstx.s $f6, Y, T1 + fstx.s $f7, Y, T2 + + slli.d T1, INCY, 1 + add.d IY, IY, T1 + + add.d T1, IX, INCX + add.d T2, T1, INCX + + fldx.s $f6, X, T1 + fldx.s $f7, X, T2 + + fmadd.s $f2, $f4, $f6, $f2 + fmadd.s $f2, $f5, $f7, $f2 + + slli.d T2, INCX, 1 + add.d IX, IX, T2 + + addi.d II, II, 8 + +.L05: /* &1 */ + sub.d T0, M, J + addi.d T0, T0, -1 + andi T0, T0, 1 + beq $r0, T0, .L06 + + mul.w T1, J, LDA + add.d T1, T1, II + + fldx.s $f4, AO1, T1 + add.d IY, IY, INCY + fldx.s $f6, Y, IY + fmadd.s $f6, $f3, $f4, $f6 + fstx.s $f6, Y, IY + + add.d IX, IX, INCX + fldx.s $f6, X, IX + fmadd.s $f2, $f4, $f6, $f2 + + addi.d II, II, 4 + +.L06: + fldx.s $f6, Y, JY + fmadd.s $f6, ALPHA, $f2, $f6 + fstx.s $f6, Y, JY + + add.d JX, JX, INCX + add.d JY, JY, INCY + + addi.d J, J, 1 + blt J, N, .L01 + +.L999: + LDARG $r23, $sp, 0 + LDARG $r24, $sp, 8 + LDARG $r25, $sp, 16 + LDARG $r26, $sp, 32 + LDARG $r27, $sp, 40 + LDARG $r28, $sp, 48 + LDARG $r29, $sp, 56 + LDARG $r30, $sp, 64 + LDARG $r31, $sp, 72 + + addi.d $sp, $sp, 88 + jirl $r0, $r1, 0x0 + + EPILOGUE \ No newline at end of file diff --git a/kernel/loongarch64/ssymv_U_lsx.S b/kernel/loongarch64/ssymv_U_lsx.S new file mode 100644 index 000000000..f3898e148 --- /dev/null +++ b/kernel/loongarch64/ssymv_U_lsx.S @@ -0,0 +1,417 @@ +/******************************************************************************* +Copyright (c) 2024, The OpenBLAS Project +All rights reserved. +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: +1. Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the OpenBLAS project 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 OPENBLAS PROJECT 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. +*******************************************************************************/ + +#define ASSEMBLER + +#include "common.h" + +/* Param */ +#define M $r4 +#define N $r5 +#define A $r6 +#define LDA $r7 +#define X $r8 +#define INCX $r9 +#define Y $r10 +#define INCY $r11 +#define BUFFER $r16 +#define ALPHA $f0 + +#define JY $r18 +#define JX $r31 +#define T0 $r19 +#define T1 $r20 +#define M1 $r12 +#define AO4 $r13 +#define I $r14 +#define J $r15 +#define AO1 $r23 +#define AO2 $r24 +#define IX $r25 +#define IY $r26 +#define II $r27 +#define T2 $r28 +#define T3 $r29 +#define T4 $r30 + +/* LSX vectors */ +#define U0 $vr31 +#define U1 $vr1 +#define U2 $vr2 +#define U3 $vr3 +#define U4 $vr4 +#define U5 $vr5 +#define U6 $vr6 +#define U7 $vr7 +#define U8 $vr8 +#define U9 $vr9 +#define U10 $vr10 +#define U11 $vr11 +#define U12 $vr12 +#define U13 $vr13 +#define U14 $vr14 +#define U15 $vr15 +#define U16 $vr16 +#define VALPHA $vr17 + +#define a2 $f2 +#define a3 $f3 +#define a4 $f4 +#define a5 $f5 +#define a6 $f6 +#define a7 $f7 +#define a8 $f8 +#define a9 $f9 + + + PROLOGUE + + LDARG BUFFER, $sp, 0 + + addi.d $sp, $sp, -88 + + SDARG $r23, $sp, 0 + SDARG $r24, $sp, 8 + SDARG $r25, $sp, 16 + SDARG $r26, $sp, 32 + SDARG $r27, $sp, 40 + SDARG $r28, $sp, 48 + SDARG $r29, $sp, 56 + SDARG $r30, $sp, 64 + SDARG $r31, $sp, 72 + ST ALPHA, $sp, 80 + + vldrepl.w VALPHA, $sp, 80 + + slli.d LDA, LDA, BASE_SHIFT + slli.d INCX, INCX, BASE_SHIFT + slli.d INCY, INCY, BASE_SHIFT + + bge $r0, M, .L999 + bge $r0, N, .L999 + + sub.d M1, M, N + + mul.d JY, M1, INCY + mul.d JX, M1, INCX + + move J, M1 + move AO1, A + + beq J, M, .L999 + +.L01: + MTC $f2, $r0 //temp2 + fldx.s $f6, X, JX + fmul.s $f3, ALPHA, $f6 //temp1 + vpermi.w U3, U3, 0x00 + vpermi.w U2, U2, 0x00 + + move IY, $r0 + move IX, $r0 + move II, $r0 + move I, $r0 + + srai.d T0, J, 3 + beq I, T0, .L03 + + mul.w T1, J, LDA + add.d T1, T1, II + +.L02: /* /8 */ + vldx U1, AO1, T1 + addi.d T1, T1, 16 + vldx U14, AO1, T1 + addi.d T1, T1, 16 + + fldx.s $f4, Y, IY + add.d T2, IY, INCY + fldx.s $f5, Y, T2 + add.d T2, T2, INCY + fldx.s $f6, Y, T2 + add.d T2, T2, INCY + fldx.s $f7, Y, T2 + + add.d T2, T2, INCY + fldx.s $f8, Y, T2 + add.d T2, T2, INCY + fldx.s $f9, Y, T2 + add.d T2, T2, INCY + fldx.s $f10, Y, T2 + add.d T2, T2, INCY + fldx.s $f11, Y, T2 + + vextrins.w U4, U5, 0x10 + vextrins.w U4, U6, 0x20 + vextrins.w U4, U7, 0x30 + vextrins.w U8, U9, 0x10 + vextrins.w U8, U10, 0x20 + vextrins.w U8, U11, 0x30 + + vfmadd.s U4, U3, U1, U4 + vfmadd.s U8, U3, U14, U8 + + vextrins.w U5, U4, 0x01 + vextrins.w U6, U4, 0x02 + vextrins.w U7, U4, 0x03 + vextrins.w U9, U8, 0x01 + vextrins.w U10, U8, 0x02 + vextrins.w U11, U8, 0x03 + + fstx.s $f4, Y, IY + add.d T2, IY, INCY + fstx.s $f5, Y, T2 + add.d T2, T2, INCY + fstx.s $f6, Y, T2 + add.d T2, T2, INCY + fstx.s $f7, Y, T2 + + add.d T2, T2, INCY + fstx.s $f8, Y, T2 + add.d T2, T2, INCY + fstx.s $f9, Y, T2 + add.d T2, T2, INCY + fstx.s $f10, Y, T2 + add.d T2, T2, INCY + fstx.s $f11, Y, T2 + + slli.d T2, INCY, 3 + add.d IY, IY, T2 + + fldx.s $f4, X, IX + add.d T2, IX, INCX + fldx.s $f5, X, T2 + add.d T2, T2, INCX + fldx.s $f6, X, T2 + add.d T2, T2, INCX + fldx.s $f7, X, T2 + + add.d T2, T2, INCX + fldx.s $f8, X, T2 + add.d T2, T2, INCX + fldx.s $f9, X, T2 + add.d T2, T2, INCX + fldx.s $f10, X, T2 + add.d T2, T2, INCX + fldx.s $f11, X, T2 + + vextrins.w $vr4, $vr5, 0x10 + vextrins.w $vr4, $vr6, 0x20 + vextrins.w $vr4, $vr7, 0x30 + vextrins.w $vr8, $vr9, 0x10 + vextrins.w $vr8, $vr10, 0x20 + vextrins.w $vr8, $vr11, 0x30 + + vand.v $vr12, $vr2, $vr2 + + vfmadd.s U2, U1, U4, U2 + vfsub.s U2, U2, $vr12 + vfmadd.s U2, U14, U8, U2 + + vextrins.w U4, U2, 0x01 + vextrins.w U5, U2, 0x02 + vextrins.w U6, U2, 0x03 + + fadd.s $f2, $f2, $f4 + fadd.s $f2, $f2, $f5 + fadd.s $f2, $f2, $f6 + fadd.s $f2, $f2, $f12 + + vpermi.w U2, U2, 0x00 + + slli.d T2, INCX, 3 + add.d IX, IX, T2 + + addi.d II, II, 32 + addi.d I, I, 1 + blt I, T0, .L02 + +.L03: /* &4 */ + andi T0, J, 4 + beq $r0, T0, .L04 + + mul.w T1, J, LDA + add.d T1, T1, II + + vldx U1, AO1, T1 + + move T1, IY + add.d T2, T1, INCY + add.d T3, T2, INCY + add.d T4, T3, INCY + + fldx.s $f4, Y, T1 + fldx.s $f5, Y, T2 + fldx.s $f6, Y, T3 + fldx.s $f7, Y, T4 + + vextrins.w U4, U5, 0x10 + vextrins.w U4, U6, 0x20 + vextrins.w U4, U7, 0x30 + + vfmadd.s U4, U3, U1, U4 + + vextrins.w U5, U4, 0x01 + vextrins.w U6, U4, 0x02 + vextrins.w U7, U4, 0x03 + + fstx.s $f4, Y, T1 + fstx.s $f5, Y, T2 + fstx.s $f6, Y, T3 + fstx.s $f7, Y, T4 + + slli.d T1, INCY, 2 + add.d IY, IY, T1 + + move T1, IX + add.d T2, T1, INCX + add.d T3, T2, INCX + add.d T4, T3, INCX + + fldx.s $f4, X, T1 + fldx.s $f5, X, T2 + fldx.s $f6, X, T3 + fldx.s $f7, X, T4 + + vextrins.w U4, U5, 0x10 + vextrins.w U4, U6, 0x20 + vextrins.w U4, U7, 0x30 + + vand.v $vr12, $vr2, $vr2 + + vfmadd.s U2, U1, U4, U2 + vfsub.s $vr2, $vr2, $vr12 + + vextrins.w U4, U2, 0x01 + vextrins.w U5, U2, 0x02 + vextrins.w U6, U2, 0x03 + + fadd.s $f2, $f2, $f4 + fadd.s $f2, $f2, $f5 + fadd.s $f2, $f2, $f6 + fadd.s $f2, $f2, $f12 + + vpermi.w U2, U2, 0x00 + + slli.d T2, INCX, 2 + add.d IX, IX, T2 + + addi.d II, II, 16 + +.L04: /* &2 */ + andi T0, J, 2 + beq $r0, T0, .L05 + + mul.w T1, J, LDA + add.d T1, T1, II + addi.d T2, T1, 4 + + fldx.s $f4, AO1, T1 + fldx.s $f5, AO1, T2 + + move T1, IY + add.d T2, T1, INCY + + fldx.s $f6, Y, T1 + fldx.s $f7, Y, T2 + + fmadd.s $f6, $f3, $f4, $f6 + fmadd.s $f7, $f3, $f5, $f7 + + fstx.s $f6, Y, T1 + fstx.s $f7, Y, T2 + + slli.d T1, INCY, 1 + add.d IY, IY, T1 + + move T1, IX + add.d T2, T1, INCX + + fldx.s $f6, X, T1 + fldx.s $f7, X, T2 + + fmadd.s $f2, $f4, $f6, $f2 + fmadd.s $f2, $f5, $f7, $f2 + + slli.d T2, INCX, 1 + add.d IX, IX, T2 + + addi.d II, II, 8 + +.L05: /* &1 */ + andi T0, J, 1 + beq $r0, T0, .L06 + + mul.w T1, J, LDA + add.d T1, T1, II + + fldx.s $f4, AO1, T1 + fldx.s $f6, Y, IY + fmadd.s $f6, $f3, $f4, $f6 + fstx.s $f6, Y, IY + add.d IY, IY, INCY + + fldx.s $f6, X, IX + fmadd.s $f2, $f4, $f6, $f2 + add.d IX, IX, INCX + + addi.d II, II, 4 + +.L06: + mul.w T1, J, LDA + slli.d T2, J, BASE_SHIFT + add.d T1, T1, T2 + + fldx.s $f6, Y, JY + fldx.s $f4, AO1, T1 + fmadd.s $f6, $f3, $f4, $f6 + fmul.s $f7, ALPHA, $f2 + fadd.s $f6, $f6, $f7 + + fstx.s $f6, Y, JY + + add.d JX, JX, INCX + add.d JY, JY, INCY + + addi.d J, J, 1 + blt J, M, .L01 + +.L999: + LDARG $r23, $sp, 0 + LDARG $r24, $sp, 8 + LDARG $r25, $sp, 16 + LDARG $r26, $sp, 32 + LDARG $r27, $sp, 40 + LDARG $r28, $sp, 48 + LDARG $r29, $sp, 56 + LDARG $r30, $sp, 64 + LDARG $r31, $sp, 72 + + addi.d $sp, $sp, 88 + jirl $r0, $r1, 0x0 + + EPILOGUE \ No newline at end of file From 30e8d255de4cfdfa2fdd7272e12d1efd6e74bc7b Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Sun, 10 Mar 2024 00:05:01 +0100 Subject: [PATCH 206/311] Skip the fork test when building against an uClibc that does not implement fork --- utest/test_fork.c | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/utest/test_fork.c b/utest/test_fork.c index bd531e7fb..558026031 100644 --- a/utest/test_fork.c +++ b/utest/test_fork.c @@ -64,6 +64,11 @@ static void check_dgemm(double *a, double *b, double *result, double *expected, CTEST(fork, safety) { +#ifdef __UCLIBC__ +#if !defined __UCLIBC_HAS_STUBS__ && !defined __ARCH_USE_MMU__ +exit(0); +#endif +#endif #ifndef BUILD_DOUBLE exit(0); #else From 8a665f0d57a355932e9571449f4cf30caed56ae1 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Sun, 10 Mar 2024 19:08:03 +0100 Subject: [PATCH 207/311] Skip test when building with a uclibc that does not implement fork --- utest/test_post_fork.c | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/utest/test_post_fork.c b/utest/test_post_fork.c index 9370a02ce..6d640aebb 100644 --- a/utest/test_post_fork.c +++ b/utest/test_post_fork.c @@ -67,6 +67,11 @@ static void check_dgemm(double *a, double *b, double *result, double *expected, CTEST(fork, safety_after_fork_in_parent) { +#ifdef __UCLIBC__ +#if !defined __UCLIBC_HAS_STUBS__ && !defined __ARCH_USE_MMU__ +exit(0); +#endif +#endif #ifndef BUILD_DOUBLE exit(0); #else From c1f7a81663ae9e172d82b91c7ffbd482d71ceeac Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Sun, 10 Mar 2024 23:19:56 +0100 Subject: [PATCH 208/311] fix mtune for CortexX1, add mtune for X2 and A710 --- Makefile.arm64 | 24 ++++++++++++++++++++++-- 1 file changed, 22 insertions(+), 2 deletions(-) diff --git a/Makefile.arm64 b/Makefile.arm64 index ca053b03d..a85ee7dfd 100644 --- a/Makefile.arm64 +++ b/Makefile.arm64 @@ -270,9 +270,17 @@ endif ifeq (1, $(filter 1,$(GCCVERSIONGTEQ11) $(ISCLANG))) ifeq ($(CORE), CORTEXX1) -CCOMMON_OPT += -march=armv8.2-a -mtune=cortexa72 +CCOMMON_OPT += -march=armv8.2-a +ifeq (1, $(filter 1,$(GCCMINORVERSIONGTEQ4) $(GCCVERSIONGTEQ12) $(ISCLANG))) +CCOMMON_OPT += -mtune=cortex-x1 +ifneq ($(F_COMPILER), NAG) +FCOMMON_OPT += -march=armv8.2-a -mtune=cortex-x1 +endif +else +CCOMMON_OPT += -mtune=cortex-a72 ifneq ($(F_COMPILER), NAG) -FCOMMON_OPT += -march=armv8.2-a -mtune=cortexa72 +FCOMMON_OPT += -march=armv8.2-a -mtune=cortex-a72 +endif endif endif endif @@ -283,6 +291,12 @@ CCOMMON_OPT += -march=armv8.4-a+sve ifneq ($(F_COMPILER), NAG) FCOMMON_OPT += -march=armv8.4-a+sve endif +ifeq (1, $(filter 1,$(GCCVERSIONGTEQ12) $(ISCLANG))) +CCOMMON_OPT += -mtune=cortex-x2 +ifneq ($(F_COMPILER), NAG) +FCOMMON_OPT += -mtune=cortex-x2 +endif +endif endif endif @@ -302,6 +316,12 @@ CCOMMON_OPT += -march=armv8.4-a+sve ifneq ($(F_COMPILER), NAG) FCOMMON_OPT += -march=armv8.4-a+sve endif +ifeq (1, $(filter 1,$(GCCVERSIONGTEQ12) $(ISCLANG))) +CCOMMON_OPT += -mtune=cortex-a710 +ifneq ($(F_COMPILER), NAG) +FCOMMON_OPT += -mtune=cortex-a710 +endif +endif endif endif From a14176440aeec391b9a21108bb4df8c3a61f50f8 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Sun, 10 Mar 2024 23:22:05 +0100 Subject: [PATCH 209/311] Add version macro for GCC12 --- Makefile.system | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/Makefile.system b/Makefile.system index e8feac9e4..2ea407349 100644 --- a/Makefile.system +++ b/Makefile.system @@ -365,8 +365,9 @@ GCCVERSIONGT5 := $(shell expr `$(CC) -dumpversion | cut -f1 -d.` \> 5) GCCVERSIONGTEQ7 := $(shell expr `$(CC) -dumpversion | cut -f1 -d.` \>= 7) GCCVERSIONGTEQ8 := $(shell expr `$(CC) -dumpversion | cut -f1 -d.` \>= 8) GCCVERSIONGTEQ9 := $(shell expr `$(CC) -dumpversion | cut -f1 -d.` \>= 9) -GCCVERSIONGTEQ11 := $(shell expr `$(CC) -dumpversion | cut -f1 -d.` \>= 11) GCCVERSIONGTEQ10 := $(shell expr `$(CC) -dumpversion | cut -f1 -d.` \>= 10) +GCCVERSIONGTEQ11 := $(shell expr `$(CC) -dumpversion | cut -f1 -d.` \>= 11) +GCCVERSIONGTEQ12 := $(shell expr `$(CC) -dumpversion | cut -f1 -d.` \>= 12) # Note that the behavior of -dumpversion is compile-time-configurable for # gcc-7.x and newer. Use -dumpfullversion there ifeq ($(GCCVERSIONGTEQ7),1) From 07b1c0bc10191ce8ac8723527bdc9ccd28e284ea Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Mon, 11 Mar 2024 08:01:49 +0100 Subject: [PATCH 210/311] Stop using sched_yield on non-Windows x86_64 --- common.h | 18 ++---------------- 1 file changed, 2 insertions(+), 16 deletions(-) diff --git a/common.h b/common.h index 1f0b9e533..b8bac1ad2 100644 --- a/common.h +++ b/common.h @@ -358,12 +358,6 @@ typedef int blasint; #define YIELDING __asm__ __volatile__ ("nop;nop;nop;nop;nop;nop;nop;nop; \n"); #endif -#ifdef BULLDOZER -#ifndef YIELDING -#define YIELDING __asm__ __volatile__ ("nop;nop;nop;nop;nop;nop;nop;nop;\n"); -#endif -#endif - #if defined(POWER8) || defined(POWER9) || defined(POWER10) #ifndef YIELDING @@ -371,21 +365,13 @@ typedef int blasint; #endif #endif -/* -#ifdef PILEDRIVER -#ifndef YIELDING -#define YIELDING __asm__ __volatile__ ("nop;nop;nop;nop;nop;nop;nop;nop;\n"); -#endif -#endif -*/ -/* -#ifdef STEAMROLLER +#if defined(ARCH_X86_64) #ifndef YIELDING #define YIELDING __asm__ __volatile__ ("nop;nop;nop;nop;nop;nop;nop;nop;\n"); #endif #endif -*/ + #ifdef __EMSCRIPTEN__ #define YIELDING From 02a025f9c1fa1df6995b25bea0ad19db7a0ff3e5 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Mon, 11 Mar 2024 22:52:18 +0100 Subject: [PATCH 211/311] remove early exit on negative inc_x --- kernel/arm64/dznrm2_thunderx2t99.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/kernel/arm64/dznrm2_thunderx2t99.c b/kernel/arm64/dznrm2_thunderx2t99.c index 6077c85dd..b78878cd4 100644 --- a/kernel/arm64/dznrm2_thunderx2t99.c +++ b/kernel/arm64/dznrm2_thunderx2t99.c @@ -345,7 +345,7 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) #endif FLOAT ssq, scale; - if (n <= 0 || inc_x <= 0) return 0.0; + if (n <= 0 || inc_x == 0) return 0.0; #if defined(SMP) if (n <= 10000) From e41d01bad93b69c4c91a318d9305d18b9914b9fd Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Mon, 11 Mar 2024 22:53:54 +0100 Subject: [PATCH 212/311] remove early exit on negative inc_x --- kernel/arm64/scnrm2_thunderx2t99.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/kernel/arm64/scnrm2_thunderx2t99.c b/kernel/arm64/scnrm2_thunderx2t99.c index f96de441e..8f930b492 100644 --- a/kernel/arm64/scnrm2_thunderx2t99.c +++ b/kernel/arm64/scnrm2_thunderx2t99.c @@ -315,7 +315,7 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) FLOAT nrm2 = 0.0; double nrm2_double = 0.0; - if (n <= 0 || inc_x <= 0) return 0.0; + if (n <= 0 || inc_x == 0) return 0.0; #if defined(SMP) if (n <= 10000) From afab848543607131dda4e7ce3b32160d7cffca4c Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Mon, 11 Mar 2024 23:09:05 +0100 Subject: [PATCH 213/311] react to macos vm image updates on cirrus (#4550) * react to macos vm image updates on cirrus --- .cirrus.yml | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/.cirrus.yml b/.cirrus.yml index 9a898f421..7a13d123f 100644 --- a/.cirrus.yml +++ b/.cirrus.yml @@ -58,8 +58,8 @@ task: - export VALID_ARCHS="i386 x86_64" - xcrun --sdk macosx --show-sdk-path - xcodebuild -version - - export CC=/Applications/Xcode-14.0.0.app/Contents/Developer/Toolchains/XcodeDefault.xctoolchain/usr/bin/clang - - export CFLAGS="-O2 -unwindlib=none -Wno-macro-redefined -isysroot /Applications/Xcode-14.0.0.app/Contents/Developer/Platforms/MacOSX.platform/Developer/SDKs/MacOSX12.3.sdk -arch x86_64" + - export CC=/Applications/Xcode-15.3.0.app/Contents/Developer/Toolchains/XcodeDefault.xctoolchain/usr/bin/clang + - export CFLAGS="-O2 -unwindlib=none -Wno-macro-redefined -isysroot /Applications/Xcode-15.3.0.app/Contents/Developer/Platforms/MacOSX.platform/Developer/SDKs/MacOSX14.4.sdk -arch x86_64" - make TARGET=CORE2 DYNAMIC_ARCH=1 NUM_THREADS=32 HOSTCC=clang NOFORTRAN=1 RANLIB="ls -l" always: config_artifacts: @@ -78,8 +78,8 @@ task: - export #PATH=/opt/homebrew/opt/llvm/bin:$PATH - export #LDFLAGS="-L/opt/homebrew/opt/llvm/lib" - export #CPPFLAGS="-I/opt/homebrew/opt/llvm/include" - - export CC=/Applications/Xcode-14.0.0.app/Contents/Developer/Toolchains/XcodeDefault.xctoolchain/usr/bin/clang - - export CFLAGS="-O2 -unwindlib=none -Wno-macro-redefined -isysroot /Applications/Xcode-14.0.0.app/Contents/Developer/Platforms/iPhoneOS.platform/Developer/SDKs/iPhoneOS16.0.sdk -arch arm64 -miphoneos-version-min=10.0" + - export CC=/Applications/Xcode-15.3.0.app/Contents/Developer/Toolchains/XcodeDefault.xctoolchain/usr/bin/clang + - export CFLAGS="-O2 -unwindlib=none -Wno-macro-redefined -isysroot /Applications/Xcode-15.3.0.app/Contents/Developer/Platforms/iPhoneOS.platform/Developer/SDKs/iPhoneOS17.4.sdk -arch arm64 -miphoneos-version-min=10.0" - make TARGET=ARMV8 NUM_THREADS=32 HOSTCC=clang NOFORTRAN=1 CROSS=1 always: config_artifacts: @@ -91,14 +91,16 @@ macos_instance: task: name: AppleM1/LLVM armv7-androidndk xbuild compile_script: - - #brew install android-ndk + - brew install android-ndk - export #PATH=/opt/homebrew/opt/llvm/bin:$PATH - export #LDFLAGS="-L/opt/homebrew/opt/llvm/lib" - export #CPPFLAGS="-I/opt/homebrew/opt/llvm/include" - - find /System/Volumes/Data/opt/homebrew/Caskroom/android-ndk/25b -name "armv7a-linux-androideabi*-ranlib" + - ls /System/Volumes/Data/opt/homebrew + - ls -l /System/Volumes/Data/opt/homebrew/Caskroom/ + - find /System/Volumes/Data/opt/homebrew -name "armv7a-linux-androideabi*-ranlib" - #export CC=/Applications/Xcode-13.4.1.app/Contents/Developer/Toolchains/XcodeDefault.xctoolchain/usr/bin/clang - #export CFLAGS="-O2 -unwindlib=none -Wno-macro-redefined -isysroot /Applications/Xcode-13.4.1.app/Contents/Developer/Platforms/iPhoneOS.platform/Developer/SDKs/iPhoneOS16.0.sdk -arch arm64 -miphoneos-version-min=10.0" - - export CC=/System/Volumes/Data/opt/homebrew/Caskroom/android-ndk/25b/AndroidNDK8937393.app/Contents/NDK/toolchains/llvm/prebuilt/darwin-x86_64/bin/armv7a-linux-androideabi23-clang + - export CC=/System/Volumes/Data/opt/homebrew/Caskroom/android-ndk/26c/AndroidNDK*.app/Contents/NDK/toolchains/llvm/prebuilt/darwin-x86_64/bin/armv7a-linux-androideabi23-clang - make TARGET=ARMV7 ARM_SOFTFP_ABI=1 NUM_THREADS=32 HOSTCC=clang NOFORTRAN=1 RANLIB="ls -l" always: config_artifacts: From a6e16a065dd43dea6fd48fb3e2776e760a3d2471 Mon Sep 17 00:00:00 2001 From: Evgeni Burovski Date: Tue, 12 Mar 2024 15:15:56 +0300 Subject: [PATCH 214/311] Add a test for dnrm(..., incx=-1) --- utest/test_dnrm2.c | 15 ++++++++++++++- 1 file changed, 14 insertions(+), 1 deletion(-) diff --git a/utest/test_dnrm2.c b/utest/test_dnrm2.c index 0035863df..ab8cac33e 100644 --- a/utest/test_dnrm2.c +++ b/utest/test_dnrm2.c @@ -30,7 +30,7 @@ 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 #include "openblas_utest.h" #if defined(BUILD_DOUBLE) @@ -64,4 +64,17 @@ CTEST(dnrm2,dnrm2_tiny) res1=BLASFUNC(dnrm2)(&n, x, &incx); ASSERT_DBL_NEAR_TOL(res2, res1, DOUBLE_EPS); } +CTEST(dnrm2,dnrm2_neg_incx) +{ + int i; + double x[5]; + blasint incx=-1; + blasint n=5; + double res1, res2; + + for (i=0;i Date: Tue, 12 Mar 2024 15:28:50 +0300 Subject: [PATCH 215/311] Update utest/test_dnrm2.c --- utest/test_dnrm2.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/utest/test_dnrm2.c b/utest/test_dnrm2.c index ab8cac33e..145676044 100644 --- a/utest/test_dnrm2.c +++ b/utest/test_dnrm2.c @@ -72,7 +72,7 @@ CTEST(dnrm2,dnrm2_neg_incx) blasint n=5; double res1, res2; - for (i=0;i Date: Tue, 12 Mar 2024 09:07:47 -0500 Subject: [PATCH 216/311] Update README for build instructions on AIX and OpenXL. --- README.md | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/README.md b/README.md index 43f390db0..aade7b917 100644 --- a/README.md +++ b/README.md @@ -185,6 +185,11 @@ Please read `GotoBLAS_01Readme.txt` for older CPU models already supported by th - **POWER9**: Optimized Level-3 BLAS (real) and some Level-1,2. PPC64LE with OpenMP only. - **POWER10**: Optimized Level-3 BLAS including SBGEMM and some Level-1,2. +- **AIX**: Dynamic architecture with OpenXL and OpenMP. + ```sh + make CC=ibm-clang_r FC=xlf TARGET=POWER7 BINARY=64 USE_OPENMP=1 INTERFACE64=1 DYNAMIC_ARCH=1 USE_THREAD=1 + ``` + #### IBM zEnterprise System - **Z13**: Optimized Level-3 BLAS and Level-1,2 @@ -242,7 +247,7 @@ Please note that it is not possible to combine support for different architectur - **NetBSD**: Supported by the community. We don't actively test the library on this OS. - **DragonFly BSD**: Supported by the community. We don't actively test the library on this OS. - **Android**: Supported by the community. Please read . -- **AIX**: Supported on PPC up to POWER8 +- **AIX**: Supported on PPC up to POWER10 - **Haiku**: Supported by the community. We don't actively test the library on this OS. - **SunOS**: Supported by the community. We don't actively test the library on this OS. - **Cortex-M**: Supported by the community. Please read . From bf93459746d374172402cdfb54079860f4b39c60 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Tue, 12 Mar 2024 15:45:23 +0100 Subject: [PATCH 217/311] fix loop condition for incx < 0 --- kernel/arm/nrm2.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/kernel/arm/nrm2.c b/kernel/arm/nrm2.c index 8cc189fe3..0b6323f29 100644 --- a/kernel/arm/nrm2.c +++ b/kernel/arm/nrm2.c @@ -61,7 +61,7 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) if ( n == 1 ) return( ABS(x[0]) ); n *= inc_x; - while(i < n) + while(abs(i) < abs(n)) { if ( x[i] != 0.0 ) From 23796f8d31e392e8834d2413c7299b6285d035ef Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Tue, 12 Mar 2024 15:46:23 +0100 Subject: [PATCH 218/311] fix loop condition for incx < 0 --- kernel/arm/znrm2.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/kernel/arm/znrm2.c b/kernel/arm/znrm2.c index 28bb0eda5..bc78c8948 100644 --- a/kernel/arm/znrm2.c +++ b/kernel/arm/znrm2.c @@ -62,7 +62,7 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) inc_x2 = 2 * inc_x; n *= inc_x2; - while(i < n) + while(abs(i) < abs(n)) { if ( x[i] != 0.0 ) From f747aedb52f744dc236b98479da0d42b484e917a Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Tue, 12 Mar 2024 15:47:17 +0100 Subject: [PATCH 219/311] fix loop condition for incx < 0 --- kernel/mips/znrm2.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/kernel/mips/znrm2.c b/kernel/mips/znrm2.c index d11a6bd4a..811b8b173 100644 --- a/kernel/mips/znrm2.c +++ b/kernel/mips/znrm2.c @@ -53,7 +53,7 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) inc_x2 = 2 * inc_x; n *= inc_x2; - while(i < n) + while(abs(i) < abs(n)) { if ( x[i] != 0.0 ) From 09e84bd29a88efeabec04f3354da984ed51865f7 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Tue, 12 Mar 2024 15:48:00 +0100 Subject: [PATCH 220/311] fix loop condition for incx < 0 --- kernel/mips/nrm2.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/kernel/mips/nrm2.c b/kernel/mips/nrm2.c index 8cc189fe3..0b6323f29 100644 --- a/kernel/mips/nrm2.c +++ b/kernel/mips/nrm2.c @@ -61,7 +61,7 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) if ( n == 1 ) return( ABS(x[0]) ); n *= inc_x; - while(i < n) + while(abs(i) < abs(n)) { if ( x[i] != 0.0 ) From 20016a0096fb9c185739476f44650f254881580e Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Tue, 12 Mar 2024 15:48:55 +0100 Subject: [PATCH 221/311] fix loop condition for incx < 0 --- kernel/riscv64/nrm2.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/kernel/riscv64/nrm2.c b/kernel/riscv64/nrm2.c index 8cc189fe3..0b6323f29 100644 --- a/kernel/riscv64/nrm2.c +++ b/kernel/riscv64/nrm2.c @@ -61,7 +61,7 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) if ( n == 1 ) return( ABS(x[0]) ); n *= inc_x; - while(i < n) + while(abs(i) < abs(n)) { if ( x[i] != 0.0 ) From 6b89e1f1d7f383f54adf4668e23753b8b9fdc260 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Tue, 12 Mar 2024 15:49:41 +0100 Subject: [PATCH 222/311] fix loop condition for incx < 0 --- kernel/riscv64/znrm2.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/kernel/riscv64/znrm2.c b/kernel/riscv64/znrm2.c index 28bb0eda5..bc78c8948 100644 --- a/kernel/riscv64/znrm2.c +++ b/kernel/riscv64/znrm2.c @@ -62,7 +62,7 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) inc_x2 = 2 * inc_x; n *= inc_x2; - while(i < n) + while(abs(i) < abs(n)) { if ( x[i] != 0.0 ) From ed532dc75b7307c0bcfa548b4b3cafd63ff5bbe0 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Tue, 12 Mar 2024 18:47:00 +0100 Subject: [PATCH 223/311] remove another early exit for incx < 0 --- kernel/arm64/dznrm2_thunderx2t99.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/kernel/arm64/dznrm2_thunderx2t99.c b/kernel/arm64/dznrm2_thunderx2t99.c index b78878cd4..9e16ed956 100644 --- a/kernel/arm64/dznrm2_thunderx2t99.c +++ b/kernel/arm64/dznrm2_thunderx2t99.c @@ -77,7 +77,7 @@ static void nrm2_compute(BLASLONG n, FLOAT *x, BLASLONG inc_x, " cmp "N", xzr \n" " ble 9f //nrm2_kernel_L999 \n" " cmp "INC_X", xzr \n" - " ble 9f //nrm2_kernel_L999 \n" + " beq 9f //nrm2_kernel_L999 \n" "1: //nrm2_kernel_F_BEGIN: \n" " mov x6, #0x7FF0000000000000 //+Infinity \n" From 552c52135377e25ad8f61fcf84068a8d3d663468 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Tue, 12 Mar 2024 18:49:27 +0100 Subject: [PATCH 224/311] remove another early exit for incx < 0 --- kernel/arm64/scnrm2_thunderx2t99.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/kernel/arm64/scnrm2_thunderx2t99.c b/kernel/arm64/scnrm2_thunderx2t99.c index 8f930b492..50790f4b7 100644 --- a/kernel/arm64/scnrm2_thunderx2t99.c +++ b/kernel/arm64/scnrm2_thunderx2t99.c @@ -229,7 +229,7 @@ static double nrm2_compute(BLASLONG n, FLOAT *x, BLASLONG inc_x) " cmp "N", xzr \n" " ble 9f //nrm2_kernel_L999 \n" " cmp "INC_X", xzr \n" - " ble 9f //nrm2_kernel_L999 \n" + " beq 9f //nrm2_kernel_L999 \n" " cmp "INC_X", #1 \n" " bne 5f //nrm2_kernel_S_BEGIN \n" From d9dff17aec4fa1e4f9f0e1a32d099a493f299862 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Tue, 12 Mar 2024 20:38:23 +0100 Subject: [PATCH 225/311] handle incx < 0 --- kernel/riscv64/nrm2_vector.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/kernel/riscv64/nrm2_vector.c b/kernel/riscv64/nrm2_vector.c index 5c03fbec7..129dbba7a 100644 --- a/kernel/riscv64/nrm2_vector.c +++ b/kernel/riscv64/nrm2_vector.c @@ -104,7 +104,7 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) { BLASLONG i=0; - if (n <= 0 || inc_x <= 0) return(0.0); + if (n <= 0 || inc_x == 0) return(0.0); if(n == 1) return (ABS(x[0])); unsigned int gvl = 0; @@ -193,7 +193,7 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) //finish any tail using scalar ops i*=gvl*inc_x; n*=inc_x; - while(i < n){ + while(abs(i) < abs(n)){ if ( x[i] != 0.0 ){ FLOAT absxi = ABS( x[i] ); if ( scale < absxi ){ From dee8557d58fd34750514e5d68e20da0e977e48ce Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Tue, 12 Mar 2024 20:40:29 +0100 Subject: [PATCH 226/311] handle incx < 0 --- kernel/riscv64/znrm2_vector.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/kernel/riscv64/znrm2_vector.c b/kernel/riscv64/znrm2_vector.c index 6ee3be79e..cace38891 100644 --- a/kernel/riscv64/znrm2_vector.c +++ b/kernel/riscv64/znrm2_vector.c @@ -96,7 +96,7 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) { BLASLONG i=0; - if (n <= 0 || inc_x <= 0) return(0.0); + if (n <= 0 || inc_x == 0) return(0.0); FLOAT_V_T v_ssq, v_scale, v0, v1, v_zero; unsigned int gvl = 0; @@ -176,7 +176,7 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) } i += inc_x*2; - }while(i Date: Tue, 12 Mar 2024 20:42:11 +0100 Subject: [PATCH 227/311] handle incx < 0 --- kernel/riscv64/znrm2_rvv.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/kernel/riscv64/znrm2_rvv.c b/kernel/riscv64/znrm2_rvv.c index 32f67758a..7b89befcc 100644 --- a/kernel/riscv64/znrm2_rvv.c +++ b/kernel/riscv64/znrm2_rvv.c @@ -69,7 +69,7 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) { BLASLONG i=0, j=0; - if (n <= 0 || inc_x <= 0) return(0.0); + if (n <= 0 || inc_x == 0) return(0.0); FLOAT_V_T vr, v0, v_zero; unsigned int gvl = 0; From 3752e73919f8737f28f45e833fb569782d089c01 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Tue, 12 Mar 2024 20:44:01 +0100 Subject: [PATCH 228/311] handle incx < 0 --- kernel/riscv64/nrm2_rvv.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/kernel/riscv64/nrm2_rvv.c b/kernel/riscv64/nrm2_rvv.c index 3eb423849..a0b201ec2 100644 --- a/kernel/riscv64/nrm2_rvv.c +++ b/kernel/riscv64/nrm2_rvv.c @@ -101,7 +101,7 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) { BLASLONG i=0; - if (n <= 0 || inc_x <= 0) return(0.0); + if (n <= 0 || inc_x == 0) return(0.0); if(n == 1) return (ABS(x[0])); unsigned int gvl = 0; @@ -190,7 +190,7 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) //finish any tail using scalar ops i*=gvl*inc_x; n*=inc_x; - while(i < n){ + while(abs(i) < abs(n)){ if ( x[i] != 0.0 ){ FLOAT absxi = ABS( x[i] ); if ( scale < absxi ){ From 18a6db686224bdd506570f930f91fed526e02e13 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Wed, 13 Mar 2024 11:10:26 +0100 Subject: [PATCH 229/311] Update nrm2_vector.c --- kernel/riscv64/nrm2_vector.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/kernel/riscv64/nrm2_vector.c b/kernel/riscv64/nrm2_vector.c index 129dbba7a..2d07b3ee2 100644 --- a/kernel/riscv64/nrm2_vector.c +++ b/kernel/riscv64/nrm2_vector.c @@ -193,7 +193,7 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) //finish any tail using scalar ops i*=gvl*inc_x; n*=inc_x; - while(abs(i) < abs(n)){ + while(i< n){ if ( x[i] != 0.0 ){ FLOAT absxi = ABS( x[i] ); if ( scale < absxi ){ From 9baa7579056a156cdda55f5f1c957eee0b6da8eb Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Wed, 13 Mar 2024 11:40:14 +0100 Subject: [PATCH 230/311] Update nrm2_vector.c --- kernel/riscv64/nrm2_vector.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/kernel/riscv64/nrm2_vector.c b/kernel/riscv64/nrm2_vector.c index 2d07b3ee2..fc349a0b3 100644 --- a/kernel/riscv64/nrm2_vector.c +++ b/kernel/riscv64/nrm2_vector.c @@ -122,7 +122,7 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) unsigned int stride_x = inc_x * sizeof(FLOAT); int idx = 0; - if( n >= gvl ) // don't pay overheads if we're not doing useful work + if( n >= gvl && inc_x > 0) // don't pay overheads if we're not doing useful work { for(i=0; i Date: Wed, 13 Mar 2024 13:07:26 +0100 Subject: [PATCH 231/311] Update nrm2_rvv.c --- kernel/riscv64/nrm2_rvv.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/kernel/riscv64/nrm2_rvv.c b/kernel/riscv64/nrm2_rvv.c index a0b201ec2..14ed68b0a 100644 --- a/kernel/riscv64/nrm2_rvv.c +++ b/kernel/riscv64/nrm2_rvv.c @@ -119,7 +119,7 @@ FLOAT CNAME(BLASLONG n, FLOAT *x, BLASLONG inc_x) unsigned int stride_x = inc_x * sizeof(FLOAT); int idx = 0; - if( n >= gvl ) // don't pay overheads if we're not doing useful work + if( n >= gvl && inc_x > 0 ) // don't pay overheads if we're not doing useful work { for(i=0; i Date: Thu, 14 Mar 2024 20:32:02 +0800 Subject: [PATCH 232/311] loongarch: Fixed {s/d/c/z}axpby LASX opt --- kernel/loongarch64/axpby_lasx.S | 10 +++++++++- kernel/loongarch64/caxpby_lasx.S | 10 ++++++++-- 2 files changed, 17 insertions(+), 3 deletions(-) diff --git a/kernel/loongarch64/axpby_lasx.S b/kernel/loongarch64/axpby_lasx.S index 7a246ca5c..b5cf77dc4 100644 --- a/kernel/loongarch64/axpby_lasx.S +++ b/kernel/loongarch64/axpby_lasx.S @@ -139,9 +139,9 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. xvst VX1, Y, 4 * SIZE #else xvfmul.s VX0, VX0, VXA - addi.d I, I, -1 xvst VX0, Y, 0 * SIZE #endif + addi.d I, I, -1 addi.d X, X, 8 * SIZE addi.d Y, Y, 8 * SIZE blt $r0, I, .L112 @@ -288,6 +288,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. addi.d X, X, 8 * SIZE addi.d I, I, -1 blt $r0, I, .L121 + move Y, YY b .L997 .align 3 @@ -334,6 +335,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. add.d YY, YY, INCY addi.d X, X, 8 * SIZE blt $r0, I, .L122 + move Y, YY b .L997 .align 3 @@ -425,6 +427,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. add.d YY, YY, INCY addi.d I, I, -1 blt $r0, I, .L123 + move Y, YY b .L997 .align 3 @@ -465,6 +468,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. add.d YY, YY, INCY addi.d I, I, -1 blt $r0, I, .L124 + move Y, YY b .L997 .align 3 @@ -803,6 +807,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #endif add.d YY, YY, INCY blt $r0, I, .L221 + move Y, YY b .L997 .align 3 @@ -895,6 +900,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #endif add.d YY, YY, INCY blt $r0, I, .L222 + move Y, YY b .L997 .align 3 @@ -987,6 +993,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #endif add.d YY, YY, INCY blt $r0, I, .L223 + move Y, YY b .L997 .align 3 @@ -1027,6 +1034,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. add.d YY, YY, INCY addi.d I, I, -1 blt $r0, I, .L224 + move Y, YY b .L997 .align 3 diff --git a/kernel/loongarch64/caxpby_lasx.S b/kernel/loongarch64/caxpby_lasx.S index c5802092e..5f34f1380 100644 --- a/kernel/loongarch64/caxpby_lasx.S +++ b/kernel/loongarch64/caxpby_lasx.S @@ -176,13 +176,13 @@ xvilvh.d VX3, x4, x3 xvst VX2, Y, 0 * SIZE xvst VX3, Y, 4 * SIZE - addi.d X, Y, 8 * SIZE + addi.d Y, Y, 8 * SIZE #else xvilvl.w VX2, x4 ,x3 xvilvh.w VX3, x4, x3 xvst VX2, Y, 0 * SIZE xvst VX3, Y, 8 * SIZE - addi.d X, Y, 16 * SIZE + addi.d Y, Y, 16 * SIZE #endif addi.d I, I, -1 blt $r0, I, .L113 @@ -617,6 +617,7 @@ xvstelm.d x4, YY, 1 * SIZE, 3 add.d YY, YY, INCY blt $r0, I, .L222 + move Y, YY b .L997 .align 3 #else @@ -691,6 +692,7 @@ xvstelm.w x4, YY, 1 * SIZE, 7 add.d YY, YY, INCY blt $r0, I, .L222 + move Y, YY b .L997 .align 3 #endif @@ -1011,7 +1013,11 @@ #endif .L997: +#ifdef DOUBLE + andi I, N, 3 +#else andi I, N, 7 +#endif bge $r0, I, .L999 .align 3 From 6159cffc58d233ca66651dc58af1e97fcf6ad5e8 Mon Sep 17 00:00:00 2001 From: gxw Date: Thu, 14 Mar 2024 20:32:39 +0800 Subject: [PATCH 233/311] loongarch: Fixed i{s/c/z}amin LASX opt --- kernel/loongarch64/iamin_lasx.S | 12 ++- kernel/loongarch64/icamin_lasx.S | 168 ++++++++++++++++++++++++------- 2 files changed, 141 insertions(+), 39 deletions(-) diff --git a/kernel/loongarch64/iamin_lasx.S b/kernel/loongarch64/iamin_lasx.S index 6ea117907..eeba4f239 100644 --- a/kernel/loongarch64/iamin_lasx.S +++ b/kernel/loongarch64/iamin_lasx.S @@ -144,7 +144,8 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. xvfmina.d VM1, VM0, VM1 #else addi.d I, I, -1 - xvadd.w VI2, VI1, VINC8 + xvadd.w VI1, VI1, VINC8 + xvor.v VI2, VI1, VI1 xvfmina.s VM1, VX0, VM0 #endif XVCMPEQ VT0, VM0, VM1 @@ -189,6 +190,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. XVFMINA VM0, VM0, VM1 XVCMPEQ VT0, VM0, VM1 xvbitsel.v VI0, VINC8, VINC4, VT0 + // $f9: x1 fcmp.ceq.d $fcc0, $f15, $f9 bceqz $fcc0, .L26 XVCMPLT VT0, VI1, VI0 @@ -357,7 +359,8 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. xvinsgr2vr.w VX0, t2, 5 xvinsgr2vr.w VX0, t3, 6 xvinsgr2vr.w VX0, t4, 7 - xvadd.w VI2, VI1, VINC8 + xvadd.w VI1, VI1, VINC8 + xvor.v VI2, VI1, VI1 xvfmina.s VM1, VX0, VM0 xvfcmp.ceq.s VT0, VM1, VM0 #endif @@ -393,7 +396,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. movfr2gr.d i0, $f20 .align 3 #else - fmov.s $f16, $f20 + fmov.s $f7, $f20 .align 3 .L252: @@ -449,9 +452,8 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. .L292: xvfmina.s VM0, VX0, VM0 xvfcmp.ceq.s VT0, VM0, VX0 - xvbitsel.v VI0, VI0, VI1, VT0 + xvbitsel.v VI0, VI0, $xr7, VT0 movfr2gr.s i0, $f20 - #endif .L21: // N<8 diff --git a/kernel/loongarch64/icamin_lasx.S b/kernel/loongarch64/icamin_lasx.S index 01abd45b2..d815c3f60 100644 --- a/kernel/loongarch64/icamin_lasx.S +++ b/kernel/loongarch64/icamin_lasx.S @@ -72,12 +72,25 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. FABS a1, a1 ADD s1, a1, a0 #ifdef DOUBLE - xvreplve0.d VM0, VM0 xvxor.v VI3, VI3, VI3 // 0 li.d I, -1 xvreplgr2vr.d VI4, I xvffint.d.l VI4, VI4 // -1 bne INCX, TEMP, .L20 + // Init VM0 + xvreplve0.d VM0, VM0 + xvld VX0, X, 0 * SIZE + xvld VX1, X, 4 * SIZE + xvpickev.d x1, VX1, VX0 + xvpickod.d x2, VX1, VX0 + xvfmul.d x3, VI4, x1 + xvfmul.d x4, VI4, x2 + xvfcmp.clt.d VT0, x1, VI3 + xvfcmp.clt.d VINC8, x2, VI3 + xvbitsel.v x1, x1, x3, VT0 + xvbitsel.v x2, x2, x4, VINC8 + xvfadd.d VM0, x1, x2 + addi.d i0, i0, 1 srai.d I, N, 2 bge $r0, I, .L21 @@ -100,12 +113,24 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. addi.d i0, i0, 2 xvinsgr2vr.d VI0, i0, 3 //4 #else - xvreplve0.w VM0, VM0 xvxor.v VI3, VI3, VI3 // 0 li.w I, -1 xvreplgr2vr.w VI4, I xvffint.s.w VI4, VI4 // -1 bne INCX, TEMP, .L20 + // Init VM0 + xvld VX0, X, 0 * SIZE + xvld VX1, X, 8 * SIZE + xvpickev.w x1, VX1, VX0 + xvpickod.w x2, VX1, VX0 + xvfmul.s x3, VI4, x1 + xvfmul.s x4, VI4, x2 + xvfcmp.clt.s VT0, x1, VI3 + xvfcmp.clt.s VINC4, x2, VI3 + xvbitsel.v x1, x1, x3, VT0 + xvbitsel.v x2, x2, x4, VINC4 + xvfadd.s VM0, x1, x2 + addi.w i0, i0, 1 srai.d I, N, 3 bge $r0, I, .L21 @@ -160,6 +185,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. xvfcmp.clt.d VINC8, x2, VI3 xvbitsel.v x1, x1, x3, VT0 xvbitsel.v x2, x2, x4, VINC8 + addi.d X, X, 8 * SIZE #else xvadd.w VI1, VI1, VINC8 xvld VX1, X, 8 * SIZE @@ -172,11 +198,11 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. xvfcmp.clt.s VINC4, x2, VI3 xvbitsel.v x1, x1, x3, VT0 xvbitsel.v x2, x2, x4, VINC4 + addi.d X, X, 16 * SIZE #endif XVFADD x1, x1, x2 XVFMIN x3, VM0, x1 XVCMPEQ VT0, x3, VM0 - addi.d X, X, 8 * SIZE xvbitsel.v VM0, x3, VM0, VT0 xvbitsel.v VI0, VI1, VI0, VT0 blt $r0, I, .L10 @@ -214,13 +240,13 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. xvpickve.w x2, VM0, 1 xvpickve.w x3, VM0, 2 xvpickve.w x4, VM0, 3 - xvfcmp.clt.s VT0, x1, x2 + xvfcmp.clt.s VT0, x2, x1 xvbitsel.v VM1, x1, x2, VT0 xvbitsel.v VINC4, VI1, VI2, VT0 - xvfcmp.clt.s VT0, x3, x4 + xvfcmp.clt.s VT0, x4, x3 xvbitsel.v VM0, x3, x4, VT0 xvbitsel.v VINC8, VI3, VI4, VT0 - xvfcmp.clt.s VT0, VM0, VM1 + xvfcmp.clt.s VT0, VM1, VM0 xvbitsel.v VM0, VM0, VM1, VT0 xvbitsel.v VI0, VINC8, VINC4, VT0 #endif @@ -233,6 +259,34 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. .L20: // INCX!=1 #ifdef DOUBLE + // Init VM0 + ld.d t1, X, 0 * SIZE + ld.d t2, X, 1 * SIZE + add.d i1, X, INCX + ld.d t3, i1, 0 * SIZE + ld.d t4, i1, 1 * SIZE + add.d i1, i1, INCX + xvinsgr2vr.d x1, t1, 0 + xvinsgr2vr.d x2, t2, 0 + xvinsgr2vr.d x1, t3, 1 + xvinsgr2vr.d x2, t4, 1 + ld.d t1, i1, 0 * SIZE + ld.d t2, i1, 1 * SIZE + add.d i1, i1, INCX + ld.d t3, i1, 0 * SIZE + ld.d t4, i1, 1 * SIZE + xvinsgr2vr.d x1, t1, 2 + xvinsgr2vr.d x2, t2, 2 + xvinsgr2vr.d x1, t3, 3 + xvinsgr2vr.d x2, t4, 3 + xvfmul.d x3, VI4, x1 + xvfmul.d x4, VI4, x2 + xvfcmp.clt.d VT0, x1, VI3 + xvfcmp.clt.d VINC8, x2, VI3 + xvbitsel.v x1, x1, x3, VT0 + xvbitsel.v x2, x2, x4, VINC8 + xvfadd.d VM0, x1, x2 + addi.d i0, i0, 1 srai.d I, N, 2 bge $r0, I, .L21 @@ -240,21 +294,70 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. xvreplgr2vr.d VINC4, i0 addi.d i0, i0, -7 xvinsgr2vr.d VI1, i0, 0 //initialize the index value for vectorization - addi.d i0, i0, 2 + addi.d i0, i0, 1 xvinsgr2vr.d VI1, i0, 1 - addi.d i0, i0, -1 + addi.d i0, i0, 1 xvinsgr2vr.d VI1, i0, 2 - addi.d i0, i0, 2 + addi.d i0, i0, 1 xvinsgr2vr.d VI1, i0, 3 addi.d i0, i0, 1 xvinsgr2vr.d VI0, i0, 0 //1 - addi.d i0, i0, 2 - xvinsgr2vr.d VI0, i0, 1 //3 - addi.d i0, i0, -1 - xvinsgr2vr.d VI0, i0, 2 //2 - addi.d i0, i0, 2 + addi.d i0, i0, 1 + xvinsgr2vr.d VI0, i0, 1 //2 + addi.d i0, i0, 1 + xvinsgr2vr.d VI0, i0, 2 //3 + addi.d i0, i0, 1 xvinsgr2vr.d VI0, i0, 3 //4 #else + // Init VM0 + ld.w t1, X, 0 * SIZE + ld.w t2, X, 1 * SIZE + add.d i1, X, INCX + ld.w t3, i1, 0 * SIZE + ld.w t4, i1, 1 * SIZE + add.d i1, i1, INCX + xvinsgr2vr.w x1, t1, 0 + xvinsgr2vr.w x2, t2, 0 + xvinsgr2vr.w x1, t3, 1 + xvinsgr2vr.w x2, t4, 1 + ld.w t1, i1, 0 * SIZE + ld.w t2, i1, 1 * SIZE + add.d i1, i1, INCX + ld.w t3, i1, 0 * SIZE + ld.w t4, i1, 1 * SIZE + add.d i1, i1, INCX + xvinsgr2vr.w x1, t1, 2 + xvinsgr2vr.w x2, t2, 2 + xvinsgr2vr.w x1, t3, 3 + xvinsgr2vr.w x2, t4, 3 + ld.w t1, i1, 0 * SIZE + ld.w t2, i1, 1 * SIZE + add.d i1, i1, INCX + ld.w t3, i1, 0 * SIZE + ld.w t4, i1, 1 * SIZE + add.d i1, i1, INCX + xvinsgr2vr.w x1, t1, 4 + xvinsgr2vr.w x2, t2, 4 + xvinsgr2vr.w x1, t3, 5 + xvinsgr2vr.w x2, t4, 5 + ld.w t1, i1, 0 * SIZE + ld.w t2, i1, 1 * SIZE + add.d i1, i1, INCX + ld.w t3, i1, 0 * SIZE + ld.w t4, i1, 1 * SIZE + add.d i1, i1, INCX + xvinsgr2vr.w x1, t1, 6 + xvinsgr2vr.w x2, t2, 6 + xvinsgr2vr.w x1, t3, 7 + xvinsgr2vr.w x2, t4, 7 + xvfmul.s x3, VI4, x1 + xvfmul.s x4, VI4, x2 + xvfcmp.clt.s VT0, x1, VI3 + xvfcmp.clt.s VINC8, x2, VI3 + xvbitsel.v x1, x1, x3, VT0 + xvbitsel.v x2, x2, x4, VINC8 + xvfadd.s VM0, x1, x2 + addi.w i0, i0, 1 srai.d I, N, 3 bge $r0, I, .L21 @@ -264,15 +367,15 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. xvinsgr2vr.w VI1, i0, 0 //initialize the index value for vectorization addi.w i0, i0, 1 xvinsgr2vr.w VI1, i0, 1 - addi.w i0, i0, 3 + addi.w i0, i0, 1 xvinsgr2vr.w VI1, i0, 2 addi.w i0, i0, 1 xvinsgr2vr.w VI1, i0, 3 - addi.w i0, i0, -3 + addi.w i0, i0, 1 xvinsgr2vr.w VI1, i0, 4 addi.w i0, i0, 1 xvinsgr2vr.w VI1, i0, 5 - addi.w i0, i0, 3 + addi.w i0, i0, 1 xvinsgr2vr.w VI1, i0, 6 addi.w i0, i0, 1 xvinsgr2vr.w VI1, i0, 7 @@ -280,15 +383,15 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. xvinsgr2vr.w VI0, i0, 0 //1 addi.w i0, i0, 1 xvinsgr2vr.w VI0, i0, 1 //2 - addi.w i0, i0, 3 - xvinsgr2vr.w VI0, i0, 2 //5 addi.w i0, i0, 1 - xvinsgr2vr.w VI0, i0, 3 //6 - addi.w i0, i0, -3 - xvinsgr2vr.w VI0, i0, 4 //3 + xvinsgr2vr.w VI0, i0, 2 //3 + addi.w i0, i0, 1 + xvinsgr2vr.w VI0, i0, 3 //4 + addi.w i0, i0, 1 + xvinsgr2vr.w VI0, i0, 4 //5 + addi.w i0, i0, 1 + xvinsgr2vr.w VI0, i0, 5 //6 addi.w i0, i0, 1 - xvinsgr2vr.w VI0, i0, 5 //4 - addi.w i0, i0, 3 xvinsgr2vr.w VI0, i0, 6 //7 addi.w i0, i0, 1 xvinsgr2vr.w VI0, i0, 7 //8 @@ -350,7 +453,6 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. xvinsgr2vr.w x2, t2, 4 xvinsgr2vr.w x1, t3, 5 xvinsgr2vr.w x2, t4, 5 - xvadd.w VI1, VI1, VINC8 ld.w t1, X, 0 * SIZE ld.w t2, X, 1 * SIZE add.d X, X, INCX @@ -361,8 +463,6 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. xvinsgr2vr.w x2, t2, 6 xvinsgr2vr.w x1, t3, 7 xvinsgr2vr.w x2, t4, 7 - xvpickev.w x1, VX1, VX0 - xvpickod.w x2, VX1, VX0 #endif addi.d I, I, -1 XVFMUL x3, VI4, x1 @@ -410,13 +510,13 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. xvpickve.w x2, VM0, 1 xvpickve.w x3, VM0, 2 xvpickve.w x4, VM0, 3 - xvfcmp.clt.s VT0, x1, x2 + xvfcmp.clt.s VT0, x2, x1 xvbitsel.v VM1, x1, x2, VT0 xvbitsel.v VINC4, VI1, VI2, VT0 - xvfcmp.clt.s VT0, x3, x4 + xvfcmp.clt.s VT0, x4, x3 xvbitsel.v VM0, x3, x4, VT0 xvbitsel.v VINC8, VI3, VI4, VT0 - xvfcmp.clt.s VT0, VM0, VM1 + xvfcmp.clt.s VT0, VM1, VM0 xvbitsel.v VM0, VM0, VM1, VT0 #endif xvbitsel.v VI0, VINC8, VINC4, VT0 @@ -475,13 +575,13 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. xvpickve.w x2, VM0, 5 xvpickve.w x3, VM0, 6 xvpickve.w x4, VM0, 7 - xvfcmp.clt.s VT0, x1, x2 + xvfcmp.clt.s VT0, x2, x1 xvbitsel.v x1, x1, x2, VT0 xvbitsel.v VINC4, VI1, VI2, VT0 - xvfcmp.clt.s VT0, x3, x4 + xvfcmp.clt.s VT0, x4, x3 xvbitsel.v VM0, x3, x4, VT0 xvbitsel.v VINC8, VI3, VI4, VT0 - xvfcmp.clt.s VT0, VM0, x1 + xvfcmp.clt.s VT0, x1, VM0 xvbitsel.v VM0, VM0, x1, VT0 xvbitsel.v VI0, VINC8, VINC4, VT0 fcmp.ceq.d $fcc0, $f15, $f9 @@ -512,7 +612,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. .align 3 .L292: - fcmp.clt.s $fcc0, $f15, $f13 + fcmp.clt.s $fcc0, $f13, $f15 fsel $f15, $f15, $f13, $fcc0 fsel $f20, $f20, $f16, $fcc0 movfr2gr.s i0, $f20 From 6534d378b7454eb19864b797142a1bb2af246349 Mon Sep 17 00:00:00 2001 From: gxw Date: Sat, 16 Mar 2024 09:36:05 +0800 Subject: [PATCH 234/311] loongarch: Fixed {s/d/c/z}sum LASX opt --- kernel/loongarch64/csum_lasx.S | 4 ++-- kernel/loongarch64/sum_lasx.S | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/kernel/loongarch64/csum_lasx.S b/kernel/loongarch64/csum_lasx.S index 3e65f2c15..146689978 100644 --- a/kernel/loongarch64/csum_lasx.S +++ b/kernel/loongarch64/csum_lasx.S @@ -104,7 +104,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. xvfadd.s res1, VX0, res1 xvfadd.s res1, VX1, res1 xvfadd.s res1, VX2, res1 - xvfadd.s res1, VX2, res1 + xvfadd.s res1, VX3, res1 #endif .align 3 @@ -246,7 +246,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. xvfadd.s res1, VX0, res1 xvfadd.s res1, VX1, res1 xvfadd.s res1, VX2, res1 - xvfadd.s res1, VX2, res1 + xvfadd.s res1, VX3, res1 #endif .align 3 diff --git a/kernel/loongarch64/sum_lasx.S b/kernel/loongarch64/sum_lasx.S index fd6d5adb3..895b49b90 100644 --- a/kernel/loongarch64/sum_lasx.S +++ b/kernel/loongarch64/sum_lasx.S @@ -96,7 +96,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. xvfadd.s res1, VX0, res1 xvfadd.s res1, VX1, res1 xvfadd.s res1, VX2, res1 - xvfadd.s res1, VX2, res1 + xvfadd.s res1, VX3, res1 #endif .align 3 @@ -200,7 +200,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. xvfadd.s res1, VX0, res1 xvfadd.s res1, VX1, res1 xvfadd.s res1, VX2, res1 - xvfadd.s res1, VX2, res1 + xvfadd.s res1, VX3, res1 #endif .align 3 From a10dde555407d11b82063df1472a209898489e37 Mon Sep 17 00:00:00 2001 From: gxw Date: Sat, 16 Mar 2024 09:41:38 +0800 Subject: [PATCH 235/311] loongarch: Fixed {s/d/sc/dz}amin LASX opt --- kernel/loongarch64/amin_lasx.S | 6 +++--- kernel/loongarch64/camin_lasx.S | 25 ++++++++++++++++++++----- 2 files changed, 23 insertions(+), 8 deletions(-) diff --git a/kernel/loongarch64/amin_lasx.S b/kernel/loongarch64/amin_lasx.S index c91a33006..62b109799 100644 --- a/kernel/loongarch64/amin_lasx.S +++ b/kernel/loongarch64/amin_lasx.S @@ -160,8 +160,8 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. xvinsgr2vr.d VX1, t2, 1 xvinsgr2vr.d VX1, t3, 2 xvinsgr2vr.d VX1, t4, 3 - xvfmaxa.d VM1, VX0, VX1 - xvfmaxa.d VM0, VM0, VM1 + xvfmina.d VM1, VX0, VX1 + xvfmina.d VM0, VM0, VM1 #else ld.w t1, X, 0 add.d X, X, INCX @@ -187,7 +187,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. xvinsgr2vr.w VM1, t2, 5 xvinsgr2vr.w VM1, t3, 6 xvinsgr2vr.w VM1, t4, 7 - xvfmaxa.s VM0, VM0, VM1 + xvfmina.s VM0, VM0, VM1 #endif addi.d I, I, -1 blt $r0, I, .L21 diff --git a/kernel/loongarch64/camin_lasx.S b/kernel/loongarch64/camin_lasx.S index c1c4c98c8..c5074f79d 100644 --- a/kernel/loongarch64/camin_lasx.S +++ b/kernel/loongarch64/camin_lasx.S @@ -116,15 +116,27 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #ifdef DOUBLE xvpickve.d x1, VM0, 0 xvpickve.d x2, VM0, 1 - XVFMIN VM0, x1, x2 + XVFMIN VX0, x1, x2 + xvpickve.d x1, VM0, 2 + xvpickve.d x2, VM0, 3 + XVFMIN VX1, x1, x2 + XVFMIN VM0, VX0, VX1 #else xvpickve.w x1, VM0, 0 xvpickve.w x2, VM0, 1 xvpickve.w x3, VM0, 2 xvpickve.w x4, VM0, 3 + XVFMIN VX0, x1, x2 + XVFMIN VX1, x3, x4 + XVFMIN VX0, VX0, VX1 + xvpickve.w x1, VM0, 4 + xvpickve.w x2, VM0, 5 + xvpickve.w x3, VM0, 6 + xvpickve.w x4, VM0, 7 XVFMIN VM0, x1, x2 XVFMIN VM1, x3, x4 XVFMIN VM0, VM0, VM1 + XVFMIN VM0, VM0, VX0 #endif b .L23 .align 3 @@ -159,7 +171,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. FABS t4, t4 ADD t1, t1, t2 ADD t3, t3, t4 - FMIN s1, t1, t3 + FMIN s2, t1, t3 LD t1, X, 0 * SIZE LD t2, X, 1 * SIZE add.d X, X, INCX @@ -187,13 +199,16 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ADD t1, t1, t2 ADD t3, t3, t4 FMIN s4, t1, t3 + + FMIN s1, s1, s2 + FMIN s3, s3, s4 + FMIN a0, a0, s3 + FMIN a0, a0, s1 blt $r0, I, .L21 .align 3 .L22: - FMIN s1, s1, s2 - FMIN s3, s3, s4 - FMIN s1, s1, s3 + MOV s1, a0 .align 3 .L23: //N<8 From 60e251a1f864228081fb74d13de96024a4c2071a Mon Sep 17 00:00:00 2001 From: gxw Date: Sat, 16 Mar 2024 10:42:40 +0800 Subject: [PATCH 236/311] loongarch: Fixed {sc/dz}amax LASX opt --- kernel/loongarch64/camax_lasx.S | 25 ++++++++++++++++++++----- 1 file changed, 20 insertions(+), 5 deletions(-) diff --git a/kernel/loongarch64/camax_lasx.S b/kernel/loongarch64/camax_lasx.S index f9a4e9012..b646f7412 100644 --- a/kernel/loongarch64/camax_lasx.S +++ b/kernel/loongarch64/camax_lasx.S @@ -107,15 +107,27 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #ifdef DOUBLE xvpickve.d x1, VM0, 0 xvpickve.d x2, VM0, 1 - XVFMAX VM0, x1, x2 + XVFMAX VX0, x1, x2 + xvpickve.d x1, VM0, 2 + xvpickve.d x2, VM0, 3 + XVFMAX VX1, x1, x2 + XVFMAX VM0, VX0, VX1 #else xvpickve.w x1, VM0, 0 xvpickve.w x2, VM0, 1 xvpickve.w x3, VM0, 2 xvpickve.w x4, VM0, 3 + XVFMAX VX0, x1, x2 + XVFMAX VX1, x3, x4 + XVFMAX VX0, VX0, VX1 + xvpickve.w x1, VM0, 4 + xvpickve.w x2, VM0, 5 + xvpickve.w x3, VM0, 6 + xvpickve.w x4, VM0, 7 XVFMAX VM0, x1, x2 XVFMAX VM1, x3, x4 XVFMAX VM0, VM0, VM1 + XVFMAX VM0, VM0, VX0 #endif b .L23 .align 3 @@ -150,7 +162,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. FABS t4, t4 ADD t1, t1, t2 ADD t3, t3, t4 - FMAX s1, t1, t3 + FMAX s2, t1, t3 LD t1, X, 0 * SIZE LD t2, X, 1 * SIZE add.d X, X, INCX @@ -178,13 +190,16 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ADD t1, t1, t2 ADD t3, t3, t4 FMAX s4, t1, t3 + + FMAX s1, s1, s2 + FMAX s3, s3, s4 + FMAX a0, a0, s3 + FMAX a0, a0, s1 blt $r0, I, .L21 .align 3 .L22: - FMAX s1, s1, s2 - FMAX s3, s3, s4 - FMAX s1, s1, s3 + MOV s1, a0 .align 3 .L23: //N<8 From 2e9ce9bb073649ca7716332854fc00d165b38426 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Sun, 17 Mar 2024 19:20:19 +0100 Subject: [PATCH 237/311] Fix argument lists of RELAPACK_?gemmt for good --- relapack/src/lapack_wrappers.c | 12 ++++-------- 1 file changed, 4 insertions(+), 8 deletions(-) diff --git a/relapack/src/lapack_wrappers.c b/relapack/src/lapack_wrappers.c index fc3dbc11e..d6845fc9d 100644 --- a/relapack/src/lapack_wrappers.c +++ b/relapack/src/lapack_wrappers.c @@ -566,8 +566,7 @@ void LAPACK(sgemmt)( const float *B, const blasint *ldB, const float *beta, float *C, const blasint *ldC ) { - blasint info; - RELAPACK_sgemmt(uplo, transA, transB, n, k, alpha, A, ldA, B, ldB, beta, C, info); + RELAPACK_sgemmt(uplo, transA, transB, n, k, alpha, A, ldA, B, ldB, beta, C, ldC); } #endif @@ -579,8 +578,7 @@ void LAPACK(dgemmt)( const double *B, const blasint *ldB, const double *beta, double *C, const blasint *ldC ) { - blasint info; - RELAPACK_dgemmt(uplo, transA, transB, n, k, alpha, A, ldA, B, ldB, beta, C, info); + RELAPACK_dgemmt(uplo, transA, transB, n, k, alpha, A, ldA, B, ldB, beta, C, ldC); } #endif @@ -592,8 +590,7 @@ void LAPACK(cgemmt)( const float *B, const blasint *ldB, const float *beta, float *C, const blasint *ldC ) { - blasint info; - RELAPACK_cgemmt(uplo, transA, transB, n, k, alpha, A, ldA, B, ldB, beta, C, info); + RELAPACK_cgemmt(uplo, transA, transB, n, k, alpha, A, ldA, B, ldB, beta, C, ldC); } #endif @@ -605,7 +602,6 @@ void LAPACK(zgemmt)( const double *B, const blasint *ldB, const double *beta, double *C, const blasint *ldC ) { - blasint info; - RELAPACK_zgemmt(uplo, transA, transB, n, k, alpha, A, ldA, B, ldB, beta, C, info); + RELAPACK_zgemmt(uplo, transA, transB, n, k, alpha, A, ldA, B, ldB, beta, C, ldC); } #endif From ac460eb42ae2a6bf3e64dc36a860b6d23109e4db Mon Sep 17 00:00:00 2001 From: gxw Date: Mon, 18 Mar 2024 15:53:10 +0800 Subject: [PATCH 238/311] loongarch: Fixed i{c/z}amin LSX opt --- kernel/loongarch64/icamin_lsx.S | 116 +++++++++++++++++++++++++++----- 1 file changed, 99 insertions(+), 17 deletions(-) diff --git a/kernel/loongarch64/icamin_lsx.S b/kernel/loongarch64/icamin_lsx.S index a08cd33c5..982a41fe2 100644 --- a/kernel/loongarch64/icamin_lsx.S +++ b/kernel/loongarch64/icamin_lsx.S @@ -70,18 +70,17 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. LD a1, X, 1 * SIZE FABS a0, a0 FABS a1, a1 - ADD s1, a1, a0 - vreplvei.w VM0, VM0, 0 + ADD s1, a1, a0 // Initialization value vxor.v VI3, VI3, VI3 // 0 #ifdef DOUBLE li.d I, -1 vreplgr2vr.d VI4, I vffint.d.l VI4, VI4 // -1 - bne INCX, TEMP, .L20 + bne INCX, TEMP, .L20 // incx != 1 + + // Init Index addi.d i0, i0, 1 - srai.d I, N, 2 - bge $r0, I, .L21 - slli.d i0, i0, 1 //2 + slli.d i0, i0, 1 // 2 vreplgr2vr.d VINC4, i0 addi.d i0, i0, -3 vinsgr2vr.d VI1, i0, 0 //initialize the index value for vectorization @@ -91,14 +90,30 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. vinsgr2vr.d VI0, i0, 0 //1 addi.d i0, i0, 1 vinsgr2vr.d VI0, i0, 1 //2 + + srai.d I, N, 2 + bge $r0, I, .L21 + + // Init VM0 + vld VX0, X, 0 * SIZE + vld VX1, X, 2 * SIZE + vpickev.d x1, VX1, VX0 + vpickod.d x2, VX1, VX0 + vfmul.d x3, VI4, x1 + vfmul.d x4, VI4, x2 + vfcmp.clt.d VT0, x1, VI3 + vfcmp.clt.d VINC8, x2, VI3 + vbitsel.v x1, x1, x3, VT0 + vbitsel.v x2, x2, x4, VINC8 + vfadd.d VM0, x1, x2 #else li.w I, -1 vreplgr2vr.w VI4, I vffint.s.w VI4, VI4 // -1 - bne INCX, TEMP, .L20 + bne INCX, TEMP, .L20 // incx != 1 + + // Init Index addi.w i0, i0, 1 - srai.d I, N, 2 - bge $r0, I, .L21 slli.w i0, i0, 2 //4 vreplgr2vr.w VINC4, i0 addi.w i0, i0, -7 @@ -117,6 +132,22 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. vinsgr2vr.w VI0, i0, 2 //3 addi.w i0, i0, 1 vinsgr2vr.w VI0, i0, 3 //4 + + srai.d I, N, 2 + bge $r0, I, .L21 + + // Init VM0 + vld VX0, X, 0 * SIZE + vld VX1, X, 4 * SIZE + vpickev.w x1, VX1, VX0 + vpickod.w x2, VX1, VX0 + vfmul.s x3, VI4, x1 + vfmul.s x4, VI4, x2 + vfcmp.clt.s VT0, x1, VI3 + vfcmp.clt.s VINC8, x2, VI3 + vbitsel.v x1, x1, x3, VT0 + vbitsel.v x2, x2, x4, VINC8 + vfadd.s VM0, x1, x2 #endif .align 3 @@ -139,6 +170,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. vfcmp.ceq.d VT0, x3, VM0 vbitsel.v VM0, x3, VM0, VT0 vbitsel.v VI0, VI1, VI0, VT0 + vld VX0, X, 4 * SIZE vadd.d VI1, VI1, VINC4 vld VX1, X, 6 * SIZE @@ -206,9 +238,8 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. .L20: // INCX!=1 #ifdef DOUBLE addi.d i0, i0, 1 - srai.d I, N, 2 - bge $r0, I, .L21 - slli.d i0, i0, 1 //2 + // Init index + slli.d i0, i0, 1 //2 vreplgr2vr.d VINC4, i0 addi.d i0, i0, -3 vinsgr2vr.d VI1, i0, 0 //initialize the index value for vectorization @@ -218,10 +249,32 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. vinsgr2vr.d VI0, i0, 0 //1 addi.d i0, i0, 1 vinsgr2vr.d VI0, i0, 1 //2 + + srai.d I, N, 2 + bge $r0, I, .L21 // N < 4 + + // Init VM0 + ld.d t1, X, 0 * SIZE + ld.d t2, X, 1 * SIZE + add.d i1, X, INCX + ld.d t3, i1, 0 * SIZE + ld.d t4, i1, 1 * SIZE + add.d i1, i1, INCX + vinsgr2vr.d x1, t1, 0 + vinsgr2vr.d x2, t2, 0 + vinsgr2vr.d x1, t3, 1 + vinsgr2vr.d x2, t4, 1 + vfmul.d x3, VI4, x1 + vfmul.d x4, VI4, x2 + vfcmp.clt.d VT0, x1, VI3 + vfcmp.clt.d VINC8, x2, VI3 + vbitsel.v x1, x1, x3, VT0 + vbitsel.v x2, x2, x4, VINC8 + vfadd.d VM0, x1, x2 #else addi.w i0, i0, 1 - srai.d I, N, 2 - bge $r0, I, .L21 + + // Init index slli.w i0, i0, 2 //4 vreplgr2vr.w VINC4, i0 addi.w i0, i0, -7 @@ -240,6 +293,36 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. vinsgr2vr.w VI0, i0, 2 //3 addi.w i0, i0, 1 vinsgr2vr.w VI0, i0, 3 //4 + + srai.d I, N, 2 + bge $r0, I, .L21 // N < 4 + + // Init VM0 + ld.w t1, X, 0 * SIZE + ld.w t2, X, 1 * SIZE + add.d i1, X, INCX + ld.w t3, i1, 0 * SIZE + ld.w t4, i1, 1 * SIZE + add.d i1, i1, INCX + vinsgr2vr.w x1, t1, 0 + vinsgr2vr.w x2, t2, 0 + vinsgr2vr.w x1, t3, 1 + vinsgr2vr.w x2, t4, 1 + ld.w t1, i1, 0 * SIZE + ld.w t2, i1, 1 * SIZE + add.d i1, i1, INCX + ld.w t3, i1, 0 * SIZE + ld.w t4, i1, 1 * SIZE + add.d i1, i1, INCX + vinsgr2vr.w x1, t1, 2 + vinsgr2vr.w x2, t2, 2 + vinsgr2vr.w x1, t3, 3 + vinsgr2vr.w x2, t4, 3 + vfcmp.clt.s VT0, x1, VI3 + vfcmp.clt.s VINC8, x2, VI3 + vbitsel.v x1, x1, x3, VT0 + vbitsel.v x2, x2, x4, VINC8 + vfadd.s VM0, x1, x2 #endif .align 3 @@ -300,8 +383,6 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. vinsgr2vr.w x2, t2, 2 vinsgr2vr.w x1, t3, 3 vinsgr2vr.w x2, t4, 3 - vpickev.w x1, VX1, VX0 - vpickod.w x2, VX1, VX0 #endif addi.d I, I, -1 VFMUL x3, VI4, x1 @@ -358,12 +439,13 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #ifdef DOUBLE vfmina.d VM0, x1, x2 vfcmp.ceq.d VT0, x1, VM0 + vbitsel.v VI0, VI2, VI1, VT0 #else fcmp.ceq.d $fcc0, $f15, $f10 bceqz $fcc0, .L27 vfcmp.clt.s VT0, VI2, VI0 -#endif vbitsel.v VI0, VI0, VI2, VT0 +#endif .align 3 .L27: From bbf82cb624d7a03d230e2411a40cfa326ca9c806 Mon Sep 17 00:00:00 2001 From: gxw Date: Mon, 18 Mar 2024 17:51:42 +0800 Subject: [PATCH 239/311] loongarch: Fixed {s/d}axpby LSX opt --- kernel/loongarch64/axpby_lsx.S | 1 + 1 file changed, 1 insertion(+) diff --git a/kernel/loongarch64/axpby_lsx.S b/kernel/loongarch64/axpby_lsx.S index e50d4cdcc..dae34fec9 100644 --- a/kernel/loongarch64/axpby_lsx.S +++ b/kernel/loongarch64/axpby_lsx.S @@ -990,6 +990,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #endif add.d YY, YY, INCY blt $r0, I, .L222 + move Y, YY b .L997 .align 3 From ad13e04669baa3d1e0569c81cc90716325ef6e3a Mon Sep 17 00:00:00 2001 From: gxw Date: Tue, 19 Mar 2024 09:18:44 +0800 Subject: [PATCH 240/311] loongarch: Fixed {s/d/sc/dz}amin LSX opt --- kernel/loongarch64/amin_lsx.S | 12 ++++++------ kernel/loongarch64/camin_lsx.S | 11 +++++++---- 2 files changed, 13 insertions(+), 10 deletions(-) diff --git a/kernel/loongarch64/amin_lsx.S b/kernel/loongarch64/amin_lsx.S index 47701b6e4..690444ca7 100644 --- a/kernel/loongarch64/amin_lsx.S +++ b/kernel/loongarch64/amin_lsx.S @@ -146,7 +146,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. add.d X, X, INCX vinsgr2vr.d VX1, t3, 0 vinsgr2vr.d VX1, t4, 1 - vfmaxa.d VM1, VX0, VX1 + vfmina.d VM1, VX0, VX1 ld.d t1, X, 0 * SIZE add.d X, X, INCX ld.d t2, X, 0 * SIZE @@ -159,9 +159,9 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. add.d X, X, INCX vinsgr2vr.d VX1, t3, 0 vinsgr2vr.d VX1, t4, 1 - vfmaxa.d VM2, VX0, VX1 - vfmaxa.d VM1, VM1, VM2 - vfmaxa.d VM0, VM0, VM1 + vfmina.d VM2, VX0, VX1 + vfmina.d VM1, VM1, VM2 + vfmina.d VM0, VM0, VM1 #else ld.w t1, X, 0 add.d X, X, INCX @@ -187,8 +187,8 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. vinsgr2vr.w VX1, t2, 1 vinsgr2vr.w VX1, t3, 2 vinsgr2vr.w VX1, t4, 3 - vfmaxa.s VM1, VX0, VX1 - vfmaxa.s VM0, VM0, VM1 + vfmina.s VM1, VX0, VX1 + vfmina.s VM0, VM0, VM1 #endif addi.d I, I, -1 blt $r0, I, .L21 diff --git a/kernel/loongarch64/camin_lsx.S b/kernel/loongarch64/camin_lsx.S index ff666ea8f..2fd78a233 100644 --- a/kernel/loongarch64/camin_lsx.S +++ b/kernel/loongarch64/camin_lsx.S @@ -186,7 +186,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. FABS t4, t4 ADD t1, t1, t2 ADD t3, t3, t4 - FMIN s1, t1, t3 + FMIN s2, t1, t3 LD t1, X, 0 * SIZE LD t2, X, 1 * SIZE add.d X, X, INCX @@ -214,13 +214,16 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ADD t1, t1, t2 ADD t3, t3, t4 FMIN s4, t1, t3 + + FMIN s1, s1, s2 + FMIN s3, s3, s4 + FMIN a0, a0, s3 + FMIN a0, a0, s1 blt $r0, I, .L21 .align 3 .L22: - FMIN s1, s1, s2 - FMIN s3, s3, s4 - FMIN s1, s1, s3 + MOV s1, a0 .align 3 .L23: //N<8 From b5eb9d6bacdd1ed0b13b91ed56d9adc96d7ee26e Mon Sep 17 00:00:00 2001 From: gxw Date: Tue, 19 Mar 2024 09:56:11 +0800 Subject: [PATCH 241/311] loongarch: Fixed {sc/dz}amax LSX opt --- kernel/loongarch64/camax_lsx.S | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/kernel/loongarch64/camax_lsx.S b/kernel/loongarch64/camax_lsx.S index cf46cb016..12922ecd8 100644 --- a/kernel/loongarch64/camax_lsx.S +++ b/kernel/loongarch64/camax_lsx.S @@ -177,7 +177,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. FABS t4, t4 ADD t1, t1, t2 ADD t3, t3, t4 - FMAX s1, t1, t3 + FMAX s2, t1, t3 LD t1, X, 0 * SIZE LD t2, X, 1 * SIZE add.d X, X, INCX @@ -205,13 +205,16 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ADD t1, t1, t2 ADD t3, t3, t4 FMAX s4, t1, t3 + + FMAX s1, s1, s2 + FMAX s3, s3, s4 + FMAX a0, a0, s3 + FMAX a0, a0, s1 blt $r0, I, .L21 .align 3 .L22: - FMAX s1, s1, s2 - FMAX s3, s3, s4 - FMAX s1, s1, s3 + MOV s1, a0 .align 3 .L23: //N<8 From 50869f6ca8d0e5cc93f03cfcec8066a766e1cf56 Mon Sep 17 00:00:00 2001 From: gxw Date: Tue, 19 Mar 2024 10:08:11 +0800 Subject: [PATCH 242/311] loongarch: Fixed zrot LSX opt --- kernel/loongarch64/crot_lsx.S | 1 + 1 file changed, 1 insertion(+) diff --git a/kernel/loongarch64/crot_lsx.S b/kernel/loongarch64/crot_lsx.S index 126257edc..af8f13b77 100644 --- a/kernel/loongarch64/crot_lsx.S +++ b/kernel/loongarch64/crot_lsx.S @@ -82,6 +82,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. vreplgr2vr.d VXC, t1 vreplgr2vr.d VXS, t2 vreplgr2vr.d VXZ, t3 + srai.d I, N, 1 #else vreplgr2vr.w VXC, t1 vreplgr2vr.w VXS, t2 From f5b2a877e23088d95bd0589172dda1307dcc1f06 Mon Sep 17 00:00:00 2001 From: Rajalakshmi Srinivasaraghavan Date: Wed, 20 Mar 2024 10:17:49 -0500 Subject: [PATCH 243/311] POWER9: Use default param values from POWER8 on AIX AIX uses KERNEL.POWER8 optimization on POWER9 and changing the default GEMM parameters in param.h to use POWER8 values on POWER9. --- param.h | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/param.h b/param.h index 8bdc03380..fef3a0991 100644 --- a/param.h +++ b/param.h @@ -2493,7 +2493,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #endif -#if defined(POWER8) +#if defined(POWER8) || (defined(POWER9) && defined(OS_AIX)) #define SNUMOPT 16 #define DNUMOPT 8 @@ -2547,7 +2547,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #endif -#if defined(POWER9) +#if defined(POWER9) && defined(OS_LINUX) #define SNUMOPT 16 #define DNUMOPT 8 From 05d0438c25f62039dfe7b5fcd5f007fdd8b09db5 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Wed, 20 Mar 2024 19:19:11 +0100 Subject: [PATCH 244/311] Fix OPENBLAS_LOOPS assignment --- benchmark/getri.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/benchmark/getri.c b/benchmark/getri.c index 4c8891226..960cef2a0 100644 --- a/benchmark/getri.c +++ b/benchmark/getri.c @@ -92,7 +92,7 @@ int main(int argc, char *argv[]){ if ((p = getenv("OPENBLAS_TEST"))) btest=*p; - if ((p = getenv("OPENBLAS_LOOPS"))) loops=*p; + if ((p = getenv("OPENBLAS_LOOPS"))) loops=atoi(p); fprintf(stderr, "From : %3d To : %3d Step = %3d\n", from, to, step); From ffcbaca16746c988e460e18276653c164b9c48ef Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Wed, 20 Mar 2024 19:20:16 +0100 Subject: [PATCH 245/311] Fix OPENBLAS_LOOPS assignment --- benchmark/linpack.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/benchmark/linpack.c b/benchmark/linpack.c index 32ccb0386..b00834b59 100644 --- a/benchmark/linpack.c +++ b/benchmark/linpack.c @@ -85,7 +85,7 @@ int main(int argc, char *argv[]){ double time1, time2, timeg1,timeg2; char *p; - if ((p = getenv("OPENBLAS_LOOPS"))) loops=*p; + if ((p = getenv("OPENBLAS_LOOPS"))) loops=atoi(p); argc--;argv++; From fe39c891a6c5d652d5741d235b1a3e3b553f102b Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Wed, 20 Mar 2024 19:21:37 +0100 Subject: [PATCH 246/311] Fix OPENBLAS_LOOPS assignment --- benchmark/potrf.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/benchmark/potrf.c b/benchmark/potrf.c index 8808203a5..674d6149b 100644 --- a/benchmark/potrf.c +++ b/benchmark/potrf.c @@ -120,7 +120,7 @@ int main(int argc, char *argv[]){ if ((p = getenv("OPENBLAS_TEST"))) btest=*p; - if ((p = getenv("OPENBLAS_LOOPS"))) loops=*p; + if ((p = getenv("OPENBLAS_LOOPS"))) loops=atoi(p); fprintf(stderr, "From : %3d To : %3d Step = %3d Uplo = %c\n", from, to, step,*uplo[uplos]); From 3f1ec74fe7a56abb91626be6d06d05a4df50e327 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Wed, 20 Mar 2024 19:22:48 +0100 Subject: [PATCH 247/311] Fix OPENBLAS_LOOPS assignment --- benchmark/syr2.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/benchmark/syr2.c b/benchmark/syr2.c index 61d1036ea..6976898f2 100644 --- a/benchmark/syr2.c +++ b/benchmark/syr2.c @@ -54,7 +54,7 @@ int main(int argc, char *argv[]){ int step = 1; int loops = 1; - if ((p = getenv("OPENBLAS_LOOPS"))) loops=*p; + if ((p = getenv("OPENBLAS_LOOPS"))) loops=atoi(p); double time1,timeg; From 52b71a1673dfe1fddfcbae3b8a03486438223fdf Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Fri, 22 Mar 2024 17:02:39 +0100 Subject: [PATCH 248/311] Filter out FFLAGS that flang-new from LLVM18 no longer supports (#4569) * Filter out FFLAGS that flang-new from LLVM18 no longer supports --- Makefile.system | 4 ++++ cmake/fc.cmake | 6 +++++- cmake/system.cmake | 8 +++++++- 3 files changed, 16 insertions(+), 2 deletions(-) diff --git a/Makefile.system b/Makefile.system index 2ea407349..f89cc8bdf 100644 --- a/Makefile.system +++ b/Makefile.system @@ -1670,6 +1670,10 @@ ifeq ($(F_COMPILER),CRAY) LAPACK_FFLAGS := $(filter-out -msse3 -mssse3 -msse4.1 -mavx -mavx2 -mskylake-avx512 ,$(FFLAGS)) override FFLAGS := $(filter-out -msse3 -mssse3 -msse4.1 -mavx -mavx2 -mskylake-avx512 ,$(FFLAGS)) endif +ifeq ($(F_COMPILER),FLANGNEW) +LAPACK_FFLAGS := $(filter-out -m32 -m64 -msse3 -mssse3 -msse4.1 -mavx -mavx2 -mskylake-avx512 ,$(FFLAGS)) +override FFLAGS := $(filter-out -m32 -m64 -msse3 -mssse3 -msse4.1 -mavx -mavx2 -mskylake-avx512 ,$(FFLAGS)) +endif LAPACK_CFLAGS = $(CFLAGS) LAPACK_CFLAGS += -DHAVE_LAPACK_CONFIG_H diff --git a/cmake/fc.cmake b/cmake/fc.cmake index bc85a2921..4d3da1a29 100644 --- a/cmake/fc.cmake +++ b/cmake/fc.cmake @@ -88,7 +88,9 @@ if (${F_COMPILER} STREQUAL "GFORTRAN" OR ${F_COMPILER} STREQUAL "F95" OR CMAKE_F endif () else () if (BINARY64) + if (NOT CMAKE_Fortran_COMPILER_ID MATCHES "LLVMFlang.*") set(FCOMMON_OPT "${FCOMMON_OPT} -m64") + endif () if (INTERFACE64) if (CMAKE_Fortran_COMPILER_ID STREQUAL "Intel") if (WIN32) @@ -101,7 +103,9 @@ if (${F_COMPILER} STREQUAL "GFORTRAN" OR ${F_COMPILER} STREQUAL "F95" OR CMAKE_F endif () endif () else () - set(FCOMMON_OPT "${FCOMMON_OPT} -m32") + if (NOT CMAKE_Fortran_COMPILER_ID MATCHES "LLVMFlang.*") + set(FCOMMON_OPT "${FCOMMON_OPT} -m32") + endif () endif () endif () diff --git a/cmake/system.cmake b/cmake/system.cmake index 95f34e9f8..c26b415c6 100644 --- a/cmake/system.cmake +++ b/cmake/system.cmake @@ -616,13 +616,19 @@ if (${CMAKE_SYSTEM_NAME} STREQUAL "Windows") endforeach () endif () -if ("${F_COMPILER}" STREQUAL "NAG" OR "${F_COMPILER}" STREQUAL "CRAY") +if (CMAKE_Fortran_COMPILER) +if (${F_COMPILER} STREQUAL "NAG" OR ${F_COMPILER} STREQUAL "CRAY" OR CMAKE_Fortran_COMPILER_ID MATCHES "LLVMFlang.*") set(FILTER_FLAGS "-msse3;-mssse3;-msse4.1;-mavx;-mavx2,-mskylake-avx512") + if (CMAKE_Fortran_COMPILER_ID MATCHES "LLVMFlang.*") +message(STATUS "removing fortran flags") + set(FILTER_FLAGS "${FILTER_FLAGS};-m32;-m64") + endif () foreach (FILTER_FLAG ${FILTER_FLAGS}) string(REPLACE ${FILTER_FLAG} "" LAPACK_FFLAGS ${LAPACK_FFLAGS}) string(REPLACE ${FILTER_FLAG} "" LAPACK_FPFLAGS ${LAPACK_FPFLAGS}) endforeach () endif () +endif () if ("${F_COMPILER}" STREQUAL "GFORTRAN") # lapack-netlib is rife with uninitialized warnings -hpa From 88b5330ae7fa506f6e92930f0bee951ea7e0065c Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Sun, 24 Mar 2024 18:33:21 +0100 Subject: [PATCH 249/311] Restore outer loop of blas_buffer_inuse setup --- driver/others/blas_server_omp.c | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/driver/others/blas_server_omp.c b/driver/others/blas_server_omp.c index 23110f807..6f2ea8623 100644 --- a/driver/others/blas_server_omp.c +++ b/driver/others/blas_server_omp.c @@ -407,6 +407,7 @@ int exec_blas(BLASLONG num, blas_queue_t *queue){ } #endif +while (true) { for(i=0; i < MAX_PARALLEL_NUMBER; i++) { #ifdef HAVE_C11 _Bool inuse = false; @@ -419,7 +420,9 @@ int exec_blas(BLASLONG num, blas_queue_t *queue){ break; } } - + if (i != MAX_PARALLEL_NUMBER) + break; +} if (openblas_omp_adaptive_env() != 0) { #pragma omp parallel for num_threads(num) schedule(OMP_SCHED) for (i = 0; i < num; i ++) { From 0b814ab8b9c5af7fe5ac717807ea002373813332 Mon Sep 17 00:00:00 2001 From: Jerry Zhao Date: Mon, 25 Mar 2024 08:14:00 -0700 Subject: [PATCH 250/311] Fix README formatting error --- README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.md b/README.md index aade7b917..477b01624 100644 --- a/README.md +++ b/README.md @@ -211,7 +211,7 @@ Please read `GotoBLAS_01Readme.txt` for older CPU models already supported by th - **ZVL???B**: Level-3 BLAS and Level-1,2 including vectorised kernels targeting generic RISCV cores with vector support with registers of at least the corresponding width; ZVL128B and ZVL256B are available. e.g.: ```sh -make TARGET=RISCV64_ZVL256B CFLAGS="-DTARGET=RISCV64_ZVL256B" \ + make TARGET=RISCV64_ZVL256B CFLAGS="-DTARGET=RISCV64_ZVL256B" \ BINARY=64 ARCH=riscv64 CC='clang -target riscv64-unknown-linux-gnu' \ AR=riscv64-unknown-linux-gnu-ar AS=riscv64-unknown-linux-gnu-gcc \ LD=riscv64-unknown-linux-gnu-gcc FC=riscv64-unknown-linux-gnu-gfortran \ From 0e0d0bce1a79bdd0a2642d7dc71ed37f7a318ec4 Mon Sep 17 00:00:00 2001 From: Chip Kerchner Date: Mon, 25 Mar 2024 15:11:55 -0500 Subject: [PATCH 251/311] Fix global (static) constructor priorty so that OpenBLAS gets initialized before other libraries. Other unit test AIX fix. --- exports/Makefile | 2 +- utest/Makefile | 12 +++++------- 2 files changed, 6 insertions(+), 8 deletions(-) diff --git a/exports/Makefile b/exports/Makefile index 27a291f34..4d929c8d3 100644 --- a/exports/Makefile +++ b/exports/Makefile @@ -266,7 +266,7 @@ so : ../$(LIBSONAME) linktest.c ../$(LIBSONAME) : aix.exp $(CC) $(CFLAGS) $(LDFLAGS) -shared -o ../$(LIBSONAME) \ - -Wl,-bE:aix.exp -Wl,-bbigtoc ../$(LIBNAME) $(EXTRALIB) + -Wl,-bcdtors:all:-2147481648:s,-bE:aix.exp -Wl,-bbigtoc ../$(LIBNAME) $(EXTRALIB) aix.exp : /usr/bin/nm -X32_64 -PCpgl ../$(LIBNAME) | /usr/bin/awk '{ if ((($$ 2 == "T") \ diff --git a/utest/Makefile b/utest/Makefile index 0e3f2b8a7..ce0f5c430 100644 --- a/utest/Makefile +++ b/utest/Makefile @@ -63,20 +63,18 @@ endif all : run_test ifeq ($(OSNAME), AIX) -ifeq ($(USE_OPENMP), 1) $(UTESTBIN): $(OBJS) $(CC) $(CFLAGS) $(LDFLAGS) -o $@ $^ ../$(LIBNAME) $(EXTRALIB) + +$(UTESTEXTBIN): $(OBJS_EXT) + $(CC) $(CFLAGS) $(LDFLAGS) -o $@ $^ ../$(LIBNAME) $(EXTRALIB) else $(UTESTBIN): $(OBJS) $(CC) $(CFLAGS) $(LDFLAGS) -o $@ $^ ../$(LIBNAME) $(EXTRALIB) $(FEXTRALIB) -endif -else -$(UTESTBIN): $(OBJS) - $(CC) $(CFLAGS) $(LDFLAGS) -o $@ $^ ../$(LIBNAME) $(EXTRALIB) $(FEXTRALIB) -endif $(UTESTEXTBIN): $(OBJS_EXT) $(CC) $(CFLAGS) $(LDFLAGS) -o $@ $^ ../$(LIBNAME) $(EXTRALIB) $(FEXTRALIB) +endif run_test: $(UTESTBIN) $(UTESTEXTBIN) ifneq ($(CROSS), 1) @@ -88,4 +86,4 @@ clean: -rm -f *.o $(UTESTBIN) $(UTESTEXTBIN) -rm -f $(DIR_EXT)/*.o -libs: \ No newline at end of file +libs: From 96607cbb98bf8bef78c1da2021aab63a21cf44f9 Mon Sep 17 00:00:00 2001 From: gxw Date: Mon, 25 Mar 2024 23:17:53 -0400 Subject: [PATCH 252/311] loongarch: Fixed dzamax Initialize the registers to prevent sporadic errors. --- kernel/loongarch64/camax_lasx.S | 1 + kernel/loongarch64/camax_lsx.S | 1 + 2 files changed, 2 insertions(+) diff --git a/kernel/loongarch64/camax_lasx.S b/kernel/loongarch64/camax_lasx.S index b646f7412..e273033e8 100644 --- a/kernel/loongarch64/camax_lasx.S +++ b/kernel/loongarch64/camax_lasx.S @@ -60,6 +60,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. PROLOGUE xvxor.v VM0, VM0, VM0 xvxor.v res0, res0, res0 + xvxor.v $xr20, $xr20, $xr20 bge $r0, N, .L999 bge $r0, INCX, .L999 li.d TEMP, 1 diff --git a/kernel/loongarch64/camax_lsx.S b/kernel/loongarch64/camax_lsx.S index 12922ecd8..2a74249c2 100644 --- a/kernel/loongarch64/camax_lsx.S +++ b/kernel/loongarch64/camax_lsx.S @@ -60,6 +60,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. PROLOGUE vxor.v VM0, VM0, VM0 vxor.v res0, res0, res0 + vxor.v $vr20, $vr20, $vr20 bge $r0, N, .L999 bge $r0, INCX, .L999 li.d TEMP, 1 From 496106642f77c7d319ee9966c067cdf0040462ab Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Wed, 27 Mar 2024 20:32:11 +0100 Subject: [PATCH 253/311] Cap the number of parallel threads --- interface/lapack/potrf.c | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) diff --git a/interface/lapack/potrf.c b/interface/lapack/potrf.c index 3abc80133..d4a56c94a 100644 --- a/interface/lapack/potrf.c +++ b/interface/lapack/potrf.c @@ -113,13 +113,17 @@ int NAME(char *UPLO, blasint *N, FLOAT *a, blasint *ldA, blasint *Info){ #ifdef SMP args.common = NULL; #ifndef DOUBLE - if (args.n <128) -#else - if (args.n <64) -#endif + int nmax = 128; +#else + int nmax = 64; +endif + if (args.n Date: Wed, 27 Mar 2024 20:34:55 +0100 Subject: [PATCH 254/311] Cap the number of parallel threads --- interface/lapack/getrf.c | 19 ++++++++++++------- 1 file changed, 12 insertions(+), 7 deletions(-) diff --git a/interface/lapack/getrf.c b/interface/lapack/getrf.c index 323370ebc..7d1f6bc70 100644 --- a/interface/lapack/getrf.c +++ b/interface/lapack/getrf.c @@ -95,14 +95,19 @@ int NAME(blasint *M, blasint *N, FLOAT *a, blasint *ldA, blasint *ipiv, blasint #ifdef SMP args.common = NULL; + #ifndef DOUBLE - if (args.m*args.n < 40000) -#else - if (args.m*args.n < 10000) -#endif - args.nthreads=1; - else - args.nthreads = num_cpu_avail(4); + int nmax = 40000; +#else + int nmax = 10000; +endif + if (args.m*args.n Date: Wed, 27 Mar 2024 22:00:30 +0100 Subject: [PATCH 255/311] Cap the number of parallel threads --- interface/gemm.c | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/interface/gemm.c b/interface/gemm.c index 4778b641b..0902bc024 100644 --- a/interface/gemm.c +++ b/interface/gemm.c @@ -533,8 +533,12 @@ void CNAME(enum CBLAS_ORDER order, enum CBLAS_TRANSPOSE TransA, enum CBLAS_TRANS MNK = (double) args.m * (double) args.n * (double) args.k; if ( MNK <= (SMP_THRESHOLD_MIN * (double) GEMM_MULTITHREAD_THRESHOLD) ) args.nthreads = 1; - else + else { args.nthreads = num_cpu_avail(3); + if (MNK/args.nthreads < SMP_THRESHOLD_MIN*(double)GEMM_MULTITHREAD_THRESHOLD) + args.nthreads = MNK/(SMP_THRESHOLD_MIN*(double)GEMM_MULTITHREAD_THRESHOLD); + } + args.common = NULL; if (args.nthreads == 1) { From 19b29b3448239d14c3541699e8543e6f9a2cd7b6 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Wed, 27 Mar 2024 22:09:30 +0100 Subject: [PATCH 256/311] Update getrf.c --- interface/lapack/getrf.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/interface/lapack/getrf.c b/interface/lapack/getrf.c index 7d1f6bc70..270604120 100644 --- a/interface/lapack/getrf.c +++ b/interface/lapack/getrf.c @@ -100,7 +100,7 @@ int NAME(blasint *M, blasint *N, FLOAT *a, blasint *ldA, blasint *ipiv, blasint int nmax = 40000; #else int nmax = 10000; -endif +#endif if (args.m*args.n Date: Wed, 27 Mar 2024 22:10:01 +0100 Subject: [PATCH 257/311] Update potrf.c --- interface/lapack/potrf.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/interface/lapack/potrf.c b/interface/lapack/potrf.c index d4a56c94a..a24e48d95 100644 --- a/interface/lapack/potrf.c +++ b/interface/lapack/potrf.c @@ -116,7 +116,7 @@ int NAME(char *UPLO, blasint *N, FLOAT *a, blasint *ldA, blasint *Info){ int nmax = 128; #else int nmax = 64; -endif +#endif if (args.n Date: Thu, 28 Mar 2024 11:33:31 +0100 Subject: [PATCH 258/311] use atomic operations as in the corresponding getrf --- lapack/potrf/potrf_parallel.c | 45 ++++++++++++++++++++++++++++------- 1 file changed, 37 insertions(+), 8 deletions(-) diff --git a/lapack/potrf/potrf_parallel.c b/lapack/potrf/potrf_parallel.c index a7c28f4c2..c38a2632d 100644 --- a/lapack/potrf/potrf_parallel.c +++ b/lapack/potrf/potrf_parallel.c @@ -105,6 +105,14 @@ typedef struct { BLASLONG working[MAX_CPU_NUMBER][CACHE_LINE_SIZE * DIVIDE_RATE]; } job_t; +#ifdef HAVE_C11 +#define atomic_load_long(p) __atomic_load_n(p, __ATOMIC_RELAXED) +#define atomic_store_long(p, v) __atomic_store_n(p, v, __ATOMIC_RELAXED) +#else +#define atomic_load_long(p) (BLASLONG)(*(volatile BLASLONG*)(p)) +#define atomic_store_long(p, v) (*(volatile BLASLONG *)(p)) = (v) +#endif + #ifndef KERNEL_OPERATION #ifndef COMPLEX @@ -233,14 +241,18 @@ static int inner_thread(blas_arg_t *args, BLASLONG *range_m, BLASLONG *range_n, } #ifndef LOWER + MB; for (i = 0; i <= mypos; i++) - job[mypos].working[i][CACHE_LINE_SIZE * bufferside] = (BLASLONG)buffer[bufferside]; + atomic_store_long(&job[mypos].working[i][CACHE_LINE_SIZE * bufferside], (BLASLONG)buffer[bufferside]); + // job[mypos].working[i][CACHE_LINE_SIZE * bufferside] = (BLASLONG)buffer[bufferside]; #else + MB for (i = mypos; i < args -> nthreads; i++) - job[mypos].working[i][CACHE_LINE_SIZE * bufferside] = (BLASLONG)buffer[bufferside]; + atomic_store_long(&job[mypos].working[i][CACHE_LINE_SIZE * bufferside], (BLASLONG)buffer[bufferside]); +// job[mypos].working[i][CACHE_LINE_SIZE * bufferside] = (BLASLONG)buffer[bufferside]; #endif - WMB; +// WMB; } min_i = m_to - m_from; @@ -271,14 +283,21 @@ static int inner_thread(blas_arg_t *args, BLASLONG *range_m, BLASLONG *range_n, for (xxx = range_n[current], bufferside = 0; xxx < range_n[current + 1]; xxx += div_n, bufferside ++) { /* thread has to wait */ - if (current != mypos) while(job[current].working[mypos][CACHE_LINE_SIZE * bufferside] == 0) {YIELDING;}; + if (current != mypos) + do { + jw = atomic_load_long(&job[current].working[mypos][CACHE_LINE_SIZE * bufferside]); + } while (jw == 0); + MB; + + //while(job[current].working[mypos][CACHE_LINE_SIZE * bufferside] == 0) {YIELDING;}; KERNEL_OPERATION(min_i, MIN(range_n[current + 1] - xxx, div_n), k, alpha, sa, (FLOAT *)job[current].working[mypos][CACHE_LINE_SIZE * bufferside], c, lda, m_from, xxx); if (m_from + min_i >= m_to) { - job[current].working[mypos][CACHE_LINE_SIZE * bufferside] &= 0; + atomic_store_long(&job[current].working[mypos][CACHE_LINE_SIZE * bufferside], job[current].working[mypos][CACHE_LINE_SIZE * bufferside] &= 0); +// job[current].working[mypos][CACHE_LINE_SIZE * bufferside] &= 0; WMB; } } @@ -323,7 +342,8 @@ static int inner_thread(blas_arg_t *args, BLASLONG *range_m, BLASLONG *range_n, c, lda, is, xxx); if (is + min_i >= m_to) { - job[current].working[mypos][CACHE_LINE_SIZE * bufferside] &= 0; + atomic_store_long(&job[current].working[mypos][CACHE_LINE_SIZE * bufferside], job[current].working[mypos][CACHE_LINE_SIZE * bufferside] &= 0); +// job[current].working[mypos][CACHE_LINE_SIZE * bufferside] &= 0; WMB; } } @@ -337,9 +357,18 @@ static int inner_thread(blas_arg_t *args, BLASLONG *range_m, BLASLONG *range_n, for (i = 0; i < args -> nthreads; i++) { if (i != mypos) { - for (xxx = 0; xxx < DIVIDE_RATE; xxx++) { + for (xxx = 0; xxx < DIVIDE_RATE; xxx++) + #if 1 + { + do { + jw = atomic_load_long(&job[mypos].working[i][CACHE_LINE_SIZE * xxx]); + } while (jw); + MB; + } +#else while (job[mypos].working[i][CACHE_LINE_SIZE * xxx] ) {YIELDING;}; - } +#endif + // } } } From b0ad8a78ff9945864d046697ff5313ae0691cf49 Mon Sep 17 00:00:00 2001 From: Mark Seminatore Date: Thu, 28 Mar 2024 15:24:52 -0700 Subject: [PATCH 259/311] code to fix lost work in case of re-entrant calls to exec_blas_async() --- driver/others/blas_server_win32.c | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/driver/others/blas_server_win32.c b/driver/others/blas_server_win32.c index 2ad8b8c5f..788a23b0b 100644 --- a/driver/others/blas_server_win32.c +++ b/driver/others/blas_server_win32.c @@ -409,14 +409,14 @@ int exec_blas_async(BLASLONG pos, blas_queue_t *queue) { } else { - blas_queue_t *next_item = work_queue; + blas_queue_t *queue_item = work_queue; // find the end of the work queue - while (next_item) - next_item = next_item->next; + while (queue_item->next) + queue_item = queue_item->next; // add new work to the end - next_item = queue; + queue_item->next = queue; } LeaveCriticalSection(&queue_lock); From 5b33e648b471b908a4a13102e97da45bad7ba1ec Mon Sep 17 00:00:00 2001 From: Matti Picus Date: Tue, 2 Apr 2024 08:54:56 +1100 Subject: [PATCH 260/311] fix typo --- openblas.pc.in | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/openblas.pc.in b/openblas.pc.in index 6c27c462b..23804f4a2 100644 --- a/openblas.pc.in +++ b/openblas.pc.in @@ -2,6 +2,6 @@ Name: openblas Description: OpenBLAS is an optimized BLAS library based on GotoBLAS2 1.13 BSD version Version: ${version} URL: https://github.com/xianyi/OpenBLAS -Libs: -L${libdir} -l$(libprefix}openblas${libnamesuffix} +Libs: -L${libdir} -l${libprefix}openblas${libnamesuffix} Libs.private: ${extralib} Cflags: -I${includedir} From 9ead81bd399b89f3d235c4c0e2e7f861bafecd4f Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Tue, 2 Apr 2024 15:59:20 +0200 Subject: [PATCH 261/311] Revert S/DNRM2 to the base NEON kernel to fix precision loss --- kernel/arm64/KERNEL.NEOVERSEN1 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/kernel/arm64/KERNEL.NEOVERSEN1 b/kernel/arm64/KERNEL.NEOVERSEN1 index 9a5938459..9fe981c58 100644 --- a/kernel/arm64/KERNEL.NEOVERSEN1 +++ b/kernel/arm64/KERNEL.NEOVERSEN1 @@ -91,8 +91,8 @@ IDAMAXKERNEL = iamax_thunderx2t99.c ICAMAXKERNEL = izamax_thunderx2t99.c IZAMAXKERNEL = izamax_thunderx2t99.c -SNRM2KERNEL = scnrm2_thunderx2t99.c -DNRM2KERNEL = dznrm2_thunderx2t99.c +SNRM2KERNEL = nrm2.S +DNRM2KERNEL = nrm2.S CNRM2KERNEL = scnrm2_thunderx2t99.c ZNRM2KERNEL = dznrm2_thunderx2t99.c From 441c81026e2d7c27c2b5e7b1883eeb883e19ff53 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Tue, 2 Apr 2024 19:41:44 +0200 Subject: [PATCH 262/311] Add support for Cortex-A76 --- kernel/arm64/KERNEL.CORTEXA76 | 3 +++ 1 file changed, 3 insertions(+) create mode 100644 kernel/arm64/KERNEL.CORTEXA76 diff --git a/kernel/arm64/KERNEL.CORTEXA76 b/kernel/arm64/KERNEL.CORTEXA76 new file mode 100644 index 000000000..007b2ce26 --- /dev/null +++ b/kernel/arm64/KERNEL.CORTEXA76 @@ -0,0 +1,3 @@ +include $(KERNELDIR)/KERNEL.CORTEXA57 + + From 3af736fb9d6e700b97cc2f07358f1a75d1d943fd Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Tue, 2 Apr 2024 19:42:23 +0200 Subject: [PATCH 263/311] Add support for Cortex-A76 --- cmake/prebuild.cmake | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cmake/prebuild.cmake b/cmake/prebuild.cmake index a33acbbd4..47e958419 100644 --- a/cmake/prebuild.cmake +++ b/cmake/prebuild.cmake @@ -932,7 +932,7 @@ endif () set(ZGEMM_UNROLL_M 4) set(ZGEMM_UNROLL_N 4) set(SYMV_P 16) - elseif ("${TCORE}" STREQUAL "CORTEXA72" OR "${TCORE}" STREQUAL "CORTEXA73") + elseif ("${TCORE}" STREQUAL "CORTEXA72" OR "${TCORE}" STREQUAL "CORTEXA73" OR "${TCORE}" STREQUAL "CORTEXA76") file(APPEND ${TARGET_CONF_TEMP} "#define L1_CODE_SIZE\t49152\n" "#define L1_CODE_LINESIZE\t64\n" From b925f61fb06ce2f120c430ea328bb839ace01157 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Tue, 2 Apr 2024 19:44:17 +0200 Subject: [PATCH 264/311] Add support for Cortex-A76 --- Makefile.arm64 | 7 +++++++ TargetList.txt | 1 + cpuid_arm64.c | 10 ++++++++-- getarch.c | 15 +++++++++++++++ param.h | 29 +++++++++++++++++++++++++++++ 5 files changed, 60 insertions(+), 2 deletions(-) diff --git a/Makefile.arm64 b/Makefile.arm64 index a85ee7dfd..eeb728735 100644 --- a/Makefile.arm64 +++ b/Makefile.arm64 @@ -58,6 +58,13 @@ FCOMMON_OPT += -march=armv8-a -mtune=cortex-a73 endif endif +ifeq ($(CORE), CORTEXA76) +CCOMMON_OPT += -march=armv8.2-a -mtune=cortex-a76 +ifneq ($(F_COMPILER), NAG) +FCOMMON_OPT += -march=armv8.2-a -mtune=cortex-a76 +endif +endif + ifeq ($(CORE), FT2000) CCOMMON_OPT += -march=armv8-a -mtune=cortex-a72 ifneq ($(F_COMPILER), NAG) diff --git a/TargetList.txt b/TargetList.txt index 115030c1b..1531fd0d2 100644 --- a/TargetList.txt +++ b/TargetList.txt @@ -93,6 +93,7 @@ CORTEXA53 CORTEXA57 CORTEXA72 CORTEXA73 +CORTEXA76 CORTEXA510 CORTEXA710 CORTEXX1 diff --git a/cpuid_arm64.c b/cpuid_arm64.c index 8c5d04c14..b23edc4e7 100644 --- a/cpuid_arm64.c +++ b/cpuid_arm64.c @@ -42,6 +42,7 @@ size_t length64=sizeof(value64); #define CPU_CORTEXA57 3 #define CPU_CORTEXA72 4 #define CPU_CORTEXA73 5 +#define CPU_CORTEXA76 23 #define CPU_NEOVERSEN1 11 #define CPU_NEOVERSEV1 16 #define CPU_NEOVERSEN2 17 @@ -89,7 +90,8 @@ static char *cpuname[] = { "CORTEXX2", "CORTEXA510", "CORTEXA710", - "FT2000" + "FT2000", + "CORTEXA76" }; static char *cpuname_lower[] = { @@ -115,7 +117,8 @@ static char *cpuname_lower[] = { "cortexx2", "cortexa510", "cortexa710", - "ft2000" + "ft2000", + "cortexa76" }; int get_feature(char *search) @@ -210,6 +213,8 @@ int detect(void) return CPU_CORTEXX2; else if (strstr(cpu_part, "0xd4e")) //X3 return CPU_CORTEXX2; + else if (strstr(cpu_part, "0xd0b")) + return CPU_CORTEXA76; } // Qualcomm else if (strstr(cpu_implementer, "0x51") && strstr(cpu_part, "0xc00")) @@ -391,6 +396,7 @@ void get_cpuconfig(void) break; case CPU_NEOVERSEV1: + case CPU_CORTEXA76: printf("#define %s\n", cpuname[d]); printf("#define L1_CODE_SIZE 65536\n"); printf("#define L1_CODE_LINESIZE 64\n"); diff --git a/getarch.c b/getarch.c index 2b5459a5f..842a843fa 100644 --- a/getarch.c +++ b/getarch.c @@ -1331,6 +1331,21 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define CORENAME "CORTEXA73" #endif +#ifdef FORCE_CORTEXA76 +#define FORCE +#define ARCHITECTURE "ARM64" +#define SUBARCHITECTURE "CORTEXA76" +#define SUBDIRNAME "arm64" +#define ARCHCONFIG "-DCORTEXA76 " \ + "-DL1_CODE_SIZE=49152 -DL1_CODE_LINESIZE=64 -DL1_CODE_ASSOCIATIVE=3 " \ + "-DL1_DATA_SIZE=32768 -DL1_DATA_LINESIZE=64 -DL1_DATA_ASSOCIATIVE=2 " \ + "-DL2_SIZE=2097152 -DL2_LINESIZE=64 -DL2_ASSOCIATIVE=16 " \ + "-DDTB_DEFAULT_ENTRIES=64 -DDTB_SIZE=4096 " \ + "-DHAVE_VFPV4 -DHAVE_VFPV3 -DHAVE_VFP -DHAVE_NEON -DARMV8" +#define LIBNAME "cortexa76" +#define CORENAME "CORTEXA76" +#endif + #ifdef FORCE_CORTEXX1 #define FORCE #define ARCHITECTURE "ARM64" diff --git a/param.h b/param.h index fef3a0991..1c9d8b44d 100644 --- a/param.h +++ b/param.h @@ -3351,6 +3351,35 @@ is a big desktop or server with abundant cache rather than a phone or embedded d #define CGEMM_DEFAULT_R 4096 #define ZGEMM_DEFAULT_R 2048 +#elif defined(CORTEXA76) + +#define SGEMM_DEFAULT_UNROLL_M 16 +#define SGEMM_DEFAULT_UNROLL_N 4 + +#define DGEMM_DEFAULT_UNROLL_M 8 +#define DGEMM_DEFAULT_UNROLL_N 4 + +#define CGEMM_DEFAULT_UNROLL_M 8 +#define CGEMM_DEFAULT_UNROLL_N 4 + +#define ZGEMM_DEFAULT_UNROLL_M 4 +#define ZGEMM_DEFAULT_UNROLL_N 4 + + #define SGEMM_DEFAULT_P 256 + #define DGEMM_DEFAULT_P 128 + #define CGEMM_DEFAULT_P 128 + #define ZGEMM_DEFAULT_P 64 + + #define SGEMM_DEFAULT_Q 512 + #define DGEMM_DEFAULT_Q 256 + #define CGEMM_DEFAULT_Q 256 + #define ZGEMM_DEFAULT_Q 256 + +#define SGEMM_DEFAULT_R 4096 +#define DGEMM_DEFAULT_R 4096 +#define CGEMM_DEFAULT_R 4096 +#define ZGEMM_DEFAULT_R 4096 + #elif defined(CORTEXA53) || defined(CORTEXA55) #define SGEMM_DEFAULT_UNROLL_M 8 From 4718d97eb9c429853c800d2aec3bbd4c940c754d Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Tue, 2 Apr 2024 19:45:38 +0200 Subject: [PATCH 265/311] Mention support for Cortex-A76 --- README.md | 1 + 1 file changed, 1 insertion(+) diff --git a/README.md b/README.md index 477b01624..a37459b82 100644 --- a/README.md +++ b/README.md @@ -167,6 +167,7 @@ Please read `GotoBLAS_01Readme.txt` for older CPU models already supported by th - **Cortex A57**: Optimized Level-3 and Level-2 functions - **Cortex A72**: same as A57 ( different cpu specifications) - **Cortex A73**: same as A57 (different cpu specifications) +- **Cortex A76**: same as A57 (different cpu specifications) - **Falkor**: same as A57 (different cpu specifications) - **ThunderX**: Optimized some Level-1 functions - **ThunderX2T99**: Optimized Level-3 BLAS and parts of Levels 1 and 2 From 584e87661d563edd45a10df4be258487010258e2 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Tue, 2 Apr 2024 23:10:45 +0200 Subject: [PATCH 266/311] set SWITCH_RATIO for Cortex-A76 --- param.h | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/param.h b/param.h index 1c9d8b44d..69f7c67a4 100644 --- a/param.h +++ b/param.h @@ -3365,6 +3365,12 @@ is a big desktop or server with abundant cache rather than a phone or embedded d #define ZGEMM_DEFAULT_UNROLL_M 4 #define ZGEMM_DEFAULT_UNROLL_N 4 +#if defined(XDOUBLE) || defined(DOUBLE) +#define SWITCH_RATIO 8 +#else +#define SWITCH_RATIO 16 +#endif + #define SGEMM_DEFAULT_P 256 #define DGEMM_DEFAULT_P 128 #define CGEMM_DEFAULT_P 128 From 22d305e2df370f288339d306e12f3c0cb61d88d3 Mon Sep 17 00:00:00 2001 From: Igor Zhuravlov Date: Wed, 3 Apr 2024 19:01:38 +1000 Subject: [PATCH 267/311] fix dtrtrs_ and ztrtrs_ to accept case-insensitive parameters uplo and diag Changes to be committed: modified: interface/lapack/trtrs.c modified: interface/lapack/ztrtrs.c --- interface/lapack/trtrs.c | 2 ++ interface/lapack/ztrtrs.c | 2 ++ 2 files changed, 4 insertions(+) diff --git a/interface/lapack/trtrs.c b/interface/lapack/trtrs.c index 54fbe8394..3cc449318 100644 --- a/interface/lapack/trtrs.c +++ b/interface/lapack/trtrs.c @@ -95,10 +95,12 @@ int NAME(char *UPLO, char* TRANS, char* DIAG, blasint *N, blasint *NRHS, FLOAT * if (trans_arg == 'R') trans = 0; if (trans_arg == 'C') trans = 1; + TOUPPER(uplo_arg); uplo = -1; if (uplo_arg == 'U') uplo = 0; if (uplo_arg == 'L') uplo = 1; + TOUPPER(diag_arg); diag = -1; if (diag_arg == 'U') diag = 0; if (diag_arg == 'N') diag = 1; diff --git a/interface/lapack/ztrtrs.c b/interface/lapack/ztrtrs.c index 7f1bd9af4..ec3343393 100644 --- a/interface/lapack/ztrtrs.c +++ b/interface/lapack/ztrtrs.c @@ -95,10 +95,12 @@ int NAME(char *UPLO, char* TRANS, char* DIAG, blasint *N, blasint *NRHS, FLOAT * if (trans_arg == 'R') trans = 2; if (trans_arg == 'C') trans = 3; + TOUPPER(uplo_arg); uplo = -1; if (uplo_arg == 'U') uplo = 0; if (uplo_arg == 'L') uplo = 1; + TOUPPER(diag_arg); diag = -1; if (diag_arg == 'U') diag = 0; if (diag_arg == 'N') diag = 1; From 16a597927f78be84b1ffd86d3c914b1a7350bf8d Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Wed, 3 Apr 2024 22:09:28 +0200 Subject: [PATCH 268/311] fix typedef of logical to support INTERFACE64 --- lapack-netlib/SRC/DEPRECATED/cgegs.c | 6 +++--- lapack-netlib/SRC/DEPRECATED/cgegv.c | 6 +++--- lapack-netlib/SRC/DEPRECATED/cgelqs.c | 11 ----------- lapack-netlib/SRC/DEPRECATED/cgelsx.c | 5 +---- lapack-netlib/SRC/DEPRECATED/cgeqpf.c | 5 +---- lapack-netlib/SRC/DEPRECATED/cgeqrs.c | 12 ------------ lapack-netlib/SRC/DEPRECATED/cggsvd.c | 6 +++--- lapack-netlib/SRC/DEPRECATED/cggsvp.c | 6 +++--- lapack-netlib/SRC/DEPRECATED/clahrd.c | 5 +---- lapack-netlib/SRC/DEPRECATED/clatzm.c | 6 +++--- lapack-netlib/SRC/DEPRECATED/ctzrqf.c | 5 +---- lapack-netlib/SRC/DEPRECATED/dgegs.c | 6 +++--- lapack-netlib/SRC/DEPRECATED/dgegv.c | 6 +++--- lapack-netlib/SRC/DEPRECATED/dgelqs.c | 12 ------------ lapack-netlib/SRC/DEPRECATED/dgelsx.c | 5 +---- lapack-netlib/SRC/DEPRECATED/dgeqpf.c | 5 +---- lapack-netlib/SRC/DEPRECATED/dgeqrs.c | 12 ------------ lapack-netlib/SRC/DEPRECATED/dggsvd.c | 6 +++--- lapack-netlib/SRC/DEPRECATED/dggsvp.c | 6 +++--- lapack-netlib/SRC/DEPRECATED/dlahrd.c | 5 +---- lapack-netlib/SRC/DEPRECATED/dlatzm.c | 6 +++--- lapack-netlib/SRC/DEPRECATED/dtzrqf.c | 5 +---- lapack-netlib/SRC/DEPRECATED/sgegs.c | 6 +++--- lapack-netlib/SRC/DEPRECATED/sgegv.c | 6 +++--- lapack-netlib/SRC/DEPRECATED/sgelqs.c | 10 ---------- lapack-netlib/SRC/DEPRECATED/sgelsx.c | 5 +---- lapack-netlib/SRC/DEPRECATED/sgeqpf.c | 5 +---- lapack-netlib/SRC/DEPRECATED/sgeqrs.c | 12 ------------ lapack-netlib/SRC/DEPRECATED/sggsvd.c | 6 +++--- lapack-netlib/SRC/DEPRECATED/sggsvp.c | 6 +++--- lapack-netlib/SRC/DEPRECATED/slahrd.c | 5 +---- lapack-netlib/SRC/DEPRECATED/slatzm.c | 6 +++--- lapack-netlib/SRC/DEPRECATED/stzrqf.c | 5 +---- lapack-netlib/SRC/DEPRECATED/zgegs.c | 6 +++--- lapack-netlib/SRC/DEPRECATED/zgegv.c | 6 +++--- lapack-netlib/SRC/DEPRECATED/zgelqs.c | 12 ------------ lapack-netlib/SRC/DEPRECATED/zgelsx.c | 5 +---- lapack-netlib/SRC/DEPRECATED/zgeqpf.c | 5 +---- lapack-netlib/SRC/DEPRECATED/zgeqrs.c | 12 ------------ lapack-netlib/SRC/DEPRECATED/zggsvd.c | 6 +++--- lapack-netlib/SRC/DEPRECATED/zggsvp.c | 6 +++--- lapack-netlib/SRC/DEPRECATED/zlahrd.c | 5 +---- lapack-netlib/SRC/DEPRECATED/zlatzm.c | 6 +++--- lapack-netlib/SRC/DEPRECATED/ztzrqf.c | 5 +---- 44 files changed, 76 insertions(+), 217 deletions(-) diff --git a/lapack-netlib/SRC/DEPRECATED/cgegs.c b/lapack-netlib/SRC/DEPRECATED/cgegs.c index 270a05ebd..4770bb21c 100644 --- a/lapack-netlib/SRC/DEPRECATED/cgegs.c +++ b/lapack-netlib/SRC/DEPRECATED/cgegs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -259,7 +259,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* -- translated by f2c (version 20000121). You must link the resulting object file with the libraries: diff --git a/lapack-netlib/SRC/DEPRECATED/cgegv.c b/lapack-netlib/SRC/DEPRECATED/cgegv.c index d485b05b6..482a6633d 100644 --- a/lapack-netlib/SRC/DEPRECATED/cgegv.c +++ b/lapack-netlib/SRC/DEPRECATED/cgegv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -259,7 +259,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* -- translated by f2c (version 20000121). You must link the resulting object file with the libraries: -lf2c -lm (in that order) diff --git a/lapack-netlib/SRC/DEPRECATED/cgelqs.c b/lapack-netlib/SRC/DEPRECATED/cgelqs.c index ee6d56119..3b71b8366 100644 --- a/lapack-netlib/SRC/DEPRECATED/cgelqs.c +++ b/lapack-netlib/SRC/DEPRECATED/cgelqs.c @@ -52,9 +52,6 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; -typedef char logical1; typedef char integer1; #define TRUE_ (1) @@ -256,14 +253,6 @@ typedef struct Namelist Namelist; #define myhuge_(w) {HUGE_VAL} #define mymaxloc_(w,s,e,n) dmaxloc_(w,*(s),*(e),n) -/* procedure parameter types for -A and -C++ */ - -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef logical (*L_fp)(...); -#else -typedef logical (*L_fp)(); -#endif /* -- translated by f2c (version 20000121). You must link the resulting object file with the libraries: diff --git a/lapack-netlib/SRC/DEPRECATED/cgelsx.c b/lapack-netlib/SRC/DEPRECATED/cgelsx.c index cb3c33323..ae4bcd0c3 100644 --- a/lapack-netlib/SRC/DEPRECATED/cgelsx.c +++ b/lapack-netlib/SRC/DEPRECATED/cgelsx.c @@ -52,9 +52,6 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; -typedef char logical1; typedef char integer1; #define TRUE_ (1) @@ -259,7 +256,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* -- translated by f2c (version 20000121). You must link the resulting object file with the libraries: -lf2c -lm (in that order) diff --git a/lapack-netlib/SRC/DEPRECATED/cgeqpf.c b/lapack-netlib/SRC/DEPRECATED/cgeqpf.c index 12f8e5c76..f27fece7b 100644 --- a/lapack-netlib/SRC/DEPRECATED/cgeqpf.c +++ b/lapack-netlib/SRC/DEPRECATED/cgeqpf.c @@ -52,9 +52,6 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; -typedef char logical1; typedef char integer1; #define TRUE_ (1) @@ -259,7 +256,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* -- translated by f2c (version 20000121). You must link the resulting object file with the libraries: diff --git a/lapack-netlib/SRC/DEPRECATED/cgeqrs.c b/lapack-netlib/SRC/DEPRECATED/cgeqrs.c index c71b8af67..882eee946 100644 --- a/lapack-netlib/SRC/DEPRECATED/cgeqrs.c +++ b/lapack-netlib/SRC/DEPRECATED/cgeqrs.c @@ -52,9 +52,6 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; -typedef char logical1; typedef char integer1; #define TRUE_ (1) @@ -256,15 +253,6 @@ typedef struct Namelist Namelist; #define myhuge_(w) {HUGE_VAL} #define mymaxloc_(w,s,e,n) dmaxloc_(w,*(s),*(e),n) -/* procedure parameter types for -A and -C++ */ - -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef logical (*L_fp)(...); -#else -typedef logical (*L_fp)(); -#endif - /* -- translated by f2c (version 20000121). You must link the resulting object file with the libraries: -lf2c -lm (in that order) diff --git a/lapack-netlib/SRC/DEPRECATED/cggsvd.c b/lapack-netlib/SRC/DEPRECATED/cggsvd.c index 1a8a827c1..4f0c6f588 100644 --- a/lapack-netlib/SRC/DEPRECATED/cggsvd.c +++ b/lapack-netlib/SRC/DEPRECATED/cggsvd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -259,7 +259,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* You must link the resulting object file with the libraries: diff --git a/lapack-netlib/SRC/DEPRECATED/cggsvp.c b/lapack-netlib/SRC/DEPRECATED/cggsvp.c index 3bf587172..047d9b321 100644 --- a/lapack-netlib/SRC/DEPRECATED/cggsvp.c +++ b/lapack-netlib/SRC/DEPRECATED/cggsvp.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -259,7 +259,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* -- translated by f2c (version 20000121). You must link the resulting object file with the libraries: -lf2c -lm (in that order) diff --git a/lapack-netlib/SRC/DEPRECATED/clahrd.c b/lapack-netlib/SRC/DEPRECATED/clahrd.c index 517e4786b..7b60f014c 100644 --- a/lapack-netlib/SRC/DEPRECATED/clahrd.c +++ b/lapack-netlib/SRC/DEPRECATED/clahrd.c @@ -52,9 +52,6 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; -typedef char logical1; typedef char integer1; #define TRUE_ (1) @@ -259,7 +256,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* Table of constant values */ diff --git a/lapack-netlib/SRC/DEPRECATED/clatzm.c b/lapack-netlib/SRC/DEPRECATED/clatzm.c index 747f5bc11..e721ba902 100644 --- a/lapack-netlib/SRC/DEPRECATED/clatzm.c +++ b/lapack-netlib/SRC/DEPRECATED/clatzm.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -259,7 +259,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* Table of constant values */ diff --git a/lapack-netlib/SRC/DEPRECATED/ctzrqf.c b/lapack-netlib/SRC/DEPRECATED/ctzrqf.c index 3986f7854..045222f54 100644 --- a/lapack-netlib/SRC/DEPRECATED/ctzrqf.c +++ b/lapack-netlib/SRC/DEPRECATED/ctzrqf.c @@ -52,9 +52,6 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; -typedef char logical1; typedef char integer1; #define TRUE_ (1) @@ -259,7 +256,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + diff --git a/lapack-netlib/SRC/DEPRECATED/dgegs.c b/lapack-netlib/SRC/DEPRECATED/dgegs.c index f034821a4..7d7b5e646 100644 --- a/lapack-netlib/SRC/DEPRECATED/dgegs.c +++ b/lapack-netlib/SRC/DEPRECATED/dgegs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -259,7 +259,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* -- translated by f2c (version 20000121). diff --git a/lapack-netlib/SRC/DEPRECATED/dgegv.c b/lapack-netlib/SRC/DEPRECATED/dgegv.c index 38df37116..72a146405 100644 --- a/lapack-netlib/SRC/DEPRECATED/dgegv.c +++ b/lapack-netlib/SRC/DEPRECATED/dgegv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -259,7 +259,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* -- translated by f2c (version 20000121). You must link the resulting object file with the libraries: -lf2c -lm (in that order) diff --git a/lapack-netlib/SRC/DEPRECATED/dgelqs.c b/lapack-netlib/SRC/DEPRECATED/dgelqs.c index e3cf1e029..df0c351b3 100644 --- a/lapack-netlib/SRC/DEPRECATED/dgelqs.c +++ b/lapack-netlib/SRC/DEPRECATED/dgelqs.c @@ -52,9 +52,6 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; -typedef char logical1; typedef char integer1; #define TRUE_ (1) @@ -256,15 +253,6 @@ typedef struct Namelist Namelist; #define myhuge_(w) {HUGE_VAL} #define mymaxloc_(w,s,e,n) dmaxloc_(w,*(s),*(e),n) -/* procedure parameter types for -A and -C++ */ - -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef logical (*L_fp)(...); -#else -typedef logical (*L_fp)(); -#endif - /* -- translated by f2c (version 20000121). You must link the resulting object file with the libraries: -lf2c -lm (in that order) diff --git a/lapack-netlib/SRC/DEPRECATED/dgelsx.c b/lapack-netlib/SRC/DEPRECATED/dgelsx.c index 5abeebe84..5871f7501 100644 --- a/lapack-netlib/SRC/DEPRECATED/dgelsx.c +++ b/lapack-netlib/SRC/DEPRECATED/dgelsx.c @@ -52,9 +52,6 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; -typedef char logical1; typedef char integer1; #define TRUE_ (1) @@ -259,7 +256,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* -- translated by f2c (version 20000121). You must link the resulting object file with the libraries: -lf2c -lm (in that order) diff --git a/lapack-netlib/SRC/DEPRECATED/dgeqpf.c b/lapack-netlib/SRC/DEPRECATED/dgeqpf.c index 21c6a5c7d..e23f53a6a 100644 --- a/lapack-netlib/SRC/DEPRECATED/dgeqpf.c +++ b/lapack-netlib/SRC/DEPRECATED/dgeqpf.c @@ -52,9 +52,6 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; -typedef char logical1; typedef char integer1; #define TRUE_ (1) @@ -259,7 +256,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* You must link the resulting object file with the libraries: diff --git a/lapack-netlib/SRC/DEPRECATED/dgeqrs.c b/lapack-netlib/SRC/DEPRECATED/dgeqrs.c index 70236738a..f94e69d8f 100644 --- a/lapack-netlib/SRC/DEPRECATED/dgeqrs.c +++ b/lapack-netlib/SRC/DEPRECATED/dgeqrs.c @@ -52,9 +52,6 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; -typedef char logical1; typedef char integer1; #define TRUE_ (1) @@ -256,15 +253,6 @@ typedef struct Namelist Namelist; #define myhuge_(w) {HUGE_VAL} #define mymaxloc_(w,s,e,n) dmaxloc_(w,*(s),*(e),n) -/* procedure parameter types for -A and -C++ */ - -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef logical (*L_fp)(...); -#else -typedef logical (*L_fp)(); -#endif - /* -- translated by f2c (version 20000121). You must link the resulting object file with the libraries: -lf2c -lm (in that order) diff --git a/lapack-netlib/SRC/DEPRECATED/dggsvd.c b/lapack-netlib/SRC/DEPRECATED/dggsvd.c index e5993b833..fddc72cbd 100644 --- a/lapack-netlib/SRC/DEPRECATED/dggsvd.c +++ b/lapack-netlib/SRC/DEPRECATED/dggsvd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -259,7 +259,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* -- translated by f2c (version 20000121). You must link the resulting object file with the libraries: diff --git a/lapack-netlib/SRC/DEPRECATED/dggsvp.c b/lapack-netlib/SRC/DEPRECATED/dggsvp.c index b3a53fad1..66cf0f39c 100644 --- a/lapack-netlib/SRC/DEPRECATED/dggsvp.c +++ b/lapack-netlib/SRC/DEPRECATED/dggsvp.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -259,7 +259,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* -- translated by f2c (version 20000121). You must link the resulting object file with the libraries: -lf2c -lm (in that order) diff --git a/lapack-netlib/SRC/DEPRECATED/dlahrd.c b/lapack-netlib/SRC/DEPRECATED/dlahrd.c index 30f7a0f7a..0e960aaf2 100644 --- a/lapack-netlib/SRC/DEPRECATED/dlahrd.c +++ b/lapack-netlib/SRC/DEPRECATED/dlahrd.c @@ -52,9 +52,6 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; -typedef char logical1; typedef char integer1; #define TRUE_ (1) @@ -259,7 +256,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + diff --git a/lapack-netlib/SRC/DEPRECATED/dlatzm.c b/lapack-netlib/SRC/DEPRECATED/dlatzm.c index 698b09e85..c2954c4b7 100644 --- a/lapack-netlib/SRC/DEPRECATED/dlatzm.c +++ b/lapack-netlib/SRC/DEPRECATED/dlatzm.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -259,7 +259,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* Table of constant values */ diff --git a/lapack-netlib/SRC/DEPRECATED/dtzrqf.c b/lapack-netlib/SRC/DEPRECATED/dtzrqf.c index ff47d4177..f919ce5f1 100644 --- a/lapack-netlib/SRC/DEPRECATED/dtzrqf.c +++ b/lapack-netlib/SRC/DEPRECATED/dtzrqf.c @@ -52,9 +52,6 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; -typedef char logical1; typedef char integer1; #define TRUE_ (1) @@ -259,7 +256,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + diff --git a/lapack-netlib/SRC/DEPRECATED/sgegs.c b/lapack-netlib/SRC/DEPRECATED/sgegs.c index 6ab9050e0..05b5bb584 100644 --- a/lapack-netlib/SRC/DEPRECATED/sgegs.c +++ b/lapack-netlib/SRC/DEPRECATED/sgegs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -259,7 +259,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* -- translated by f2c (version 20000121). You must link the resulting object file with the libraries: diff --git a/lapack-netlib/SRC/DEPRECATED/sgegv.c b/lapack-netlib/SRC/DEPRECATED/sgegv.c index 39b2d6fb6..575feefbc 100644 --- a/lapack-netlib/SRC/DEPRECATED/sgegv.c +++ b/lapack-netlib/SRC/DEPRECATED/sgegv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -259,7 +259,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* -- translated by f2c (version 20000121). You must link the resulting object file with the libraries: -lf2c -lm (in that order) diff --git a/lapack-netlib/SRC/DEPRECATED/sgelqs.c b/lapack-netlib/SRC/DEPRECATED/sgelqs.c index 03034b0dc..c0b9dc8cd 100644 --- a/lapack-netlib/SRC/DEPRECATED/sgelqs.c +++ b/lapack-netlib/SRC/DEPRECATED/sgelqs.c @@ -52,9 +52,6 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; -typedef char logical1; typedef char integer1; #define TRUE_ (1) @@ -258,13 +255,6 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef logical (*L_fp)(...); -#else -typedef logical (*L_fp)(); -#endif - /* Table of constant values */ static real c_b7 = 1.f; diff --git a/lapack-netlib/SRC/DEPRECATED/sgelsx.c b/lapack-netlib/SRC/DEPRECATED/sgelsx.c index b2c480481..c91c746b2 100644 --- a/lapack-netlib/SRC/DEPRECATED/sgelsx.c +++ b/lapack-netlib/SRC/DEPRECATED/sgelsx.c @@ -52,9 +52,6 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; -typedef char logical1; typedef char integer1; #define TRUE_ (1) @@ -259,7 +256,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* -- translated by f2c (version 20000121). You must link the resulting object file with the libraries: -lf2c -lm (in that order) diff --git a/lapack-netlib/SRC/DEPRECATED/sgeqpf.c b/lapack-netlib/SRC/DEPRECATED/sgeqpf.c index 67121341e..d2889e44a 100644 --- a/lapack-netlib/SRC/DEPRECATED/sgeqpf.c +++ b/lapack-netlib/SRC/DEPRECATED/sgeqpf.c @@ -52,9 +52,6 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; -typedef char logical1; typedef char integer1; #define TRUE_ (1) @@ -259,7 +256,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* You must link the resulting object file with the libraries: diff --git a/lapack-netlib/SRC/DEPRECATED/sgeqrs.c b/lapack-netlib/SRC/DEPRECATED/sgeqrs.c index b593d0dc9..1530337f5 100644 --- a/lapack-netlib/SRC/DEPRECATED/sgeqrs.c +++ b/lapack-netlib/SRC/DEPRECATED/sgeqrs.c @@ -52,9 +52,6 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; -typedef char logical1; typedef char integer1; #define TRUE_ (1) @@ -256,15 +253,6 @@ typedef struct Namelist Namelist; #define myhuge_(w) {HUGE_VAL} #define mymaxloc_(w,s,e,n) dmaxloc_(w,*(s),*(e),n) -/* procedure parameter types for -A and -C++ */ - -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef logical (*L_fp)(...); -#else -typedef logical (*L_fp)(); -#endif - /* -- translated by f2c (version 20000121). You must link the resulting object file with the libraries: -lf2c -lm (in that order) diff --git a/lapack-netlib/SRC/DEPRECATED/sggsvd.c b/lapack-netlib/SRC/DEPRECATED/sggsvd.c index a10edf060..39f60e547 100644 --- a/lapack-netlib/SRC/DEPRECATED/sggsvd.c +++ b/lapack-netlib/SRC/DEPRECATED/sggsvd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -259,7 +259,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* -- translated by f2c (version 20000121). You must link the resulting object file with the libraries: diff --git a/lapack-netlib/SRC/DEPRECATED/sggsvp.c b/lapack-netlib/SRC/DEPRECATED/sggsvp.c index ca47bc629..2626170c5 100644 --- a/lapack-netlib/SRC/DEPRECATED/sggsvp.c +++ b/lapack-netlib/SRC/DEPRECATED/sggsvp.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -259,7 +259,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* -- translated by f2c (version 20000121). You must link the resulting object file with the libraries: -lf2c -lm (in that order) diff --git a/lapack-netlib/SRC/DEPRECATED/slahrd.c b/lapack-netlib/SRC/DEPRECATED/slahrd.c index 920288686..518d6cc4e 100644 --- a/lapack-netlib/SRC/DEPRECATED/slahrd.c +++ b/lapack-netlib/SRC/DEPRECATED/slahrd.c @@ -52,9 +52,6 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; -typedef char logical1; typedef char integer1; #define TRUE_ (1) @@ -259,7 +256,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* -- translated by f2c (version 20000121). You must link the resulting object file with the libraries: -lf2c -lm (in that order) diff --git a/lapack-netlib/SRC/DEPRECATED/slatzm.c b/lapack-netlib/SRC/DEPRECATED/slatzm.c index 6e53dceca..7b84a5d3b 100644 --- a/lapack-netlib/SRC/DEPRECATED/slatzm.c +++ b/lapack-netlib/SRC/DEPRECATED/slatzm.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -259,7 +259,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + diff --git a/lapack-netlib/SRC/DEPRECATED/stzrqf.c b/lapack-netlib/SRC/DEPRECATED/stzrqf.c index 72c0083bb..61773343d 100644 --- a/lapack-netlib/SRC/DEPRECATED/stzrqf.c +++ b/lapack-netlib/SRC/DEPRECATED/stzrqf.c @@ -52,9 +52,6 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; -typedef char logical1; typedef char integer1; #define TRUE_ (1) @@ -259,7 +256,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* Table of constant values */ diff --git a/lapack-netlib/SRC/DEPRECATED/zgegs.c b/lapack-netlib/SRC/DEPRECATED/zgegs.c index c053ec432..7f3b0ed62 100644 --- a/lapack-netlib/SRC/DEPRECATED/zgegs.c +++ b/lapack-netlib/SRC/DEPRECATED/zgegs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -259,7 +259,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* -- translated by f2c (version 20000121). You must link the resulting object file with the libraries: diff --git a/lapack-netlib/SRC/DEPRECATED/zgegv.c b/lapack-netlib/SRC/DEPRECATED/zgegv.c index 8272bd918..791362d1d 100644 --- a/lapack-netlib/SRC/DEPRECATED/zgegv.c +++ b/lapack-netlib/SRC/DEPRECATED/zgegv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -259,7 +259,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* -- translated by f2c (version 20000121). You must link the resulting object file with the libraries: -lf2c -lm (in that order) diff --git a/lapack-netlib/SRC/DEPRECATED/zgelqs.c b/lapack-netlib/SRC/DEPRECATED/zgelqs.c index b77ba906a..59d84d7c2 100644 --- a/lapack-netlib/SRC/DEPRECATED/zgelqs.c +++ b/lapack-netlib/SRC/DEPRECATED/zgelqs.c @@ -52,9 +52,6 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; -typedef char logical1; typedef char integer1; #define TRUE_ (1) @@ -256,15 +253,6 @@ typedef struct Namelist Namelist; #define myhuge_(w) {HUGE_VAL} #define mymaxloc_(w,s,e,n) dmaxloc_(w,*(s),*(e),n) -/* procedure parameter types for -A and -C++ */ - -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef logical (*L_fp)(...); -#else -typedef logical (*L_fp)(); -#endif - /* -- translated by f2c (version 20000121). You must link the resulting object file with the libraries: -lf2c -lm (in that order) diff --git a/lapack-netlib/SRC/DEPRECATED/zgelsx.c b/lapack-netlib/SRC/DEPRECATED/zgelsx.c index 82d195550..396a38f2a 100644 --- a/lapack-netlib/SRC/DEPRECATED/zgelsx.c +++ b/lapack-netlib/SRC/DEPRECATED/zgelsx.c @@ -52,9 +52,6 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; -typedef char logical1; typedef char integer1; #define TRUE_ (1) @@ -259,7 +256,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* -- translated by f2c (version 20000121). You must link the resulting object file with the libraries: -lf2c -lm (in that order) diff --git a/lapack-netlib/SRC/DEPRECATED/zgeqpf.c b/lapack-netlib/SRC/DEPRECATED/zgeqpf.c index 0a2f8c7aa..3f884d660 100644 --- a/lapack-netlib/SRC/DEPRECATED/zgeqpf.c +++ b/lapack-netlib/SRC/DEPRECATED/zgeqpf.c @@ -52,9 +52,6 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; -typedef char logical1; typedef char integer1; #define TRUE_ (1) @@ -259,7 +256,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* You must link the resulting object file with the libraries: diff --git a/lapack-netlib/SRC/DEPRECATED/zgeqrs.c b/lapack-netlib/SRC/DEPRECATED/zgeqrs.c index 3e8f3cce7..da3dccf4f 100644 --- a/lapack-netlib/SRC/DEPRECATED/zgeqrs.c +++ b/lapack-netlib/SRC/DEPRECATED/zgeqrs.c @@ -52,9 +52,6 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; -typedef char logical1; typedef char integer1; #define TRUE_ (1) @@ -256,15 +253,6 @@ typedef struct Namelist Namelist; #define myhuge_(w) {HUGE_VAL} #define mymaxloc_(w,s,e,n) dmaxloc_(w,*(s),*(e),n) -/* procedure parameter types for -A and -C++ */ - -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef logical (*L_fp)(...); -#else -typedef logical (*L_fp)(); -#endif - /* -- translated by f2c (version 20000121). You must link the resulting object file with the libraries: -lf2c -lm (in that order) diff --git a/lapack-netlib/SRC/DEPRECATED/zggsvd.c b/lapack-netlib/SRC/DEPRECATED/zggsvd.c index e9d723404..5d252edce 100644 --- a/lapack-netlib/SRC/DEPRECATED/zggsvd.c +++ b/lapack-netlib/SRC/DEPRECATED/zggsvd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -259,7 +259,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* You must link the resulting object file with the libraries: diff --git a/lapack-netlib/SRC/DEPRECATED/zggsvp.c b/lapack-netlib/SRC/DEPRECATED/zggsvp.c index 0409e97b1..c5b7fc1bc 100644 --- a/lapack-netlib/SRC/DEPRECATED/zggsvp.c +++ b/lapack-netlib/SRC/DEPRECATED/zggsvp.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -259,7 +259,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* You must link the resulting object file with the libraries: -lf2c -lm (in that order) diff --git a/lapack-netlib/SRC/DEPRECATED/zlahrd.c b/lapack-netlib/SRC/DEPRECATED/zlahrd.c index 41c26d98e..b35355153 100644 --- a/lapack-netlib/SRC/DEPRECATED/zlahrd.c +++ b/lapack-netlib/SRC/DEPRECATED/zlahrd.c @@ -52,9 +52,6 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; -typedef char logical1; typedef char integer1; #define TRUE_ (1) @@ -259,7 +256,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* Table of constant values */ diff --git a/lapack-netlib/SRC/DEPRECATED/zlatzm.c b/lapack-netlib/SRC/DEPRECATED/zlatzm.c index 25c476524..f7f67b0db 100644 --- a/lapack-netlib/SRC/DEPRECATED/zlatzm.c +++ b/lapack-netlib/SRC/DEPRECATED/zlatzm.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -259,7 +259,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* Table of constant values */ diff --git a/lapack-netlib/SRC/DEPRECATED/ztzrqf.c b/lapack-netlib/SRC/DEPRECATED/ztzrqf.c index 3a94fa79a..54ec15c1e 100644 --- a/lapack-netlib/SRC/DEPRECATED/ztzrqf.c +++ b/lapack-netlib/SRC/DEPRECATED/ztzrqf.c @@ -52,9 +52,6 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; -typedef char logical1; typedef char integer1; #define TRUE_ (1) @@ -259,7 +256,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* Table of constant values */ From 7bc0ff77bde1ff587a4ad7599c195ae37e12dd42 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Wed, 3 Apr 2024 22:23:18 +0200 Subject: [PATCH 269/311] fix typedef of logical to support INTERFACE64 --- lapack-netlib/TESTING/MATGEN/clagge.c | 5 +---- lapack-netlib/TESTING/MATGEN/claghe.c | 5 +---- lapack-netlib/TESTING/MATGEN/clagsy.c | 5 +---- lapack-netlib/TESTING/MATGEN/clahilb.c | 6 +++--- lapack-netlib/TESTING/MATGEN/clakf2.c | 5 +---- lapack-netlib/TESTING/MATGEN/clarge.c | 5 +---- lapack-netlib/TESTING/MATGEN/clarnd.c | 5 +---- lapack-netlib/TESTING/MATGEN/claror.c | 6 +++--- lapack-netlib/TESTING/MATGEN/clarot.c | 6 +++--- lapack-netlib/TESTING/MATGEN/clatm1.c | 5 +---- lapack-netlib/TESTING/MATGEN/clatm2.c | 5 +---- lapack-netlib/TESTING/MATGEN/clatm3.c | 5 +---- lapack-netlib/TESTING/MATGEN/clatm5.c | 5 +---- lapack-netlib/TESTING/MATGEN/clatm6.c | 5 +---- lapack-netlib/TESTING/MATGEN/clatme.c | 6 +++--- lapack-netlib/TESTING/MATGEN/clatmr.c | 6 +++--- lapack-netlib/TESTING/MATGEN/clatms.c | 6 +++--- lapack-netlib/TESTING/MATGEN/clatmt.c | 6 +++--- lapack-netlib/TESTING/MATGEN/dlagge.c | 5 +---- lapack-netlib/TESTING/MATGEN/dlagsy.c | 5 +---- lapack-netlib/TESTING/MATGEN/dlahilb.c | 5 +---- lapack-netlib/TESTING/MATGEN/dlakf2.c | 5 +---- lapack-netlib/TESTING/MATGEN/dlaran.c | 5 +---- lapack-netlib/TESTING/MATGEN/dlarge.c | 5 +---- lapack-netlib/TESTING/MATGEN/dlarnd.c | 5 +---- lapack-netlib/TESTING/MATGEN/dlaror.c | 6 +++--- lapack-netlib/TESTING/MATGEN/dlarot.c | 6 +++--- lapack-netlib/TESTING/MATGEN/dlatm1.c | 5 +---- lapack-netlib/TESTING/MATGEN/dlatm2.c | 5 +---- lapack-netlib/TESTING/MATGEN/dlatm3.c | 5 +---- lapack-netlib/TESTING/MATGEN/dlatm5.c | 5 +---- lapack-netlib/TESTING/MATGEN/dlatm6.c | 5 +---- lapack-netlib/TESTING/MATGEN/dlatm7.c | 5 +---- lapack-netlib/TESTING/MATGEN/dlatme.c | 6 +++--- lapack-netlib/TESTING/MATGEN/dlatmr.c | 6 +++--- lapack-netlib/TESTING/MATGEN/dlatms.c | 6 +++--- lapack-netlib/TESTING/MATGEN/dlatmt.c | 6 +++--- lapack-netlib/TESTING/MATGEN/slagge.c | 5 +---- lapack-netlib/TESTING/MATGEN/slagsy.c | 5 +---- lapack-netlib/TESTING/MATGEN/slahilb.c | 5 +---- lapack-netlib/TESTING/MATGEN/slakf2.c | 5 +---- lapack-netlib/TESTING/MATGEN/slaran.c | 5 +---- lapack-netlib/TESTING/MATGEN/slarge.c | 5 +---- lapack-netlib/TESTING/MATGEN/slarnd.c | 5 +---- lapack-netlib/TESTING/MATGEN/slaror.c | 6 +++--- lapack-netlib/TESTING/MATGEN/slarot.c | 6 +++--- lapack-netlib/TESTING/MATGEN/slatm1.c | 5 +---- lapack-netlib/TESTING/MATGEN/slatm2.c | 5 +---- lapack-netlib/TESTING/MATGEN/slatm3.c | 5 +---- lapack-netlib/TESTING/MATGEN/slatm5.c | 5 +---- lapack-netlib/TESTING/MATGEN/slatm6.c | 5 +---- lapack-netlib/TESTING/MATGEN/slatm7.c | 5 +---- lapack-netlib/TESTING/MATGEN/slatme.c | 6 +++--- lapack-netlib/TESTING/MATGEN/slatmr.c | 6 +++--- lapack-netlib/TESTING/MATGEN/slatms.c | 6 +++--- lapack-netlib/TESTING/MATGEN/slatmt.c | 6 +++--- lapack-netlib/TESTING/MATGEN/zlagge.c | 5 +---- lapack-netlib/TESTING/MATGEN/zlaghe.c | 5 +---- lapack-netlib/TESTING/MATGEN/zlagsy.c | 5 +---- lapack-netlib/TESTING/MATGEN/zlahilb.c | 6 +++--- lapack-netlib/TESTING/MATGEN/zlakf2.c | 5 +---- lapack-netlib/TESTING/MATGEN/zlarge.c | 5 +---- lapack-netlib/TESTING/MATGEN/zlarnd.c | 5 +---- lapack-netlib/TESTING/MATGEN/zlaror.c | 6 +++--- lapack-netlib/TESTING/MATGEN/zlarot.c | 6 +++--- lapack-netlib/TESTING/MATGEN/zlatm1.c | 5 +---- lapack-netlib/TESTING/MATGEN/zlatm2.c | 5 +---- lapack-netlib/TESTING/MATGEN/zlatm3.c | 5 +---- lapack-netlib/TESTING/MATGEN/zlatm5.c | 5 +---- lapack-netlib/TESTING/MATGEN/zlatm6.c | 5 +---- lapack-netlib/TESTING/MATGEN/zlatme.c | 6 +++--- lapack-netlib/TESTING/MATGEN/zlatmr.c | 6 +++--- lapack-netlib/TESTING/MATGEN/zlatms.c | 6 +++--- lapack-netlib/TESTING/MATGEN/zlatmt.c | 6 +++--- 74 files changed, 126 insertions(+), 270 deletions(-) diff --git a/lapack-netlib/TESTING/MATGEN/clagge.c b/lapack-netlib/TESTING/MATGEN/clagge.c index 62c33d01e..82c4e5706 100644 --- a/lapack-netlib/TESTING/MATGEN/clagge.c +++ b/lapack-netlib/TESTING/MATGEN/clagge.c @@ -52,9 +52,6 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; -typedef char logical1; typedef char integer1; #define TRUE_ (1) @@ -259,7 +256,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* Table of constant values */ diff --git a/lapack-netlib/TESTING/MATGEN/claghe.c b/lapack-netlib/TESTING/MATGEN/claghe.c index 009329dd8..2696de72d 100644 --- a/lapack-netlib/TESTING/MATGEN/claghe.c +++ b/lapack-netlib/TESTING/MATGEN/claghe.c @@ -52,9 +52,6 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; -typedef char logical1; typedef char integer1; #define TRUE_ (1) @@ -259,7 +256,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* Table of constant values */ diff --git a/lapack-netlib/TESTING/MATGEN/clagsy.c b/lapack-netlib/TESTING/MATGEN/clagsy.c index 5117f85db..1921a1c90 100644 --- a/lapack-netlib/TESTING/MATGEN/clagsy.c +++ b/lapack-netlib/TESTING/MATGEN/clagsy.c @@ -52,9 +52,6 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; -typedef char logical1; typedef char integer1; #define TRUE_ (1) @@ -259,7 +256,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* Table of constant values */ diff --git a/lapack-netlib/TESTING/MATGEN/clahilb.c b/lapack-netlib/TESTING/MATGEN/clahilb.c index 1ee293c6f..e20f928cb 100644 --- a/lapack-netlib/TESTING/MATGEN/clahilb.c +++ b/lapack-netlib/TESTING/MATGEN/clahilb.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -259,7 +259,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* Table of constant values */ diff --git a/lapack-netlib/TESTING/MATGEN/clakf2.c b/lapack-netlib/TESTING/MATGEN/clakf2.c index 2b1b4e905..2964aa0c2 100644 --- a/lapack-netlib/TESTING/MATGEN/clakf2.c +++ b/lapack-netlib/TESTING/MATGEN/clakf2.c @@ -52,9 +52,6 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; -typedef char logical1; typedef char integer1; #define TRUE_ (1) @@ -259,7 +256,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* Table of constant values */ diff --git a/lapack-netlib/TESTING/MATGEN/clarge.c b/lapack-netlib/TESTING/MATGEN/clarge.c index 25801da89..25a4a2f01 100644 --- a/lapack-netlib/TESTING/MATGEN/clarge.c +++ b/lapack-netlib/TESTING/MATGEN/clarge.c @@ -52,9 +52,6 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; -typedef char logical1; typedef char integer1; #define TRUE_ (1) @@ -259,7 +256,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* Table of constant values */ diff --git a/lapack-netlib/TESTING/MATGEN/clarnd.c b/lapack-netlib/TESTING/MATGEN/clarnd.c index 26a22a3e0..745f1865e 100644 --- a/lapack-netlib/TESTING/MATGEN/clarnd.c +++ b/lapack-netlib/TESTING/MATGEN/clarnd.c @@ -52,9 +52,6 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; -typedef char logical1; typedef char integer1; #define TRUE_ (1) @@ -259,7 +256,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* > \brief \b CLARND */ diff --git a/lapack-netlib/TESTING/MATGEN/claror.c b/lapack-netlib/TESTING/MATGEN/claror.c index b0d73f37c..b09b8c729 100644 --- a/lapack-netlib/TESTING/MATGEN/claror.c +++ b/lapack-netlib/TESTING/MATGEN/claror.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -259,7 +259,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* Table of constant values */ diff --git a/lapack-netlib/TESTING/MATGEN/clarot.c b/lapack-netlib/TESTING/MATGEN/clarot.c index bd5f01cd3..7fd602ee4 100644 --- a/lapack-netlib/TESTING/MATGEN/clarot.c +++ b/lapack-netlib/TESTING/MATGEN/clarot.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -259,7 +259,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* Table of constant values */ diff --git a/lapack-netlib/TESTING/MATGEN/clatm1.c b/lapack-netlib/TESTING/MATGEN/clatm1.c index 2651091c8..638755302 100644 --- a/lapack-netlib/TESTING/MATGEN/clatm1.c +++ b/lapack-netlib/TESTING/MATGEN/clatm1.c @@ -52,9 +52,6 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; -typedef char logical1; typedef char integer1; #define TRUE_ (1) @@ -259,7 +256,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + static float spow_ui(float x, integer n) { float pow=1.0; unsigned long int u; diff --git a/lapack-netlib/TESTING/MATGEN/clatm2.c b/lapack-netlib/TESTING/MATGEN/clatm2.c index 2dceff497..92717b2fe 100644 --- a/lapack-netlib/TESTING/MATGEN/clatm2.c +++ b/lapack-netlib/TESTING/MATGEN/clatm2.c @@ -52,9 +52,6 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; -typedef char logical1; typedef char integer1; #define TRUE_ (1) @@ -259,7 +256,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* > \brief \b CLATM2 */ diff --git a/lapack-netlib/TESTING/MATGEN/clatm3.c b/lapack-netlib/TESTING/MATGEN/clatm3.c index fcd8dbfcb..997a98007 100644 --- a/lapack-netlib/TESTING/MATGEN/clatm3.c +++ b/lapack-netlib/TESTING/MATGEN/clatm3.c @@ -52,9 +52,6 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; -typedef char logical1; typedef char integer1; #define TRUE_ (1) @@ -259,7 +256,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* > \brief \b CLATM3 */ diff --git a/lapack-netlib/TESTING/MATGEN/clatm5.c b/lapack-netlib/TESTING/MATGEN/clatm5.c index 8fbc1c0a6..3cdfbc7d5 100644 --- a/lapack-netlib/TESTING/MATGEN/clatm5.c +++ b/lapack-netlib/TESTING/MATGEN/clatm5.c @@ -52,9 +52,6 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; -typedef char logical1; typedef char integer1; #define TRUE_ (1) @@ -259,7 +256,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* Table of constant values */ diff --git a/lapack-netlib/TESTING/MATGEN/clatm6.c b/lapack-netlib/TESTING/MATGEN/clatm6.c index f6992a362..cdb79cc52 100644 --- a/lapack-netlib/TESTING/MATGEN/clatm6.c +++ b/lapack-netlib/TESTING/MATGEN/clatm6.c @@ -52,9 +52,6 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; -typedef char logical1; typedef char integer1; #define TRUE_ (1) @@ -259,7 +256,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* Table of constant values */ diff --git a/lapack-netlib/TESTING/MATGEN/clatme.c b/lapack-netlib/TESTING/MATGEN/clatme.c index fd0aec8ec..572b7c607 100644 --- a/lapack-netlib/TESTING/MATGEN/clatme.c +++ b/lapack-netlib/TESTING/MATGEN/clatme.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -259,7 +259,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* Table of constant values */ diff --git a/lapack-netlib/TESTING/MATGEN/clatmr.c b/lapack-netlib/TESTING/MATGEN/clatmr.c index 2f987f744..9ecbb802f 100644 --- a/lapack-netlib/TESTING/MATGEN/clatmr.c +++ b/lapack-netlib/TESTING/MATGEN/clatmr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -259,7 +259,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* Table of constant values */ diff --git a/lapack-netlib/TESTING/MATGEN/clatms.c b/lapack-netlib/TESTING/MATGEN/clatms.c index 006b33b7a..a20825e02 100644 --- a/lapack-netlib/TESTING/MATGEN/clatms.c +++ b/lapack-netlib/TESTING/MATGEN/clatms.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -259,7 +259,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* Table of constant values */ diff --git a/lapack-netlib/TESTING/MATGEN/clatmt.c b/lapack-netlib/TESTING/MATGEN/clatmt.c index f6a842861..3abf958c7 100644 --- a/lapack-netlib/TESTING/MATGEN/clatmt.c +++ b/lapack-netlib/TESTING/MATGEN/clatmt.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -259,7 +259,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* Table of constant values */ diff --git a/lapack-netlib/TESTING/MATGEN/dlagge.c b/lapack-netlib/TESTING/MATGEN/dlagge.c index 5482c3ff6..7f50ea879 100644 --- a/lapack-netlib/TESTING/MATGEN/dlagge.c +++ b/lapack-netlib/TESTING/MATGEN/dlagge.c @@ -52,9 +52,6 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; -typedef char logical1; typedef char integer1; #define TRUE_ (1) @@ -259,7 +256,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* Table of constant values */ diff --git a/lapack-netlib/TESTING/MATGEN/dlagsy.c b/lapack-netlib/TESTING/MATGEN/dlagsy.c index efcbe3f99..9665e5443 100644 --- a/lapack-netlib/TESTING/MATGEN/dlagsy.c +++ b/lapack-netlib/TESTING/MATGEN/dlagsy.c @@ -52,9 +52,6 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; -typedef char logical1; typedef char integer1; #define TRUE_ (1) @@ -259,7 +256,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* Table of constant values */ diff --git a/lapack-netlib/TESTING/MATGEN/dlahilb.c b/lapack-netlib/TESTING/MATGEN/dlahilb.c index d671adee6..2ab0aae05 100644 --- a/lapack-netlib/TESTING/MATGEN/dlahilb.c +++ b/lapack-netlib/TESTING/MATGEN/dlahilb.c @@ -52,9 +52,6 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; -typedef char logical1; typedef char integer1; #define TRUE_ (1) @@ -259,7 +256,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* Table of constant values */ diff --git a/lapack-netlib/TESTING/MATGEN/dlakf2.c b/lapack-netlib/TESTING/MATGEN/dlakf2.c index b4a09204b..6103ead63 100644 --- a/lapack-netlib/TESTING/MATGEN/dlakf2.c +++ b/lapack-netlib/TESTING/MATGEN/dlakf2.c @@ -52,9 +52,6 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; -typedef char logical1; typedef char integer1; #define TRUE_ (1) @@ -259,7 +256,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* Table of constant values */ diff --git a/lapack-netlib/TESTING/MATGEN/dlaran.c b/lapack-netlib/TESTING/MATGEN/dlaran.c index f13ada834..1fa957939 100644 --- a/lapack-netlib/TESTING/MATGEN/dlaran.c +++ b/lapack-netlib/TESTING/MATGEN/dlaran.c @@ -52,9 +52,6 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; -typedef char logical1; typedef char integer1; #define TRUE_ (1) @@ -259,7 +256,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* > \brief \b DLARAN */ diff --git a/lapack-netlib/TESTING/MATGEN/dlarge.c b/lapack-netlib/TESTING/MATGEN/dlarge.c index 5cc7fbce8..7d3761383 100644 --- a/lapack-netlib/TESTING/MATGEN/dlarge.c +++ b/lapack-netlib/TESTING/MATGEN/dlarge.c @@ -52,9 +52,6 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; -typedef char logical1; typedef char integer1; #define TRUE_ (1) @@ -259,7 +256,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* Table of constant values */ diff --git a/lapack-netlib/TESTING/MATGEN/dlarnd.c b/lapack-netlib/TESTING/MATGEN/dlarnd.c index 3119097bf..0e6c33521 100644 --- a/lapack-netlib/TESTING/MATGEN/dlarnd.c +++ b/lapack-netlib/TESTING/MATGEN/dlarnd.c @@ -52,9 +52,6 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; -typedef char logical1; typedef char integer1; #define TRUE_ (1) @@ -259,7 +256,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* > \brief \b DLARND */ diff --git a/lapack-netlib/TESTING/MATGEN/dlaror.c b/lapack-netlib/TESTING/MATGEN/dlaror.c index fdd126174..baad70256 100644 --- a/lapack-netlib/TESTING/MATGEN/dlaror.c +++ b/lapack-netlib/TESTING/MATGEN/dlaror.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -259,7 +259,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* Table of constant values */ diff --git a/lapack-netlib/TESTING/MATGEN/dlarot.c b/lapack-netlib/TESTING/MATGEN/dlarot.c index 3eadf15c6..c858e7596 100644 --- a/lapack-netlib/TESTING/MATGEN/dlarot.c +++ b/lapack-netlib/TESTING/MATGEN/dlarot.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -259,7 +259,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* Table of constant values */ diff --git a/lapack-netlib/TESTING/MATGEN/dlatm1.c b/lapack-netlib/TESTING/MATGEN/dlatm1.c index aa58300a3..86f1cd2b9 100644 --- a/lapack-netlib/TESTING/MATGEN/dlatm1.c +++ b/lapack-netlib/TESTING/MATGEN/dlatm1.c @@ -52,9 +52,6 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; -typedef char logical1; typedef char integer1; #define TRUE_ (1) @@ -259,7 +256,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + static double dpow_ui(double x, integer n) { double pow=1.0; unsigned long int u; diff --git a/lapack-netlib/TESTING/MATGEN/dlatm2.c b/lapack-netlib/TESTING/MATGEN/dlatm2.c index 7491e9829..081e90614 100644 --- a/lapack-netlib/TESTING/MATGEN/dlatm2.c +++ b/lapack-netlib/TESTING/MATGEN/dlatm2.c @@ -52,9 +52,6 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; -typedef char logical1; typedef char integer1; #define TRUE_ (1) @@ -259,7 +256,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* > \brief \b DLATM2 */ diff --git a/lapack-netlib/TESTING/MATGEN/dlatm3.c b/lapack-netlib/TESTING/MATGEN/dlatm3.c index a9d26c7fc..bf4b54a45 100644 --- a/lapack-netlib/TESTING/MATGEN/dlatm3.c +++ b/lapack-netlib/TESTING/MATGEN/dlatm3.c @@ -52,9 +52,6 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; -typedef char logical1; typedef char integer1; #define TRUE_ (1) @@ -259,7 +256,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* > \brief \b DLATM3 */ diff --git a/lapack-netlib/TESTING/MATGEN/dlatm5.c b/lapack-netlib/TESTING/MATGEN/dlatm5.c index 7f1c36428..441050cc3 100644 --- a/lapack-netlib/TESTING/MATGEN/dlatm5.c +++ b/lapack-netlib/TESTING/MATGEN/dlatm5.c @@ -52,9 +52,6 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; -typedef char logical1; typedef char integer1; #define TRUE_ (1) @@ -259,7 +256,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* Table of constant values */ diff --git a/lapack-netlib/TESTING/MATGEN/dlatm6.c b/lapack-netlib/TESTING/MATGEN/dlatm6.c index 0b3fbb42f..f32a41113 100644 --- a/lapack-netlib/TESTING/MATGEN/dlatm6.c +++ b/lapack-netlib/TESTING/MATGEN/dlatm6.c @@ -52,9 +52,6 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; -typedef char logical1; typedef char integer1; #define TRUE_ (1) @@ -259,7 +256,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* Table of constant values */ diff --git a/lapack-netlib/TESTING/MATGEN/dlatm7.c b/lapack-netlib/TESTING/MATGEN/dlatm7.c index c907feff4..159c4c024 100644 --- a/lapack-netlib/TESTING/MATGEN/dlatm7.c +++ b/lapack-netlib/TESTING/MATGEN/dlatm7.c @@ -52,9 +52,6 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; -typedef char logical1; typedef char integer1; #define TRUE_ (1) @@ -259,7 +256,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + static double dpow_ui(double x, integer n) { double pow=1.0; unsigned long int u; diff --git a/lapack-netlib/TESTING/MATGEN/dlatme.c b/lapack-netlib/TESTING/MATGEN/dlatme.c index e29df164c..c5c647508 100644 --- a/lapack-netlib/TESTING/MATGEN/dlatme.c +++ b/lapack-netlib/TESTING/MATGEN/dlatme.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -259,7 +259,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* Table of constant values */ diff --git a/lapack-netlib/TESTING/MATGEN/dlatmr.c b/lapack-netlib/TESTING/MATGEN/dlatmr.c index 77e224840..f054e9871 100644 --- a/lapack-netlib/TESTING/MATGEN/dlatmr.c +++ b/lapack-netlib/TESTING/MATGEN/dlatmr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -259,7 +259,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* Table of constant values */ diff --git a/lapack-netlib/TESTING/MATGEN/dlatms.c b/lapack-netlib/TESTING/MATGEN/dlatms.c index c9a8b226e..6d92e1cf7 100644 --- a/lapack-netlib/TESTING/MATGEN/dlatms.c +++ b/lapack-netlib/TESTING/MATGEN/dlatms.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -259,7 +259,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* Table of constant values */ diff --git a/lapack-netlib/TESTING/MATGEN/dlatmt.c b/lapack-netlib/TESTING/MATGEN/dlatmt.c index 6b0871257..5717e2575 100644 --- a/lapack-netlib/TESTING/MATGEN/dlatmt.c +++ b/lapack-netlib/TESTING/MATGEN/dlatmt.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -259,7 +259,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* Table of constant values */ diff --git a/lapack-netlib/TESTING/MATGEN/slagge.c b/lapack-netlib/TESTING/MATGEN/slagge.c index 9213d9688..1edeadf6e 100644 --- a/lapack-netlib/TESTING/MATGEN/slagge.c +++ b/lapack-netlib/TESTING/MATGEN/slagge.c @@ -52,9 +52,6 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; -typedef char logical1; typedef char integer1; #define TRUE_ (1) @@ -259,7 +256,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* Table of constant values */ diff --git a/lapack-netlib/TESTING/MATGEN/slagsy.c b/lapack-netlib/TESTING/MATGEN/slagsy.c index fad4cf5fa..9e58b6822 100644 --- a/lapack-netlib/TESTING/MATGEN/slagsy.c +++ b/lapack-netlib/TESTING/MATGEN/slagsy.c @@ -52,9 +52,6 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; -typedef char logical1; typedef char integer1; #define TRUE_ (1) @@ -259,7 +256,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* Table of constant values */ diff --git a/lapack-netlib/TESTING/MATGEN/slahilb.c b/lapack-netlib/TESTING/MATGEN/slahilb.c index 7367d71a2..75a73ee0e 100644 --- a/lapack-netlib/TESTING/MATGEN/slahilb.c +++ b/lapack-netlib/TESTING/MATGEN/slahilb.c @@ -52,9 +52,6 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; -typedef char logical1; typedef char integer1; #define TRUE_ (1) @@ -259,7 +256,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* Table of constant values */ diff --git a/lapack-netlib/TESTING/MATGEN/slakf2.c b/lapack-netlib/TESTING/MATGEN/slakf2.c index 388d630e1..e4fa51c5d 100644 --- a/lapack-netlib/TESTING/MATGEN/slakf2.c +++ b/lapack-netlib/TESTING/MATGEN/slakf2.c @@ -52,9 +52,6 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; -typedef char logical1; typedef char integer1; #define TRUE_ (1) @@ -259,7 +256,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* Table of constant values */ diff --git a/lapack-netlib/TESTING/MATGEN/slaran.c b/lapack-netlib/TESTING/MATGEN/slaran.c index af9b56412..4213d18fc 100644 --- a/lapack-netlib/TESTING/MATGEN/slaran.c +++ b/lapack-netlib/TESTING/MATGEN/slaran.c @@ -52,9 +52,6 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; -typedef char logical1; typedef char integer1; #define TRUE_ (1) @@ -259,7 +256,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* > \brief \b SLARAN */ diff --git a/lapack-netlib/TESTING/MATGEN/slarge.c b/lapack-netlib/TESTING/MATGEN/slarge.c index d5fbd541c..a984d6112 100644 --- a/lapack-netlib/TESTING/MATGEN/slarge.c +++ b/lapack-netlib/TESTING/MATGEN/slarge.c @@ -52,9 +52,6 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; -typedef char logical1; typedef char integer1; #define TRUE_ (1) @@ -259,7 +256,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* Table of constant values */ diff --git a/lapack-netlib/TESTING/MATGEN/slarnd.c b/lapack-netlib/TESTING/MATGEN/slarnd.c index eabfa13c0..4c36a6570 100644 --- a/lapack-netlib/TESTING/MATGEN/slarnd.c +++ b/lapack-netlib/TESTING/MATGEN/slarnd.c @@ -52,9 +52,6 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; -typedef char logical1; typedef char integer1; #define TRUE_ (1) @@ -259,7 +256,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* > \brief \b SLARND */ diff --git a/lapack-netlib/TESTING/MATGEN/slaror.c b/lapack-netlib/TESTING/MATGEN/slaror.c index 7e3065432..ed48b2150 100644 --- a/lapack-netlib/TESTING/MATGEN/slaror.c +++ b/lapack-netlib/TESTING/MATGEN/slaror.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -259,7 +259,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* Table of constant values */ diff --git a/lapack-netlib/TESTING/MATGEN/slarot.c b/lapack-netlib/TESTING/MATGEN/slarot.c index 8d2f51f92..91f72ff2d 100644 --- a/lapack-netlib/TESTING/MATGEN/slarot.c +++ b/lapack-netlib/TESTING/MATGEN/slarot.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -259,7 +259,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* Table of constant values */ diff --git a/lapack-netlib/TESTING/MATGEN/slatm1.c b/lapack-netlib/TESTING/MATGEN/slatm1.c index 8acbdfa3e..6399d5ffb 100644 --- a/lapack-netlib/TESTING/MATGEN/slatm1.c +++ b/lapack-netlib/TESTING/MATGEN/slatm1.c @@ -52,9 +52,6 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; -typedef char logical1; typedef char integer1; #define TRUE_ (1) @@ -259,7 +256,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + static float spow_ui(float x, integer n) { float pow=1.0; unsigned long int u; diff --git a/lapack-netlib/TESTING/MATGEN/slatm2.c b/lapack-netlib/TESTING/MATGEN/slatm2.c index 833ee5dea..538b441bc 100644 --- a/lapack-netlib/TESTING/MATGEN/slatm2.c +++ b/lapack-netlib/TESTING/MATGEN/slatm2.c @@ -52,9 +52,6 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; -typedef char logical1; typedef char integer1; #define TRUE_ (1) @@ -260,7 +257,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* > \brief \b SLATM2 */ diff --git a/lapack-netlib/TESTING/MATGEN/slatm3.c b/lapack-netlib/TESTING/MATGEN/slatm3.c index cdf96ef51..92649f3b8 100644 --- a/lapack-netlib/TESTING/MATGEN/slatm3.c +++ b/lapack-netlib/TESTING/MATGEN/slatm3.c @@ -52,9 +52,6 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; -typedef char logical1; typedef char integer1; #define TRUE_ (1) @@ -259,7 +256,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* > \brief \b SLATM3 */ diff --git a/lapack-netlib/TESTING/MATGEN/slatm5.c b/lapack-netlib/TESTING/MATGEN/slatm5.c index 9122bc041..a7e059ca5 100644 --- a/lapack-netlib/TESTING/MATGEN/slatm5.c +++ b/lapack-netlib/TESTING/MATGEN/slatm5.c @@ -52,9 +52,6 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; -typedef char logical1; typedef char integer1; #define TRUE_ (1) @@ -259,7 +256,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* Table of constant values */ diff --git a/lapack-netlib/TESTING/MATGEN/slatm6.c b/lapack-netlib/TESTING/MATGEN/slatm6.c index 6e3306d29..84cbaadfc 100644 --- a/lapack-netlib/TESTING/MATGEN/slatm6.c +++ b/lapack-netlib/TESTING/MATGEN/slatm6.c @@ -52,9 +52,6 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; -typedef char logical1; typedef char integer1; #define TRUE_ (1) @@ -259,7 +256,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* Table of constant values */ diff --git a/lapack-netlib/TESTING/MATGEN/slatm7.c b/lapack-netlib/TESTING/MATGEN/slatm7.c index 5ea2e32f6..d0eee2206 100644 --- a/lapack-netlib/TESTING/MATGEN/slatm7.c +++ b/lapack-netlib/TESTING/MATGEN/slatm7.c @@ -52,9 +52,6 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; -typedef char logical1; typedef char integer1; #define TRUE_ (1) @@ -259,7 +256,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + static float spow_ui(float x, integer n) { float pow=1.0; unsigned long int u; diff --git a/lapack-netlib/TESTING/MATGEN/slatme.c b/lapack-netlib/TESTING/MATGEN/slatme.c index 126c42121..56a3c251a 100644 --- a/lapack-netlib/TESTING/MATGEN/slatme.c +++ b/lapack-netlib/TESTING/MATGEN/slatme.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -259,7 +259,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* Table of constant values */ diff --git a/lapack-netlib/TESTING/MATGEN/slatmr.c b/lapack-netlib/TESTING/MATGEN/slatmr.c index cc227a9d8..ddd5702dc 100644 --- a/lapack-netlib/TESTING/MATGEN/slatmr.c +++ b/lapack-netlib/TESTING/MATGEN/slatmr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -259,7 +259,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* Table of constant values */ diff --git a/lapack-netlib/TESTING/MATGEN/slatms.c b/lapack-netlib/TESTING/MATGEN/slatms.c index 95f005858..6fd71c862 100644 --- a/lapack-netlib/TESTING/MATGEN/slatms.c +++ b/lapack-netlib/TESTING/MATGEN/slatms.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -259,7 +259,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* Table of constant values */ diff --git a/lapack-netlib/TESTING/MATGEN/slatmt.c b/lapack-netlib/TESTING/MATGEN/slatmt.c index cd1c3c7c1..c1a8f0b80 100644 --- a/lapack-netlib/TESTING/MATGEN/slatmt.c +++ b/lapack-netlib/TESTING/MATGEN/slatmt.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -259,7 +259,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* Table of constant values */ diff --git a/lapack-netlib/TESTING/MATGEN/zlagge.c b/lapack-netlib/TESTING/MATGEN/zlagge.c index 56d0318e2..d13afa91c 100644 --- a/lapack-netlib/TESTING/MATGEN/zlagge.c +++ b/lapack-netlib/TESTING/MATGEN/zlagge.c @@ -52,9 +52,6 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; -typedef char logical1; typedef char integer1; #define TRUE_ (1) @@ -259,7 +256,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* Table of constant values */ diff --git a/lapack-netlib/TESTING/MATGEN/zlaghe.c b/lapack-netlib/TESTING/MATGEN/zlaghe.c index 63a8a05d6..c9fccb89a 100644 --- a/lapack-netlib/TESTING/MATGEN/zlaghe.c +++ b/lapack-netlib/TESTING/MATGEN/zlaghe.c @@ -52,9 +52,6 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; -typedef char logical1; typedef char integer1; #define TRUE_ (1) @@ -259,7 +256,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* Table of constant values */ diff --git a/lapack-netlib/TESTING/MATGEN/zlagsy.c b/lapack-netlib/TESTING/MATGEN/zlagsy.c index 8804bfbce..1445a670f 100644 --- a/lapack-netlib/TESTING/MATGEN/zlagsy.c +++ b/lapack-netlib/TESTING/MATGEN/zlagsy.c @@ -52,9 +52,6 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; -typedef char logical1; typedef char integer1; #define TRUE_ (1) @@ -259,7 +256,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* Table of constant values */ diff --git a/lapack-netlib/TESTING/MATGEN/zlahilb.c b/lapack-netlib/TESTING/MATGEN/zlahilb.c index ff3d06525..a8e0ebb06 100644 --- a/lapack-netlib/TESTING/MATGEN/zlahilb.c +++ b/lapack-netlib/TESTING/MATGEN/zlahilb.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -259,7 +259,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* Table of constant values */ diff --git a/lapack-netlib/TESTING/MATGEN/zlakf2.c b/lapack-netlib/TESTING/MATGEN/zlakf2.c index 4c08bd112..f558bad21 100644 --- a/lapack-netlib/TESTING/MATGEN/zlakf2.c +++ b/lapack-netlib/TESTING/MATGEN/zlakf2.c @@ -52,9 +52,6 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; -typedef char logical1; typedef char integer1; #define TRUE_ (1) @@ -259,7 +256,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* Table of constant values */ diff --git a/lapack-netlib/TESTING/MATGEN/zlarge.c b/lapack-netlib/TESTING/MATGEN/zlarge.c index 848cde007..e38cbe824 100644 --- a/lapack-netlib/TESTING/MATGEN/zlarge.c +++ b/lapack-netlib/TESTING/MATGEN/zlarge.c @@ -52,9 +52,6 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; -typedef char logical1; typedef char integer1; #define TRUE_ (1) @@ -259,7 +256,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* Table of constant values */ diff --git a/lapack-netlib/TESTING/MATGEN/zlarnd.c b/lapack-netlib/TESTING/MATGEN/zlarnd.c index ff1bf1467..ca71aceb0 100644 --- a/lapack-netlib/TESTING/MATGEN/zlarnd.c +++ b/lapack-netlib/TESTING/MATGEN/zlarnd.c @@ -52,9 +52,6 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; -typedef char logical1; typedef char integer1; #define TRUE_ (1) @@ -259,7 +256,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* > \brief \b ZLARND */ diff --git a/lapack-netlib/TESTING/MATGEN/zlaror.c b/lapack-netlib/TESTING/MATGEN/zlaror.c index c8a84f215..227bbbf64 100644 --- a/lapack-netlib/TESTING/MATGEN/zlaror.c +++ b/lapack-netlib/TESTING/MATGEN/zlaror.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -259,7 +259,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* Table of constant values */ diff --git a/lapack-netlib/TESTING/MATGEN/zlarot.c b/lapack-netlib/TESTING/MATGEN/zlarot.c index be951dcb5..86b5ae759 100644 --- a/lapack-netlib/TESTING/MATGEN/zlarot.c +++ b/lapack-netlib/TESTING/MATGEN/zlarot.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -259,7 +259,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* Table of constant values */ diff --git a/lapack-netlib/TESTING/MATGEN/zlatm1.c b/lapack-netlib/TESTING/MATGEN/zlatm1.c index 447edc259..d3655efbd 100644 --- a/lapack-netlib/TESTING/MATGEN/zlatm1.c +++ b/lapack-netlib/TESTING/MATGEN/zlatm1.c @@ -52,9 +52,6 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; -typedef char logical1; typedef char integer1; #define TRUE_ (1) @@ -259,7 +256,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + static double dpow_ui(double x, integer n) { double pow=1.0; unsigned long int u; diff --git a/lapack-netlib/TESTING/MATGEN/zlatm2.c b/lapack-netlib/TESTING/MATGEN/zlatm2.c index e6fe75d06..52bc1ce7b 100644 --- a/lapack-netlib/TESTING/MATGEN/zlatm2.c +++ b/lapack-netlib/TESTING/MATGEN/zlatm2.c @@ -52,9 +52,6 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; -typedef char logical1; typedef char integer1; #define TRUE_ (1) @@ -259,7 +256,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* > \brief \b ZLATM2 */ diff --git a/lapack-netlib/TESTING/MATGEN/zlatm3.c b/lapack-netlib/TESTING/MATGEN/zlatm3.c index 6370a9d39..ec39eeb45 100644 --- a/lapack-netlib/TESTING/MATGEN/zlatm3.c +++ b/lapack-netlib/TESTING/MATGEN/zlatm3.c @@ -52,9 +52,6 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; -typedef char logical1; typedef char integer1; #define TRUE_ (1) @@ -259,7 +256,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* > \brief \b ZLATM3 */ diff --git a/lapack-netlib/TESTING/MATGEN/zlatm5.c b/lapack-netlib/TESTING/MATGEN/zlatm5.c index 5ee6cc8ce..0abc83624 100644 --- a/lapack-netlib/TESTING/MATGEN/zlatm5.c +++ b/lapack-netlib/TESTING/MATGEN/zlatm5.c @@ -52,9 +52,6 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; -typedef char logical1; typedef char integer1; #define TRUE_ (1) @@ -260,7 +257,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* Table of constant values */ diff --git a/lapack-netlib/TESTING/MATGEN/zlatm6.c b/lapack-netlib/TESTING/MATGEN/zlatm6.c index f394cb1df..7791c51a2 100644 --- a/lapack-netlib/TESTING/MATGEN/zlatm6.c +++ b/lapack-netlib/TESTING/MATGEN/zlatm6.c @@ -52,9 +52,6 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; -typedef char logical1; typedef char integer1; #define TRUE_ (1) @@ -259,7 +256,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* Table of constant values */ diff --git a/lapack-netlib/TESTING/MATGEN/zlatme.c b/lapack-netlib/TESTING/MATGEN/zlatme.c index 11127aa51..f22851a12 100644 --- a/lapack-netlib/TESTING/MATGEN/zlatme.c +++ b/lapack-netlib/TESTING/MATGEN/zlatme.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -259,7 +259,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* Table of constant values */ diff --git a/lapack-netlib/TESTING/MATGEN/zlatmr.c b/lapack-netlib/TESTING/MATGEN/zlatmr.c index 02a4cf16f..254edab54 100644 --- a/lapack-netlib/TESTING/MATGEN/zlatmr.c +++ b/lapack-netlib/TESTING/MATGEN/zlatmr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -259,7 +259,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* Table of constant values */ diff --git a/lapack-netlib/TESTING/MATGEN/zlatms.c b/lapack-netlib/TESTING/MATGEN/zlatms.c index 87f26059d..f78cccb5b 100644 --- a/lapack-netlib/TESTING/MATGEN/zlatms.c +++ b/lapack-netlib/TESTING/MATGEN/zlatms.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -259,7 +259,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* Table of constant values */ diff --git a/lapack-netlib/TESTING/MATGEN/zlatmt.c b/lapack-netlib/TESTING/MATGEN/zlatmt.c index 64c30ec17..9d467f44e 100644 --- a/lapack-netlib/TESTING/MATGEN/zlatmt.c +++ b/lapack-netlib/TESTING/MATGEN/zlatmt.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -259,7 +259,7 @@ typedef struct Namelist Namelist; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + /* Table of constant values */ From 547533fe9a00fa20c41710c847cd7eaaf000a7e8 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Wed, 3 Apr 2024 22:35:10 +0200 Subject: [PATCH 270/311] fix typedef of logical to support INTERFACE64 --- lapack-netlib/SRC/claqz0.c | 28 +++- lapack-netlib/SRC/claqz1.c | 29 +++- lapack-netlib/SRC/claqz2.c | 29 +++- lapack-netlib/SRC/claqz3.c | 29 +++- lapack-netlib/SRC/dlaqz0.c | 28 +++- lapack-netlib/SRC/dlaqz1.c | 29 +++- lapack-netlib/SRC/dlaqz2.c | 29 +++- lapack-netlib/SRC/dlaqz3.c | 29 +++- lapack-netlib/SRC/dlaqz4.c | 29 +++- lapack-netlib/SRC/la_constants.c | 29 +++- lapack-netlib/SRC/la_xisnan.c | 29 +++- lapack-netlib/SRC/sgbbrd.c | 256 +----------------------------- lapack-netlib/SRC/sgbcon.c | 256 +----------------------------- lapack-netlib/SRC/sgbequ.c | 255 +---------------------------- lapack-netlib/SRC/sgbrfs.c | 256 +----------------------------- lapack-netlib/SRC/sgbsv.c | 252 ----------------------------- lapack-netlib/SRC/sgbsvx.c | 256 +----------------------------- lapack-netlib/SRC/sgbtf2.c | 255 ----------------------------- lapack-netlib/SRC/sgbtrf.c | 256 +----------------------------- lapack-netlib/SRC/sgbtrs.c | 256 +----------------------------- lapack-netlib/SRC/sgebak.c | 256 +----------------------------- lapack-netlib/SRC/sgebal.c | 256 +----------------------------- lapack-netlib/SRC/sgebd2.c | 256 +----------------------------- lapack-netlib/SRC/sgebrd.c | 256 +----------------------------- lapack-netlib/SRC/sgecon.c | 256 +----------------------------- lapack-netlib/SRC/sgeequ.c | 256 +----------------------------- lapack-netlib/SRC/sgees.c | 251 +---------------------------- lapack-netlib/SRC/sgeesx.c | 249 +---------------------------- lapack-netlib/SRC/sgeev.c | 256 +----------------------------- lapack-netlib/SRC/sgeevx.c | 256 +----------------------------- lapack-netlib/SRC/sgehd2.c | 254 ----------------------------- lapack-netlib/SRC/sgehrd.c | 256 +----------------------------- lapack-netlib/SRC/sgelq2.c | 255 ----------------------------- lapack-netlib/SRC/sgelqf.c | 256 +----------------------------- lapack-netlib/SRC/sgels.c | 256 +----------------------------- lapack-netlib/SRC/sgelsd.c | 256 +----------------------------- lapack-netlib/SRC/sgelss.c | 256 +----------------------------- lapack-netlib/SRC/sgelsy.c | 256 +----------------------------- lapack-netlib/SRC/sgeql2.c | 255 ----------------------------- lapack-netlib/SRC/sgeqlf.c | 256 +----------------------------- lapack-netlib/SRC/sgeqp3.c | 256 +----------------------------- lapack-netlib/SRC/sgeqp3rk.c | 263 +----------------------------- lapack-netlib/SRC/sgeqr2.c | 255 ----------------------------- lapack-netlib/SRC/sgeqr2p.c | 255 ----------------------------- lapack-netlib/SRC/sgeqrf.c | 256 +----------------------------- lapack-netlib/SRC/sgeqrfp.c | 256 +----------------------------- lapack-netlib/SRC/sgerfs.c | 256 +----------------------------- lapack-netlib/SRC/sgerq2.c | 256 +----------------------------- lapack-netlib/SRC/sgerqf.c | 256 +----------------------------- lapack-netlib/SRC/sgesc2.c | 255 ----------------------------- lapack-netlib/SRC/sgesdd.c | 256 +----------------------------- lapack-netlib/SRC/sgesvd.c | 256 +----------------------------- lapack-netlib/SRC/sgesvdx.c | 256 +----------------------------- lapack-netlib/SRC/sgesvx.c | 256 +----------------------------- lapack-netlib/SRC/sgetc2.c | 255 ----------------------------- lapack-netlib/SRC/sgetrf2.c | 255 +---------------------------- lapack-netlib/SRC/sgetri.c | 256 +----------------------------- lapack-netlib/SRC/sggbak.c | 256 +----------------------------- lapack-netlib/SRC/sggbal.c | 264 ++----------------------------- lapack-netlib/SRC/sgges.c | 249 +---------------------------- lapack-netlib/SRC/sgges3.c | 249 +---------------------------- lapack-netlib/SRC/sggesx.c | 249 +---------------------------- lapack-netlib/SRC/sggev.c | 256 +----------------------------- lapack-netlib/SRC/sggev3.c | 256 +----------------------------- lapack-netlib/SRC/sggevx.c | 256 +----------------------------- lapack-netlib/SRC/sggglm.c | 256 +----------------------------- lapack-netlib/SRC/sgghd3.c | 256 +----------------------------- lapack-netlib/SRC/sgghrd.c | 256 +----------------------------- lapack-netlib/SRC/sgglse.c | 256 +----------------------------- lapack-netlib/SRC/sggqrf.c | 256 +----------------------------- lapack-netlib/SRC/sggrqf.c | 256 +----------------------------- lapack-netlib/SRC/sggsvd3.c | 256 +----------------------------- lapack-netlib/SRC/sggsvp3.c | 256 +----------------------------- lapack-netlib/SRC/sgtcon.c | 256 +----------------------------- lapack-netlib/SRC/sgtrfs.c | 256 +----------------------------- lapack-netlib/SRC/sgtsv.c | 256 +----------------------------- lapack-netlib/SRC/sgtsvx.c | 256 +----------------------------- lapack-netlib/SRC/sgttrf.c | 256 +----------------------------- lapack-netlib/SRC/sgttrs.c | 256 +----------------------------- lapack-netlib/SRC/sgtts2.c | 256 +----------------------------- lapack-netlib/SRC/shgeqz.c | 255 +---------------------------- lapack-netlib/SRC/shsein.c | 256 +----------------------------- lapack-netlib/SRC/shseqr.c | 256 +----------------------------- lapack-netlib/SRC/slabrd.c | 256 +----------------------------- lapack-netlib/SRC/slacon.c | 256 +----------------------------- lapack-netlib/SRC/slaqz0.c | 178 +++------------------ lapack-netlib/SRC/slaqz1.c | 29 +++- lapack-netlib/SRC/slaqz2.c | 29 +++- lapack-netlib/SRC/slaqz3.c | 29 +++- lapack-netlib/SRC/slaqz4.c | 29 +++- lapack-netlib/SRC/spotrf2.c | 255 +---------------------------- lapack-netlib/SRC/zlaqz0.c | 29 +++- lapack-netlib/SRC/zlaqz1.c | 29 +++- lapack-netlib/SRC/zlaqz2.c | 29 +++- lapack-netlib/SRC/zlaqz3.c | 29 +++- 95 files changed, 643 insertions(+), 19249 deletions(-) diff --git a/lapack-netlib/SRC/claqz0.c b/lapack-netlib/SRC/claqz0.c index d05923a46..6d7e7d534 100644 --- a/lapack-netlib/SRC/claqz0.c +++ b/lapack-netlib/SRC/claqz0.c @@ -18,8 +18,28 @@ #ifdef I #undef I #endif +#if defined(_WIN64) +typedef long long BLASLONG; +typedef unsigned long long BLASULONG; +#else +typedef long BLASLONG; +typedef unsigned long BLASULONG; +#endif + +#ifdef LAPACK_ILP64 +typedef BLASLONG blasint; +#if defined(_WIN64) +#define blasabs(x) llabs(x) +#else +#define blasabs(x) labs(x) +#endif +#else +typedef int blasint; +#define blasabs(x) abs(x) +#endif + +typedef blasint integer; -typedef int integer; typedef unsigned int uinteger; typedef char *address; typedef short int shortint; @@ -33,8 +53,8 @@ static inline _Complex float * _pCf(complex *z) {return (_Complex float*)z;} static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double*)z;} #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -236,7 +256,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/claqz1.c b/lapack-netlib/SRC/claqz1.c index d05923a46..7856e080f 100644 --- a/lapack-netlib/SRC/claqz1.c +++ b/lapack-netlib/SRC/claqz1.c @@ -19,7 +19,28 @@ #undef I #endif -typedef int integer; +#if defined(_WIN64) +typedef long long BLASLONG; +typedef unsigned long long BLASULONG; +#else +typedef long BLASLONG; +typedef unsigned long BLASULONG; +#endif + +#ifdef LAPACK_ILP64 +typedef BLASLONG blasint; +#if defined(_WIN64) +#define blasabs(x) llabs(x) +#else +#define blasabs(x) labs(x) +#endif +#else +typedef int blasint; +#define blasabs(x) abs(x) +#endif + +typedef blasint integer; + typedef unsigned int uinteger; typedef char *address; typedef short int shortint; @@ -33,8 +54,8 @@ static inline _Complex float * _pCf(complex *z) {return (_Complex float*)z;} static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double*)z;} #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -236,7 +257,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/claqz2.c b/lapack-netlib/SRC/claqz2.c index d05923a46..7856e080f 100644 --- a/lapack-netlib/SRC/claqz2.c +++ b/lapack-netlib/SRC/claqz2.c @@ -19,7 +19,28 @@ #undef I #endif -typedef int integer; +#if defined(_WIN64) +typedef long long BLASLONG; +typedef unsigned long long BLASULONG; +#else +typedef long BLASLONG; +typedef unsigned long BLASULONG; +#endif + +#ifdef LAPACK_ILP64 +typedef BLASLONG blasint; +#if defined(_WIN64) +#define blasabs(x) llabs(x) +#else +#define blasabs(x) labs(x) +#endif +#else +typedef int blasint; +#define blasabs(x) abs(x) +#endif + +typedef blasint integer; + typedef unsigned int uinteger; typedef char *address; typedef short int shortint; @@ -33,8 +54,8 @@ static inline _Complex float * _pCf(complex *z) {return (_Complex float*)z;} static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double*)z;} #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -236,7 +257,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/claqz3.c b/lapack-netlib/SRC/claqz3.c index d05923a46..7856e080f 100644 --- a/lapack-netlib/SRC/claqz3.c +++ b/lapack-netlib/SRC/claqz3.c @@ -19,7 +19,28 @@ #undef I #endif -typedef int integer; +#if defined(_WIN64) +typedef long long BLASLONG; +typedef unsigned long long BLASULONG; +#else +typedef long BLASLONG; +typedef unsigned long BLASULONG; +#endif + +#ifdef LAPACK_ILP64 +typedef BLASLONG blasint; +#if defined(_WIN64) +#define blasabs(x) llabs(x) +#else +#define blasabs(x) labs(x) +#endif +#else +typedef int blasint; +#define blasabs(x) abs(x) +#endif + +typedef blasint integer; + typedef unsigned int uinteger; typedef char *address; typedef short int shortint; @@ -33,8 +54,8 @@ static inline _Complex float * _pCf(complex *z) {return (_Complex float*)z;} static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double*)z;} #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -236,7 +257,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlaqz0.c b/lapack-netlib/SRC/dlaqz0.c index d05923a46..6d7e7d534 100644 --- a/lapack-netlib/SRC/dlaqz0.c +++ b/lapack-netlib/SRC/dlaqz0.c @@ -18,8 +18,28 @@ #ifdef I #undef I #endif +#if defined(_WIN64) +typedef long long BLASLONG; +typedef unsigned long long BLASULONG; +#else +typedef long BLASLONG; +typedef unsigned long BLASULONG; +#endif + +#ifdef LAPACK_ILP64 +typedef BLASLONG blasint; +#if defined(_WIN64) +#define blasabs(x) llabs(x) +#else +#define blasabs(x) labs(x) +#endif +#else +typedef int blasint; +#define blasabs(x) abs(x) +#endif + +typedef blasint integer; -typedef int integer; typedef unsigned int uinteger; typedef char *address; typedef short int shortint; @@ -33,8 +53,8 @@ static inline _Complex float * _pCf(complex *z) {return (_Complex float*)z;} static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double*)z;} #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -236,7 +256,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlaqz1.c b/lapack-netlib/SRC/dlaqz1.c index d05923a46..7856e080f 100644 --- a/lapack-netlib/SRC/dlaqz1.c +++ b/lapack-netlib/SRC/dlaqz1.c @@ -19,7 +19,28 @@ #undef I #endif -typedef int integer; +#if defined(_WIN64) +typedef long long BLASLONG; +typedef unsigned long long BLASULONG; +#else +typedef long BLASLONG; +typedef unsigned long BLASULONG; +#endif + +#ifdef LAPACK_ILP64 +typedef BLASLONG blasint; +#if defined(_WIN64) +#define blasabs(x) llabs(x) +#else +#define blasabs(x) labs(x) +#endif +#else +typedef int blasint; +#define blasabs(x) abs(x) +#endif + +typedef blasint integer; + typedef unsigned int uinteger; typedef char *address; typedef short int shortint; @@ -33,8 +54,8 @@ static inline _Complex float * _pCf(complex *z) {return (_Complex float*)z;} static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double*)z;} #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -236,7 +257,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlaqz2.c b/lapack-netlib/SRC/dlaqz2.c index d05923a46..7856e080f 100644 --- a/lapack-netlib/SRC/dlaqz2.c +++ b/lapack-netlib/SRC/dlaqz2.c @@ -19,7 +19,28 @@ #undef I #endif -typedef int integer; +#if defined(_WIN64) +typedef long long BLASLONG; +typedef unsigned long long BLASULONG; +#else +typedef long BLASLONG; +typedef unsigned long BLASULONG; +#endif + +#ifdef LAPACK_ILP64 +typedef BLASLONG blasint; +#if defined(_WIN64) +#define blasabs(x) llabs(x) +#else +#define blasabs(x) labs(x) +#endif +#else +typedef int blasint; +#define blasabs(x) abs(x) +#endif + +typedef blasint integer; + typedef unsigned int uinteger; typedef char *address; typedef short int shortint; @@ -33,8 +54,8 @@ static inline _Complex float * _pCf(complex *z) {return (_Complex float*)z;} static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double*)z;} #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -236,7 +257,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlaqz3.c b/lapack-netlib/SRC/dlaqz3.c index d05923a46..7856e080f 100644 --- a/lapack-netlib/SRC/dlaqz3.c +++ b/lapack-netlib/SRC/dlaqz3.c @@ -19,7 +19,28 @@ #undef I #endif -typedef int integer; +#if defined(_WIN64) +typedef long long BLASLONG; +typedef unsigned long long BLASULONG; +#else +typedef long BLASLONG; +typedef unsigned long BLASULONG; +#endif + +#ifdef LAPACK_ILP64 +typedef BLASLONG blasint; +#if defined(_WIN64) +#define blasabs(x) llabs(x) +#else +#define blasabs(x) labs(x) +#endif +#else +typedef int blasint; +#define blasabs(x) abs(x) +#endif + +typedef blasint integer; + typedef unsigned int uinteger; typedef char *address; typedef short int shortint; @@ -33,8 +54,8 @@ static inline _Complex float * _pCf(complex *z) {return (_Complex float*)z;} static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double*)z;} #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -236,7 +257,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlaqz4.c b/lapack-netlib/SRC/dlaqz4.c index d05923a46..7856e080f 100644 --- a/lapack-netlib/SRC/dlaqz4.c +++ b/lapack-netlib/SRC/dlaqz4.c @@ -19,7 +19,28 @@ #undef I #endif -typedef int integer; +#if defined(_WIN64) +typedef long long BLASLONG; +typedef unsigned long long BLASULONG; +#else +typedef long BLASLONG; +typedef unsigned long BLASULONG; +#endif + +#ifdef LAPACK_ILP64 +typedef BLASLONG blasint; +#if defined(_WIN64) +#define blasabs(x) llabs(x) +#else +#define blasabs(x) labs(x) +#endif +#else +typedef int blasint; +#define blasabs(x) abs(x) +#endif + +typedef blasint integer; + typedef unsigned int uinteger; typedef char *address; typedef short int shortint; @@ -33,8 +54,8 @@ static inline _Complex float * _pCf(complex *z) {return (_Complex float*)z;} static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double*)z;} #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -236,7 +257,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/la_constants.c b/lapack-netlib/SRC/la_constants.c index d05923a46..7856e080f 100644 --- a/lapack-netlib/SRC/la_constants.c +++ b/lapack-netlib/SRC/la_constants.c @@ -19,7 +19,28 @@ #undef I #endif -typedef int integer; +#if defined(_WIN64) +typedef long long BLASLONG; +typedef unsigned long long BLASULONG; +#else +typedef long BLASLONG; +typedef unsigned long BLASULONG; +#endif + +#ifdef LAPACK_ILP64 +typedef BLASLONG blasint; +#if defined(_WIN64) +#define blasabs(x) llabs(x) +#else +#define blasabs(x) labs(x) +#endif +#else +typedef int blasint; +#define blasabs(x) abs(x) +#endif + +typedef blasint integer; + typedef unsigned int uinteger; typedef char *address; typedef short int shortint; @@ -33,8 +54,8 @@ static inline _Complex float * _pCf(complex *z) {return (_Complex float*)z;} static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double*)z;} #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -236,7 +257,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/la_xisnan.c b/lapack-netlib/SRC/la_xisnan.c index d05923a46..7856e080f 100644 --- a/lapack-netlib/SRC/la_xisnan.c +++ b/lapack-netlib/SRC/la_xisnan.c @@ -19,7 +19,28 @@ #undef I #endif -typedef int integer; +#if defined(_WIN64) +typedef long long BLASLONG; +typedef unsigned long long BLASULONG; +#else +typedef long BLASLONG; +typedef unsigned long BLASULONG; +#endif + +#ifdef LAPACK_ILP64 +typedef BLASLONG blasint; +#if defined(_WIN64) +#define blasabs(x) llabs(x) +#else +#define blasabs(x) labs(x) +#endif +#else +typedef int blasint; +#define blasabs(x) abs(x) +#endif + +typedef blasint integer; + typedef unsigned int uinteger; typedef char *address; typedef short int shortint; @@ -33,8 +54,8 @@ static inline _Complex float * _pCf(complex *z) {return (_Complex float*)z;} static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double*)z;} #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -236,7 +257,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sgbbrd.c b/lapack-netlib/SRC/sgbbrd.c index ffa248478..306eebee7 100644 --- a/lapack-netlib/SRC/sgbbrd.c +++ b/lapack-netlib/SRC/sgbbrd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -235,19 +235,11 @@ typedef struct Namelist Namelist; #define i_len(s, n) (n) #define i_nint(x) ((integer)u_nint(*(x))) #define i_sign(a,b) ((integer)u_sign((integer)*(a),(integer)*(b))) -#define pow_dd(ap, bp) ( pow(*(ap), *(bp))) -#define pow_si(B,E) spow_ui(*(B),*(E)) -#define pow_ri(B,E) spow_ui(*(B),*(E)) -#define pow_di(B,E) dpow_ui(*(B),*(E)) -#define pow_zi(p, a, b) {pCd(p) = zpow_ui(Cd(a), *(b));} -#define pow_ci(p, a, b) {pCf(p) = cpow_ui(Cf(a), *(b));} -#define pow_zz(R,A,B) {pCd(R) = cpow(Cd(A),*(B));} #define s_cat(lpp, rpp, rnp, np, llp) { ftnlen i, nc, ll; char *f__rp, *lp; ll = (llp); lp = (lpp); for(i=0; i < (int)*(np); ++i) { nc = ll; if((rnp)[i] < nc) nc = (rnp)[i]; ll -= nc; f__rp = (rpp)[i]; while(--nc >= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; #define z_abs(z) (cabs(Cd(z))) #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} @@ -258,250 +250,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; //#define mymaxloc_(w,s,e,n) {if (sizeof(*(w)) == sizeof(double)) dmaxloc_((w),*(s),*(e),n); else dmaxloc_((w),*(s),*(e),n);} #define mymaxloc(w,s,e,n) {dmaxloc_(w,*(s),*(e),n)} -/* procedure parameter types for -A and -C++ */ - -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef logical (*L_fp)(...); -#else -typedef logical (*L_fp)(); -#endif - -static float spow_ui(float x, integer n) { - float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static double dpow_ui(double x, integer n) { - double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#ifdef _MSC_VER -static _Fcomplex cpow_ui(complex x, integer n) { - complex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; - for(u = n; ; ) { - if(u & 01) pow.r *= x.r, pow.i *= x.i; - if(u >>= 1) x.r *= x.r, x.i *= x.i; - else break; - } - } - _Fcomplex p={pow.r, pow.i}; - return p; -} -#else -static _Complex float cpow_ui(_Complex float x, integer n) { - _Complex float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -#ifdef _MSC_VER -static _Dcomplex zpow_ui(_Dcomplex x, integer n) { - _Dcomplex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; - for(u = n; ; ) { - if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; - if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; - else break; - } - } - _Dcomplex p = {pow._Val[0], pow._Val[1]}; - return p; -} -#else -static _Complex double zpow_ui(_Complex double x, integer n) { - _Complex double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -static integer pow_ii(integer x, integer n) { - integer pow; unsigned long int u; - if (n <= 0) { - if (n == 0 || x == 1) pow = 1; - else if (x != -1) pow = x == 0 ? 1/x : 0; - else n = -n; - } - if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { - u = n; - for(pow = 1; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static integer dmaxloc_(double *w, integer s, integer e, integer *n) -{ - double m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static integer smaxloc_(float *w, integer s, integer e, integer *n) -{ - float m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { - integer n = *n_, incx = *incx_, incy = *incy_, i; -#ifdef _MSC_VER - _Fcomplex zdotc = {0.0, 0.0}; - if (incx == 1 && incy == 1) { - for (i=0;i= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; #define z_abs(z) (cabs(Cd(z))) #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} @@ -258,250 +250,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; //#define mymaxloc_(w,s,e,n) {if (sizeof(*(w)) == sizeof(double)) dmaxloc_((w),*(s),*(e),n); else dmaxloc_((w),*(s),*(e),n);} #define mymaxloc(w,s,e,n) {dmaxloc_(w,*(s),*(e),n)} -/* procedure parameter types for -A and -C++ */ - -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef logical (*L_fp)(...); -#else -typedef logical (*L_fp)(); -#endif - -static float spow_ui(float x, integer n) { - float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static double dpow_ui(double x, integer n) { - double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#ifdef _MSC_VER -static _Fcomplex cpow_ui(complex x, integer n) { - complex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; - for(u = n; ; ) { - if(u & 01) pow.r *= x.r, pow.i *= x.i; - if(u >>= 1) x.r *= x.r, x.i *= x.i; - else break; - } - } - _Fcomplex p={pow.r, pow.i}; - return p; -} -#else -static _Complex float cpow_ui(_Complex float x, integer n) { - _Complex float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -#ifdef _MSC_VER -static _Dcomplex zpow_ui(_Dcomplex x, integer n) { - _Dcomplex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; - for(u = n; ; ) { - if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; - if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; - else break; - } - } - _Dcomplex p = {pow._Val[0], pow._Val[1]}; - return p; -} -#else -static _Complex double zpow_ui(_Complex double x, integer n) { - _Complex double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -static integer pow_ii(integer x, integer n) { - integer pow; unsigned long int u; - if (n <= 0) { - if (n == 0 || x == 1) pow = 1; - else if (x != -1) pow = x == 0 ? 1/x : 0; - else n = -n; - } - if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { - u = n; - for(pow = 1; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static integer dmaxloc_(double *w, integer s, integer e, integer *n) -{ - double m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static integer smaxloc_(float *w, integer s, integer e, integer *n) -{ - float m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { - integer n = *n_, incx = *incx_, incy = *incy_, i; -#ifdef _MSC_VER - _Fcomplex zdotc = {0.0, 0.0}; - if (incx == 1 && incy == 1) { - for (i=0;i= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; #define z_abs(z) (cabs(Cd(z))) #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} @@ -258,250 +250,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; //#define mymaxloc_(w,s,e,n) {if (sizeof(*(w)) == sizeof(double)) dmaxloc_((w),*(s),*(e),n); else dmaxloc_((w),*(s),*(e),n);} #define mymaxloc(w,s,e,n) {dmaxloc_(w,*(s),*(e),n)} -/* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef logical (*L_fp)(...); -#else -typedef logical (*L_fp)(); -#endif - -static float spow_ui(float x, integer n) { - float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static double dpow_ui(double x, integer n) { - double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#ifdef _MSC_VER -static _Fcomplex cpow_ui(complex x, integer n) { - complex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; - for(u = n; ; ) { - if(u & 01) pow.r *= x.r, pow.i *= x.i; - if(u >>= 1) x.r *= x.r, x.i *= x.i; - else break; - } - } - _Fcomplex p={pow.r, pow.i}; - return p; -} -#else -static _Complex float cpow_ui(_Complex float x, integer n) { - _Complex float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -#ifdef _MSC_VER -static _Dcomplex zpow_ui(_Dcomplex x, integer n) { - _Dcomplex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; - for(u = n; ; ) { - if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; - if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; - else break; - } - } - _Dcomplex p = {pow._Val[0], pow._Val[1]}; - return p; -} -#else -static _Complex double zpow_ui(_Complex double x, integer n) { - _Complex double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -static integer pow_ii(integer x, integer n) { - integer pow; unsigned long int u; - if (n <= 0) { - if (n == 0 || x == 1) pow = 1; - else if (x != -1) pow = x == 0 ? 1/x : 0; - else n = -n; - } - if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { - u = n; - for(pow = 1; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static integer dmaxloc_(double *w, integer s, integer e, integer *n) -{ - double m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static integer smaxloc_(float *w, integer s, integer e, integer *n) -{ - float m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { - integer n = *n_, incx = *incx_, incy = *incy_, i; -#ifdef _MSC_VER - _Fcomplex zdotc = {0.0, 0.0}; - if (incx == 1 && incy == 1) { - for (i=0;i= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; #define z_abs(z) (cabs(Cd(z))) #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} @@ -258,250 +250,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; //#define mymaxloc_(w,s,e,n) {if (sizeof(*(w)) == sizeof(double)) dmaxloc_((w),*(s),*(e),n); else dmaxloc_((w),*(s),*(e),n);} #define mymaxloc(w,s,e,n) {dmaxloc_(w,*(s),*(e),n)} -/* procedure parameter types for -A and -C++ */ - -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef logical (*L_fp)(...); -#else -typedef logical (*L_fp)(); -#endif - -static float spow_ui(float x, integer n) { - float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static double dpow_ui(double x, integer n) { - double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#ifdef _MSC_VER -static _Fcomplex cpow_ui(complex x, integer n) { - complex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; - for(u = n; ; ) { - if(u & 01) pow.r *= x.r, pow.i *= x.i; - if(u >>= 1) x.r *= x.r, x.i *= x.i; - else break; - } - } - _Fcomplex p={pow.r, pow.i}; - return p; -} -#else -static _Complex float cpow_ui(_Complex float x, integer n) { - _Complex float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -#ifdef _MSC_VER -static _Dcomplex zpow_ui(_Dcomplex x, integer n) { - _Dcomplex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; - for(u = n; ; ) { - if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; - if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; - else break; - } - } - _Dcomplex p = {pow._Val[0], pow._Val[1]}; - return p; -} -#else -static _Complex double zpow_ui(_Complex double x, integer n) { - _Complex double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -static integer pow_ii(integer x, integer n) { - integer pow; unsigned long int u; - if (n <= 0) { - if (n == 0 || x == 1) pow = 1; - else if (x != -1) pow = x == 0 ? 1/x : 0; - else n = -n; - } - if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { - u = n; - for(pow = 1; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static integer dmaxloc_(double *w, integer s, integer e, integer *n) -{ - double m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static integer smaxloc_(float *w, integer s, integer e, integer *n) -{ - float m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { - integer n = *n_, incx = *incx_, incy = *incy_, i; -#ifdef _MSC_VER - _Fcomplex zdotc = {0.0, 0.0}; - if (incx == 1 && incy == 1) { - for (i=0;i= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; #define z_abs(z) (cabs(Cd(z))) #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} @@ -260,248 +249,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef logical (*L_fp)(...); -#else -typedef logical (*L_fp)(); -#endif -static float spow_ui(float x, integer n) { - float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static double dpow_ui(double x, integer n) { - double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#ifdef _MSC_VER -static _Fcomplex cpow_ui(complex x, integer n) { - complex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; - for(u = n; ; ) { - if(u & 01) pow.r *= x.r, pow.i *= x.i; - if(u >>= 1) x.r *= x.r, x.i *= x.i; - else break; - } - } - _Fcomplex p={pow.r, pow.i}; - return p; -} -#else -static _Complex float cpow_ui(_Complex float x, integer n) { - _Complex float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -#ifdef _MSC_VER -static _Dcomplex zpow_ui(_Dcomplex x, integer n) { - _Dcomplex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; - for(u = n; ; ) { - if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; - if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; - else break; - } - } - _Dcomplex p = {pow._Val[0], pow._Val[1]}; - return p; -} -#else -static _Complex double zpow_ui(_Complex double x, integer n) { - _Complex double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -static integer pow_ii(integer x, integer n) { - integer pow; unsigned long int u; - if (n <= 0) { - if (n == 0 || x == 1) pow = 1; - else if (x != -1) pow = x == 0 ? 1/x : 0; - else n = -n; - } - if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { - u = n; - for(pow = 1; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static integer dmaxloc_(double *w, integer s, integer e, integer *n) -{ - double m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static integer smaxloc_(float *w, integer s, integer e, integer *n) -{ - float m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { - integer n = *n_, incx = *incx_, incy = *incy_, i; -#ifdef _MSC_VER - _Fcomplex zdotc = {0.0, 0.0}; - if (incx == 1 && incy == 1) { - for (i=0;i= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; #define z_abs(z) (cabs(Cd(z))) #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} @@ -258,250 +250,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; //#define mymaxloc_(w,s,e,n) {if (sizeof(*(w)) == sizeof(double)) dmaxloc_((w),*(s),*(e),n); else dmaxloc_((w),*(s),*(e),n);} #define mymaxloc(w,s,e,n) {dmaxloc_(w,*(s),*(e),n)} -/* procedure parameter types for -A and -C++ */ - -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef logical (*L_fp)(...); -#else -typedef logical (*L_fp)(); -#endif - -static float spow_ui(float x, integer n) { - float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static double dpow_ui(double x, integer n) { - double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#ifdef _MSC_VER -static _Fcomplex cpow_ui(complex x, integer n) { - complex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; - for(u = n; ; ) { - if(u & 01) pow.r *= x.r, pow.i *= x.i; - if(u >>= 1) x.r *= x.r, x.i *= x.i; - else break; - } - } - _Fcomplex p={pow.r, pow.i}; - return p; -} -#else -static _Complex float cpow_ui(_Complex float x, integer n) { - _Complex float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -#ifdef _MSC_VER -static _Dcomplex zpow_ui(_Dcomplex x, integer n) { - _Dcomplex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; - for(u = n; ; ) { - if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; - if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; - else break; - } - } - _Dcomplex p = {pow._Val[0], pow._Val[1]}; - return p; -} -#else -static _Complex double zpow_ui(_Complex double x, integer n) { - _Complex double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -static integer pow_ii(integer x, integer n) { - integer pow; unsigned long int u; - if (n <= 0) { - if (n == 0 || x == 1) pow = 1; - else if (x != -1) pow = x == 0 ? 1/x : 0; - else n = -n; - } - if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { - u = n; - for(pow = 1; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static integer dmaxloc_(double *w, integer s, integer e, integer *n) -{ - double m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static integer smaxloc_(float *w, integer s, integer e, integer *n) -{ - float m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { - integer n = *n_, incx = *incx_, incy = *incy_, i; -#ifdef _MSC_VER - _Fcomplex zdotc = {0.0, 0.0}; - if (incx == 1 && incy == 1) { - for (i=0;i= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; #define z_abs(z) (cabs(Cd(z))) #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} @@ -258,250 +247,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; //#define mymaxloc_(w,s,e,n) {if (sizeof(*(w)) == sizeof(double)) dmaxloc_((w),*(s),*(e),n); else dmaxloc_((w),*(s),*(e),n);} #define mymaxloc(w,s,e,n) {dmaxloc_(w,*(s),*(e),n)} -/* procedure parameter types for -A and -C++ */ - -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef logical (*L_fp)(...); -#else -typedef logical (*L_fp)(); -#endif - -static float spow_ui(float x, integer n) { - float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static double dpow_ui(double x, integer n) { - double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#ifdef _MSC_VER -static _Fcomplex cpow_ui(complex x, integer n) { - complex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; - for(u = n; ; ) { - if(u & 01) pow.r *= x.r, pow.i *= x.i; - if(u >>= 1) x.r *= x.r, x.i *= x.i; - else break; - } - } - _Fcomplex p={pow.r, pow.i}; - return p; -} -#else -static _Complex float cpow_ui(_Complex float x, integer n) { - _Complex float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -#ifdef _MSC_VER -static _Dcomplex zpow_ui(_Dcomplex x, integer n) { - _Dcomplex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; - for(u = n; ; ) { - if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; - if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; - else break; - } - } - _Dcomplex p = {pow._Val[0], pow._Val[1]}; - return p; -} -#else -static _Complex double zpow_ui(_Complex double x, integer n) { - _Complex double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -static integer pow_ii(integer x, integer n) { - integer pow; unsigned long int u; - if (n <= 0) { - if (n == 0 || x == 1) pow = 1; - else if (x != -1) pow = x == 0 ? 1/x : 0; - else n = -n; - } - if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { - u = n; - for(pow = 1; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static integer dmaxloc_(double *w, integer s, integer e, integer *n) -{ - double m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static integer smaxloc_(float *w, integer s, integer e, integer *n) -{ - float m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { - integer n = *n_, incx = *incx_, incy = *incy_, i; -#ifdef _MSC_VER - _Fcomplex zdotc = {0.0, 0.0}; - if (incx == 1 && incy == 1) { - for (i=0;i= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; #define z_abs(z) (cabs(Cd(z))) #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} @@ -258,250 +250,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; //#define mymaxloc_(w,s,e,n) {if (sizeof(*(w)) == sizeof(double)) dmaxloc_((w),*(s),*(e),n); else dmaxloc_((w),*(s),*(e),n);} #define mymaxloc(w,s,e,n) {dmaxloc_(w,*(s),*(e),n)} -/* procedure parameter types for -A and -C++ */ - -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef logical (*L_fp)(...); -#else -typedef logical (*L_fp)(); -#endif - -static float spow_ui(float x, integer n) { - float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static double dpow_ui(double x, integer n) { - double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#ifdef _MSC_VER -static _Fcomplex cpow_ui(complex x, integer n) { - complex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; - for(u = n; ; ) { - if(u & 01) pow.r *= x.r, pow.i *= x.i; - if(u >>= 1) x.r *= x.r, x.i *= x.i; - else break; - } - } - _Fcomplex p={pow.r, pow.i}; - return p; -} -#else -static _Complex float cpow_ui(_Complex float x, integer n) { - _Complex float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -#ifdef _MSC_VER -static _Dcomplex zpow_ui(_Dcomplex x, integer n) { - _Dcomplex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; - for(u = n; ; ) { - if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; - if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; - else break; - } - } - _Dcomplex p = {pow._Val[0], pow._Val[1]}; - return p; -} -#else -static _Complex double zpow_ui(_Complex double x, integer n) { - _Complex double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -static integer pow_ii(integer x, integer n) { - integer pow; unsigned long int u; - if (n <= 0) { - if (n == 0 || x == 1) pow = 1; - else if (x != -1) pow = x == 0 ? 1/x : 0; - else n = -n; - } - if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { - u = n; - for(pow = 1; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static integer dmaxloc_(double *w, integer s, integer e, integer *n) -{ - double m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static integer smaxloc_(float *w, integer s, integer e, integer *n) -{ - float m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { - integer n = *n_, incx = *incx_, incy = *incy_, i; -#ifdef _MSC_VER - _Fcomplex zdotc = {0.0, 0.0}; - if (incx == 1 && incy == 1) { - for (i=0;i= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; #define z_abs(z) (cabs(Cd(z))) #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} @@ -258,250 +250,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; //#define mymaxloc_(w,s,e,n) {if (sizeof(*(w)) == sizeof(double)) dmaxloc_((w),*(s),*(e),n); else dmaxloc_((w),*(s),*(e),n);} #define mymaxloc(w,s,e,n) {dmaxloc_(w,*(s),*(e),n)} -/* procedure parameter types for -A and -C++ */ - -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef logical (*L_fp)(...); -#else -typedef logical (*L_fp)(); -#endif - -static float spow_ui(float x, integer n) { - float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static double dpow_ui(double x, integer n) { - double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#ifdef _MSC_VER -static _Fcomplex cpow_ui(complex x, integer n) { - complex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; - for(u = n; ; ) { - if(u & 01) pow.r *= x.r, pow.i *= x.i; - if(u >>= 1) x.r *= x.r, x.i *= x.i; - else break; - } - } - _Fcomplex p={pow.r, pow.i}; - return p; -} -#else -static _Complex float cpow_ui(_Complex float x, integer n) { - _Complex float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -#ifdef _MSC_VER -static _Dcomplex zpow_ui(_Dcomplex x, integer n) { - _Dcomplex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; - for(u = n; ; ) { - if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; - if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; - else break; - } - } - _Dcomplex p = {pow._Val[0], pow._Val[1]}; - return p; -} -#else -static _Complex double zpow_ui(_Complex double x, integer n) { - _Complex double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -static integer pow_ii(integer x, integer n) { - integer pow; unsigned long int u; - if (n <= 0) { - if (n == 0 || x == 1) pow = 1; - else if (x != -1) pow = x == 0 ? 1/x : 0; - else n = -n; - } - if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { - u = n; - for(pow = 1; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static integer dmaxloc_(double *w, integer s, integer e, integer *n) -{ - double m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static integer smaxloc_(float *w, integer s, integer e, integer *n) -{ - float m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { - integer n = *n_, incx = *incx_, incy = *incy_, i; -#ifdef _MSC_VER - _Fcomplex zdotc = {0.0, 0.0}; - if (incx == 1 && incy == 1) { - for (i=0;i= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; #define z_abs(z) (cabs(Cd(z))) #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} @@ -258,250 +250,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; //#define mymaxloc_(w,s,e,n) {if (sizeof(*(w)) == sizeof(double)) dmaxloc_((w),*(s),*(e),n); else dmaxloc_((w),*(s),*(e),n);} #define mymaxloc(w,s,e,n) {dmaxloc_(w,*(s),*(e),n)} -/* procedure parameter types for -A and -C++ */ - -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef logical (*L_fp)(...); -#else -typedef logical (*L_fp)(); -#endif - -static float spow_ui(float x, integer n) { - float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static double dpow_ui(double x, integer n) { - double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#ifdef _MSC_VER -static _Fcomplex cpow_ui(complex x, integer n) { - complex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; - for(u = n; ; ) { - if(u & 01) pow.r *= x.r, pow.i *= x.i; - if(u >>= 1) x.r *= x.r, x.i *= x.i; - else break; - } - } - _Fcomplex p={pow.r, pow.i}; - return p; -} -#else -static _Complex float cpow_ui(_Complex float x, integer n) { - _Complex float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -#ifdef _MSC_VER -static _Dcomplex zpow_ui(_Dcomplex x, integer n) { - _Dcomplex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; - for(u = n; ; ) { - if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; - if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; - else break; - } - } - _Dcomplex p = {pow._Val[0], pow._Val[1]}; - return p; -} -#else -static _Complex double zpow_ui(_Complex double x, integer n) { - _Complex double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -static integer pow_ii(integer x, integer n) { - integer pow; unsigned long int u; - if (n <= 0) { - if (n == 0 || x == 1) pow = 1; - else if (x != -1) pow = x == 0 ? 1/x : 0; - else n = -n; - } - if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { - u = n; - for(pow = 1; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static integer dmaxloc_(double *w, integer s, integer e, integer *n) -{ - double m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static integer smaxloc_(float *w, integer s, integer e, integer *n) -{ - float m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { - integer n = *n_, incx = *incx_, incy = *incy_, i; -#ifdef _MSC_VER - _Fcomplex zdotc = {0.0, 0.0}; - if (incx == 1 && incy == 1) { - for (i=0;i= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; #define z_abs(z) (cabs(Cd(z))) #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} @@ -258,250 +250,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; //#define mymaxloc_(w,s,e,n) {if (sizeof(*(w)) == sizeof(double)) dmaxloc_((w),*(s),*(e),n); else dmaxloc_((w),*(s),*(e),n);} #define mymaxloc(w,s,e,n) {dmaxloc_(w,*(s),*(e),n)} -/* procedure parameter types for -A and -C++ */ - -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef logical (*L_fp)(...); -#else -typedef logical (*L_fp)(); -#endif - -static float spow_ui(float x, integer n) { - float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static double dpow_ui(double x, integer n) { - double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#ifdef _MSC_VER -static _Fcomplex cpow_ui(complex x, integer n) { - complex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; - for(u = n; ; ) { - if(u & 01) pow.r *= x.r, pow.i *= x.i; - if(u >>= 1) x.r *= x.r, x.i *= x.i; - else break; - } - } - _Fcomplex p={pow.r, pow.i}; - return p; -} -#else -static _Complex float cpow_ui(_Complex float x, integer n) { - _Complex float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -#ifdef _MSC_VER -static _Dcomplex zpow_ui(_Dcomplex x, integer n) { - _Dcomplex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; - for(u = n; ; ) { - if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; - if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; - else break; - } - } - _Dcomplex p = {pow._Val[0], pow._Val[1]}; - return p; -} -#else -static _Complex double zpow_ui(_Complex double x, integer n) { - _Complex double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -static integer pow_ii(integer x, integer n) { - integer pow; unsigned long int u; - if (n <= 0) { - if (n == 0 || x == 1) pow = 1; - else if (x != -1) pow = x == 0 ? 1/x : 0; - else n = -n; - } - if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { - u = n; - for(pow = 1; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static integer dmaxloc_(double *w, integer s, integer e, integer *n) -{ - double m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static integer smaxloc_(float *w, integer s, integer e, integer *n) -{ - float m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { - integer n = *n_, incx = *incx_, incy = *incy_, i; -#ifdef _MSC_VER - _Fcomplex zdotc = {0.0, 0.0}; - if (incx == 1 && incy == 1) { - for (i=0;i= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; #define z_abs(z) (cabs(Cd(z))) #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} @@ -258,250 +250,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; //#define mymaxloc_(w,s,e,n) {if (sizeof(*(w)) == sizeof(double)) dmaxloc_((w),*(s),*(e),n); else dmaxloc_((w),*(s),*(e),n);} #define mymaxloc(w,s,e,n) {dmaxloc_(w,*(s),*(e),n)} -/* procedure parameter types for -A and -C++ */ - -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef logical (*L_fp)(...); -#else -typedef logical (*L_fp)(); -#endif - -static float spow_ui(float x, integer n) { - float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static double dpow_ui(double x, integer n) { - double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#ifdef _MSC_VER -static _Fcomplex cpow_ui(complex x, integer n) { - complex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; - for(u = n; ; ) { - if(u & 01) pow.r *= x.r, pow.i *= x.i; - if(u >>= 1) x.r *= x.r, x.i *= x.i; - else break; - } - } - _Fcomplex p={pow.r, pow.i}; - return p; -} -#else -static _Complex float cpow_ui(_Complex float x, integer n) { - _Complex float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -#ifdef _MSC_VER -static _Dcomplex zpow_ui(_Dcomplex x, integer n) { - _Dcomplex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; - for(u = n; ; ) { - if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; - if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; - else break; - } - } - _Dcomplex p = {pow._Val[0], pow._Val[1]}; - return p; -} -#else -static _Complex double zpow_ui(_Complex double x, integer n) { - _Complex double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -static integer pow_ii(integer x, integer n) { - integer pow; unsigned long int u; - if (n <= 0) { - if (n == 0 || x == 1) pow = 1; - else if (x != -1) pow = x == 0 ? 1/x : 0; - else n = -n; - } - if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { - u = n; - for(pow = 1; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static integer dmaxloc_(double *w, integer s, integer e, integer *n) -{ - double m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static integer smaxloc_(float *w, integer s, integer e, integer *n) -{ - float m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { - integer n = *n_, incx = *incx_, incy = *incy_, i; -#ifdef _MSC_VER - _Fcomplex zdotc = {0.0, 0.0}; - if (incx == 1 && incy == 1) { - for (i=0;i= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; #define z_abs(z) (cabs(Cd(z))) #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} @@ -258,250 +250,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; //#define mymaxloc_(w,s,e,n) {if (sizeof(*(w)) == sizeof(double)) dmaxloc_((w),*(s),*(e),n); else dmaxloc_((w),*(s),*(e),n);} #define mymaxloc(w,s,e,n) {dmaxloc_(w,*(s),*(e),n)} -/* procedure parameter types for -A and -C++ */ - -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef logical (*L_fp)(...); -#else -typedef logical (*L_fp)(); -#endif - -static float spow_ui(float x, integer n) { - float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static double dpow_ui(double x, integer n) { - double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#ifdef _MSC_VER -static _Fcomplex cpow_ui(complex x, integer n) { - complex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; - for(u = n; ; ) { - if(u & 01) pow.r *= x.r, pow.i *= x.i; - if(u >>= 1) x.r *= x.r, x.i *= x.i; - else break; - } - } - _Fcomplex p={pow.r, pow.i}; - return p; -} -#else -static _Complex float cpow_ui(_Complex float x, integer n) { - _Complex float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -#ifdef _MSC_VER -static _Dcomplex zpow_ui(_Dcomplex x, integer n) { - _Dcomplex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; - for(u = n; ; ) { - if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; - if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; - else break; - } - } - _Dcomplex p = {pow._Val[0], pow._Val[1]}; - return p; -} -#else -static _Complex double zpow_ui(_Complex double x, integer n) { - _Complex double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -static integer pow_ii(integer x, integer n) { - integer pow; unsigned long int u; - if (n <= 0) { - if (n == 0 || x == 1) pow = 1; - else if (x != -1) pow = x == 0 ? 1/x : 0; - else n = -n; - } - if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { - u = n; - for(pow = 1; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static integer dmaxloc_(double *w, integer s, integer e, integer *n) -{ - double m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static integer smaxloc_(float *w, integer s, integer e, integer *n) -{ - float m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { - integer n = *n_, incx = *incx_, incy = *incy_, i; -#ifdef _MSC_VER - _Fcomplex zdotc = {0.0, 0.0}; - if (incx == 1 && incy == 1) { - for (i=0;i= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; #define z_abs(z) (cabs(Cd(z))) #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} @@ -258,250 +250,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; //#define mymaxloc_(w,s,e,n) {if (sizeof(*(w)) == sizeof(double)) dmaxloc_((w),*(s),*(e),n); else dmaxloc_((w),*(s),*(e),n);} #define mymaxloc(w,s,e,n) {dmaxloc_(w,*(s),*(e),n)} -/* procedure parameter types for -A and -C++ */ - -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef logical (*L_fp)(...); -#else -typedef logical (*L_fp)(); -#endif - -static float spow_ui(float x, integer n) { - float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static double dpow_ui(double x, integer n) { - double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#ifdef _MSC_VER -static _Fcomplex cpow_ui(complex x, integer n) { - complex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; - for(u = n; ; ) { - if(u & 01) pow.r *= x.r, pow.i *= x.i; - if(u >>= 1) x.r *= x.r, x.i *= x.i; - else break; - } - } - _Fcomplex p={pow.r, pow.i}; - return p; -} -#else -static _Complex float cpow_ui(_Complex float x, integer n) { - _Complex float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -#ifdef _MSC_VER -static _Dcomplex zpow_ui(_Dcomplex x, integer n) { - _Dcomplex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; - for(u = n; ; ) { - if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; - if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; - else break; - } - } - _Dcomplex p = {pow._Val[0], pow._Val[1]}; - return p; -} -#else -static _Complex double zpow_ui(_Complex double x, integer n) { - _Complex double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -static integer pow_ii(integer x, integer n) { - integer pow; unsigned long int u; - if (n <= 0) { - if (n == 0 || x == 1) pow = 1; - else if (x != -1) pow = x == 0 ? 1/x : 0; - else n = -n; - } - if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { - u = n; - for(pow = 1; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static integer dmaxloc_(double *w, integer s, integer e, integer *n) -{ - double m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static integer smaxloc_(float *w, integer s, integer e, integer *n) -{ - float m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { - integer n = *n_, incx = *incx_, incy = *incy_, i; -#ifdef _MSC_VER - _Fcomplex zdotc = {0.0, 0.0}; - if (incx == 1 && incy == 1) { - for (i=0;i= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; #define z_abs(z) (cabs(Cd(z))) #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} @@ -258,250 +250,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; //#define mymaxloc_(w,s,e,n) {if (sizeof(*(w)) == sizeof(double)) dmaxloc_((w),*(s),*(e),n); else dmaxloc_((w),*(s),*(e),n);} #define mymaxloc(w,s,e,n) {dmaxloc_(w,*(s),*(e),n)} -/* procedure parameter types for -A and -C++ */ - -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef logical (*L_fp)(...); -#else -typedef logical (*L_fp)(); -#endif - -static float spow_ui(float x, integer n) { - float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static double dpow_ui(double x, integer n) { - double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#ifdef _MSC_VER -static _Fcomplex cpow_ui(complex x, integer n) { - complex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; - for(u = n; ; ) { - if(u & 01) pow.r *= x.r, pow.i *= x.i; - if(u >>= 1) x.r *= x.r, x.i *= x.i; - else break; - } - } - _Fcomplex p={pow.r, pow.i}; - return p; -} -#else -static _Complex float cpow_ui(_Complex float x, integer n) { - _Complex float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -#ifdef _MSC_VER -static _Dcomplex zpow_ui(_Dcomplex x, integer n) { - _Dcomplex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; - for(u = n; ; ) { - if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; - if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; - else break; - } - } - _Dcomplex p = {pow._Val[0], pow._Val[1]}; - return p; -} -#else -static _Complex double zpow_ui(_Complex double x, integer n) { - _Complex double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -static integer pow_ii(integer x, integer n) { - integer pow; unsigned long int u; - if (n <= 0) { - if (n == 0 || x == 1) pow = 1; - else if (x != -1) pow = x == 0 ? 1/x : 0; - else n = -n; - } - if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { - u = n; - for(pow = 1; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static integer dmaxloc_(double *w, integer s, integer e, integer *n) -{ - double m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static integer smaxloc_(float *w, integer s, integer e, integer *n) -{ - float m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { - integer n = *n_, incx = *incx_, incy = *incy_, i; -#ifdef _MSC_VER - _Fcomplex zdotc = {0.0, 0.0}; - if (incx == 1 && incy == 1) { - for (i=0;i= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; #define z_abs(z) (cabs(Cd(z))) #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} @@ -257,251 +249,12 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; #define myhuge(w) {HUGE_VAL} //#define mymaxloc_(w,s,e,n) {if (sizeof(*(w)) == sizeof(double)) dmaxloc_((w),*(s),*(e),n); else dmaxloc_((w),*(s),*(e),n);} #define mymaxloc(w,s,e,n) {dmaxloc_(w,*(s),*(e),n)} - -/* procedure parameter types for -A and -C++ */ - -#define F2C_proc_par_types 1 #ifdef __cplusplus typedef logical (*L_fp)(...); #else typedef logical (*L_fp)(); #endif -static float spow_ui(float x, integer n) { - float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static double dpow_ui(double x, integer n) { - double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#ifdef _MSC_VER -static _Fcomplex cpow_ui(complex x, integer n) { - complex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; - for(u = n; ; ) { - if(u & 01) pow.r *= x.r, pow.i *= x.i; - if(u >>= 1) x.r *= x.r, x.i *= x.i; - else break; - } - } - _Fcomplex p={pow.r, pow.i}; - return p; -} -#else -static _Complex float cpow_ui(_Complex float x, integer n) { - _Complex float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -#ifdef _MSC_VER -static _Dcomplex zpow_ui(_Dcomplex x, integer n) { - _Dcomplex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; - for(u = n; ; ) { - if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; - if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; - else break; - } - } - _Dcomplex p = {pow._Val[0], pow._Val[1]}; - return p; -} -#else -static _Complex double zpow_ui(_Complex double x, integer n) { - _Complex double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -static integer pow_ii(integer x, integer n) { - integer pow; unsigned long int u; - if (n <= 0) { - if (n == 0 || x == 1) pow = 1; - else if (x != -1) pow = x == 0 ? 1/x : 0; - else n = -n; - } - if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { - u = n; - for(pow = 1; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static integer dmaxloc_(double *w, integer s, integer e, integer *n) -{ - double m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static integer smaxloc_(float *w, integer s, integer e, integer *n) -{ - float m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { - integer n = *n_, incx = *incx_, incy = *incy_, i; -#ifdef _MSC_VER - _Fcomplex zdotc = {0.0, 0.0}; - if (incx == 1 && incy == 1) { - for (i=0;i= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; #define z_abs(z) (cabs(Cd(z))) #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} @@ -260,248 +252,13 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else typedef logical (*L_fp)(); #endif -static float spow_ui(float x, integer n) { - float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static double dpow_ui(double x, integer n) { - double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#ifdef _MSC_VER -static _Fcomplex cpow_ui(complex x, integer n) { - complex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; - for(u = n; ; ) { - if(u & 01) pow.r *= x.r, pow.i *= x.i; - if(u >>= 1) x.r *= x.r, x.i *= x.i; - else break; - } - } - _Fcomplex p={pow.r, pow.i}; - return p; -} -#else -static _Complex float cpow_ui(_Complex float x, integer n) { - _Complex float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -#ifdef _MSC_VER -static _Dcomplex zpow_ui(_Dcomplex x, integer n) { - _Dcomplex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; - for(u = n; ; ) { - if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; - if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; - else break; - } - } - _Dcomplex p = {pow._Val[0], pow._Val[1]}; - return p; -} -#else -static _Complex double zpow_ui(_Complex double x, integer n) { - _Complex double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -static integer pow_ii(integer x, integer n) { - integer pow; unsigned long int u; - if (n <= 0) { - if (n == 0 || x == 1) pow = 1; - else if (x != -1) pow = x == 0 ? 1/x : 0; - else n = -n; - } - if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { - u = n; - for(pow = 1; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static integer dmaxloc_(double *w, integer s, integer e, integer *n) -{ - double m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static integer smaxloc_(float *w, integer s, integer e, integer *n) -{ - float m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { - integer n = *n_, incx = *incx_, incy = *incy_, i; -#ifdef _MSC_VER - _Fcomplex zdotc = {0.0, 0.0}; - if (incx == 1 && incy == 1) { - for (i=0;i= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; #define z_abs(z) (cabs(Cd(z))) #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} @@ -258,250 +250,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; //#define mymaxloc_(w,s,e,n) {if (sizeof(*(w)) == sizeof(double)) dmaxloc_((w),*(s),*(e),n); else dmaxloc_((w),*(s),*(e),n);} #define mymaxloc(w,s,e,n) {dmaxloc_(w,*(s),*(e),n)} -/* procedure parameter types for -A and -C++ */ - -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef logical (*L_fp)(...); -#else -typedef logical (*L_fp)(); -#endif - -static float spow_ui(float x, integer n) { - float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static double dpow_ui(double x, integer n) { - double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#ifdef _MSC_VER -static _Fcomplex cpow_ui(complex x, integer n) { - complex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; - for(u = n; ; ) { - if(u & 01) pow.r *= x.r, pow.i *= x.i; - if(u >>= 1) x.r *= x.r, x.i *= x.i; - else break; - } - } - _Fcomplex p={pow.r, pow.i}; - return p; -} -#else -static _Complex float cpow_ui(_Complex float x, integer n) { - _Complex float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -#ifdef _MSC_VER -static _Dcomplex zpow_ui(_Dcomplex x, integer n) { - _Dcomplex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; - for(u = n; ; ) { - if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; - if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; - else break; - } - } - _Dcomplex p = {pow._Val[0], pow._Val[1]}; - return p; -} -#else -static _Complex double zpow_ui(_Complex double x, integer n) { - _Complex double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -static integer pow_ii(integer x, integer n) { - integer pow; unsigned long int u; - if (n <= 0) { - if (n == 0 || x == 1) pow = 1; - else if (x != -1) pow = x == 0 ? 1/x : 0; - else n = -n; - } - if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { - u = n; - for(pow = 1; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static integer dmaxloc_(double *w, integer s, integer e, integer *n) -{ - double m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static integer smaxloc_(float *w, integer s, integer e, integer *n) -{ - float m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { - integer n = *n_, incx = *incx_, incy = *incy_, i; -#ifdef _MSC_VER - _Fcomplex zdotc = {0.0, 0.0}; - if (incx == 1 && incy == 1) { - for (i=0;i= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; #define z_abs(z) (cabs(Cd(z))) #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} @@ -258,250 +250,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; //#define mymaxloc_(w,s,e,n) {if (sizeof(*(w)) == sizeof(double)) dmaxloc_((w),*(s),*(e),n); else dmaxloc_((w),*(s),*(e),n);} #define mymaxloc(w,s,e,n) {dmaxloc_(w,*(s),*(e),n)} -/* procedure parameter types for -A and -C++ */ - -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef logical (*L_fp)(...); -#else -typedef logical (*L_fp)(); -#endif - -static float spow_ui(float x, integer n) { - float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static double dpow_ui(double x, integer n) { - double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#ifdef _MSC_VER -static _Fcomplex cpow_ui(complex x, integer n) { - complex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; - for(u = n; ; ) { - if(u & 01) pow.r *= x.r, pow.i *= x.i; - if(u >>= 1) x.r *= x.r, x.i *= x.i; - else break; - } - } - _Fcomplex p={pow.r, pow.i}; - return p; -} -#else -static _Complex float cpow_ui(_Complex float x, integer n) { - _Complex float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -#ifdef _MSC_VER -static _Dcomplex zpow_ui(_Dcomplex x, integer n) { - _Dcomplex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; - for(u = n; ; ) { - if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; - if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; - else break; - } - } - _Dcomplex p = {pow._Val[0], pow._Val[1]}; - return p; -} -#else -static _Complex double zpow_ui(_Complex double x, integer n) { - _Complex double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -static integer pow_ii(integer x, integer n) { - integer pow; unsigned long int u; - if (n <= 0) { - if (n == 0 || x == 1) pow = 1; - else if (x != -1) pow = x == 0 ? 1/x : 0; - else n = -n; - } - if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { - u = n; - for(pow = 1; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static integer dmaxloc_(double *w, integer s, integer e, integer *n) -{ - double m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static integer smaxloc_(float *w, integer s, integer e, integer *n) -{ - float m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { - integer n = *n_, incx = *incx_, incy = *incy_, i; -#ifdef _MSC_VER - _Fcomplex zdotc = {0.0, 0.0}; - if (incx == 1 && incy == 1) { - for (i=0;i= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; #define z_abs(z) (cabs(Cd(z))) #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} @@ -258,250 +247,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; //#define mymaxloc_(w,s,e,n) {if (sizeof(*(w)) == sizeof(double)) dmaxloc_((w),*(s),*(e),n); else dmaxloc_((w),*(s),*(e),n);} #define mymaxloc(w,s,e,n) {dmaxloc_(w,*(s),*(e),n)} -/* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef logical (*L_fp)(...); -#else -typedef logical (*L_fp)(); -#endif - -static float spow_ui(float x, integer n) { - float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static double dpow_ui(double x, integer n) { - double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#ifdef _MSC_VER -static _Fcomplex cpow_ui(complex x, integer n) { - complex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; - for(u = n; ; ) { - if(u & 01) pow.r *= x.r, pow.i *= x.i; - if(u >>= 1) x.r *= x.r, x.i *= x.i; - else break; - } - } - _Fcomplex p={pow.r, pow.i}; - return p; -} -#else -static _Complex float cpow_ui(_Complex float x, integer n) { - _Complex float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -#ifdef _MSC_VER -static _Dcomplex zpow_ui(_Dcomplex x, integer n) { - _Dcomplex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; - for(u = n; ; ) { - if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; - if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; - else break; - } - } - _Dcomplex p = {pow._Val[0], pow._Val[1]}; - return p; -} -#else -static _Complex double zpow_ui(_Complex double x, integer n) { - _Complex double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -static integer pow_ii(integer x, integer n) { - integer pow; unsigned long int u; - if (n <= 0) { - if (n == 0 || x == 1) pow = 1; - else if (x != -1) pow = x == 0 ? 1/x : 0; - else n = -n; - } - if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { - u = n; - for(pow = 1; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static integer dmaxloc_(double *w, integer s, integer e, integer *n) -{ - double m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static integer smaxloc_(float *w, integer s, integer e, integer *n) -{ - float m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { - integer n = *n_, incx = *incx_, incy = *incy_, i; -#ifdef _MSC_VER - _Fcomplex zdotc = {0.0, 0.0}; - if (incx == 1 && incy == 1) { - for (i=0;i= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; #define z_abs(z) (cabs(Cd(z))) #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} @@ -258,250 +250,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; //#define mymaxloc_(w,s,e,n) {if (sizeof(*(w)) == sizeof(double)) dmaxloc_((w),*(s),*(e),n); else dmaxloc_((w),*(s),*(e),n);} #define mymaxloc(w,s,e,n) {dmaxloc_(w,*(s),*(e),n)} -/* procedure parameter types for -A and -C++ */ - -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef logical (*L_fp)(...); -#else -typedef logical (*L_fp)(); -#endif - -static float spow_ui(float x, integer n) { - float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static double dpow_ui(double x, integer n) { - double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#ifdef _MSC_VER -static _Fcomplex cpow_ui(complex x, integer n) { - complex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; - for(u = n; ; ) { - if(u & 01) pow.r *= x.r, pow.i *= x.i; - if(u >>= 1) x.r *= x.r, x.i *= x.i; - else break; - } - } - _Fcomplex p={pow.r, pow.i}; - return p; -} -#else -static _Complex float cpow_ui(_Complex float x, integer n) { - _Complex float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -#ifdef _MSC_VER -static _Dcomplex zpow_ui(_Dcomplex x, integer n) { - _Dcomplex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; - for(u = n; ; ) { - if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; - if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; - else break; - } - } - _Dcomplex p = {pow._Val[0], pow._Val[1]}; - return p; -} -#else -static _Complex double zpow_ui(_Complex double x, integer n) { - _Complex double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -static integer pow_ii(integer x, integer n) { - integer pow; unsigned long int u; - if (n <= 0) { - if (n == 0 || x == 1) pow = 1; - else if (x != -1) pow = x == 0 ? 1/x : 0; - else n = -n; - } - if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { - u = n; - for(pow = 1; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static integer dmaxloc_(double *w, integer s, integer e, integer *n) -{ - double m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static integer smaxloc_(float *w, integer s, integer e, integer *n) -{ - float m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { - integer n = *n_, incx = *incx_, incy = *incy_, i; -#ifdef _MSC_VER - _Fcomplex zdotc = {0.0, 0.0}; - if (incx == 1 && incy == 1) { - for (i=0;i= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; #define z_abs(z) (cabs(Cd(z))) #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} @@ -258,250 +247,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; //#define mymaxloc_(w,s,e,n) {if (sizeof(*(w)) == sizeof(double)) dmaxloc_((w),*(s),*(e),n); else dmaxloc_((w),*(s),*(e),n);} #define mymaxloc(w,s,e,n) {dmaxloc_(w,*(s),*(e),n)} -/* procedure parameter types for -A and -C++ */ - -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef logical (*L_fp)(...); -#else -typedef logical (*L_fp)(); -#endif - -static float spow_ui(float x, integer n) { - float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static double dpow_ui(double x, integer n) { - double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#ifdef _MSC_VER -static _Fcomplex cpow_ui(complex x, integer n) { - complex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; - for(u = n; ; ) { - if(u & 01) pow.r *= x.r, pow.i *= x.i; - if(u >>= 1) x.r *= x.r, x.i *= x.i; - else break; - } - } - _Fcomplex p={pow.r, pow.i}; - return p; -} -#else -static _Complex float cpow_ui(_Complex float x, integer n) { - _Complex float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -#ifdef _MSC_VER -static _Dcomplex zpow_ui(_Dcomplex x, integer n) { - _Dcomplex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; - for(u = n; ; ) { - if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; - if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; - else break; - } - } - _Dcomplex p = {pow._Val[0], pow._Val[1]}; - return p; -} -#else -static _Complex double zpow_ui(_Complex double x, integer n) { - _Complex double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -static integer pow_ii(integer x, integer n) { - integer pow; unsigned long int u; - if (n <= 0) { - if (n == 0 || x == 1) pow = 1; - else if (x != -1) pow = x == 0 ? 1/x : 0; - else n = -n; - } - if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { - u = n; - for(pow = 1; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static integer dmaxloc_(double *w, integer s, integer e, integer *n) -{ - double m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static integer smaxloc_(float *w, integer s, integer e, integer *n) -{ - float m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { - integer n = *n_, incx = *incx_, incy = *incy_, i; -#ifdef _MSC_VER - _Fcomplex zdotc = {0.0, 0.0}; - if (incx == 1 && incy == 1) { - for (i=0;i= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; #define z_abs(z) (cabs(Cd(z))) #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} @@ -258,250 +250,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; //#define mymaxloc_(w,s,e,n) {if (sizeof(*(w)) == sizeof(double)) dmaxloc_((w),*(s),*(e),n); else dmaxloc_((w),*(s),*(e),n);} #define mymaxloc(w,s,e,n) {dmaxloc_(w,*(s),*(e),n)} -/* procedure parameter types for -A and -C++ */ - -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef logical (*L_fp)(...); -#else -typedef logical (*L_fp)(); -#endif - -static float spow_ui(float x, integer n) { - float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static double dpow_ui(double x, integer n) { - double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#ifdef _MSC_VER -static _Fcomplex cpow_ui(complex x, integer n) { - complex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; - for(u = n; ; ) { - if(u & 01) pow.r *= x.r, pow.i *= x.i; - if(u >>= 1) x.r *= x.r, x.i *= x.i; - else break; - } - } - _Fcomplex p={pow.r, pow.i}; - return p; -} -#else -static _Complex float cpow_ui(_Complex float x, integer n) { - _Complex float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -#ifdef _MSC_VER -static _Dcomplex zpow_ui(_Dcomplex x, integer n) { - _Dcomplex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; - for(u = n; ; ) { - if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; - if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; - else break; - } - } - _Dcomplex p = {pow._Val[0], pow._Val[1]}; - return p; -} -#else -static _Complex double zpow_ui(_Complex double x, integer n) { - _Complex double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -static integer pow_ii(integer x, integer n) { - integer pow; unsigned long int u; - if (n <= 0) { - if (n == 0 || x == 1) pow = 1; - else if (x != -1) pow = x == 0 ? 1/x : 0; - else n = -n; - } - if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { - u = n; - for(pow = 1; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static integer dmaxloc_(double *w, integer s, integer e, integer *n) -{ - double m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static integer smaxloc_(float *w, integer s, integer e, integer *n) -{ - float m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { - integer n = *n_, incx = *incx_, incy = *incy_, i; -#ifdef _MSC_VER - _Fcomplex zdotc = {0.0, 0.0}; - if (incx == 1 && incy == 1) { - for (i=0;i= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; #define z_abs(z) (cabs(Cd(z))) #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} @@ -258,250 +250,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; //#define mymaxloc_(w,s,e,n) {if (sizeof(*(w)) == sizeof(double)) dmaxloc_((w),*(s),*(e),n); else dmaxloc_((w),*(s),*(e),n);} #define mymaxloc(w,s,e,n) {dmaxloc_(w,*(s),*(e),n)} -/* procedure parameter types for -A and -C++ */ - -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef logical (*L_fp)(...); -#else -typedef logical (*L_fp)(); -#endif - -static float spow_ui(float x, integer n) { - float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static double dpow_ui(double x, integer n) { - double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#ifdef _MSC_VER -static _Fcomplex cpow_ui(complex x, integer n) { - complex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; - for(u = n; ; ) { - if(u & 01) pow.r *= x.r, pow.i *= x.i; - if(u >>= 1) x.r *= x.r, x.i *= x.i; - else break; - } - } - _Fcomplex p={pow.r, pow.i}; - return p; -} -#else -static _Complex float cpow_ui(_Complex float x, integer n) { - _Complex float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -#ifdef _MSC_VER -static _Dcomplex zpow_ui(_Dcomplex x, integer n) { - _Dcomplex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; - for(u = n; ; ) { - if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; - if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; - else break; - } - } - _Dcomplex p = {pow._Val[0], pow._Val[1]}; - return p; -} -#else -static _Complex double zpow_ui(_Complex double x, integer n) { - _Complex double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -static integer pow_ii(integer x, integer n) { - integer pow; unsigned long int u; - if (n <= 0) { - if (n == 0 || x == 1) pow = 1; - else if (x != -1) pow = x == 0 ? 1/x : 0; - else n = -n; - } - if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { - u = n; - for(pow = 1; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static integer dmaxloc_(double *w, integer s, integer e, integer *n) -{ - double m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static integer smaxloc_(float *w, integer s, integer e, integer *n) -{ - float m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { - integer n = *n_, incx = *incx_, incy = *incy_, i; -#ifdef _MSC_VER - _Fcomplex zdotc = {0.0, 0.0}; - if (incx == 1 && incy == 1) { - for (i=0;i= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; #define z_abs(z) (cabs(Cd(z))) #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} @@ -258,250 +250,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; //#define mymaxloc_(w,s,e,n) {if (sizeof(*(w)) == sizeof(double)) dmaxloc_((w),*(s),*(e),n); else dmaxloc_((w),*(s),*(e),n);} #define mymaxloc(w,s,e,n) {dmaxloc_(w,*(s),*(e),n)} -/* procedure parameter types for -A and -C++ */ - -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef logical (*L_fp)(...); -#else -typedef logical (*L_fp)(); -#endif - -static float spow_ui(float x, integer n) { - float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static double dpow_ui(double x, integer n) { - double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#ifdef _MSC_VER -static _Fcomplex cpow_ui(complex x, integer n) { - complex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; - for(u = n; ; ) { - if(u & 01) pow.r *= x.r, pow.i *= x.i; - if(u >>= 1) x.r *= x.r, x.i *= x.i; - else break; - } - } - _Fcomplex p={pow.r, pow.i}; - return p; -} -#else -static _Complex float cpow_ui(_Complex float x, integer n) { - _Complex float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -#ifdef _MSC_VER -static _Dcomplex zpow_ui(_Dcomplex x, integer n) { - _Dcomplex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; - for(u = n; ; ) { - if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; - if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; - else break; - } - } - _Dcomplex p = {pow._Val[0], pow._Val[1]}; - return p; -} -#else -static _Complex double zpow_ui(_Complex double x, integer n) { - _Complex double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -static integer pow_ii(integer x, integer n) { - integer pow; unsigned long int u; - if (n <= 0) { - if (n == 0 || x == 1) pow = 1; - else if (x != -1) pow = x == 0 ? 1/x : 0; - else n = -n; - } - if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { - u = n; - for(pow = 1; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static integer dmaxloc_(double *w, integer s, integer e, integer *n) -{ - double m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static integer smaxloc_(float *w, integer s, integer e, integer *n) -{ - float m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { - integer n = *n_, incx = *incx_, incy = *incy_, i; -#ifdef _MSC_VER - _Fcomplex zdotc = {0.0, 0.0}; - if (incx == 1 && incy == 1) { - for (i=0;i= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; #define z_abs(z) (cabs(Cd(z))) #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} @@ -258,250 +250,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; //#define mymaxloc_(w,s,e,n) {if (sizeof(*(w)) == sizeof(double)) dmaxloc_((w),*(s),*(e),n); else dmaxloc_((w),*(s),*(e),n);} #define mymaxloc(w,s,e,n) {dmaxloc_(w,*(s),*(e),n)} -/* procedure parameter types for -A and -C++ */ - -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef logical (*L_fp)(...); -#else -typedef logical (*L_fp)(); -#endif - -static float spow_ui(float x, integer n) { - float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static double dpow_ui(double x, integer n) { - double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#ifdef _MSC_VER -static _Fcomplex cpow_ui(complex x, integer n) { - complex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; - for(u = n; ; ) { - if(u & 01) pow.r *= x.r, pow.i *= x.i; - if(u >>= 1) x.r *= x.r, x.i *= x.i; - else break; - } - } - _Fcomplex p={pow.r, pow.i}; - return p; -} -#else -static _Complex float cpow_ui(_Complex float x, integer n) { - _Complex float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -#ifdef _MSC_VER -static _Dcomplex zpow_ui(_Dcomplex x, integer n) { - _Dcomplex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; - for(u = n; ; ) { - if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; - if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; - else break; - } - } - _Dcomplex p = {pow._Val[0], pow._Val[1]}; - return p; -} -#else -static _Complex double zpow_ui(_Complex double x, integer n) { - _Complex double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -static integer pow_ii(integer x, integer n) { - integer pow; unsigned long int u; - if (n <= 0) { - if (n == 0 || x == 1) pow = 1; - else if (x != -1) pow = x == 0 ? 1/x : 0; - else n = -n; - } - if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { - u = n; - for(pow = 1; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static integer dmaxloc_(double *w, integer s, integer e, integer *n) -{ - double m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static integer smaxloc_(float *w, integer s, integer e, integer *n) -{ - float m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { - integer n = *n_, incx = *incx_, incy = *incy_, i; -#ifdef _MSC_VER - _Fcomplex zdotc = {0.0, 0.0}; - if (incx == 1 && incy == 1) { - for (i=0;i= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; #define z_abs(z) (cabs(Cd(z))) #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} @@ -258,250 +250,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; //#define mymaxloc_(w,s,e,n) {if (sizeof(*(w)) == sizeof(double)) dmaxloc_((w),*(s),*(e),n); else dmaxloc_((w),*(s),*(e),n);} #define mymaxloc(w,s,e,n) {dmaxloc_(w,*(s),*(e),n)} -/* procedure parameter types for -A and -C++ */ - -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef logical (*L_fp)(...); -#else -typedef logical (*L_fp)(); -#endif - -static float spow_ui(float x, integer n) { - float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static double dpow_ui(double x, integer n) { - double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#ifdef _MSC_VER -static _Fcomplex cpow_ui(complex x, integer n) { - complex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; - for(u = n; ; ) { - if(u & 01) pow.r *= x.r, pow.i *= x.i; - if(u >>= 1) x.r *= x.r, x.i *= x.i; - else break; - } - } - _Fcomplex p={pow.r, pow.i}; - return p; -} -#else -static _Complex float cpow_ui(_Complex float x, integer n) { - _Complex float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -#ifdef _MSC_VER -static _Dcomplex zpow_ui(_Dcomplex x, integer n) { - _Dcomplex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; - for(u = n; ; ) { - if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; - if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; - else break; - } - } - _Dcomplex p = {pow._Val[0], pow._Val[1]}; - return p; -} -#else -static _Complex double zpow_ui(_Complex double x, integer n) { - _Complex double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -static integer pow_ii(integer x, integer n) { - integer pow; unsigned long int u; - if (n <= 0) { - if (n == 0 || x == 1) pow = 1; - else if (x != -1) pow = x == 0 ? 1/x : 0; - else n = -n; - } - if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { - u = n; - for(pow = 1; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static integer dmaxloc_(double *w, integer s, integer e, integer *n) -{ - double m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static integer smaxloc_(float *w, integer s, integer e, integer *n) -{ - float m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { - integer n = *n_, incx = *incx_, incy = *incy_, i; -#ifdef _MSC_VER - _Fcomplex zdotc = {0.0, 0.0}; - if (incx == 1 && incy == 1) { - for (i=0;i= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; #define z_abs(z) (cabs(Cd(z))) #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} @@ -258,250 +247,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; //#define mymaxloc_(w,s,e,n) {if (sizeof(*(w)) == sizeof(double)) dmaxloc_((w),*(s),*(e),n); else dmaxloc_((w),*(s),*(e),n);} #define mymaxloc(w,s,e,n) {dmaxloc_(w,*(s),*(e),n)} -/* procedure parameter types for -A and -C++ */ - -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef logical (*L_fp)(...); -#else -typedef logical (*L_fp)(); -#endif - -static float spow_ui(float x, integer n) { - float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static double dpow_ui(double x, integer n) { - double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#ifdef _MSC_VER -static _Fcomplex cpow_ui(complex x, integer n) { - complex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; - for(u = n; ; ) { - if(u & 01) pow.r *= x.r, pow.i *= x.i; - if(u >>= 1) x.r *= x.r, x.i *= x.i; - else break; - } - } - _Fcomplex p={pow.r, pow.i}; - return p; -} -#else -static _Complex float cpow_ui(_Complex float x, integer n) { - _Complex float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -#ifdef _MSC_VER -static _Dcomplex zpow_ui(_Dcomplex x, integer n) { - _Dcomplex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; - for(u = n; ; ) { - if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; - if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; - else break; - } - } - _Dcomplex p = {pow._Val[0], pow._Val[1]}; - return p; -} -#else -static _Complex double zpow_ui(_Complex double x, integer n) { - _Complex double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -static integer pow_ii(integer x, integer n) { - integer pow; unsigned long int u; - if (n <= 0) { - if (n == 0 || x == 1) pow = 1; - else if (x != -1) pow = x == 0 ? 1/x : 0; - else n = -n; - } - if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { - u = n; - for(pow = 1; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static integer dmaxloc_(double *w, integer s, integer e, integer *n) -{ - double m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static integer smaxloc_(float *w, integer s, integer e, integer *n) -{ - float m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { - integer n = *n_, incx = *incx_, incy = *incy_, i; -#ifdef _MSC_VER - _Fcomplex zdotc = {0.0, 0.0}; - if (incx == 1 && incy == 1) { - for (i=0;i= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; #define z_abs(z) (cabs(Cd(z))) #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} @@ -258,250 +250,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; //#define mymaxloc_(w,s,e,n) {if (sizeof(*(w)) == sizeof(double)) dmaxloc_((w),*(s),*(e),n); else dmaxloc_((w),*(s),*(e),n);} #define mymaxloc(w,s,e,n) {dmaxloc_(w,*(s),*(e),n)} -/* procedure parameter types for -A and -C++ */ - -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef logical (*L_fp)(...); -#else -typedef logical (*L_fp)(); -#endif - -static float spow_ui(float x, integer n) { - float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static double dpow_ui(double x, integer n) { - double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#ifdef _MSC_VER -static _Fcomplex cpow_ui(complex x, integer n) { - complex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; - for(u = n; ; ) { - if(u & 01) pow.r *= x.r, pow.i *= x.i; - if(u >>= 1) x.r *= x.r, x.i *= x.i; - else break; - } - } - _Fcomplex p={pow.r, pow.i}; - return p; -} -#else -static _Complex float cpow_ui(_Complex float x, integer n) { - _Complex float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -#ifdef _MSC_VER -static _Dcomplex zpow_ui(_Dcomplex x, integer n) { - _Dcomplex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; - for(u = n; ; ) { - if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; - if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; - else break; - } - } - _Dcomplex p = {pow._Val[0], pow._Val[1]}; - return p; -} -#else -static _Complex double zpow_ui(_Complex double x, integer n) { - _Complex double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -static integer pow_ii(integer x, integer n) { - integer pow; unsigned long int u; - if (n <= 0) { - if (n == 0 || x == 1) pow = 1; - else if (x != -1) pow = x == 0 ? 1/x : 0; - else n = -n; - } - if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { - u = n; - for(pow = 1; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static integer dmaxloc_(double *w, integer s, integer e, integer *n) -{ - double m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static integer smaxloc_(float *w, integer s, integer e, integer *n) -{ - float m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { - integer n = *n_, incx = *incx_, incy = *incy_, i; -#ifdef _MSC_VER - _Fcomplex zdotc = {0.0, 0.0}; - if (incx == 1 && incy == 1) { - for (i=0;i= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; #define z_abs(z) (cabs(Cd(z))) #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} @@ -258,250 +250,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; //#define mymaxloc_(w,s,e,n) {if (sizeof(*(w)) == sizeof(double)) dmaxloc_((w),*(s),*(e),n); else dmaxloc_((w),*(s),*(e),n);} #define mymaxloc(w,s,e,n) {dmaxloc_(w,*(s),*(e),n)} -/* procedure parameter types for -A and -C++ */ - -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef logical (*L_fp)(...); -#else -typedef logical (*L_fp)(); -#endif - -static float spow_ui(float x, integer n) { - float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static double dpow_ui(double x, integer n) { - double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#ifdef _MSC_VER -static _Fcomplex cpow_ui(complex x, integer n) { - complex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; - for(u = n; ; ) { - if(u & 01) pow.r *= x.r, pow.i *= x.i; - if(u >>= 1) x.r *= x.r, x.i *= x.i; - else break; - } - } - _Fcomplex p={pow.r, pow.i}; - return p; -} -#else -static _Complex float cpow_ui(_Complex float x, integer n) { - _Complex float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -#ifdef _MSC_VER -static _Dcomplex zpow_ui(_Dcomplex x, integer n) { - _Dcomplex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; - for(u = n; ; ) { - if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; - if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; - else break; - } - } - _Dcomplex p = {pow._Val[0], pow._Val[1]}; - return p; -} -#else -static _Complex double zpow_ui(_Complex double x, integer n) { - _Complex double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -static integer pow_ii(integer x, integer n) { - integer pow; unsigned long int u; - if (n <= 0) { - if (n == 0 || x == 1) pow = 1; - else if (x != -1) pow = x == 0 ? 1/x : 0; - else n = -n; - } - if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { - u = n; - for(pow = 1; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static integer dmaxloc_(double *w, integer s, integer e, integer *n) -{ - double m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static integer smaxloc_(float *w, integer s, integer e, integer *n) -{ - float m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { - integer n = *n_, incx = *incx_, incy = *incy_, i; -#ifdef _MSC_VER - _Fcomplex zdotc = {0.0, 0.0}; - if (incx == 1 && incy == 1) { - for (i=0;i= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; #define z_abs(z) (cabs(Cd(z))) #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} @@ -258,257 +250,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; //#define mymaxloc_(w,s,e,n) {if (sizeof(*(w)) == sizeof(double)) dmaxloc_((w),*(s),*(e),n); else dmaxloc_((w),*(s),*(e),n);} #define mymaxloc_(w,s,e,n) dmaxloc_(w,*(s),*(e),n) -/* procedure parameter types for -A and -C++ */ - -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef logical (*L_fp)(...); -#else -typedef logical (*L_fp)(); -#endif - -static float spow_ui(float x, integer n) { - float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static double dpow_ui(double x, integer n) { - double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#ifdef _MSC_VER -static _Fcomplex cpow_ui(complex x, integer n) { - complex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; - for(u = n; ; ) { - if(u & 01) pow.r *= x.r, pow.i *= x.i; - if(u >>= 1) x.r *= x.r, x.i *= x.i; - else break; - } - } - _Fcomplex p={pow.r, pow.i}; - return p; -} -#else -static _Complex float cpow_ui(_Complex float x, integer n) { - _Complex float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -#ifdef _MSC_VER -static _Dcomplex zpow_ui(_Dcomplex x, integer n) { - _Dcomplex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; - for(u = n; ; ) { - if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; - if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; - else break; - } - } - _Dcomplex p = {pow._Val[0], pow._Val[1]}; - return p; -} -#else -static _Complex double zpow_ui(_Complex double x, integer n) { - _Complex double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -static integer pow_ii(integer x, integer n) { - integer pow; unsigned long int u; - if (n <= 0) { - if (n == 0 || x == 1) pow = 1; - else if (x != -1) pow = x == 0 ? 1/x : 0; - else n = -n; - } - if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { - u = n; - for(pow = 1; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static integer dmaxloc_(double *w, integer s, integer e, integer *n) -{ - double m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static integer smaxloc_(float *w, integer s, integer e, integer *n) -{ - float m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { - integer n = *n_, incx = *incx_, incy = *incy_, i; -#ifdef _MSC_VER - _Fcomplex zdotc = {0.0, 0.0}; - if (incx == 1 && incy == 1) { - for (i=0;i= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; #define z_abs(z) (cabs(Cd(z))) #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} @@ -258,250 +247,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; //#define mymaxloc_(w,s,e,n) {if (sizeof(*(w)) == sizeof(double)) dmaxloc_((w),*(s),*(e),n); else dmaxloc_((w),*(s),*(e),n);} #define mymaxloc(w,s,e,n) {dmaxloc_(w,*(s),*(e),n)} -/* procedure parameter types for -A and -C++ */ - -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef logical (*L_fp)(...); -#else -typedef logical (*L_fp)(); -#endif - -static float spow_ui(float x, integer n) { - float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static double dpow_ui(double x, integer n) { - double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#ifdef _MSC_VER -static _Fcomplex cpow_ui(complex x, integer n) { - complex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; - for(u = n; ; ) { - if(u & 01) pow.r *= x.r, pow.i *= x.i; - if(u >>= 1) x.r *= x.r, x.i *= x.i; - else break; - } - } - _Fcomplex p={pow.r, pow.i}; - return p; -} -#else -static _Complex float cpow_ui(_Complex float x, integer n) { - _Complex float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -#ifdef _MSC_VER -static _Dcomplex zpow_ui(_Dcomplex x, integer n) { - _Dcomplex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; - for(u = n; ; ) { - if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; - if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; - else break; - } - } - _Dcomplex p = {pow._Val[0], pow._Val[1]}; - return p; -} -#else -static _Complex double zpow_ui(_Complex double x, integer n) { - _Complex double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -static integer pow_ii(integer x, integer n) { - integer pow; unsigned long int u; - if (n <= 0) { - if (n == 0 || x == 1) pow = 1; - else if (x != -1) pow = x == 0 ? 1/x : 0; - else n = -n; - } - if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { - u = n; - for(pow = 1; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static integer dmaxloc_(double *w, integer s, integer e, integer *n) -{ - double m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static integer smaxloc_(float *w, integer s, integer e, integer *n) -{ - float m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { - integer n = *n_, incx = *incx_, incy = *incy_, i; -#ifdef _MSC_VER - _Fcomplex zdotc = {0.0, 0.0}; - if (incx == 1 && incy == 1) { - for (i=0;i= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; #define z_abs(z) (cabs(Cd(z))) #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} @@ -258,250 +247,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; //#define mymaxloc_(w,s,e,n) {if (sizeof(*(w)) == sizeof(double)) dmaxloc_((w),*(s),*(e),n); else dmaxloc_((w),*(s),*(e),n);} #define mymaxloc(w,s,e,n) {dmaxloc_(w,*(s),*(e),n)} -/* procedure parameter types for -A and -C++ */ - -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef logical (*L_fp)(...); -#else -typedef logical (*L_fp)(); -#endif - -static float spow_ui(float x, integer n) { - float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static double dpow_ui(double x, integer n) { - double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#ifdef _MSC_VER -static _Fcomplex cpow_ui(complex x, integer n) { - complex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; - for(u = n; ; ) { - if(u & 01) pow.r *= x.r, pow.i *= x.i; - if(u >>= 1) x.r *= x.r, x.i *= x.i; - else break; - } - } - _Fcomplex p={pow.r, pow.i}; - return p; -} -#else -static _Complex float cpow_ui(_Complex float x, integer n) { - _Complex float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -#ifdef _MSC_VER -static _Dcomplex zpow_ui(_Dcomplex x, integer n) { - _Dcomplex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; - for(u = n; ; ) { - if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; - if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; - else break; - } - } - _Dcomplex p = {pow._Val[0], pow._Val[1]}; - return p; -} -#else -static _Complex double zpow_ui(_Complex double x, integer n) { - _Complex double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -static integer pow_ii(integer x, integer n) { - integer pow; unsigned long int u; - if (n <= 0) { - if (n == 0 || x == 1) pow = 1; - else if (x != -1) pow = x == 0 ? 1/x : 0; - else n = -n; - } - if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { - u = n; - for(pow = 1; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static integer dmaxloc_(double *w, integer s, integer e, integer *n) -{ - double m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static integer smaxloc_(float *w, integer s, integer e, integer *n) -{ - float m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { - integer n = *n_, incx = *incx_, incy = *incy_, i; -#ifdef _MSC_VER - _Fcomplex zdotc = {0.0, 0.0}; - if (incx == 1 && incy == 1) { - for (i=0;i= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; #define z_abs(z) (cabs(Cd(z))) #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} @@ -258,250 +250,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; //#define mymaxloc_(w,s,e,n) {if (sizeof(*(w)) == sizeof(double)) dmaxloc_((w),*(s),*(e),n); else dmaxloc_((w),*(s),*(e),n);} #define mymaxloc(w,s,e,n) {dmaxloc_(w,*(s),*(e),n)} -/* procedure parameter types for -A and -C++ */ - -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef logical (*L_fp)(...); -#else -typedef logical (*L_fp)(); -#endif - -static float spow_ui(float x, integer n) { - float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static double dpow_ui(double x, integer n) { - double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#ifdef _MSC_VER -static _Fcomplex cpow_ui(complex x, integer n) { - complex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; - for(u = n; ; ) { - if(u & 01) pow.r *= x.r, pow.i *= x.i; - if(u >>= 1) x.r *= x.r, x.i *= x.i; - else break; - } - } - _Fcomplex p={pow.r, pow.i}; - return p; -} -#else -static _Complex float cpow_ui(_Complex float x, integer n) { - _Complex float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -#ifdef _MSC_VER -static _Dcomplex zpow_ui(_Dcomplex x, integer n) { - _Dcomplex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; - for(u = n; ; ) { - if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; - if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; - else break; - } - } - _Dcomplex p = {pow._Val[0], pow._Val[1]}; - return p; -} -#else -static _Complex double zpow_ui(_Complex double x, integer n) { - _Complex double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -static integer pow_ii(integer x, integer n) { - integer pow; unsigned long int u; - if (n <= 0) { - if (n == 0 || x == 1) pow = 1; - else if (x != -1) pow = x == 0 ? 1/x : 0; - else n = -n; - } - if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { - u = n; - for(pow = 1; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static integer dmaxloc_(double *w, integer s, integer e, integer *n) -{ - double m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static integer smaxloc_(float *w, integer s, integer e, integer *n) -{ - float m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { - integer n = *n_, incx = *incx_, incy = *incy_, i; -#ifdef _MSC_VER - _Fcomplex zdotc = {0.0, 0.0}; - if (incx == 1 && incy == 1) { - for (i=0;i= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; #define z_abs(z) (cabs(Cd(z))) #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} @@ -258,250 +250,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; //#define mymaxloc_(w,s,e,n) {if (sizeof(*(w)) == sizeof(double)) dmaxloc_((w),*(s),*(e),n); else dmaxloc_((w),*(s),*(e),n);} #define mymaxloc(w,s,e,n) {dmaxloc_(w,*(s),*(e),n)} -/* procedure parameter types for -A and -C++ */ - -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef logical (*L_fp)(...); -#else -typedef logical (*L_fp)(); -#endif - -static float spow_ui(float x, integer n) { - float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static double dpow_ui(double x, integer n) { - double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#ifdef _MSC_VER -static _Fcomplex cpow_ui(complex x, integer n) { - complex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; - for(u = n; ; ) { - if(u & 01) pow.r *= x.r, pow.i *= x.i; - if(u >>= 1) x.r *= x.r, x.i *= x.i; - else break; - } - } - _Fcomplex p={pow.r, pow.i}; - return p; -} -#else -static _Complex float cpow_ui(_Complex float x, integer n) { - _Complex float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -#ifdef _MSC_VER -static _Dcomplex zpow_ui(_Dcomplex x, integer n) { - _Dcomplex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; - for(u = n; ; ) { - if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; - if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; - else break; - } - } - _Dcomplex p = {pow._Val[0], pow._Val[1]}; - return p; -} -#else -static _Complex double zpow_ui(_Complex double x, integer n) { - _Complex double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -static integer pow_ii(integer x, integer n) { - integer pow; unsigned long int u; - if (n <= 0) { - if (n == 0 || x == 1) pow = 1; - else if (x != -1) pow = x == 0 ? 1/x : 0; - else n = -n; - } - if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { - u = n; - for(pow = 1; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static integer dmaxloc_(double *w, integer s, integer e, integer *n) -{ - double m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static integer smaxloc_(float *w, integer s, integer e, integer *n) -{ - float m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { - integer n = *n_, incx = *incx_, incy = *incy_, i; -#ifdef _MSC_VER - _Fcomplex zdotc = {0.0, 0.0}; - if (incx == 1 && incy == 1) { - for (i=0;i= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; #define z_abs(z) (cabs(Cd(z))) #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} @@ -258,250 +250,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; //#define mymaxloc_(w,s,e,n) {if (sizeof(*(w)) == sizeof(double)) dmaxloc_((w),*(s),*(e),n); else dmaxloc_((w),*(s),*(e),n);} #define mymaxloc(w,s,e,n) {dmaxloc_(w,*(s),*(e),n)} -/* procedure parameter types for -A and -C++ */ - -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef logical (*L_fp)(...); -#else -typedef logical (*L_fp)(); -#endif - -static float spow_ui(float x, integer n) { - float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static double dpow_ui(double x, integer n) { - double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#ifdef _MSC_VER -static _Fcomplex cpow_ui(complex x, integer n) { - complex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; - for(u = n; ; ) { - if(u & 01) pow.r *= x.r, pow.i *= x.i; - if(u >>= 1) x.r *= x.r, x.i *= x.i; - else break; - } - } - _Fcomplex p={pow.r, pow.i}; - return p; -} -#else -static _Complex float cpow_ui(_Complex float x, integer n) { - _Complex float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -#ifdef _MSC_VER -static _Dcomplex zpow_ui(_Dcomplex x, integer n) { - _Dcomplex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; - for(u = n; ; ) { - if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; - if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; - else break; - } - } - _Dcomplex p = {pow._Val[0], pow._Val[1]}; - return p; -} -#else -static _Complex double zpow_ui(_Complex double x, integer n) { - _Complex double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -static integer pow_ii(integer x, integer n) { - integer pow; unsigned long int u; - if (n <= 0) { - if (n == 0 || x == 1) pow = 1; - else if (x != -1) pow = x == 0 ? 1/x : 0; - else n = -n; - } - if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { - u = n; - for(pow = 1; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static integer dmaxloc_(double *w, integer s, integer e, integer *n) -{ - double m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static integer smaxloc_(float *w, integer s, integer e, integer *n) -{ - float m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { - integer n = *n_, incx = *incx_, incy = *incy_, i; -#ifdef _MSC_VER - _Fcomplex zdotc = {0.0, 0.0}; - if (incx == 1 && incy == 1) { - for (i=0;i= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; #define z_abs(z) (cabs(Cd(z))) #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} @@ -258,250 +250,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; //#define mymaxloc_(w,s,e,n) {if (sizeof(*(w)) == sizeof(double)) dmaxloc_((w),*(s),*(e),n); else dmaxloc_((w),*(s),*(e),n);} #define mymaxloc(w,s,e,n) {dmaxloc_(w,*(s),*(e),n)} -/* procedure parameter types for -A and -C++ */ - -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef logical (*L_fp)(...); -#else -typedef logical (*L_fp)(); -#endif - -static float spow_ui(float x, integer n) { - float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static double dpow_ui(double x, integer n) { - double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#ifdef _MSC_VER -static _Fcomplex cpow_ui(complex x, integer n) { - complex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; - for(u = n; ; ) { - if(u & 01) pow.r *= x.r, pow.i *= x.i; - if(u >>= 1) x.r *= x.r, x.i *= x.i; - else break; - } - } - _Fcomplex p={pow.r, pow.i}; - return p; -} -#else -static _Complex float cpow_ui(_Complex float x, integer n) { - _Complex float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -#ifdef _MSC_VER -static _Dcomplex zpow_ui(_Dcomplex x, integer n) { - _Dcomplex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; - for(u = n; ; ) { - if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; - if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; - else break; - } - } - _Dcomplex p = {pow._Val[0], pow._Val[1]}; - return p; -} -#else -static _Complex double zpow_ui(_Complex double x, integer n) { - _Complex double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -static integer pow_ii(integer x, integer n) { - integer pow; unsigned long int u; - if (n <= 0) { - if (n == 0 || x == 1) pow = 1; - else if (x != -1) pow = x == 0 ? 1/x : 0; - else n = -n; - } - if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { - u = n; - for(pow = 1; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static integer dmaxloc_(double *w, integer s, integer e, integer *n) -{ - double m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static integer smaxloc_(float *w, integer s, integer e, integer *n) -{ - float m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { - integer n = *n_, incx = *incx_, incy = *incy_, i; -#ifdef _MSC_VER - _Fcomplex zdotc = {0.0, 0.0}; - if (incx == 1 && incy == 1) { - for (i=0;i= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; #define z_abs(z) (cabs(Cd(z))) #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} @@ -258,250 +250,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; //#define mymaxloc_(w,s,e,n) {if (sizeof(*(w)) == sizeof(double)) dmaxloc_((w),*(s),*(e),n); else dmaxloc_((w),*(s),*(e),n);} #define mymaxloc(w,s,e,n) {dmaxloc_(w,*(s),*(e),n)} -/* procedure parameter types for -A and -C++ */ - -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef logical (*L_fp)(...); -#else -typedef logical (*L_fp)(); -#endif - -static float spow_ui(float x, integer n) { - float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static double dpow_ui(double x, integer n) { - double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#ifdef _MSC_VER -static _Fcomplex cpow_ui(complex x, integer n) { - complex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; - for(u = n; ; ) { - if(u & 01) pow.r *= x.r, pow.i *= x.i; - if(u >>= 1) x.r *= x.r, x.i *= x.i; - else break; - } - } - _Fcomplex p={pow.r, pow.i}; - return p; -} -#else -static _Complex float cpow_ui(_Complex float x, integer n) { - _Complex float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -#ifdef _MSC_VER -static _Dcomplex zpow_ui(_Dcomplex x, integer n) { - _Dcomplex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; - for(u = n; ; ) { - if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; - if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; - else break; - } - } - _Dcomplex p = {pow._Val[0], pow._Val[1]}; - return p; -} -#else -static _Complex double zpow_ui(_Complex double x, integer n) { - _Complex double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -static integer pow_ii(integer x, integer n) { - integer pow; unsigned long int u; - if (n <= 0) { - if (n == 0 || x == 1) pow = 1; - else if (x != -1) pow = x == 0 ? 1/x : 0; - else n = -n; - } - if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { - u = n; - for(pow = 1; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static integer dmaxloc_(double *w, integer s, integer e, integer *n) -{ - double m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static integer smaxloc_(float *w, integer s, integer e, integer *n) -{ - float m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { - integer n = *n_, incx = *incx_, incy = *incy_, i; -#ifdef _MSC_VER - _Fcomplex zdotc = {0.0, 0.0}; - if (incx == 1 && incy == 1) { - for (i=0;i= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; #define z_abs(z) (cabs(Cd(z))) #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} @@ -258,250 +247,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; //#define mymaxloc_(w,s,e,n) {if (sizeof(*(w)) == sizeof(double)) dmaxloc_((w),*(s),*(e),n); else dmaxloc_((w),*(s),*(e),n);} #define mymaxloc(w,s,e,n) {dmaxloc_(w,*(s),*(e),n)} -/* procedure parameter types for -A and -C++ */ - -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef logical (*L_fp)(...); -#else -typedef logical (*L_fp)(); -#endif - -static float spow_ui(float x, integer n) { - float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static double dpow_ui(double x, integer n) { - double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#ifdef _MSC_VER -static _Fcomplex cpow_ui(complex x, integer n) { - complex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; - for(u = n; ; ) { - if(u & 01) pow.r *= x.r, pow.i *= x.i; - if(u >>= 1) x.r *= x.r, x.i *= x.i; - else break; - } - } - _Fcomplex p={pow.r, pow.i}; - return p; -} -#else -static _Complex float cpow_ui(_Complex float x, integer n) { - _Complex float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -#ifdef _MSC_VER -static _Dcomplex zpow_ui(_Dcomplex x, integer n) { - _Dcomplex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; - for(u = n; ; ) { - if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; - if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; - else break; - } - } - _Dcomplex p = {pow._Val[0], pow._Val[1]}; - return p; -} -#else -static _Complex double zpow_ui(_Complex double x, integer n) { - _Complex double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -static integer pow_ii(integer x, integer n) { - integer pow; unsigned long int u; - if (n <= 0) { - if (n == 0 || x == 1) pow = 1; - else if (x != -1) pow = x == 0 ? 1/x : 0; - else n = -n; - } - if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { - u = n; - for(pow = 1; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static integer dmaxloc_(double *w, integer s, integer e, integer *n) -{ - double m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static integer smaxloc_(float *w, integer s, integer e, integer *n) -{ - float m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { - integer n = *n_, incx = *incx_, incy = *incy_, i; -#ifdef _MSC_VER - _Fcomplex zdotc = {0.0, 0.0}; - if (incx == 1 && incy == 1) { - for (i=0;i= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; #define z_abs(z) (cabs(Cd(z))) #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} @@ -258,250 +250,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; //#define mymaxloc_(w,s,e,n) {if (sizeof(*(w)) == sizeof(double)) dmaxloc_((w),*(s),*(e),n); else dmaxloc_((w),*(s),*(e),n);} #define mymaxloc(w,s,e,n) {dmaxloc_(w,*(s),*(e),n)} -/* procedure parameter types for -A and -C++ */ - -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef logical (*L_fp)(...); -#else -typedef logical (*L_fp)(); -#endif - -static float spow_ui(float x, integer n) { - float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static double dpow_ui(double x, integer n) { - double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#ifdef _MSC_VER -static _Fcomplex cpow_ui(complex x, integer n) { - complex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; - for(u = n; ; ) { - if(u & 01) pow.r *= x.r, pow.i *= x.i; - if(u >>= 1) x.r *= x.r, x.i *= x.i; - else break; - } - } - _Fcomplex p={pow.r, pow.i}; - return p; -} -#else -static _Complex float cpow_ui(_Complex float x, integer n) { - _Complex float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -#ifdef _MSC_VER -static _Dcomplex zpow_ui(_Dcomplex x, integer n) { - _Dcomplex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; - for(u = n; ; ) { - if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; - if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; - else break; - } - } - _Dcomplex p = {pow._Val[0], pow._Val[1]}; - return p; -} -#else -static _Complex double zpow_ui(_Complex double x, integer n) { - _Complex double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -static integer pow_ii(integer x, integer n) { - integer pow; unsigned long int u; - if (n <= 0) { - if (n == 0 || x == 1) pow = 1; - else if (x != -1) pow = x == 0 ? 1/x : 0; - else n = -n; - } - if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { - u = n; - for(pow = 1; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static integer dmaxloc_(double *w, integer s, integer e, integer *n) -{ - double m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static integer smaxloc_(float *w, integer s, integer e, integer *n) -{ - float m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { - integer n = *n_, incx = *incx_, incy = *incy_, i; -#ifdef _MSC_VER - _Fcomplex zdotc = {0.0, 0.0}; - if (incx == 1 && incy == 1) { - for (i=0;i= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; #define z_abs(z) (cabs(Cd(z))) #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} @@ -258,250 +250,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; //#define mymaxloc_(w,s,e,n) {if (sizeof(*(w)) == sizeof(double)) dmaxloc_((w),*(s),*(e),n); else dmaxloc_((w),*(s),*(e),n);} #define mymaxloc(w,s,e,n) {dmaxloc_(w,*(s),*(e),n)} -/* procedure parameter types for -A and -C++ */ - -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef logical (*L_fp)(...); -#else -typedef logical (*L_fp)(); -#endif - -static float spow_ui(float x, integer n) { - float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static double dpow_ui(double x, integer n) { - double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#ifdef _MSC_VER -static _Fcomplex cpow_ui(complex x, integer n) { - complex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; - for(u = n; ; ) { - if(u & 01) pow.r *= x.r, pow.i *= x.i; - if(u >>= 1) x.r *= x.r, x.i *= x.i; - else break; - } - } - _Fcomplex p={pow.r, pow.i}; - return p; -} -#else -static _Complex float cpow_ui(_Complex float x, integer n) { - _Complex float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -#ifdef _MSC_VER -static _Dcomplex zpow_ui(_Dcomplex x, integer n) { - _Dcomplex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; - for(u = n; ; ) { - if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; - if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; - else break; - } - } - _Dcomplex p = {pow._Val[0], pow._Val[1]}; - return p; -} -#else -static _Complex double zpow_ui(_Complex double x, integer n) { - _Complex double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -static integer pow_ii(integer x, integer n) { - integer pow; unsigned long int u; - if (n <= 0) { - if (n == 0 || x == 1) pow = 1; - else if (x != -1) pow = x == 0 ? 1/x : 0; - else n = -n; - } - if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { - u = n; - for(pow = 1; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static integer dmaxloc_(double *w, integer s, integer e, integer *n) -{ - double m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static integer smaxloc_(float *w, integer s, integer e, integer *n) -{ - float m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { - integer n = *n_, incx = *incx_, incy = *incy_, i; -#ifdef _MSC_VER - _Fcomplex zdotc = {0.0, 0.0}; - if (incx == 1 && incy == 1) { - for (i=0;i= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; #define z_abs(z) (cabs(Cd(z))) #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} @@ -258,250 +250,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; //#define mymaxloc_(w,s,e,n) {if (sizeof(*(w)) == sizeof(double)) dmaxloc_((w),*(s),*(e),n); else dmaxloc_((w),*(s),*(e),n);} #define mymaxloc(w,s,e,n) {dmaxloc_(w,*(s),*(e),n)} -/* procedure parameter types for -A and -C++ */ - -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef logical (*L_fp)(...); -#else -typedef logical (*L_fp)(); -#endif - -static float spow_ui(float x, integer n) { - float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static double dpow_ui(double x, integer n) { - double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#ifdef _MSC_VER -static _Fcomplex cpow_ui(complex x, integer n) { - complex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; - for(u = n; ; ) { - if(u & 01) pow.r *= x.r, pow.i *= x.i; - if(u >>= 1) x.r *= x.r, x.i *= x.i; - else break; - } - } - _Fcomplex p={pow.r, pow.i}; - return p; -} -#else -static _Complex float cpow_ui(_Complex float x, integer n) { - _Complex float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -#ifdef _MSC_VER -static _Dcomplex zpow_ui(_Dcomplex x, integer n) { - _Dcomplex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; - for(u = n; ; ) { - if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; - if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; - else break; - } - } - _Dcomplex p = {pow._Val[0], pow._Val[1]}; - return p; -} -#else -static _Complex double zpow_ui(_Complex double x, integer n) { - _Complex double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -static integer pow_ii(integer x, integer n) { - integer pow; unsigned long int u; - if (n <= 0) { - if (n == 0 || x == 1) pow = 1; - else if (x != -1) pow = x == 0 ? 1/x : 0; - else n = -n; - } - if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { - u = n; - for(pow = 1; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static integer dmaxloc_(double *w, integer s, integer e, integer *n) -{ - double m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static integer smaxloc_(float *w, integer s, integer e, integer *n) -{ - float m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { - integer n = *n_, incx = *incx_, incy = *incy_, i; -#ifdef _MSC_VER - _Fcomplex zdotc = {0.0, 0.0}; - if (incx == 1 && incy == 1) { - for (i=0;i= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; #define z_abs(z) (cabs(Cd(z))) #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} @@ -258,250 +250,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; //#define mymaxloc_(w,s,e,n) {if (sizeof(*(w)) == sizeof(double)) dmaxloc_((w),*(s),*(e),n); else dmaxloc_((w),*(s),*(e),n);} #define mymaxloc(w,s,e,n) {dmaxloc_(w,*(s),*(e),n)} -/* procedure parameter types for -A and -C++ */ - -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef logical (*L_fp)(...); -#else -typedef logical (*L_fp)(); -#endif - -static float spow_ui(float x, integer n) { - float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static double dpow_ui(double x, integer n) { - double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#ifdef _MSC_VER -static _Fcomplex cpow_ui(complex x, integer n) { - complex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; - for(u = n; ; ) { - if(u & 01) pow.r *= x.r, pow.i *= x.i; - if(u >>= 1) x.r *= x.r, x.i *= x.i; - else break; - } - } - _Fcomplex p={pow.r, pow.i}; - return p; -} -#else -static _Complex float cpow_ui(_Complex float x, integer n) { - _Complex float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -#ifdef _MSC_VER -static _Dcomplex zpow_ui(_Dcomplex x, integer n) { - _Dcomplex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; - for(u = n; ; ) { - if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; - if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; - else break; - } - } - _Dcomplex p = {pow._Val[0], pow._Val[1]}; - return p; -} -#else -static _Complex double zpow_ui(_Complex double x, integer n) { - _Complex double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -static integer pow_ii(integer x, integer n) { - integer pow; unsigned long int u; - if (n <= 0) { - if (n == 0 || x == 1) pow = 1; - else if (x != -1) pow = x == 0 ? 1/x : 0; - else n = -n; - } - if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { - u = n; - for(pow = 1; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static integer dmaxloc_(double *w, integer s, integer e, integer *n) -{ - double m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static integer smaxloc_(float *w, integer s, integer e, integer *n) -{ - float m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { - integer n = *n_, incx = *incx_, incy = *incy_, i; -#ifdef _MSC_VER - _Fcomplex zdotc = {0.0, 0.0}; - if (incx == 1 && incy == 1) { - for (i=0;i= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; #define z_abs(z) (cabs(Cd(z))) #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} @@ -258,250 +247,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; //#define mymaxloc_(w,s,e,n) {if (sizeof(*(w)) == sizeof(double)) dmaxloc_((w),*(s),*(e),n); else dmaxloc_((w),*(s),*(e),n);} #define mymaxloc(w,s,e,n) {dmaxloc_(w,*(s),*(e),n)} -/* procedure parameter types for -A and -C++ */ - -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef logical (*L_fp)(...); -#else -typedef logical (*L_fp)(); -#endif - -static float spow_ui(float x, integer n) { - float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static double dpow_ui(double x, integer n) { - double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#ifdef _MSC_VER -static _Fcomplex cpow_ui(complex x, integer n) { - complex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; - for(u = n; ; ) { - if(u & 01) pow.r *= x.r, pow.i *= x.i; - if(u >>= 1) x.r *= x.r, x.i *= x.i; - else break; - } - } - _Fcomplex p={pow.r, pow.i}; - return p; -} -#else -static _Complex float cpow_ui(_Complex float x, integer n) { - _Complex float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -#ifdef _MSC_VER -static _Dcomplex zpow_ui(_Dcomplex x, integer n) { - _Dcomplex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; - for(u = n; ; ) { - if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; - if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; - else break; - } - } - _Dcomplex p = {pow._Val[0], pow._Val[1]}; - return p; -} -#else -static _Complex double zpow_ui(_Complex double x, integer n) { - _Complex double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -static integer pow_ii(integer x, integer n) { - integer pow; unsigned long int u; - if (n <= 0) { - if (n == 0 || x == 1) pow = 1; - else if (x != -1) pow = x == 0 ? 1/x : 0; - else n = -n; - } - if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { - u = n; - for(pow = 1; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static integer dmaxloc_(double *w, integer s, integer e, integer *n) -{ - double m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static integer smaxloc_(float *w, integer s, integer e, integer *n) -{ - float m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { - integer n = *n_, incx = *incx_, incy = *incy_, i; -#ifdef _MSC_VER - _Fcomplex zdotc = {0.0, 0.0}; - if (incx == 1 && incy == 1) { - for (i=0;i= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; #define z_abs(z) (cabs(Cd(z))) #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} @@ -258,250 +250,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; //#define mymaxloc_(w,s,e,n) {if (sizeof(*(w)) == sizeof(double)) dmaxloc_((w),*(s),*(e),n); else dmaxloc_((w),*(s),*(e),n);} #define mymaxloc(w,s,e,n) {dmaxloc_(w,*(s),*(e),n)} -/* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef logical (*L_fp)(...); -#else -typedef logical (*L_fp)(); -#endif - -static float spow_ui(float x, integer n) { - float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static double dpow_ui(double x, integer n) { - double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#ifdef _MSC_VER -static _Fcomplex cpow_ui(complex x, integer n) { - complex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; - for(u = n; ; ) { - if(u & 01) pow.r *= x.r, pow.i *= x.i; - if(u >>= 1) x.r *= x.r, x.i *= x.i; - else break; - } - } - _Fcomplex p={pow.r, pow.i}; - return p; -} -#else -static _Complex float cpow_ui(_Complex float x, integer n) { - _Complex float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -#ifdef _MSC_VER -static _Dcomplex zpow_ui(_Dcomplex x, integer n) { - _Dcomplex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; - for(u = n; ; ) { - if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; - if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; - else break; - } - } - _Dcomplex p = {pow._Val[0], pow._Val[1]}; - return p; -} -#else -static _Complex double zpow_ui(_Complex double x, integer n) { - _Complex double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -static integer pow_ii(integer x, integer n) { - integer pow; unsigned long int u; - if (n <= 0) { - if (n == 0 || x == 1) pow = 1; - else if (x != -1) pow = x == 0 ? 1/x : 0; - else n = -n; - } - if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { - u = n; - for(pow = 1; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static integer dmaxloc_(double *w, integer s, integer e, integer *n) -{ - double m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static integer smaxloc_(float *w, integer s, integer e, integer *n) -{ - float m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { - integer n = *n_, incx = *incx_, incy = *incy_, i; -#ifdef _MSC_VER - _Fcomplex zdotc = {0.0, 0.0}; - if (incx == 1 && incy == 1) { - for (i=0;i= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; #define z_abs(z) (cabs(Cd(z))) #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} @@ -258,250 +250,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; //#define mymaxloc_(w,s,e,n) {if (sizeof(*(w)) == sizeof(double)) dmaxloc_((w),*(s),*(e),n); else dmaxloc_((w),*(s),*(e),n);} #define mymaxloc(w,s,e,n) {dmaxloc_(w,*(s),*(e),n)} -/* procedure parameter types for -A and -C++ */ - -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef logical (*L_fp)(...); -#else -typedef logical (*L_fp)(); -#endif - -static float spow_ui(float x, integer n) { - float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static double dpow_ui(double x, integer n) { - double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#ifdef _MSC_VER -static _Fcomplex cpow_ui(complex x, integer n) { - complex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; - for(u = n; ; ) { - if(u & 01) pow.r *= x.r, pow.i *= x.i; - if(u >>= 1) x.r *= x.r, x.i *= x.i; - else break; - } - } - _Fcomplex p={pow.r, pow.i}; - return p; -} -#else -static _Complex float cpow_ui(_Complex float x, integer n) { - _Complex float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -#ifdef _MSC_VER -static _Dcomplex zpow_ui(_Dcomplex x, integer n) { - _Dcomplex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; - for(u = n; ; ) { - if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; - if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; - else break; - } - } - _Dcomplex p = {pow._Val[0], pow._Val[1]}; - return p; -} -#else -static _Complex double zpow_ui(_Complex double x, integer n) { - _Complex double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -static integer pow_ii(integer x, integer n) { - integer pow; unsigned long int u; - if (n <= 0) { - if (n == 0 || x == 1) pow = 1; - else if (x != -1) pow = x == 0 ? 1/x : 0; - else n = -n; - } - if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { - u = n; - for(pow = 1; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static integer dmaxloc_(double *w, integer s, integer e, integer *n) -{ - double m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static integer smaxloc_(float *w, integer s, integer e, integer *n) -{ - float m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { - integer n = *n_, incx = *incx_, incy = *incy_, i; -#ifdef _MSC_VER - _Fcomplex zdotc = {0.0, 0.0}; - if (incx == 1 && incy == 1) { - for (i=0;i= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; #define z_abs(z) (cabs(Cd(z))) #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} @@ -258,250 +250,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; //#define mymaxloc_(w,s,e,n) {if (sizeof(*(w)) == sizeof(double)) dmaxloc_((w),*(s),*(e),n); else dmaxloc_((w),*(s),*(e),n);} #define mymaxloc(w,s,e,n) {dmaxloc_(w,*(s),*(e),n)} -/* procedure parameter types for -A and -C++ */ - -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef logical (*L_fp)(...); -#else -typedef logical (*L_fp)(); -#endif - -static float spow_ui(float x, integer n) { - float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static double dpow_ui(double x, integer n) { - double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#ifdef _MSC_VER -static _Fcomplex cpow_ui(complex x, integer n) { - complex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; - for(u = n; ; ) { - if(u & 01) pow.r *= x.r, pow.i *= x.i; - if(u >>= 1) x.r *= x.r, x.i *= x.i; - else break; - } - } - _Fcomplex p={pow.r, pow.i}; - return p; -} -#else -static _Complex float cpow_ui(_Complex float x, integer n) { - _Complex float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -#ifdef _MSC_VER -static _Dcomplex zpow_ui(_Dcomplex x, integer n) { - _Dcomplex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; - for(u = n; ; ) { - if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; - if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; - else break; - } - } - _Dcomplex p = {pow._Val[0], pow._Val[1]}; - return p; -} -#else -static _Complex double zpow_ui(_Complex double x, integer n) { - _Complex double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -static integer pow_ii(integer x, integer n) { - integer pow; unsigned long int u; - if (n <= 0) { - if (n == 0 || x == 1) pow = 1; - else if (x != -1) pow = x == 0 ? 1/x : 0; - else n = -n; - } - if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { - u = n; - for(pow = 1; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static integer dmaxloc_(double *w, integer s, integer e, integer *n) -{ - double m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static integer smaxloc_(float *w, integer s, integer e, integer *n) -{ - float m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { - integer n = *n_, incx = *incx_, incy = *incy_, i; -#ifdef _MSC_VER - _Fcomplex zdotc = {0.0, 0.0}; - if (incx == 1 && incy == 1) { - for (i=0;i= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; #define z_abs(z) (cabs(Cd(z))) #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} @@ -258,250 +251,19 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; //#define mymaxloc_(w,s,e,n) {if (sizeof(*(w)) == sizeof(double)) dmaxloc_((w),*(s),*(e),n); else dmaxloc_((w),*(s),*(e),n);} #define mymaxloc(w,s,e,n) {dmaxloc_(w,*(s),*(e),n)} -/* procedure parameter types for -A and -C++ */ - -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef logical (*L_fp)(...); -#else -typedef logical (*L_fp)(); -#endif - static float spow_ui(float x, integer n) { - float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static double dpow_ui(double x, integer n) { - double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#ifdef _MSC_VER -static _Fcomplex cpow_ui(complex x, integer n) { - complex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; - for(u = n; ; ) { - if(u & 01) pow.r *= x.r, pow.i *= x.i; - if(u >>= 1) x.r *= x.r, x.i *= x.i; - else break; - } - } - _Fcomplex p={pow.r, pow.i}; - return p; -} -#else -static _Complex float cpow_ui(_Complex float x, integer n) { - _Complex float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -#ifdef _MSC_VER -static _Dcomplex zpow_ui(_Dcomplex x, integer n) { - _Dcomplex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; - for(u = n; ; ) { - if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; - if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; - else break; - } - } - _Dcomplex p = {pow._Val[0], pow._Val[1]}; - return p; -} -#else -static _Complex double zpow_ui(_Complex double x, integer n) { - _Complex double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -static integer pow_ii(integer x, integer n) { - integer pow; unsigned long int u; - if (n <= 0) { - if (n == 0 || x == 1) pow = 1; - else if (x != -1) pow = x == 0 ? 1/x : 0; - else n = -n; - } - if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { - u = n; - for(pow = 1; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static integer dmaxloc_(double *w, integer s, integer e, integer *n) -{ - double m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static integer smaxloc_(float *w, integer s, integer e, integer *n) -{ - float m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; + float pow=1.0; unsigned long int u; + if(n != 0) { + if(n < 0) n = -n, x = 1/x; + for(u = n; ; ) { + if(u & 01) pow *= x; + if(u >>= 1) x *= x; + else break; + } + } + return pow; } -static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { - integer n = *n_, incx = *incx_, incy = *incy_, i; -#ifdef _MSC_VER - _Fcomplex zdotc = {0.0, 0.0}; - if (incx == 1 && incy == 1) { - for (i=0;i= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; #define z_abs(z) (cabs(Cd(z))) #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} @@ -260,248 +252,13 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else typedef logical (*L_fp)(); #endif -static float spow_ui(float x, integer n) { - float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static double dpow_ui(double x, integer n) { - double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#ifdef _MSC_VER -static _Fcomplex cpow_ui(complex x, integer n) { - complex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; - for(u = n; ; ) { - if(u & 01) pow.r *= x.r, pow.i *= x.i; - if(u >>= 1) x.r *= x.r, x.i *= x.i; - else break; - } - } - _Fcomplex p={pow.r, pow.i}; - return p; -} -#else -static _Complex float cpow_ui(_Complex float x, integer n) { - _Complex float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -#ifdef _MSC_VER -static _Dcomplex zpow_ui(_Dcomplex x, integer n) { - _Dcomplex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; - for(u = n; ; ) { - if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; - if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; - else break; - } - } - _Dcomplex p = {pow._Val[0], pow._Val[1]}; - return p; -} -#else -static _Complex double zpow_ui(_Complex double x, integer n) { - _Complex double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -static integer pow_ii(integer x, integer n) { - integer pow; unsigned long int u; - if (n <= 0) { - if (n == 0 || x == 1) pow = 1; - else if (x != -1) pow = x == 0 ? 1/x : 0; - else n = -n; - } - if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { - u = n; - for(pow = 1; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static integer dmaxloc_(double *w, integer s, integer e, integer *n) -{ - double m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static integer smaxloc_(float *w, integer s, integer e, integer *n) -{ - float m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { - integer n = *n_, incx = *incx_, incy = *incy_, i; -#ifdef _MSC_VER - _Fcomplex zdotc = {0.0, 0.0}; - if (incx == 1 && incy == 1) { - for (i=0;i= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; #define z_abs(z) (cabs(Cd(z))) #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} @@ -260,248 +252,13 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else typedef logical (*L_fp)(); #endif -static float spow_ui(float x, integer n) { - float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static double dpow_ui(double x, integer n) { - double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#ifdef _MSC_VER -static _Fcomplex cpow_ui(complex x, integer n) { - complex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; - for(u = n; ; ) { - if(u & 01) pow.r *= x.r, pow.i *= x.i; - if(u >>= 1) x.r *= x.r, x.i *= x.i; - else break; - } - } - _Fcomplex p={pow.r, pow.i}; - return p; -} -#else -static _Complex float cpow_ui(_Complex float x, integer n) { - _Complex float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -#ifdef _MSC_VER -static _Dcomplex zpow_ui(_Dcomplex x, integer n) { - _Dcomplex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; - for(u = n; ; ) { - if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; - if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; - else break; - } - } - _Dcomplex p = {pow._Val[0], pow._Val[1]}; - return p; -} -#else -static _Complex double zpow_ui(_Complex double x, integer n) { - _Complex double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -static integer pow_ii(integer x, integer n) { - integer pow; unsigned long int u; - if (n <= 0) { - if (n == 0 || x == 1) pow = 1; - else if (x != -1) pow = x == 0 ? 1/x : 0; - else n = -n; - } - if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { - u = n; - for(pow = 1; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static integer dmaxloc_(double *w, integer s, integer e, integer *n) -{ - double m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static integer smaxloc_(float *w, integer s, integer e, integer *n) -{ - float m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { - integer n = *n_, incx = *incx_, incy = *incy_, i; -#ifdef _MSC_VER - _Fcomplex zdotc = {0.0, 0.0}; - if (incx == 1 && incy == 1) { - for (i=0;i= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; #define z_abs(z) (cabs(Cd(z))) #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} @@ -260,248 +252,13 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else typedef logical (*L_fp)(); #endif -static float spow_ui(float x, integer n) { - float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static double dpow_ui(double x, integer n) { - double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#ifdef _MSC_VER -static _Fcomplex cpow_ui(complex x, integer n) { - complex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; - for(u = n; ; ) { - if(u & 01) pow.r *= x.r, pow.i *= x.i; - if(u >>= 1) x.r *= x.r, x.i *= x.i; - else break; - } - } - _Fcomplex p={pow.r, pow.i}; - return p; -} -#else -static _Complex float cpow_ui(_Complex float x, integer n) { - _Complex float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -#ifdef _MSC_VER -static _Dcomplex zpow_ui(_Dcomplex x, integer n) { - _Dcomplex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; - for(u = n; ; ) { - if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; - if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; - else break; - } - } - _Dcomplex p = {pow._Val[0], pow._Val[1]}; - return p; -} -#else -static _Complex double zpow_ui(_Complex double x, integer n) { - _Complex double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -static integer pow_ii(integer x, integer n) { - integer pow; unsigned long int u; - if (n <= 0) { - if (n == 0 || x == 1) pow = 1; - else if (x != -1) pow = x == 0 ? 1/x : 0; - else n = -n; - } - if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { - u = n; - for(pow = 1; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static integer dmaxloc_(double *w, integer s, integer e, integer *n) -{ - double m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static integer smaxloc_(float *w, integer s, integer e, integer *n) -{ - float m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { - integer n = *n_, incx = *incx_, incy = *incy_, i; -#ifdef _MSC_VER - _Fcomplex zdotc = {0.0, 0.0}; - if (incx == 1 && incy == 1) { - for (i=0;i= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; #define z_abs(z) (cabs(Cd(z))) #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} @@ -258,250 +250,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; //#define mymaxloc_(w,s,e,n) {if (sizeof(*(w)) == sizeof(double)) dmaxloc_((w),*(s),*(e),n); else dmaxloc_((w),*(s),*(e),n);} #define mymaxloc(w,s,e,n) {dmaxloc_(w,*(s),*(e),n)} -/* procedure parameter types for -A and -C++ */ - -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef logical (*L_fp)(...); -#else -typedef logical (*L_fp)(); -#endif - -static float spow_ui(float x, integer n) { - float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static double dpow_ui(double x, integer n) { - double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#ifdef _MSC_VER -static _Fcomplex cpow_ui(complex x, integer n) { - complex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; - for(u = n; ; ) { - if(u & 01) pow.r *= x.r, pow.i *= x.i; - if(u >>= 1) x.r *= x.r, x.i *= x.i; - else break; - } - } - _Fcomplex p={pow.r, pow.i}; - return p; -} -#else -static _Complex float cpow_ui(_Complex float x, integer n) { - _Complex float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -#ifdef _MSC_VER -static _Dcomplex zpow_ui(_Dcomplex x, integer n) { - _Dcomplex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; - for(u = n; ; ) { - if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; - if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; - else break; - } - } - _Dcomplex p = {pow._Val[0], pow._Val[1]}; - return p; -} -#else -static _Complex double zpow_ui(_Complex double x, integer n) { - _Complex double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -static integer pow_ii(integer x, integer n) { - integer pow; unsigned long int u; - if (n <= 0) { - if (n == 0 || x == 1) pow = 1; - else if (x != -1) pow = x == 0 ? 1/x : 0; - else n = -n; - } - if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { - u = n; - for(pow = 1; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static integer dmaxloc_(double *w, integer s, integer e, integer *n) -{ - double m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static integer smaxloc_(float *w, integer s, integer e, integer *n) -{ - float m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { - integer n = *n_, incx = *incx_, incy = *incy_, i; -#ifdef _MSC_VER - _Fcomplex zdotc = {0.0, 0.0}; - if (incx == 1 && incy == 1) { - for (i=0;i= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; #define z_abs(z) (cabs(Cd(z))) #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} @@ -258,250 +250,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; //#define mymaxloc_(w,s,e,n) {if (sizeof(*(w)) == sizeof(double)) dmaxloc_((w),*(s),*(e),n); else dmaxloc_((w),*(s),*(e),n);} #define mymaxloc(w,s,e,n) {dmaxloc_(w,*(s),*(e),n)} -/* procedure parameter types for -A and -C++ */ - -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef logical (*L_fp)(...); -#else -typedef logical (*L_fp)(); -#endif - -static float spow_ui(float x, integer n) { - float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static double dpow_ui(double x, integer n) { - double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#ifdef _MSC_VER -static _Fcomplex cpow_ui(complex x, integer n) { - complex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; - for(u = n; ; ) { - if(u & 01) pow.r *= x.r, pow.i *= x.i; - if(u >>= 1) x.r *= x.r, x.i *= x.i; - else break; - } - } - _Fcomplex p={pow.r, pow.i}; - return p; -} -#else -static _Complex float cpow_ui(_Complex float x, integer n) { - _Complex float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -#ifdef _MSC_VER -static _Dcomplex zpow_ui(_Dcomplex x, integer n) { - _Dcomplex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; - for(u = n; ; ) { - if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; - if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; - else break; - } - } - _Dcomplex p = {pow._Val[0], pow._Val[1]}; - return p; -} -#else -static _Complex double zpow_ui(_Complex double x, integer n) { - _Complex double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -static integer pow_ii(integer x, integer n) { - integer pow; unsigned long int u; - if (n <= 0) { - if (n == 0 || x == 1) pow = 1; - else if (x != -1) pow = x == 0 ? 1/x : 0; - else n = -n; - } - if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { - u = n; - for(pow = 1; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static integer dmaxloc_(double *w, integer s, integer e, integer *n) -{ - double m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static integer smaxloc_(float *w, integer s, integer e, integer *n) -{ - float m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { - integer n = *n_, incx = *incx_, incy = *incy_, i; -#ifdef _MSC_VER - _Fcomplex zdotc = {0.0, 0.0}; - if (incx == 1 && incy == 1) { - for (i=0;i= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; #define z_abs(z) (cabs(Cd(z))) #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} @@ -258,250 +250,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; //#define mymaxloc_(w,s,e,n) {if (sizeof(*(w)) == sizeof(double)) dmaxloc_((w),*(s),*(e),n); else dmaxloc_((w),*(s),*(e),n);} #define mymaxloc(w,s,e,n) {dmaxloc_(w,*(s),*(e),n)} -/* procedure parameter types for -A and -C++ */ - -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef logical (*L_fp)(...); -#else -typedef logical (*L_fp)(); -#endif - -static float spow_ui(float x, integer n) { - float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static double dpow_ui(double x, integer n) { - double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#ifdef _MSC_VER -static _Fcomplex cpow_ui(complex x, integer n) { - complex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; - for(u = n; ; ) { - if(u & 01) pow.r *= x.r, pow.i *= x.i; - if(u >>= 1) x.r *= x.r, x.i *= x.i; - else break; - } - } - _Fcomplex p={pow.r, pow.i}; - return p; -} -#else -static _Complex float cpow_ui(_Complex float x, integer n) { - _Complex float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -#ifdef _MSC_VER -static _Dcomplex zpow_ui(_Dcomplex x, integer n) { - _Dcomplex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; - for(u = n; ; ) { - if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; - if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; - else break; - } - } - _Dcomplex p = {pow._Val[0], pow._Val[1]}; - return p; -} -#else -static _Complex double zpow_ui(_Complex double x, integer n) { - _Complex double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -static integer pow_ii(integer x, integer n) { - integer pow; unsigned long int u; - if (n <= 0) { - if (n == 0 || x == 1) pow = 1; - else if (x != -1) pow = x == 0 ? 1/x : 0; - else n = -n; - } - if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { - u = n; - for(pow = 1; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static integer dmaxloc_(double *w, integer s, integer e, integer *n) -{ - double m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static integer smaxloc_(float *w, integer s, integer e, integer *n) -{ - float m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { - integer n = *n_, incx = *incx_, incy = *incy_, i; -#ifdef _MSC_VER - _Fcomplex zdotc = {0.0, 0.0}; - if (incx == 1 && incy == 1) { - for (i=0;i= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; #define z_abs(z) (cabs(Cd(z))) #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} @@ -258,250 +250,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; //#define mymaxloc_(w,s,e,n) {if (sizeof(*(w)) == sizeof(double)) dmaxloc_((w),*(s),*(e),n); else dmaxloc_((w),*(s),*(e),n);} #define mymaxloc(w,s,e,n) {dmaxloc_(w,*(s),*(e),n)} -/* procedure parameter types for -A and -C++ */ - -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef logical (*L_fp)(...); -#else -typedef logical (*L_fp)(); -#endif - -static float spow_ui(float x, integer n) { - float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static double dpow_ui(double x, integer n) { - double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#ifdef _MSC_VER -static _Fcomplex cpow_ui(complex x, integer n) { - complex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; - for(u = n; ; ) { - if(u & 01) pow.r *= x.r, pow.i *= x.i; - if(u >>= 1) x.r *= x.r, x.i *= x.i; - else break; - } - } - _Fcomplex p={pow.r, pow.i}; - return p; -} -#else -static _Complex float cpow_ui(_Complex float x, integer n) { - _Complex float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -#ifdef _MSC_VER -static _Dcomplex zpow_ui(_Dcomplex x, integer n) { - _Dcomplex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; - for(u = n; ; ) { - if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; - if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; - else break; - } - } - _Dcomplex p = {pow._Val[0], pow._Val[1]}; - return p; -} -#else -static _Complex double zpow_ui(_Complex double x, integer n) { - _Complex double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -static integer pow_ii(integer x, integer n) { - integer pow; unsigned long int u; - if (n <= 0) { - if (n == 0 || x == 1) pow = 1; - else if (x != -1) pow = x == 0 ? 1/x : 0; - else n = -n; - } - if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { - u = n; - for(pow = 1; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static integer dmaxloc_(double *w, integer s, integer e, integer *n) -{ - double m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static integer smaxloc_(float *w, integer s, integer e, integer *n) -{ - float m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { - integer n = *n_, incx = *incx_, incy = *incy_, i; -#ifdef _MSC_VER - _Fcomplex zdotc = {0.0, 0.0}; - if (incx == 1 && incy == 1) { - for (i=0;i= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; #define z_abs(z) (cabs(Cd(z))) #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} @@ -258,250 +250,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; //#define mymaxloc_(w,s,e,n) {if (sizeof(*(w)) == sizeof(double)) dmaxloc_((w),*(s),*(e),n); else dmaxloc_((w),*(s),*(e),n);} #define mymaxloc(w,s,e,n) {dmaxloc_(w,*(s),*(e),n)} -/* procedure parameter types for -A and -C++ */ - -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef logical (*L_fp)(...); -#else -typedef logical (*L_fp)(); -#endif - -static float spow_ui(float x, integer n) { - float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static double dpow_ui(double x, integer n) { - double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#ifdef _MSC_VER -static _Fcomplex cpow_ui(complex x, integer n) { - complex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; - for(u = n; ; ) { - if(u & 01) pow.r *= x.r, pow.i *= x.i; - if(u >>= 1) x.r *= x.r, x.i *= x.i; - else break; - } - } - _Fcomplex p={pow.r, pow.i}; - return p; -} -#else -static _Complex float cpow_ui(_Complex float x, integer n) { - _Complex float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -#ifdef _MSC_VER -static _Dcomplex zpow_ui(_Dcomplex x, integer n) { - _Dcomplex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; - for(u = n; ; ) { - if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; - if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; - else break; - } - } - _Dcomplex p = {pow._Val[0], pow._Val[1]}; - return p; -} -#else -static _Complex double zpow_ui(_Complex double x, integer n) { - _Complex double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -static integer pow_ii(integer x, integer n) { - integer pow; unsigned long int u; - if (n <= 0) { - if (n == 0 || x == 1) pow = 1; - else if (x != -1) pow = x == 0 ? 1/x : 0; - else n = -n; - } - if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { - u = n; - for(pow = 1; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static integer dmaxloc_(double *w, integer s, integer e, integer *n) -{ - double m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static integer smaxloc_(float *w, integer s, integer e, integer *n) -{ - float m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { - integer n = *n_, incx = *incx_, incy = *incy_, i; -#ifdef _MSC_VER - _Fcomplex zdotc = {0.0, 0.0}; - if (incx == 1 && incy == 1) { - for (i=0;i= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; #define z_abs(z) (cabs(Cd(z))) #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} @@ -258,250 +250,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; //#define mymaxloc_(w,s,e,n) {if (sizeof(*(w)) == sizeof(double)) dmaxloc_((w),*(s),*(e),n); else dmaxloc_((w),*(s),*(e),n);} #define mymaxloc(w,s,e,n) {dmaxloc_(w,*(s),*(e),n)} -/* procedure parameter types for -A and -C++ */ - -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef logical (*L_fp)(...); -#else -typedef logical (*L_fp)(); -#endif - -static float spow_ui(float x, integer n) { - float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static double dpow_ui(double x, integer n) { - double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#ifdef _MSC_VER -static _Fcomplex cpow_ui(complex x, integer n) { - complex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; - for(u = n; ; ) { - if(u & 01) pow.r *= x.r, pow.i *= x.i; - if(u >>= 1) x.r *= x.r, x.i *= x.i; - else break; - } - } - _Fcomplex p={pow.r, pow.i}; - return p; -} -#else -static _Complex float cpow_ui(_Complex float x, integer n) { - _Complex float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -#ifdef _MSC_VER -static _Dcomplex zpow_ui(_Dcomplex x, integer n) { - _Dcomplex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; - for(u = n; ; ) { - if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; - if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; - else break; - } - } - _Dcomplex p = {pow._Val[0], pow._Val[1]}; - return p; -} -#else -static _Complex double zpow_ui(_Complex double x, integer n) { - _Complex double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -static integer pow_ii(integer x, integer n) { - integer pow; unsigned long int u; - if (n <= 0) { - if (n == 0 || x == 1) pow = 1; - else if (x != -1) pow = x == 0 ? 1/x : 0; - else n = -n; - } - if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { - u = n; - for(pow = 1; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static integer dmaxloc_(double *w, integer s, integer e, integer *n) -{ - double m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static integer smaxloc_(float *w, integer s, integer e, integer *n) -{ - float m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { - integer n = *n_, incx = *incx_, incy = *incy_, i; -#ifdef _MSC_VER - _Fcomplex zdotc = {0.0, 0.0}; - if (incx == 1 && incy == 1) { - for (i=0;i= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; #define z_abs(z) (cabs(Cd(z))) #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} @@ -258,250 +250,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; //#define mymaxloc_(w,s,e,n) {if (sizeof(*(w)) == sizeof(double)) dmaxloc_((w),*(s),*(e),n); else dmaxloc_((w),*(s),*(e),n);} #define mymaxloc(w,s,e,n) {dmaxloc_(w,*(s),*(e),n)} -/* procedure parameter types for -A and -C++ */ - -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef logical (*L_fp)(...); -#else -typedef logical (*L_fp)(); -#endif - -static float spow_ui(float x, integer n) { - float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static double dpow_ui(double x, integer n) { - double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#ifdef _MSC_VER -static _Fcomplex cpow_ui(complex x, integer n) { - complex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; - for(u = n; ; ) { - if(u & 01) pow.r *= x.r, pow.i *= x.i; - if(u >>= 1) x.r *= x.r, x.i *= x.i; - else break; - } - } - _Fcomplex p={pow.r, pow.i}; - return p; -} -#else -static _Complex float cpow_ui(_Complex float x, integer n) { - _Complex float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -#ifdef _MSC_VER -static _Dcomplex zpow_ui(_Dcomplex x, integer n) { - _Dcomplex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; - for(u = n; ; ) { - if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; - if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; - else break; - } - } - _Dcomplex p = {pow._Val[0], pow._Val[1]}; - return p; -} -#else -static _Complex double zpow_ui(_Complex double x, integer n) { - _Complex double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -static integer pow_ii(integer x, integer n) { - integer pow; unsigned long int u; - if (n <= 0) { - if (n == 0 || x == 1) pow = 1; - else if (x != -1) pow = x == 0 ? 1/x : 0; - else n = -n; - } - if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { - u = n; - for(pow = 1; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static integer dmaxloc_(double *w, integer s, integer e, integer *n) -{ - double m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static integer smaxloc_(float *w, integer s, integer e, integer *n) -{ - float m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { - integer n = *n_, incx = *incx_, incy = *incy_, i; -#ifdef _MSC_VER - _Fcomplex zdotc = {0.0, 0.0}; - if (incx == 1 && incy == 1) { - for (i=0;i= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; #define z_abs(z) (cabs(Cd(z))) #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} @@ -258,250 +250,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; //#define mymaxloc_(w,s,e,n) {if (sizeof(*(w)) == sizeof(double)) dmaxloc_((w),*(s),*(e),n); else dmaxloc_((w),*(s),*(e),n);} #define mymaxloc(w,s,e,n) {dmaxloc_(w,*(s),*(e),n)} -/* procedure parameter types for -A and -C++ */ - -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef logical (*L_fp)(...); -#else -typedef logical (*L_fp)(); -#endif - -static float spow_ui(float x, integer n) { - float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static double dpow_ui(double x, integer n) { - double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#ifdef _MSC_VER -static _Fcomplex cpow_ui(complex x, integer n) { - complex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; - for(u = n; ; ) { - if(u & 01) pow.r *= x.r, pow.i *= x.i; - if(u >>= 1) x.r *= x.r, x.i *= x.i; - else break; - } - } - _Fcomplex p={pow.r, pow.i}; - return p; -} -#else -static _Complex float cpow_ui(_Complex float x, integer n) { - _Complex float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -#ifdef _MSC_VER -static _Dcomplex zpow_ui(_Dcomplex x, integer n) { - _Dcomplex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; - for(u = n; ; ) { - if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; - if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; - else break; - } - } - _Dcomplex p = {pow._Val[0], pow._Val[1]}; - return p; -} -#else -static _Complex double zpow_ui(_Complex double x, integer n) { - _Complex double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -static integer pow_ii(integer x, integer n) { - integer pow; unsigned long int u; - if (n <= 0) { - if (n == 0 || x == 1) pow = 1; - else if (x != -1) pow = x == 0 ? 1/x : 0; - else n = -n; - } - if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { - u = n; - for(pow = 1; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static integer dmaxloc_(double *w, integer s, integer e, integer *n) -{ - double m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static integer smaxloc_(float *w, integer s, integer e, integer *n) -{ - float m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { - integer n = *n_, incx = *incx_, incy = *incy_, i; -#ifdef _MSC_VER - _Fcomplex zdotc = {0.0, 0.0}; - if (incx == 1 && incy == 1) { - for (i=0;i= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; #define z_abs(z) (cabs(Cd(z))) #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} @@ -258,250 +250,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; //#define mymaxloc_(w,s,e,n) {if (sizeof(*(w)) == sizeof(double)) dmaxloc_((w),*(s),*(e),n); else dmaxloc_((w),*(s),*(e),n);} #define mymaxloc(w,s,e,n) {dmaxloc_(w,*(s),*(e),n)} -/* procedure parameter types for -A and -C++ */ - -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef logical (*L_fp)(...); -#else -typedef logical (*L_fp)(); -#endif - -static float spow_ui(float x, integer n) { - float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static double dpow_ui(double x, integer n) { - double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#ifdef _MSC_VER -static _Fcomplex cpow_ui(complex x, integer n) { - complex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; - for(u = n; ; ) { - if(u & 01) pow.r *= x.r, pow.i *= x.i; - if(u >>= 1) x.r *= x.r, x.i *= x.i; - else break; - } - } - _Fcomplex p={pow.r, pow.i}; - return p; -} -#else -static _Complex float cpow_ui(_Complex float x, integer n) { - _Complex float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -#ifdef _MSC_VER -static _Dcomplex zpow_ui(_Dcomplex x, integer n) { - _Dcomplex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; - for(u = n; ; ) { - if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; - if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; - else break; - } - } - _Dcomplex p = {pow._Val[0], pow._Val[1]}; - return p; -} -#else -static _Complex double zpow_ui(_Complex double x, integer n) { - _Complex double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -static integer pow_ii(integer x, integer n) { - integer pow; unsigned long int u; - if (n <= 0) { - if (n == 0 || x == 1) pow = 1; - else if (x != -1) pow = x == 0 ? 1/x : 0; - else n = -n; - } - if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { - u = n; - for(pow = 1; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static integer dmaxloc_(double *w, integer s, integer e, integer *n) -{ - double m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static integer smaxloc_(float *w, integer s, integer e, integer *n) -{ - float m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { - integer n = *n_, incx = *incx_, incy = *incy_, i; -#ifdef _MSC_VER - _Fcomplex zdotc = {0.0, 0.0}; - if (incx == 1 && incy == 1) { - for (i=0;i= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; #define z_abs(z) (cabs(Cd(z))) #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} @@ -258,250 +250,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; //#define mymaxloc_(w,s,e,n) {if (sizeof(*(w)) == sizeof(double)) dmaxloc_((w),*(s),*(e),n); else dmaxloc_((w),*(s),*(e),n);} #define mymaxloc(w,s,e,n) {dmaxloc_(w,*(s),*(e),n)} -/* procedure parameter types for -A and -C++ */ - -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef logical (*L_fp)(...); -#else -typedef logical (*L_fp)(); -#endif - -static float spow_ui(float x, integer n) { - float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static double dpow_ui(double x, integer n) { - double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#ifdef _MSC_VER -static _Fcomplex cpow_ui(complex x, integer n) { - complex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; - for(u = n; ; ) { - if(u & 01) pow.r *= x.r, pow.i *= x.i; - if(u >>= 1) x.r *= x.r, x.i *= x.i; - else break; - } - } - _Fcomplex p={pow.r, pow.i}; - return p; -} -#else -static _Complex float cpow_ui(_Complex float x, integer n) { - _Complex float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -#ifdef _MSC_VER -static _Dcomplex zpow_ui(_Dcomplex x, integer n) { - _Dcomplex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; - for(u = n; ; ) { - if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; - if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; - else break; - } - } - _Dcomplex p = {pow._Val[0], pow._Val[1]}; - return p; -} -#else -static _Complex double zpow_ui(_Complex double x, integer n) { - _Complex double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -static integer pow_ii(integer x, integer n) { - integer pow; unsigned long int u; - if (n <= 0) { - if (n == 0 || x == 1) pow = 1; - else if (x != -1) pow = x == 0 ? 1/x : 0; - else n = -n; - } - if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { - u = n; - for(pow = 1; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static integer dmaxloc_(double *w, integer s, integer e, integer *n) -{ - double m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static integer smaxloc_(float *w, integer s, integer e, integer *n) -{ - float m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { - integer n = *n_, incx = *incx_, incy = *incy_, i; -#ifdef _MSC_VER - _Fcomplex zdotc = {0.0, 0.0}; - if (incx == 1 && incy == 1) { - for (i=0;i= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; #define z_abs(z) (cabs(Cd(z))) #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} @@ -258,250 +250,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; //#define mymaxloc_(w,s,e,n) {if (sizeof(*(w)) == sizeof(double)) dmaxloc_((w),*(s),*(e),n); else dmaxloc_((w),*(s),*(e),n);} #define mymaxloc(w,s,e,n) {dmaxloc_(w,*(s),*(e),n)} -/* procedure parameter types for -A and -C++ */ - -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef logical (*L_fp)(...); -#else -typedef logical (*L_fp)(); -#endif - -static float spow_ui(float x, integer n) { - float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static double dpow_ui(double x, integer n) { - double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#ifdef _MSC_VER -static _Fcomplex cpow_ui(complex x, integer n) { - complex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; - for(u = n; ; ) { - if(u & 01) pow.r *= x.r, pow.i *= x.i; - if(u >>= 1) x.r *= x.r, x.i *= x.i; - else break; - } - } - _Fcomplex p={pow.r, pow.i}; - return p; -} -#else -static _Complex float cpow_ui(_Complex float x, integer n) { - _Complex float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -#ifdef _MSC_VER -static _Dcomplex zpow_ui(_Dcomplex x, integer n) { - _Dcomplex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; - for(u = n; ; ) { - if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; - if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; - else break; - } - } - _Dcomplex p = {pow._Val[0], pow._Val[1]}; - return p; -} -#else -static _Complex double zpow_ui(_Complex double x, integer n) { - _Complex double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -static integer pow_ii(integer x, integer n) { - integer pow; unsigned long int u; - if (n <= 0) { - if (n == 0 || x == 1) pow = 1; - else if (x != -1) pow = x == 0 ? 1/x : 0; - else n = -n; - } - if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { - u = n; - for(pow = 1; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static integer dmaxloc_(double *w, integer s, integer e, integer *n) -{ - double m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static integer smaxloc_(float *w, integer s, integer e, integer *n) -{ - float m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { - integer n = *n_, incx = *incx_, incy = *incy_, i; -#ifdef _MSC_VER - _Fcomplex zdotc = {0.0, 0.0}; - if (incx == 1 && incy == 1) { - for (i=0;i= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; #define z_abs(z) (cabs(Cd(z))) #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} @@ -258,250 +250,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; //#define mymaxloc_(w,s,e,n) {if (sizeof(*(w)) == sizeof(double)) dmaxloc_((w),*(s),*(e),n); else dmaxloc_((w),*(s),*(e),n);} #define mymaxloc(w,s,e,n) {dmaxloc_(w,*(s),*(e),n)} -/* procedure parameter types for -A and -C++ */ - -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef logical (*L_fp)(...); -#else -typedef logical (*L_fp)(); -#endif - -static float spow_ui(float x, integer n) { - float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static double dpow_ui(double x, integer n) { - double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#ifdef _MSC_VER -static _Fcomplex cpow_ui(complex x, integer n) { - complex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; - for(u = n; ; ) { - if(u & 01) pow.r *= x.r, pow.i *= x.i; - if(u >>= 1) x.r *= x.r, x.i *= x.i; - else break; - } - } - _Fcomplex p={pow.r, pow.i}; - return p; -} -#else -static _Complex float cpow_ui(_Complex float x, integer n) { - _Complex float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -#ifdef _MSC_VER -static _Dcomplex zpow_ui(_Dcomplex x, integer n) { - _Dcomplex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; - for(u = n; ; ) { - if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; - if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; - else break; - } - } - _Dcomplex p = {pow._Val[0], pow._Val[1]}; - return p; -} -#else -static _Complex double zpow_ui(_Complex double x, integer n) { - _Complex double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -static integer pow_ii(integer x, integer n) { - integer pow; unsigned long int u; - if (n <= 0) { - if (n == 0 || x == 1) pow = 1; - else if (x != -1) pow = x == 0 ? 1/x : 0; - else n = -n; - } - if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { - u = n; - for(pow = 1; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static integer dmaxloc_(double *w, integer s, integer e, integer *n) -{ - double m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static integer smaxloc_(float *w, integer s, integer e, integer *n) -{ - float m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { - integer n = *n_, incx = *incx_, incy = *incy_, i; -#ifdef _MSC_VER - _Fcomplex zdotc = {0.0, 0.0}; - if (incx == 1 && incy == 1) { - for (i=0;i= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; #define z_abs(z) (cabs(Cd(z))) #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} @@ -258,250 +250,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; //#define mymaxloc_(w,s,e,n) {if (sizeof(*(w)) == sizeof(double)) dmaxloc_((w),*(s),*(e),n); else dmaxloc_((w),*(s),*(e),n);} #define mymaxloc(w,s,e,n) {dmaxloc_(w,*(s),*(e),n)} -/* procedure parameter types for -A and -C++ */ - -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef logical (*L_fp)(...); -#else -typedef logical (*L_fp)(); -#endif - -static float spow_ui(float x, integer n) { - float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static double dpow_ui(double x, integer n) { - double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#ifdef _MSC_VER -static _Fcomplex cpow_ui(complex x, integer n) { - complex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; - for(u = n; ; ) { - if(u & 01) pow.r *= x.r, pow.i *= x.i; - if(u >>= 1) x.r *= x.r, x.i *= x.i; - else break; - } - } - _Fcomplex p={pow.r, pow.i}; - return p; -} -#else -static _Complex float cpow_ui(_Complex float x, integer n) { - _Complex float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -#ifdef _MSC_VER -static _Dcomplex zpow_ui(_Dcomplex x, integer n) { - _Dcomplex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; - for(u = n; ; ) { - if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; - if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; - else break; - } - } - _Dcomplex p = {pow._Val[0], pow._Val[1]}; - return p; -} -#else -static _Complex double zpow_ui(_Complex double x, integer n) { - _Complex double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -static integer pow_ii(integer x, integer n) { - integer pow; unsigned long int u; - if (n <= 0) { - if (n == 0 || x == 1) pow = 1; - else if (x != -1) pow = x == 0 ? 1/x : 0; - else n = -n; - } - if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { - u = n; - for(pow = 1; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static integer dmaxloc_(double *w, integer s, integer e, integer *n) -{ - double m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static integer smaxloc_(float *w, integer s, integer e, integer *n) -{ - float m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { - integer n = *n_, incx = *incx_, incy = *incy_, i; -#ifdef _MSC_VER - _Fcomplex zdotc = {0.0, 0.0}; - if (incx == 1 && incy == 1) { - for (i=0;i= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; #define z_abs(z) (cabs(Cd(z))) #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} @@ -258,250 +250,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; //#define mymaxloc_(w,s,e,n) {if (sizeof(*(w)) == sizeof(double)) dmaxloc_((w),*(s),*(e),n); else dmaxloc_((w),*(s),*(e),n);} #define mymaxloc(w,s,e,n) {dmaxloc_(w,*(s),*(e),n)} -/* procedure parameter types for -A and -C++ */ - -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef logical (*L_fp)(...); -#else -typedef logical (*L_fp)(); -#endif - -static float spow_ui(float x, integer n) { - float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static double dpow_ui(double x, integer n) { - double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#ifdef _MSC_VER -static _Fcomplex cpow_ui(complex x, integer n) { - complex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; - for(u = n; ; ) { - if(u & 01) pow.r *= x.r, pow.i *= x.i; - if(u >>= 1) x.r *= x.r, x.i *= x.i; - else break; - } - } - _Fcomplex p={pow.r, pow.i}; - return p; -} -#else -static _Complex float cpow_ui(_Complex float x, integer n) { - _Complex float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -#ifdef _MSC_VER -static _Dcomplex zpow_ui(_Dcomplex x, integer n) { - _Dcomplex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; - for(u = n; ; ) { - if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; - if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; - else break; - } - } - _Dcomplex p = {pow._Val[0], pow._Val[1]}; - return p; -} -#else -static _Complex double zpow_ui(_Complex double x, integer n) { - _Complex double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -static integer pow_ii(integer x, integer n) { - integer pow; unsigned long int u; - if (n <= 0) { - if (n == 0 || x == 1) pow = 1; - else if (x != -1) pow = x == 0 ? 1/x : 0; - else n = -n; - } - if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { - u = n; - for(pow = 1; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static integer dmaxloc_(double *w, integer s, integer e, integer *n) -{ - double m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static integer smaxloc_(float *w, integer s, integer e, integer *n) -{ - float m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { - integer n = *n_, incx = *incx_, incy = *incy_, i; -#ifdef _MSC_VER - _Fcomplex zdotc = {0.0, 0.0}; - if (incx == 1 && incy == 1) { - for (i=0;i= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; #define z_abs(z) (cabs(Cd(z))) #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} @@ -258,250 +250,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; //#define mymaxloc_(w,s,e,n) {if (sizeof(*(w)) == sizeof(double)) dmaxloc_((w),*(s),*(e),n); else dmaxloc_((w),*(s),*(e),n);} #define mymaxloc(w,s,e,n) {dmaxloc_(w,*(s),*(e),n)} -/* procedure parameter types for -A and -C++ */ - -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef logical (*L_fp)(...); -#else -typedef logical (*L_fp)(); -#endif - -static float spow_ui(float x, integer n) { - float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static double dpow_ui(double x, integer n) { - double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#ifdef _MSC_VER -static _Fcomplex cpow_ui(complex x, integer n) { - complex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; - for(u = n; ; ) { - if(u & 01) pow.r *= x.r, pow.i *= x.i; - if(u >>= 1) x.r *= x.r, x.i *= x.i; - else break; - } - } - _Fcomplex p={pow.r, pow.i}; - return p; -} -#else -static _Complex float cpow_ui(_Complex float x, integer n) { - _Complex float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -#ifdef _MSC_VER -static _Dcomplex zpow_ui(_Dcomplex x, integer n) { - _Dcomplex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; - for(u = n; ; ) { - if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; - if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; - else break; - } - } - _Dcomplex p = {pow._Val[0], pow._Val[1]}; - return p; -} -#else -static _Complex double zpow_ui(_Complex double x, integer n) { - _Complex double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -static integer pow_ii(integer x, integer n) { - integer pow; unsigned long int u; - if (n <= 0) { - if (n == 0 || x == 1) pow = 1; - else if (x != -1) pow = x == 0 ? 1/x : 0; - else n = -n; - } - if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { - u = n; - for(pow = 1; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static integer dmaxloc_(double *w, integer s, integer e, integer *n) -{ - double m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static integer smaxloc_(float *w, integer s, integer e, integer *n) -{ - float m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { - integer n = *n_, incx = *incx_, incy = *incy_, i; -#ifdef _MSC_VER - _Fcomplex zdotc = {0.0, 0.0}; - if (incx == 1 && incy == 1) { - for (i=0;i= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; #define z_abs(z) (cabs(Cd(z))) #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} @@ -258,250 +250,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; //#define mymaxloc_(w,s,e,n) {if (sizeof(*(w)) == sizeof(double)) dmaxloc_((w),*(s),*(e),n); else dmaxloc_((w),*(s),*(e),n);} #define mymaxloc(w,s,e,n) {dmaxloc_(w,*(s),*(e),n)} -/* procedure parameter types for -A and -C++ */ - -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef logical (*L_fp)(...); -#else -typedef logical (*L_fp)(); -#endif - -static float spow_ui(float x, integer n) { - float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static double dpow_ui(double x, integer n) { - double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#ifdef _MSC_VER -static _Fcomplex cpow_ui(complex x, integer n) { - complex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; - for(u = n; ; ) { - if(u & 01) pow.r *= x.r, pow.i *= x.i; - if(u >>= 1) x.r *= x.r, x.i *= x.i; - else break; - } - } - _Fcomplex p={pow.r, pow.i}; - return p; -} -#else -static _Complex float cpow_ui(_Complex float x, integer n) { - _Complex float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -#ifdef _MSC_VER -static _Dcomplex zpow_ui(_Dcomplex x, integer n) { - _Dcomplex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; - for(u = n; ; ) { - if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; - if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; - else break; - } - } - _Dcomplex p = {pow._Val[0], pow._Val[1]}; - return p; -} -#else -static _Complex double zpow_ui(_Complex double x, integer n) { - _Complex double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -static integer pow_ii(integer x, integer n) { - integer pow; unsigned long int u; - if (n <= 0) { - if (n == 0 || x == 1) pow = 1; - else if (x != -1) pow = x == 0 ? 1/x : 0; - else n = -n; - } - if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { - u = n; - for(pow = 1; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static integer dmaxloc_(double *w, integer s, integer e, integer *n) -{ - double m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static integer smaxloc_(float *w, integer s, integer e, integer *n) -{ - float m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { - integer n = *n_, incx = *incx_, incy = *incy_, i; -#ifdef _MSC_VER - _Fcomplex zdotc = {0.0, 0.0}; - if (incx == 1 && incy == 1) { - for (i=0;i= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; #define z_abs(z) (cabs(Cd(z))) #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} @@ -258,250 +250,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; //#define mymaxloc_(w,s,e,n) {if (sizeof(*(w)) == sizeof(double)) dmaxloc_((w),*(s),*(e),n); else dmaxloc_((w),*(s),*(e),n);} #define mymaxloc(w,s,e,n) {dmaxloc_(w,*(s),*(e),n)} -/* procedure parameter types for -A and -C++ */ - -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef logical (*L_fp)(...); -#else -typedef logical (*L_fp)(); -#endif - -static float spow_ui(float x, integer n) { - float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static double dpow_ui(double x, integer n) { - double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#ifdef _MSC_VER -static _Fcomplex cpow_ui(complex x, integer n) { - complex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; - for(u = n; ; ) { - if(u & 01) pow.r *= x.r, pow.i *= x.i; - if(u >>= 1) x.r *= x.r, x.i *= x.i; - else break; - } - } - _Fcomplex p={pow.r, pow.i}; - return p; -} -#else -static _Complex float cpow_ui(_Complex float x, integer n) { - _Complex float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -#ifdef _MSC_VER -static _Dcomplex zpow_ui(_Dcomplex x, integer n) { - _Dcomplex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; - for(u = n; ; ) { - if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; - if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; - else break; - } - } - _Dcomplex p = {pow._Val[0], pow._Val[1]}; - return p; -} -#else -static _Complex double zpow_ui(_Complex double x, integer n) { - _Complex double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -static integer pow_ii(integer x, integer n) { - integer pow; unsigned long int u; - if (n <= 0) { - if (n == 0 || x == 1) pow = 1; - else if (x != -1) pow = x == 0 ? 1/x : 0; - else n = -n; - } - if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { - u = n; - for(pow = 1; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static integer dmaxloc_(double *w, integer s, integer e, integer *n) -{ - double m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static integer smaxloc_(float *w, integer s, integer e, integer *n) -{ - float m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { - integer n = *n_, incx = *incx_, incy = *incy_, i; -#ifdef _MSC_VER - _Fcomplex zdotc = {0.0, 0.0}; - if (incx == 1 && incy == 1) { - for (i=0;i= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; #define z_abs(z) (cabs(Cd(z))) #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} @@ -258,250 +250,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; //#define mymaxloc_(w,s,e,n) {if (sizeof(*(w)) == sizeof(double)) dmaxloc_((w),*(s),*(e),n); else dmaxloc_((w),*(s),*(e),n);} #define mymaxloc(w,s,e,n) {dmaxloc_(w,*(s),*(e),n)} -/* procedure parameter types for -A and -C++ */ - -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef logical (*L_fp)(...); -#else -typedef logical (*L_fp)(); -#endif - -static float spow_ui(float x, integer n) { - float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static double dpow_ui(double x, integer n) { - double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#ifdef _MSC_VER -static _Fcomplex cpow_ui(complex x, integer n) { - complex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; - for(u = n; ; ) { - if(u & 01) pow.r *= x.r, pow.i *= x.i; - if(u >>= 1) x.r *= x.r, x.i *= x.i; - else break; - } - } - _Fcomplex p={pow.r, pow.i}; - return p; -} -#else -static _Complex float cpow_ui(_Complex float x, integer n) { - _Complex float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -#ifdef _MSC_VER -static _Dcomplex zpow_ui(_Dcomplex x, integer n) { - _Dcomplex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; - for(u = n; ; ) { - if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; - if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; - else break; - } - } - _Dcomplex p = {pow._Val[0], pow._Val[1]}; - return p; -} -#else -static _Complex double zpow_ui(_Complex double x, integer n) { - _Complex double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -static integer pow_ii(integer x, integer n) { - integer pow; unsigned long int u; - if (n <= 0) { - if (n == 0 || x == 1) pow = 1; - else if (x != -1) pow = x == 0 ? 1/x : 0; - else n = -n; - } - if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { - u = n; - for(pow = 1; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static integer dmaxloc_(double *w, integer s, integer e, integer *n) -{ - double m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static integer smaxloc_(float *w, integer s, integer e, integer *n) -{ - float m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { - integer n = *n_, incx = *incx_, incy = *incy_, i; -#ifdef _MSC_VER - _Fcomplex zdotc = {0.0, 0.0}; - if (incx == 1 && incy == 1) { - for (i=0;i= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; #define z_abs(z) (cabs(Cd(z))) #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} @@ -258,250 +249,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; //#define mymaxloc_(w,s,e,n) {if (sizeof(*(w)) == sizeof(double)) dmaxloc_((w),*(s),*(e),n); else dmaxloc_((w),*(s),*(e),n);} #define mymaxloc(w,s,e,n) {dmaxloc_(w,*(s),*(e),n)} -/* procedure parameter types for -A and -C++ */ - -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef logical (*L_fp)(...); -#else -typedef logical (*L_fp)(); -#endif - -static float spow_ui(float x, integer n) { - float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static double dpow_ui(double x, integer n) { - double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#ifdef _MSC_VER -static _Fcomplex cpow_ui(complex x, integer n) { - complex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; - for(u = n; ; ) { - if(u & 01) pow.r *= x.r, pow.i *= x.i; - if(u >>= 1) x.r *= x.r, x.i *= x.i; - else break; - } - } - _Fcomplex p={pow.r, pow.i}; - return p; -} -#else -static _Complex float cpow_ui(_Complex float x, integer n) { - _Complex float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -#ifdef _MSC_VER -static _Dcomplex zpow_ui(_Dcomplex x, integer n) { - _Dcomplex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; - for(u = n; ; ) { - if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; - if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; - else break; - } - } - _Dcomplex p = {pow._Val[0], pow._Val[1]}; - return p; -} -#else -static _Complex double zpow_ui(_Complex double x, integer n) { - _Complex double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -static integer pow_ii(integer x, integer n) { - integer pow; unsigned long int u; - if (n <= 0) { - if (n == 0 || x == 1) pow = 1; - else if (x != -1) pow = x == 0 ? 1/x : 0; - else n = -n; - } - if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { - u = n; - for(pow = 1; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static integer dmaxloc_(double *w, integer s, integer e, integer *n) -{ - double m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static integer smaxloc_(float *w, integer s, integer e, integer *n) -{ - float m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { - integer n = *n_, incx = *incx_, incy = *incy_, i; -#ifdef _MSC_VER - _Fcomplex zdotc = {0.0, 0.0}; - if (incx == 1 && incy == 1) { - for (i=0;i= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; #define z_abs(z) (cabs(Cd(z))) #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} @@ -258,250 +250,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; //#define mymaxloc_(w,s,e,n) {if (sizeof(*(w)) == sizeof(double)) dmaxloc_((w),*(s),*(e),n); else dmaxloc_((w),*(s),*(e),n);} #define mymaxloc(w,s,e,n) {dmaxloc_(w,*(s),*(e),n)} -/* procedure parameter types for -A and -C++ */ - -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef logical (*L_fp)(...); -#else -typedef logical (*L_fp)(); -#endif - -static float spow_ui(float x, integer n) { - float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static double dpow_ui(double x, integer n) { - double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#ifdef _MSC_VER -static _Fcomplex cpow_ui(complex x, integer n) { - complex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; - for(u = n; ; ) { - if(u & 01) pow.r *= x.r, pow.i *= x.i; - if(u >>= 1) x.r *= x.r, x.i *= x.i; - else break; - } - } - _Fcomplex p={pow.r, pow.i}; - return p; -} -#else -static _Complex float cpow_ui(_Complex float x, integer n) { - _Complex float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -#ifdef _MSC_VER -static _Dcomplex zpow_ui(_Dcomplex x, integer n) { - _Dcomplex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; - for(u = n; ; ) { - if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; - if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; - else break; - } - } - _Dcomplex p = {pow._Val[0], pow._Val[1]}; - return p; -} -#else -static _Complex double zpow_ui(_Complex double x, integer n) { - _Complex double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -static integer pow_ii(integer x, integer n) { - integer pow; unsigned long int u; - if (n <= 0) { - if (n == 0 || x == 1) pow = 1; - else if (x != -1) pow = x == 0 ? 1/x : 0; - else n = -n; - } - if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { - u = n; - for(pow = 1; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static integer dmaxloc_(double *w, integer s, integer e, integer *n) -{ - double m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static integer smaxloc_(float *w, integer s, integer e, integer *n) -{ - float m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { - integer n = *n_, incx = *incx_, incy = *incy_, i; -#ifdef _MSC_VER - _Fcomplex zdotc = {0.0, 0.0}; - if (incx == 1 && incy == 1) { - for (i=0;i= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; #define z_abs(z) (cabs(Cd(z))) #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} @@ -258,250 +250,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; //#define mymaxloc_(w,s,e,n) {if (sizeof(*(w)) == sizeof(double)) dmaxloc_((w),*(s),*(e),n); else dmaxloc_((w),*(s),*(e),n);} #define mymaxloc(w,s,e,n) {dmaxloc_(w,*(s),*(e),n)} -/* procedure parameter types for -A and -C++ */ - -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef logical (*L_fp)(...); -#else -typedef logical (*L_fp)(); -#endif - -static float spow_ui(float x, integer n) { - float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static double dpow_ui(double x, integer n) { - double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#ifdef _MSC_VER -static _Fcomplex cpow_ui(complex x, integer n) { - complex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; - for(u = n; ; ) { - if(u & 01) pow.r *= x.r, pow.i *= x.i; - if(u >>= 1) x.r *= x.r, x.i *= x.i; - else break; - } - } - _Fcomplex p={pow.r, pow.i}; - return p; -} -#else -static _Complex float cpow_ui(_Complex float x, integer n) { - _Complex float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -#ifdef _MSC_VER -static _Dcomplex zpow_ui(_Dcomplex x, integer n) { - _Dcomplex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; - for(u = n; ; ) { - if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; - if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; - else break; - } - } - _Dcomplex p = {pow._Val[0], pow._Val[1]}; - return p; -} -#else -static _Complex double zpow_ui(_Complex double x, integer n) { - _Complex double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -static integer pow_ii(integer x, integer n) { - integer pow; unsigned long int u; - if (n <= 0) { - if (n == 0 || x == 1) pow = 1; - else if (x != -1) pow = x == 0 ? 1/x : 0; - else n = -n; - } - if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { - u = n; - for(pow = 1; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static integer dmaxloc_(double *w, integer s, integer e, integer *n) -{ - double m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static integer smaxloc_(float *w, integer s, integer e, integer *n) -{ - float m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { - integer n = *n_, incx = *incx_, incy = *incy_, i; -#ifdef _MSC_VER - _Fcomplex zdotc = {0.0, 0.0}; - if (incx == 1 && incy == 1) { - for (i=0;i= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; #define z_abs(z) (cabs(Cd(z))) #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} @@ -258,250 +250,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; //#define mymaxloc_(w,s,e,n) {if (sizeof(*(w)) == sizeof(double)) dmaxloc_((w),*(s),*(e),n); else dmaxloc_((w),*(s),*(e),n);} #define mymaxloc(w,s,e,n) {dmaxloc_(w,*(s),*(e),n)} -/* procedure parameter types for -A and -C++ */ - -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef logical (*L_fp)(...); -#else -typedef logical (*L_fp)(); -#endif - -static float spow_ui(float x, integer n) { - float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static double dpow_ui(double x, integer n) { - double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#ifdef _MSC_VER -static _Fcomplex cpow_ui(complex x, integer n) { - complex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; - for(u = n; ; ) { - if(u & 01) pow.r *= x.r, pow.i *= x.i; - if(u >>= 1) x.r *= x.r, x.i *= x.i; - else break; - } - } - _Fcomplex p={pow.r, pow.i}; - return p; -} -#else -static _Complex float cpow_ui(_Complex float x, integer n) { - _Complex float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -#ifdef _MSC_VER -static _Dcomplex zpow_ui(_Dcomplex x, integer n) { - _Dcomplex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; - for(u = n; ; ) { - if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; - if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; - else break; - } - } - _Dcomplex p = {pow._Val[0], pow._Val[1]}; - return p; -} -#else -static _Complex double zpow_ui(_Complex double x, integer n) { - _Complex double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -static integer pow_ii(integer x, integer n) { - integer pow; unsigned long int u; - if (n <= 0) { - if (n == 0 || x == 1) pow = 1; - else if (x != -1) pow = x == 0 ? 1/x : 0; - else n = -n; - } - if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { - u = n; - for(pow = 1; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static integer dmaxloc_(double *w, integer s, integer e, integer *n) -{ - double m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static integer smaxloc_(float *w, integer s, integer e, integer *n) -{ - float m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { - integer n = *n_, incx = *incx_, incy = *incy_, i; -#ifdef _MSC_VER - _Fcomplex zdotc = {0.0, 0.0}; - if (incx == 1 && incy == 1) { - for (i=0;i= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; #define z_abs(z) (cabs(Cd(z))) #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} @@ -258,250 +250,6 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; //#define mymaxloc_(w,s,e,n) {if (sizeof(*(w)) == sizeof(double)) dmaxloc_((w),*(s),*(e),n); else dmaxloc_((w),*(s),*(e),n);} #define mymaxloc(w,s,e,n) {dmaxloc_(w,*(s),*(e),n)} -/* procedure parameter types for -A and -C++ */ - -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef logical (*L_fp)(...); -#else -typedef logical (*L_fp)(); -#endif - -static float spow_ui(float x, integer n) { - float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static double dpow_ui(double x, integer n) { - double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#ifdef _MSC_VER -static _Fcomplex cpow_ui(complex x, integer n) { - complex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; - for(u = n; ; ) { - if(u & 01) pow.r *= x.r, pow.i *= x.i; - if(u >>= 1) x.r *= x.r, x.i *= x.i; - else break; - } - } - _Fcomplex p={pow.r, pow.i}; - return p; -} -#else -static _Complex float cpow_ui(_Complex float x, integer n) { - _Complex float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -#ifdef _MSC_VER -static _Dcomplex zpow_ui(_Dcomplex x, integer n) { - _Dcomplex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; - for(u = n; ; ) { - if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; - if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; - else break; - } - } - _Dcomplex p = {pow._Val[0], pow._Val[1]}; - return p; -} -#else -static _Complex double zpow_ui(_Complex double x, integer n) { - _Complex double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -static integer pow_ii(integer x, integer n) { - integer pow; unsigned long int u; - if (n <= 0) { - if (n == 0 || x == 1) pow = 1; - else if (x != -1) pow = x == 0 ? 1/x : 0; - else n = -n; - } - if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { - u = n; - for(pow = 1; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static integer dmaxloc_(double *w, integer s, integer e, integer *n) -{ - double m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static integer smaxloc_(float *w, integer s, integer e, integer *n) -{ - float m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { - integer n = *n_, incx = *incx_, incy = *incy_, i; -#ifdef _MSC_VER - _Fcomplex zdotc = {0.0, 0.0}; - if (incx == 1 && incy == 1) { - for (i=0;i= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; #define z_abs(z) (cabs(Cd(z))) #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} @@ -234,148 +247,5 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; //#define mymaxloc_(w,s,e,n) {if (sizeof(*(w)) == sizeof(double)) dmaxloc_((w),*(s),*(e),n); else dmaxloc_((w),*(s),*(e),n);} #define mymaxloc_(w,s,e,n) dmaxloc_(w,*(s),*(e),n) -/* procedure parameter types for -A and -C++ */ - -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef logical (*L_fp)(...); -#else -typedef logical (*L_fp)(); #endif -static float spow_ui(float x, integer n) { - float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static double dpow_ui(double x, integer n) { - double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static _Complex float cpow_ui(_Complex float x, integer n) { - _Complex float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static _Complex double zpow_ui(_Complex double x, integer n) { - _Complex double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static integer pow_ii(integer x, integer n) { - integer pow; unsigned long int u; - if (n <= 0) { - if (n == 0 || x == 1) pow = 1; - else if (x != -1) pow = x == 0 ? 1/x : 0; - else n = -n; - } - if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { - u = n; - for(pow = 1; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static integer dmaxloc_(double *w, integer s, integer e, integer *n) -{ - double m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static integer smaxloc_(float *w, integer s, integer e, integer *n) -{ - float m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { - integer n = *n_, incx = *incx_, incy = *incy_, i; - _Complex float zdotc = 0.0; - if (incx == 1 && incy == 1) { - for (i=0;i= 0) *lp++ = *(f__rp)++; } while(--ll >= 0) *lp++ = ' '; } #define s_cmp(a,b,c,d) ((integer)strncmp((a),(b),f2cmin((c),(d)))) #define s_copy(A,B,C,D) { int __i,__m; for (__i=0, __m=f2cmin((C),(D)); __i<__m && (B)[__i] != 0; ++__i) (A)[__i] = (B)[__i]; } #define sig_die(s, kill) { exit(1); } #define s_stop(s, n) {exit(0);} -static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; #define z_abs(z) (cabs(Cd(z))) #define z_exp(R, Z) {pCd(R) = cexp(Cd(Z));} #define z_sqrt(R, Z) {pCd(R) = csqrt(Cd(Z));} @@ -258,250 +250,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; //#define mymaxloc_(w,s,e,n) {if (sizeof(*(w)) == sizeof(double)) dmaxloc_((w),*(s),*(e),n); else dmaxloc_((w),*(s),*(e),n);} #define mymaxloc(w,s,e,n) {dmaxloc_(w,*(s),*(e),n)} -/* procedure parameter types for -A and -C++ */ - -#define F2C_proc_par_types 1 -#ifdef __cplusplus -typedef logical (*L_fp)(...); -#else -typedef logical (*L_fp)(); -#endif -static float spow_ui(float x, integer n) { - float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static double dpow_ui(double x, integer n) { - double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#ifdef _MSC_VER -static _Fcomplex cpow_ui(complex x, integer n) { - complex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x.r = 1/x.r, x.i=1/x.i; - for(u = n; ; ) { - if(u & 01) pow.r *= x.r, pow.i *= x.i; - if(u >>= 1) x.r *= x.r, x.i *= x.i; - else break; - } - } - _Fcomplex p={pow.r, pow.i}; - return p; -} -#else -static _Complex float cpow_ui(_Complex float x, integer n) { - _Complex float pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -#ifdef _MSC_VER -static _Dcomplex zpow_ui(_Dcomplex x, integer n) { - _Dcomplex pow={1.0,0.0}; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x._Val[0] = 1/x._Val[0], x._Val[1] =1/x._Val[1]; - for(u = n; ; ) { - if(u & 01) pow._Val[0] *= x._Val[0], pow._Val[1] *= x._Val[1]; - if(u >>= 1) x._Val[0] *= x._Val[0], x._Val[1] *= x._Val[1]; - else break; - } - } - _Dcomplex p = {pow._Val[0], pow._Val[1]}; - return p; -} -#else -static _Complex double zpow_ui(_Complex double x, integer n) { - _Complex double pow=1.0; unsigned long int u; - if(n != 0) { - if(n < 0) n = -n, x = 1/x; - for(u = n; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -#endif -static integer pow_ii(integer x, integer n) { - integer pow; unsigned long int u; - if (n <= 0) { - if (n == 0 || x == 1) pow = 1; - else if (x != -1) pow = x == 0 ? 1/x : 0; - else n = -n; - } - if ((n > 0) || !(n == 0 || x == 1 || x != -1)) { - u = n; - for(pow = 1; ; ) { - if(u & 01) pow *= x; - if(u >>= 1) x *= x; - else break; - } - } - return pow; -} -static integer dmaxloc_(double *w, integer s, integer e, integer *n) -{ - double m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static integer smaxloc_(float *w, integer s, integer e, integer *n) -{ - float m; integer i, mi; - for(m=w[s-1], mi=s, i=s+1; i<=e; i++) - if (w[i-1]>m) mi=i ,m=w[i-1]; - return mi-s+1; -} -static inline void cdotc_(complex *z, integer *n_, complex *x, integer *incx_, complex *y, integer *incy_) { - integer n = *n_, incx = *incx_, incy = *incy_, i; -#ifdef _MSC_VER - _Fcomplex zdotc = {0.0, 0.0}; - if (incx == 1 && incy == 1) { - for (i=0;i Date: Wed, 3 Apr 2024 22:47:34 +0200 Subject: [PATCH 271/311] fix typedef of logical to support INTERFACE64 --- lapack-netlib/SRC/ztrsyl.c | 6 +++--- lapack-netlib/SRC/ztrsyl3.c | 6 +++--- lapack-netlib/SRC/ztrti2.c | 6 +++--- lapack-netlib/SRC/ztrtri.c | 6 +++--- lapack-netlib/SRC/ztrtrs.c | 6 +++--- lapack-netlib/SRC/ztrttf.c | 6 +++--- lapack-netlib/SRC/ztrttp.c | 6 +++--- lapack-netlib/SRC/ztzrzf.c | 6 +++--- lapack-netlib/SRC/zunbdb.c | 6 +++--- lapack-netlib/SRC/zunbdb1.c | 6 +++--- lapack-netlib/SRC/zunbdb2.c | 6 +++--- lapack-netlib/SRC/zunbdb3.c | 6 +++--- lapack-netlib/SRC/zunbdb4.c | 6 +++--- lapack-netlib/SRC/zunbdb5.c | 6 +++--- lapack-netlib/SRC/zunbdb6.c | 6 +++--- lapack-netlib/SRC/zuncsd.c | 6 +++--- lapack-netlib/SRC/zuncsd2by1.c | 6 +++--- lapack-netlib/SRC/zung2l.c | 6 +++--- lapack-netlib/SRC/zung2r.c | 6 +++--- lapack-netlib/SRC/zungbr.c | 6 +++--- lapack-netlib/SRC/zunghr.c | 6 +++--- lapack-netlib/SRC/zungl2.c | 6 +++--- lapack-netlib/SRC/zunglq.c | 6 +++--- lapack-netlib/SRC/zungql.c | 6 +++--- lapack-netlib/SRC/zungqr.c | 6 +++--- lapack-netlib/SRC/zungr2.c | 6 +++--- lapack-netlib/SRC/zungrq.c | 6 +++--- lapack-netlib/SRC/zungtr.c | 6 +++--- lapack-netlib/SRC/zungtsqr.c | 6 +++--- lapack-netlib/SRC/zungtsqr_row.c | 6 +++--- lapack-netlib/SRC/zunhr_col.c | 6 +++--- lapack-netlib/SRC/zunm22.c | 6 +++--- lapack-netlib/SRC/zunm2l.c | 6 +++--- lapack-netlib/SRC/zunm2r.c | 6 +++--- lapack-netlib/SRC/zunmbr.c | 6 +++--- lapack-netlib/SRC/zunmhr.c | 6 +++--- lapack-netlib/SRC/zunml2.c | 6 +++--- lapack-netlib/SRC/zunmlq.c | 6 +++--- lapack-netlib/SRC/zunmql.c | 6 +++--- lapack-netlib/SRC/zunmqr.c | 6 +++--- lapack-netlib/SRC/zunmr2.c | 6 +++--- lapack-netlib/SRC/zunmr3.c | 6 +++--- lapack-netlib/SRC/zunmrq.c | 6 +++--- lapack-netlib/SRC/zunmrz.c | 6 +++--- lapack-netlib/SRC/zunmtr.c | 6 +++--- lapack-netlib/SRC/zupgtr.c | 6 +++--- lapack-netlib/SRC/zupmtr.c | 6 +++--- 47 files changed, 141 insertions(+), 141 deletions(-) diff --git a/lapack-netlib/SRC/ztrsyl.c b/lapack-netlib/SRC/ztrsyl.c index af8f9e761..d2cd58770 100644 --- a/lapack-netlib/SRC/ztrsyl.c +++ b/lapack-netlib/SRC/ztrsyl.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ztrsyl3.c b/lapack-netlib/SRC/ztrsyl3.c index 09719e1d9..48d957d49 100644 --- a/lapack-netlib/SRC/ztrsyl3.c +++ b/lapack-netlib/SRC/ztrsyl3.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -264,7 +264,7 @@ static int my_expfunc(double *x) {int e; (void)frexp(*x,&e); return e;} /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ztrti2.c b/lapack-netlib/SRC/ztrti2.c index dbd3db68e..09160b444 100644 --- a/lapack-netlib/SRC/ztrti2.c +++ b/lapack-netlib/SRC/ztrti2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ztrtri.c b/lapack-netlib/SRC/ztrtri.c index be2f6acbb..882d6473b 100644 --- a/lapack-netlib/SRC/ztrtri.c +++ b/lapack-netlib/SRC/ztrtri.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ztrtrs.c b/lapack-netlib/SRC/ztrtrs.c index 6d1f71a04..fbb9ed500 100644 --- a/lapack-netlib/SRC/ztrtrs.c +++ b/lapack-netlib/SRC/ztrtrs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ztrttf.c b/lapack-netlib/SRC/ztrttf.c index 692e5e845..3035fa318 100644 --- a/lapack-netlib/SRC/ztrttf.c +++ b/lapack-netlib/SRC/ztrttf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ztrttp.c b/lapack-netlib/SRC/ztrttp.c index 95624b1db..86a551b43 100644 --- a/lapack-netlib/SRC/ztrttp.c +++ b/lapack-netlib/SRC/ztrttp.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ztzrzf.c b/lapack-netlib/SRC/ztzrzf.c index 6d03d2d54..936c1e7aa 100644 --- a/lapack-netlib/SRC/ztzrzf.c +++ b/lapack-netlib/SRC/ztzrzf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zunbdb.c b/lapack-netlib/SRC/zunbdb.c index 5d9d3541a..f0f0b6e51 100644 --- a/lapack-netlib/SRC/zunbdb.c +++ b/lapack-netlib/SRC/zunbdb.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zunbdb1.c b/lapack-netlib/SRC/zunbdb1.c index 1759c2602..022c65520 100644 --- a/lapack-netlib/SRC/zunbdb1.c +++ b/lapack-netlib/SRC/zunbdb1.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zunbdb2.c b/lapack-netlib/SRC/zunbdb2.c index 0b0f9e6cd..2a2144079 100644 --- a/lapack-netlib/SRC/zunbdb2.c +++ b/lapack-netlib/SRC/zunbdb2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zunbdb3.c b/lapack-netlib/SRC/zunbdb3.c index 4c6354a74..f203511e6 100644 --- a/lapack-netlib/SRC/zunbdb3.c +++ b/lapack-netlib/SRC/zunbdb3.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zunbdb4.c b/lapack-netlib/SRC/zunbdb4.c index db8bb894e..b514743bd 100644 --- a/lapack-netlib/SRC/zunbdb4.c +++ b/lapack-netlib/SRC/zunbdb4.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zunbdb5.c b/lapack-netlib/SRC/zunbdb5.c index c92452ad2..cd7413d59 100644 --- a/lapack-netlib/SRC/zunbdb5.c +++ b/lapack-netlib/SRC/zunbdb5.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zunbdb6.c b/lapack-netlib/SRC/zunbdb6.c index e68eb562b..943df37dc 100644 --- a/lapack-netlib/SRC/zunbdb6.c +++ b/lapack-netlib/SRC/zunbdb6.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zuncsd.c b/lapack-netlib/SRC/zuncsd.c index 2e8cef799..d9c4e4d34 100644 --- a/lapack-netlib/SRC/zuncsd.c +++ b/lapack-netlib/SRC/zuncsd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zuncsd2by1.c b/lapack-netlib/SRC/zuncsd2by1.c index 23b894d9a..6771f2869 100644 --- a/lapack-netlib/SRC/zuncsd2by1.c +++ b/lapack-netlib/SRC/zuncsd2by1.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zung2l.c b/lapack-netlib/SRC/zung2l.c index fccecb341..b8b67f43c 100644 --- a/lapack-netlib/SRC/zung2l.c +++ b/lapack-netlib/SRC/zung2l.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zung2r.c b/lapack-netlib/SRC/zung2r.c index 75d48a91a..fce138cf0 100644 --- a/lapack-netlib/SRC/zung2r.c +++ b/lapack-netlib/SRC/zung2r.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zungbr.c b/lapack-netlib/SRC/zungbr.c index 7033dc2bf..77e73ad64 100644 --- a/lapack-netlib/SRC/zungbr.c +++ b/lapack-netlib/SRC/zungbr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zunghr.c b/lapack-netlib/SRC/zunghr.c index b0b60567d..93fe8c95e 100644 --- a/lapack-netlib/SRC/zunghr.c +++ b/lapack-netlib/SRC/zunghr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zungl2.c b/lapack-netlib/SRC/zungl2.c index ea0fe66fc..dd4d8bb09 100644 --- a/lapack-netlib/SRC/zungl2.c +++ b/lapack-netlib/SRC/zungl2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zunglq.c b/lapack-netlib/SRC/zunglq.c index 2075177a7..173419e13 100644 --- a/lapack-netlib/SRC/zunglq.c +++ b/lapack-netlib/SRC/zunglq.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zungql.c b/lapack-netlib/SRC/zungql.c index 0d5fa891f..5b58fe390 100644 --- a/lapack-netlib/SRC/zungql.c +++ b/lapack-netlib/SRC/zungql.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zungqr.c b/lapack-netlib/SRC/zungqr.c index 74c6b3cf6..66fa83f86 100644 --- a/lapack-netlib/SRC/zungqr.c +++ b/lapack-netlib/SRC/zungqr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zungr2.c b/lapack-netlib/SRC/zungr2.c index e527607f9..4b984c36d 100644 --- a/lapack-netlib/SRC/zungr2.c +++ b/lapack-netlib/SRC/zungr2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zungrq.c b/lapack-netlib/SRC/zungrq.c index 03f8b67a9..1f521e1aa 100644 --- a/lapack-netlib/SRC/zungrq.c +++ b/lapack-netlib/SRC/zungrq.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zungtr.c b/lapack-netlib/SRC/zungtr.c index d42c84c75..a34b750ea 100644 --- a/lapack-netlib/SRC/zungtr.c +++ b/lapack-netlib/SRC/zungtr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zungtsqr.c b/lapack-netlib/SRC/zungtsqr.c index 5b49a37ce..ef4cf3788 100644 --- a/lapack-netlib/SRC/zungtsqr.c +++ b/lapack-netlib/SRC/zungtsqr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zungtsqr_row.c b/lapack-netlib/SRC/zungtsqr_row.c index d23eac0cc..a7b482fa0 100644 --- a/lapack-netlib/SRC/zungtsqr_row.c +++ b/lapack-netlib/SRC/zungtsqr_row.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zunhr_col.c b/lapack-netlib/SRC/zunhr_col.c index 935a0c769..646da0414 100644 --- a/lapack-netlib/SRC/zunhr_col.c +++ b/lapack-netlib/SRC/zunhr_col.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zunm22.c b/lapack-netlib/SRC/zunm22.c index 1d07b5632..1faeb77b2 100644 --- a/lapack-netlib/SRC/zunm22.c +++ b/lapack-netlib/SRC/zunm22.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zunm2l.c b/lapack-netlib/SRC/zunm2l.c index 9748d4d21..2efbfc958 100644 --- a/lapack-netlib/SRC/zunm2l.c +++ b/lapack-netlib/SRC/zunm2l.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zunm2r.c b/lapack-netlib/SRC/zunm2r.c index 9e4e90ecb..766dae02e 100644 --- a/lapack-netlib/SRC/zunm2r.c +++ b/lapack-netlib/SRC/zunm2r.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zunmbr.c b/lapack-netlib/SRC/zunmbr.c index 5fb8cbe05..8cd84a65a 100644 --- a/lapack-netlib/SRC/zunmbr.c +++ b/lapack-netlib/SRC/zunmbr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zunmhr.c b/lapack-netlib/SRC/zunmhr.c index 76e8aad0c..d606c59a1 100644 --- a/lapack-netlib/SRC/zunmhr.c +++ b/lapack-netlib/SRC/zunmhr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zunml2.c b/lapack-netlib/SRC/zunml2.c index e4d071d29..2cd325172 100644 --- a/lapack-netlib/SRC/zunml2.c +++ b/lapack-netlib/SRC/zunml2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zunmlq.c b/lapack-netlib/SRC/zunmlq.c index b9e8e0262..d451c5c34 100644 --- a/lapack-netlib/SRC/zunmlq.c +++ b/lapack-netlib/SRC/zunmlq.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zunmql.c b/lapack-netlib/SRC/zunmql.c index da7c16c61..35274978a 100644 --- a/lapack-netlib/SRC/zunmql.c +++ b/lapack-netlib/SRC/zunmql.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zunmqr.c b/lapack-netlib/SRC/zunmqr.c index b3470b9c1..1db1a0258 100644 --- a/lapack-netlib/SRC/zunmqr.c +++ b/lapack-netlib/SRC/zunmqr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zunmr2.c b/lapack-netlib/SRC/zunmr2.c index cf0cd013d..51b150238 100644 --- a/lapack-netlib/SRC/zunmr2.c +++ b/lapack-netlib/SRC/zunmr2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zunmr3.c b/lapack-netlib/SRC/zunmr3.c index 0ca68e2a5..129630a80 100644 --- a/lapack-netlib/SRC/zunmr3.c +++ b/lapack-netlib/SRC/zunmr3.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zunmrq.c b/lapack-netlib/SRC/zunmrq.c index 30ccf40df..3206e7405 100644 --- a/lapack-netlib/SRC/zunmrq.c +++ b/lapack-netlib/SRC/zunmrq.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zunmrz.c b/lapack-netlib/SRC/zunmrz.c index 728db22d0..d41b9085c 100644 --- a/lapack-netlib/SRC/zunmrz.c +++ b/lapack-netlib/SRC/zunmrz.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zunmtr.c b/lapack-netlib/SRC/zunmtr.c index 55b93d334..520370cb3 100644 --- a/lapack-netlib/SRC/zunmtr.c +++ b/lapack-netlib/SRC/zunmtr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zupgtr.c b/lapack-netlib/SRC/zupgtr.c index 671de3e58..6cb7c70b0 100644 --- a/lapack-netlib/SRC/zupgtr.c +++ b/lapack-netlib/SRC/zupgtr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zupmtr.c b/lapack-netlib/SRC/zupmtr.c index 2a67a791b..a51d54620 100644 --- a/lapack-netlib/SRC/zupmtr.c +++ b/lapack-netlib/SRC/zupmtr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else From 592905a72c7ed91bb607ce030c00eebe42b6e21f Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Wed, 3 Apr 2024 22:53:22 +0200 Subject: [PATCH 272/311] fix typedef of logical to support INTERFACE64 --- lapack-netlib/SRC/zrot.c | 6 +++--- lapack-netlib/SRC/zrscl.c | 6 +++--- lapack-netlib/SRC/zspcon.c | 6 +++--- lapack-netlib/SRC/zspmv.c | 6 +++--- lapack-netlib/SRC/zspr.c | 6 +++--- lapack-netlib/SRC/zsprfs.c | 6 +++--- lapack-netlib/SRC/zspsv.c | 6 +++--- lapack-netlib/SRC/zspsvx.c | 6 +++--- lapack-netlib/SRC/zsptrf.c | 6 +++--- lapack-netlib/SRC/zsptri.c | 6 +++--- lapack-netlib/SRC/zsptrs.c | 6 +++--- lapack-netlib/SRC/zstedc.c | 6 +++--- lapack-netlib/SRC/zstegr.c | 6 +++--- lapack-netlib/SRC/zstein.c | 6 +++--- lapack-netlib/SRC/zstemr.c | 6 +++--- lapack-netlib/SRC/zsteqr.c | 6 +++--- lapack-netlib/SRC/zsycon.c | 6 +++--- lapack-netlib/SRC/zsycon_3.c | 6 +++--- lapack-netlib/SRC/zsycon_rook.c | 6 +++--- lapack-netlib/SRC/zsyconv.c | 6 +++--- lapack-netlib/SRC/zsyconvf.c | 6 +++--- lapack-netlib/SRC/zsyconvf_rook.c | 6 +++--- lapack-netlib/SRC/zsyequb.c | 6 +++--- lapack-netlib/SRC/zsymv.c | 6 +++--- lapack-netlib/SRC/zsyr.c | 6 +++--- lapack-netlib/SRC/zsyrfs.c | 6 +++--- lapack-netlib/SRC/zsyrfsx.c | 6 +++--- lapack-netlib/SRC/zsysv.c | 6 +++--- lapack-netlib/SRC/zsysv_aa.c | 6 +++--- lapack-netlib/SRC/zsysv_aa_2stage.c | 6 +++--- lapack-netlib/SRC/zsysv_rk.c | 6 +++--- lapack-netlib/SRC/zsysv_rook.c | 6 +++--- lapack-netlib/SRC/zsysvx.c | 6 +++--- lapack-netlib/SRC/zsysvxx.c | 6 +++--- lapack-netlib/SRC/zsyswapr.c | 6 +++--- lapack-netlib/SRC/zsytf2.c | 6 +++--- lapack-netlib/SRC/zsytf2_rk.c | 6 +++--- lapack-netlib/SRC/zsytf2_rook.c | 6 +++--- lapack-netlib/SRC/zsytrf.c | 6 +++--- lapack-netlib/SRC/zsytrf_aa.c | 6 +++--- lapack-netlib/SRC/zsytrf_aa_2stage.c | 6 +++--- lapack-netlib/SRC/zsytrf_rk.c | 6 +++--- lapack-netlib/SRC/zsytrf_rook.c | 6 +++--- lapack-netlib/SRC/zsytri.c | 6 +++--- lapack-netlib/SRC/zsytri2.c | 6 +++--- lapack-netlib/SRC/zsytri2x.c | 6 +++--- lapack-netlib/SRC/zsytri_3.c | 6 +++--- lapack-netlib/SRC/zsytri_3x.c | 6 +++--- lapack-netlib/SRC/zsytri_rook.c | 6 +++--- lapack-netlib/SRC/zsytrs.c | 6 +++--- lapack-netlib/SRC/zsytrs2.c | 6 +++--- lapack-netlib/SRC/zsytrs_3.c | 6 +++--- lapack-netlib/SRC/zsytrs_aa.c | 6 +++--- lapack-netlib/SRC/zsytrs_aa_2stage.c | 6 +++--- lapack-netlib/SRC/zsytrs_rook.c | 6 +++--- lapack-netlib/SRC/ztbcon.c | 6 +++--- lapack-netlib/SRC/ztbrfs.c | 6 +++--- lapack-netlib/SRC/ztbtrs.c | 6 +++--- lapack-netlib/SRC/ztfsm.c | 6 +++--- lapack-netlib/SRC/ztftri.c | 6 +++--- lapack-netlib/SRC/ztfttp.c | 6 +++--- lapack-netlib/SRC/ztfttr.c | 6 +++--- lapack-netlib/SRC/ztgevc.c | 6 +++--- lapack-netlib/SRC/ztgex2.c | 6 +++--- lapack-netlib/SRC/ztgexc.c | 6 +++--- lapack-netlib/SRC/ztgsen.c | 6 +++--- lapack-netlib/SRC/ztgsja.c | 6 +++--- lapack-netlib/SRC/ztgsna.c | 6 +++--- lapack-netlib/SRC/ztgsy2.c | 6 +++--- lapack-netlib/SRC/ztgsyl.c | 6 +++--- lapack-netlib/SRC/ztpcon.c | 6 +++--- lapack-netlib/SRC/ztplqt.c | 6 +++--- lapack-netlib/SRC/ztplqt2.c | 6 +++--- lapack-netlib/SRC/ztpmlqt.c | 6 +++--- lapack-netlib/SRC/ztpmqrt.c | 6 +++--- lapack-netlib/SRC/ztpqrt.c | 6 +++--- lapack-netlib/SRC/ztpqrt2.c | 6 +++--- lapack-netlib/SRC/ztprfb.c | 6 +++--- lapack-netlib/SRC/ztprfs.c | 6 +++--- lapack-netlib/SRC/ztptri.c | 6 +++--- lapack-netlib/SRC/ztptrs.c | 6 +++--- lapack-netlib/SRC/ztpttf.c | 6 +++--- lapack-netlib/SRC/ztpttr.c | 6 +++--- lapack-netlib/SRC/ztrcon.c | 6 +++--- lapack-netlib/SRC/ztrevc.c | 6 +++--- lapack-netlib/SRC/ztrevc3.c | 6 +++--- lapack-netlib/SRC/ztrexc.c | 6 +++--- lapack-netlib/SRC/ztrrfs.c | 6 +++--- lapack-netlib/SRC/ztrsen.c | 6 +++--- lapack-netlib/SRC/ztrsna.c | 6 +++--- 90 files changed, 270 insertions(+), 270 deletions(-) diff --git a/lapack-netlib/SRC/zrot.c b/lapack-netlib/SRC/zrot.c index da9b20037..f55349182 100644 --- a/lapack-netlib/SRC/zrot.c +++ b/lapack-netlib/SRC/zrot.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zrscl.c b/lapack-netlib/SRC/zrscl.c index 2264b5465..97eb3b91f 100644 --- a/lapack-netlib/SRC/zrscl.c +++ b/lapack-netlib/SRC/zrscl.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zspcon.c b/lapack-netlib/SRC/zspcon.c index 21cc74cdb..b53e45043 100644 --- a/lapack-netlib/SRC/zspcon.c +++ b/lapack-netlib/SRC/zspcon.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zspmv.c b/lapack-netlib/SRC/zspmv.c index e0bd139b5..66e3d008b 100644 --- a/lapack-netlib/SRC/zspmv.c +++ b/lapack-netlib/SRC/zspmv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zspr.c b/lapack-netlib/SRC/zspr.c index 9aa4b9b03..d15d8ba3e 100644 --- a/lapack-netlib/SRC/zspr.c +++ b/lapack-netlib/SRC/zspr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zsprfs.c b/lapack-netlib/SRC/zsprfs.c index 2a8b99582..5998f7a43 100644 --- a/lapack-netlib/SRC/zsprfs.c +++ b/lapack-netlib/SRC/zsprfs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zspsv.c b/lapack-netlib/SRC/zspsv.c index 31c89538e..9de93d297 100644 --- a/lapack-netlib/SRC/zspsv.c +++ b/lapack-netlib/SRC/zspsv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zspsvx.c b/lapack-netlib/SRC/zspsvx.c index f51ca179e..5df091420 100644 --- a/lapack-netlib/SRC/zspsvx.c +++ b/lapack-netlib/SRC/zspsvx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zsptrf.c b/lapack-netlib/SRC/zsptrf.c index e423f831e..9d2263751 100644 --- a/lapack-netlib/SRC/zsptrf.c +++ b/lapack-netlib/SRC/zsptrf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zsptri.c b/lapack-netlib/SRC/zsptri.c index 7a3d97631..e8ec90fdb 100644 --- a/lapack-netlib/SRC/zsptri.c +++ b/lapack-netlib/SRC/zsptri.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zsptrs.c b/lapack-netlib/SRC/zsptrs.c index 45cb7a79a..9717f795d 100644 --- a/lapack-netlib/SRC/zsptrs.c +++ b/lapack-netlib/SRC/zsptrs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zstedc.c b/lapack-netlib/SRC/zstedc.c index b75747133..85e3d6716 100644 --- a/lapack-netlib/SRC/zstedc.c +++ b/lapack-netlib/SRC/zstedc.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zstegr.c b/lapack-netlib/SRC/zstegr.c index d685404cd..c307a0457 100644 --- a/lapack-netlib/SRC/zstegr.c +++ b/lapack-netlib/SRC/zstegr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zstein.c b/lapack-netlib/SRC/zstein.c index bbe439c48..7fb3a13ac 100644 --- a/lapack-netlib/SRC/zstein.c +++ b/lapack-netlib/SRC/zstein.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zstemr.c b/lapack-netlib/SRC/zstemr.c index 28af7cff5..90e22f304 100644 --- a/lapack-netlib/SRC/zstemr.c +++ b/lapack-netlib/SRC/zstemr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zsteqr.c b/lapack-netlib/SRC/zsteqr.c index 42782baab..87a496d3a 100644 --- a/lapack-netlib/SRC/zsteqr.c +++ b/lapack-netlib/SRC/zsteqr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zsycon.c b/lapack-netlib/SRC/zsycon.c index 2842546af..92676d76a 100644 --- a/lapack-netlib/SRC/zsycon.c +++ b/lapack-netlib/SRC/zsycon.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zsycon_3.c b/lapack-netlib/SRC/zsycon_3.c index cd0bf7f96..9e70198c2 100644 --- a/lapack-netlib/SRC/zsycon_3.c +++ b/lapack-netlib/SRC/zsycon_3.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zsycon_rook.c b/lapack-netlib/SRC/zsycon_rook.c index 0fe88cbdb..0198a7669 100644 --- a/lapack-netlib/SRC/zsycon_rook.c +++ b/lapack-netlib/SRC/zsycon_rook.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zsyconv.c b/lapack-netlib/SRC/zsyconv.c index b0acec29a..24d1e02ac 100644 --- a/lapack-netlib/SRC/zsyconv.c +++ b/lapack-netlib/SRC/zsyconv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zsyconvf.c b/lapack-netlib/SRC/zsyconvf.c index 1313bb4e6..84d710b81 100644 --- a/lapack-netlib/SRC/zsyconvf.c +++ b/lapack-netlib/SRC/zsyconvf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zsyconvf_rook.c b/lapack-netlib/SRC/zsyconvf_rook.c index 05cefa81a..06b44c7c1 100644 --- a/lapack-netlib/SRC/zsyconvf_rook.c +++ b/lapack-netlib/SRC/zsyconvf_rook.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zsyequb.c b/lapack-netlib/SRC/zsyequb.c index 9f740710f..12535c8bf 100644 --- a/lapack-netlib/SRC/zsyequb.c +++ b/lapack-netlib/SRC/zsyequb.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zsymv.c b/lapack-netlib/SRC/zsymv.c index 7729d3f43..1eca75bd9 100644 --- a/lapack-netlib/SRC/zsymv.c +++ b/lapack-netlib/SRC/zsymv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zsyr.c b/lapack-netlib/SRC/zsyr.c index bacc1cf54..27cf8e8d9 100644 --- a/lapack-netlib/SRC/zsyr.c +++ b/lapack-netlib/SRC/zsyr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zsyrfs.c b/lapack-netlib/SRC/zsyrfs.c index 31a54c120..2c46ef6e8 100644 --- a/lapack-netlib/SRC/zsyrfs.c +++ b/lapack-netlib/SRC/zsyrfs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zsyrfsx.c b/lapack-netlib/SRC/zsyrfsx.c index aa3ac4f72..61885f2fe 100644 --- a/lapack-netlib/SRC/zsyrfsx.c +++ b/lapack-netlib/SRC/zsyrfsx.c @@ -54,8 +54,8 @@ static inline _Complex float * _pCf(complex *z) {return (_Complex float*)z;} static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double*)z;} #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -257,7 +257,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zsysv.c b/lapack-netlib/SRC/zsysv.c index ffa5a09f9..5bf2fada1 100644 --- a/lapack-netlib/SRC/zsysv.c +++ b/lapack-netlib/SRC/zsysv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zsysv_aa.c b/lapack-netlib/SRC/zsysv_aa.c index 2b226200e..f27b1f96a 100644 --- a/lapack-netlib/SRC/zsysv_aa.c +++ b/lapack-netlib/SRC/zsysv_aa.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zsysv_aa_2stage.c b/lapack-netlib/SRC/zsysv_aa_2stage.c index d2ed5e3c8..5f8fc82f8 100644 --- a/lapack-netlib/SRC/zsysv_aa_2stage.c +++ b/lapack-netlib/SRC/zsysv_aa_2stage.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zsysv_rk.c b/lapack-netlib/SRC/zsysv_rk.c index 01a75aaec..d38c78e0b 100644 --- a/lapack-netlib/SRC/zsysv_rk.c +++ b/lapack-netlib/SRC/zsysv_rk.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zsysv_rook.c b/lapack-netlib/SRC/zsysv_rook.c index c0ea7bb1f..161a51136 100644 --- a/lapack-netlib/SRC/zsysv_rook.c +++ b/lapack-netlib/SRC/zsysv_rook.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zsysvx.c b/lapack-netlib/SRC/zsysvx.c index 29302ff76..39d23fd5f 100644 --- a/lapack-netlib/SRC/zsysvx.c +++ b/lapack-netlib/SRC/zsysvx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zsysvxx.c b/lapack-netlib/SRC/zsysvxx.c index ff18cc709..f3c0f95d0 100644 --- a/lapack-netlib/SRC/zsysvxx.c +++ b/lapack-netlib/SRC/zsysvxx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zsyswapr.c b/lapack-netlib/SRC/zsyswapr.c index 86f925d1a..1d5772cd9 100644 --- a/lapack-netlib/SRC/zsyswapr.c +++ b/lapack-netlib/SRC/zsyswapr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zsytf2.c b/lapack-netlib/SRC/zsytf2.c index 7d84395df..3fba2c67a 100644 --- a/lapack-netlib/SRC/zsytf2.c +++ b/lapack-netlib/SRC/zsytf2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zsytf2_rk.c b/lapack-netlib/SRC/zsytf2_rk.c index 61596a996..68a28e004 100644 --- a/lapack-netlib/SRC/zsytf2_rk.c +++ b/lapack-netlib/SRC/zsytf2_rk.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zsytf2_rook.c b/lapack-netlib/SRC/zsytf2_rook.c index 0ffd6dd78..eb3b1b275 100644 --- a/lapack-netlib/SRC/zsytf2_rook.c +++ b/lapack-netlib/SRC/zsytf2_rook.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zsytrf.c b/lapack-netlib/SRC/zsytrf.c index 9aac589ad..c13bcdb10 100644 --- a/lapack-netlib/SRC/zsytrf.c +++ b/lapack-netlib/SRC/zsytrf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zsytrf_aa.c b/lapack-netlib/SRC/zsytrf_aa.c index 29a3dcb7c..1b260572c 100644 --- a/lapack-netlib/SRC/zsytrf_aa.c +++ b/lapack-netlib/SRC/zsytrf_aa.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zsytrf_aa_2stage.c b/lapack-netlib/SRC/zsytrf_aa_2stage.c index a3d6a39b6..44178bc43 100644 --- a/lapack-netlib/SRC/zsytrf_aa_2stage.c +++ b/lapack-netlib/SRC/zsytrf_aa_2stage.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zsytrf_rk.c b/lapack-netlib/SRC/zsytrf_rk.c index a87821837..fe5607a02 100644 --- a/lapack-netlib/SRC/zsytrf_rk.c +++ b/lapack-netlib/SRC/zsytrf_rk.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zsytrf_rook.c b/lapack-netlib/SRC/zsytrf_rook.c index 6c02245a2..cf9a7940a 100644 --- a/lapack-netlib/SRC/zsytrf_rook.c +++ b/lapack-netlib/SRC/zsytrf_rook.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zsytri.c b/lapack-netlib/SRC/zsytri.c index cf9a70251..4b9e1418f 100644 --- a/lapack-netlib/SRC/zsytri.c +++ b/lapack-netlib/SRC/zsytri.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zsytri2.c b/lapack-netlib/SRC/zsytri2.c index 31f65bdac..1899883a1 100644 --- a/lapack-netlib/SRC/zsytri2.c +++ b/lapack-netlib/SRC/zsytri2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zsytri2x.c b/lapack-netlib/SRC/zsytri2x.c index cacd30379..4462ed6de 100644 --- a/lapack-netlib/SRC/zsytri2x.c +++ b/lapack-netlib/SRC/zsytri2x.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zsytri_3.c b/lapack-netlib/SRC/zsytri_3.c index 9a1fe7b6d..c36fa5e86 100644 --- a/lapack-netlib/SRC/zsytri_3.c +++ b/lapack-netlib/SRC/zsytri_3.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zsytri_3x.c b/lapack-netlib/SRC/zsytri_3x.c index e5575d293..7c214afca 100644 --- a/lapack-netlib/SRC/zsytri_3x.c +++ b/lapack-netlib/SRC/zsytri_3x.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zsytri_rook.c b/lapack-netlib/SRC/zsytri_rook.c index 2899d12f0..2e956e3a5 100644 --- a/lapack-netlib/SRC/zsytri_rook.c +++ b/lapack-netlib/SRC/zsytri_rook.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zsytrs.c b/lapack-netlib/SRC/zsytrs.c index a31b3e9f2..d3b41ebfe 100644 --- a/lapack-netlib/SRC/zsytrs.c +++ b/lapack-netlib/SRC/zsytrs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zsytrs2.c b/lapack-netlib/SRC/zsytrs2.c index b377b7f5d..9a52a245b 100644 --- a/lapack-netlib/SRC/zsytrs2.c +++ b/lapack-netlib/SRC/zsytrs2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zsytrs_3.c b/lapack-netlib/SRC/zsytrs_3.c index 7d1763c04..c296b6ba3 100644 --- a/lapack-netlib/SRC/zsytrs_3.c +++ b/lapack-netlib/SRC/zsytrs_3.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zsytrs_aa.c b/lapack-netlib/SRC/zsytrs_aa.c index 7983cd087..00e03d982 100644 --- a/lapack-netlib/SRC/zsytrs_aa.c +++ b/lapack-netlib/SRC/zsytrs_aa.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zsytrs_aa_2stage.c b/lapack-netlib/SRC/zsytrs_aa_2stage.c index 0bb91f940..0641f49b0 100644 --- a/lapack-netlib/SRC/zsytrs_aa_2stage.c +++ b/lapack-netlib/SRC/zsytrs_aa_2stage.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zsytrs_rook.c b/lapack-netlib/SRC/zsytrs_rook.c index 2a01c9461..994bbf5cc 100644 --- a/lapack-netlib/SRC/zsytrs_rook.c +++ b/lapack-netlib/SRC/zsytrs_rook.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ztbcon.c b/lapack-netlib/SRC/ztbcon.c index 5fcd4e0b2..7fedf5966 100644 --- a/lapack-netlib/SRC/ztbcon.c +++ b/lapack-netlib/SRC/ztbcon.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ztbrfs.c b/lapack-netlib/SRC/ztbrfs.c index a34d2fae8..96b9eb9cb 100644 --- a/lapack-netlib/SRC/ztbrfs.c +++ b/lapack-netlib/SRC/ztbrfs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ztbtrs.c b/lapack-netlib/SRC/ztbtrs.c index 25c365744..2391f4bba 100644 --- a/lapack-netlib/SRC/ztbtrs.c +++ b/lapack-netlib/SRC/ztbtrs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ztfsm.c b/lapack-netlib/SRC/ztfsm.c index f96df7d01..f6cb622fb 100644 --- a/lapack-netlib/SRC/ztfsm.c +++ b/lapack-netlib/SRC/ztfsm.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ztftri.c b/lapack-netlib/SRC/ztftri.c index 8a69fb313..05aee16c6 100644 --- a/lapack-netlib/SRC/ztftri.c +++ b/lapack-netlib/SRC/ztftri.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ztfttp.c b/lapack-netlib/SRC/ztfttp.c index 4b5372f9e..c206a32f5 100644 --- a/lapack-netlib/SRC/ztfttp.c +++ b/lapack-netlib/SRC/ztfttp.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ztfttr.c b/lapack-netlib/SRC/ztfttr.c index fd4be1edc..6bf640c0e 100644 --- a/lapack-netlib/SRC/ztfttr.c +++ b/lapack-netlib/SRC/ztfttr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ztgevc.c b/lapack-netlib/SRC/ztgevc.c index b9af414f8..c804aa8bd 100644 --- a/lapack-netlib/SRC/ztgevc.c +++ b/lapack-netlib/SRC/ztgevc.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ztgex2.c b/lapack-netlib/SRC/ztgex2.c index c11096b23..87a3fb8fe 100644 --- a/lapack-netlib/SRC/ztgex2.c +++ b/lapack-netlib/SRC/ztgex2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ztgexc.c b/lapack-netlib/SRC/ztgexc.c index 9b0a524a8..398b645b6 100644 --- a/lapack-netlib/SRC/ztgexc.c +++ b/lapack-netlib/SRC/ztgexc.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ztgsen.c b/lapack-netlib/SRC/ztgsen.c index 8484a391b..e4e380153 100644 --- a/lapack-netlib/SRC/ztgsen.c +++ b/lapack-netlib/SRC/ztgsen.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ztgsja.c b/lapack-netlib/SRC/ztgsja.c index e2253749f..e1bed2af6 100644 --- a/lapack-netlib/SRC/ztgsja.c +++ b/lapack-netlib/SRC/ztgsja.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ztgsna.c b/lapack-netlib/SRC/ztgsna.c index 797943f44..0e5ee68d4 100644 --- a/lapack-netlib/SRC/ztgsna.c +++ b/lapack-netlib/SRC/ztgsna.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ztgsy2.c b/lapack-netlib/SRC/ztgsy2.c index 0dab49991..63ef528e1 100644 --- a/lapack-netlib/SRC/ztgsy2.c +++ b/lapack-netlib/SRC/ztgsy2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ztgsyl.c b/lapack-netlib/SRC/ztgsyl.c index 3b11a13ac..0f8d3ed95 100644 --- a/lapack-netlib/SRC/ztgsyl.c +++ b/lapack-netlib/SRC/ztgsyl.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ztpcon.c b/lapack-netlib/SRC/ztpcon.c index 2224c2cef..806b2b0c3 100644 --- a/lapack-netlib/SRC/ztpcon.c +++ b/lapack-netlib/SRC/ztpcon.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ztplqt.c b/lapack-netlib/SRC/ztplqt.c index c21618cfe..9bac887e7 100644 --- a/lapack-netlib/SRC/ztplqt.c +++ b/lapack-netlib/SRC/ztplqt.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ztplqt2.c b/lapack-netlib/SRC/ztplqt2.c index ac9a4a100..8f2abc22e 100644 --- a/lapack-netlib/SRC/ztplqt2.c +++ b/lapack-netlib/SRC/ztplqt2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ztpmlqt.c b/lapack-netlib/SRC/ztpmlqt.c index 10adc30cc..a917fc59e 100644 --- a/lapack-netlib/SRC/ztpmlqt.c +++ b/lapack-netlib/SRC/ztpmlqt.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ztpmqrt.c b/lapack-netlib/SRC/ztpmqrt.c index 7118487bd..4efc3d5a4 100644 --- a/lapack-netlib/SRC/ztpmqrt.c +++ b/lapack-netlib/SRC/ztpmqrt.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ztpqrt.c b/lapack-netlib/SRC/ztpqrt.c index ce4688f95..f122c648f 100644 --- a/lapack-netlib/SRC/ztpqrt.c +++ b/lapack-netlib/SRC/ztpqrt.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ztpqrt2.c b/lapack-netlib/SRC/ztpqrt2.c index 659937549..de2431fec 100644 --- a/lapack-netlib/SRC/ztpqrt2.c +++ b/lapack-netlib/SRC/ztpqrt2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ztprfb.c b/lapack-netlib/SRC/ztprfb.c index 558b6e0d1..63c72a281 100644 --- a/lapack-netlib/SRC/ztprfb.c +++ b/lapack-netlib/SRC/ztprfb.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ztprfs.c b/lapack-netlib/SRC/ztprfs.c index a979964b1..1833cea18 100644 --- a/lapack-netlib/SRC/ztprfs.c +++ b/lapack-netlib/SRC/ztprfs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ztptri.c b/lapack-netlib/SRC/ztptri.c index 1778f4fdd..ad8e80420 100644 --- a/lapack-netlib/SRC/ztptri.c +++ b/lapack-netlib/SRC/ztptri.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ztptrs.c b/lapack-netlib/SRC/ztptrs.c index 072b8dcd2..296218894 100644 --- a/lapack-netlib/SRC/ztptrs.c +++ b/lapack-netlib/SRC/ztptrs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ztpttf.c b/lapack-netlib/SRC/ztpttf.c index 420fa0275..07e6888d3 100644 --- a/lapack-netlib/SRC/ztpttf.c +++ b/lapack-netlib/SRC/ztpttf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ztpttr.c b/lapack-netlib/SRC/ztpttr.c index 0f1255854..54b334e32 100644 --- a/lapack-netlib/SRC/ztpttr.c +++ b/lapack-netlib/SRC/ztpttr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ztrcon.c b/lapack-netlib/SRC/ztrcon.c index 1f5e58fe4..dfd926a3c 100644 --- a/lapack-netlib/SRC/ztrcon.c +++ b/lapack-netlib/SRC/ztrcon.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ztrevc.c b/lapack-netlib/SRC/ztrevc.c index 3f1b5a96e..5e43feed1 100644 --- a/lapack-netlib/SRC/ztrevc.c +++ b/lapack-netlib/SRC/ztrevc.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ztrevc3.c b/lapack-netlib/SRC/ztrevc3.c index 8a4e723f8..3b2c097a0 100644 --- a/lapack-netlib/SRC/ztrevc3.c +++ b/lapack-netlib/SRC/ztrevc3.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ztrexc.c b/lapack-netlib/SRC/ztrexc.c index aac01362c..e47ce5ceb 100644 --- a/lapack-netlib/SRC/ztrexc.c +++ b/lapack-netlib/SRC/ztrexc.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ztrrfs.c b/lapack-netlib/SRC/ztrrfs.c index e7b8020de..c6767a17c 100644 --- a/lapack-netlib/SRC/ztrrfs.c +++ b/lapack-netlib/SRC/ztrrfs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ztrsen.c b/lapack-netlib/SRC/ztrsen.c index 117e56249..3edf169fc 100644 --- a/lapack-netlib/SRC/ztrsen.c +++ b/lapack-netlib/SRC/ztrsen.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ztrsna.c b/lapack-netlib/SRC/ztrsna.c index 26b8bdc0c..ecd2158ec 100644 --- a/lapack-netlib/SRC/ztrsna.c +++ b/lapack-netlib/SRC/ztrsna.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else From b1da12356d6c2a9a6fb51276c22e7a82e9b894ce Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Wed, 3 Apr 2024 23:00:54 +0200 Subject: [PATCH 273/311] fix typedef of logical to support INTERFACE64 --- lapack-netlib/SRC/zlaswp.c | 6 +++--- lapack-netlib/SRC/zlasyf.c | 6 +++--- lapack-netlib/SRC/zlasyf_aa.c | 6 +++--- lapack-netlib/SRC/zlasyf_rk.c | 6 +++--- lapack-netlib/SRC/zlasyf_rook.c | 6 +++--- lapack-netlib/SRC/zlat2c.c | 6 +++--- lapack-netlib/SRC/zlatbs.c | 6 +++--- lapack-netlib/SRC/zlatdf.c | 6 +++--- lapack-netlib/SRC/zlatps.c | 6 +++--- lapack-netlib/SRC/zlatrd.c | 6 +++--- lapack-netlib/SRC/zlatrs.c | 6 +++--- lapack-netlib/SRC/zlatrs3.c | 6 +++--- lapack-netlib/SRC/zlatrz.c | 6 +++--- lapack-netlib/SRC/zlatsqr.c | 6 +++--- lapack-netlib/SRC/zlaunhr_col_getrfnp.c | 6 +++--- lapack-netlib/SRC/zlaunhr_col_getrfnp2.c | 6 +++--- lapack-netlib/SRC/zlauu2.c | 6 +++--- lapack-netlib/SRC/zlauum.c | 6 +++--- lapack-netlib/SRC/zpbcon.c | 6 +++--- lapack-netlib/SRC/zpbequ.c | 6 +++--- lapack-netlib/SRC/zpbrfs.c | 6 +++--- lapack-netlib/SRC/zpbstf.c | 6 +++--- lapack-netlib/SRC/zpbsv.c | 6 +++--- lapack-netlib/SRC/zpbsvx.c | 6 +++--- lapack-netlib/SRC/zpbtf2.c | 6 +++--- lapack-netlib/SRC/zpbtrf.c | 6 +++--- lapack-netlib/SRC/zpbtrs.c | 6 +++--- lapack-netlib/SRC/zpftrf.c | 6 +++--- lapack-netlib/SRC/zpftri.c | 6 +++--- lapack-netlib/SRC/zpftrs.c | 6 +++--- lapack-netlib/SRC/zpocon.c | 6 +++--- lapack-netlib/SRC/zpoequ.c | 6 +++--- lapack-netlib/SRC/zpoequb.c | 6 +++--- lapack-netlib/SRC/zporfs.c | 6 +++--- lapack-netlib/SRC/zporfsx.c | 6 +++--- lapack-netlib/SRC/zposv.c | 6 +++--- lapack-netlib/SRC/zposvx.c | 6 +++--- lapack-netlib/SRC/zposvxx.c | 6 +++--- lapack-netlib/SRC/zpotf2.c | 6 +++--- lapack-netlib/SRC/zpotrf.c | 6 +++--- lapack-netlib/SRC/zpotrf2.c | 6 +++--- lapack-netlib/SRC/zpotri.c | 6 +++--- lapack-netlib/SRC/zpotrs.c | 6 +++--- lapack-netlib/SRC/zppcon.c | 6 +++--- lapack-netlib/SRC/zppequ.c | 6 +++--- lapack-netlib/SRC/zpprfs.c | 6 +++--- lapack-netlib/SRC/zppsv.c | 6 +++--- lapack-netlib/SRC/zppsvx.c | 6 +++--- lapack-netlib/SRC/zpptrf.c | 6 +++--- lapack-netlib/SRC/zpptri.c | 6 +++--- lapack-netlib/SRC/zpptrs.c | 6 +++--- lapack-netlib/SRC/zpstf2.c | 6 +++--- lapack-netlib/SRC/zpstrf.c | 6 +++--- lapack-netlib/SRC/zptcon.c | 6 +++--- lapack-netlib/SRC/zpteqr.c | 6 +++--- lapack-netlib/SRC/zptrfs.c | 6 +++--- lapack-netlib/SRC/zptsv.c | 6 +++--- lapack-netlib/SRC/zptsvx.c | 6 +++--- lapack-netlib/SRC/zpttrf.c | 6 +++--- lapack-netlib/SRC/zpttrs.c | 6 +++--- lapack-netlib/SRC/zptts2.c | 6 +++--- 61 files changed, 183 insertions(+), 183 deletions(-) diff --git a/lapack-netlib/SRC/zlaswp.c b/lapack-netlib/SRC/zlaswp.c index 84616be2b..eee4de061 100644 --- a/lapack-netlib/SRC/zlaswp.c +++ b/lapack-netlib/SRC/zlaswp.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlasyf.c b/lapack-netlib/SRC/zlasyf.c index f52e18b6a..cc26f87e0 100644 --- a/lapack-netlib/SRC/zlasyf.c +++ b/lapack-netlib/SRC/zlasyf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlasyf_aa.c b/lapack-netlib/SRC/zlasyf_aa.c index 6a769f996..d5bc9fe1a 100644 --- a/lapack-netlib/SRC/zlasyf_aa.c +++ b/lapack-netlib/SRC/zlasyf_aa.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlasyf_rk.c b/lapack-netlib/SRC/zlasyf_rk.c index a8690e3b0..f388372b2 100644 --- a/lapack-netlib/SRC/zlasyf_rk.c +++ b/lapack-netlib/SRC/zlasyf_rk.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlasyf_rook.c b/lapack-netlib/SRC/zlasyf_rook.c index 09ff4c304..6c1302aeb 100644 --- a/lapack-netlib/SRC/zlasyf_rook.c +++ b/lapack-netlib/SRC/zlasyf_rook.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlat2c.c b/lapack-netlib/SRC/zlat2c.c index a11ce7f97..a3a2de70d 100644 --- a/lapack-netlib/SRC/zlat2c.c +++ b/lapack-netlib/SRC/zlat2c.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlatbs.c b/lapack-netlib/SRC/zlatbs.c index f862c1488..33e73dbf2 100644 --- a/lapack-netlib/SRC/zlatbs.c +++ b/lapack-netlib/SRC/zlatbs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlatdf.c b/lapack-netlib/SRC/zlatdf.c index 125fc1752..a207a62cb 100644 --- a/lapack-netlib/SRC/zlatdf.c +++ b/lapack-netlib/SRC/zlatdf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlatps.c b/lapack-netlib/SRC/zlatps.c index f73d72e71..125cc4425 100644 --- a/lapack-netlib/SRC/zlatps.c +++ b/lapack-netlib/SRC/zlatps.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlatrd.c b/lapack-netlib/SRC/zlatrd.c index 81a3479f7..9a6cf3b13 100644 --- a/lapack-netlib/SRC/zlatrd.c +++ b/lapack-netlib/SRC/zlatrd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlatrs.c b/lapack-netlib/SRC/zlatrs.c index 71122e2cc..6bd493c1f 100644 --- a/lapack-netlib/SRC/zlatrs.c +++ b/lapack-netlib/SRC/zlatrs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlatrs3.c b/lapack-netlib/SRC/zlatrs3.c index 0afc8d26c..dddf96eea 100644 --- a/lapack-netlib/SRC/zlatrs3.c +++ b/lapack-netlib/SRC/zlatrs3.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -263,7 +263,7 @@ static int my_expfunc(double *x) {int e; (void)frexp(*x,&e); return e;} /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlatrz.c b/lapack-netlib/SRC/zlatrz.c index 69be8eaa8..3c2b754fd 100644 --- a/lapack-netlib/SRC/zlatrz.c +++ b/lapack-netlib/SRC/zlatrz.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlatsqr.c b/lapack-netlib/SRC/zlatsqr.c index 7e98a6203..baa0e5511 100644 --- a/lapack-netlib/SRC/zlatsqr.c +++ b/lapack-netlib/SRC/zlatsqr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlaunhr_col_getrfnp.c b/lapack-netlib/SRC/zlaunhr_col_getrfnp.c index ed22ca82e..82393ba86 100644 --- a/lapack-netlib/SRC/zlaunhr_col_getrfnp.c +++ b/lapack-netlib/SRC/zlaunhr_col_getrfnp.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlaunhr_col_getrfnp2.c b/lapack-netlib/SRC/zlaunhr_col_getrfnp2.c index acf267024..91d93849d 100644 --- a/lapack-netlib/SRC/zlaunhr_col_getrfnp2.c +++ b/lapack-netlib/SRC/zlaunhr_col_getrfnp2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlauu2.c b/lapack-netlib/SRC/zlauu2.c index 9a8dbea6d..0086794da 100644 --- a/lapack-netlib/SRC/zlauu2.c +++ b/lapack-netlib/SRC/zlauu2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlauum.c b/lapack-netlib/SRC/zlauum.c index b8331beee..0f3a5528b 100644 --- a/lapack-netlib/SRC/zlauum.c +++ b/lapack-netlib/SRC/zlauum.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zpbcon.c b/lapack-netlib/SRC/zpbcon.c index 36d2dac74..574e5d79f 100644 --- a/lapack-netlib/SRC/zpbcon.c +++ b/lapack-netlib/SRC/zpbcon.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zpbequ.c b/lapack-netlib/SRC/zpbequ.c index eecf4b2f8..d4b46d313 100644 --- a/lapack-netlib/SRC/zpbequ.c +++ b/lapack-netlib/SRC/zpbequ.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zpbrfs.c b/lapack-netlib/SRC/zpbrfs.c index 7e1166d9d..d3f813d41 100644 --- a/lapack-netlib/SRC/zpbrfs.c +++ b/lapack-netlib/SRC/zpbrfs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zpbstf.c b/lapack-netlib/SRC/zpbstf.c index c46dcb8c3..78b5d1b75 100644 --- a/lapack-netlib/SRC/zpbstf.c +++ b/lapack-netlib/SRC/zpbstf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zpbsv.c b/lapack-netlib/SRC/zpbsv.c index a9a19b714..c4fe2e1e7 100644 --- a/lapack-netlib/SRC/zpbsv.c +++ b/lapack-netlib/SRC/zpbsv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zpbsvx.c b/lapack-netlib/SRC/zpbsvx.c index 83b923883..43b487403 100644 --- a/lapack-netlib/SRC/zpbsvx.c +++ b/lapack-netlib/SRC/zpbsvx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zpbtf2.c b/lapack-netlib/SRC/zpbtf2.c index f050b9602..3454ca6f7 100644 --- a/lapack-netlib/SRC/zpbtf2.c +++ b/lapack-netlib/SRC/zpbtf2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zpbtrf.c b/lapack-netlib/SRC/zpbtrf.c index 268d1c101..6dfc68947 100644 --- a/lapack-netlib/SRC/zpbtrf.c +++ b/lapack-netlib/SRC/zpbtrf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zpbtrs.c b/lapack-netlib/SRC/zpbtrs.c index 3e8d2cf79..e1eb3415a 100644 --- a/lapack-netlib/SRC/zpbtrs.c +++ b/lapack-netlib/SRC/zpbtrs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zpftrf.c b/lapack-netlib/SRC/zpftrf.c index f2231e331..1c01e97b7 100644 --- a/lapack-netlib/SRC/zpftrf.c +++ b/lapack-netlib/SRC/zpftrf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zpftri.c b/lapack-netlib/SRC/zpftri.c index 52ab6aff5..2e0045390 100644 --- a/lapack-netlib/SRC/zpftri.c +++ b/lapack-netlib/SRC/zpftri.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zpftrs.c b/lapack-netlib/SRC/zpftrs.c index 26aaaa61c..7206231ff 100644 --- a/lapack-netlib/SRC/zpftrs.c +++ b/lapack-netlib/SRC/zpftrs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zpocon.c b/lapack-netlib/SRC/zpocon.c index 4eecb1316..51305a415 100644 --- a/lapack-netlib/SRC/zpocon.c +++ b/lapack-netlib/SRC/zpocon.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zpoequ.c b/lapack-netlib/SRC/zpoequ.c index e3fcc4892..59ff410db 100644 --- a/lapack-netlib/SRC/zpoequ.c +++ b/lapack-netlib/SRC/zpoequ.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zpoequb.c b/lapack-netlib/SRC/zpoequb.c index 54c36e772..c323ec60c 100644 --- a/lapack-netlib/SRC/zpoequb.c +++ b/lapack-netlib/SRC/zpoequb.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zporfs.c b/lapack-netlib/SRC/zporfs.c index 9b963c44a..aebda152e 100644 --- a/lapack-netlib/SRC/zporfs.c +++ b/lapack-netlib/SRC/zporfs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zporfsx.c b/lapack-netlib/SRC/zporfsx.c index aa3ac4f72..61885f2fe 100644 --- a/lapack-netlib/SRC/zporfsx.c +++ b/lapack-netlib/SRC/zporfsx.c @@ -54,8 +54,8 @@ static inline _Complex float * _pCf(complex *z) {return (_Complex float*)z;} static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double*)z;} #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -257,7 +257,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zposv.c b/lapack-netlib/SRC/zposv.c index a577d5315..cc8fbf581 100644 --- a/lapack-netlib/SRC/zposv.c +++ b/lapack-netlib/SRC/zposv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zposvx.c b/lapack-netlib/SRC/zposvx.c index 10032d758..b8a0150ef 100644 --- a/lapack-netlib/SRC/zposvx.c +++ b/lapack-netlib/SRC/zposvx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zposvxx.c b/lapack-netlib/SRC/zposvxx.c index b6473cf98..a62619cbf 100644 --- a/lapack-netlib/SRC/zposvxx.c +++ b/lapack-netlib/SRC/zposvxx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zpotf2.c b/lapack-netlib/SRC/zpotf2.c index 594f33802..c4c8c77ff 100644 --- a/lapack-netlib/SRC/zpotf2.c +++ b/lapack-netlib/SRC/zpotf2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zpotrf.c b/lapack-netlib/SRC/zpotrf.c index 99dd13bde..37d1babb7 100644 --- a/lapack-netlib/SRC/zpotrf.c +++ b/lapack-netlib/SRC/zpotrf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zpotrf2.c b/lapack-netlib/SRC/zpotrf2.c index 0b773aae6..0520c7fe5 100644 --- a/lapack-netlib/SRC/zpotrf2.c +++ b/lapack-netlib/SRC/zpotrf2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zpotri.c b/lapack-netlib/SRC/zpotri.c index 92b0f844b..f4f5d7617 100644 --- a/lapack-netlib/SRC/zpotri.c +++ b/lapack-netlib/SRC/zpotri.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zpotrs.c b/lapack-netlib/SRC/zpotrs.c index ddbe496e5..c01deca93 100644 --- a/lapack-netlib/SRC/zpotrs.c +++ b/lapack-netlib/SRC/zpotrs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zppcon.c b/lapack-netlib/SRC/zppcon.c index 541c330af..e44f73a49 100644 --- a/lapack-netlib/SRC/zppcon.c +++ b/lapack-netlib/SRC/zppcon.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zppequ.c b/lapack-netlib/SRC/zppequ.c index 7b7d7be22..04d5955ab 100644 --- a/lapack-netlib/SRC/zppequ.c +++ b/lapack-netlib/SRC/zppequ.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zpprfs.c b/lapack-netlib/SRC/zpprfs.c index 652d53cbc..80bca1606 100644 --- a/lapack-netlib/SRC/zpprfs.c +++ b/lapack-netlib/SRC/zpprfs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zppsv.c b/lapack-netlib/SRC/zppsv.c index 4788368fc..46784aded 100644 --- a/lapack-netlib/SRC/zppsv.c +++ b/lapack-netlib/SRC/zppsv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zppsvx.c b/lapack-netlib/SRC/zppsvx.c index ff1cb299e..2b3446572 100644 --- a/lapack-netlib/SRC/zppsvx.c +++ b/lapack-netlib/SRC/zppsvx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zpptrf.c b/lapack-netlib/SRC/zpptrf.c index 8e099c203..c595af7e0 100644 --- a/lapack-netlib/SRC/zpptrf.c +++ b/lapack-netlib/SRC/zpptrf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zpptri.c b/lapack-netlib/SRC/zpptri.c index 215e34379..f05e6e6bb 100644 --- a/lapack-netlib/SRC/zpptri.c +++ b/lapack-netlib/SRC/zpptri.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zpptrs.c b/lapack-netlib/SRC/zpptrs.c index 4ede1c717..7c88d70ff 100644 --- a/lapack-netlib/SRC/zpptrs.c +++ b/lapack-netlib/SRC/zpptrs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zpstf2.c b/lapack-netlib/SRC/zpstf2.c index 9fa691324..4d563869e 100644 --- a/lapack-netlib/SRC/zpstf2.c +++ b/lapack-netlib/SRC/zpstf2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zpstrf.c b/lapack-netlib/SRC/zpstrf.c index 056f93b46..806b4ba20 100644 --- a/lapack-netlib/SRC/zpstrf.c +++ b/lapack-netlib/SRC/zpstrf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zptcon.c b/lapack-netlib/SRC/zptcon.c index 45e748a6b..8496b48cc 100644 --- a/lapack-netlib/SRC/zptcon.c +++ b/lapack-netlib/SRC/zptcon.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zpteqr.c b/lapack-netlib/SRC/zpteqr.c index e557bcc7c..578aa7739 100644 --- a/lapack-netlib/SRC/zpteqr.c +++ b/lapack-netlib/SRC/zpteqr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zptrfs.c b/lapack-netlib/SRC/zptrfs.c index 3bf491577..a59ac5cdc 100644 --- a/lapack-netlib/SRC/zptrfs.c +++ b/lapack-netlib/SRC/zptrfs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zptsv.c b/lapack-netlib/SRC/zptsv.c index 37e853465..c08a1b800 100644 --- a/lapack-netlib/SRC/zptsv.c +++ b/lapack-netlib/SRC/zptsv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zptsvx.c b/lapack-netlib/SRC/zptsvx.c index 3ab57d235..25d742016 100644 --- a/lapack-netlib/SRC/zptsvx.c +++ b/lapack-netlib/SRC/zptsvx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zpttrf.c b/lapack-netlib/SRC/zpttrf.c index e2c271f90..8069c1b22 100644 --- a/lapack-netlib/SRC/zpttrf.c +++ b/lapack-netlib/SRC/zpttrf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zpttrs.c b/lapack-netlib/SRC/zpttrs.c index c9a0336fa..327e1bad0 100644 --- a/lapack-netlib/SRC/zpttrs.c +++ b/lapack-netlib/SRC/zpttrs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zptts2.c b/lapack-netlib/SRC/zptts2.c index 9b6d2fb9f..9f80af125 100644 --- a/lapack-netlib/SRC/zptts2.c +++ b/lapack-netlib/SRC/zptts2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else From c7d0a0b009708788b2349a8d6ca981bfcb934783 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Wed, 3 Apr 2024 23:39:43 +0200 Subject: [PATCH 274/311] fix typedef of logical to support INTERFACE64 --- lapack-netlib/SRC/zlacon.c | 6 +++--- lapack-netlib/SRC/zlacp2.c | 6 +++--- lapack-netlib/SRC/zlacpy.c | 6 +++--- lapack-netlib/SRC/zlacrm.c | 6 +++--- lapack-netlib/SRC/zlacrt.c | 6 +++--- lapack-netlib/SRC/zladiv.c | 6 +++--- lapack-netlib/SRC/zlaed0.c | 6 +++--- lapack-netlib/SRC/zlaed7.c | 6 +++--- lapack-netlib/SRC/zlaed8.c | 6 +++--- lapack-netlib/SRC/zlaein.c | 6 +++--- lapack-netlib/SRC/zlaesy.c | 6 +++--- lapack-netlib/SRC/zlaev2.c | 6 +++--- lapack-netlib/SRC/zlag2c.c | 6 +++--- lapack-netlib/SRC/zlags2.c | 6 +++--- lapack-netlib/SRC/zlagtm.c | 6 +++--- lapack-netlib/SRC/zlahef.c | 6 +++--- lapack-netlib/SRC/zlahef_aa.c | 6 +++--- lapack-netlib/SRC/zlahef_rk.c | 6 +++--- lapack-netlib/SRC/zlahef_rook.c | 6 +++--- lapack-netlib/SRC/zlahqr.c | 6 +++--- lapack-netlib/SRC/zlahr2.c | 6 +++--- lapack-netlib/SRC/zlaic1.c | 6 +++--- lapack-netlib/SRC/zlals0.c | 6 +++--- lapack-netlib/SRC/zlalsa.c | 6 +++--- lapack-netlib/SRC/zlalsd.c | 6 +++--- lapack-netlib/SRC/zlamswlq.c | 6 +++--- lapack-netlib/SRC/zlamtsqr.c | 6 +++--- lapack-netlib/SRC/zlangb.c | 6 +++--- lapack-netlib/SRC/zlange.c | 6 +++--- lapack-netlib/SRC/zlangt.c | 6 +++--- lapack-netlib/SRC/zlanhb.c | 6 +++--- lapack-netlib/SRC/zlanhe.c | 6 +++--- lapack-netlib/SRC/zlanhf.c | 6 +++--- lapack-netlib/SRC/zlanhp.c | 6 +++--- lapack-netlib/SRC/zlanhs.c | 6 +++--- lapack-netlib/SRC/zlanht.c | 6 +++--- lapack-netlib/SRC/zlansb.c | 6 +++--- lapack-netlib/SRC/zlansp.c | 6 +++--- lapack-netlib/SRC/zlansy.c | 6 +++--- lapack-netlib/SRC/zlantb.c | 6 +++--- lapack-netlib/SRC/zlantp.c | 6 +++--- lapack-netlib/SRC/zlantr.c | 6 +++--- lapack-netlib/SRC/zlapll.c | 6 +++--- lapack-netlib/SRC/zlapmr.c | 6 +++--- lapack-netlib/SRC/zlapmt.c | 6 +++--- lapack-netlib/SRC/zlaqgb.c | 6 +++--- lapack-netlib/SRC/zlaqge.c | 6 +++--- lapack-netlib/SRC/zlaqhb.c | 6 +++--- lapack-netlib/SRC/zlaqhe.c | 6 +++--- lapack-netlib/SRC/zlaqhp.c | 6 +++--- lapack-netlib/SRC/zlaqp2.c | 6 +++--- lapack-netlib/SRC/zlaqp2rk.c | 6 +++--- lapack-netlib/SRC/zlaqp3rk.c | 6 +++--- lapack-netlib/SRC/zlaqps.c | 6 +++--- lapack-netlib/SRC/zlaqr0.c | 6 +++--- lapack-netlib/SRC/zlaqr1.c | 6 +++--- lapack-netlib/SRC/zlaqr2.c | 6 +++--- lapack-netlib/SRC/zlaqr3.c | 6 +++--- lapack-netlib/SRC/zlaqr4.c | 6 +++--- lapack-netlib/SRC/zlaqr5.c | 6 +++--- lapack-netlib/SRC/zlaqsb.c | 6 +++--- lapack-netlib/SRC/zlaqsp.c | 6 +++--- lapack-netlib/SRC/zlaqsy.c | 6 +++--- lapack-netlib/SRC/zlar1v.c | 6 +++--- lapack-netlib/SRC/zlar2v.c | 6 +++--- lapack-netlib/SRC/zlarcm.c | 6 +++--- lapack-netlib/SRC/zlarf.c | 6 +++--- lapack-netlib/SRC/zlarfb.c | 6 +++--- lapack-netlib/SRC/zlarfb_gett.c | 6 +++--- lapack-netlib/SRC/zlarfg.c | 6 +++--- lapack-netlib/SRC/zlarfgp.c | 6 +++--- lapack-netlib/SRC/zlarft.c | 6 +++--- lapack-netlib/SRC/zlarfx.c | 6 +++--- lapack-netlib/SRC/zlarfy.c | 6 +++--- lapack-netlib/SRC/zlargv.c | 6 +++--- lapack-netlib/SRC/zlarnv.c | 6 +++--- lapack-netlib/SRC/zlarrv.c | 6 +++--- lapack-netlib/SRC/zlarscl2.c | 6 +++--- lapack-netlib/SRC/zlartg.c | 6 +++--- lapack-netlib/SRC/zlartv.c | 6 +++--- lapack-netlib/SRC/zlarz.c | 6 +++--- lapack-netlib/SRC/zlarzb.c | 6 +++--- lapack-netlib/SRC/zlarzt.c | 6 +++--- lapack-netlib/SRC/zlascl.c | 6 +++--- lapack-netlib/SRC/zlascl2.c | 6 +++--- lapack-netlib/SRC/zlaset.c | 6 +++--- lapack-netlib/SRC/zlasr.c | 6 +++--- lapack-netlib/SRC/zlassq.c | 6 +++--- lapack-netlib/SRC/zlaswlq.c | 6 +++--- 89 files changed, 267 insertions(+), 267 deletions(-) diff --git a/lapack-netlib/SRC/zlacon.c b/lapack-netlib/SRC/zlacon.c index 09aed340f..1ad786e33 100644 --- a/lapack-netlib/SRC/zlacon.c +++ b/lapack-netlib/SRC/zlacon.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlacp2.c b/lapack-netlib/SRC/zlacp2.c index 86f6db0c2..55da81056 100644 --- a/lapack-netlib/SRC/zlacp2.c +++ b/lapack-netlib/SRC/zlacp2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlacpy.c b/lapack-netlib/SRC/zlacpy.c index 3db74dbfa..388af1e0f 100644 --- a/lapack-netlib/SRC/zlacpy.c +++ b/lapack-netlib/SRC/zlacpy.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlacrm.c b/lapack-netlib/SRC/zlacrm.c index 842ad2bfd..3010003a3 100644 --- a/lapack-netlib/SRC/zlacrm.c +++ b/lapack-netlib/SRC/zlacrm.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlacrt.c b/lapack-netlib/SRC/zlacrt.c index 587630d43..6ee43bd19 100644 --- a/lapack-netlib/SRC/zlacrt.c +++ b/lapack-netlib/SRC/zlacrt.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zladiv.c b/lapack-netlib/SRC/zladiv.c index 82c963534..226ea16a6 100644 --- a/lapack-netlib/SRC/zladiv.c +++ b/lapack-netlib/SRC/zladiv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlaed0.c b/lapack-netlib/SRC/zlaed0.c index a904235fc..b48fca2c4 100644 --- a/lapack-netlib/SRC/zlaed0.c +++ b/lapack-netlib/SRC/zlaed0.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlaed7.c b/lapack-netlib/SRC/zlaed7.c index 78c21aa2e..210511a73 100644 --- a/lapack-netlib/SRC/zlaed7.c +++ b/lapack-netlib/SRC/zlaed7.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlaed8.c b/lapack-netlib/SRC/zlaed8.c index 54edb64f9..6e45b4155 100644 --- a/lapack-netlib/SRC/zlaed8.c +++ b/lapack-netlib/SRC/zlaed8.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlaein.c b/lapack-netlib/SRC/zlaein.c index eaa156ecd..35cbf2c12 100644 --- a/lapack-netlib/SRC/zlaein.c +++ b/lapack-netlib/SRC/zlaein.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlaesy.c b/lapack-netlib/SRC/zlaesy.c index 33cc23005..9e09550c3 100644 --- a/lapack-netlib/SRC/zlaesy.c +++ b/lapack-netlib/SRC/zlaesy.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlaev2.c b/lapack-netlib/SRC/zlaev2.c index a25e05633..a28ee2cb8 100644 --- a/lapack-netlib/SRC/zlaev2.c +++ b/lapack-netlib/SRC/zlaev2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlag2c.c b/lapack-netlib/SRC/zlag2c.c index 60d24d21c..1c8a14d00 100644 --- a/lapack-netlib/SRC/zlag2c.c +++ b/lapack-netlib/SRC/zlag2c.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlags2.c b/lapack-netlib/SRC/zlags2.c index 9ddde74f6..d440ae90b 100644 --- a/lapack-netlib/SRC/zlags2.c +++ b/lapack-netlib/SRC/zlags2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlagtm.c b/lapack-netlib/SRC/zlagtm.c index c15790904..a9de3e3f6 100644 --- a/lapack-netlib/SRC/zlagtm.c +++ b/lapack-netlib/SRC/zlagtm.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlahef.c b/lapack-netlib/SRC/zlahef.c index 466b0ed73..c9b543800 100644 --- a/lapack-netlib/SRC/zlahef.c +++ b/lapack-netlib/SRC/zlahef.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlahef_aa.c b/lapack-netlib/SRC/zlahef_aa.c index 10b77518a..5c7907856 100644 --- a/lapack-netlib/SRC/zlahef_aa.c +++ b/lapack-netlib/SRC/zlahef_aa.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlahef_rk.c b/lapack-netlib/SRC/zlahef_rk.c index 05f455b77..bede4d594 100644 --- a/lapack-netlib/SRC/zlahef_rk.c +++ b/lapack-netlib/SRC/zlahef_rk.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlahef_rook.c b/lapack-netlib/SRC/zlahef_rook.c index 6172edfd2..9fbb3f402 100644 --- a/lapack-netlib/SRC/zlahef_rook.c +++ b/lapack-netlib/SRC/zlahef_rook.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlahqr.c b/lapack-netlib/SRC/zlahqr.c index 8436315e0..1b991d586 100644 --- a/lapack-netlib/SRC/zlahqr.c +++ b/lapack-netlib/SRC/zlahqr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlahr2.c b/lapack-netlib/SRC/zlahr2.c index c04c53d91..c75e9f4e0 100644 --- a/lapack-netlib/SRC/zlahr2.c +++ b/lapack-netlib/SRC/zlahr2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlaic1.c b/lapack-netlib/SRC/zlaic1.c index dcb06dc7c..a2413808b 100644 --- a/lapack-netlib/SRC/zlaic1.c +++ b/lapack-netlib/SRC/zlaic1.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlals0.c b/lapack-netlib/SRC/zlals0.c index 3a3dc3fad..6255884cc 100644 --- a/lapack-netlib/SRC/zlals0.c +++ b/lapack-netlib/SRC/zlals0.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlalsa.c b/lapack-netlib/SRC/zlalsa.c index 0452472c6..b6704b31d 100644 --- a/lapack-netlib/SRC/zlalsa.c +++ b/lapack-netlib/SRC/zlalsa.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlalsd.c b/lapack-netlib/SRC/zlalsd.c index 1f2c72a91..ef4bea558 100644 --- a/lapack-netlib/SRC/zlalsd.c +++ b/lapack-netlib/SRC/zlalsd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlamswlq.c b/lapack-netlib/SRC/zlamswlq.c index af40d70f5..6ce2f20b7 100644 --- a/lapack-netlib/SRC/zlamswlq.c +++ b/lapack-netlib/SRC/zlamswlq.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlamtsqr.c b/lapack-netlib/SRC/zlamtsqr.c index cf2fd49e3..ed8bd4fc3 100644 --- a/lapack-netlib/SRC/zlamtsqr.c +++ b/lapack-netlib/SRC/zlamtsqr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlangb.c b/lapack-netlib/SRC/zlangb.c index 6cd82d7ad..7a57d6ed9 100644 --- a/lapack-netlib/SRC/zlangb.c +++ b/lapack-netlib/SRC/zlangb.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlange.c b/lapack-netlib/SRC/zlange.c index 4d5c75539..4feeb0afe 100644 --- a/lapack-netlib/SRC/zlange.c +++ b/lapack-netlib/SRC/zlange.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlangt.c b/lapack-netlib/SRC/zlangt.c index ef6b240a6..1eb4ecc9d 100644 --- a/lapack-netlib/SRC/zlangt.c +++ b/lapack-netlib/SRC/zlangt.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlanhb.c b/lapack-netlib/SRC/zlanhb.c index 9187e2fd9..45e5e10c1 100644 --- a/lapack-netlib/SRC/zlanhb.c +++ b/lapack-netlib/SRC/zlanhb.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlanhe.c b/lapack-netlib/SRC/zlanhe.c index 4e4392f44..737bc6060 100644 --- a/lapack-netlib/SRC/zlanhe.c +++ b/lapack-netlib/SRC/zlanhe.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlanhf.c b/lapack-netlib/SRC/zlanhf.c index cce5b2bd5..b1f98040d 100644 --- a/lapack-netlib/SRC/zlanhf.c +++ b/lapack-netlib/SRC/zlanhf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlanhp.c b/lapack-netlib/SRC/zlanhp.c index 753514afb..cc30fc52a 100644 --- a/lapack-netlib/SRC/zlanhp.c +++ b/lapack-netlib/SRC/zlanhp.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlanhs.c b/lapack-netlib/SRC/zlanhs.c index a6d952e98..8e08be671 100644 --- a/lapack-netlib/SRC/zlanhs.c +++ b/lapack-netlib/SRC/zlanhs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlanht.c b/lapack-netlib/SRC/zlanht.c index b47df2e45..90136fca1 100644 --- a/lapack-netlib/SRC/zlanht.c +++ b/lapack-netlib/SRC/zlanht.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlansb.c b/lapack-netlib/SRC/zlansb.c index c1291302b..baac7031f 100644 --- a/lapack-netlib/SRC/zlansb.c +++ b/lapack-netlib/SRC/zlansb.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlansp.c b/lapack-netlib/SRC/zlansp.c index a27b7d730..22d6c894a 100644 --- a/lapack-netlib/SRC/zlansp.c +++ b/lapack-netlib/SRC/zlansp.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlansy.c b/lapack-netlib/SRC/zlansy.c index 536511c94..f4c7a7377 100644 --- a/lapack-netlib/SRC/zlansy.c +++ b/lapack-netlib/SRC/zlansy.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlantb.c b/lapack-netlib/SRC/zlantb.c index 076dcc380..24a13c189 100644 --- a/lapack-netlib/SRC/zlantb.c +++ b/lapack-netlib/SRC/zlantb.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlantp.c b/lapack-netlib/SRC/zlantp.c index 6e504eb69..a102b2e63 100644 --- a/lapack-netlib/SRC/zlantp.c +++ b/lapack-netlib/SRC/zlantp.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlantr.c b/lapack-netlib/SRC/zlantr.c index 778689d9a..504d2c654 100644 --- a/lapack-netlib/SRC/zlantr.c +++ b/lapack-netlib/SRC/zlantr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlapll.c b/lapack-netlib/SRC/zlapll.c index 7eb7598ce..ef955d599 100644 --- a/lapack-netlib/SRC/zlapll.c +++ b/lapack-netlib/SRC/zlapll.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlapmr.c b/lapack-netlib/SRC/zlapmr.c index 3895f6519..9e42dc5c6 100644 --- a/lapack-netlib/SRC/zlapmr.c +++ b/lapack-netlib/SRC/zlapmr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlapmt.c b/lapack-netlib/SRC/zlapmt.c index 93a398986..e64653a1b 100644 --- a/lapack-netlib/SRC/zlapmt.c +++ b/lapack-netlib/SRC/zlapmt.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlaqgb.c b/lapack-netlib/SRC/zlaqgb.c index f27b90096..2b016ab75 100644 --- a/lapack-netlib/SRC/zlaqgb.c +++ b/lapack-netlib/SRC/zlaqgb.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlaqge.c b/lapack-netlib/SRC/zlaqge.c index 3842ed5c9..5fab7e489 100644 --- a/lapack-netlib/SRC/zlaqge.c +++ b/lapack-netlib/SRC/zlaqge.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlaqhb.c b/lapack-netlib/SRC/zlaqhb.c index bc31968c0..24c25fe71 100644 --- a/lapack-netlib/SRC/zlaqhb.c +++ b/lapack-netlib/SRC/zlaqhb.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlaqhe.c b/lapack-netlib/SRC/zlaqhe.c index 994097638..456d8e241 100644 --- a/lapack-netlib/SRC/zlaqhe.c +++ b/lapack-netlib/SRC/zlaqhe.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlaqhp.c b/lapack-netlib/SRC/zlaqhp.c index 843d69036..f76b643fd 100644 --- a/lapack-netlib/SRC/zlaqhp.c +++ b/lapack-netlib/SRC/zlaqhp.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlaqp2.c b/lapack-netlib/SRC/zlaqp2.c index a85160bbc..e64846e71 100644 --- a/lapack-netlib/SRC/zlaqp2.c +++ b/lapack-netlib/SRC/zlaqp2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlaqp2rk.c b/lapack-netlib/SRC/zlaqp2rk.c index 0d38e71fb..f72b6ef17 100644 --- a/lapack-netlib/SRC/zlaqp2rk.c +++ b/lapack-netlib/SRC/zlaqp2rk.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlaqp3rk.c b/lapack-netlib/SRC/zlaqp3rk.c index cb44e4d34..73213ec3b 100644 --- a/lapack-netlib/SRC/zlaqp3rk.c +++ b/lapack-netlib/SRC/zlaqp3rk.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlaqps.c b/lapack-netlib/SRC/zlaqps.c index 19fda2a09..f31ba46de 100644 --- a/lapack-netlib/SRC/zlaqps.c +++ b/lapack-netlib/SRC/zlaqps.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlaqr0.c b/lapack-netlib/SRC/zlaqr0.c index 4c8ece372..bf3b93612 100644 --- a/lapack-netlib/SRC/zlaqr0.c +++ b/lapack-netlib/SRC/zlaqr0.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlaqr1.c b/lapack-netlib/SRC/zlaqr1.c index c0b702645..42c841926 100644 --- a/lapack-netlib/SRC/zlaqr1.c +++ b/lapack-netlib/SRC/zlaqr1.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlaqr2.c b/lapack-netlib/SRC/zlaqr2.c index dee1cf49b..e73590628 100644 --- a/lapack-netlib/SRC/zlaqr2.c +++ b/lapack-netlib/SRC/zlaqr2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlaqr3.c b/lapack-netlib/SRC/zlaqr3.c index a07baaa37..c445f9d00 100644 --- a/lapack-netlib/SRC/zlaqr3.c +++ b/lapack-netlib/SRC/zlaqr3.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlaqr4.c b/lapack-netlib/SRC/zlaqr4.c index 97be063dc..1158c55ad 100644 --- a/lapack-netlib/SRC/zlaqr4.c +++ b/lapack-netlib/SRC/zlaqr4.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlaqr5.c b/lapack-netlib/SRC/zlaqr5.c index 1aacd4c7e..8ed00a35b 100644 --- a/lapack-netlib/SRC/zlaqr5.c +++ b/lapack-netlib/SRC/zlaqr5.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlaqsb.c b/lapack-netlib/SRC/zlaqsb.c index eac534754..c7af51cbe 100644 --- a/lapack-netlib/SRC/zlaqsb.c +++ b/lapack-netlib/SRC/zlaqsb.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlaqsp.c b/lapack-netlib/SRC/zlaqsp.c index 22758cefa..c896bcf88 100644 --- a/lapack-netlib/SRC/zlaqsp.c +++ b/lapack-netlib/SRC/zlaqsp.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlaqsy.c b/lapack-netlib/SRC/zlaqsy.c index 8089d2eb6..b14f94b2c 100644 --- a/lapack-netlib/SRC/zlaqsy.c +++ b/lapack-netlib/SRC/zlaqsy.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlar1v.c b/lapack-netlib/SRC/zlar1v.c index fa9c6147a..609e8a95c 100644 --- a/lapack-netlib/SRC/zlar1v.c +++ b/lapack-netlib/SRC/zlar1v.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlar2v.c b/lapack-netlib/SRC/zlar2v.c index 8654cdde4..b138a2636 100644 --- a/lapack-netlib/SRC/zlar2v.c +++ b/lapack-netlib/SRC/zlar2v.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlarcm.c b/lapack-netlib/SRC/zlarcm.c index 5ce71fdf9..34c861a59 100644 --- a/lapack-netlib/SRC/zlarcm.c +++ b/lapack-netlib/SRC/zlarcm.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlarf.c b/lapack-netlib/SRC/zlarf.c index 67f8c9756..fcc88eab4 100644 --- a/lapack-netlib/SRC/zlarf.c +++ b/lapack-netlib/SRC/zlarf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlarfb.c b/lapack-netlib/SRC/zlarfb.c index 14d36bc1b..0d0b2400d 100644 --- a/lapack-netlib/SRC/zlarfb.c +++ b/lapack-netlib/SRC/zlarfb.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlarfb_gett.c b/lapack-netlib/SRC/zlarfb_gett.c index 71f4a749d..47ff06454 100644 --- a/lapack-netlib/SRC/zlarfb_gett.c +++ b/lapack-netlib/SRC/zlarfb_gett.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlarfg.c b/lapack-netlib/SRC/zlarfg.c index 9696b3ef4..099c685bc 100644 --- a/lapack-netlib/SRC/zlarfg.c +++ b/lapack-netlib/SRC/zlarfg.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlarfgp.c b/lapack-netlib/SRC/zlarfgp.c index 00d3f2042..3a891c19f 100644 --- a/lapack-netlib/SRC/zlarfgp.c +++ b/lapack-netlib/SRC/zlarfgp.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlarft.c b/lapack-netlib/SRC/zlarft.c index f24e62d38..31d17ca5f 100644 --- a/lapack-netlib/SRC/zlarft.c +++ b/lapack-netlib/SRC/zlarft.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlarfx.c b/lapack-netlib/SRC/zlarfx.c index 782699a66..f4a3767d2 100644 --- a/lapack-netlib/SRC/zlarfx.c +++ b/lapack-netlib/SRC/zlarfx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlarfy.c b/lapack-netlib/SRC/zlarfy.c index e5df36f34..280dcbb38 100644 --- a/lapack-netlib/SRC/zlarfy.c +++ b/lapack-netlib/SRC/zlarfy.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlargv.c b/lapack-netlib/SRC/zlargv.c index 2fc7080e2..89926d034 100644 --- a/lapack-netlib/SRC/zlargv.c +++ b/lapack-netlib/SRC/zlargv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlarnv.c b/lapack-netlib/SRC/zlarnv.c index 9b7d4b173..b7a011769 100644 --- a/lapack-netlib/SRC/zlarnv.c +++ b/lapack-netlib/SRC/zlarnv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlarrv.c b/lapack-netlib/SRC/zlarrv.c index 8dda3d097..672df9ab8 100644 --- a/lapack-netlib/SRC/zlarrv.c +++ b/lapack-netlib/SRC/zlarrv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlarscl2.c b/lapack-netlib/SRC/zlarscl2.c index 2493468e7..871f25afb 100644 --- a/lapack-netlib/SRC/zlarscl2.c +++ b/lapack-netlib/SRC/zlarscl2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlartg.c b/lapack-netlib/SRC/zlartg.c index f8f726025..ede5b489a 100644 --- a/lapack-netlib/SRC/zlartg.c +++ b/lapack-netlib/SRC/zlartg.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlartv.c b/lapack-netlib/SRC/zlartv.c index b578b8bf7..2bccb7924 100644 --- a/lapack-netlib/SRC/zlartv.c +++ b/lapack-netlib/SRC/zlartv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlarz.c b/lapack-netlib/SRC/zlarz.c index e4a4ea254..a1c630892 100644 --- a/lapack-netlib/SRC/zlarz.c +++ b/lapack-netlib/SRC/zlarz.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlarzb.c b/lapack-netlib/SRC/zlarzb.c index 5416b5e34..132c2ecf5 100644 --- a/lapack-netlib/SRC/zlarzb.c +++ b/lapack-netlib/SRC/zlarzb.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlarzt.c b/lapack-netlib/SRC/zlarzt.c index 036c7209e..70c76cd5a 100644 --- a/lapack-netlib/SRC/zlarzt.c +++ b/lapack-netlib/SRC/zlarzt.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlascl.c b/lapack-netlib/SRC/zlascl.c index 73b2f29ff..0e06e9bc4 100644 --- a/lapack-netlib/SRC/zlascl.c +++ b/lapack-netlib/SRC/zlascl.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlascl2.c b/lapack-netlib/SRC/zlascl2.c index 076bab027..a5f6562a2 100644 --- a/lapack-netlib/SRC/zlascl2.c +++ b/lapack-netlib/SRC/zlascl2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlaset.c b/lapack-netlib/SRC/zlaset.c index 9e3f21d72..a579a01d3 100644 --- a/lapack-netlib/SRC/zlaset.c +++ b/lapack-netlib/SRC/zlaset.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlasr.c b/lapack-netlib/SRC/zlasr.c index 983f7b3d3..c30626ca3 100644 --- a/lapack-netlib/SRC/zlasr.c +++ b/lapack-netlib/SRC/zlasr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlassq.c b/lapack-netlib/SRC/zlassq.c index 5e9fade41..2ccd8be98 100644 --- a/lapack-netlib/SRC/zlassq.c +++ b/lapack-netlib/SRC/zlassq.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlaswlq.c b/lapack-netlib/SRC/zlaswlq.c index aa46bfa29..8fccd02d4 100644 --- a/lapack-netlib/SRC/zlaswlq.c +++ b/lapack-netlib/SRC/zlaswlq.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else From 837a173115a1063c106bddcf82edaff01270cf92 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Wed, 3 Apr 2024 23:43:55 +0200 Subject: [PATCH 275/311] fix prototype of logical to support INTERFACE64 --- lapack-netlib/SRC/zhfrk.c | 6 +++--- lapack-netlib/SRC/zhgeqz.c | 6 +++--- lapack-netlib/SRC/zhpcon.c | 6 +++--- lapack-netlib/SRC/zhpev.c | 6 +++--- lapack-netlib/SRC/zhpevd.c | 6 +++--- lapack-netlib/SRC/zhpevx.c | 6 +++--- lapack-netlib/SRC/zhpgst.c | 6 +++--- lapack-netlib/SRC/zhpgv.c | 6 +++--- lapack-netlib/SRC/zhpgvd.c | 6 +++--- lapack-netlib/SRC/zhpgvx.c | 6 +++--- lapack-netlib/SRC/zhprfs.c | 6 +++--- lapack-netlib/SRC/zhpsv.c | 6 +++--- lapack-netlib/SRC/zhpsvx.c | 6 +++--- lapack-netlib/SRC/zhptrd.c | 6 +++--- lapack-netlib/SRC/zhptrf.c | 6 +++--- lapack-netlib/SRC/zhptri.c | 6 +++--- lapack-netlib/SRC/zhptrs.c | 6 +++--- lapack-netlib/SRC/zhsein.c | 6 +++--- lapack-netlib/SRC/zhseqr.c | 6 +++--- lapack-netlib/SRC/zla_gbamv.c | 6 +++--- lapack-netlib/SRC/zla_gbrcond_c.c | 6 +++--- lapack-netlib/SRC/zla_gbrcond_x.c | 6 +++--- lapack-netlib/SRC/zla_gbrfsx_extended.c | 6 +++--- lapack-netlib/SRC/zla_gbrpvgrw.c | 6 +++--- lapack-netlib/SRC/zla_geamv.c | 6 +++--- lapack-netlib/SRC/zla_gercond_c.c | 6 +++--- lapack-netlib/SRC/zla_gercond_x.c | 6 +++--- lapack-netlib/SRC/zla_gerfsx_extended.c | 6 +++--- lapack-netlib/SRC/zla_gerpvgrw.c | 6 +++--- lapack-netlib/SRC/zla_heamv.c | 6 +++--- lapack-netlib/SRC/zla_hercond_c.c | 6 +++--- lapack-netlib/SRC/zla_hercond_x.c | 6 +++--- lapack-netlib/SRC/zla_herfsx_extended.c | 6 +++--- lapack-netlib/SRC/zla_herpvgrw.c | 6 +++--- lapack-netlib/SRC/zla_lin_berr.c | 6 +++--- lapack-netlib/SRC/zla_porcond_c.c | 6 +++--- lapack-netlib/SRC/zla_porcond_x.c | 6 +++--- lapack-netlib/SRC/zla_porfsx_extended.c | 6 +++--- lapack-netlib/SRC/zla_porpvgrw.c | 6 +++--- lapack-netlib/SRC/zla_syamv.c | 6 +++--- lapack-netlib/SRC/zla_syrcond_c.c | 6 +++--- lapack-netlib/SRC/zla_syrcond_x.c | 6 +++--- lapack-netlib/SRC/zla_syrfsx_extended.c | 6 +++--- lapack-netlib/SRC/zla_syrpvgrw.c | 6 +++--- lapack-netlib/SRC/zla_wwaddw.c | 6 +++--- lapack-netlib/SRC/zlabrd.c | 6 +++--- lapack-netlib/SRC/zlacgv.c | 6 +++--- lapack-netlib/SRC/zlacn2.c | 6 +++--- 48 files changed, 144 insertions(+), 144 deletions(-) diff --git a/lapack-netlib/SRC/zhfrk.c b/lapack-netlib/SRC/zhfrk.c index efc567c3a..89da0aef7 100644 --- a/lapack-netlib/SRC/zhfrk.c +++ b/lapack-netlib/SRC/zhfrk.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zhgeqz.c b/lapack-netlib/SRC/zhgeqz.c index a34d50426..fc1a5d00c 100644 --- a/lapack-netlib/SRC/zhgeqz.c +++ b/lapack-netlib/SRC/zhgeqz.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zhpcon.c b/lapack-netlib/SRC/zhpcon.c index aef8edf97..b50e66266 100644 --- a/lapack-netlib/SRC/zhpcon.c +++ b/lapack-netlib/SRC/zhpcon.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zhpev.c b/lapack-netlib/SRC/zhpev.c index b3f42a19f..b92c88f11 100644 --- a/lapack-netlib/SRC/zhpev.c +++ b/lapack-netlib/SRC/zhpev.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zhpevd.c b/lapack-netlib/SRC/zhpevd.c index 651d25267..c6a0c9f5d 100644 --- a/lapack-netlib/SRC/zhpevd.c +++ b/lapack-netlib/SRC/zhpevd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zhpevx.c b/lapack-netlib/SRC/zhpevx.c index 289d78890..8efd03bed 100644 --- a/lapack-netlib/SRC/zhpevx.c +++ b/lapack-netlib/SRC/zhpevx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zhpgst.c b/lapack-netlib/SRC/zhpgst.c index 55bd84a5e..845e3c6b4 100644 --- a/lapack-netlib/SRC/zhpgst.c +++ b/lapack-netlib/SRC/zhpgst.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zhpgv.c b/lapack-netlib/SRC/zhpgv.c index 915cdc526..8b45e067b 100644 --- a/lapack-netlib/SRC/zhpgv.c +++ b/lapack-netlib/SRC/zhpgv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zhpgvd.c b/lapack-netlib/SRC/zhpgvd.c index 41edf776e..e7ecb5bd9 100644 --- a/lapack-netlib/SRC/zhpgvd.c +++ b/lapack-netlib/SRC/zhpgvd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zhpgvx.c b/lapack-netlib/SRC/zhpgvx.c index a5bc14dfb..dc8a9dde7 100644 --- a/lapack-netlib/SRC/zhpgvx.c +++ b/lapack-netlib/SRC/zhpgvx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zhprfs.c b/lapack-netlib/SRC/zhprfs.c index e4dcbafc3..39cb9b30c 100644 --- a/lapack-netlib/SRC/zhprfs.c +++ b/lapack-netlib/SRC/zhprfs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zhpsv.c b/lapack-netlib/SRC/zhpsv.c index dd075d9d7..b4cd74808 100644 --- a/lapack-netlib/SRC/zhpsv.c +++ b/lapack-netlib/SRC/zhpsv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zhpsvx.c b/lapack-netlib/SRC/zhpsvx.c index 93af38a19..118556646 100644 --- a/lapack-netlib/SRC/zhpsvx.c +++ b/lapack-netlib/SRC/zhpsvx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zhptrd.c b/lapack-netlib/SRC/zhptrd.c index e14d305a1..fd128f067 100644 --- a/lapack-netlib/SRC/zhptrd.c +++ b/lapack-netlib/SRC/zhptrd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zhptrf.c b/lapack-netlib/SRC/zhptrf.c index 31bfd9bc0..ffec15a3b 100644 --- a/lapack-netlib/SRC/zhptrf.c +++ b/lapack-netlib/SRC/zhptrf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zhptri.c b/lapack-netlib/SRC/zhptri.c index 67266cb9b..447d80bf1 100644 --- a/lapack-netlib/SRC/zhptri.c +++ b/lapack-netlib/SRC/zhptri.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zhptrs.c b/lapack-netlib/SRC/zhptrs.c index e000b267c..f15bf615d 100644 --- a/lapack-netlib/SRC/zhptrs.c +++ b/lapack-netlib/SRC/zhptrs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zhsein.c b/lapack-netlib/SRC/zhsein.c index a7bc3e15f..06f0ecd9d 100644 --- a/lapack-netlib/SRC/zhsein.c +++ b/lapack-netlib/SRC/zhsein.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zhseqr.c b/lapack-netlib/SRC/zhseqr.c index bdf100a32..d7913ca7a 100644 --- a/lapack-netlib/SRC/zhseqr.c +++ b/lapack-netlib/SRC/zhseqr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zla_gbamv.c b/lapack-netlib/SRC/zla_gbamv.c index 6bab7632d..d12a36bc5 100644 --- a/lapack-netlib/SRC/zla_gbamv.c +++ b/lapack-netlib/SRC/zla_gbamv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zla_gbrcond_c.c b/lapack-netlib/SRC/zla_gbrcond_c.c index 599695341..d3a31dcd5 100644 --- a/lapack-netlib/SRC/zla_gbrcond_c.c +++ b/lapack-netlib/SRC/zla_gbrcond_c.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zla_gbrcond_x.c b/lapack-netlib/SRC/zla_gbrcond_x.c index b1ffadc64..1514a82b2 100644 --- a/lapack-netlib/SRC/zla_gbrcond_x.c +++ b/lapack-netlib/SRC/zla_gbrcond_x.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zla_gbrfsx_extended.c b/lapack-netlib/SRC/zla_gbrfsx_extended.c index a662d4344..f8d5e4786 100644 --- a/lapack-netlib/SRC/zla_gbrfsx_extended.c +++ b/lapack-netlib/SRC/zla_gbrfsx_extended.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zla_gbrpvgrw.c b/lapack-netlib/SRC/zla_gbrpvgrw.c index 520860169..370d37e8a 100644 --- a/lapack-netlib/SRC/zla_gbrpvgrw.c +++ b/lapack-netlib/SRC/zla_gbrpvgrw.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zla_geamv.c b/lapack-netlib/SRC/zla_geamv.c index 5ad3c2207..8fa2f3992 100644 --- a/lapack-netlib/SRC/zla_geamv.c +++ b/lapack-netlib/SRC/zla_geamv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zla_gercond_c.c b/lapack-netlib/SRC/zla_gercond_c.c index b1a63cd92..95718808f 100644 --- a/lapack-netlib/SRC/zla_gercond_c.c +++ b/lapack-netlib/SRC/zla_gercond_c.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zla_gercond_x.c b/lapack-netlib/SRC/zla_gercond_x.c index 2b862092f..1a01f6b5f 100644 --- a/lapack-netlib/SRC/zla_gercond_x.c +++ b/lapack-netlib/SRC/zla_gercond_x.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zla_gerfsx_extended.c b/lapack-netlib/SRC/zla_gerfsx_extended.c index 34703a163..5e7b2d584 100644 --- a/lapack-netlib/SRC/zla_gerfsx_extended.c +++ b/lapack-netlib/SRC/zla_gerfsx_extended.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zla_gerpvgrw.c b/lapack-netlib/SRC/zla_gerpvgrw.c index 5feae54aa..b8bc9700c 100644 --- a/lapack-netlib/SRC/zla_gerpvgrw.c +++ b/lapack-netlib/SRC/zla_gerpvgrw.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zla_heamv.c b/lapack-netlib/SRC/zla_heamv.c index d76bb993c..23f1c4b54 100644 --- a/lapack-netlib/SRC/zla_heamv.c +++ b/lapack-netlib/SRC/zla_heamv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zla_hercond_c.c b/lapack-netlib/SRC/zla_hercond_c.c index bb5e2fe4d..251446aee 100644 --- a/lapack-netlib/SRC/zla_hercond_c.c +++ b/lapack-netlib/SRC/zla_hercond_c.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zla_hercond_x.c b/lapack-netlib/SRC/zla_hercond_x.c index 879164bd3..1e4e692a9 100644 --- a/lapack-netlib/SRC/zla_hercond_x.c +++ b/lapack-netlib/SRC/zla_hercond_x.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zla_herfsx_extended.c b/lapack-netlib/SRC/zla_herfsx_extended.c index 2b4145e8e..e26f6a27f 100644 --- a/lapack-netlib/SRC/zla_herfsx_extended.c +++ b/lapack-netlib/SRC/zla_herfsx_extended.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zla_herpvgrw.c b/lapack-netlib/SRC/zla_herpvgrw.c index 85715d493..f409b090a 100644 --- a/lapack-netlib/SRC/zla_herpvgrw.c +++ b/lapack-netlib/SRC/zla_herpvgrw.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zla_lin_berr.c b/lapack-netlib/SRC/zla_lin_berr.c index 3a64125e8..820de3ac5 100644 --- a/lapack-netlib/SRC/zla_lin_berr.c +++ b/lapack-netlib/SRC/zla_lin_berr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zla_porcond_c.c b/lapack-netlib/SRC/zla_porcond_c.c index d5c914b40..e99410854 100644 --- a/lapack-netlib/SRC/zla_porcond_c.c +++ b/lapack-netlib/SRC/zla_porcond_c.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zla_porcond_x.c b/lapack-netlib/SRC/zla_porcond_x.c index 50fe97806..f9c4f02df 100644 --- a/lapack-netlib/SRC/zla_porcond_x.c +++ b/lapack-netlib/SRC/zla_porcond_x.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zla_porfsx_extended.c b/lapack-netlib/SRC/zla_porfsx_extended.c index 47982e658..17e2a91c3 100644 --- a/lapack-netlib/SRC/zla_porfsx_extended.c +++ b/lapack-netlib/SRC/zla_porfsx_extended.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zla_porpvgrw.c b/lapack-netlib/SRC/zla_porpvgrw.c index ee1de1b3f..10b6737d0 100644 --- a/lapack-netlib/SRC/zla_porpvgrw.c +++ b/lapack-netlib/SRC/zla_porpvgrw.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zla_syamv.c b/lapack-netlib/SRC/zla_syamv.c index f6a0c7784..7f652153c 100644 --- a/lapack-netlib/SRC/zla_syamv.c +++ b/lapack-netlib/SRC/zla_syamv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zla_syrcond_c.c b/lapack-netlib/SRC/zla_syrcond_c.c index 988a63713..5173cbb05 100644 --- a/lapack-netlib/SRC/zla_syrcond_c.c +++ b/lapack-netlib/SRC/zla_syrcond_c.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zla_syrcond_x.c b/lapack-netlib/SRC/zla_syrcond_x.c index 7b771f144..c0f9c71ba 100644 --- a/lapack-netlib/SRC/zla_syrcond_x.c +++ b/lapack-netlib/SRC/zla_syrcond_x.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zla_syrfsx_extended.c b/lapack-netlib/SRC/zla_syrfsx_extended.c index 8e5b40297..95e3c555f 100644 --- a/lapack-netlib/SRC/zla_syrfsx_extended.c +++ b/lapack-netlib/SRC/zla_syrfsx_extended.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zla_syrpvgrw.c b/lapack-netlib/SRC/zla_syrpvgrw.c index 3a9af3b3e..789cb2393 100644 --- a/lapack-netlib/SRC/zla_syrpvgrw.c +++ b/lapack-netlib/SRC/zla_syrpvgrw.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zla_wwaddw.c b/lapack-netlib/SRC/zla_wwaddw.c index 63a8542b6..aa9bf35c3 100644 --- a/lapack-netlib/SRC/zla_wwaddw.c +++ b/lapack-netlib/SRC/zla_wwaddw.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlabrd.c b/lapack-netlib/SRC/zlabrd.c index 208655c58..13721ce76 100644 --- a/lapack-netlib/SRC/zlabrd.c +++ b/lapack-netlib/SRC/zlabrd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlacgv.c b/lapack-netlib/SRC/zlacgv.c index 13809ceb4..02591726c 100644 --- a/lapack-netlib/SRC/zlacgv.c +++ b/lapack-netlib/SRC/zlacgv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zlacn2.c b/lapack-netlib/SRC/zlacn2.c index 8984c8bd1..eba861a77 100644 --- a/lapack-netlib/SRC/zlacn2.c +++ b/lapack-netlib/SRC/zlacn2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else From 7a267e4c50fbb47a4cb5c800401e32b8b7f795f6 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Wed, 3 Apr 2024 23:51:25 +0200 Subject: [PATCH 276/311] fix typedef for logical to support INTERFACE64 --- lapack-netlib/SRC/zgges.c | 6 +++--- lapack-netlib/SRC/zgges3.c | 6 +++--- lapack-netlib/SRC/zggesx.c | 6 +++--- lapack-netlib/SRC/zggev.c | 6 +++--- lapack-netlib/SRC/zggev3.c | 6 +++--- lapack-netlib/SRC/zggevx.c | 6 +++--- lapack-netlib/SRC/zggglm.c | 6 +++--- lapack-netlib/SRC/zgghd3.c | 6 +++--- lapack-netlib/SRC/zgghrd.c | 6 +++--- lapack-netlib/SRC/zgglse.c | 6 +++--- lapack-netlib/SRC/zggqrf.c | 6 +++--- lapack-netlib/SRC/zggrqf.c | 6 +++--- lapack-netlib/SRC/zggsvd3.c | 6 +++--- lapack-netlib/SRC/zggsvp3.c | 6 +++--- lapack-netlib/SRC/zgsvj0.c | 6 +++--- lapack-netlib/SRC/zgsvj1.c | 6 +++--- lapack-netlib/SRC/zgtcon.c | 6 +++--- lapack-netlib/SRC/zgtrfs.c | 6 +++--- lapack-netlib/SRC/zgtsv.c | 6 +++--- lapack-netlib/SRC/zgtsvx.c | 6 +++--- lapack-netlib/SRC/zgttrf.c | 6 +++--- lapack-netlib/SRC/zgttrs.c | 6 +++--- lapack-netlib/SRC/zgtts2.c | 6 +++--- lapack-netlib/SRC/zhb2st_kernels.c | 6 +++--- lapack-netlib/SRC/zhbev.c | 6 +++--- lapack-netlib/SRC/zhbev_2stage.c | 6 +++--- lapack-netlib/SRC/zhbevd.c | 6 +++--- lapack-netlib/SRC/zhbevd_2stage.c | 6 +++--- lapack-netlib/SRC/zhbevx.c | 6 +++--- lapack-netlib/SRC/zhbevx_2stage.c | 6 +++--- lapack-netlib/SRC/zhbgst.c | 6 +++--- lapack-netlib/SRC/zhbgv.c | 6 +++--- lapack-netlib/SRC/zhbgvd.c | 6 +++--- lapack-netlib/SRC/zhbgvx.c | 6 +++--- lapack-netlib/SRC/zhbtrd.c | 6 +++--- lapack-netlib/SRC/zhecon.c | 6 +++--- lapack-netlib/SRC/zhecon_3.c | 6 +++--- lapack-netlib/SRC/zhecon_rook.c | 6 +++--- lapack-netlib/SRC/zheequb.c | 6 +++--- lapack-netlib/SRC/zheev.c | 6 +++--- lapack-netlib/SRC/zheev_2stage.c | 6 +++--- lapack-netlib/SRC/zheevd.c | 6 +++--- lapack-netlib/SRC/zheevd_2stage.c | 6 +++--- lapack-netlib/SRC/zheevr.c | 6 +++--- lapack-netlib/SRC/zheevr_2stage.c | 6 +++--- lapack-netlib/SRC/zheevx.c | 6 +++--- lapack-netlib/SRC/zheevx_2stage.c | 6 +++--- lapack-netlib/SRC/zhegs2.c | 6 +++--- lapack-netlib/SRC/zhegst.c | 6 +++--- lapack-netlib/SRC/zhegv.c | 6 +++--- lapack-netlib/SRC/zhegv_2stage.c | 6 +++--- lapack-netlib/SRC/zhegvd.c | 6 +++--- lapack-netlib/SRC/zhegvx.c | 6 +++--- lapack-netlib/SRC/zherfs.c | 6 +++--- lapack-netlib/SRC/zherfsx.c | 6 +++--- lapack-netlib/SRC/zhesv.c | 6 +++--- lapack-netlib/SRC/zhesv_aa.c | 6 +++--- lapack-netlib/SRC/zhesv_aa_2stage.c | 6 +++--- lapack-netlib/SRC/zhesv_rk.c | 6 +++--- lapack-netlib/SRC/zhesv_rook.c | 6 +++--- lapack-netlib/SRC/zhesvx.c | 6 +++--- lapack-netlib/SRC/zhesvxx.c | 6 +++--- lapack-netlib/SRC/zheswapr.c | 6 +++--- lapack-netlib/SRC/zhetd2.c | 6 +++--- lapack-netlib/SRC/zhetf2.c | 6 +++--- lapack-netlib/SRC/zhetf2_rk.c | 6 +++--- lapack-netlib/SRC/zhetf2_rook.c | 6 +++--- lapack-netlib/SRC/zhetrd.c | 6 +++--- lapack-netlib/SRC/zhetrd_2stage.c | 6 +++--- lapack-netlib/SRC/zhetrd_hb2st.c | 6 +++--- lapack-netlib/SRC/zhetrd_he2hb.c | 6 +++--- lapack-netlib/SRC/zhetrf.c | 6 +++--- lapack-netlib/SRC/zhetrf_aa.c | 6 +++--- lapack-netlib/SRC/zhetrf_aa_2stage.c | 6 +++--- lapack-netlib/SRC/zhetrf_rk.c | 6 +++--- lapack-netlib/SRC/zhetrf_rook.c | 6 +++--- lapack-netlib/SRC/zhetri.c | 6 +++--- lapack-netlib/SRC/zhetri2.c | 6 +++--- lapack-netlib/SRC/zhetri2x.c | 6 +++--- lapack-netlib/SRC/zhetri_3.c | 6 +++--- lapack-netlib/SRC/zhetri_3x.c | 6 +++--- lapack-netlib/SRC/zhetri_rook.c | 6 +++--- lapack-netlib/SRC/zhetrs.c | 6 +++--- lapack-netlib/SRC/zhetrs2.c | 6 +++--- lapack-netlib/SRC/zhetrs_3.c | 6 +++--- lapack-netlib/SRC/zhetrs_aa.c | 6 +++--- lapack-netlib/SRC/zhetrs_aa_2stage.c | 6 +++--- lapack-netlib/SRC/zhetrs_rook.c | 6 +++--- 88 files changed, 264 insertions(+), 264 deletions(-) diff --git a/lapack-netlib/SRC/zgges.c b/lapack-netlib/SRC/zgges.c index e8858d7e1..aab716add 100644 --- a/lapack-netlib/SRC/zgges.c +++ b/lapack-netlib/SRC/zgges.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgges3.c b/lapack-netlib/SRC/zgges3.c index ac9ce770f..98149dabe 100644 --- a/lapack-netlib/SRC/zgges3.c +++ b/lapack-netlib/SRC/zgges3.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zggesx.c b/lapack-netlib/SRC/zggesx.c index ea98b0e1a..fa4c5bd8d 100644 --- a/lapack-netlib/SRC/zggesx.c +++ b/lapack-netlib/SRC/zggesx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zggev.c b/lapack-netlib/SRC/zggev.c index a93883a73..daf22a1ac 100644 --- a/lapack-netlib/SRC/zggev.c +++ b/lapack-netlib/SRC/zggev.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zggev3.c b/lapack-netlib/SRC/zggev3.c index 084d20517..ab15944cd 100644 --- a/lapack-netlib/SRC/zggev3.c +++ b/lapack-netlib/SRC/zggev3.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zggevx.c b/lapack-netlib/SRC/zggevx.c index b04cf7fd6..9c2e7b05f 100644 --- a/lapack-netlib/SRC/zggevx.c +++ b/lapack-netlib/SRC/zggevx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zggglm.c b/lapack-netlib/SRC/zggglm.c index cc2dcd8fd..e4ed67fb0 100644 --- a/lapack-netlib/SRC/zggglm.c +++ b/lapack-netlib/SRC/zggglm.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgghd3.c b/lapack-netlib/SRC/zgghd3.c index ff20280f3..5f14a19ae 100644 --- a/lapack-netlib/SRC/zgghd3.c +++ b/lapack-netlib/SRC/zgghd3.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgghrd.c b/lapack-netlib/SRC/zgghrd.c index 62ba9a31f..9e351075e 100644 --- a/lapack-netlib/SRC/zgghrd.c +++ b/lapack-netlib/SRC/zgghrd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgglse.c b/lapack-netlib/SRC/zgglse.c index 47b30742c..06a3c266b 100644 --- a/lapack-netlib/SRC/zgglse.c +++ b/lapack-netlib/SRC/zgglse.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zggqrf.c b/lapack-netlib/SRC/zggqrf.c index afe06bcfc..5d8d7f625 100644 --- a/lapack-netlib/SRC/zggqrf.c +++ b/lapack-netlib/SRC/zggqrf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zggrqf.c b/lapack-netlib/SRC/zggrqf.c index 789c1c856..c9138ee3b 100644 --- a/lapack-netlib/SRC/zggrqf.c +++ b/lapack-netlib/SRC/zggrqf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zggsvd3.c b/lapack-netlib/SRC/zggsvd3.c index a8bc8de19..0df6740bc 100644 --- a/lapack-netlib/SRC/zggsvd3.c +++ b/lapack-netlib/SRC/zggsvd3.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zggsvp3.c b/lapack-netlib/SRC/zggsvp3.c index e78bbe74e..fa31f1728 100644 --- a/lapack-netlib/SRC/zggsvp3.c +++ b/lapack-netlib/SRC/zggsvp3.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgsvj0.c b/lapack-netlib/SRC/zgsvj0.c index c300fcd93..948f1b501 100644 --- a/lapack-netlib/SRC/zgsvj0.c +++ b/lapack-netlib/SRC/zgsvj0.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgsvj1.c b/lapack-netlib/SRC/zgsvj1.c index fa1fc77c1..17f61ec2b 100644 --- a/lapack-netlib/SRC/zgsvj1.c +++ b/lapack-netlib/SRC/zgsvj1.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgtcon.c b/lapack-netlib/SRC/zgtcon.c index bc5732d5e..d35373489 100644 --- a/lapack-netlib/SRC/zgtcon.c +++ b/lapack-netlib/SRC/zgtcon.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgtrfs.c b/lapack-netlib/SRC/zgtrfs.c index a0d1374e6..642d109e8 100644 --- a/lapack-netlib/SRC/zgtrfs.c +++ b/lapack-netlib/SRC/zgtrfs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgtsv.c b/lapack-netlib/SRC/zgtsv.c index 8a4da397a..5acb3be28 100644 --- a/lapack-netlib/SRC/zgtsv.c +++ b/lapack-netlib/SRC/zgtsv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgtsvx.c b/lapack-netlib/SRC/zgtsvx.c index 0d8dec2a1..9a7a8c187 100644 --- a/lapack-netlib/SRC/zgtsvx.c +++ b/lapack-netlib/SRC/zgtsvx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgttrf.c b/lapack-netlib/SRC/zgttrf.c index 4dd8d5e98..ec9bc2f34 100644 --- a/lapack-netlib/SRC/zgttrf.c +++ b/lapack-netlib/SRC/zgttrf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgttrs.c b/lapack-netlib/SRC/zgttrs.c index 99ae1cb14..6e6f3c5ac 100644 --- a/lapack-netlib/SRC/zgttrs.c +++ b/lapack-netlib/SRC/zgttrs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgtts2.c b/lapack-netlib/SRC/zgtts2.c index 235432563..e84a9507b 100644 --- a/lapack-netlib/SRC/zgtts2.c +++ b/lapack-netlib/SRC/zgtts2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zhb2st_kernels.c b/lapack-netlib/SRC/zhb2st_kernels.c index a7734ef64..c06b5b275 100644 --- a/lapack-netlib/SRC/zhb2st_kernels.c +++ b/lapack-netlib/SRC/zhb2st_kernels.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zhbev.c b/lapack-netlib/SRC/zhbev.c index 7d5b2ecf1..c46de93d5 100644 --- a/lapack-netlib/SRC/zhbev.c +++ b/lapack-netlib/SRC/zhbev.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zhbev_2stage.c b/lapack-netlib/SRC/zhbev_2stage.c index 986b0382e..6337d52a4 100644 --- a/lapack-netlib/SRC/zhbev_2stage.c +++ b/lapack-netlib/SRC/zhbev_2stage.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zhbevd.c b/lapack-netlib/SRC/zhbevd.c index 00fd613f7..382d4ab6b 100644 --- a/lapack-netlib/SRC/zhbevd.c +++ b/lapack-netlib/SRC/zhbevd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zhbevd_2stage.c b/lapack-netlib/SRC/zhbevd_2stage.c index 5a866844b..35763067a 100644 --- a/lapack-netlib/SRC/zhbevd_2stage.c +++ b/lapack-netlib/SRC/zhbevd_2stage.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zhbevx.c b/lapack-netlib/SRC/zhbevx.c index 6203b310d..b2f9c1130 100644 --- a/lapack-netlib/SRC/zhbevx.c +++ b/lapack-netlib/SRC/zhbevx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zhbevx_2stage.c b/lapack-netlib/SRC/zhbevx_2stage.c index 64e97ebd3..64bcfc279 100644 --- a/lapack-netlib/SRC/zhbevx_2stage.c +++ b/lapack-netlib/SRC/zhbevx_2stage.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zhbgst.c b/lapack-netlib/SRC/zhbgst.c index e37dd82b4..e08a67b66 100644 --- a/lapack-netlib/SRC/zhbgst.c +++ b/lapack-netlib/SRC/zhbgst.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zhbgv.c b/lapack-netlib/SRC/zhbgv.c index 459f11cab..1c50e2cf2 100644 --- a/lapack-netlib/SRC/zhbgv.c +++ b/lapack-netlib/SRC/zhbgv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zhbgvd.c b/lapack-netlib/SRC/zhbgvd.c index e7dd111f5..c4b92605a 100644 --- a/lapack-netlib/SRC/zhbgvd.c +++ b/lapack-netlib/SRC/zhbgvd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zhbgvx.c b/lapack-netlib/SRC/zhbgvx.c index 75d981600..c6954c077 100644 --- a/lapack-netlib/SRC/zhbgvx.c +++ b/lapack-netlib/SRC/zhbgvx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zhbtrd.c b/lapack-netlib/SRC/zhbtrd.c index 641320b87..abf676fc9 100644 --- a/lapack-netlib/SRC/zhbtrd.c +++ b/lapack-netlib/SRC/zhbtrd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zhecon.c b/lapack-netlib/SRC/zhecon.c index e1ec4b856..b7f3774c2 100644 --- a/lapack-netlib/SRC/zhecon.c +++ b/lapack-netlib/SRC/zhecon.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zhecon_3.c b/lapack-netlib/SRC/zhecon_3.c index 97713d102..71e9f667c 100644 --- a/lapack-netlib/SRC/zhecon_3.c +++ b/lapack-netlib/SRC/zhecon_3.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zhecon_rook.c b/lapack-netlib/SRC/zhecon_rook.c index 82665a210..d59da6cc2 100644 --- a/lapack-netlib/SRC/zhecon_rook.c +++ b/lapack-netlib/SRC/zhecon_rook.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zheequb.c b/lapack-netlib/SRC/zheequb.c index 918272b8b..32b620423 100644 --- a/lapack-netlib/SRC/zheequb.c +++ b/lapack-netlib/SRC/zheequb.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zheev.c b/lapack-netlib/SRC/zheev.c index fed8677b7..0ec48f8f3 100644 --- a/lapack-netlib/SRC/zheev.c +++ b/lapack-netlib/SRC/zheev.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zheev_2stage.c b/lapack-netlib/SRC/zheev_2stage.c index 6fd0b2b58..6f5e3e893 100644 --- a/lapack-netlib/SRC/zheev_2stage.c +++ b/lapack-netlib/SRC/zheev_2stage.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zheevd.c b/lapack-netlib/SRC/zheevd.c index f4e9ef33c..df446b8c2 100644 --- a/lapack-netlib/SRC/zheevd.c +++ b/lapack-netlib/SRC/zheevd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zheevd_2stage.c b/lapack-netlib/SRC/zheevd_2stage.c index a3abcfaca..971ce08be 100644 --- a/lapack-netlib/SRC/zheevd_2stage.c +++ b/lapack-netlib/SRC/zheevd_2stage.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zheevr.c b/lapack-netlib/SRC/zheevr.c index 16f10593e..159a9bceb 100644 --- a/lapack-netlib/SRC/zheevr.c +++ b/lapack-netlib/SRC/zheevr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zheevr_2stage.c b/lapack-netlib/SRC/zheevr_2stage.c index 8f524c77b..9d43883a1 100644 --- a/lapack-netlib/SRC/zheevr_2stage.c +++ b/lapack-netlib/SRC/zheevr_2stage.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zheevx.c b/lapack-netlib/SRC/zheevx.c index c8e4d0b9a..7250e9696 100644 --- a/lapack-netlib/SRC/zheevx.c +++ b/lapack-netlib/SRC/zheevx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zheevx_2stage.c b/lapack-netlib/SRC/zheevx_2stage.c index cc2503067..833ddef83 100644 --- a/lapack-netlib/SRC/zheevx_2stage.c +++ b/lapack-netlib/SRC/zheevx_2stage.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zhegs2.c b/lapack-netlib/SRC/zhegs2.c index ea7aaf923..321c357d2 100644 --- a/lapack-netlib/SRC/zhegs2.c +++ b/lapack-netlib/SRC/zhegs2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zhegst.c b/lapack-netlib/SRC/zhegst.c index d7517e27a..4bf50954f 100644 --- a/lapack-netlib/SRC/zhegst.c +++ b/lapack-netlib/SRC/zhegst.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zhegv.c b/lapack-netlib/SRC/zhegv.c index 77d2ddea4..20005702f 100644 --- a/lapack-netlib/SRC/zhegv.c +++ b/lapack-netlib/SRC/zhegv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zhegv_2stage.c b/lapack-netlib/SRC/zhegv_2stage.c index 9ae891db1..773f51f76 100644 --- a/lapack-netlib/SRC/zhegv_2stage.c +++ b/lapack-netlib/SRC/zhegv_2stage.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zhegvd.c b/lapack-netlib/SRC/zhegvd.c index 6ce5b9552..a05d5e3f1 100644 --- a/lapack-netlib/SRC/zhegvd.c +++ b/lapack-netlib/SRC/zhegvd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zhegvx.c b/lapack-netlib/SRC/zhegvx.c index 77e5ddd74..117e8dab9 100644 --- a/lapack-netlib/SRC/zhegvx.c +++ b/lapack-netlib/SRC/zhegvx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zherfs.c b/lapack-netlib/SRC/zherfs.c index 47496c519..0803da780 100644 --- a/lapack-netlib/SRC/zherfs.c +++ b/lapack-netlib/SRC/zherfs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zherfsx.c b/lapack-netlib/SRC/zherfsx.c index aa3ac4f72..61885f2fe 100644 --- a/lapack-netlib/SRC/zherfsx.c +++ b/lapack-netlib/SRC/zherfsx.c @@ -54,8 +54,8 @@ static inline _Complex float * _pCf(complex *z) {return (_Complex float*)z;} static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double*)z;} #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -257,7 +257,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zhesv.c b/lapack-netlib/SRC/zhesv.c index 64c94960f..337fba5f8 100644 --- a/lapack-netlib/SRC/zhesv.c +++ b/lapack-netlib/SRC/zhesv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zhesv_aa.c b/lapack-netlib/SRC/zhesv_aa.c index 5878e3470..2d10e0d18 100644 --- a/lapack-netlib/SRC/zhesv_aa.c +++ b/lapack-netlib/SRC/zhesv_aa.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zhesv_aa_2stage.c b/lapack-netlib/SRC/zhesv_aa_2stage.c index e2665440d..8bd981d8f 100644 --- a/lapack-netlib/SRC/zhesv_aa_2stage.c +++ b/lapack-netlib/SRC/zhesv_aa_2stage.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zhesv_rk.c b/lapack-netlib/SRC/zhesv_rk.c index 36079d8cf..d8db49742 100644 --- a/lapack-netlib/SRC/zhesv_rk.c +++ b/lapack-netlib/SRC/zhesv_rk.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zhesv_rook.c b/lapack-netlib/SRC/zhesv_rook.c index 4c166c123..1bfee5121 100644 --- a/lapack-netlib/SRC/zhesv_rook.c +++ b/lapack-netlib/SRC/zhesv_rook.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zhesvx.c b/lapack-netlib/SRC/zhesvx.c index a71a0745c..f0b53843a 100644 --- a/lapack-netlib/SRC/zhesvx.c +++ b/lapack-netlib/SRC/zhesvx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zhesvxx.c b/lapack-netlib/SRC/zhesvxx.c index 54b52afc2..efdc9f3e8 100644 --- a/lapack-netlib/SRC/zhesvxx.c +++ b/lapack-netlib/SRC/zhesvxx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zheswapr.c b/lapack-netlib/SRC/zheswapr.c index 999b3f43b..3683bfd2e 100644 --- a/lapack-netlib/SRC/zheswapr.c +++ b/lapack-netlib/SRC/zheswapr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zhetd2.c b/lapack-netlib/SRC/zhetd2.c index af8d2532e..f7bb4748b 100644 --- a/lapack-netlib/SRC/zhetd2.c +++ b/lapack-netlib/SRC/zhetd2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zhetf2.c b/lapack-netlib/SRC/zhetf2.c index 0ded5c3a7..4d2bd2bee 100644 --- a/lapack-netlib/SRC/zhetf2.c +++ b/lapack-netlib/SRC/zhetf2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zhetf2_rk.c b/lapack-netlib/SRC/zhetf2_rk.c index 95131cfca..b4edb3dba 100644 --- a/lapack-netlib/SRC/zhetf2_rk.c +++ b/lapack-netlib/SRC/zhetf2_rk.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zhetf2_rook.c b/lapack-netlib/SRC/zhetf2_rook.c index 40ebc9661..ffebafa42 100644 --- a/lapack-netlib/SRC/zhetf2_rook.c +++ b/lapack-netlib/SRC/zhetf2_rook.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zhetrd.c b/lapack-netlib/SRC/zhetrd.c index a08e38a9c..180d0d617 100644 --- a/lapack-netlib/SRC/zhetrd.c +++ b/lapack-netlib/SRC/zhetrd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zhetrd_2stage.c b/lapack-netlib/SRC/zhetrd_2stage.c index 1d52bdaea..b4aabba89 100644 --- a/lapack-netlib/SRC/zhetrd_2stage.c +++ b/lapack-netlib/SRC/zhetrd_2stage.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zhetrd_hb2st.c b/lapack-netlib/SRC/zhetrd_hb2st.c index cac1d995e..50d296d67 100644 --- a/lapack-netlib/SRC/zhetrd_hb2st.c +++ b/lapack-netlib/SRC/zhetrd_hb2st.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zhetrd_he2hb.c b/lapack-netlib/SRC/zhetrd_he2hb.c index 669ca5c59..f87c24b1f 100644 --- a/lapack-netlib/SRC/zhetrd_he2hb.c +++ b/lapack-netlib/SRC/zhetrd_he2hb.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zhetrf.c b/lapack-netlib/SRC/zhetrf.c index a52c02a65..928fa793f 100644 --- a/lapack-netlib/SRC/zhetrf.c +++ b/lapack-netlib/SRC/zhetrf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zhetrf_aa.c b/lapack-netlib/SRC/zhetrf_aa.c index b3c663bb5..40b290e5f 100644 --- a/lapack-netlib/SRC/zhetrf_aa.c +++ b/lapack-netlib/SRC/zhetrf_aa.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zhetrf_aa_2stage.c b/lapack-netlib/SRC/zhetrf_aa_2stage.c index a21c6c472..ae6f10fc6 100644 --- a/lapack-netlib/SRC/zhetrf_aa_2stage.c +++ b/lapack-netlib/SRC/zhetrf_aa_2stage.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zhetrf_rk.c b/lapack-netlib/SRC/zhetrf_rk.c index b92404579..8b340dfdb 100644 --- a/lapack-netlib/SRC/zhetrf_rk.c +++ b/lapack-netlib/SRC/zhetrf_rk.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zhetrf_rook.c b/lapack-netlib/SRC/zhetrf_rook.c index f4a2b2def..c502352e4 100644 --- a/lapack-netlib/SRC/zhetrf_rook.c +++ b/lapack-netlib/SRC/zhetrf_rook.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zhetri.c b/lapack-netlib/SRC/zhetri.c index 9b7511b55..6aff3a5a4 100644 --- a/lapack-netlib/SRC/zhetri.c +++ b/lapack-netlib/SRC/zhetri.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zhetri2.c b/lapack-netlib/SRC/zhetri2.c index 9dc0f8b54..b3a5394c6 100644 --- a/lapack-netlib/SRC/zhetri2.c +++ b/lapack-netlib/SRC/zhetri2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zhetri2x.c b/lapack-netlib/SRC/zhetri2x.c index fa41c2a5d..4dcf207e4 100644 --- a/lapack-netlib/SRC/zhetri2x.c +++ b/lapack-netlib/SRC/zhetri2x.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zhetri_3.c b/lapack-netlib/SRC/zhetri_3.c index 47d2c6331..df658fb02 100644 --- a/lapack-netlib/SRC/zhetri_3.c +++ b/lapack-netlib/SRC/zhetri_3.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zhetri_3x.c b/lapack-netlib/SRC/zhetri_3x.c index 114ae02d5..a971f09d4 100644 --- a/lapack-netlib/SRC/zhetri_3x.c +++ b/lapack-netlib/SRC/zhetri_3x.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zhetri_rook.c b/lapack-netlib/SRC/zhetri_rook.c index 1897f04b3..efc2b4401 100644 --- a/lapack-netlib/SRC/zhetri_rook.c +++ b/lapack-netlib/SRC/zhetri_rook.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zhetrs.c b/lapack-netlib/SRC/zhetrs.c index a732bb7f9..c6101c701 100644 --- a/lapack-netlib/SRC/zhetrs.c +++ b/lapack-netlib/SRC/zhetrs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zhetrs2.c b/lapack-netlib/SRC/zhetrs2.c index fe49e271c..bc2c75e4a 100644 --- a/lapack-netlib/SRC/zhetrs2.c +++ b/lapack-netlib/SRC/zhetrs2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zhetrs_3.c b/lapack-netlib/SRC/zhetrs_3.c index d8160301e..d0b728f74 100644 --- a/lapack-netlib/SRC/zhetrs_3.c +++ b/lapack-netlib/SRC/zhetrs_3.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zhetrs_aa.c b/lapack-netlib/SRC/zhetrs_aa.c index bdebbd6b3..d2c4da0ed 100644 --- a/lapack-netlib/SRC/zhetrs_aa.c +++ b/lapack-netlib/SRC/zhetrs_aa.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zhetrs_aa_2stage.c b/lapack-netlib/SRC/zhetrs_aa_2stage.c index efcebead3..8cf70349c 100644 --- a/lapack-netlib/SRC/zhetrs_aa_2stage.c +++ b/lapack-netlib/SRC/zhetrs_aa_2stage.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zhetrs_rook.c b/lapack-netlib/SRC/zhetrs_rook.c index f6f814ea9..8a23b694c 100644 --- a/lapack-netlib/SRC/zhetrs_rook.c +++ b/lapack-netlib/SRC/zhetrs_rook.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else From 04aae0e12b5235affb229a6b430a6c3f631ad802 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Wed, 3 Apr 2024 23:57:12 +0200 Subject: [PATCH 277/311] fix typedef of logical to support INTERFACE64 --- lapack-netlib/SRC/xerbla.c | 6 +++--- lapack-netlib/SRC/xerbla_array.c | 6 +++--- lapack-netlib/SRC/zbbcsd.c | 6 +++--- lapack-netlib/SRC/zbdsqr.c | 6 +++--- lapack-netlib/SRC/zcgesv.c | 6 +++--- lapack-netlib/SRC/zcposv.c | 6 +++--- lapack-netlib/SRC/zdrscl.c | 6 +++--- lapack-netlib/SRC/zgbbrd.c | 6 +++--- lapack-netlib/SRC/zgbcon.c | 6 +++--- lapack-netlib/SRC/zgbequ.c | 6 +++--- lapack-netlib/SRC/zgbequb.c | 6 +++--- lapack-netlib/SRC/zgbrfs.c | 6 +++--- lapack-netlib/SRC/zgbrfsx.c | 6 +++--- lapack-netlib/SRC/zgbsv.c | 6 +++--- lapack-netlib/SRC/zgbsvx.c | 6 +++--- lapack-netlib/SRC/zgbsvxx.c | 6 +++--- lapack-netlib/SRC/zgbtf2.c | 6 +++--- lapack-netlib/SRC/zgbtrf.c | 6 +++--- lapack-netlib/SRC/zgbtrs.c | 6 +++--- lapack-netlib/SRC/zgebak.c | 6 +++--- lapack-netlib/SRC/zgebal.c | 6 +++--- lapack-netlib/SRC/zgebd2.c | 6 +++--- lapack-netlib/SRC/zgebrd.c | 6 +++--- lapack-netlib/SRC/zgecon.c | 6 +++--- lapack-netlib/SRC/zgedmd.c | 6 +++--- lapack-netlib/SRC/zgedmdq.c | 6 +++--- lapack-netlib/SRC/zgeequ.c | 6 +++--- lapack-netlib/SRC/zgeequb.c | 6 +++--- lapack-netlib/SRC/zgees.c | 6 +++--- lapack-netlib/SRC/zgeesx.c | 6 +++--- lapack-netlib/SRC/zgeev.c | 6 +++--- lapack-netlib/SRC/zgeevx.c | 6 +++--- lapack-netlib/SRC/zgehd2.c | 6 +++--- lapack-netlib/SRC/zgehrd.c | 6 +++--- lapack-netlib/SRC/zgejsv.c | 6 +++--- lapack-netlib/SRC/zgelq.c | 6 +++--- lapack-netlib/SRC/zgelq2.c | 6 +++--- lapack-netlib/SRC/zgelqf.c | 6 +++--- lapack-netlib/SRC/zgelqt.c | 6 +++--- lapack-netlib/SRC/zgelqt3.c | 6 +++--- lapack-netlib/SRC/zgels.c | 6 +++--- lapack-netlib/SRC/zgelsd.c | 6 +++--- lapack-netlib/SRC/zgelss.c | 6 +++--- lapack-netlib/SRC/zgelst.c | 6 +++--- lapack-netlib/SRC/zgelsy.c | 6 +++--- lapack-netlib/SRC/zgemlq.c | 6 +++--- lapack-netlib/SRC/zgemlqt.c | 6 +++--- lapack-netlib/SRC/zgemqr.c | 6 +++--- lapack-netlib/SRC/zgemqrt.c | 6 +++--- lapack-netlib/SRC/zgeql2.c | 6 +++--- lapack-netlib/SRC/zgeqlf.c | 6 +++--- lapack-netlib/SRC/zgeqp3.c | 6 +++--- lapack-netlib/SRC/zgeqp3rk.c | 6 +++--- lapack-netlib/SRC/zgeqr.c | 6 +++--- lapack-netlib/SRC/zgeqr2.c | 6 +++--- lapack-netlib/SRC/zgeqr2p.c | 6 +++--- lapack-netlib/SRC/zgeqrf.c | 6 +++--- lapack-netlib/SRC/zgeqrfp.c | 6 +++--- lapack-netlib/SRC/zgeqrt.c | 6 +++--- lapack-netlib/SRC/zgeqrt2.c | 6 +++--- lapack-netlib/SRC/zgeqrt3.c | 6 +++--- lapack-netlib/SRC/zgerfs.c | 6 +++--- lapack-netlib/SRC/zgerfsx.c | 6 +++--- lapack-netlib/SRC/zgerq2.c | 6 +++--- lapack-netlib/SRC/zgerqf.c | 6 +++--- lapack-netlib/SRC/zgesc2.c | 6 +++--- lapack-netlib/SRC/zgesdd.c | 6 +++--- lapack-netlib/SRC/zgesv.c | 6 +++--- lapack-netlib/SRC/zgesvd.c | 6 +++--- lapack-netlib/SRC/zgesvdq.c | 6 +++--- lapack-netlib/SRC/zgesvdx.c | 6 +++--- lapack-netlib/SRC/zgesvj.c | 6 +++--- lapack-netlib/SRC/zgesvx.c | 6 +++--- lapack-netlib/SRC/zgesvxx.c | 6 +++--- lapack-netlib/SRC/zgetc2.c | 6 +++--- lapack-netlib/SRC/zgetf2.c | 6 +++--- lapack-netlib/SRC/zgetrf.c | 6 +++--- lapack-netlib/SRC/zgetrf2.c | 6 +++--- lapack-netlib/SRC/zgetri.c | 6 +++--- lapack-netlib/SRC/zgetrs.c | 6 +++--- lapack-netlib/SRC/zgetsls.c | 6 +++--- lapack-netlib/SRC/zgetsqrhrt.c | 6 +++--- lapack-netlib/SRC/zggbak.c | 6 +++--- lapack-netlib/SRC/zggbal.c | 6 +++--- 84 files changed, 252 insertions(+), 252 deletions(-) diff --git a/lapack-netlib/SRC/xerbla.c b/lapack-netlib/SRC/xerbla.c index f571aeea0..309762e40 100644 --- a/lapack-netlib/SRC/xerbla.c +++ b/lapack-netlib/SRC/xerbla.c @@ -54,8 +54,8 @@ static inline _Complex float * _pCf(complex *z) {return (_Complex float*)z;} static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double*)z;} #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -257,7 +257,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/xerbla_array.c b/lapack-netlib/SRC/xerbla_array.c index fe7d6d898..92219b986 100644 --- a/lapack-netlib/SRC/xerbla_array.c +++ b/lapack-netlib/SRC/xerbla_array.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zbbcsd.c b/lapack-netlib/SRC/zbbcsd.c index 4cef71060..1d89db1b2 100644 --- a/lapack-netlib/SRC/zbbcsd.c +++ b/lapack-netlib/SRC/zbbcsd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zbdsqr.c b/lapack-netlib/SRC/zbdsqr.c index 35dac9e73..a1d107621 100644 --- a/lapack-netlib/SRC/zbdsqr.c +++ b/lapack-netlib/SRC/zbdsqr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zcgesv.c b/lapack-netlib/SRC/zcgesv.c index 095fa756d..1cac2a966 100644 --- a/lapack-netlib/SRC/zcgesv.c +++ b/lapack-netlib/SRC/zcgesv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zcposv.c b/lapack-netlib/SRC/zcposv.c index 65ae2e4dd..fac41f398 100644 --- a/lapack-netlib/SRC/zcposv.c +++ b/lapack-netlib/SRC/zcposv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zdrscl.c b/lapack-netlib/SRC/zdrscl.c index 3173319e7..d6b643951 100644 --- a/lapack-netlib/SRC/zdrscl.c +++ b/lapack-netlib/SRC/zdrscl.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgbbrd.c b/lapack-netlib/SRC/zgbbrd.c index e9008214a..21e247b93 100644 --- a/lapack-netlib/SRC/zgbbrd.c +++ b/lapack-netlib/SRC/zgbbrd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgbcon.c b/lapack-netlib/SRC/zgbcon.c index 5cac8cdef..8c2adac66 100644 --- a/lapack-netlib/SRC/zgbcon.c +++ b/lapack-netlib/SRC/zgbcon.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgbequ.c b/lapack-netlib/SRC/zgbequ.c index 7c5f38723..de5f469ee 100644 --- a/lapack-netlib/SRC/zgbequ.c +++ b/lapack-netlib/SRC/zgbequ.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgbequb.c b/lapack-netlib/SRC/zgbequb.c index 11a14d641..672fb1c3d 100644 --- a/lapack-netlib/SRC/zgbequb.c +++ b/lapack-netlib/SRC/zgbequb.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgbrfs.c b/lapack-netlib/SRC/zgbrfs.c index a09132c43..025ad9146 100644 --- a/lapack-netlib/SRC/zgbrfs.c +++ b/lapack-netlib/SRC/zgbrfs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgbrfsx.c b/lapack-netlib/SRC/zgbrfsx.c index aa3ac4f72..61885f2fe 100644 --- a/lapack-netlib/SRC/zgbrfsx.c +++ b/lapack-netlib/SRC/zgbrfsx.c @@ -54,8 +54,8 @@ static inline _Complex float * _pCf(complex *z) {return (_Complex float*)z;} static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double*)z;} #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -257,7 +257,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgbsv.c b/lapack-netlib/SRC/zgbsv.c index 38a84cdcd..a224f62a6 100644 --- a/lapack-netlib/SRC/zgbsv.c +++ b/lapack-netlib/SRC/zgbsv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgbsvx.c b/lapack-netlib/SRC/zgbsvx.c index 5e18ae34a..d20f44743 100644 --- a/lapack-netlib/SRC/zgbsvx.c +++ b/lapack-netlib/SRC/zgbsvx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgbsvxx.c b/lapack-netlib/SRC/zgbsvxx.c index ad6692aa0..6928a7b43 100644 --- a/lapack-netlib/SRC/zgbsvxx.c +++ b/lapack-netlib/SRC/zgbsvxx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgbtf2.c b/lapack-netlib/SRC/zgbtf2.c index b15c12d86..a06c4c100 100644 --- a/lapack-netlib/SRC/zgbtf2.c +++ b/lapack-netlib/SRC/zgbtf2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgbtrf.c b/lapack-netlib/SRC/zgbtrf.c index 64b5d1304..236f1434d 100644 --- a/lapack-netlib/SRC/zgbtrf.c +++ b/lapack-netlib/SRC/zgbtrf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgbtrs.c b/lapack-netlib/SRC/zgbtrs.c index b744ab5b6..4f3f36350 100644 --- a/lapack-netlib/SRC/zgbtrs.c +++ b/lapack-netlib/SRC/zgbtrs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgebak.c b/lapack-netlib/SRC/zgebak.c index 131185aec..1cda920df 100644 --- a/lapack-netlib/SRC/zgebak.c +++ b/lapack-netlib/SRC/zgebak.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgebal.c b/lapack-netlib/SRC/zgebal.c index 289e9c9a5..36b7203ee 100644 --- a/lapack-netlib/SRC/zgebal.c +++ b/lapack-netlib/SRC/zgebal.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgebd2.c b/lapack-netlib/SRC/zgebd2.c index 17282ba0b..d8d9e27b9 100644 --- a/lapack-netlib/SRC/zgebd2.c +++ b/lapack-netlib/SRC/zgebd2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgebrd.c b/lapack-netlib/SRC/zgebrd.c index cc2d94b65..bc0fb3a79 100644 --- a/lapack-netlib/SRC/zgebrd.c +++ b/lapack-netlib/SRC/zgebrd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgecon.c b/lapack-netlib/SRC/zgecon.c index d83bcf93f..1dbe908e0 100644 --- a/lapack-netlib/SRC/zgecon.c +++ b/lapack-netlib/SRC/zgecon.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgedmd.c b/lapack-netlib/SRC/zgedmd.c index c1b39ba3e..0adad21d8 100644 --- a/lapack-netlib/SRC/zgedmd.c +++ b/lapack-netlib/SRC/zgedmd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgedmdq.c b/lapack-netlib/SRC/zgedmdq.c index 1815f0814..6ef687371 100644 --- a/lapack-netlib/SRC/zgedmdq.c +++ b/lapack-netlib/SRC/zgedmdq.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgeequ.c b/lapack-netlib/SRC/zgeequ.c index b48f175c6..89c8e61f2 100644 --- a/lapack-netlib/SRC/zgeequ.c +++ b/lapack-netlib/SRC/zgeequ.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgeequb.c b/lapack-netlib/SRC/zgeequb.c index 6b35c8994..f9ec3045a 100644 --- a/lapack-netlib/SRC/zgeequb.c +++ b/lapack-netlib/SRC/zgeequb.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgees.c b/lapack-netlib/SRC/zgees.c index 504417329..fea0f2573 100644 --- a/lapack-netlib/SRC/zgees.c +++ b/lapack-netlib/SRC/zgees.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgeesx.c b/lapack-netlib/SRC/zgeesx.c index a04f05d9f..3749c53e5 100644 --- a/lapack-netlib/SRC/zgeesx.c +++ b/lapack-netlib/SRC/zgeesx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgeev.c b/lapack-netlib/SRC/zgeev.c index 7034c7c5b..e9bff9b10 100644 --- a/lapack-netlib/SRC/zgeev.c +++ b/lapack-netlib/SRC/zgeev.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgeevx.c b/lapack-netlib/SRC/zgeevx.c index 874b56e1d..221efe857 100644 --- a/lapack-netlib/SRC/zgeevx.c +++ b/lapack-netlib/SRC/zgeevx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgehd2.c b/lapack-netlib/SRC/zgehd2.c index 5ce4b504f..125727e39 100644 --- a/lapack-netlib/SRC/zgehd2.c +++ b/lapack-netlib/SRC/zgehd2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgehrd.c b/lapack-netlib/SRC/zgehrd.c index bb1bdc0db..ac39cec7d 100644 --- a/lapack-netlib/SRC/zgehrd.c +++ b/lapack-netlib/SRC/zgehrd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgejsv.c b/lapack-netlib/SRC/zgejsv.c index 7158ff8d7..13928d93a 100644 --- a/lapack-netlib/SRC/zgejsv.c +++ b/lapack-netlib/SRC/zgejsv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgelq.c b/lapack-netlib/SRC/zgelq.c index f876c6ed0..960b92604 100644 --- a/lapack-netlib/SRC/zgelq.c +++ b/lapack-netlib/SRC/zgelq.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgelq2.c b/lapack-netlib/SRC/zgelq2.c index b9dc8893b..216f1eaa2 100644 --- a/lapack-netlib/SRC/zgelq2.c +++ b/lapack-netlib/SRC/zgelq2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgelqf.c b/lapack-netlib/SRC/zgelqf.c index 4373e4616..6c641aeb8 100644 --- a/lapack-netlib/SRC/zgelqf.c +++ b/lapack-netlib/SRC/zgelqf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgelqt.c b/lapack-netlib/SRC/zgelqt.c index e9bc1f855..baa6c4e92 100644 --- a/lapack-netlib/SRC/zgelqt.c +++ b/lapack-netlib/SRC/zgelqt.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgelqt3.c b/lapack-netlib/SRC/zgelqt3.c index 6732698c1..64e6435cd 100644 --- a/lapack-netlib/SRC/zgelqt3.c +++ b/lapack-netlib/SRC/zgelqt3.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgels.c b/lapack-netlib/SRC/zgels.c index fdc1da60a..5f3ca5e4b 100644 --- a/lapack-netlib/SRC/zgels.c +++ b/lapack-netlib/SRC/zgels.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgelsd.c b/lapack-netlib/SRC/zgelsd.c index f101cb3f0..3a42ae9ce 100644 --- a/lapack-netlib/SRC/zgelsd.c +++ b/lapack-netlib/SRC/zgelsd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgelss.c b/lapack-netlib/SRC/zgelss.c index 573963478..fe98d07d4 100644 --- a/lapack-netlib/SRC/zgelss.c +++ b/lapack-netlib/SRC/zgelss.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgelst.c b/lapack-netlib/SRC/zgelst.c index 88e0dcc9c..42282011c 100644 --- a/lapack-netlib/SRC/zgelst.c +++ b/lapack-netlib/SRC/zgelst.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgelsy.c b/lapack-netlib/SRC/zgelsy.c index 673ea76c8..2e4d3955e 100644 --- a/lapack-netlib/SRC/zgelsy.c +++ b/lapack-netlib/SRC/zgelsy.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgemlq.c b/lapack-netlib/SRC/zgemlq.c index dc1616d7a..42dcbdbdd 100644 --- a/lapack-netlib/SRC/zgemlq.c +++ b/lapack-netlib/SRC/zgemlq.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgemlqt.c b/lapack-netlib/SRC/zgemlqt.c index 2487a49b0..8d78d6f5d 100644 --- a/lapack-netlib/SRC/zgemlqt.c +++ b/lapack-netlib/SRC/zgemlqt.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgemqr.c b/lapack-netlib/SRC/zgemqr.c index 600c94145..b975f318c 100644 --- a/lapack-netlib/SRC/zgemqr.c +++ b/lapack-netlib/SRC/zgemqr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgemqrt.c b/lapack-netlib/SRC/zgemqrt.c index 0ac74d4c5..5edef0691 100644 --- a/lapack-netlib/SRC/zgemqrt.c +++ b/lapack-netlib/SRC/zgemqrt.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgeql2.c b/lapack-netlib/SRC/zgeql2.c index b62412cfe..81b332077 100644 --- a/lapack-netlib/SRC/zgeql2.c +++ b/lapack-netlib/SRC/zgeql2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgeqlf.c b/lapack-netlib/SRC/zgeqlf.c index b562fc9a2..2aabd5dec 100644 --- a/lapack-netlib/SRC/zgeqlf.c +++ b/lapack-netlib/SRC/zgeqlf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgeqp3.c b/lapack-netlib/SRC/zgeqp3.c index f2b957e7a..c8601af2f 100644 --- a/lapack-netlib/SRC/zgeqp3.c +++ b/lapack-netlib/SRC/zgeqp3.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgeqp3rk.c b/lapack-netlib/SRC/zgeqp3rk.c index 0c8b41c2d..14e5b0cda 100644 --- a/lapack-netlib/SRC/zgeqp3rk.c +++ b/lapack-netlib/SRC/zgeqp3rk.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgeqr.c b/lapack-netlib/SRC/zgeqr.c index 93af2ac2b..00fe402eb 100644 --- a/lapack-netlib/SRC/zgeqr.c +++ b/lapack-netlib/SRC/zgeqr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgeqr2.c b/lapack-netlib/SRC/zgeqr2.c index cf368ad46..d1cc85f2c 100644 --- a/lapack-netlib/SRC/zgeqr2.c +++ b/lapack-netlib/SRC/zgeqr2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgeqr2p.c b/lapack-netlib/SRC/zgeqr2p.c index 4e409ec78..824725e21 100644 --- a/lapack-netlib/SRC/zgeqr2p.c +++ b/lapack-netlib/SRC/zgeqr2p.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgeqrf.c b/lapack-netlib/SRC/zgeqrf.c index 9f2facb99..f37a28b7c 100644 --- a/lapack-netlib/SRC/zgeqrf.c +++ b/lapack-netlib/SRC/zgeqrf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgeqrfp.c b/lapack-netlib/SRC/zgeqrfp.c index 5432a10a3..4658d5f3d 100644 --- a/lapack-netlib/SRC/zgeqrfp.c +++ b/lapack-netlib/SRC/zgeqrfp.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgeqrt.c b/lapack-netlib/SRC/zgeqrt.c index c3919be55..717d484d6 100644 --- a/lapack-netlib/SRC/zgeqrt.c +++ b/lapack-netlib/SRC/zgeqrt.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgeqrt2.c b/lapack-netlib/SRC/zgeqrt2.c index 847db1b82..0fdb08e49 100644 --- a/lapack-netlib/SRC/zgeqrt2.c +++ b/lapack-netlib/SRC/zgeqrt2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgeqrt3.c b/lapack-netlib/SRC/zgeqrt3.c index 020558deb..589680b6d 100644 --- a/lapack-netlib/SRC/zgeqrt3.c +++ b/lapack-netlib/SRC/zgeqrt3.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgerfs.c b/lapack-netlib/SRC/zgerfs.c index a53dd4f8f..733175f66 100644 --- a/lapack-netlib/SRC/zgerfs.c +++ b/lapack-netlib/SRC/zgerfs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgerfsx.c b/lapack-netlib/SRC/zgerfsx.c index aa3ac4f72..61885f2fe 100644 --- a/lapack-netlib/SRC/zgerfsx.c +++ b/lapack-netlib/SRC/zgerfsx.c @@ -54,8 +54,8 @@ static inline _Complex float * _pCf(complex *z) {return (_Complex float*)z;} static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double*)z;} #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -257,7 +257,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgerq2.c b/lapack-netlib/SRC/zgerq2.c index ccafd6293..13d5445c5 100644 --- a/lapack-netlib/SRC/zgerq2.c +++ b/lapack-netlib/SRC/zgerq2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgerqf.c b/lapack-netlib/SRC/zgerqf.c index 840416f50..b3e777dd3 100644 --- a/lapack-netlib/SRC/zgerqf.c +++ b/lapack-netlib/SRC/zgerqf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgesc2.c b/lapack-netlib/SRC/zgesc2.c index ae7884dd7..26b602a71 100644 --- a/lapack-netlib/SRC/zgesc2.c +++ b/lapack-netlib/SRC/zgesc2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgesdd.c b/lapack-netlib/SRC/zgesdd.c index 898d5c87a..22b59c426 100644 --- a/lapack-netlib/SRC/zgesdd.c +++ b/lapack-netlib/SRC/zgesdd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgesv.c b/lapack-netlib/SRC/zgesv.c index 53813cd01..210c8b272 100644 --- a/lapack-netlib/SRC/zgesv.c +++ b/lapack-netlib/SRC/zgesv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgesvd.c b/lapack-netlib/SRC/zgesvd.c index 0d1670357..ed54892af 100644 --- a/lapack-netlib/SRC/zgesvd.c +++ b/lapack-netlib/SRC/zgesvd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgesvdq.c b/lapack-netlib/SRC/zgesvdq.c index ea91ef269..a1a6723c6 100644 --- a/lapack-netlib/SRC/zgesvdq.c +++ b/lapack-netlib/SRC/zgesvdq.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgesvdx.c b/lapack-netlib/SRC/zgesvdx.c index dfd525a95..ba915f0dd 100644 --- a/lapack-netlib/SRC/zgesvdx.c +++ b/lapack-netlib/SRC/zgesvdx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgesvj.c b/lapack-netlib/SRC/zgesvj.c index b94112af0..d4985f642 100644 --- a/lapack-netlib/SRC/zgesvj.c +++ b/lapack-netlib/SRC/zgesvj.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgesvx.c b/lapack-netlib/SRC/zgesvx.c index 7a8538c35..57c1289fb 100644 --- a/lapack-netlib/SRC/zgesvx.c +++ b/lapack-netlib/SRC/zgesvx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgesvxx.c b/lapack-netlib/SRC/zgesvxx.c index ed19f0d39..054a3c8cb 100644 --- a/lapack-netlib/SRC/zgesvxx.c +++ b/lapack-netlib/SRC/zgesvxx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgetc2.c b/lapack-netlib/SRC/zgetc2.c index 80ff7ab60..73eba5290 100644 --- a/lapack-netlib/SRC/zgetc2.c +++ b/lapack-netlib/SRC/zgetc2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgetf2.c b/lapack-netlib/SRC/zgetf2.c index fdc895428..1a7d7b940 100644 --- a/lapack-netlib/SRC/zgetf2.c +++ b/lapack-netlib/SRC/zgetf2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgetrf.c b/lapack-netlib/SRC/zgetrf.c index d4f52efd3..287b51332 100644 --- a/lapack-netlib/SRC/zgetrf.c +++ b/lapack-netlib/SRC/zgetrf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgetrf2.c b/lapack-netlib/SRC/zgetrf2.c index 679b10374..849d90741 100644 --- a/lapack-netlib/SRC/zgetrf2.c +++ b/lapack-netlib/SRC/zgetrf2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgetri.c b/lapack-netlib/SRC/zgetri.c index e7a46e719..72fa88fdb 100644 --- a/lapack-netlib/SRC/zgetri.c +++ b/lapack-netlib/SRC/zgetri.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgetrs.c b/lapack-netlib/SRC/zgetrs.c index d9e10c346..c6de811e8 100644 --- a/lapack-netlib/SRC/zgetrs.c +++ b/lapack-netlib/SRC/zgetrs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgetsls.c b/lapack-netlib/SRC/zgetsls.c index a63df472f..c9f1d5d97 100644 --- a/lapack-netlib/SRC/zgetsls.c +++ b/lapack-netlib/SRC/zgetsls.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zgetsqrhrt.c b/lapack-netlib/SRC/zgetsqrhrt.c index 6b426465f..28d85782d 100644 --- a/lapack-netlib/SRC/zgetsqrhrt.c +++ b/lapack-netlib/SRC/zgetsqrhrt.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zggbak.c b/lapack-netlib/SRC/zggbak.c index 735ae22f9..418da428b 100644 --- a/lapack-netlib/SRC/zggbak.c +++ b/lapack-netlib/SRC/zggbak.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/zggbal.c b/lapack-netlib/SRC/zggbal.c index 673ad9d14..4bde5573e 100644 --- a/lapack-netlib/SRC/zggbal.c +++ b/lapack-netlib/SRC/zggbal.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else From 770246363fe1ce9fc1224d08b706efa5d7eb4ca1 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Thu, 4 Apr 2024 00:04:50 +0200 Subject: [PATCH 278/311] fix typedef of logical to support INTERFACE64 --- lapack-netlib/SRC/ssysvx.c | 6 +++--- lapack-netlib/SRC/ssysvxx.c | 6 +++--- lapack-netlib/SRC/ssyswapr.c | 6 +++--- lapack-netlib/SRC/ssytd2.c | 6 +++--- lapack-netlib/SRC/ssytf2.c | 6 +++--- lapack-netlib/SRC/ssytf2_rk.c | 6 +++--- lapack-netlib/SRC/ssytf2_rook.c | 6 +++--- lapack-netlib/SRC/ssytrd.c | 6 +++--- lapack-netlib/SRC/ssytrd_2stage.c | 6 +++--- lapack-netlib/SRC/ssytrd_sb2st.c | 6 +++--- lapack-netlib/SRC/ssytrd_sy2sb.c | 6 +++--- lapack-netlib/SRC/ssytrf.c | 6 +++--- lapack-netlib/SRC/ssytrf_aa.c | 6 +++--- lapack-netlib/SRC/ssytrf_aa_2stage.c | 6 +++--- lapack-netlib/SRC/ssytrf_rk.c | 6 +++--- lapack-netlib/SRC/ssytrf_rook.c | 6 +++--- lapack-netlib/SRC/ssytri.c | 6 +++--- lapack-netlib/SRC/ssytri2.c | 6 +++--- lapack-netlib/SRC/ssytri2x.c | 6 +++--- lapack-netlib/SRC/ssytri_3.c | 6 +++--- lapack-netlib/SRC/ssytri_3x.c | 6 +++--- lapack-netlib/SRC/ssytri_rook.c | 6 +++--- lapack-netlib/SRC/ssytrs.c | 6 +++--- lapack-netlib/SRC/ssytrs2.c | 6 +++--- lapack-netlib/SRC/ssytrs_3.c | 6 +++--- lapack-netlib/SRC/ssytrs_aa.c | 6 +++--- lapack-netlib/SRC/ssytrs_aa_2stage.c | 6 +++--- lapack-netlib/SRC/ssytrs_rook.c | 6 +++--- lapack-netlib/SRC/stbcon.c | 6 +++--- lapack-netlib/SRC/stbrfs.c | 6 +++--- lapack-netlib/SRC/stbtrs.c | 6 +++--- lapack-netlib/SRC/stfsm.c | 6 +++--- lapack-netlib/SRC/stftri.c | 6 +++--- lapack-netlib/SRC/stfttp.c | 6 +++--- lapack-netlib/SRC/stfttr.c | 6 +++--- lapack-netlib/SRC/stgevc.c | 6 +++--- lapack-netlib/SRC/stgex2.c | 6 +++--- lapack-netlib/SRC/stgexc.c | 6 +++--- lapack-netlib/SRC/stgsen.c | 6 +++--- lapack-netlib/SRC/stgsja.c | 6 +++--- lapack-netlib/SRC/stgsna.c | 6 +++--- lapack-netlib/SRC/stgsy2.c | 6 +++--- lapack-netlib/SRC/stgsyl.c | 6 +++--- lapack-netlib/SRC/stpcon.c | 6 +++--- lapack-netlib/SRC/stplqt.c | 6 +++--- lapack-netlib/SRC/stplqt2.c | 6 +++--- lapack-netlib/SRC/stpmlqt.c | 6 +++--- lapack-netlib/SRC/stpmqrt.c | 6 +++--- lapack-netlib/SRC/stpqrt.c | 6 +++--- lapack-netlib/SRC/stpqrt2.c | 6 +++--- lapack-netlib/SRC/stprfb.c | 6 +++--- lapack-netlib/SRC/stprfs.c | 6 +++--- lapack-netlib/SRC/stptri.c | 6 +++--- lapack-netlib/SRC/stptrs.c | 6 +++--- lapack-netlib/SRC/stpttf.c | 6 +++--- lapack-netlib/SRC/stpttr.c | 6 +++--- lapack-netlib/SRC/strcon.c | 6 +++--- lapack-netlib/SRC/strevc.c | 6 +++--- lapack-netlib/SRC/strevc3.c | 6 +++--- lapack-netlib/SRC/strexc.c | 6 +++--- lapack-netlib/SRC/strrfs.c | 6 +++--- lapack-netlib/SRC/strsen.c | 6 +++--- lapack-netlib/SRC/strsna.c | 6 +++--- lapack-netlib/SRC/strsyl.c | 6 +++--- lapack-netlib/SRC/strsyl3.c | 6 +++--- lapack-netlib/SRC/strti2.c | 6 +++--- lapack-netlib/SRC/strtri.c | 6 +++--- lapack-netlib/SRC/strtrs.c | 6 +++--- lapack-netlib/SRC/strttf.c | 6 +++--- lapack-netlib/SRC/strttp.c | 6 +++--- lapack-netlib/SRC/stzrzf.c | 6 +++--- 71 files changed, 213 insertions(+), 213 deletions(-) diff --git a/lapack-netlib/SRC/ssysvx.c b/lapack-netlib/SRC/ssysvx.c index a6b2d7a1c..ccc016fd6 100644 --- a/lapack-netlib/SRC/ssysvx.c +++ b/lapack-netlib/SRC/ssysvx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ssysvxx.c b/lapack-netlib/SRC/ssysvxx.c index 46cfecb64..d2e34bbba 100644 --- a/lapack-netlib/SRC/ssysvxx.c +++ b/lapack-netlib/SRC/ssysvxx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ssyswapr.c b/lapack-netlib/SRC/ssyswapr.c index 532d2b4b5..09a363a27 100644 --- a/lapack-netlib/SRC/ssyswapr.c +++ b/lapack-netlib/SRC/ssyswapr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ssytd2.c b/lapack-netlib/SRC/ssytd2.c index bb0046680..a98497be6 100644 --- a/lapack-netlib/SRC/ssytd2.c +++ b/lapack-netlib/SRC/ssytd2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ssytf2.c b/lapack-netlib/SRC/ssytf2.c index 7347525c9..d90be5393 100644 --- a/lapack-netlib/SRC/ssytf2.c +++ b/lapack-netlib/SRC/ssytf2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ssytf2_rk.c b/lapack-netlib/SRC/ssytf2_rk.c index 9cd7f07d8..cae771855 100644 --- a/lapack-netlib/SRC/ssytf2_rk.c +++ b/lapack-netlib/SRC/ssytf2_rk.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ssytf2_rook.c b/lapack-netlib/SRC/ssytf2_rook.c index ce244ceb5..dc2deca72 100644 --- a/lapack-netlib/SRC/ssytf2_rook.c +++ b/lapack-netlib/SRC/ssytf2_rook.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ssytrd.c b/lapack-netlib/SRC/ssytrd.c index f2b213003..2a6029d01 100644 --- a/lapack-netlib/SRC/ssytrd.c +++ b/lapack-netlib/SRC/ssytrd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ssytrd_2stage.c b/lapack-netlib/SRC/ssytrd_2stage.c index 2242619b5..be92520dd 100644 --- a/lapack-netlib/SRC/ssytrd_2stage.c +++ b/lapack-netlib/SRC/ssytrd_2stage.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ssytrd_sb2st.c b/lapack-netlib/SRC/ssytrd_sb2st.c index c621673c6..2cbd33989 100644 --- a/lapack-netlib/SRC/ssytrd_sb2st.c +++ b/lapack-netlib/SRC/ssytrd_sb2st.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ssytrd_sy2sb.c b/lapack-netlib/SRC/ssytrd_sy2sb.c index 096c0aea6..6587a04cd 100644 --- a/lapack-netlib/SRC/ssytrd_sy2sb.c +++ b/lapack-netlib/SRC/ssytrd_sy2sb.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ssytrf.c b/lapack-netlib/SRC/ssytrf.c index b69d20d79..7e46144c4 100644 --- a/lapack-netlib/SRC/ssytrf.c +++ b/lapack-netlib/SRC/ssytrf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ssytrf_aa.c b/lapack-netlib/SRC/ssytrf_aa.c index f66e03453..ab234c9cf 100644 --- a/lapack-netlib/SRC/ssytrf_aa.c +++ b/lapack-netlib/SRC/ssytrf_aa.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ssytrf_aa_2stage.c b/lapack-netlib/SRC/ssytrf_aa_2stage.c index 2aa0a9d23..9e1f2a190 100644 --- a/lapack-netlib/SRC/ssytrf_aa_2stage.c +++ b/lapack-netlib/SRC/ssytrf_aa_2stage.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ssytrf_rk.c b/lapack-netlib/SRC/ssytrf_rk.c index 1eb83fb31..3ac4336ab 100644 --- a/lapack-netlib/SRC/ssytrf_rk.c +++ b/lapack-netlib/SRC/ssytrf_rk.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ssytrf_rook.c b/lapack-netlib/SRC/ssytrf_rook.c index 1091438e4..574d85945 100644 --- a/lapack-netlib/SRC/ssytrf_rook.c +++ b/lapack-netlib/SRC/ssytrf_rook.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ssytri.c b/lapack-netlib/SRC/ssytri.c index 33ef9d581..84b1c90fd 100644 --- a/lapack-netlib/SRC/ssytri.c +++ b/lapack-netlib/SRC/ssytri.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ssytri2.c b/lapack-netlib/SRC/ssytri2.c index 1ab96b18e..1a86204bb 100644 --- a/lapack-netlib/SRC/ssytri2.c +++ b/lapack-netlib/SRC/ssytri2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ssytri2x.c b/lapack-netlib/SRC/ssytri2x.c index 0caf344c5..6601285f5 100644 --- a/lapack-netlib/SRC/ssytri2x.c +++ b/lapack-netlib/SRC/ssytri2x.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ssytri_3.c b/lapack-netlib/SRC/ssytri_3.c index 0b393594c..03c947a0d 100644 --- a/lapack-netlib/SRC/ssytri_3.c +++ b/lapack-netlib/SRC/ssytri_3.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ssytri_3x.c b/lapack-netlib/SRC/ssytri_3x.c index e86c6e03e..2b1383230 100644 --- a/lapack-netlib/SRC/ssytri_3x.c +++ b/lapack-netlib/SRC/ssytri_3x.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ssytri_rook.c b/lapack-netlib/SRC/ssytri_rook.c index 80a68dc1d..8329f8201 100644 --- a/lapack-netlib/SRC/ssytri_rook.c +++ b/lapack-netlib/SRC/ssytri_rook.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ssytrs.c b/lapack-netlib/SRC/ssytrs.c index 132afb659..969c4fb25 100644 --- a/lapack-netlib/SRC/ssytrs.c +++ b/lapack-netlib/SRC/ssytrs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ssytrs2.c b/lapack-netlib/SRC/ssytrs2.c index 0ed726693..4264a34b6 100644 --- a/lapack-netlib/SRC/ssytrs2.c +++ b/lapack-netlib/SRC/ssytrs2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ssytrs_3.c b/lapack-netlib/SRC/ssytrs_3.c index a4e5b1d09..3dded3775 100644 --- a/lapack-netlib/SRC/ssytrs_3.c +++ b/lapack-netlib/SRC/ssytrs_3.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ssytrs_aa.c b/lapack-netlib/SRC/ssytrs_aa.c index 8dfac7ad5..d785a590a 100644 --- a/lapack-netlib/SRC/ssytrs_aa.c +++ b/lapack-netlib/SRC/ssytrs_aa.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ssytrs_aa_2stage.c b/lapack-netlib/SRC/ssytrs_aa_2stage.c index b9ef41170..5a91c8373 100644 --- a/lapack-netlib/SRC/ssytrs_aa_2stage.c +++ b/lapack-netlib/SRC/ssytrs_aa_2stage.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ssytrs_rook.c b/lapack-netlib/SRC/ssytrs_rook.c index bd6926b0b..86d92934a 100644 --- a/lapack-netlib/SRC/ssytrs_rook.c +++ b/lapack-netlib/SRC/ssytrs_rook.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/stbcon.c b/lapack-netlib/SRC/stbcon.c index 6edc905b1..7df7bdebd 100644 --- a/lapack-netlib/SRC/stbcon.c +++ b/lapack-netlib/SRC/stbcon.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/stbrfs.c b/lapack-netlib/SRC/stbrfs.c index bc8a71c15..cee44a080 100644 --- a/lapack-netlib/SRC/stbrfs.c +++ b/lapack-netlib/SRC/stbrfs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/stbtrs.c b/lapack-netlib/SRC/stbtrs.c index 916c59897..65f7b5436 100644 --- a/lapack-netlib/SRC/stbtrs.c +++ b/lapack-netlib/SRC/stbtrs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/stfsm.c b/lapack-netlib/SRC/stfsm.c index 850040348..8ea7ae164 100644 --- a/lapack-netlib/SRC/stfsm.c +++ b/lapack-netlib/SRC/stfsm.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/stftri.c b/lapack-netlib/SRC/stftri.c index 50e1ae6fb..a3982ba85 100644 --- a/lapack-netlib/SRC/stftri.c +++ b/lapack-netlib/SRC/stftri.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/stfttp.c b/lapack-netlib/SRC/stfttp.c index 6b875cf1a..95a60d620 100644 --- a/lapack-netlib/SRC/stfttp.c +++ b/lapack-netlib/SRC/stfttp.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/stfttr.c b/lapack-netlib/SRC/stfttr.c index d199de832..c9121227e 100644 --- a/lapack-netlib/SRC/stfttr.c +++ b/lapack-netlib/SRC/stfttr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/stgevc.c b/lapack-netlib/SRC/stgevc.c index dfdd9b068..e08f388c2 100644 --- a/lapack-netlib/SRC/stgevc.c +++ b/lapack-netlib/SRC/stgevc.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/stgex2.c b/lapack-netlib/SRC/stgex2.c index 1d07cfe58..6a5c1fd05 100644 --- a/lapack-netlib/SRC/stgex2.c +++ b/lapack-netlib/SRC/stgex2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/stgexc.c b/lapack-netlib/SRC/stgexc.c index 23016212b..9ddc9241d 100644 --- a/lapack-netlib/SRC/stgexc.c +++ b/lapack-netlib/SRC/stgexc.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/stgsen.c b/lapack-netlib/SRC/stgsen.c index f25029246..32fa37525 100644 --- a/lapack-netlib/SRC/stgsen.c +++ b/lapack-netlib/SRC/stgsen.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/stgsja.c b/lapack-netlib/SRC/stgsja.c index ab455367c..ae16d255a 100644 --- a/lapack-netlib/SRC/stgsja.c +++ b/lapack-netlib/SRC/stgsja.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/stgsna.c b/lapack-netlib/SRC/stgsna.c index 4d7c7505d..058703358 100644 --- a/lapack-netlib/SRC/stgsna.c +++ b/lapack-netlib/SRC/stgsna.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/stgsy2.c b/lapack-netlib/SRC/stgsy2.c index 92213c44b..1292d39ee 100644 --- a/lapack-netlib/SRC/stgsy2.c +++ b/lapack-netlib/SRC/stgsy2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/stgsyl.c b/lapack-netlib/SRC/stgsyl.c index ae065a349..435becb40 100644 --- a/lapack-netlib/SRC/stgsyl.c +++ b/lapack-netlib/SRC/stgsyl.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/stpcon.c b/lapack-netlib/SRC/stpcon.c index 8812ca818..84c65cd5d 100644 --- a/lapack-netlib/SRC/stpcon.c +++ b/lapack-netlib/SRC/stpcon.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/stplqt.c b/lapack-netlib/SRC/stplqt.c index a52e40535..bc45acdc2 100644 --- a/lapack-netlib/SRC/stplqt.c +++ b/lapack-netlib/SRC/stplqt.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/stplqt2.c b/lapack-netlib/SRC/stplqt2.c index 99f2cdc97..2b77f3405 100644 --- a/lapack-netlib/SRC/stplqt2.c +++ b/lapack-netlib/SRC/stplqt2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/stpmlqt.c b/lapack-netlib/SRC/stpmlqt.c index 73868f9b7..68ffa07ae 100644 --- a/lapack-netlib/SRC/stpmlqt.c +++ b/lapack-netlib/SRC/stpmlqt.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/stpmqrt.c b/lapack-netlib/SRC/stpmqrt.c index a30bfd420..6664b2b4a 100644 --- a/lapack-netlib/SRC/stpmqrt.c +++ b/lapack-netlib/SRC/stpmqrt.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/stpqrt.c b/lapack-netlib/SRC/stpqrt.c index d5b3837b2..2f8845cb9 100644 --- a/lapack-netlib/SRC/stpqrt.c +++ b/lapack-netlib/SRC/stpqrt.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/stpqrt2.c b/lapack-netlib/SRC/stpqrt2.c index df9fd59bf..5ebde0f9f 100644 --- a/lapack-netlib/SRC/stpqrt2.c +++ b/lapack-netlib/SRC/stpqrt2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/stprfb.c b/lapack-netlib/SRC/stprfb.c index 1de2583b4..edc344608 100644 --- a/lapack-netlib/SRC/stprfb.c +++ b/lapack-netlib/SRC/stprfb.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/stprfs.c b/lapack-netlib/SRC/stprfs.c index 5a978aa98..81776c7f7 100644 --- a/lapack-netlib/SRC/stprfs.c +++ b/lapack-netlib/SRC/stprfs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/stptri.c b/lapack-netlib/SRC/stptri.c index 776eecd93..afa43182e 100644 --- a/lapack-netlib/SRC/stptri.c +++ b/lapack-netlib/SRC/stptri.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/stptrs.c b/lapack-netlib/SRC/stptrs.c index 2f9514dfa..512858b98 100644 --- a/lapack-netlib/SRC/stptrs.c +++ b/lapack-netlib/SRC/stptrs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/stpttf.c b/lapack-netlib/SRC/stpttf.c index 9ea179e03..9aa76d473 100644 --- a/lapack-netlib/SRC/stpttf.c +++ b/lapack-netlib/SRC/stpttf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/stpttr.c b/lapack-netlib/SRC/stpttr.c index 2ea5beb8e..cfa8ae7b6 100644 --- a/lapack-netlib/SRC/stpttr.c +++ b/lapack-netlib/SRC/stpttr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/strcon.c b/lapack-netlib/SRC/strcon.c index a81e5bca6..db96809c4 100644 --- a/lapack-netlib/SRC/strcon.c +++ b/lapack-netlib/SRC/strcon.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/strevc.c b/lapack-netlib/SRC/strevc.c index 2dae7d8f5..d73e6d53a 100644 --- a/lapack-netlib/SRC/strevc.c +++ b/lapack-netlib/SRC/strevc.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/strevc3.c b/lapack-netlib/SRC/strevc3.c index 5c6b3770a..95879db7e 100644 --- a/lapack-netlib/SRC/strevc3.c +++ b/lapack-netlib/SRC/strevc3.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/strexc.c b/lapack-netlib/SRC/strexc.c index 978ff1969..3817b939c 100644 --- a/lapack-netlib/SRC/strexc.c +++ b/lapack-netlib/SRC/strexc.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/strrfs.c b/lapack-netlib/SRC/strrfs.c index 5a7d0dd5d..81dea7fb1 100644 --- a/lapack-netlib/SRC/strrfs.c +++ b/lapack-netlib/SRC/strrfs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/strsen.c b/lapack-netlib/SRC/strsen.c index 2becc7318..6901e9f95 100644 --- a/lapack-netlib/SRC/strsen.c +++ b/lapack-netlib/SRC/strsen.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/strsna.c b/lapack-netlib/SRC/strsna.c index a629a69c3..b05dd9a52 100644 --- a/lapack-netlib/SRC/strsna.c +++ b/lapack-netlib/SRC/strsna.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/strsyl.c b/lapack-netlib/SRC/strsyl.c index 0cc08139e..e6e9e919a 100644 --- a/lapack-netlib/SRC/strsyl.c +++ b/lapack-netlib/SRC/strsyl.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/strsyl3.c b/lapack-netlib/SRC/strsyl3.c index a2a1d0a62..85d130fac 100644 --- a/lapack-netlib/SRC/strsyl3.c +++ b/lapack-netlib/SRC/strsyl3.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -263,7 +263,7 @@ static int my_expfunc(float *x) {int e; (void)frexpf(*x,&e); return e;} /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/strti2.c b/lapack-netlib/SRC/strti2.c index 5ec1dedbf..10fc3c8c9 100644 --- a/lapack-netlib/SRC/strti2.c +++ b/lapack-netlib/SRC/strti2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/strtri.c b/lapack-netlib/SRC/strtri.c index 96d618ebe..db8f92814 100644 --- a/lapack-netlib/SRC/strtri.c +++ b/lapack-netlib/SRC/strtri.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/strtrs.c b/lapack-netlib/SRC/strtrs.c index 3f6f90aa2..5e2d36971 100644 --- a/lapack-netlib/SRC/strtrs.c +++ b/lapack-netlib/SRC/strtrs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/strttf.c b/lapack-netlib/SRC/strttf.c index 41b9c6017..1f67d05cc 100644 --- a/lapack-netlib/SRC/strttf.c +++ b/lapack-netlib/SRC/strttf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/strttp.c b/lapack-netlib/SRC/strttp.c index f90fa3dba..5bd307f28 100644 --- a/lapack-netlib/SRC/strttp.c +++ b/lapack-netlib/SRC/strttp.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/stzrzf.c b/lapack-netlib/SRC/stzrzf.c index 12f7324f7..98d9ef477 100644 --- a/lapack-netlib/SRC/stzrzf.c +++ b/lapack-netlib/SRC/stzrzf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else From 34be8fae29c285c2a2f8cc5be8457e1ad0a59baf Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Thu, 4 Apr 2024 00:10:01 +0200 Subject: [PATCH 279/311] fix typedef of logical to support INTERFACE64 --- lapack-netlib/SRC/ssb2st_kernels.c | 6 +++--- lapack-netlib/SRC/ssbev.c | 6 +++--- lapack-netlib/SRC/ssbev_2stage.c | 6 +++--- lapack-netlib/SRC/ssbevd.c | 6 +++--- lapack-netlib/SRC/ssbevd_2stage.c | 6 +++--- lapack-netlib/SRC/ssbevx.c | 6 +++--- lapack-netlib/SRC/ssbevx_2stage.c | 6 +++--- lapack-netlib/SRC/ssbgst.c | 6 +++--- lapack-netlib/SRC/ssbgv.c | 6 +++--- lapack-netlib/SRC/ssbgvd.c | 6 +++--- lapack-netlib/SRC/ssbgvx.c | 6 +++--- lapack-netlib/SRC/ssbtrd.c | 6 +++--- lapack-netlib/SRC/ssfrk.c | 6 +++--- lapack-netlib/SRC/sspcon.c | 6 +++--- lapack-netlib/SRC/sspev.c | 6 +++--- lapack-netlib/SRC/sspevd.c | 6 +++--- lapack-netlib/SRC/sspevx.c | 6 +++--- lapack-netlib/SRC/sspgst.c | 6 +++--- lapack-netlib/SRC/sspgv.c | 6 +++--- lapack-netlib/SRC/sspgvd.c | 6 +++--- lapack-netlib/SRC/sspgvx.c | 6 +++--- lapack-netlib/SRC/ssprfs.c | 6 +++--- lapack-netlib/SRC/sspsv.c | 6 +++--- lapack-netlib/SRC/sspsvx.c | 6 +++--- lapack-netlib/SRC/ssptrd.c | 6 +++--- lapack-netlib/SRC/ssptrf.c | 6 +++--- lapack-netlib/SRC/ssptri.c | 6 +++--- lapack-netlib/SRC/ssptrs.c | 6 +++--- lapack-netlib/SRC/sstebz.c | 6 +++--- lapack-netlib/SRC/sstedc.c | 6 +++--- lapack-netlib/SRC/sstegr.c | 6 +++--- lapack-netlib/SRC/sstein.c | 6 +++--- lapack-netlib/SRC/sstemr.c | 6 +++--- lapack-netlib/SRC/ssteqr.c | 6 +++--- lapack-netlib/SRC/ssterf.c | 6 +++--- lapack-netlib/SRC/sstev.c | 6 +++--- lapack-netlib/SRC/sstevd.c | 6 +++--- lapack-netlib/SRC/sstevr.c | 6 +++--- lapack-netlib/SRC/sstevx.c | 6 +++--- lapack-netlib/SRC/ssycon.c | 6 +++--- lapack-netlib/SRC/ssycon_3.c | 6 +++--- lapack-netlib/SRC/ssycon_rook.c | 6 +++--- lapack-netlib/SRC/ssyconv.c | 6 +++--- lapack-netlib/SRC/ssyconvf.c | 6 +++--- lapack-netlib/SRC/ssyconvf_rook.c | 6 +++--- lapack-netlib/SRC/ssyequb.c | 6 +++--- lapack-netlib/SRC/ssyev.c | 6 +++--- lapack-netlib/SRC/ssyev_2stage.c | 6 +++--- lapack-netlib/SRC/ssyevd.c | 6 +++--- lapack-netlib/SRC/ssyevd_2stage.c | 6 +++--- lapack-netlib/SRC/ssyevr.c | 6 +++--- lapack-netlib/SRC/ssyevr_2stage.c | 6 +++--- lapack-netlib/SRC/ssyevx.c | 6 +++--- lapack-netlib/SRC/ssyevx_2stage.c | 6 +++--- lapack-netlib/SRC/ssygs2.c | 6 +++--- lapack-netlib/SRC/ssygst.c | 6 +++--- lapack-netlib/SRC/ssygv.c | 6 +++--- lapack-netlib/SRC/ssygv_2stage.c | 6 +++--- lapack-netlib/SRC/ssygvd.c | 6 +++--- lapack-netlib/SRC/ssygvx.c | 6 +++--- lapack-netlib/SRC/ssyrfs.c | 6 +++--- lapack-netlib/SRC/ssyrfsx.c | 6 +++--- lapack-netlib/SRC/ssysv.c | 6 +++--- lapack-netlib/SRC/ssysv_aa.c | 6 +++--- lapack-netlib/SRC/ssysv_aa_2stage.c | 6 +++--- lapack-netlib/SRC/ssysv_rk.c | 6 +++--- lapack-netlib/SRC/ssysv_rook.c | 6 +++--- 67 files changed, 201 insertions(+), 201 deletions(-) diff --git a/lapack-netlib/SRC/ssb2st_kernels.c b/lapack-netlib/SRC/ssb2st_kernels.c index b043b3cf6..46d19d32a 100644 --- a/lapack-netlib/SRC/ssb2st_kernels.c +++ b/lapack-netlib/SRC/ssb2st_kernels.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ssbev.c b/lapack-netlib/SRC/ssbev.c index f5f9dda6b..5e05403a7 100644 --- a/lapack-netlib/SRC/ssbev.c +++ b/lapack-netlib/SRC/ssbev.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ssbev_2stage.c b/lapack-netlib/SRC/ssbev_2stage.c index 4d9f67a77..5b4f9158f 100644 --- a/lapack-netlib/SRC/ssbev_2stage.c +++ b/lapack-netlib/SRC/ssbev_2stage.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ssbevd.c b/lapack-netlib/SRC/ssbevd.c index 7f4bff87b..c137445a6 100644 --- a/lapack-netlib/SRC/ssbevd.c +++ b/lapack-netlib/SRC/ssbevd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ssbevd_2stage.c b/lapack-netlib/SRC/ssbevd_2stage.c index af09f95d2..21d9beb09 100644 --- a/lapack-netlib/SRC/ssbevd_2stage.c +++ b/lapack-netlib/SRC/ssbevd_2stage.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ssbevx.c b/lapack-netlib/SRC/ssbevx.c index d16816e56..36627d84f 100644 --- a/lapack-netlib/SRC/ssbevx.c +++ b/lapack-netlib/SRC/ssbevx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ssbevx_2stage.c b/lapack-netlib/SRC/ssbevx_2stage.c index e93f63650..2e3a49682 100644 --- a/lapack-netlib/SRC/ssbevx_2stage.c +++ b/lapack-netlib/SRC/ssbevx_2stage.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ssbgst.c b/lapack-netlib/SRC/ssbgst.c index c1dea63db..698eb2757 100644 --- a/lapack-netlib/SRC/ssbgst.c +++ b/lapack-netlib/SRC/ssbgst.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ssbgv.c b/lapack-netlib/SRC/ssbgv.c index d8d3b2b35..a10fad4a3 100644 --- a/lapack-netlib/SRC/ssbgv.c +++ b/lapack-netlib/SRC/ssbgv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ssbgvd.c b/lapack-netlib/SRC/ssbgvd.c index cd73f479b..7c5d294f9 100644 --- a/lapack-netlib/SRC/ssbgvd.c +++ b/lapack-netlib/SRC/ssbgvd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ssbgvx.c b/lapack-netlib/SRC/ssbgvx.c index b30fe2b82..33670ae7f 100644 --- a/lapack-netlib/SRC/ssbgvx.c +++ b/lapack-netlib/SRC/ssbgvx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ssbtrd.c b/lapack-netlib/SRC/ssbtrd.c index 2664bf8b8..edbe1423e 100644 --- a/lapack-netlib/SRC/ssbtrd.c +++ b/lapack-netlib/SRC/ssbtrd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ssfrk.c b/lapack-netlib/SRC/ssfrk.c index 21b52b0bb..3a4f19a1b 100644 --- a/lapack-netlib/SRC/ssfrk.c +++ b/lapack-netlib/SRC/ssfrk.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sspcon.c b/lapack-netlib/SRC/sspcon.c index bac0aea5f..c7cd43cae 100644 --- a/lapack-netlib/SRC/sspcon.c +++ b/lapack-netlib/SRC/sspcon.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sspev.c b/lapack-netlib/SRC/sspev.c index 12d8f9842..eee8cc864 100644 --- a/lapack-netlib/SRC/sspev.c +++ b/lapack-netlib/SRC/sspev.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sspevd.c b/lapack-netlib/SRC/sspevd.c index 6bf7d19a8..9176babdb 100644 --- a/lapack-netlib/SRC/sspevd.c +++ b/lapack-netlib/SRC/sspevd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sspevx.c b/lapack-netlib/SRC/sspevx.c index 67ece8dfa..299dafb49 100644 --- a/lapack-netlib/SRC/sspevx.c +++ b/lapack-netlib/SRC/sspevx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sspgst.c b/lapack-netlib/SRC/sspgst.c index 07b9eb822..61f1c896f 100644 --- a/lapack-netlib/SRC/sspgst.c +++ b/lapack-netlib/SRC/sspgst.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sspgv.c b/lapack-netlib/SRC/sspgv.c index 5e9baa716..4f81deb52 100644 --- a/lapack-netlib/SRC/sspgv.c +++ b/lapack-netlib/SRC/sspgv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sspgvd.c b/lapack-netlib/SRC/sspgvd.c index f63aaaf18..939e17f01 100644 --- a/lapack-netlib/SRC/sspgvd.c +++ b/lapack-netlib/SRC/sspgvd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sspgvx.c b/lapack-netlib/SRC/sspgvx.c index 93913d3c7..eee640dab 100644 --- a/lapack-netlib/SRC/sspgvx.c +++ b/lapack-netlib/SRC/sspgvx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ssprfs.c b/lapack-netlib/SRC/ssprfs.c index e2f5ee628..f5027fe36 100644 --- a/lapack-netlib/SRC/ssprfs.c +++ b/lapack-netlib/SRC/ssprfs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sspsv.c b/lapack-netlib/SRC/sspsv.c index 885c89c30..97d5805bb 100644 --- a/lapack-netlib/SRC/sspsv.c +++ b/lapack-netlib/SRC/sspsv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sspsvx.c b/lapack-netlib/SRC/sspsvx.c index 52e97e751..c63566df2 100644 --- a/lapack-netlib/SRC/sspsvx.c +++ b/lapack-netlib/SRC/sspsvx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ssptrd.c b/lapack-netlib/SRC/ssptrd.c index df599e782..d26d8a470 100644 --- a/lapack-netlib/SRC/ssptrd.c +++ b/lapack-netlib/SRC/ssptrd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ssptrf.c b/lapack-netlib/SRC/ssptrf.c index 89d5414d9..6c326bf5a 100644 --- a/lapack-netlib/SRC/ssptrf.c +++ b/lapack-netlib/SRC/ssptrf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ssptri.c b/lapack-netlib/SRC/ssptri.c index ee09a21a4..56d4d156c 100644 --- a/lapack-netlib/SRC/ssptri.c +++ b/lapack-netlib/SRC/ssptri.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ssptrs.c b/lapack-netlib/SRC/ssptrs.c index f6f2cb403..ccc88ddde 100644 --- a/lapack-netlib/SRC/ssptrs.c +++ b/lapack-netlib/SRC/ssptrs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sstebz.c b/lapack-netlib/SRC/sstebz.c index ebe4d0c96..b8aa18dc4 100644 --- a/lapack-netlib/SRC/sstebz.c +++ b/lapack-netlib/SRC/sstebz.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sstedc.c b/lapack-netlib/SRC/sstedc.c index 10ea1249f..91c53ca98 100644 --- a/lapack-netlib/SRC/sstedc.c +++ b/lapack-netlib/SRC/sstedc.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sstegr.c b/lapack-netlib/SRC/sstegr.c index 3971609e4..23b3bcd74 100644 --- a/lapack-netlib/SRC/sstegr.c +++ b/lapack-netlib/SRC/sstegr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sstein.c b/lapack-netlib/SRC/sstein.c index 42c85fa5b..b1c4e63ca 100644 --- a/lapack-netlib/SRC/sstein.c +++ b/lapack-netlib/SRC/sstein.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sstemr.c b/lapack-netlib/SRC/sstemr.c index f008b7045..77713391f 100644 --- a/lapack-netlib/SRC/sstemr.c +++ b/lapack-netlib/SRC/sstemr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ssteqr.c b/lapack-netlib/SRC/ssteqr.c index 8a43b9425..2e0c0f7b8 100644 --- a/lapack-netlib/SRC/ssteqr.c +++ b/lapack-netlib/SRC/ssteqr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ssterf.c b/lapack-netlib/SRC/ssterf.c index 3e815cfc9..fd970ef27 100644 --- a/lapack-netlib/SRC/ssterf.c +++ b/lapack-netlib/SRC/ssterf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sstev.c b/lapack-netlib/SRC/sstev.c index fc6a68148..098485b81 100644 --- a/lapack-netlib/SRC/sstev.c +++ b/lapack-netlib/SRC/sstev.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sstevd.c b/lapack-netlib/SRC/sstevd.c index dfb1f5d74..3fe2bcb67 100644 --- a/lapack-netlib/SRC/sstevd.c +++ b/lapack-netlib/SRC/sstevd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sstevr.c b/lapack-netlib/SRC/sstevr.c index 13bcca0e2..c65d465dd 100644 --- a/lapack-netlib/SRC/sstevr.c +++ b/lapack-netlib/SRC/sstevr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sstevx.c b/lapack-netlib/SRC/sstevx.c index d6ce747d6..5be719cee 100644 --- a/lapack-netlib/SRC/sstevx.c +++ b/lapack-netlib/SRC/sstevx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ssycon.c b/lapack-netlib/SRC/ssycon.c index 794ba94b3..6a54be666 100644 --- a/lapack-netlib/SRC/ssycon.c +++ b/lapack-netlib/SRC/ssycon.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ssycon_3.c b/lapack-netlib/SRC/ssycon_3.c index 0352febd0..f21ba7a4f 100644 --- a/lapack-netlib/SRC/ssycon_3.c +++ b/lapack-netlib/SRC/ssycon_3.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ssycon_rook.c b/lapack-netlib/SRC/ssycon_rook.c index d6bde6e4f..85371f3eb 100644 --- a/lapack-netlib/SRC/ssycon_rook.c +++ b/lapack-netlib/SRC/ssycon_rook.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ssyconv.c b/lapack-netlib/SRC/ssyconv.c index a69acae8e..fec9f484d 100644 --- a/lapack-netlib/SRC/ssyconv.c +++ b/lapack-netlib/SRC/ssyconv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ssyconvf.c b/lapack-netlib/SRC/ssyconvf.c index d6a8a5250..4dfddb666 100644 --- a/lapack-netlib/SRC/ssyconvf.c +++ b/lapack-netlib/SRC/ssyconvf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ssyconvf_rook.c b/lapack-netlib/SRC/ssyconvf_rook.c index 4c2475fc2..5a2c5fb36 100644 --- a/lapack-netlib/SRC/ssyconvf_rook.c +++ b/lapack-netlib/SRC/ssyconvf_rook.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ssyequb.c b/lapack-netlib/SRC/ssyequb.c index 5e4a09c73..a037792c5 100644 --- a/lapack-netlib/SRC/ssyequb.c +++ b/lapack-netlib/SRC/ssyequb.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ssyev.c b/lapack-netlib/SRC/ssyev.c index e861c0bc3..6c4cc06aa 100644 --- a/lapack-netlib/SRC/ssyev.c +++ b/lapack-netlib/SRC/ssyev.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ssyev_2stage.c b/lapack-netlib/SRC/ssyev_2stage.c index dea80d02e..4c1a3c512 100644 --- a/lapack-netlib/SRC/ssyev_2stage.c +++ b/lapack-netlib/SRC/ssyev_2stage.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ssyevd.c b/lapack-netlib/SRC/ssyevd.c index 86f3494dc..45d53c63f 100644 --- a/lapack-netlib/SRC/ssyevd.c +++ b/lapack-netlib/SRC/ssyevd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ssyevd_2stage.c b/lapack-netlib/SRC/ssyevd_2stage.c index 19d366874..186cdbbe6 100644 --- a/lapack-netlib/SRC/ssyevd_2stage.c +++ b/lapack-netlib/SRC/ssyevd_2stage.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ssyevr.c b/lapack-netlib/SRC/ssyevr.c index 287656d0d..327e298e3 100644 --- a/lapack-netlib/SRC/ssyevr.c +++ b/lapack-netlib/SRC/ssyevr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ssyevr_2stage.c b/lapack-netlib/SRC/ssyevr_2stage.c index e61324786..35b592d61 100644 --- a/lapack-netlib/SRC/ssyevr_2stage.c +++ b/lapack-netlib/SRC/ssyevr_2stage.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ssyevx.c b/lapack-netlib/SRC/ssyevx.c index 50fc2cac6..c58e8a041 100644 --- a/lapack-netlib/SRC/ssyevx.c +++ b/lapack-netlib/SRC/ssyevx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ssyevx_2stage.c b/lapack-netlib/SRC/ssyevx_2stage.c index 81c4ab8dd..48297e39f 100644 --- a/lapack-netlib/SRC/ssyevx_2stage.c +++ b/lapack-netlib/SRC/ssyevx_2stage.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ssygs2.c b/lapack-netlib/SRC/ssygs2.c index dca132458..4566a7a95 100644 --- a/lapack-netlib/SRC/ssygs2.c +++ b/lapack-netlib/SRC/ssygs2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ssygst.c b/lapack-netlib/SRC/ssygst.c index 87d340a89..222529328 100644 --- a/lapack-netlib/SRC/ssygst.c +++ b/lapack-netlib/SRC/ssygst.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ssygv.c b/lapack-netlib/SRC/ssygv.c index 692de8d9c..f18c88816 100644 --- a/lapack-netlib/SRC/ssygv.c +++ b/lapack-netlib/SRC/ssygv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ssygv_2stage.c b/lapack-netlib/SRC/ssygv_2stage.c index 4ddd71200..faa17f213 100644 --- a/lapack-netlib/SRC/ssygv_2stage.c +++ b/lapack-netlib/SRC/ssygv_2stage.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ssygvd.c b/lapack-netlib/SRC/ssygvd.c index d8bbd48e7..dfdeb1ea1 100644 --- a/lapack-netlib/SRC/ssygvd.c +++ b/lapack-netlib/SRC/ssygvd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ssygvx.c b/lapack-netlib/SRC/ssygvx.c index f6b45d4bd..5eb043247 100644 --- a/lapack-netlib/SRC/ssygvx.c +++ b/lapack-netlib/SRC/ssygvx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ssyrfs.c b/lapack-netlib/SRC/ssyrfs.c index cf48a77be..c832212ba 100644 --- a/lapack-netlib/SRC/ssyrfs.c +++ b/lapack-netlib/SRC/ssyrfs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ssyrfsx.c b/lapack-netlib/SRC/ssyrfsx.c index e9caf6b9e..b82151cca 100644 --- a/lapack-netlib/SRC/ssyrfsx.c +++ b/lapack-netlib/SRC/ssyrfsx.c @@ -54,8 +54,8 @@ static inline _Complex float * _pCf(complex *z) {return (_Complex float*)z;} static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double*)z;} #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -257,7 +257,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ssysv.c b/lapack-netlib/SRC/ssysv.c index 92d234f51..01e2e6652 100644 --- a/lapack-netlib/SRC/ssysv.c +++ b/lapack-netlib/SRC/ssysv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ssysv_aa.c b/lapack-netlib/SRC/ssysv_aa.c index c0303e3f4..6b5c35cb6 100644 --- a/lapack-netlib/SRC/ssysv_aa.c +++ b/lapack-netlib/SRC/ssysv_aa.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ssysv_aa_2stage.c b/lapack-netlib/SRC/ssysv_aa_2stage.c index dbd8402c6..70dd9e9f9 100644 --- a/lapack-netlib/SRC/ssysv_aa_2stage.c +++ b/lapack-netlib/SRC/ssysv_aa_2stage.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ssysv_rk.c b/lapack-netlib/SRC/ssysv_rk.c index ca9922901..36ccfb27e 100644 --- a/lapack-netlib/SRC/ssysv_rk.c +++ b/lapack-netlib/SRC/ssysv_rk.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ssysv_rook.c b/lapack-netlib/SRC/ssysv_rook.c index a76639605..e2cdb238d 100644 --- a/lapack-netlib/SRC/ssysv_rook.c +++ b/lapack-netlib/SRC/ssysv_rook.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else From f7dd80ba73956731c4434148c63fda3f16cc7998 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Thu, 4 Apr 2024 00:14:57 +0200 Subject: [PATCH 280/311] fix typedef of logical to support INTERFACE64 --- lapack-netlib/SRC/sopgtr.c | 6 +++--- lapack-netlib/SRC/sopmtr.c | 6 +++--- lapack-netlib/SRC/sorbdb.c | 6 +++--- lapack-netlib/SRC/sorbdb1.c | 6 +++--- lapack-netlib/SRC/sorbdb2.c | 6 +++--- lapack-netlib/SRC/sorbdb3.c | 6 +++--- lapack-netlib/SRC/sorbdb4.c | 6 +++--- lapack-netlib/SRC/sorbdb5.c | 6 +++--- lapack-netlib/SRC/sorbdb6.c | 6 +++--- lapack-netlib/SRC/sorcsd.c | 6 +++--- lapack-netlib/SRC/sorcsd2by1.c | 6 +++--- lapack-netlib/SRC/sorg2l.c | 6 +++--- lapack-netlib/SRC/sorg2r.c | 6 +++--- lapack-netlib/SRC/sorgbr.c | 6 +++--- lapack-netlib/SRC/sorghr.c | 6 +++--- lapack-netlib/SRC/sorgl2.c | 6 +++--- lapack-netlib/SRC/sorglq.c | 6 +++--- lapack-netlib/SRC/sorgql.c | 6 +++--- lapack-netlib/SRC/sorgqr.c | 6 +++--- lapack-netlib/SRC/sorgr2.c | 6 +++--- lapack-netlib/SRC/sorgrq.c | 6 +++--- lapack-netlib/SRC/sorgtr.c | 6 +++--- lapack-netlib/SRC/sorgtsqr.c | 6 +++--- lapack-netlib/SRC/sorgtsqr_row.c | 6 +++--- lapack-netlib/SRC/sorhr_col.c | 6 +++--- lapack-netlib/SRC/sorm22.c | 6 +++--- lapack-netlib/SRC/sorm2l.c | 6 +++--- lapack-netlib/SRC/sorm2r.c | 6 +++--- lapack-netlib/SRC/sormbr.c | 6 +++--- lapack-netlib/SRC/sormhr.c | 6 +++--- lapack-netlib/SRC/sorml2.c | 6 +++--- lapack-netlib/SRC/sormlq.c | 6 +++--- lapack-netlib/SRC/sormql.c | 6 +++--- lapack-netlib/SRC/sormqr.c | 6 +++--- lapack-netlib/SRC/sormr2.c | 6 +++--- lapack-netlib/SRC/sormr3.c | 6 +++--- lapack-netlib/SRC/sormrq.c | 6 +++--- lapack-netlib/SRC/sormrz.c | 6 +++--- lapack-netlib/SRC/sormtr.c | 6 +++--- lapack-netlib/SRC/spbcon.c | 6 +++--- lapack-netlib/SRC/spbequ.c | 6 +++--- lapack-netlib/SRC/spbrfs.c | 6 +++--- lapack-netlib/SRC/spbstf.c | 6 +++--- lapack-netlib/SRC/spbsv.c | 6 +++--- lapack-netlib/SRC/spbsvx.c | 6 +++--- lapack-netlib/SRC/spbtf2.c | 6 +++--- lapack-netlib/SRC/spbtrf.c | 6 +++--- lapack-netlib/SRC/spbtrs.c | 6 +++--- lapack-netlib/SRC/spftrf.c | 6 +++--- lapack-netlib/SRC/spftri.c | 6 +++--- lapack-netlib/SRC/spftrs.c | 6 +++--- lapack-netlib/SRC/spocon.c | 6 +++--- lapack-netlib/SRC/spoequ.c | 6 +++--- lapack-netlib/SRC/spoequb.c | 6 +++--- lapack-netlib/SRC/sporfs.c | 6 +++--- lapack-netlib/SRC/sporfsx.c | 6 +++--- lapack-netlib/SRC/sposv.c | 6 +++--- lapack-netlib/SRC/sposvx.c | 6 +++--- lapack-netlib/SRC/sposvxx.c | 6 +++--- lapack-netlib/SRC/spotf2.c | 6 +++--- lapack-netlib/SRC/spotrf.c | 6 +++--- lapack-netlib/SRC/spotri.c | 6 +++--- lapack-netlib/SRC/spotrs.c | 6 +++--- lapack-netlib/SRC/sppcon.c | 6 +++--- lapack-netlib/SRC/sppequ.c | 6 +++--- lapack-netlib/SRC/spprfs.c | 6 +++--- lapack-netlib/SRC/sppsv.c | 6 +++--- lapack-netlib/SRC/sppsvx.c | 6 +++--- lapack-netlib/SRC/spptrf.c | 6 +++--- lapack-netlib/SRC/spptri.c | 6 +++--- lapack-netlib/SRC/spptrs.c | 6 +++--- lapack-netlib/SRC/spstf2.c | 6 +++--- lapack-netlib/SRC/spstrf.c | 6 +++--- lapack-netlib/SRC/sptcon.c | 6 +++--- lapack-netlib/SRC/spteqr.c | 6 +++--- lapack-netlib/SRC/sptrfs.c | 6 +++--- lapack-netlib/SRC/sptsv.c | 6 +++--- lapack-netlib/SRC/sptsvx.c | 6 +++--- lapack-netlib/SRC/spttrf.c | 6 +++--- lapack-netlib/SRC/spttrs.c | 6 +++--- lapack-netlib/SRC/sptts2.c | 6 +++--- lapack-netlib/SRC/srscl.c | 6 +++--- 82 files changed, 246 insertions(+), 246 deletions(-) diff --git a/lapack-netlib/SRC/sopgtr.c b/lapack-netlib/SRC/sopgtr.c index a9f7625d4..dabdfd509 100644 --- a/lapack-netlib/SRC/sopgtr.c +++ b/lapack-netlib/SRC/sopgtr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sopmtr.c b/lapack-netlib/SRC/sopmtr.c index 5ab428a2e..c337f3e97 100644 --- a/lapack-netlib/SRC/sopmtr.c +++ b/lapack-netlib/SRC/sopmtr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sorbdb.c b/lapack-netlib/SRC/sorbdb.c index deba21c6c..90859fc4f 100644 --- a/lapack-netlib/SRC/sorbdb.c +++ b/lapack-netlib/SRC/sorbdb.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sorbdb1.c b/lapack-netlib/SRC/sorbdb1.c index 170f60bf6..140e7d51c 100644 --- a/lapack-netlib/SRC/sorbdb1.c +++ b/lapack-netlib/SRC/sorbdb1.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sorbdb2.c b/lapack-netlib/SRC/sorbdb2.c index 24095a68a..345af02cb 100644 --- a/lapack-netlib/SRC/sorbdb2.c +++ b/lapack-netlib/SRC/sorbdb2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sorbdb3.c b/lapack-netlib/SRC/sorbdb3.c index 0ac80f40e..3c6ec4cb4 100644 --- a/lapack-netlib/SRC/sorbdb3.c +++ b/lapack-netlib/SRC/sorbdb3.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sorbdb4.c b/lapack-netlib/SRC/sorbdb4.c index 02328c253..70d443f8d 100644 --- a/lapack-netlib/SRC/sorbdb4.c +++ b/lapack-netlib/SRC/sorbdb4.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sorbdb5.c b/lapack-netlib/SRC/sorbdb5.c index 26cfc7591..8c4cb5125 100644 --- a/lapack-netlib/SRC/sorbdb5.c +++ b/lapack-netlib/SRC/sorbdb5.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sorbdb6.c b/lapack-netlib/SRC/sorbdb6.c index 2f61c3834..61a3cf6e0 100644 --- a/lapack-netlib/SRC/sorbdb6.c +++ b/lapack-netlib/SRC/sorbdb6.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sorcsd.c b/lapack-netlib/SRC/sorcsd.c index 108173ba2..cadad46d8 100644 --- a/lapack-netlib/SRC/sorcsd.c +++ b/lapack-netlib/SRC/sorcsd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sorcsd2by1.c b/lapack-netlib/SRC/sorcsd2by1.c index 7dfb5db12..afce2da4e 100644 --- a/lapack-netlib/SRC/sorcsd2by1.c +++ b/lapack-netlib/SRC/sorcsd2by1.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sorg2l.c b/lapack-netlib/SRC/sorg2l.c index f5816ef82..a23c4c43b 100644 --- a/lapack-netlib/SRC/sorg2l.c +++ b/lapack-netlib/SRC/sorg2l.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sorg2r.c b/lapack-netlib/SRC/sorg2r.c index 425657cc1..c5110bf43 100644 --- a/lapack-netlib/SRC/sorg2r.c +++ b/lapack-netlib/SRC/sorg2r.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sorgbr.c b/lapack-netlib/SRC/sorgbr.c index 59f5b289f..5af6c2683 100644 --- a/lapack-netlib/SRC/sorgbr.c +++ b/lapack-netlib/SRC/sorgbr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sorghr.c b/lapack-netlib/SRC/sorghr.c index ea21f32a2..95bf997d2 100644 --- a/lapack-netlib/SRC/sorghr.c +++ b/lapack-netlib/SRC/sorghr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sorgl2.c b/lapack-netlib/SRC/sorgl2.c index 1fb907dfc..665b6e4de 100644 --- a/lapack-netlib/SRC/sorgl2.c +++ b/lapack-netlib/SRC/sorgl2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sorglq.c b/lapack-netlib/SRC/sorglq.c index ff865dcfa..402db1604 100644 --- a/lapack-netlib/SRC/sorglq.c +++ b/lapack-netlib/SRC/sorglq.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sorgql.c b/lapack-netlib/SRC/sorgql.c index 81ee726b1..272be7225 100644 --- a/lapack-netlib/SRC/sorgql.c +++ b/lapack-netlib/SRC/sorgql.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sorgqr.c b/lapack-netlib/SRC/sorgqr.c index 208038f53..6335ffdbb 100644 --- a/lapack-netlib/SRC/sorgqr.c +++ b/lapack-netlib/SRC/sorgqr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sorgr2.c b/lapack-netlib/SRC/sorgr2.c index 04b830eac..c6a568e4f 100644 --- a/lapack-netlib/SRC/sorgr2.c +++ b/lapack-netlib/SRC/sorgr2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sorgrq.c b/lapack-netlib/SRC/sorgrq.c index b32dd4606..2630b2505 100644 --- a/lapack-netlib/SRC/sorgrq.c +++ b/lapack-netlib/SRC/sorgrq.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sorgtr.c b/lapack-netlib/SRC/sorgtr.c index 1cc106671..2f643ae65 100644 --- a/lapack-netlib/SRC/sorgtr.c +++ b/lapack-netlib/SRC/sorgtr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sorgtsqr.c b/lapack-netlib/SRC/sorgtsqr.c index a9f8a30d6..a177496eb 100644 --- a/lapack-netlib/SRC/sorgtsqr.c +++ b/lapack-netlib/SRC/sorgtsqr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sorgtsqr_row.c b/lapack-netlib/SRC/sorgtsqr_row.c index cd966e9e5..6ac534cc9 100644 --- a/lapack-netlib/SRC/sorgtsqr_row.c +++ b/lapack-netlib/SRC/sorgtsqr_row.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sorhr_col.c b/lapack-netlib/SRC/sorhr_col.c index d2110548e..b106699c3 100644 --- a/lapack-netlib/SRC/sorhr_col.c +++ b/lapack-netlib/SRC/sorhr_col.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sorm22.c b/lapack-netlib/SRC/sorm22.c index 5f1d05cda..e137f5615 100644 --- a/lapack-netlib/SRC/sorm22.c +++ b/lapack-netlib/SRC/sorm22.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sorm2l.c b/lapack-netlib/SRC/sorm2l.c index 97b682708..46708bcbe 100644 --- a/lapack-netlib/SRC/sorm2l.c +++ b/lapack-netlib/SRC/sorm2l.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sorm2r.c b/lapack-netlib/SRC/sorm2r.c index 4d8e075bf..1db5fc5f5 100644 --- a/lapack-netlib/SRC/sorm2r.c +++ b/lapack-netlib/SRC/sorm2r.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sormbr.c b/lapack-netlib/SRC/sormbr.c index 701bf10d7..5a866d8c7 100644 --- a/lapack-netlib/SRC/sormbr.c +++ b/lapack-netlib/SRC/sormbr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sormhr.c b/lapack-netlib/SRC/sormhr.c index c9eb97444..70d834855 100644 --- a/lapack-netlib/SRC/sormhr.c +++ b/lapack-netlib/SRC/sormhr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sorml2.c b/lapack-netlib/SRC/sorml2.c index 122fe4ed6..888f1ad69 100644 --- a/lapack-netlib/SRC/sorml2.c +++ b/lapack-netlib/SRC/sorml2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sormlq.c b/lapack-netlib/SRC/sormlq.c index 5b37bed56..4c7627f55 100644 --- a/lapack-netlib/SRC/sormlq.c +++ b/lapack-netlib/SRC/sormlq.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sormql.c b/lapack-netlib/SRC/sormql.c index e729d49cd..8b8323f6d 100644 --- a/lapack-netlib/SRC/sormql.c +++ b/lapack-netlib/SRC/sormql.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sormqr.c b/lapack-netlib/SRC/sormqr.c index b621e1c7a..8f791f560 100644 --- a/lapack-netlib/SRC/sormqr.c +++ b/lapack-netlib/SRC/sormqr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sormr2.c b/lapack-netlib/SRC/sormr2.c index 2b6d81978..1e807f7bf 100644 --- a/lapack-netlib/SRC/sormr2.c +++ b/lapack-netlib/SRC/sormr2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sormr3.c b/lapack-netlib/SRC/sormr3.c index 8c806a145..1dc18beeb 100644 --- a/lapack-netlib/SRC/sormr3.c +++ b/lapack-netlib/SRC/sormr3.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sormrq.c b/lapack-netlib/SRC/sormrq.c index a516c57ea..f945722c8 100644 --- a/lapack-netlib/SRC/sormrq.c +++ b/lapack-netlib/SRC/sormrq.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sormrz.c b/lapack-netlib/SRC/sormrz.c index e5614ac38..98ce7e150 100644 --- a/lapack-netlib/SRC/sormrz.c +++ b/lapack-netlib/SRC/sormrz.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sormtr.c b/lapack-netlib/SRC/sormtr.c index d1a19ffa2..e094aceb6 100644 --- a/lapack-netlib/SRC/sormtr.c +++ b/lapack-netlib/SRC/sormtr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/spbcon.c b/lapack-netlib/SRC/spbcon.c index 3725448a3..ae0ab6393 100644 --- a/lapack-netlib/SRC/spbcon.c +++ b/lapack-netlib/SRC/spbcon.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/spbequ.c b/lapack-netlib/SRC/spbequ.c index 80458825e..166190c67 100644 --- a/lapack-netlib/SRC/spbequ.c +++ b/lapack-netlib/SRC/spbequ.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/spbrfs.c b/lapack-netlib/SRC/spbrfs.c index fce4df080..2d5b3bd5c 100644 --- a/lapack-netlib/SRC/spbrfs.c +++ b/lapack-netlib/SRC/spbrfs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/spbstf.c b/lapack-netlib/SRC/spbstf.c index f4636978b..5b598a46f 100644 --- a/lapack-netlib/SRC/spbstf.c +++ b/lapack-netlib/SRC/spbstf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/spbsv.c b/lapack-netlib/SRC/spbsv.c index 1d76f9fe0..42f29be04 100644 --- a/lapack-netlib/SRC/spbsv.c +++ b/lapack-netlib/SRC/spbsv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/spbsvx.c b/lapack-netlib/SRC/spbsvx.c index 1574cd6ba..999ac6427 100644 --- a/lapack-netlib/SRC/spbsvx.c +++ b/lapack-netlib/SRC/spbsvx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/spbtf2.c b/lapack-netlib/SRC/spbtf2.c index 011fd91d0..056db248e 100644 --- a/lapack-netlib/SRC/spbtf2.c +++ b/lapack-netlib/SRC/spbtf2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/spbtrf.c b/lapack-netlib/SRC/spbtrf.c index cd4b61522..57cbc54fb 100644 --- a/lapack-netlib/SRC/spbtrf.c +++ b/lapack-netlib/SRC/spbtrf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/spbtrs.c b/lapack-netlib/SRC/spbtrs.c index 1dda79314..9b1f869d8 100644 --- a/lapack-netlib/SRC/spbtrs.c +++ b/lapack-netlib/SRC/spbtrs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/spftrf.c b/lapack-netlib/SRC/spftrf.c index 464d48083..a84f13cd6 100644 --- a/lapack-netlib/SRC/spftrf.c +++ b/lapack-netlib/SRC/spftrf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/spftri.c b/lapack-netlib/SRC/spftri.c index 44a295333..7da45ea7b 100644 --- a/lapack-netlib/SRC/spftri.c +++ b/lapack-netlib/SRC/spftri.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/spftrs.c b/lapack-netlib/SRC/spftrs.c index b7cbf6c32..b73e2730b 100644 --- a/lapack-netlib/SRC/spftrs.c +++ b/lapack-netlib/SRC/spftrs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/spocon.c b/lapack-netlib/SRC/spocon.c index 4f4fc12cd..c871d1af7 100644 --- a/lapack-netlib/SRC/spocon.c +++ b/lapack-netlib/SRC/spocon.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/spoequ.c b/lapack-netlib/SRC/spoequ.c index bb80ce848..6252812a2 100644 --- a/lapack-netlib/SRC/spoequ.c +++ b/lapack-netlib/SRC/spoequ.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/spoequb.c b/lapack-netlib/SRC/spoequb.c index 3e616fa4a..e45acea35 100644 --- a/lapack-netlib/SRC/spoequb.c +++ b/lapack-netlib/SRC/spoequb.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sporfs.c b/lapack-netlib/SRC/sporfs.c index 671976291..2da5ad4bc 100644 --- a/lapack-netlib/SRC/sporfs.c +++ b/lapack-netlib/SRC/sporfs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sporfsx.c b/lapack-netlib/SRC/sporfsx.c index adc3a90c5..df395551b 100644 --- a/lapack-netlib/SRC/sporfsx.c +++ b/lapack-netlib/SRC/sporfsx.c @@ -54,8 +54,8 @@ static inline _Complex float * _pCf(complex *z) {return (_Complex float*)z;} static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double*)z;} #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -257,7 +257,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sposv.c b/lapack-netlib/SRC/sposv.c index 5feebe736..8c936fe77 100644 --- a/lapack-netlib/SRC/sposv.c +++ b/lapack-netlib/SRC/sposv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sposvx.c b/lapack-netlib/SRC/sposvx.c index 5e845528b..5019d5451 100644 --- a/lapack-netlib/SRC/sposvx.c +++ b/lapack-netlib/SRC/sposvx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sposvxx.c b/lapack-netlib/SRC/sposvxx.c index cea6dd307..141cf19fe 100644 --- a/lapack-netlib/SRC/sposvxx.c +++ b/lapack-netlib/SRC/sposvxx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/spotf2.c b/lapack-netlib/SRC/spotf2.c index f0f1f12f9..6ee4d80d5 100644 --- a/lapack-netlib/SRC/spotf2.c +++ b/lapack-netlib/SRC/spotf2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/spotrf.c b/lapack-netlib/SRC/spotrf.c index 3b4933918..581a7cb7b 100644 --- a/lapack-netlib/SRC/spotrf.c +++ b/lapack-netlib/SRC/spotrf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/spotri.c b/lapack-netlib/SRC/spotri.c index d32d013d3..d0cc67a25 100644 --- a/lapack-netlib/SRC/spotri.c +++ b/lapack-netlib/SRC/spotri.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/spotrs.c b/lapack-netlib/SRC/spotrs.c index 796eab211..a7a6a87ac 100644 --- a/lapack-netlib/SRC/spotrs.c +++ b/lapack-netlib/SRC/spotrs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sppcon.c b/lapack-netlib/SRC/sppcon.c index 07bd6a83d..848ae315f 100644 --- a/lapack-netlib/SRC/sppcon.c +++ b/lapack-netlib/SRC/sppcon.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sppequ.c b/lapack-netlib/SRC/sppequ.c index 102678c91..66a720b92 100644 --- a/lapack-netlib/SRC/sppequ.c +++ b/lapack-netlib/SRC/sppequ.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/spprfs.c b/lapack-netlib/SRC/spprfs.c index 962506818..d29bea7ef 100644 --- a/lapack-netlib/SRC/spprfs.c +++ b/lapack-netlib/SRC/spprfs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sppsv.c b/lapack-netlib/SRC/sppsv.c index 724f8ed87..b8f012758 100644 --- a/lapack-netlib/SRC/sppsv.c +++ b/lapack-netlib/SRC/sppsv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sppsvx.c b/lapack-netlib/SRC/sppsvx.c index 6a6eb27a3..a93b0d79d 100644 --- a/lapack-netlib/SRC/sppsvx.c +++ b/lapack-netlib/SRC/sppsvx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/spptrf.c b/lapack-netlib/SRC/spptrf.c index a135b5633..4015f9a7c 100644 --- a/lapack-netlib/SRC/spptrf.c +++ b/lapack-netlib/SRC/spptrf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/spptri.c b/lapack-netlib/SRC/spptri.c index 28e57e7eb..ab265bf93 100644 --- a/lapack-netlib/SRC/spptri.c +++ b/lapack-netlib/SRC/spptri.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/spptrs.c b/lapack-netlib/SRC/spptrs.c index 37ceb99c3..df34dbc4f 100644 --- a/lapack-netlib/SRC/spptrs.c +++ b/lapack-netlib/SRC/spptrs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/spstf2.c b/lapack-netlib/SRC/spstf2.c index f408568b9..7b2abce03 100644 --- a/lapack-netlib/SRC/spstf2.c +++ b/lapack-netlib/SRC/spstf2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/spstrf.c b/lapack-netlib/SRC/spstrf.c index 5d446aa95..75e1d65b7 100644 --- a/lapack-netlib/SRC/spstrf.c +++ b/lapack-netlib/SRC/spstrf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sptcon.c b/lapack-netlib/SRC/sptcon.c index c8cb73217..c087625d5 100644 --- a/lapack-netlib/SRC/sptcon.c +++ b/lapack-netlib/SRC/sptcon.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/spteqr.c b/lapack-netlib/SRC/spteqr.c index 9c56d6d88..d88b51a5c 100644 --- a/lapack-netlib/SRC/spteqr.c +++ b/lapack-netlib/SRC/spteqr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sptrfs.c b/lapack-netlib/SRC/sptrfs.c index 46d142c80..8c81a0688 100644 --- a/lapack-netlib/SRC/sptrfs.c +++ b/lapack-netlib/SRC/sptrfs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sptsv.c b/lapack-netlib/SRC/sptsv.c index 36c454a93..fcaca78e0 100644 --- a/lapack-netlib/SRC/sptsv.c +++ b/lapack-netlib/SRC/sptsv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sptsvx.c b/lapack-netlib/SRC/sptsvx.c index d2ab81b5c..34e5c86b1 100644 --- a/lapack-netlib/SRC/sptsvx.c +++ b/lapack-netlib/SRC/sptsvx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/spttrf.c b/lapack-netlib/SRC/spttrf.c index 916eb113c..8564cd3ff 100644 --- a/lapack-netlib/SRC/spttrf.c +++ b/lapack-netlib/SRC/spttrf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/spttrs.c b/lapack-netlib/SRC/spttrs.c index cbd642446..d6c51d80d 100644 --- a/lapack-netlib/SRC/spttrs.c +++ b/lapack-netlib/SRC/spttrs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sptts2.c b/lapack-netlib/SRC/sptts2.c index be6b38ebe..1b63ae0a5 100644 --- a/lapack-netlib/SRC/sptts2.c +++ b/lapack-netlib/SRC/sptts2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/srscl.c b/lapack-netlib/SRC/srscl.c index 0ac2e4c36..158e58068 100644 --- a/lapack-netlib/SRC/srscl.c +++ b/lapack-netlib/SRC/srscl.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else From cda91fdc48813964d21238ca899b8836406e850f Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Thu, 4 Apr 2024 00:20:19 +0200 Subject: [PATCH 281/311] fix typedef of logical to support INTERFACE64 --- lapack-netlib/SRC/slaqr0.c | 6 +++--- lapack-netlib/SRC/slaqr1.c | 6 +++--- lapack-netlib/SRC/slaqr2.c | 6 +++--- lapack-netlib/SRC/slaqr3.c | 6 +++--- lapack-netlib/SRC/slaqr4.c | 6 +++--- lapack-netlib/SRC/slaqr5.c | 6 +++--- lapack-netlib/SRC/slaqsb.c | 6 +++--- lapack-netlib/SRC/slaqsp.c | 6 +++--- lapack-netlib/SRC/slaqsy.c | 6 +++--- lapack-netlib/SRC/slaqtr.c | 6 +++--- lapack-netlib/SRC/slar1v.c | 6 +++--- lapack-netlib/SRC/slar2v.c | 6 +++--- lapack-netlib/SRC/slarf.c | 6 +++--- lapack-netlib/SRC/slarfb.c | 6 +++--- lapack-netlib/SRC/slarfb_gett.c | 6 +++--- lapack-netlib/SRC/slarfg.c | 6 +++--- lapack-netlib/SRC/slarfgp.c | 6 +++--- lapack-netlib/SRC/slarft.c | 6 +++--- lapack-netlib/SRC/slarfx.c | 6 +++--- lapack-netlib/SRC/slarfy.c | 6 +++--- lapack-netlib/SRC/slargv.c | 6 +++--- lapack-netlib/SRC/slarmm.c | 6 +++--- lapack-netlib/SRC/slarnv.c | 6 +++--- lapack-netlib/SRC/slarra.c | 6 +++--- lapack-netlib/SRC/slarrb.c | 6 +++--- lapack-netlib/SRC/slarrc.c | 6 +++--- lapack-netlib/SRC/slarrd.c | 6 +++--- lapack-netlib/SRC/slarre.c | 6 +++--- lapack-netlib/SRC/slarrf.c | 6 +++--- lapack-netlib/SRC/slarrj.c | 6 +++--- lapack-netlib/SRC/slarrk.c | 6 +++--- lapack-netlib/SRC/slarrr.c | 6 +++--- lapack-netlib/SRC/slarrv.c | 6 +++--- lapack-netlib/SRC/slarscl2.c | 6 +++--- lapack-netlib/SRC/slartg.c | 6 +++--- lapack-netlib/SRC/slartgp.c | 6 +++--- lapack-netlib/SRC/slartgs.c | 6 +++--- lapack-netlib/SRC/slartv.c | 6 +++--- lapack-netlib/SRC/slaruv.c | 6 +++--- lapack-netlib/SRC/slarz.c | 6 +++--- lapack-netlib/SRC/slarzb.c | 6 +++--- lapack-netlib/SRC/slarzt.c | 6 +++--- lapack-netlib/SRC/slas2.c | 6 +++--- lapack-netlib/SRC/slascl.c | 6 +++--- lapack-netlib/SRC/slascl2.c | 6 +++--- lapack-netlib/SRC/slasd0.c | 6 +++--- lapack-netlib/SRC/slasd1.c | 6 +++--- lapack-netlib/SRC/slasd2.c | 6 +++--- lapack-netlib/SRC/slasd3.c | 6 +++--- lapack-netlib/SRC/slasd4.c | 6 +++--- lapack-netlib/SRC/slasd5.c | 6 +++--- lapack-netlib/SRC/slasd6.c | 6 +++--- lapack-netlib/SRC/slasd7.c | 6 +++--- lapack-netlib/SRC/slasd8.c | 6 +++--- lapack-netlib/SRC/slasda.c | 6 +++--- lapack-netlib/SRC/slasdq.c | 6 +++--- lapack-netlib/SRC/slasdt.c | 6 +++--- lapack-netlib/SRC/slaset.c | 6 +++--- lapack-netlib/SRC/slasq1.c | 6 +++--- lapack-netlib/SRC/slasq2.c | 6 +++--- lapack-netlib/SRC/slasq3.c | 6 +++--- lapack-netlib/SRC/slasq4.c | 6 +++--- lapack-netlib/SRC/slasq5.c | 6 +++--- lapack-netlib/SRC/slasq6.c | 6 +++--- lapack-netlib/SRC/slasr.c | 6 +++--- lapack-netlib/SRC/slasrt.c | 6 +++--- lapack-netlib/SRC/slassq.c | 6 +++--- lapack-netlib/SRC/slasv2.c | 6 +++--- lapack-netlib/SRC/slaswlq.c | 6 +++--- lapack-netlib/SRC/slaswp.c | 6 +++--- lapack-netlib/SRC/slasy2.c | 6 +++--- lapack-netlib/SRC/slasyf.c | 6 +++--- lapack-netlib/SRC/slasyf_aa.c | 6 +++--- lapack-netlib/SRC/slasyf_rk.c | 6 +++--- lapack-netlib/SRC/slasyf_rook.c | 6 +++--- lapack-netlib/SRC/slatbs.c | 6 +++--- lapack-netlib/SRC/slatdf.c | 6 +++--- lapack-netlib/SRC/slatps.c | 6 +++--- lapack-netlib/SRC/slatrd.c | 6 +++--- lapack-netlib/SRC/slatrs.c | 6 +++--- lapack-netlib/SRC/slatrs3.c | 6 +++--- lapack-netlib/SRC/slatrz.c | 6 +++--- lapack-netlib/SRC/slatsqr.c | 6 +++--- lapack-netlib/SRC/slauu2.c | 6 +++--- lapack-netlib/SRC/slauum.c | 6 +++--- 85 files changed, 255 insertions(+), 255 deletions(-) diff --git a/lapack-netlib/SRC/slaqr0.c b/lapack-netlib/SRC/slaqr0.c index 419e6ae71..e8e7f14d3 100644 --- a/lapack-netlib/SRC/slaqr0.c +++ b/lapack-netlib/SRC/slaqr0.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slaqr1.c b/lapack-netlib/SRC/slaqr1.c index 56f487c00..28ee1989b 100644 --- a/lapack-netlib/SRC/slaqr1.c +++ b/lapack-netlib/SRC/slaqr1.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slaqr2.c b/lapack-netlib/SRC/slaqr2.c index 93ab490d8..89d387546 100644 --- a/lapack-netlib/SRC/slaqr2.c +++ b/lapack-netlib/SRC/slaqr2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slaqr3.c b/lapack-netlib/SRC/slaqr3.c index 80fb05bcc..db40006dd 100644 --- a/lapack-netlib/SRC/slaqr3.c +++ b/lapack-netlib/SRC/slaqr3.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slaqr4.c b/lapack-netlib/SRC/slaqr4.c index 8b54e58de..375ddcab6 100644 --- a/lapack-netlib/SRC/slaqr4.c +++ b/lapack-netlib/SRC/slaqr4.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slaqr5.c b/lapack-netlib/SRC/slaqr5.c index ceaf406ca..f8212828b 100644 --- a/lapack-netlib/SRC/slaqr5.c +++ b/lapack-netlib/SRC/slaqr5.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slaqsb.c b/lapack-netlib/SRC/slaqsb.c index d6aa050dd..a5bc278b7 100644 --- a/lapack-netlib/SRC/slaqsb.c +++ b/lapack-netlib/SRC/slaqsb.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slaqsp.c b/lapack-netlib/SRC/slaqsp.c index b49337226..062dad3cf 100644 --- a/lapack-netlib/SRC/slaqsp.c +++ b/lapack-netlib/SRC/slaqsp.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slaqsy.c b/lapack-netlib/SRC/slaqsy.c index e81c12778..19db5e738 100644 --- a/lapack-netlib/SRC/slaqsy.c +++ b/lapack-netlib/SRC/slaqsy.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slaqtr.c b/lapack-netlib/SRC/slaqtr.c index 86c83abfd..0c39d6519 100644 --- a/lapack-netlib/SRC/slaqtr.c +++ b/lapack-netlib/SRC/slaqtr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slar1v.c b/lapack-netlib/SRC/slar1v.c index 32073a50f..f28802e14 100644 --- a/lapack-netlib/SRC/slar1v.c +++ b/lapack-netlib/SRC/slar1v.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slar2v.c b/lapack-netlib/SRC/slar2v.c index a44249474..448987cef 100644 --- a/lapack-netlib/SRC/slar2v.c +++ b/lapack-netlib/SRC/slar2v.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slarf.c b/lapack-netlib/SRC/slarf.c index 344c7b18f..b19978a06 100644 --- a/lapack-netlib/SRC/slarf.c +++ b/lapack-netlib/SRC/slarf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slarfb.c b/lapack-netlib/SRC/slarfb.c index c6af56139..754adf17d 100644 --- a/lapack-netlib/SRC/slarfb.c +++ b/lapack-netlib/SRC/slarfb.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slarfb_gett.c b/lapack-netlib/SRC/slarfb_gett.c index f42da13ca..61f3696df 100644 --- a/lapack-netlib/SRC/slarfb_gett.c +++ b/lapack-netlib/SRC/slarfb_gett.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slarfg.c b/lapack-netlib/SRC/slarfg.c index ed3c80fa0..dd7bd6738 100644 --- a/lapack-netlib/SRC/slarfg.c +++ b/lapack-netlib/SRC/slarfg.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slarfgp.c b/lapack-netlib/SRC/slarfgp.c index 7baef7999..644b451a2 100644 --- a/lapack-netlib/SRC/slarfgp.c +++ b/lapack-netlib/SRC/slarfgp.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slarft.c b/lapack-netlib/SRC/slarft.c index c498d809f..6f8350b21 100644 --- a/lapack-netlib/SRC/slarft.c +++ b/lapack-netlib/SRC/slarft.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slarfx.c b/lapack-netlib/SRC/slarfx.c index 681c939a3..9662a4257 100644 --- a/lapack-netlib/SRC/slarfx.c +++ b/lapack-netlib/SRC/slarfx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slarfy.c b/lapack-netlib/SRC/slarfy.c index c1eb37349..2eb1dc4da 100644 --- a/lapack-netlib/SRC/slarfy.c +++ b/lapack-netlib/SRC/slarfy.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slargv.c b/lapack-netlib/SRC/slargv.c index 9c24fb24a..757c17894 100644 --- a/lapack-netlib/SRC/slargv.c +++ b/lapack-netlib/SRC/slargv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slarmm.c b/lapack-netlib/SRC/slarmm.c index 95114e2f1..97b18bb69 100644 --- a/lapack-netlib/SRC/slarmm.c +++ b/lapack-netlib/SRC/slarmm.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -263,7 +263,7 @@ static int my_expfunc(float *x) {int e; (void)frexpf(*x,&e); return e;} /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slarnv.c b/lapack-netlib/SRC/slarnv.c index 38e6d01dc..0854afb9f 100644 --- a/lapack-netlib/SRC/slarnv.c +++ b/lapack-netlib/SRC/slarnv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slarra.c b/lapack-netlib/SRC/slarra.c index 22699f073..4039c9db7 100644 --- a/lapack-netlib/SRC/slarra.c +++ b/lapack-netlib/SRC/slarra.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slarrb.c b/lapack-netlib/SRC/slarrb.c index b9f080a20..56a733df4 100644 --- a/lapack-netlib/SRC/slarrb.c +++ b/lapack-netlib/SRC/slarrb.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slarrc.c b/lapack-netlib/SRC/slarrc.c index a3bd9fbe1..350a0dd6f 100644 --- a/lapack-netlib/SRC/slarrc.c +++ b/lapack-netlib/SRC/slarrc.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slarrd.c b/lapack-netlib/SRC/slarrd.c index c5e703439..eb1386e7d 100644 --- a/lapack-netlib/SRC/slarrd.c +++ b/lapack-netlib/SRC/slarrd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slarre.c b/lapack-netlib/SRC/slarre.c index ae44ff4d2..58cfdfb1e 100644 --- a/lapack-netlib/SRC/slarre.c +++ b/lapack-netlib/SRC/slarre.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slarrf.c b/lapack-netlib/SRC/slarrf.c index a169b50e6..8cd78c7a0 100644 --- a/lapack-netlib/SRC/slarrf.c +++ b/lapack-netlib/SRC/slarrf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slarrj.c b/lapack-netlib/SRC/slarrj.c index 18bfc4b4a..cba77cdbb 100644 --- a/lapack-netlib/SRC/slarrj.c +++ b/lapack-netlib/SRC/slarrj.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slarrk.c b/lapack-netlib/SRC/slarrk.c index 1dbbcb405..f485deaab 100644 --- a/lapack-netlib/SRC/slarrk.c +++ b/lapack-netlib/SRC/slarrk.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slarrr.c b/lapack-netlib/SRC/slarrr.c index e77ee1d8b..bdb6ad776 100644 --- a/lapack-netlib/SRC/slarrr.c +++ b/lapack-netlib/SRC/slarrr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slarrv.c b/lapack-netlib/SRC/slarrv.c index e922e882b..729c72fd9 100644 --- a/lapack-netlib/SRC/slarrv.c +++ b/lapack-netlib/SRC/slarrv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slarscl2.c b/lapack-netlib/SRC/slarscl2.c index 1403ea61d..66b6438dc 100644 --- a/lapack-netlib/SRC/slarscl2.c +++ b/lapack-netlib/SRC/slarscl2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slartg.c b/lapack-netlib/SRC/slartg.c index d3ba18ab7..55e313df1 100644 --- a/lapack-netlib/SRC/slartg.c +++ b/lapack-netlib/SRC/slartg.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slartgp.c b/lapack-netlib/SRC/slartgp.c index 51995ea7f..0bf8ce52d 100644 --- a/lapack-netlib/SRC/slartgp.c +++ b/lapack-netlib/SRC/slartgp.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slartgs.c b/lapack-netlib/SRC/slartgs.c index a7517ec1f..1bb524bed 100644 --- a/lapack-netlib/SRC/slartgs.c +++ b/lapack-netlib/SRC/slartgs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slartv.c b/lapack-netlib/SRC/slartv.c index 75306c888..2e8cd93f7 100644 --- a/lapack-netlib/SRC/slartv.c +++ b/lapack-netlib/SRC/slartv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slaruv.c b/lapack-netlib/SRC/slaruv.c index b7101f0fd..5d837faf2 100644 --- a/lapack-netlib/SRC/slaruv.c +++ b/lapack-netlib/SRC/slaruv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slarz.c b/lapack-netlib/SRC/slarz.c index d089fdb3e..5b50968dc 100644 --- a/lapack-netlib/SRC/slarz.c +++ b/lapack-netlib/SRC/slarz.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slarzb.c b/lapack-netlib/SRC/slarzb.c index b0e29fd26..f21a6f741 100644 --- a/lapack-netlib/SRC/slarzb.c +++ b/lapack-netlib/SRC/slarzb.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slarzt.c b/lapack-netlib/SRC/slarzt.c index 3c4ba98e5..21aa04930 100644 --- a/lapack-netlib/SRC/slarzt.c +++ b/lapack-netlib/SRC/slarzt.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slas2.c b/lapack-netlib/SRC/slas2.c index d43738d6d..a5df436aa 100644 --- a/lapack-netlib/SRC/slas2.c +++ b/lapack-netlib/SRC/slas2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slascl.c b/lapack-netlib/SRC/slascl.c index 82c46209a..f41d0186f 100644 --- a/lapack-netlib/SRC/slascl.c +++ b/lapack-netlib/SRC/slascl.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slascl2.c b/lapack-netlib/SRC/slascl2.c index 9e17b200c..322fce020 100644 --- a/lapack-netlib/SRC/slascl2.c +++ b/lapack-netlib/SRC/slascl2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slasd0.c b/lapack-netlib/SRC/slasd0.c index a4e9c8748..670473afc 100644 --- a/lapack-netlib/SRC/slasd0.c +++ b/lapack-netlib/SRC/slasd0.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slasd1.c b/lapack-netlib/SRC/slasd1.c index a781d7aeb..2d02e879f 100644 --- a/lapack-netlib/SRC/slasd1.c +++ b/lapack-netlib/SRC/slasd1.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slasd2.c b/lapack-netlib/SRC/slasd2.c index 4263b3bd7..78440d4e2 100644 --- a/lapack-netlib/SRC/slasd2.c +++ b/lapack-netlib/SRC/slasd2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slasd3.c b/lapack-netlib/SRC/slasd3.c index 000b7198e..37cb657fe 100644 --- a/lapack-netlib/SRC/slasd3.c +++ b/lapack-netlib/SRC/slasd3.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slasd4.c b/lapack-netlib/SRC/slasd4.c index 265a16f13..94f3c2276 100644 --- a/lapack-netlib/SRC/slasd4.c +++ b/lapack-netlib/SRC/slasd4.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slasd5.c b/lapack-netlib/SRC/slasd5.c index aabfdc73f..716abcb60 100644 --- a/lapack-netlib/SRC/slasd5.c +++ b/lapack-netlib/SRC/slasd5.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slasd6.c b/lapack-netlib/SRC/slasd6.c index 3877d7204..8ce07adfc 100644 --- a/lapack-netlib/SRC/slasd6.c +++ b/lapack-netlib/SRC/slasd6.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slasd7.c b/lapack-netlib/SRC/slasd7.c index 073ef3438..8c69ba238 100644 --- a/lapack-netlib/SRC/slasd7.c +++ b/lapack-netlib/SRC/slasd7.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slasd8.c b/lapack-netlib/SRC/slasd8.c index 630d5a1dd..eaf4e60f8 100644 --- a/lapack-netlib/SRC/slasd8.c +++ b/lapack-netlib/SRC/slasd8.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slasda.c b/lapack-netlib/SRC/slasda.c index 01924a748..ddd050244 100644 --- a/lapack-netlib/SRC/slasda.c +++ b/lapack-netlib/SRC/slasda.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slasdq.c b/lapack-netlib/SRC/slasdq.c index 61cd7d763..4a1316a1a 100644 --- a/lapack-netlib/SRC/slasdq.c +++ b/lapack-netlib/SRC/slasdq.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slasdt.c b/lapack-netlib/SRC/slasdt.c index b486206b6..01d121e5e 100644 --- a/lapack-netlib/SRC/slasdt.c +++ b/lapack-netlib/SRC/slasdt.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slaset.c b/lapack-netlib/SRC/slaset.c index 7eb9c9939..4936a24c1 100644 --- a/lapack-netlib/SRC/slaset.c +++ b/lapack-netlib/SRC/slaset.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slasq1.c b/lapack-netlib/SRC/slasq1.c index 4489c3f96..187c28da9 100644 --- a/lapack-netlib/SRC/slasq1.c +++ b/lapack-netlib/SRC/slasq1.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slasq2.c b/lapack-netlib/SRC/slasq2.c index 98c53d685..c7ecd4e7c 100644 --- a/lapack-netlib/SRC/slasq2.c +++ b/lapack-netlib/SRC/slasq2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slasq3.c b/lapack-netlib/SRC/slasq3.c index 12688de07..b5549548e 100644 --- a/lapack-netlib/SRC/slasq3.c +++ b/lapack-netlib/SRC/slasq3.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slasq4.c b/lapack-netlib/SRC/slasq4.c index 73f5ca011..c3644ecec 100644 --- a/lapack-netlib/SRC/slasq4.c +++ b/lapack-netlib/SRC/slasq4.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slasq5.c b/lapack-netlib/SRC/slasq5.c index 1a65859c5..c80c995b5 100644 --- a/lapack-netlib/SRC/slasq5.c +++ b/lapack-netlib/SRC/slasq5.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slasq6.c b/lapack-netlib/SRC/slasq6.c index 824ad31c8..9bd97c501 100644 --- a/lapack-netlib/SRC/slasq6.c +++ b/lapack-netlib/SRC/slasq6.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slasr.c b/lapack-netlib/SRC/slasr.c index df1b43403..a78c213f5 100644 --- a/lapack-netlib/SRC/slasr.c +++ b/lapack-netlib/SRC/slasr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slasrt.c b/lapack-netlib/SRC/slasrt.c index 8a97c26bc..273b7e526 100644 --- a/lapack-netlib/SRC/slasrt.c +++ b/lapack-netlib/SRC/slasrt.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slassq.c b/lapack-netlib/SRC/slassq.c index f4a800c75..fae1963a0 100644 --- a/lapack-netlib/SRC/slassq.c +++ b/lapack-netlib/SRC/slassq.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slasv2.c b/lapack-netlib/SRC/slasv2.c index 4fee79d71..704777e99 100644 --- a/lapack-netlib/SRC/slasv2.c +++ b/lapack-netlib/SRC/slasv2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slaswlq.c b/lapack-netlib/SRC/slaswlq.c index bc0d13cb1..e0dabda30 100644 --- a/lapack-netlib/SRC/slaswlq.c +++ b/lapack-netlib/SRC/slaswlq.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slaswp.c b/lapack-netlib/SRC/slaswp.c index d84e6616f..c8c25e2c5 100644 --- a/lapack-netlib/SRC/slaswp.c +++ b/lapack-netlib/SRC/slaswp.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slasy2.c b/lapack-netlib/SRC/slasy2.c index e227137fa..7c88cb54f 100644 --- a/lapack-netlib/SRC/slasy2.c +++ b/lapack-netlib/SRC/slasy2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slasyf.c b/lapack-netlib/SRC/slasyf.c index 6de8fd8f4..a9d7d3dfa 100644 --- a/lapack-netlib/SRC/slasyf.c +++ b/lapack-netlib/SRC/slasyf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slasyf_aa.c b/lapack-netlib/SRC/slasyf_aa.c index 22ec7510a..81fedac3d 100644 --- a/lapack-netlib/SRC/slasyf_aa.c +++ b/lapack-netlib/SRC/slasyf_aa.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slasyf_rk.c b/lapack-netlib/SRC/slasyf_rk.c index 3fa967b54..57c352582 100644 --- a/lapack-netlib/SRC/slasyf_rk.c +++ b/lapack-netlib/SRC/slasyf_rk.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slasyf_rook.c b/lapack-netlib/SRC/slasyf_rook.c index 96715c565..e310c599a 100644 --- a/lapack-netlib/SRC/slasyf_rook.c +++ b/lapack-netlib/SRC/slasyf_rook.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slatbs.c b/lapack-netlib/SRC/slatbs.c index d3cfdeac4..a8bda2095 100644 --- a/lapack-netlib/SRC/slatbs.c +++ b/lapack-netlib/SRC/slatbs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slatdf.c b/lapack-netlib/SRC/slatdf.c index 0a3f04fbe..16a46caa7 100644 --- a/lapack-netlib/SRC/slatdf.c +++ b/lapack-netlib/SRC/slatdf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slatps.c b/lapack-netlib/SRC/slatps.c index c3493a99f..50f82400c 100644 --- a/lapack-netlib/SRC/slatps.c +++ b/lapack-netlib/SRC/slatps.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slatrd.c b/lapack-netlib/SRC/slatrd.c index a4f86a954..b7f0f7848 100644 --- a/lapack-netlib/SRC/slatrd.c +++ b/lapack-netlib/SRC/slatrd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slatrs.c b/lapack-netlib/SRC/slatrs.c index c8463866e..7c6b9eefb 100644 --- a/lapack-netlib/SRC/slatrs.c +++ b/lapack-netlib/SRC/slatrs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slatrs3.c b/lapack-netlib/SRC/slatrs3.c index e6fc722b1..e51f206ba 100644 --- a/lapack-netlib/SRC/slatrs3.c +++ b/lapack-netlib/SRC/slatrs3.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -263,7 +263,7 @@ static int my_expfunc(float *x) {int e; (void)frexpf(*x,&e); return e;} /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slatrz.c b/lapack-netlib/SRC/slatrz.c index 1f8467fe7..6f792c69f 100644 --- a/lapack-netlib/SRC/slatrz.c +++ b/lapack-netlib/SRC/slatrz.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slatsqr.c b/lapack-netlib/SRC/slatsqr.c index d756560e0..9227237e8 100644 --- a/lapack-netlib/SRC/slatsqr.c +++ b/lapack-netlib/SRC/slatsqr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slauu2.c b/lapack-netlib/SRC/slauu2.c index 67ba252af..ff1e09dd1 100644 --- a/lapack-netlib/SRC/slauu2.c +++ b/lapack-netlib/SRC/slauu2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slauum.c b/lapack-netlib/SRC/slauum.c index 5b33e2c51..3413fec1e 100644 --- a/lapack-netlib/SRC/slauum.c +++ b/lapack-netlib/SRC/slauum.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else From 0d33422b8dde63957e9db4eb4c4e89ec356d62da Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Thu, 4 Apr 2024 00:24:54 +0200 Subject: [PATCH 282/311] fix typedef of logical to support INTERFACE64 --- lapack-netlib/SRC/slabad.c | 6 +++--- lapack-netlib/SRC/slacn2.c | 6 +++--- lapack-netlib/SRC/slacpy.c | 6 +++--- lapack-netlib/SRC/sladiv.c | 6 +++--- lapack-netlib/SRC/slae2.c | 6 +++--- lapack-netlib/SRC/slaebz.c | 6 +++--- lapack-netlib/SRC/slaed0.c | 6 +++--- lapack-netlib/SRC/slaed1.c | 6 +++--- lapack-netlib/SRC/slaed2.c | 6 +++--- lapack-netlib/SRC/slaed3.c | 6 +++--- lapack-netlib/SRC/slaed4.c | 6 +++--- lapack-netlib/SRC/slaed5.c | 6 +++--- lapack-netlib/SRC/slaed6.c | 6 +++--- lapack-netlib/SRC/slaed7.c | 6 +++--- lapack-netlib/SRC/slaed8.c | 6 +++--- lapack-netlib/SRC/slaed9.c | 6 +++--- lapack-netlib/SRC/slaeda.c | 6 +++--- lapack-netlib/SRC/slaein.c | 6 +++--- lapack-netlib/SRC/slaev2.c | 6 +++--- lapack-netlib/SRC/slaexc.c | 6 +++--- lapack-netlib/SRC/slag2.c | 6 +++--- lapack-netlib/SRC/slag2d.c | 6 +++--- lapack-netlib/SRC/slags2.c | 6 +++--- lapack-netlib/SRC/slagtf.c | 6 +++--- lapack-netlib/SRC/slagtm.c | 6 +++--- lapack-netlib/SRC/slagts.c | 6 +++--- lapack-netlib/SRC/slagv2.c | 6 +++--- lapack-netlib/SRC/slahqr.c | 6 +++--- lapack-netlib/SRC/slahr2.c | 6 +++--- lapack-netlib/SRC/slaic1.c | 6 +++--- lapack-netlib/SRC/slaisnan.c | 6 +++--- lapack-netlib/SRC/slaln2.c | 6 +++--- lapack-netlib/SRC/slals0.c | 6 +++--- lapack-netlib/SRC/slalsa.c | 6 +++--- lapack-netlib/SRC/slalsd.c | 6 +++--- lapack-netlib/SRC/slamrg.c | 6 +++--- lapack-netlib/SRC/slamswlq.c | 6 +++--- lapack-netlib/SRC/slamtsqr.c | 6 +++--- lapack-netlib/SRC/slaneg.c | 6 +++--- lapack-netlib/SRC/slangb.c | 6 +++--- lapack-netlib/SRC/slange.c | 6 +++--- lapack-netlib/SRC/slangt.c | 6 +++--- lapack-netlib/SRC/slanhs.c | 6 +++--- lapack-netlib/SRC/slansb.c | 6 +++--- lapack-netlib/SRC/slansf.c | 6 +++--- lapack-netlib/SRC/slansp.c | 6 +++--- lapack-netlib/SRC/slanst.c | 6 +++--- lapack-netlib/SRC/slansy.c | 6 +++--- lapack-netlib/SRC/slantb.c | 6 +++--- lapack-netlib/SRC/slantp.c | 6 +++--- lapack-netlib/SRC/slantr.c | 6 +++--- lapack-netlib/SRC/slanv2.c | 6 +++--- lapack-netlib/SRC/slaorhr_col_getrfnp.c | 6 +++--- lapack-netlib/SRC/slaorhr_col_getrfnp2.c | 6 +++--- lapack-netlib/SRC/slapll.c | 6 +++--- lapack-netlib/SRC/slapmr.c | 6 +++--- lapack-netlib/SRC/slapmt.c | 6 +++--- lapack-netlib/SRC/slapy2.c | 6 +++--- lapack-netlib/SRC/slapy3.c | 6 +++--- lapack-netlib/SRC/slaqgb.c | 6 +++--- lapack-netlib/SRC/slaqge.c | 6 +++--- lapack-netlib/SRC/slaqp2.c | 6 +++--- lapack-netlib/SRC/slaqp2rk.c | 6 +++--- lapack-netlib/SRC/slaqp3rk.c | 6 +++--- lapack-netlib/SRC/slaqps.c | 6 +++--- 65 files changed, 195 insertions(+), 195 deletions(-) diff --git a/lapack-netlib/SRC/slabad.c b/lapack-netlib/SRC/slabad.c index 0c7fbe0a3..d0b91ed1c 100644 --- a/lapack-netlib/SRC/slabad.c +++ b/lapack-netlib/SRC/slabad.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slacn2.c b/lapack-netlib/SRC/slacn2.c index a0d7bb426..bb2dd69d3 100644 --- a/lapack-netlib/SRC/slacn2.c +++ b/lapack-netlib/SRC/slacn2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slacpy.c b/lapack-netlib/SRC/slacpy.c index eeb42dfa1..85a78cbf7 100644 --- a/lapack-netlib/SRC/slacpy.c +++ b/lapack-netlib/SRC/slacpy.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sladiv.c b/lapack-netlib/SRC/sladiv.c index 5005ee1b2..ace698b18 100644 --- a/lapack-netlib/SRC/sladiv.c +++ b/lapack-netlib/SRC/sladiv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slae2.c b/lapack-netlib/SRC/slae2.c index b97fe5582..eebb67832 100644 --- a/lapack-netlib/SRC/slae2.c +++ b/lapack-netlib/SRC/slae2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slaebz.c b/lapack-netlib/SRC/slaebz.c index 24264032c..881b61ba3 100644 --- a/lapack-netlib/SRC/slaebz.c +++ b/lapack-netlib/SRC/slaebz.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slaed0.c b/lapack-netlib/SRC/slaed0.c index 930102b9f..1d94820ab 100644 --- a/lapack-netlib/SRC/slaed0.c +++ b/lapack-netlib/SRC/slaed0.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slaed1.c b/lapack-netlib/SRC/slaed1.c index d03d2425f..4dbe5bfd9 100644 --- a/lapack-netlib/SRC/slaed1.c +++ b/lapack-netlib/SRC/slaed1.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slaed2.c b/lapack-netlib/SRC/slaed2.c index 0093a7053..6e35b709c 100644 --- a/lapack-netlib/SRC/slaed2.c +++ b/lapack-netlib/SRC/slaed2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slaed3.c b/lapack-netlib/SRC/slaed3.c index f3fb1aaf7..a77adc3a7 100644 --- a/lapack-netlib/SRC/slaed3.c +++ b/lapack-netlib/SRC/slaed3.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slaed4.c b/lapack-netlib/SRC/slaed4.c index 009b5095f..637d45429 100644 --- a/lapack-netlib/SRC/slaed4.c +++ b/lapack-netlib/SRC/slaed4.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slaed5.c b/lapack-netlib/SRC/slaed5.c index dc8417ef3..f7ff39b45 100644 --- a/lapack-netlib/SRC/slaed5.c +++ b/lapack-netlib/SRC/slaed5.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slaed6.c b/lapack-netlib/SRC/slaed6.c index ceeaad0b7..f40a5e6df 100644 --- a/lapack-netlib/SRC/slaed6.c +++ b/lapack-netlib/SRC/slaed6.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slaed7.c b/lapack-netlib/SRC/slaed7.c index b1fb60a0a..e5543f739 100644 --- a/lapack-netlib/SRC/slaed7.c +++ b/lapack-netlib/SRC/slaed7.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slaed8.c b/lapack-netlib/SRC/slaed8.c index d060c9755..5e9aaefd7 100644 --- a/lapack-netlib/SRC/slaed8.c +++ b/lapack-netlib/SRC/slaed8.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slaed9.c b/lapack-netlib/SRC/slaed9.c index 6de1a9db6..91dd02934 100644 --- a/lapack-netlib/SRC/slaed9.c +++ b/lapack-netlib/SRC/slaed9.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slaeda.c b/lapack-netlib/SRC/slaeda.c index fdf2036db..b0c951e6e 100644 --- a/lapack-netlib/SRC/slaeda.c +++ b/lapack-netlib/SRC/slaeda.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slaein.c b/lapack-netlib/SRC/slaein.c index e05629ee7..99295f86b 100644 --- a/lapack-netlib/SRC/slaein.c +++ b/lapack-netlib/SRC/slaein.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slaev2.c b/lapack-netlib/SRC/slaev2.c index 7500e82af..fe76b0d14 100644 --- a/lapack-netlib/SRC/slaev2.c +++ b/lapack-netlib/SRC/slaev2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slaexc.c b/lapack-netlib/SRC/slaexc.c index 553c4957b..1fb42113c 100644 --- a/lapack-netlib/SRC/slaexc.c +++ b/lapack-netlib/SRC/slaexc.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slag2.c b/lapack-netlib/SRC/slag2.c index c012c0be2..fe84cf72b 100644 --- a/lapack-netlib/SRC/slag2.c +++ b/lapack-netlib/SRC/slag2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slag2d.c b/lapack-netlib/SRC/slag2d.c index 9d4753598..65ecec273 100644 --- a/lapack-netlib/SRC/slag2d.c +++ b/lapack-netlib/SRC/slag2d.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slags2.c b/lapack-netlib/SRC/slags2.c index 1d18f4f57..e299ad774 100644 --- a/lapack-netlib/SRC/slags2.c +++ b/lapack-netlib/SRC/slags2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slagtf.c b/lapack-netlib/SRC/slagtf.c index 993b6e4f0..1e6b64468 100644 --- a/lapack-netlib/SRC/slagtf.c +++ b/lapack-netlib/SRC/slagtf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slagtm.c b/lapack-netlib/SRC/slagtm.c index 589f0723b..9802d094a 100644 --- a/lapack-netlib/SRC/slagtm.c +++ b/lapack-netlib/SRC/slagtm.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slagts.c b/lapack-netlib/SRC/slagts.c index f16f31862..a07a496ac 100644 --- a/lapack-netlib/SRC/slagts.c +++ b/lapack-netlib/SRC/slagts.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slagv2.c b/lapack-netlib/SRC/slagv2.c index 9eed34978..c76744310 100644 --- a/lapack-netlib/SRC/slagv2.c +++ b/lapack-netlib/SRC/slagv2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slahqr.c b/lapack-netlib/SRC/slahqr.c index 99cdc2580..0ac08e955 100644 --- a/lapack-netlib/SRC/slahqr.c +++ b/lapack-netlib/SRC/slahqr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slahr2.c b/lapack-netlib/SRC/slahr2.c index ed697ff09..70796ed1c 100644 --- a/lapack-netlib/SRC/slahr2.c +++ b/lapack-netlib/SRC/slahr2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slaic1.c b/lapack-netlib/SRC/slaic1.c index 6307e19e9..db004fd13 100644 --- a/lapack-netlib/SRC/slaic1.c +++ b/lapack-netlib/SRC/slaic1.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slaisnan.c b/lapack-netlib/SRC/slaisnan.c index fe1065746..ffeaa5f91 100644 --- a/lapack-netlib/SRC/slaisnan.c +++ b/lapack-netlib/SRC/slaisnan.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slaln2.c b/lapack-netlib/SRC/slaln2.c index 68465aced..4cefd60ea 100644 --- a/lapack-netlib/SRC/slaln2.c +++ b/lapack-netlib/SRC/slaln2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slals0.c b/lapack-netlib/SRC/slals0.c index 0fa849983..3cbd91fc8 100644 --- a/lapack-netlib/SRC/slals0.c +++ b/lapack-netlib/SRC/slals0.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slalsa.c b/lapack-netlib/SRC/slalsa.c index 2eba239f4..aae61e7e8 100644 --- a/lapack-netlib/SRC/slalsa.c +++ b/lapack-netlib/SRC/slalsa.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slalsd.c b/lapack-netlib/SRC/slalsd.c index de6066e58..5c4019735 100644 --- a/lapack-netlib/SRC/slalsd.c +++ b/lapack-netlib/SRC/slalsd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slamrg.c b/lapack-netlib/SRC/slamrg.c index 75d51e4c4..9e705a0d6 100644 --- a/lapack-netlib/SRC/slamrg.c +++ b/lapack-netlib/SRC/slamrg.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slamswlq.c b/lapack-netlib/SRC/slamswlq.c index 9a7591fcb..84684608c 100644 --- a/lapack-netlib/SRC/slamswlq.c +++ b/lapack-netlib/SRC/slamswlq.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slamtsqr.c b/lapack-netlib/SRC/slamtsqr.c index 99b4acb93..85f9abef9 100644 --- a/lapack-netlib/SRC/slamtsqr.c +++ b/lapack-netlib/SRC/slamtsqr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slaneg.c b/lapack-netlib/SRC/slaneg.c index 8e1c3a48d..c3ad93b73 100644 --- a/lapack-netlib/SRC/slaneg.c +++ b/lapack-netlib/SRC/slaneg.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slangb.c b/lapack-netlib/SRC/slangb.c index d2b1fb86f..73759fc3e 100644 --- a/lapack-netlib/SRC/slangb.c +++ b/lapack-netlib/SRC/slangb.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slange.c b/lapack-netlib/SRC/slange.c index 5090e6fc6..780d05384 100644 --- a/lapack-netlib/SRC/slange.c +++ b/lapack-netlib/SRC/slange.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slangt.c b/lapack-netlib/SRC/slangt.c index 27a3f0b08..06dff9db7 100644 --- a/lapack-netlib/SRC/slangt.c +++ b/lapack-netlib/SRC/slangt.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slanhs.c b/lapack-netlib/SRC/slanhs.c index 75142b255..1cdde81be 100644 --- a/lapack-netlib/SRC/slanhs.c +++ b/lapack-netlib/SRC/slanhs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slansb.c b/lapack-netlib/SRC/slansb.c index 1c2fbb508..8f5a9cd0e 100644 --- a/lapack-netlib/SRC/slansb.c +++ b/lapack-netlib/SRC/slansb.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slansf.c b/lapack-netlib/SRC/slansf.c index 014aaefdb..aee50c6fe 100644 --- a/lapack-netlib/SRC/slansf.c +++ b/lapack-netlib/SRC/slansf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slansp.c b/lapack-netlib/SRC/slansp.c index b75278114..0d5fedaf2 100644 --- a/lapack-netlib/SRC/slansp.c +++ b/lapack-netlib/SRC/slansp.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slanst.c b/lapack-netlib/SRC/slanst.c index 8e7a24bd3..60f951034 100644 --- a/lapack-netlib/SRC/slanst.c +++ b/lapack-netlib/SRC/slanst.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slansy.c b/lapack-netlib/SRC/slansy.c index d5cbbf21b..81bc2bb68 100644 --- a/lapack-netlib/SRC/slansy.c +++ b/lapack-netlib/SRC/slansy.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slantb.c b/lapack-netlib/SRC/slantb.c index 0b488ce05..d533870ab 100644 --- a/lapack-netlib/SRC/slantb.c +++ b/lapack-netlib/SRC/slantb.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slantp.c b/lapack-netlib/SRC/slantp.c index 6d6187eca..c99eae654 100644 --- a/lapack-netlib/SRC/slantp.c +++ b/lapack-netlib/SRC/slantp.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slantr.c b/lapack-netlib/SRC/slantr.c index 4d74a5274..4f82d7db0 100644 --- a/lapack-netlib/SRC/slantr.c +++ b/lapack-netlib/SRC/slantr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slanv2.c b/lapack-netlib/SRC/slanv2.c index b26f84fcb..31cc31a3c 100644 --- a/lapack-netlib/SRC/slanv2.c +++ b/lapack-netlib/SRC/slanv2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slaorhr_col_getrfnp.c b/lapack-netlib/SRC/slaorhr_col_getrfnp.c index 13bb84654..5fce3290c 100644 --- a/lapack-netlib/SRC/slaorhr_col_getrfnp.c +++ b/lapack-netlib/SRC/slaorhr_col_getrfnp.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slaorhr_col_getrfnp2.c b/lapack-netlib/SRC/slaorhr_col_getrfnp2.c index 5569c9d92..f6798acf9 100644 --- a/lapack-netlib/SRC/slaorhr_col_getrfnp2.c +++ b/lapack-netlib/SRC/slaorhr_col_getrfnp2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slapll.c b/lapack-netlib/SRC/slapll.c index aa284a954..78da4fdf4 100644 --- a/lapack-netlib/SRC/slapll.c +++ b/lapack-netlib/SRC/slapll.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slapmr.c b/lapack-netlib/SRC/slapmr.c index da542a823..8aedaa58d 100644 --- a/lapack-netlib/SRC/slapmr.c +++ b/lapack-netlib/SRC/slapmr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slapmt.c b/lapack-netlib/SRC/slapmt.c index cdbbd9dad..0e054d15d 100644 --- a/lapack-netlib/SRC/slapmt.c +++ b/lapack-netlib/SRC/slapmt.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slapy2.c b/lapack-netlib/SRC/slapy2.c index f81fda348..7549f87e2 100644 --- a/lapack-netlib/SRC/slapy2.c +++ b/lapack-netlib/SRC/slapy2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slapy3.c b/lapack-netlib/SRC/slapy3.c index 15669b800..372ec9c99 100644 --- a/lapack-netlib/SRC/slapy3.c +++ b/lapack-netlib/SRC/slapy3.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slaqgb.c b/lapack-netlib/SRC/slaqgb.c index f01adbe31..d503508d0 100644 --- a/lapack-netlib/SRC/slaqgb.c +++ b/lapack-netlib/SRC/slaqgb.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slaqge.c b/lapack-netlib/SRC/slaqge.c index 4af7d4c8f..8d6043b51 100644 --- a/lapack-netlib/SRC/slaqge.c +++ b/lapack-netlib/SRC/slaqge.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slaqp2.c b/lapack-netlib/SRC/slaqp2.c index 3547e505d..e3f846f9a 100644 --- a/lapack-netlib/SRC/slaqp2.c +++ b/lapack-netlib/SRC/slaqp2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slaqp2rk.c b/lapack-netlib/SRC/slaqp2rk.c index 0bfa71ab9..3886a09fe 100644 --- a/lapack-netlib/SRC/slaqp2rk.c +++ b/lapack-netlib/SRC/slaqp2rk.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slaqp3rk.c b/lapack-netlib/SRC/slaqp3rk.c index e3632538b..66c2b7522 100644 --- a/lapack-netlib/SRC/slaqp3rk.c +++ b/lapack-netlib/SRC/slaqp3rk.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/slaqps.c b/lapack-netlib/SRC/slaqps.c index b9093db39..a535cf1fa 100644 --- a/lapack-netlib/SRC/slaqps.c +++ b/lapack-netlib/SRC/slaqps.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else From b0973a98e2e0499a62d63a30cd55641796f13641 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Thu, 4 Apr 2024 00:34:32 +0200 Subject: [PATCH 283/311] fix typedef of logical to support INTERFACE64 --- lapack-netlib/SRC/iparam2stage.c | 6 +++--- lapack-netlib/SRC/iparmq.c | 6 +++--- lapack-netlib/SRC/izmax1.c | 6 +++--- lapack-netlib/SRC/lsamen.c | 6 +++--- lapack-netlib/SRC/sbbcsd.c | 6 +++--- lapack-netlib/SRC/sbdsdc.c | 6 +++--- lapack-netlib/SRC/sbdsqr.c | 6 +++--- lapack-netlib/SRC/sbdsvdx.c | 6 +++--- lapack-netlib/SRC/scombssq.c | 6 +++--- lapack-netlib/SRC/scsum1.c | 6 +++--- lapack-netlib/SRC/sdisna.c | 6 +++--- lapack-netlib/SRC/sgbequb.c | 6 +++--- lapack-netlib/SRC/sgbrfsx.c | 6 +++--- lapack-netlib/SRC/sgbsvxx.c | 6 +++--- lapack-netlib/SRC/sgedmd.c | 6 +++--- lapack-netlib/SRC/sgedmdq.c | 6 +++--- lapack-netlib/SRC/sgeequb.c | 6 +++--- lapack-netlib/SRC/sgejsv.c | 6 +++--- lapack-netlib/SRC/sgelq.c | 6 +++--- lapack-netlib/SRC/sgelqt.c | 6 +++--- lapack-netlib/SRC/sgelqt3.c | 6 +++--- lapack-netlib/SRC/sgelst.c | 6 +++--- lapack-netlib/SRC/sgemlq.c | 6 +++--- lapack-netlib/SRC/sgemlqt.c | 6 +++--- lapack-netlib/SRC/sgemqr.c | 6 +++--- lapack-netlib/SRC/sgemqrt.c | 6 +++--- lapack-netlib/SRC/sgeqr.c | 6 +++--- lapack-netlib/SRC/sgeqrt.c | 6 +++--- lapack-netlib/SRC/sgeqrt2.c | 6 +++--- lapack-netlib/SRC/sgeqrt3.c | 6 +++--- lapack-netlib/SRC/sgerfsx.c | 6 +++--- lapack-netlib/SRC/sgesv.c | 6 +++--- lapack-netlib/SRC/sgesvdq.c | 6 +++--- lapack-netlib/SRC/sgesvj.c | 6 +++--- lapack-netlib/SRC/sgesvxx.c | 6 +++--- lapack-netlib/SRC/sgetf2.c | 6 +++--- lapack-netlib/SRC/sgetrf.c | 6 +++--- lapack-netlib/SRC/sgetrs.c | 6 +++--- lapack-netlib/SRC/sgetsls.c | 6 +++--- lapack-netlib/SRC/sgetsqrhrt.c | 6 +++--- lapack-netlib/SRC/sgsvj0.c | 6 +++--- lapack-netlib/SRC/sgsvj1.c | 6 +++--- lapack-netlib/SRC/sisnan.c | 6 +++--- lapack-netlib/SRC/sla_gbamv.c | 6 +++--- lapack-netlib/SRC/sla_gbrcond.c | 6 +++--- lapack-netlib/SRC/sla_gbrfsx_extended.c | 6 +++--- lapack-netlib/SRC/sla_gbrpvgrw.c | 6 +++--- lapack-netlib/SRC/sla_geamv.c | 6 +++--- lapack-netlib/SRC/sla_gercond.c | 6 +++--- lapack-netlib/SRC/sla_gerfsx_extended.c | 6 +++--- lapack-netlib/SRC/sla_gerpvgrw.c | 6 +++--- lapack-netlib/SRC/sla_lin_berr.c | 6 +++--- lapack-netlib/SRC/sla_porcond.c | 6 +++--- lapack-netlib/SRC/sla_porfsx_extended.c | 6 +++--- lapack-netlib/SRC/sla_porpvgrw.c | 6 +++--- lapack-netlib/SRC/sla_syamv.c | 6 +++--- lapack-netlib/SRC/sla_syrcond.c | 6 +++--- lapack-netlib/SRC/sla_syrfsx_extended.c | 6 +++--- lapack-netlib/SRC/sla_syrpvgrw.c | 6 +++--- lapack-netlib/SRC/sla_wwaddw.c | 6 +++--- 60 files changed, 180 insertions(+), 180 deletions(-) diff --git a/lapack-netlib/SRC/iparam2stage.c b/lapack-netlib/SRC/iparam2stage.c index 7ba938dcd..f88aeb1b4 100644 --- a/lapack-netlib/SRC/iparam2stage.c +++ b/lapack-netlib/SRC/iparam2stage.c @@ -53,8 +53,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -261,7 +261,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/iparmq.c b/lapack-netlib/SRC/iparmq.c index eb9d12112..57578929f 100644 --- a/lapack-netlib/SRC/iparmq.c +++ b/lapack-netlib/SRC/iparmq.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/izmax1.c b/lapack-netlib/SRC/izmax1.c index 1176d0208..c6a8443bc 100644 --- a/lapack-netlib/SRC/izmax1.c +++ b/lapack-netlib/SRC/izmax1.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/lsamen.c b/lapack-netlib/SRC/lsamen.c index 18bad69cf..252fed8dc 100644 --- a/lapack-netlib/SRC/lsamen.c +++ b/lapack-netlib/SRC/lsamen.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sbbcsd.c b/lapack-netlib/SRC/sbbcsd.c index 198baa59c..d22bb2995 100644 --- a/lapack-netlib/SRC/sbbcsd.c +++ b/lapack-netlib/SRC/sbbcsd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sbdsdc.c b/lapack-netlib/SRC/sbdsdc.c index ffcf1afda..85fd13e2b 100644 --- a/lapack-netlib/SRC/sbdsdc.c +++ b/lapack-netlib/SRC/sbdsdc.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sbdsqr.c b/lapack-netlib/SRC/sbdsqr.c index 832c43bca..f5a3b49d8 100644 --- a/lapack-netlib/SRC/sbdsqr.c +++ b/lapack-netlib/SRC/sbdsqr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sbdsvdx.c b/lapack-netlib/SRC/sbdsvdx.c index bf1b9aa1b..be3bbde4f 100644 --- a/lapack-netlib/SRC/sbdsvdx.c +++ b/lapack-netlib/SRC/sbdsvdx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/scombssq.c b/lapack-netlib/SRC/scombssq.c index 1e207420f..b2da995d6 100644 --- a/lapack-netlib/SRC/scombssq.c +++ b/lapack-netlib/SRC/scombssq.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/scsum1.c b/lapack-netlib/SRC/scsum1.c index a12e8cc8a..35384b949 100644 --- a/lapack-netlib/SRC/scsum1.c +++ b/lapack-netlib/SRC/scsum1.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sdisna.c b/lapack-netlib/SRC/sdisna.c index bf12638f1..8f411715c 100644 --- a/lapack-netlib/SRC/sdisna.c +++ b/lapack-netlib/SRC/sdisna.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sgbequb.c b/lapack-netlib/SRC/sgbequb.c index 94dc75c39..e7807be5a 100644 --- a/lapack-netlib/SRC/sgbequb.c +++ b/lapack-netlib/SRC/sgbequb.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sgbrfsx.c b/lapack-netlib/SRC/sgbrfsx.c index a957a440d..65e9ddced 100644 --- a/lapack-netlib/SRC/sgbrfsx.c +++ b/lapack-netlib/SRC/sgbrfsx.c @@ -54,8 +54,8 @@ static inline _Complex float * _pCf(complex *z) {return (_Complex float*)z;} static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double*)z;} #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -257,7 +257,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sgbsvxx.c b/lapack-netlib/SRC/sgbsvxx.c index 74f458c06..d1a3d0e2f 100644 --- a/lapack-netlib/SRC/sgbsvxx.c +++ b/lapack-netlib/SRC/sgbsvxx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sgedmd.c b/lapack-netlib/SRC/sgedmd.c index c8f3a5964..e2a7ad0a2 100644 --- a/lapack-netlib/SRC/sgedmd.c +++ b/lapack-netlib/SRC/sgedmd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sgedmdq.c b/lapack-netlib/SRC/sgedmdq.c index 0adf3bda3..bafc775cb 100644 --- a/lapack-netlib/SRC/sgedmdq.c +++ b/lapack-netlib/SRC/sgedmdq.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sgeequb.c b/lapack-netlib/SRC/sgeequb.c index 9515a5df8..fa0b0db1f 100644 --- a/lapack-netlib/SRC/sgeequb.c +++ b/lapack-netlib/SRC/sgeequb.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sgejsv.c b/lapack-netlib/SRC/sgejsv.c index 0820b0dfb..8dc009941 100644 --- a/lapack-netlib/SRC/sgejsv.c +++ b/lapack-netlib/SRC/sgejsv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sgelq.c b/lapack-netlib/SRC/sgelq.c index 55d7079b6..41b10caae 100644 --- a/lapack-netlib/SRC/sgelq.c +++ b/lapack-netlib/SRC/sgelq.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sgelqt.c b/lapack-netlib/SRC/sgelqt.c index 5c5efdb6f..440bb865e 100644 --- a/lapack-netlib/SRC/sgelqt.c +++ b/lapack-netlib/SRC/sgelqt.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sgelqt3.c b/lapack-netlib/SRC/sgelqt3.c index fdb918647..1dffe4c9b 100644 --- a/lapack-netlib/SRC/sgelqt3.c +++ b/lapack-netlib/SRC/sgelqt3.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sgelst.c b/lapack-netlib/SRC/sgelst.c index 7e17c542c..6a6ed86bf 100644 --- a/lapack-netlib/SRC/sgelst.c +++ b/lapack-netlib/SRC/sgelst.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sgemlq.c b/lapack-netlib/SRC/sgemlq.c index 0d17bbfb0..1995ae908 100644 --- a/lapack-netlib/SRC/sgemlq.c +++ b/lapack-netlib/SRC/sgemlq.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sgemlqt.c b/lapack-netlib/SRC/sgemlqt.c index f5c9609f1..cb1ac4cfe 100644 --- a/lapack-netlib/SRC/sgemlqt.c +++ b/lapack-netlib/SRC/sgemlqt.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sgemqr.c b/lapack-netlib/SRC/sgemqr.c index 3788ab32e..6afe35088 100644 --- a/lapack-netlib/SRC/sgemqr.c +++ b/lapack-netlib/SRC/sgemqr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sgemqrt.c b/lapack-netlib/SRC/sgemqrt.c index b078373ca..e82d50222 100644 --- a/lapack-netlib/SRC/sgemqrt.c +++ b/lapack-netlib/SRC/sgemqrt.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sgeqr.c b/lapack-netlib/SRC/sgeqr.c index 6cf01efa4..6cad3f066 100644 --- a/lapack-netlib/SRC/sgeqr.c +++ b/lapack-netlib/SRC/sgeqr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sgeqrt.c b/lapack-netlib/SRC/sgeqrt.c index 44b22b8bb..a54242ce9 100644 --- a/lapack-netlib/SRC/sgeqrt.c +++ b/lapack-netlib/SRC/sgeqrt.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sgeqrt2.c b/lapack-netlib/SRC/sgeqrt2.c index 027616203..44cc02393 100644 --- a/lapack-netlib/SRC/sgeqrt2.c +++ b/lapack-netlib/SRC/sgeqrt2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sgeqrt3.c b/lapack-netlib/SRC/sgeqrt3.c index 0de1ac3ab..17442fbab 100644 --- a/lapack-netlib/SRC/sgeqrt3.c +++ b/lapack-netlib/SRC/sgeqrt3.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sgerfsx.c b/lapack-netlib/SRC/sgerfsx.c index 3cd1abbc4..986fa6ac8 100644 --- a/lapack-netlib/SRC/sgerfsx.c +++ b/lapack-netlib/SRC/sgerfsx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sgesv.c b/lapack-netlib/SRC/sgesv.c index ac0b02e2f..3283f37cf 100644 --- a/lapack-netlib/SRC/sgesv.c +++ b/lapack-netlib/SRC/sgesv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sgesvdq.c b/lapack-netlib/SRC/sgesvdq.c index 4c6bc8bea..33bf7a0f2 100644 --- a/lapack-netlib/SRC/sgesvdq.c +++ b/lapack-netlib/SRC/sgesvdq.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sgesvj.c b/lapack-netlib/SRC/sgesvj.c index ab5fa21ca..1cc2c3251 100644 --- a/lapack-netlib/SRC/sgesvj.c +++ b/lapack-netlib/SRC/sgesvj.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sgesvxx.c b/lapack-netlib/SRC/sgesvxx.c index 424053793..742e0023d 100644 --- a/lapack-netlib/SRC/sgesvxx.c +++ b/lapack-netlib/SRC/sgesvxx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sgetf2.c b/lapack-netlib/SRC/sgetf2.c index 60604637d..6a9d980a9 100644 --- a/lapack-netlib/SRC/sgetf2.c +++ b/lapack-netlib/SRC/sgetf2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sgetrf.c b/lapack-netlib/SRC/sgetrf.c index efe00eb33..adef7d9f0 100644 --- a/lapack-netlib/SRC/sgetrf.c +++ b/lapack-netlib/SRC/sgetrf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sgetrs.c b/lapack-netlib/SRC/sgetrs.c index 6740b3383..afb5b3869 100644 --- a/lapack-netlib/SRC/sgetrs.c +++ b/lapack-netlib/SRC/sgetrs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sgetsls.c b/lapack-netlib/SRC/sgetsls.c index bd1230bfa..09b8d3a59 100644 --- a/lapack-netlib/SRC/sgetsls.c +++ b/lapack-netlib/SRC/sgetsls.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sgetsqrhrt.c b/lapack-netlib/SRC/sgetsqrhrt.c index 5f0a94229..3caeb7d4c 100644 --- a/lapack-netlib/SRC/sgetsqrhrt.c +++ b/lapack-netlib/SRC/sgetsqrhrt.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sgsvj0.c b/lapack-netlib/SRC/sgsvj0.c index e969997da..8aa66ef06 100644 --- a/lapack-netlib/SRC/sgsvj0.c +++ b/lapack-netlib/SRC/sgsvj0.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sgsvj1.c b/lapack-netlib/SRC/sgsvj1.c index 804a2ec29..890808b63 100644 --- a/lapack-netlib/SRC/sgsvj1.c +++ b/lapack-netlib/SRC/sgsvj1.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sisnan.c b/lapack-netlib/SRC/sisnan.c index d53a8748c..acf8885bb 100644 --- a/lapack-netlib/SRC/sisnan.c +++ b/lapack-netlib/SRC/sisnan.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sla_gbamv.c b/lapack-netlib/SRC/sla_gbamv.c index 6b59f704d..44aa20fe4 100644 --- a/lapack-netlib/SRC/sla_gbamv.c +++ b/lapack-netlib/SRC/sla_gbamv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sla_gbrcond.c b/lapack-netlib/SRC/sla_gbrcond.c index 1f18bee25..cc910019c 100644 --- a/lapack-netlib/SRC/sla_gbrcond.c +++ b/lapack-netlib/SRC/sla_gbrcond.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sla_gbrfsx_extended.c b/lapack-netlib/SRC/sla_gbrfsx_extended.c index e84e3b2e9..0c9d816d7 100644 --- a/lapack-netlib/SRC/sla_gbrfsx_extended.c +++ b/lapack-netlib/SRC/sla_gbrfsx_extended.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sla_gbrpvgrw.c b/lapack-netlib/SRC/sla_gbrpvgrw.c index 673cac069..d1601be13 100644 --- a/lapack-netlib/SRC/sla_gbrpvgrw.c +++ b/lapack-netlib/SRC/sla_gbrpvgrw.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sla_geamv.c b/lapack-netlib/SRC/sla_geamv.c index 338f6070e..cdf2283f3 100644 --- a/lapack-netlib/SRC/sla_geamv.c +++ b/lapack-netlib/SRC/sla_geamv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sla_gercond.c b/lapack-netlib/SRC/sla_gercond.c index 72198dc49..0a911215d 100644 --- a/lapack-netlib/SRC/sla_gercond.c +++ b/lapack-netlib/SRC/sla_gercond.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sla_gerfsx_extended.c b/lapack-netlib/SRC/sla_gerfsx_extended.c index ca801473a..16f08a8a5 100644 --- a/lapack-netlib/SRC/sla_gerfsx_extended.c +++ b/lapack-netlib/SRC/sla_gerfsx_extended.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sla_gerpvgrw.c b/lapack-netlib/SRC/sla_gerpvgrw.c index 638d91bb5..9af741611 100644 --- a/lapack-netlib/SRC/sla_gerpvgrw.c +++ b/lapack-netlib/SRC/sla_gerpvgrw.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sla_lin_berr.c b/lapack-netlib/SRC/sla_lin_berr.c index 199c8c2c2..d7f056f6a 100644 --- a/lapack-netlib/SRC/sla_lin_berr.c +++ b/lapack-netlib/SRC/sla_lin_berr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sla_porcond.c b/lapack-netlib/SRC/sla_porcond.c index 7fde8818a..dcaec34ec 100644 --- a/lapack-netlib/SRC/sla_porcond.c +++ b/lapack-netlib/SRC/sla_porcond.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sla_porfsx_extended.c b/lapack-netlib/SRC/sla_porfsx_extended.c index 1f0f09e24..5a32b1f71 100644 --- a/lapack-netlib/SRC/sla_porfsx_extended.c +++ b/lapack-netlib/SRC/sla_porfsx_extended.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sla_porpvgrw.c b/lapack-netlib/SRC/sla_porpvgrw.c index a2b10c459..1391bc16a 100644 --- a/lapack-netlib/SRC/sla_porpvgrw.c +++ b/lapack-netlib/SRC/sla_porpvgrw.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sla_syamv.c b/lapack-netlib/SRC/sla_syamv.c index 5222376b6..ce3296ace 100644 --- a/lapack-netlib/SRC/sla_syamv.c +++ b/lapack-netlib/SRC/sla_syamv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sla_syrcond.c b/lapack-netlib/SRC/sla_syrcond.c index a61e0450e..714a533f3 100644 --- a/lapack-netlib/SRC/sla_syrcond.c +++ b/lapack-netlib/SRC/sla_syrcond.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sla_syrfsx_extended.c b/lapack-netlib/SRC/sla_syrfsx_extended.c index 936d9a36b..c0a0019b8 100644 --- a/lapack-netlib/SRC/sla_syrfsx_extended.c +++ b/lapack-netlib/SRC/sla_syrfsx_extended.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sla_syrpvgrw.c b/lapack-netlib/SRC/sla_syrpvgrw.c index 63b63c0e5..616d9ba29 100644 --- a/lapack-netlib/SRC/sla_syrpvgrw.c +++ b/lapack-netlib/SRC/sla_syrpvgrw.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/sla_wwaddw.c b/lapack-netlib/SRC/sla_wwaddw.c index c14f5676f..97361cc2f 100644 --- a/lapack-netlib/SRC/sla_wwaddw.c +++ b/lapack-netlib/SRC/sla_wwaddw.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else From c0d74772606cb4c9f6ca0f87894b55de48ac2260 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Thu, 4 Apr 2024 00:41:14 +0200 Subject: [PATCH 284/311] fix typedef of logical to support INTERFACE64 --- lapack-netlib/SRC/dsyswapr.c | 6 +++--- lapack-netlib/SRC/dsytd2.c | 6 +++--- lapack-netlib/SRC/dsytf2.c | 6 +++--- lapack-netlib/SRC/dsytf2_rk.c | 6 +++--- lapack-netlib/SRC/dsytf2_rook.c | 6 +++--- lapack-netlib/SRC/dsytrd.c | 6 +++--- lapack-netlib/SRC/dsytrd_2stage.c | 6 +++--- lapack-netlib/SRC/dsytrd_sb2st.c | 6 +++--- lapack-netlib/SRC/dsytrd_sy2sb.c | 6 +++--- lapack-netlib/SRC/dsytrf.c | 6 +++--- lapack-netlib/SRC/dsytrf_aa.c | 6 +++--- lapack-netlib/SRC/dsytrf_aa_2stage.c | 6 +++--- lapack-netlib/SRC/dsytrf_rk.c | 6 +++--- lapack-netlib/SRC/dsytrf_rook.c | 6 +++--- lapack-netlib/SRC/dsytri.c | 6 +++--- lapack-netlib/SRC/dsytri2.c | 6 +++--- lapack-netlib/SRC/dsytri2x.c | 6 +++--- lapack-netlib/SRC/dsytri_3.c | 6 +++--- lapack-netlib/SRC/dsytri_3x.c | 6 +++--- lapack-netlib/SRC/dsytri_rook.c | 6 +++--- lapack-netlib/SRC/dsytrs.c | 6 +++--- lapack-netlib/SRC/dsytrs2.c | 6 +++--- lapack-netlib/SRC/dsytrs_3.c | 6 +++--- lapack-netlib/SRC/dsytrs_aa.c | 6 +++--- lapack-netlib/SRC/dsytrs_aa_2stage.c | 6 +++--- lapack-netlib/SRC/dsytrs_rook.c | 6 +++--- lapack-netlib/SRC/dtbcon.c | 6 +++--- lapack-netlib/SRC/dtbrfs.c | 6 +++--- lapack-netlib/SRC/dtbtrs.c | 6 +++--- lapack-netlib/SRC/dtfsm.c | 6 +++--- lapack-netlib/SRC/dtftri.c | 6 +++--- lapack-netlib/SRC/dtfttp.c | 6 +++--- lapack-netlib/SRC/dtfttr.c | 6 +++--- lapack-netlib/SRC/dtgevc.c | 6 +++--- lapack-netlib/SRC/dtgex2.c | 6 +++--- lapack-netlib/SRC/dtgexc.c | 6 +++--- lapack-netlib/SRC/dtgsen.c | 6 +++--- lapack-netlib/SRC/dtgsja.c | 6 +++--- lapack-netlib/SRC/dtgsna.c | 6 +++--- lapack-netlib/SRC/dtgsy2.c | 6 +++--- lapack-netlib/SRC/dtgsyl.c | 6 +++--- lapack-netlib/SRC/dtpcon.c | 6 +++--- lapack-netlib/SRC/dtplqt.c | 6 +++--- lapack-netlib/SRC/dtplqt2.c | 6 +++--- lapack-netlib/SRC/dtpmlqt.c | 6 +++--- lapack-netlib/SRC/dtpmqrt.c | 6 +++--- lapack-netlib/SRC/dtpqrt.c | 6 +++--- lapack-netlib/SRC/dtpqrt2.c | 6 +++--- lapack-netlib/SRC/dtprfb.c | 6 +++--- lapack-netlib/SRC/dtprfs.c | 6 +++--- lapack-netlib/SRC/dtptri.c | 6 +++--- lapack-netlib/SRC/dtptrs.c | 6 +++--- lapack-netlib/SRC/dtpttf.c | 6 +++--- lapack-netlib/SRC/dtpttr.c | 6 +++--- lapack-netlib/SRC/dtrcon.c | 6 +++--- lapack-netlib/SRC/dtrevc.c | 6 +++--- lapack-netlib/SRC/dtrevc3.c | 6 +++--- lapack-netlib/SRC/dtrexc.c | 6 +++--- lapack-netlib/SRC/dtrrfs.c | 6 +++--- lapack-netlib/SRC/dtrsen.c | 6 +++--- lapack-netlib/SRC/dtrsna.c | 6 +++--- lapack-netlib/SRC/dtrsyl.c | 6 +++--- lapack-netlib/SRC/dtrsyl3.c | 6 +++--- lapack-netlib/SRC/dtrti2.c | 6 +++--- lapack-netlib/SRC/dtrtri.c | 6 +++--- lapack-netlib/SRC/dtrtrs.c | 6 +++--- lapack-netlib/SRC/dtrttf.c | 6 +++--- lapack-netlib/SRC/dtrttp.c | 6 +++--- lapack-netlib/SRC/dtzrzf.c | 6 +++--- lapack-netlib/SRC/dzsum1.c | 6 +++--- lapack-netlib/SRC/icmax1.c | 6 +++--- lapack-netlib/SRC/ieeeck.c | 6 +++--- lapack-netlib/SRC/ilaclc.c | 6 +++--- lapack-netlib/SRC/ilaclr.c | 6 +++--- lapack-netlib/SRC/iladiag.c | 6 +++--- lapack-netlib/SRC/iladlc.c | 6 +++--- lapack-netlib/SRC/iladlr.c | 6 +++--- lapack-netlib/SRC/ilaenv.c | 6 +++--- lapack-netlib/SRC/ilaenv2stage.c | 6 +++--- lapack-netlib/SRC/ilaprec.c | 6 +++--- lapack-netlib/SRC/ilaslc.c | 6 +++--- lapack-netlib/SRC/ilaslr.c | 6 +++--- lapack-netlib/SRC/ilatrans.c | 6 +++--- lapack-netlib/SRC/ilauplo.c | 6 +++--- lapack-netlib/SRC/ilazlc.c | 6 +++--- lapack-netlib/SRC/ilazlr.c | 6 +++--- 86 files changed, 258 insertions(+), 258 deletions(-) diff --git a/lapack-netlib/SRC/dsyswapr.c b/lapack-netlib/SRC/dsyswapr.c index e239f7858..ba74d23a7 100644 --- a/lapack-netlib/SRC/dsyswapr.c +++ b/lapack-netlib/SRC/dsyswapr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dsytd2.c b/lapack-netlib/SRC/dsytd2.c index 48c357648..4b3256083 100644 --- a/lapack-netlib/SRC/dsytd2.c +++ b/lapack-netlib/SRC/dsytd2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dsytf2.c b/lapack-netlib/SRC/dsytf2.c index 421bc62d7..76401042e 100644 --- a/lapack-netlib/SRC/dsytf2.c +++ b/lapack-netlib/SRC/dsytf2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dsytf2_rk.c b/lapack-netlib/SRC/dsytf2_rk.c index 0cf7a7726..ba30c7ff7 100644 --- a/lapack-netlib/SRC/dsytf2_rk.c +++ b/lapack-netlib/SRC/dsytf2_rk.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dsytf2_rook.c b/lapack-netlib/SRC/dsytf2_rook.c index a6e93428d..21ba35c5a 100644 --- a/lapack-netlib/SRC/dsytf2_rook.c +++ b/lapack-netlib/SRC/dsytf2_rook.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dsytrd.c b/lapack-netlib/SRC/dsytrd.c index da0310281..e56ca7473 100644 --- a/lapack-netlib/SRC/dsytrd.c +++ b/lapack-netlib/SRC/dsytrd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dsytrd_2stage.c b/lapack-netlib/SRC/dsytrd_2stage.c index 100864b63..4063ace54 100644 --- a/lapack-netlib/SRC/dsytrd_2stage.c +++ b/lapack-netlib/SRC/dsytrd_2stage.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dsytrd_sb2st.c b/lapack-netlib/SRC/dsytrd_sb2st.c index e8f2bf0a5..ed78630d6 100644 --- a/lapack-netlib/SRC/dsytrd_sb2st.c +++ b/lapack-netlib/SRC/dsytrd_sb2st.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dsytrd_sy2sb.c b/lapack-netlib/SRC/dsytrd_sy2sb.c index b98cecf64..8df65bb91 100644 --- a/lapack-netlib/SRC/dsytrd_sy2sb.c +++ b/lapack-netlib/SRC/dsytrd_sy2sb.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dsytrf.c b/lapack-netlib/SRC/dsytrf.c index f2078bdb1..309ccabb4 100644 --- a/lapack-netlib/SRC/dsytrf.c +++ b/lapack-netlib/SRC/dsytrf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dsytrf_aa.c b/lapack-netlib/SRC/dsytrf_aa.c index 1f56e2f7c..11739e47e 100644 --- a/lapack-netlib/SRC/dsytrf_aa.c +++ b/lapack-netlib/SRC/dsytrf_aa.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dsytrf_aa_2stage.c b/lapack-netlib/SRC/dsytrf_aa_2stage.c index 24b213c70..9d37b01bf 100644 --- a/lapack-netlib/SRC/dsytrf_aa_2stage.c +++ b/lapack-netlib/SRC/dsytrf_aa_2stage.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dsytrf_rk.c b/lapack-netlib/SRC/dsytrf_rk.c index dcb9aeeff..356a444a1 100644 --- a/lapack-netlib/SRC/dsytrf_rk.c +++ b/lapack-netlib/SRC/dsytrf_rk.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dsytrf_rook.c b/lapack-netlib/SRC/dsytrf_rook.c index 57f8e4e64..c19ea9cec 100644 --- a/lapack-netlib/SRC/dsytrf_rook.c +++ b/lapack-netlib/SRC/dsytrf_rook.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dsytri.c b/lapack-netlib/SRC/dsytri.c index 0311e9e1e..6bc297237 100644 --- a/lapack-netlib/SRC/dsytri.c +++ b/lapack-netlib/SRC/dsytri.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dsytri2.c b/lapack-netlib/SRC/dsytri2.c index 9f453cc05..1a3288cb6 100644 --- a/lapack-netlib/SRC/dsytri2.c +++ b/lapack-netlib/SRC/dsytri2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dsytri2x.c b/lapack-netlib/SRC/dsytri2x.c index 6bab331f0..72b95139a 100644 --- a/lapack-netlib/SRC/dsytri2x.c +++ b/lapack-netlib/SRC/dsytri2x.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dsytri_3.c b/lapack-netlib/SRC/dsytri_3.c index 8ce325fea..1a8c65e33 100644 --- a/lapack-netlib/SRC/dsytri_3.c +++ b/lapack-netlib/SRC/dsytri_3.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dsytri_3x.c b/lapack-netlib/SRC/dsytri_3x.c index 1d7a23f9f..001bcf233 100644 --- a/lapack-netlib/SRC/dsytri_3x.c +++ b/lapack-netlib/SRC/dsytri_3x.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dsytri_rook.c b/lapack-netlib/SRC/dsytri_rook.c index 16adecc7d..0633c0164 100644 --- a/lapack-netlib/SRC/dsytri_rook.c +++ b/lapack-netlib/SRC/dsytri_rook.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dsytrs.c b/lapack-netlib/SRC/dsytrs.c index 69903ec36..c9f6a5d82 100644 --- a/lapack-netlib/SRC/dsytrs.c +++ b/lapack-netlib/SRC/dsytrs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dsytrs2.c b/lapack-netlib/SRC/dsytrs2.c index 62a8f545a..e0192fa9a 100644 --- a/lapack-netlib/SRC/dsytrs2.c +++ b/lapack-netlib/SRC/dsytrs2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dsytrs_3.c b/lapack-netlib/SRC/dsytrs_3.c index ee48613c4..6eaf0dd89 100644 --- a/lapack-netlib/SRC/dsytrs_3.c +++ b/lapack-netlib/SRC/dsytrs_3.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dsytrs_aa.c b/lapack-netlib/SRC/dsytrs_aa.c index bbf225259..047541025 100644 --- a/lapack-netlib/SRC/dsytrs_aa.c +++ b/lapack-netlib/SRC/dsytrs_aa.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dsytrs_aa_2stage.c b/lapack-netlib/SRC/dsytrs_aa_2stage.c index 3153ef806..271667168 100644 --- a/lapack-netlib/SRC/dsytrs_aa_2stage.c +++ b/lapack-netlib/SRC/dsytrs_aa_2stage.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dsytrs_rook.c b/lapack-netlib/SRC/dsytrs_rook.c index af9b1f43a..7fe1d3b8b 100644 --- a/lapack-netlib/SRC/dsytrs_rook.c +++ b/lapack-netlib/SRC/dsytrs_rook.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dtbcon.c b/lapack-netlib/SRC/dtbcon.c index 0c5807e78..1a3be57e9 100644 --- a/lapack-netlib/SRC/dtbcon.c +++ b/lapack-netlib/SRC/dtbcon.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dtbrfs.c b/lapack-netlib/SRC/dtbrfs.c index 19ac8469c..0cc6aaa9b 100644 --- a/lapack-netlib/SRC/dtbrfs.c +++ b/lapack-netlib/SRC/dtbrfs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dtbtrs.c b/lapack-netlib/SRC/dtbtrs.c index 6da24c48f..0e2759259 100644 --- a/lapack-netlib/SRC/dtbtrs.c +++ b/lapack-netlib/SRC/dtbtrs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dtfsm.c b/lapack-netlib/SRC/dtfsm.c index bc37a7ccc..bb49e16a9 100644 --- a/lapack-netlib/SRC/dtfsm.c +++ b/lapack-netlib/SRC/dtfsm.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dtftri.c b/lapack-netlib/SRC/dtftri.c index 86b63defa..a2c0fcd35 100644 --- a/lapack-netlib/SRC/dtftri.c +++ b/lapack-netlib/SRC/dtftri.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dtfttp.c b/lapack-netlib/SRC/dtfttp.c index d1dd7891e..97ebc6986 100644 --- a/lapack-netlib/SRC/dtfttp.c +++ b/lapack-netlib/SRC/dtfttp.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dtfttr.c b/lapack-netlib/SRC/dtfttr.c index 105489483..be710da64 100644 --- a/lapack-netlib/SRC/dtfttr.c +++ b/lapack-netlib/SRC/dtfttr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dtgevc.c b/lapack-netlib/SRC/dtgevc.c index 66b43daca..a4754f183 100644 --- a/lapack-netlib/SRC/dtgevc.c +++ b/lapack-netlib/SRC/dtgevc.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dtgex2.c b/lapack-netlib/SRC/dtgex2.c index f4a077d35..2a6060225 100644 --- a/lapack-netlib/SRC/dtgex2.c +++ b/lapack-netlib/SRC/dtgex2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dtgexc.c b/lapack-netlib/SRC/dtgexc.c index bc0765a6f..9eb76de18 100644 --- a/lapack-netlib/SRC/dtgexc.c +++ b/lapack-netlib/SRC/dtgexc.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dtgsen.c b/lapack-netlib/SRC/dtgsen.c index 1d2e658e2..3c186178a 100644 --- a/lapack-netlib/SRC/dtgsen.c +++ b/lapack-netlib/SRC/dtgsen.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dtgsja.c b/lapack-netlib/SRC/dtgsja.c index 158ee2805..25a027f2f 100644 --- a/lapack-netlib/SRC/dtgsja.c +++ b/lapack-netlib/SRC/dtgsja.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dtgsna.c b/lapack-netlib/SRC/dtgsna.c index 010b0a890..9f0d49b12 100644 --- a/lapack-netlib/SRC/dtgsna.c +++ b/lapack-netlib/SRC/dtgsna.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dtgsy2.c b/lapack-netlib/SRC/dtgsy2.c index fc2f271aa..0a89bd99b 100644 --- a/lapack-netlib/SRC/dtgsy2.c +++ b/lapack-netlib/SRC/dtgsy2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dtgsyl.c b/lapack-netlib/SRC/dtgsyl.c index 3493e716f..3d0885c0f 100644 --- a/lapack-netlib/SRC/dtgsyl.c +++ b/lapack-netlib/SRC/dtgsyl.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dtpcon.c b/lapack-netlib/SRC/dtpcon.c index 7beee5211..a0747eae5 100644 --- a/lapack-netlib/SRC/dtpcon.c +++ b/lapack-netlib/SRC/dtpcon.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dtplqt.c b/lapack-netlib/SRC/dtplqt.c index 0c3d1b1c9..cff76eda6 100644 --- a/lapack-netlib/SRC/dtplqt.c +++ b/lapack-netlib/SRC/dtplqt.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dtplqt2.c b/lapack-netlib/SRC/dtplqt2.c index cac1311db..db77fca68 100644 --- a/lapack-netlib/SRC/dtplqt2.c +++ b/lapack-netlib/SRC/dtplqt2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dtpmlqt.c b/lapack-netlib/SRC/dtpmlqt.c index 52ee6799e..3907b7d93 100644 --- a/lapack-netlib/SRC/dtpmlqt.c +++ b/lapack-netlib/SRC/dtpmlqt.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dtpmqrt.c b/lapack-netlib/SRC/dtpmqrt.c index 78b7a4e4f..4c0032954 100644 --- a/lapack-netlib/SRC/dtpmqrt.c +++ b/lapack-netlib/SRC/dtpmqrt.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dtpqrt.c b/lapack-netlib/SRC/dtpqrt.c index 3d44f2b16..bb95eebef 100644 --- a/lapack-netlib/SRC/dtpqrt.c +++ b/lapack-netlib/SRC/dtpqrt.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dtpqrt2.c b/lapack-netlib/SRC/dtpqrt2.c index d82e0a7d5..2d1634e22 100644 --- a/lapack-netlib/SRC/dtpqrt2.c +++ b/lapack-netlib/SRC/dtpqrt2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dtprfb.c b/lapack-netlib/SRC/dtprfb.c index 28c152d9e..6e1759542 100644 --- a/lapack-netlib/SRC/dtprfb.c +++ b/lapack-netlib/SRC/dtprfb.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dtprfs.c b/lapack-netlib/SRC/dtprfs.c index 3d89639f4..6fa658c0b 100644 --- a/lapack-netlib/SRC/dtprfs.c +++ b/lapack-netlib/SRC/dtprfs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dtptri.c b/lapack-netlib/SRC/dtptri.c index d2bf675f0..655218d98 100644 --- a/lapack-netlib/SRC/dtptri.c +++ b/lapack-netlib/SRC/dtptri.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dtptrs.c b/lapack-netlib/SRC/dtptrs.c index b9485e533..d8643c9e2 100644 --- a/lapack-netlib/SRC/dtptrs.c +++ b/lapack-netlib/SRC/dtptrs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dtpttf.c b/lapack-netlib/SRC/dtpttf.c index f58742658..858457e91 100644 --- a/lapack-netlib/SRC/dtpttf.c +++ b/lapack-netlib/SRC/dtpttf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dtpttr.c b/lapack-netlib/SRC/dtpttr.c index e62a648cf..4fbc8af14 100644 --- a/lapack-netlib/SRC/dtpttr.c +++ b/lapack-netlib/SRC/dtpttr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dtrcon.c b/lapack-netlib/SRC/dtrcon.c index bda4ee17a..ee54cf178 100644 --- a/lapack-netlib/SRC/dtrcon.c +++ b/lapack-netlib/SRC/dtrcon.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dtrevc.c b/lapack-netlib/SRC/dtrevc.c index bbaacf89d..a282cec3f 100644 --- a/lapack-netlib/SRC/dtrevc.c +++ b/lapack-netlib/SRC/dtrevc.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dtrevc3.c b/lapack-netlib/SRC/dtrevc3.c index eb7055fa2..0ad4b3d92 100644 --- a/lapack-netlib/SRC/dtrevc3.c +++ b/lapack-netlib/SRC/dtrevc3.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dtrexc.c b/lapack-netlib/SRC/dtrexc.c index 6dd00b907..e70297281 100644 --- a/lapack-netlib/SRC/dtrexc.c +++ b/lapack-netlib/SRC/dtrexc.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dtrrfs.c b/lapack-netlib/SRC/dtrrfs.c index a42ee25ff..5a8a027e4 100644 --- a/lapack-netlib/SRC/dtrrfs.c +++ b/lapack-netlib/SRC/dtrrfs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dtrsen.c b/lapack-netlib/SRC/dtrsen.c index 17d3915ca..165cddb0f 100644 --- a/lapack-netlib/SRC/dtrsen.c +++ b/lapack-netlib/SRC/dtrsen.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dtrsna.c b/lapack-netlib/SRC/dtrsna.c index 4bcf3e344..5cf7757cb 100644 --- a/lapack-netlib/SRC/dtrsna.c +++ b/lapack-netlib/SRC/dtrsna.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dtrsyl.c b/lapack-netlib/SRC/dtrsyl.c index a92834682..f98bd6a83 100644 --- a/lapack-netlib/SRC/dtrsyl.c +++ b/lapack-netlib/SRC/dtrsyl.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dtrsyl3.c b/lapack-netlib/SRC/dtrsyl3.c index 187226281..c459b61db 100644 --- a/lapack-netlib/SRC/dtrsyl3.c +++ b/lapack-netlib/SRC/dtrsyl3.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -263,7 +263,7 @@ static int my_expfunc(double *x) {int e; (void)frexp(*x,&e); return e;} /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dtrti2.c b/lapack-netlib/SRC/dtrti2.c index 47eb0d889..9779b6f7a 100644 --- a/lapack-netlib/SRC/dtrti2.c +++ b/lapack-netlib/SRC/dtrti2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dtrtri.c b/lapack-netlib/SRC/dtrtri.c index 1f7191472..196388553 100644 --- a/lapack-netlib/SRC/dtrtri.c +++ b/lapack-netlib/SRC/dtrtri.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dtrtrs.c b/lapack-netlib/SRC/dtrtrs.c index 804ebe54e..6c2b27257 100644 --- a/lapack-netlib/SRC/dtrtrs.c +++ b/lapack-netlib/SRC/dtrtrs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dtrttf.c b/lapack-netlib/SRC/dtrttf.c index 199a8731c..a90ecd0dc 100644 --- a/lapack-netlib/SRC/dtrttf.c +++ b/lapack-netlib/SRC/dtrttf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dtrttp.c b/lapack-netlib/SRC/dtrttp.c index fb96db271..2164edb55 100644 --- a/lapack-netlib/SRC/dtrttp.c +++ b/lapack-netlib/SRC/dtrttp.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dtzrzf.c b/lapack-netlib/SRC/dtzrzf.c index 5836f65fc..7324ead6b 100644 --- a/lapack-netlib/SRC/dtzrzf.c +++ b/lapack-netlib/SRC/dtzrzf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dzsum1.c b/lapack-netlib/SRC/dzsum1.c index e3c0e9893..5101bc049 100644 --- a/lapack-netlib/SRC/dzsum1.c +++ b/lapack-netlib/SRC/dzsum1.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/icmax1.c b/lapack-netlib/SRC/icmax1.c index 3a2510453..4d57a4c1a 100644 --- a/lapack-netlib/SRC/icmax1.c +++ b/lapack-netlib/SRC/icmax1.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ieeeck.c b/lapack-netlib/SRC/ieeeck.c index 0516fc377..8b22019f1 100644 --- a/lapack-netlib/SRC/ieeeck.c +++ b/lapack-netlib/SRC/ieeeck.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ilaclc.c b/lapack-netlib/SRC/ilaclc.c index 616c3d1e4..16617f9da 100644 --- a/lapack-netlib/SRC/ilaclc.c +++ b/lapack-netlib/SRC/ilaclc.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ilaclr.c b/lapack-netlib/SRC/ilaclr.c index 7cddc2b86..b90466f9a 100644 --- a/lapack-netlib/SRC/ilaclr.c +++ b/lapack-netlib/SRC/ilaclr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/iladiag.c b/lapack-netlib/SRC/iladiag.c index fa99e6423..a65ea4cd9 100644 --- a/lapack-netlib/SRC/iladiag.c +++ b/lapack-netlib/SRC/iladiag.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/iladlc.c b/lapack-netlib/SRC/iladlc.c index d2c5451a0..37cfad67e 100644 --- a/lapack-netlib/SRC/iladlc.c +++ b/lapack-netlib/SRC/iladlc.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/iladlr.c b/lapack-netlib/SRC/iladlr.c index ff871596c..8955573f7 100644 --- a/lapack-netlib/SRC/iladlr.c +++ b/lapack-netlib/SRC/iladlr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ilaenv.c b/lapack-netlib/SRC/ilaenv.c index 8f3b2db8e..c262e5952 100644 --- a/lapack-netlib/SRC/ilaenv.c +++ b/lapack-netlib/SRC/ilaenv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ilaenv2stage.c b/lapack-netlib/SRC/ilaenv2stage.c index 9730bdc48..12baeba63 100644 --- a/lapack-netlib/SRC/ilaenv2stage.c +++ b/lapack-netlib/SRC/ilaenv2stage.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ilaprec.c b/lapack-netlib/SRC/ilaprec.c index 07a1b5873..381d3292e 100644 --- a/lapack-netlib/SRC/ilaprec.c +++ b/lapack-netlib/SRC/ilaprec.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ilaslc.c b/lapack-netlib/SRC/ilaslc.c index cdce95c3a..c37f0f2f4 100644 --- a/lapack-netlib/SRC/ilaslc.c +++ b/lapack-netlib/SRC/ilaslc.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ilaslr.c b/lapack-netlib/SRC/ilaslr.c index 285d971a5..f0f04e9d0 100644 --- a/lapack-netlib/SRC/ilaslr.c +++ b/lapack-netlib/SRC/ilaslr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ilatrans.c b/lapack-netlib/SRC/ilatrans.c index c75bb7c48..f086785ce 100644 --- a/lapack-netlib/SRC/ilatrans.c +++ b/lapack-netlib/SRC/ilatrans.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ilauplo.c b/lapack-netlib/SRC/ilauplo.c index 71d1c5cba..4bda2c0c7 100644 --- a/lapack-netlib/SRC/ilauplo.c +++ b/lapack-netlib/SRC/ilauplo.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ilazlc.c b/lapack-netlib/SRC/ilazlc.c index 4af641d40..60de5b185 100644 --- a/lapack-netlib/SRC/ilazlc.c +++ b/lapack-netlib/SRC/ilazlc.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ilazlr.c b/lapack-netlib/SRC/ilazlr.c index 93b80c7c3..016cd9cb9 100644 --- a/lapack-netlib/SRC/ilazlr.c +++ b/lapack-netlib/SRC/ilazlr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else From 1d4d36e835029b056184def146e17b50f3e3fca5 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Thu, 4 Apr 2024 00:51:36 +0200 Subject: [PATCH 285/311] fix typedef of logical to support INTERFACE64 --- lapack-netlib/SRC/dpotrf.c | 6 +++--- lapack-netlib/SRC/dpotrf2.c | 6 +++--- lapack-netlib/SRC/dpotri.c | 6 +++--- lapack-netlib/SRC/dpotrs.c | 6 +++--- lapack-netlib/SRC/dppcon.c | 6 +++--- lapack-netlib/SRC/dppequ.c | 6 +++--- lapack-netlib/SRC/dpprfs.c | 6 +++--- lapack-netlib/SRC/dppsv.c | 6 +++--- lapack-netlib/SRC/dppsvx.c | 6 +++--- lapack-netlib/SRC/dpptrf.c | 6 +++--- lapack-netlib/SRC/dpptri.c | 6 +++--- lapack-netlib/SRC/dpptrs.c | 6 +++--- lapack-netlib/SRC/dpstf2.c | 6 +++--- lapack-netlib/SRC/dpstrf.c | 6 +++--- lapack-netlib/SRC/dptcon.c | 6 +++--- lapack-netlib/SRC/dpteqr.c | 6 +++--- lapack-netlib/SRC/dptrfs.c | 6 +++--- lapack-netlib/SRC/dptsv.c | 6 +++--- lapack-netlib/SRC/dptsvx.c | 6 +++--- lapack-netlib/SRC/dpttrf.c | 6 +++--- lapack-netlib/SRC/dpttrs.c | 6 +++--- lapack-netlib/SRC/dptts2.c | 6 +++--- lapack-netlib/SRC/drscl.c | 6 +++--- lapack-netlib/SRC/dsb2st_kernels.c | 6 +++--- lapack-netlib/SRC/dsbev.c | 6 +++--- lapack-netlib/SRC/dsbev_2stage.c | 6 +++--- lapack-netlib/SRC/dsbevd.c | 6 +++--- lapack-netlib/SRC/dsbevd_2stage.c | 6 +++--- lapack-netlib/SRC/dsbevx.c | 6 +++--- lapack-netlib/SRC/dsbevx_2stage.c | 6 +++--- lapack-netlib/SRC/dsbgst.c | 6 +++--- lapack-netlib/SRC/dsbgv.c | 6 +++--- lapack-netlib/SRC/dsbgvd.c | 6 +++--- lapack-netlib/SRC/dsbgvx.c | 6 +++--- lapack-netlib/SRC/dsbtrd.c | 6 +++--- lapack-netlib/SRC/dsfrk.c | 6 +++--- lapack-netlib/SRC/dsgesv.c | 6 +++--- lapack-netlib/SRC/dspcon.c | 6 +++--- lapack-netlib/SRC/dspev.c | 6 +++--- lapack-netlib/SRC/dspevd.c | 6 +++--- lapack-netlib/SRC/dspevx.c | 6 +++--- lapack-netlib/SRC/dspgst.c | 6 +++--- lapack-netlib/SRC/dspgv.c | 6 +++--- lapack-netlib/SRC/dspgvd.c | 6 +++--- lapack-netlib/SRC/dspgvx.c | 6 +++--- lapack-netlib/SRC/dsposv.c | 6 +++--- lapack-netlib/SRC/dsprfs.c | 6 +++--- lapack-netlib/SRC/dspsv.c | 6 +++--- lapack-netlib/SRC/dspsvx.c | 6 +++--- lapack-netlib/SRC/dsptrd.c | 6 +++--- lapack-netlib/SRC/dsptrf.c | 6 +++--- lapack-netlib/SRC/dsptri.c | 6 +++--- lapack-netlib/SRC/dsptrs.c | 6 +++--- lapack-netlib/SRC/dstebz.c | 6 +++--- lapack-netlib/SRC/dstedc.c | 6 +++--- lapack-netlib/SRC/dstegr.c | 6 +++--- lapack-netlib/SRC/dstein.c | 6 +++--- lapack-netlib/SRC/dstemr.c | 6 +++--- lapack-netlib/SRC/dsteqr.c | 6 +++--- lapack-netlib/SRC/dsterf.c | 6 +++--- lapack-netlib/SRC/dstev.c | 6 +++--- lapack-netlib/SRC/dstevd.c | 6 +++--- lapack-netlib/SRC/dstevr.c | 6 +++--- lapack-netlib/SRC/dstevx.c | 6 +++--- lapack-netlib/SRC/dsycon.c | 6 +++--- lapack-netlib/SRC/dsycon_3.c | 6 +++--- lapack-netlib/SRC/dsycon_rook.c | 6 +++--- lapack-netlib/SRC/dsyconv.c | 6 +++--- lapack-netlib/SRC/dsyconvf.c | 6 +++--- lapack-netlib/SRC/dsyconvf_rook.c | 6 +++--- lapack-netlib/SRC/dsyequb.c | 6 +++--- lapack-netlib/SRC/dsyev.c | 6 +++--- lapack-netlib/SRC/dsyev_2stage.c | 6 +++--- lapack-netlib/SRC/dsyevd.c | 6 +++--- lapack-netlib/SRC/dsyevd_2stage.c | 6 +++--- lapack-netlib/SRC/dsyevr.c | 6 +++--- lapack-netlib/SRC/dsyevr_2stage.c | 6 +++--- lapack-netlib/SRC/dsyevx.c | 6 +++--- lapack-netlib/SRC/dsyevx_2stage.c | 6 +++--- lapack-netlib/SRC/dsygs2.c | 6 +++--- lapack-netlib/SRC/dsygst.c | 6 +++--- lapack-netlib/SRC/dsygv.c | 6 +++--- lapack-netlib/SRC/dsygv_2stage.c | 6 +++--- lapack-netlib/SRC/dsygvd.c | 6 +++--- lapack-netlib/SRC/dsygvx.c | 6 +++--- lapack-netlib/SRC/dsyrfs.c | 6 +++--- lapack-netlib/SRC/dsyrfsx.c | 6 +++--- lapack-netlib/SRC/dsysv.c | 6 +++--- lapack-netlib/SRC/dsysv_aa.c | 6 +++--- lapack-netlib/SRC/dsysv_aa_2stage.c | 6 +++--- lapack-netlib/SRC/dsysv_rk.c | 6 +++--- lapack-netlib/SRC/dsysv_rook.c | 6 +++--- lapack-netlib/SRC/dsysvx.c | 6 +++--- lapack-netlib/SRC/dsysvxx.c | 6 +++--- 94 files changed, 282 insertions(+), 282 deletions(-) diff --git a/lapack-netlib/SRC/dpotrf.c b/lapack-netlib/SRC/dpotrf.c index 2c09fd41e..2940a266c 100644 --- a/lapack-netlib/SRC/dpotrf.c +++ b/lapack-netlib/SRC/dpotrf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dpotrf2.c b/lapack-netlib/SRC/dpotrf2.c index 5073fe1ae..dc93dec03 100644 --- a/lapack-netlib/SRC/dpotrf2.c +++ b/lapack-netlib/SRC/dpotrf2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dpotri.c b/lapack-netlib/SRC/dpotri.c index c11d90d8d..46ec9323e 100644 --- a/lapack-netlib/SRC/dpotri.c +++ b/lapack-netlib/SRC/dpotri.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dpotrs.c b/lapack-netlib/SRC/dpotrs.c index 97ed17d61..dc1447ced 100644 --- a/lapack-netlib/SRC/dpotrs.c +++ b/lapack-netlib/SRC/dpotrs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dppcon.c b/lapack-netlib/SRC/dppcon.c index c81be8bee..87b263c01 100644 --- a/lapack-netlib/SRC/dppcon.c +++ b/lapack-netlib/SRC/dppcon.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dppequ.c b/lapack-netlib/SRC/dppequ.c index 9700a80bd..16643e678 100644 --- a/lapack-netlib/SRC/dppequ.c +++ b/lapack-netlib/SRC/dppequ.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dpprfs.c b/lapack-netlib/SRC/dpprfs.c index 40e1677cd..40367b38b 100644 --- a/lapack-netlib/SRC/dpprfs.c +++ b/lapack-netlib/SRC/dpprfs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dppsv.c b/lapack-netlib/SRC/dppsv.c index e730dc071..971a697c7 100644 --- a/lapack-netlib/SRC/dppsv.c +++ b/lapack-netlib/SRC/dppsv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dppsvx.c b/lapack-netlib/SRC/dppsvx.c index 3a339ab87..93d83a6e7 100644 --- a/lapack-netlib/SRC/dppsvx.c +++ b/lapack-netlib/SRC/dppsvx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dpptrf.c b/lapack-netlib/SRC/dpptrf.c index 7cfd1b984..af70cfb93 100644 --- a/lapack-netlib/SRC/dpptrf.c +++ b/lapack-netlib/SRC/dpptrf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dpptri.c b/lapack-netlib/SRC/dpptri.c index be3e43847..03daeeb66 100644 --- a/lapack-netlib/SRC/dpptri.c +++ b/lapack-netlib/SRC/dpptri.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dpptrs.c b/lapack-netlib/SRC/dpptrs.c index ae96e067f..16cc679b4 100644 --- a/lapack-netlib/SRC/dpptrs.c +++ b/lapack-netlib/SRC/dpptrs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dpstf2.c b/lapack-netlib/SRC/dpstf2.c index ff677abef..fe881088b 100644 --- a/lapack-netlib/SRC/dpstf2.c +++ b/lapack-netlib/SRC/dpstf2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dpstrf.c b/lapack-netlib/SRC/dpstrf.c index fe83d4232..9dca1638f 100644 --- a/lapack-netlib/SRC/dpstrf.c +++ b/lapack-netlib/SRC/dpstrf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dptcon.c b/lapack-netlib/SRC/dptcon.c index f097bdf20..720f950d3 100644 --- a/lapack-netlib/SRC/dptcon.c +++ b/lapack-netlib/SRC/dptcon.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dpteqr.c b/lapack-netlib/SRC/dpteqr.c index a1426dcbb..a408deaf7 100644 --- a/lapack-netlib/SRC/dpteqr.c +++ b/lapack-netlib/SRC/dpteqr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dptrfs.c b/lapack-netlib/SRC/dptrfs.c index b1077e93c..867a29024 100644 --- a/lapack-netlib/SRC/dptrfs.c +++ b/lapack-netlib/SRC/dptrfs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dptsv.c b/lapack-netlib/SRC/dptsv.c index 2afc6ea37..aa48dad05 100644 --- a/lapack-netlib/SRC/dptsv.c +++ b/lapack-netlib/SRC/dptsv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dptsvx.c b/lapack-netlib/SRC/dptsvx.c index 9f28238fe..bcb5d4fb7 100644 --- a/lapack-netlib/SRC/dptsvx.c +++ b/lapack-netlib/SRC/dptsvx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dpttrf.c b/lapack-netlib/SRC/dpttrf.c index f3aa48b26..abb348cd2 100644 --- a/lapack-netlib/SRC/dpttrf.c +++ b/lapack-netlib/SRC/dpttrf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dpttrs.c b/lapack-netlib/SRC/dpttrs.c index 9c49ef959..9a8dfd66e 100644 --- a/lapack-netlib/SRC/dpttrs.c +++ b/lapack-netlib/SRC/dpttrs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dptts2.c b/lapack-netlib/SRC/dptts2.c index e6991be26..2471b7af2 100644 --- a/lapack-netlib/SRC/dptts2.c +++ b/lapack-netlib/SRC/dptts2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/drscl.c b/lapack-netlib/SRC/drscl.c index 653d90874..b3ce58bae 100644 --- a/lapack-netlib/SRC/drscl.c +++ b/lapack-netlib/SRC/drscl.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dsb2st_kernels.c b/lapack-netlib/SRC/dsb2st_kernels.c index 2d619ce18..7ef0cad68 100644 --- a/lapack-netlib/SRC/dsb2st_kernels.c +++ b/lapack-netlib/SRC/dsb2st_kernels.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dsbev.c b/lapack-netlib/SRC/dsbev.c index 50e54cea6..e72e1a1fe 100644 --- a/lapack-netlib/SRC/dsbev.c +++ b/lapack-netlib/SRC/dsbev.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dsbev_2stage.c b/lapack-netlib/SRC/dsbev_2stage.c index 563547b6e..2cd37fed0 100644 --- a/lapack-netlib/SRC/dsbev_2stage.c +++ b/lapack-netlib/SRC/dsbev_2stage.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dsbevd.c b/lapack-netlib/SRC/dsbevd.c index 900bb9718..0173f0222 100644 --- a/lapack-netlib/SRC/dsbevd.c +++ b/lapack-netlib/SRC/dsbevd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dsbevd_2stage.c b/lapack-netlib/SRC/dsbevd_2stage.c index 7d9617985..81d264369 100644 --- a/lapack-netlib/SRC/dsbevd_2stage.c +++ b/lapack-netlib/SRC/dsbevd_2stage.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dsbevx.c b/lapack-netlib/SRC/dsbevx.c index 61e687d3e..b6af5a846 100644 --- a/lapack-netlib/SRC/dsbevx.c +++ b/lapack-netlib/SRC/dsbevx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dsbevx_2stage.c b/lapack-netlib/SRC/dsbevx_2stage.c index cea4ec24c..0be5ca2a4 100644 --- a/lapack-netlib/SRC/dsbevx_2stage.c +++ b/lapack-netlib/SRC/dsbevx_2stage.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dsbgst.c b/lapack-netlib/SRC/dsbgst.c index ff5565603..85b6728cc 100644 --- a/lapack-netlib/SRC/dsbgst.c +++ b/lapack-netlib/SRC/dsbgst.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dsbgv.c b/lapack-netlib/SRC/dsbgv.c index 149689762..2dc0ed571 100644 --- a/lapack-netlib/SRC/dsbgv.c +++ b/lapack-netlib/SRC/dsbgv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dsbgvd.c b/lapack-netlib/SRC/dsbgvd.c index c8274131f..14e02dcba 100644 --- a/lapack-netlib/SRC/dsbgvd.c +++ b/lapack-netlib/SRC/dsbgvd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dsbgvx.c b/lapack-netlib/SRC/dsbgvx.c index d5422073d..4e14053ba 100644 --- a/lapack-netlib/SRC/dsbgvx.c +++ b/lapack-netlib/SRC/dsbgvx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dsbtrd.c b/lapack-netlib/SRC/dsbtrd.c index 91da67f14..b2cede310 100644 --- a/lapack-netlib/SRC/dsbtrd.c +++ b/lapack-netlib/SRC/dsbtrd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dsfrk.c b/lapack-netlib/SRC/dsfrk.c index d31002e1e..ab2d29a1b 100644 --- a/lapack-netlib/SRC/dsfrk.c +++ b/lapack-netlib/SRC/dsfrk.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dsgesv.c b/lapack-netlib/SRC/dsgesv.c index 049fd25d8..367a271b0 100644 --- a/lapack-netlib/SRC/dsgesv.c +++ b/lapack-netlib/SRC/dsgesv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dspcon.c b/lapack-netlib/SRC/dspcon.c index 1ae028787..a5238a768 100644 --- a/lapack-netlib/SRC/dspcon.c +++ b/lapack-netlib/SRC/dspcon.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dspev.c b/lapack-netlib/SRC/dspev.c index aa0b6bf8c..03a2fa667 100644 --- a/lapack-netlib/SRC/dspev.c +++ b/lapack-netlib/SRC/dspev.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dspevd.c b/lapack-netlib/SRC/dspevd.c index e674f18b0..8ad1fa09a 100644 --- a/lapack-netlib/SRC/dspevd.c +++ b/lapack-netlib/SRC/dspevd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dspevx.c b/lapack-netlib/SRC/dspevx.c index 92ea4ac6d..0a96afb4a 100644 --- a/lapack-netlib/SRC/dspevx.c +++ b/lapack-netlib/SRC/dspevx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dspgst.c b/lapack-netlib/SRC/dspgst.c index 3fd0c23c1..482ebfcc5 100644 --- a/lapack-netlib/SRC/dspgst.c +++ b/lapack-netlib/SRC/dspgst.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dspgv.c b/lapack-netlib/SRC/dspgv.c index be8b6d322..e6af4016b 100644 --- a/lapack-netlib/SRC/dspgv.c +++ b/lapack-netlib/SRC/dspgv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dspgvd.c b/lapack-netlib/SRC/dspgvd.c index 3927df724..298410c14 100644 --- a/lapack-netlib/SRC/dspgvd.c +++ b/lapack-netlib/SRC/dspgvd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dspgvx.c b/lapack-netlib/SRC/dspgvx.c index b02296c2c..210390e30 100644 --- a/lapack-netlib/SRC/dspgvx.c +++ b/lapack-netlib/SRC/dspgvx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dsposv.c b/lapack-netlib/SRC/dsposv.c index 3e0f26533..faa71a702 100644 --- a/lapack-netlib/SRC/dsposv.c +++ b/lapack-netlib/SRC/dsposv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dsprfs.c b/lapack-netlib/SRC/dsprfs.c index 520916c6a..2d54f662e 100644 --- a/lapack-netlib/SRC/dsprfs.c +++ b/lapack-netlib/SRC/dsprfs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dspsv.c b/lapack-netlib/SRC/dspsv.c index c98c5229d..ef323c69f 100644 --- a/lapack-netlib/SRC/dspsv.c +++ b/lapack-netlib/SRC/dspsv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dspsvx.c b/lapack-netlib/SRC/dspsvx.c index 41bfe98f8..7e98571b7 100644 --- a/lapack-netlib/SRC/dspsvx.c +++ b/lapack-netlib/SRC/dspsvx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dsptrd.c b/lapack-netlib/SRC/dsptrd.c index d613b5799..3271da0ab 100644 --- a/lapack-netlib/SRC/dsptrd.c +++ b/lapack-netlib/SRC/dsptrd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dsptrf.c b/lapack-netlib/SRC/dsptrf.c index 6040c539d..601a320c4 100644 --- a/lapack-netlib/SRC/dsptrf.c +++ b/lapack-netlib/SRC/dsptrf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dsptri.c b/lapack-netlib/SRC/dsptri.c index 2ecb43c46..b0f19e682 100644 --- a/lapack-netlib/SRC/dsptri.c +++ b/lapack-netlib/SRC/dsptri.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dsptrs.c b/lapack-netlib/SRC/dsptrs.c index c31a7c796..97c9c1b1d 100644 --- a/lapack-netlib/SRC/dsptrs.c +++ b/lapack-netlib/SRC/dsptrs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dstebz.c b/lapack-netlib/SRC/dstebz.c index 608ebe510..9e01c2ae2 100644 --- a/lapack-netlib/SRC/dstebz.c +++ b/lapack-netlib/SRC/dstebz.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dstedc.c b/lapack-netlib/SRC/dstedc.c index cd3ba9a66..202bc3bff 100644 --- a/lapack-netlib/SRC/dstedc.c +++ b/lapack-netlib/SRC/dstedc.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dstegr.c b/lapack-netlib/SRC/dstegr.c index d64c439ae..9a8784cae 100644 --- a/lapack-netlib/SRC/dstegr.c +++ b/lapack-netlib/SRC/dstegr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dstein.c b/lapack-netlib/SRC/dstein.c index a916d8ad1..ced21fa70 100644 --- a/lapack-netlib/SRC/dstein.c +++ b/lapack-netlib/SRC/dstein.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dstemr.c b/lapack-netlib/SRC/dstemr.c index 42b58bf61..370057b05 100644 --- a/lapack-netlib/SRC/dstemr.c +++ b/lapack-netlib/SRC/dstemr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dsteqr.c b/lapack-netlib/SRC/dsteqr.c index d1140bea6..a80ce01d2 100644 --- a/lapack-netlib/SRC/dsteqr.c +++ b/lapack-netlib/SRC/dsteqr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dsterf.c b/lapack-netlib/SRC/dsterf.c index 090c50b61..236b0044b 100644 --- a/lapack-netlib/SRC/dsterf.c +++ b/lapack-netlib/SRC/dsterf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dstev.c b/lapack-netlib/SRC/dstev.c index 00ab2cfe0..ac1edf83f 100644 --- a/lapack-netlib/SRC/dstev.c +++ b/lapack-netlib/SRC/dstev.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dstevd.c b/lapack-netlib/SRC/dstevd.c index cf2f30eac..b00505d3f 100644 --- a/lapack-netlib/SRC/dstevd.c +++ b/lapack-netlib/SRC/dstevd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dstevr.c b/lapack-netlib/SRC/dstevr.c index e5fbbdae4..00631d84c 100644 --- a/lapack-netlib/SRC/dstevr.c +++ b/lapack-netlib/SRC/dstevr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dstevx.c b/lapack-netlib/SRC/dstevx.c index 1febd23eb..24f73ae20 100644 --- a/lapack-netlib/SRC/dstevx.c +++ b/lapack-netlib/SRC/dstevx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dsycon.c b/lapack-netlib/SRC/dsycon.c index 751cd076d..ae6aefaff 100644 --- a/lapack-netlib/SRC/dsycon.c +++ b/lapack-netlib/SRC/dsycon.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dsycon_3.c b/lapack-netlib/SRC/dsycon_3.c index 9f9cb0039..96ecffc68 100644 --- a/lapack-netlib/SRC/dsycon_3.c +++ b/lapack-netlib/SRC/dsycon_3.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dsycon_rook.c b/lapack-netlib/SRC/dsycon_rook.c index c339fc39c..7d78a0775 100644 --- a/lapack-netlib/SRC/dsycon_rook.c +++ b/lapack-netlib/SRC/dsycon_rook.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dsyconv.c b/lapack-netlib/SRC/dsyconv.c index 192321ef6..441680978 100644 --- a/lapack-netlib/SRC/dsyconv.c +++ b/lapack-netlib/SRC/dsyconv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dsyconvf.c b/lapack-netlib/SRC/dsyconvf.c index 3947a6b56..917e46686 100644 --- a/lapack-netlib/SRC/dsyconvf.c +++ b/lapack-netlib/SRC/dsyconvf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dsyconvf_rook.c b/lapack-netlib/SRC/dsyconvf_rook.c index 49b4fcc19..a4e10f0ce 100644 --- a/lapack-netlib/SRC/dsyconvf_rook.c +++ b/lapack-netlib/SRC/dsyconvf_rook.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dsyequb.c b/lapack-netlib/SRC/dsyequb.c index 84cb49886..19c1052a5 100644 --- a/lapack-netlib/SRC/dsyequb.c +++ b/lapack-netlib/SRC/dsyequb.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dsyev.c b/lapack-netlib/SRC/dsyev.c index 50801fc31..d8daa225c 100644 --- a/lapack-netlib/SRC/dsyev.c +++ b/lapack-netlib/SRC/dsyev.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dsyev_2stage.c b/lapack-netlib/SRC/dsyev_2stage.c index 0b9f7283c..b0cfb4994 100644 --- a/lapack-netlib/SRC/dsyev_2stage.c +++ b/lapack-netlib/SRC/dsyev_2stage.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dsyevd.c b/lapack-netlib/SRC/dsyevd.c index 16f71d9b6..9c89a4977 100644 --- a/lapack-netlib/SRC/dsyevd.c +++ b/lapack-netlib/SRC/dsyevd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dsyevd_2stage.c b/lapack-netlib/SRC/dsyevd_2stage.c index a2fdcc74d..0f79f9a51 100644 --- a/lapack-netlib/SRC/dsyevd_2stage.c +++ b/lapack-netlib/SRC/dsyevd_2stage.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dsyevr.c b/lapack-netlib/SRC/dsyevr.c index 6f55b9f42..6ed93d469 100644 --- a/lapack-netlib/SRC/dsyevr.c +++ b/lapack-netlib/SRC/dsyevr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dsyevr_2stage.c b/lapack-netlib/SRC/dsyevr_2stage.c index a706e53f6..a43e1c289 100644 --- a/lapack-netlib/SRC/dsyevr_2stage.c +++ b/lapack-netlib/SRC/dsyevr_2stage.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dsyevx.c b/lapack-netlib/SRC/dsyevx.c index 83927ddec..efdcfa6f2 100644 --- a/lapack-netlib/SRC/dsyevx.c +++ b/lapack-netlib/SRC/dsyevx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dsyevx_2stage.c b/lapack-netlib/SRC/dsyevx_2stage.c index b73bdddfe..6e07042ab 100644 --- a/lapack-netlib/SRC/dsyevx_2stage.c +++ b/lapack-netlib/SRC/dsyevx_2stage.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dsygs2.c b/lapack-netlib/SRC/dsygs2.c index da9ba7b8e..5feb0a120 100644 --- a/lapack-netlib/SRC/dsygs2.c +++ b/lapack-netlib/SRC/dsygs2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dsygst.c b/lapack-netlib/SRC/dsygst.c index b18805b89..6c9cd6969 100644 --- a/lapack-netlib/SRC/dsygst.c +++ b/lapack-netlib/SRC/dsygst.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dsygv.c b/lapack-netlib/SRC/dsygv.c index 21792c93c..d1cafff2f 100644 --- a/lapack-netlib/SRC/dsygv.c +++ b/lapack-netlib/SRC/dsygv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dsygv_2stage.c b/lapack-netlib/SRC/dsygv_2stage.c index 92e12102e..d0c60b15a 100644 --- a/lapack-netlib/SRC/dsygv_2stage.c +++ b/lapack-netlib/SRC/dsygv_2stage.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dsygvd.c b/lapack-netlib/SRC/dsygvd.c index 828399c97..b01f8c904 100644 --- a/lapack-netlib/SRC/dsygvd.c +++ b/lapack-netlib/SRC/dsygvd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dsygvx.c b/lapack-netlib/SRC/dsygvx.c index e5478eea7..4c482f6b7 100644 --- a/lapack-netlib/SRC/dsygvx.c +++ b/lapack-netlib/SRC/dsygvx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dsyrfs.c b/lapack-netlib/SRC/dsyrfs.c index 2503d5f24..27c6751be 100644 --- a/lapack-netlib/SRC/dsyrfs.c +++ b/lapack-netlib/SRC/dsyrfs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dsyrfsx.c b/lapack-netlib/SRC/dsyrfsx.c index 05218fe35..38c70bbfd 100644 --- a/lapack-netlib/SRC/dsyrfsx.c +++ b/lapack-netlib/SRC/dsyrfsx.c @@ -54,8 +54,8 @@ static inline _Complex float * _pCf(complex *z) {return (_Complex float*)z;} static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double*)z;} #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -257,7 +257,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dsysv.c b/lapack-netlib/SRC/dsysv.c index 802c9c4cc..181189538 100644 --- a/lapack-netlib/SRC/dsysv.c +++ b/lapack-netlib/SRC/dsysv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dsysv_aa.c b/lapack-netlib/SRC/dsysv_aa.c index e01611764..9b19f3bb2 100644 --- a/lapack-netlib/SRC/dsysv_aa.c +++ b/lapack-netlib/SRC/dsysv_aa.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dsysv_aa_2stage.c b/lapack-netlib/SRC/dsysv_aa_2stage.c index 16e3dcbc8..5612cb9fc 100644 --- a/lapack-netlib/SRC/dsysv_aa_2stage.c +++ b/lapack-netlib/SRC/dsysv_aa_2stage.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dsysv_rk.c b/lapack-netlib/SRC/dsysv_rk.c index 76c3fd48b..d781d3f13 100644 --- a/lapack-netlib/SRC/dsysv_rk.c +++ b/lapack-netlib/SRC/dsysv_rk.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dsysv_rook.c b/lapack-netlib/SRC/dsysv_rook.c index 7d813426f..e1de661bd 100644 --- a/lapack-netlib/SRC/dsysv_rook.c +++ b/lapack-netlib/SRC/dsysv_rook.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dsysvx.c b/lapack-netlib/SRC/dsysvx.c index da5c5ebe3..da83f99f3 100644 --- a/lapack-netlib/SRC/dsysvx.c +++ b/lapack-netlib/SRC/dsysvx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dsysvxx.c b/lapack-netlib/SRC/dsysvxx.c index 66978788a..7ded4a9a1 100644 --- a/lapack-netlib/SRC/dsysvxx.c +++ b/lapack-netlib/SRC/dsysvxx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else From a16adcddd90522198697009aab80b21e7c790c88 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Thu, 4 Apr 2024 00:59:57 +0200 Subject: [PATCH 286/311] fix typedef of logical to support INTERFACE64 --- lapack-netlib/SRC/dorbdb.c | 6 +++--- lapack-netlib/SRC/dorbdb1.c | 6 +++--- lapack-netlib/SRC/dorbdb2.c | 6 +++--- lapack-netlib/SRC/dorbdb3.c | 6 +++--- lapack-netlib/SRC/dorbdb4.c | 6 +++--- lapack-netlib/SRC/dorbdb5.c | 6 +++--- lapack-netlib/SRC/dorbdb6.c | 6 +++--- lapack-netlib/SRC/dorcsd.c | 6 +++--- lapack-netlib/SRC/dorcsd2by1.c | 6 +++--- lapack-netlib/SRC/dorg2l.c | 6 +++--- lapack-netlib/SRC/dorg2r.c | 6 +++--- lapack-netlib/SRC/dorgbr.c | 6 +++--- lapack-netlib/SRC/dorghr.c | 6 +++--- lapack-netlib/SRC/dorgl2.c | 6 +++--- lapack-netlib/SRC/dorglq.c | 6 +++--- lapack-netlib/SRC/dorgql.c | 6 +++--- lapack-netlib/SRC/dorgqr.c | 6 +++--- lapack-netlib/SRC/dorgr2.c | 6 +++--- lapack-netlib/SRC/dorgrq.c | 6 +++--- lapack-netlib/SRC/dorgtr.c | 6 +++--- lapack-netlib/SRC/dorgtsqr.c | 6 +++--- lapack-netlib/SRC/dorgtsqr_row.c | 6 +++--- lapack-netlib/SRC/dorhr_col.c | 6 +++--- lapack-netlib/SRC/dorm22.c | 6 +++--- lapack-netlib/SRC/dorm2l.c | 6 +++--- lapack-netlib/SRC/dorm2r.c | 6 +++--- lapack-netlib/SRC/dormbr.c | 6 +++--- lapack-netlib/SRC/dormhr.c | 6 +++--- lapack-netlib/SRC/dorml2.c | 6 +++--- lapack-netlib/SRC/dormlq.c | 6 +++--- lapack-netlib/SRC/dormql.c | 6 +++--- lapack-netlib/SRC/dormqr.c | 6 +++--- lapack-netlib/SRC/dormr2.c | 6 +++--- lapack-netlib/SRC/dormr3.c | 6 +++--- lapack-netlib/SRC/dormrq.c | 6 +++--- lapack-netlib/SRC/dormrz.c | 6 +++--- lapack-netlib/SRC/dormtr.c | 6 +++--- lapack-netlib/SRC/dpbcon.c | 6 +++--- lapack-netlib/SRC/dpbequ.c | 6 +++--- lapack-netlib/SRC/dpbrfs.c | 6 +++--- lapack-netlib/SRC/dpbstf.c | 6 +++--- lapack-netlib/SRC/dpbsv.c | 6 +++--- lapack-netlib/SRC/dpbsvx.c | 6 +++--- lapack-netlib/SRC/dpbtf2.c | 6 +++--- lapack-netlib/SRC/dpbtrf.c | 6 +++--- lapack-netlib/SRC/dpbtrs.c | 6 +++--- lapack-netlib/SRC/dpftrf.c | 6 +++--- lapack-netlib/SRC/dpftri.c | 6 +++--- lapack-netlib/SRC/dpftrs.c | 6 +++--- lapack-netlib/SRC/dpocon.c | 6 +++--- lapack-netlib/SRC/dpoequ.c | 6 +++--- lapack-netlib/SRC/dpoequb.c | 6 +++--- lapack-netlib/SRC/dporfs.c | 6 +++--- lapack-netlib/SRC/dporfsx.c | 6 +++--- lapack-netlib/SRC/dposv.c | 6 +++--- lapack-netlib/SRC/dposvx.c | 6 +++--- lapack-netlib/SRC/dposvxx.c | 6 +++--- lapack-netlib/SRC/dpotf2.c | 6 +++--- 58 files changed, 174 insertions(+), 174 deletions(-) diff --git a/lapack-netlib/SRC/dorbdb.c b/lapack-netlib/SRC/dorbdb.c index b59b35b4f..2877b38ff 100644 --- a/lapack-netlib/SRC/dorbdb.c +++ b/lapack-netlib/SRC/dorbdb.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dorbdb1.c b/lapack-netlib/SRC/dorbdb1.c index dbca828da..28dc9bfed 100644 --- a/lapack-netlib/SRC/dorbdb1.c +++ b/lapack-netlib/SRC/dorbdb1.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dorbdb2.c b/lapack-netlib/SRC/dorbdb2.c index 3ebea93b2..e2a584cf4 100644 --- a/lapack-netlib/SRC/dorbdb2.c +++ b/lapack-netlib/SRC/dorbdb2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dorbdb3.c b/lapack-netlib/SRC/dorbdb3.c index a22ac718f..03684bc04 100644 --- a/lapack-netlib/SRC/dorbdb3.c +++ b/lapack-netlib/SRC/dorbdb3.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dorbdb4.c b/lapack-netlib/SRC/dorbdb4.c index d53ff709c..82ba1da7e 100644 --- a/lapack-netlib/SRC/dorbdb4.c +++ b/lapack-netlib/SRC/dorbdb4.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dorbdb5.c b/lapack-netlib/SRC/dorbdb5.c index 891153fcc..bc4d81a30 100644 --- a/lapack-netlib/SRC/dorbdb5.c +++ b/lapack-netlib/SRC/dorbdb5.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dorbdb6.c b/lapack-netlib/SRC/dorbdb6.c index 70f1b4638..74efea464 100644 --- a/lapack-netlib/SRC/dorbdb6.c +++ b/lapack-netlib/SRC/dorbdb6.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dorcsd.c b/lapack-netlib/SRC/dorcsd.c index a25001fb1..d6ad241e2 100644 --- a/lapack-netlib/SRC/dorcsd.c +++ b/lapack-netlib/SRC/dorcsd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dorcsd2by1.c b/lapack-netlib/SRC/dorcsd2by1.c index fc44e083b..2fedb3593 100644 --- a/lapack-netlib/SRC/dorcsd2by1.c +++ b/lapack-netlib/SRC/dorcsd2by1.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dorg2l.c b/lapack-netlib/SRC/dorg2l.c index d10fb0023..0a6682127 100644 --- a/lapack-netlib/SRC/dorg2l.c +++ b/lapack-netlib/SRC/dorg2l.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dorg2r.c b/lapack-netlib/SRC/dorg2r.c index af2e98452..f1a018166 100644 --- a/lapack-netlib/SRC/dorg2r.c +++ b/lapack-netlib/SRC/dorg2r.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dorgbr.c b/lapack-netlib/SRC/dorgbr.c index 35697354b..bbf22f097 100644 --- a/lapack-netlib/SRC/dorgbr.c +++ b/lapack-netlib/SRC/dorgbr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dorghr.c b/lapack-netlib/SRC/dorghr.c index b95d45875..ad870a4a6 100644 --- a/lapack-netlib/SRC/dorghr.c +++ b/lapack-netlib/SRC/dorghr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dorgl2.c b/lapack-netlib/SRC/dorgl2.c index 6059146e6..7c566e868 100644 --- a/lapack-netlib/SRC/dorgl2.c +++ b/lapack-netlib/SRC/dorgl2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dorglq.c b/lapack-netlib/SRC/dorglq.c index 09b943728..ebc9aba10 100644 --- a/lapack-netlib/SRC/dorglq.c +++ b/lapack-netlib/SRC/dorglq.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dorgql.c b/lapack-netlib/SRC/dorgql.c index 374ee65a8..f6652f70a 100644 --- a/lapack-netlib/SRC/dorgql.c +++ b/lapack-netlib/SRC/dorgql.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dorgqr.c b/lapack-netlib/SRC/dorgqr.c index 518d410b3..350727c1b 100644 --- a/lapack-netlib/SRC/dorgqr.c +++ b/lapack-netlib/SRC/dorgqr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dorgr2.c b/lapack-netlib/SRC/dorgr2.c index afc3fa7ba..874e40450 100644 --- a/lapack-netlib/SRC/dorgr2.c +++ b/lapack-netlib/SRC/dorgr2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dorgrq.c b/lapack-netlib/SRC/dorgrq.c index fa3a054b6..ab4d2ff44 100644 --- a/lapack-netlib/SRC/dorgrq.c +++ b/lapack-netlib/SRC/dorgrq.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dorgtr.c b/lapack-netlib/SRC/dorgtr.c index d2cdcee02..e4dd0cde5 100644 --- a/lapack-netlib/SRC/dorgtr.c +++ b/lapack-netlib/SRC/dorgtr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dorgtsqr.c b/lapack-netlib/SRC/dorgtsqr.c index e0d43d9f8..1afb88cd0 100644 --- a/lapack-netlib/SRC/dorgtsqr.c +++ b/lapack-netlib/SRC/dorgtsqr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dorgtsqr_row.c b/lapack-netlib/SRC/dorgtsqr_row.c index 6bb13f718..e91896e22 100644 --- a/lapack-netlib/SRC/dorgtsqr_row.c +++ b/lapack-netlib/SRC/dorgtsqr_row.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dorhr_col.c b/lapack-netlib/SRC/dorhr_col.c index 03f00b789..4d6106688 100644 --- a/lapack-netlib/SRC/dorhr_col.c +++ b/lapack-netlib/SRC/dorhr_col.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dorm22.c b/lapack-netlib/SRC/dorm22.c index 9f3b9bf32..8bf24ec2d 100644 --- a/lapack-netlib/SRC/dorm22.c +++ b/lapack-netlib/SRC/dorm22.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dorm2l.c b/lapack-netlib/SRC/dorm2l.c index 9d62a36d5..c05d21b07 100644 --- a/lapack-netlib/SRC/dorm2l.c +++ b/lapack-netlib/SRC/dorm2l.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dorm2r.c b/lapack-netlib/SRC/dorm2r.c index 7ad7af7df..126a1b2fb 100644 --- a/lapack-netlib/SRC/dorm2r.c +++ b/lapack-netlib/SRC/dorm2r.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dormbr.c b/lapack-netlib/SRC/dormbr.c index ba3a607da..0533ab8a5 100644 --- a/lapack-netlib/SRC/dormbr.c +++ b/lapack-netlib/SRC/dormbr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dormhr.c b/lapack-netlib/SRC/dormhr.c index 25f949cb9..10eaf1504 100644 --- a/lapack-netlib/SRC/dormhr.c +++ b/lapack-netlib/SRC/dormhr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dorml2.c b/lapack-netlib/SRC/dorml2.c index a9882d627..c60d9cb62 100644 --- a/lapack-netlib/SRC/dorml2.c +++ b/lapack-netlib/SRC/dorml2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dormlq.c b/lapack-netlib/SRC/dormlq.c index ac319e054..e13d28368 100644 --- a/lapack-netlib/SRC/dormlq.c +++ b/lapack-netlib/SRC/dormlq.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dormql.c b/lapack-netlib/SRC/dormql.c index 3d421e212..9f7b05a72 100644 --- a/lapack-netlib/SRC/dormql.c +++ b/lapack-netlib/SRC/dormql.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dormqr.c b/lapack-netlib/SRC/dormqr.c index 45281d776..dedb25594 100644 --- a/lapack-netlib/SRC/dormqr.c +++ b/lapack-netlib/SRC/dormqr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dormr2.c b/lapack-netlib/SRC/dormr2.c index dbb930ac0..e1a9ce61c 100644 --- a/lapack-netlib/SRC/dormr2.c +++ b/lapack-netlib/SRC/dormr2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dormr3.c b/lapack-netlib/SRC/dormr3.c index ba19bfd26..cbccaf9a3 100644 --- a/lapack-netlib/SRC/dormr3.c +++ b/lapack-netlib/SRC/dormr3.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dormrq.c b/lapack-netlib/SRC/dormrq.c index 09f8dc535..6eba4abee 100644 --- a/lapack-netlib/SRC/dormrq.c +++ b/lapack-netlib/SRC/dormrq.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dormrz.c b/lapack-netlib/SRC/dormrz.c index ae00e8c9b..f6d5d7d32 100644 --- a/lapack-netlib/SRC/dormrz.c +++ b/lapack-netlib/SRC/dormrz.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dormtr.c b/lapack-netlib/SRC/dormtr.c index 6d9b2ef79..2c4b22501 100644 --- a/lapack-netlib/SRC/dormtr.c +++ b/lapack-netlib/SRC/dormtr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dpbcon.c b/lapack-netlib/SRC/dpbcon.c index 09fd9b862..9187fa645 100644 --- a/lapack-netlib/SRC/dpbcon.c +++ b/lapack-netlib/SRC/dpbcon.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dpbequ.c b/lapack-netlib/SRC/dpbequ.c index 97fc2189a..a96a9d12c 100644 --- a/lapack-netlib/SRC/dpbequ.c +++ b/lapack-netlib/SRC/dpbequ.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dpbrfs.c b/lapack-netlib/SRC/dpbrfs.c index 1878fd546..2356c3121 100644 --- a/lapack-netlib/SRC/dpbrfs.c +++ b/lapack-netlib/SRC/dpbrfs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dpbstf.c b/lapack-netlib/SRC/dpbstf.c index 754af635f..f7b87adca 100644 --- a/lapack-netlib/SRC/dpbstf.c +++ b/lapack-netlib/SRC/dpbstf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dpbsv.c b/lapack-netlib/SRC/dpbsv.c index 48a660933..67012d5ca 100644 --- a/lapack-netlib/SRC/dpbsv.c +++ b/lapack-netlib/SRC/dpbsv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dpbsvx.c b/lapack-netlib/SRC/dpbsvx.c index 91314848d..8b051fb19 100644 --- a/lapack-netlib/SRC/dpbsvx.c +++ b/lapack-netlib/SRC/dpbsvx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dpbtf2.c b/lapack-netlib/SRC/dpbtf2.c index d7cac9cbf..79521c990 100644 --- a/lapack-netlib/SRC/dpbtf2.c +++ b/lapack-netlib/SRC/dpbtf2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dpbtrf.c b/lapack-netlib/SRC/dpbtrf.c index ecb49b802..f1b90d158 100644 --- a/lapack-netlib/SRC/dpbtrf.c +++ b/lapack-netlib/SRC/dpbtrf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dpbtrs.c b/lapack-netlib/SRC/dpbtrs.c index 02f96e03f..0d1b175ab 100644 --- a/lapack-netlib/SRC/dpbtrs.c +++ b/lapack-netlib/SRC/dpbtrs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dpftrf.c b/lapack-netlib/SRC/dpftrf.c index 1552a222a..883f3dfe8 100644 --- a/lapack-netlib/SRC/dpftrf.c +++ b/lapack-netlib/SRC/dpftrf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dpftri.c b/lapack-netlib/SRC/dpftri.c index df7208a88..0924519ed 100644 --- a/lapack-netlib/SRC/dpftri.c +++ b/lapack-netlib/SRC/dpftri.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dpftrs.c b/lapack-netlib/SRC/dpftrs.c index 4764e86a3..a09b692a0 100644 --- a/lapack-netlib/SRC/dpftrs.c +++ b/lapack-netlib/SRC/dpftrs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dpocon.c b/lapack-netlib/SRC/dpocon.c index 4699fa3a7..e2b373800 100644 --- a/lapack-netlib/SRC/dpocon.c +++ b/lapack-netlib/SRC/dpocon.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dpoequ.c b/lapack-netlib/SRC/dpoequ.c index 95635a7c4..7bc4c50be 100644 --- a/lapack-netlib/SRC/dpoequ.c +++ b/lapack-netlib/SRC/dpoequ.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dpoequb.c b/lapack-netlib/SRC/dpoequb.c index 87b3fbec4..720002316 100644 --- a/lapack-netlib/SRC/dpoequb.c +++ b/lapack-netlib/SRC/dpoequb.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dporfs.c b/lapack-netlib/SRC/dporfs.c index 91ca297f2..933390c97 100644 --- a/lapack-netlib/SRC/dporfs.c +++ b/lapack-netlib/SRC/dporfs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dporfsx.c b/lapack-netlib/SRC/dporfsx.c index 63408560e..ae342a555 100644 --- a/lapack-netlib/SRC/dporfsx.c +++ b/lapack-netlib/SRC/dporfsx.c @@ -54,8 +54,8 @@ static inline _Complex float * _pCf(complex *z) {return (_Complex float*)z;} static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double*)z;} #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -257,7 +257,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dposv.c b/lapack-netlib/SRC/dposv.c index 2e6b5019f..d7c32312e 100644 --- a/lapack-netlib/SRC/dposv.c +++ b/lapack-netlib/SRC/dposv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dposvx.c b/lapack-netlib/SRC/dposvx.c index bd56317d8..3939ad70b 100644 --- a/lapack-netlib/SRC/dposvx.c +++ b/lapack-netlib/SRC/dposvx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dposvxx.c b/lapack-netlib/SRC/dposvxx.c index 9e7eeb14d..b46d77a9d 100644 --- a/lapack-netlib/SRC/dposvxx.c +++ b/lapack-netlib/SRC/dposvxx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dpotf2.c b/lapack-netlib/SRC/dpotf2.c index b6a732841..e5d6750b8 100644 --- a/lapack-netlib/SRC/dpotf2.c +++ b/lapack-netlib/SRC/dpotf2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else From b6440160cec06c118e8782f3e82f2aa0bd385ffd Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Thu, 4 Apr 2024 01:05:35 +0200 Subject: [PATCH 287/311] fix typedef of logical to support INTERFACE64 --- lapack-netlib/SRC/dlaqr0.c | 6 +++--- lapack-netlib/SRC/dlaqr1.c | 6 +++--- lapack-netlib/SRC/dlaqr2.c | 6 +++--- lapack-netlib/SRC/dlaqr3.c | 6 +++--- lapack-netlib/SRC/dlaqr4.c | 6 +++--- lapack-netlib/SRC/dlaqr5.c | 6 +++--- lapack-netlib/SRC/dlaqsb.c | 6 +++--- lapack-netlib/SRC/dlaqsp.c | 6 +++--- lapack-netlib/SRC/dlaqsy.c | 6 +++--- lapack-netlib/SRC/dlaqtr.c | 6 +++--- lapack-netlib/SRC/dlar1v.c | 6 +++--- lapack-netlib/SRC/dlar2v.c | 6 +++--- lapack-netlib/SRC/dlarf.c | 6 +++--- lapack-netlib/SRC/dlarfb.c | 6 +++--- lapack-netlib/SRC/dlarfb_gett.c | 6 +++--- lapack-netlib/SRC/dlarfg.c | 6 +++--- lapack-netlib/SRC/dlarfgp.c | 6 +++--- lapack-netlib/SRC/dlarft.c | 6 +++--- lapack-netlib/SRC/dlarfx.c | 6 +++--- lapack-netlib/SRC/dlarfy.c | 6 +++--- lapack-netlib/SRC/dlargv.c | 6 +++--- lapack-netlib/SRC/dlarmm.c | 6 +++--- lapack-netlib/SRC/dlarnv.c | 6 +++--- lapack-netlib/SRC/dlarra.c | 6 +++--- lapack-netlib/SRC/dlarrb.c | 6 +++--- lapack-netlib/SRC/dlarrc.c | 6 +++--- lapack-netlib/SRC/dlarrd.c | 6 +++--- lapack-netlib/SRC/dlarre.c | 6 +++--- lapack-netlib/SRC/dlarrf.c | 6 +++--- lapack-netlib/SRC/dlarrj.c | 6 +++--- lapack-netlib/SRC/dlarrk.c | 6 +++--- lapack-netlib/SRC/dlarrr.c | 6 +++--- lapack-netlib/SRC/dlarrv.c | 6 +++--- lapack-netlib/SRC/dlarscl2.c | 6 +++--- lapack-netlib/SRC/dlartg.c | 6 +++--- lapack-netlib/SRC/dlartgp.c | 6 +++--- lapack-netlib/SRC/dlartgs.c | 6 +++--- lapack-netlib/SRC/dlartv.c | 6 +++--- lapack-netlib/SRC/dlaruv.c | 6 +++--- lapack-netlib/SRC/dlarz.c | 6 +++--- lapack-netlib/SRC/dlarzb.c | 6 +++--- lapack-netlib/SRC/dlarzt.c | 6 +++--- lapack-netlib/SRC/dlas2.c | 6 +++--- lapack-netlib/SRC/dlascl.c | 6 +++--- lapack-netlib/SRC/dlascl2.c | 6 +++--- lapack-netlib/SRC/dlasd0.c | 6 +++--- lapack-netlib/SRC/dlasd1.c | 6 +++--- lapack-netlib/SRC/dlasd2.c | 6 +++--- lapack-netlib/SRC/dlasd3.c | 6 +++--- lapack-netlib/SRC/dlasd4.c | 6 +++--- lapack-netlib/SRC/dlasd5.c | 6 +++--- lapack-netlib/SRC/dlasd6.c | 6 +++--- lapack-netlib/SRC/dlasd7.c | 6 +++--- lapack-netlib/SRC/dlasd8.c | 6 +++--- lapack-netlib/SRC/dlasda.c | 6 +++--- lapack-netlib/SRC/dlasdq.c | 6 +++--- lapack-netlib/SRC/dlasdt.c | 6 +++--- lapack-netlib/SRC/dlaset.c | 6 +++--- lapack-netlib/SRC/dlasq1.c | 6 +++--- lapack-netlib/SRC/dlasq2.c | 6 +++--- lapack-netlib/SRC/dlasq3.c | 6 +++--- lapack-netlib/SRC/dlasq4.c | 6 +++--- lapack-netlib/SRC/dlasq5.c | 6 +++--- lapack-netlib/SRC/dlasq6.c | 6 +++--- lapack-netlib/SRC/dlasr.c | 6 +++--- lapack-netlib/SRC/dlasrt.c | 6 +++--- lapack-netlib/SRC/dlassq.c | 6 +++--- lapack-netlib/SRC/dlasv2.c | 6 +++--- lapack-netlib/SRC/dlaswlq.c | 6 +++--- lapack-netlib/SRC/dlaswp.c | 6 +++--- lapack-netlib/SRC/dlasy2.c | 6 +++--- lapack-netlib/SRC/dlasyf.c | 6 +++--- lapack-netlib/SRC/dlasyf_aa.c | 6 +++--- lapack-netlib/SRC/dlasyf_rk.c | 6 +++--- lapack-netlib/SRC/dlasyf_rook.c | 6 +++--- lapack-netlib/SRC/dlat2s.c | 6 +++--- lapack-netlib/SRC/dlatbs.c | 6 +++--- lapack-netlib/SRC/dlatdf.c | 6 +++--- lapack-netlib/SRC/dlatps.c | 6 +++--- lapack-netlib/SRC/dlatrd.c | 6 +++--- lapack-netlib/SRC/dlatrs.c | 6 +++--- lapack-netlib/SRC/dlatrs3.c | 6 +++--- lapack-netlib/SRC/dlatrz.c | 6 +++--- lapack-netlib/SRC/dlatsqr.c | 6 +++--- lapack-netlib/SRC/dlauu2.c | 6 +++--- lapack-netlib/SRC/dlauum.c | 6 +++--- lapack-netlib/SRC/dopgtr.c | 6 +++--- lapack-netlib/SRC/dopmtr.c | 6 +++--- 88 files changed, 264 insertions(+), 264 deletions(-) diff --git a/lapack-netlib/SRC/dlaqr0.c b/lapack-netlib/SRC/dlaqr0.c index 5b3ae7779..8d29a06f8 100644 --- a/lapack-netlib/SRC/dlaqr0.c +++ b/lapack-netlib/SRC/dlaqr0.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlaqr1.c b/lapack-netlib/SRC/dlaqr1.c index b878f8c31..a6b9302ca 100644 --- a/lapack-netlib/SRC/dlaqr1.c +++ b/lapack-netlib/SRC/dlaqr1.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlaqr2.c b/lapack-netlib/SRC/dlaqr2.c index 783a1e5d3..a6d30436c 100644 --- a/lapack-netlib/SRC/dlaqr2.c +++ b/lapack-netlib/SRC/dlaqr2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlaqr3.c b/lapack-netlib/SRC/dlaqr3.c index f88c8cb2c..2babd45a6 100644 --- a/lapack-netlib/SRC/dlaqr3.c +++ b/lapack-netlib/SRC/dlaqr3.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlaqr4.c b/lapack-netlib/SRC/dlaqr4.c index f267f5aae..c6244a4d7 100644 --- a/lapack-netlib/SRC/dlaqr4.c +++ b/lapack-netlib/SRC/dlaqr4.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlaqr5.c b/lapack-netlib/SRC/dlaqr5.c index 939c4378e..4bff71ce7 100644 --- a/lapack-netlib/SRC/dlaqr5.c +++ b/lapack-netlib/SRC/dlaqr5.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlaqsb.c b/lapack-netlib/SRC/dlaqsb.c index 55eb4420e..1c59b3103 100644 --- a/lapack-netlib/SRC/dlaqsb.c +++ b/lapack-netlib/SRC/dlaqsb.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlaqsp.c b/lapack-netlib/SRC/dlaqsp.c index ad7861aa3..c44212209 100644 --- a/lapack-netlib/SRC/dlaqsp.c +++ b/lapack-netlib/SRC/dlaqsp.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlaqsy.c b/lapack-netlib/SRC/dlaqsy.c index 8c144b04f..eb7d22d79 100644 --- a/lapack-netlib/SRC/dlaqsy.c +++ b/lapack-netlib/SRC/dlaqsy.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlaqtr.c b/lapack-netlib/SRC/dlaqtr.c index 1a91df092..c44a307dd 100644 --- a/lapack-netlib/SRC/dlaqtr.c +++ b/lapack-netlib/SRC/dlaqtr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlar1v.c b/lapack-netlib/SRC/dlar1v.c index 221c7f8c4..d2d07f8dd 100644 --- a/lapack-netlib/SRC/dlar1v.c +++ b/lapack-netlib/SRC/dlar1v.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlar2v.c b/lapack-netlib/SRC/dlar2v.c index d7096f009..31312ba4b 100644 --- a/lapack-netlib/SRC/dlar2v.c +++ b/lapack-netlib/SRC/dlar2v.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlarf.c b/lapack-netlib/SRC/dlarf.c index 5bb376a82..910ae8d78 100644 --- a/lapack-netlib/SRC/dlarf.c +++ b/lapack-netlib/SRC/dlarf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlarfb.c b/lapack-netlib/SRC/dlarfb.c index b04824a31..51f4599bc 100644 --- a/lapack-netlib/SRC/dlarfb.c +++ b/lapack-netlib/SRC/dlarfb.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlarfb_gett.c b/lapack-netlib/SRC/dlarfb_gett.c index 232d12b23..8ff3e8bc0 100644 --- a/lapack-netlib/SRC/dlarfb_gett.c +++ b/lapack-netlib/SRC/dlarfb_gett.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlarfg.c b/lapack-netlib/SRC/dlarfg.c index 24995a5e1..d115b6085 100644 --- a/lapack-netlib/SRC/dlarfg.c +++ b/lapack-netlib/SRC/dlarfg.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlarfgp.c b/lapack-netlib/SRC/dlarfgp.c index 04073a559..c636cfd45 100644 --- a/lapack-netlib/SRC/dlarfgp.c +++ b/lapack-netlib/SRC/dlarfgp.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlarft.c b/lapack-netlib/SRC/dlarft.c index b5e2c542c..65ce8807f 100644 --- a/lapack-netlib/SRC/dlarft.c +++ b/lapack-netlib/SRC/dlarft.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlarfx.c b/lapack-netlib/SRC/dlarfx.c index 1d5400d10..6adaeefea 100644 --- a/lapack-netlib/SRC/dlarfx.c +++ b/lapack-netlib/SRC/dlarfx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlarfy.c b/lapack-netlib/SRC/dlarfy.c index 3101bd5dd..c8011ee8e 100644 --- a/lapack-netlib/SRC/dlarfy.c +++ b/lapack-netlib/SRC/dlarfy.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlargv.c b/lapack-netlib/SRC/dlargv.c index 944e3e241..b9402db4e 100644 --- a/lapack-netlib/SRC/dlargv.c +++ b/lapack-netlib/SRC/dlargv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlarmm.c b/lapack-netlib/SRC/dlarmm.c index eec5d143a..45f16c25c 100644 --- a/lapack-netlib/SRC/dlarmm.c +++ b/lapack-netlib/SRC/dlarmm.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -263,7 +263,7 @@ static int my_expfunc(double *x) {int e; (void)frexp(*x,&e); return e;} /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlarnv.c b/lapack-netlib/SRC/dlarnv.c index c5f3ca408..2fd62d1dd 100644 --- a/lapack-netlib/SRC/dlarnv.c +++ b/lapack-netlib/SRC/dlarnv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlarra.c b/lapack-netlib/SRC/dlarra.c index 9b41fec62..13842b367 100644 --- a/lapack-netlib/SRC/dlarra.c +++ b/lapack-netlib/SRC/dlarra.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlarrb.c b/lapack-netlib/SRC/dlarrb.c index cdf261b4c..7fb9dda4e 100644 --- a/lapack-netlib/SRC/dlarrb.c +++ b/lapack-netlib/SRC/dlarrb.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlarrc.c b/lapack-netlib/SRC/dlarrc.c index c2e3c4054..b5d9d5e04 100644 --- a/lapack-netlib/SRC/dlarrc.c +++ b/lapack-netlib/SRC/dlarrc.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlarrd.c b/lapack-netlib/SRC/dlarrd.c index 89c51279f..67d0c9513 100644 --- a/lapack-netlib/SRC/dlarrd.c +++ b/lapack-netlib/SRC/dlarrd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlarre.c b/lapack-netlib/SRC/dlarre.c index 367cf1d0b..0b2f4d9b1 100644 --- a/lapack-netlib/SRC/dlarre.c +++ b/lapack-netlib/SRC/dlarre.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlarrf.c b/lapack-netlib/SRC/dlarrf.c index 82e631d54..cf637e2b1 100644 --- a/lapack-netlib/SRC/dlarrf.c +++ b/lapack-netlib/SRC/dlarrf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlarrj.c b/lapack-netlib/SRC/dlarrj.c index 1a45ffda6..e8c5ede0f 100644 --- a/lapack-netlib/SRC/dlarrj.c +++ b/lapack-netlib/SRC/dlarrj.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlarrk.c b/lapack-netlib/SRC/dlarrk.c index 73258f5eb..b12b1c080 100644 --- a/lapack-netlib/SRC/dlarrk.c +++ b/lapack-netlib/SRC/dlarrk.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlarrr.c b/lapack-netlib/SRC/dlarrr.c index f27afc862..253e880d9 100644 --- a/lapack-netlib/SRC/dlarrr.c +++ b/lapack-netlib/SRC/dlarrr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlarrv.c b/lapack-netlib/SRC/dlarrv.c index d9d672554..b3cbffb80 100644 --- a/lapack-netlib/SRC/dlarrv.c +++ b/lapack-netlib/SRC/dlarrv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlarscl2.c b/lapack-netlib/SRC/dlarscl2.c index 5a34dfaf0..b42564371 100644 --- a/lapack-netlib/SRC/dlarscl2.c +++ b/lapack-netlib/SRC/dlarscl2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlartg.c b/lapack-netlib/SRC/dlartg.c index c4e3889b1..1062abf72 100644 --- a/lapack-netlib/SRC/dlartg.c +++ b/lapack-netlib/SRC/dlartg.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlartgp.c b/lapack-netlib/SRC/dlartgp.c index 6bdb30f95..97451769f 100644 --- a/lapack-netlib/SRC/dlartgp.c +++ b/lapack-netlib/SRC/dlartgp.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlartgs.c b/lapack-netlib/SRC/dlartgs.c index e99526275..8d903a289 100644 --- a/lapack-netlib/SRC/dlartgs.c +++ b/lapack-netlib/SRC/dlartgs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlartv.c b/lapack-netlib/SRC/dlartv.c index e5dc6e61b..040e39bb9 100644 --- a/lapack-netlib/SRC/dlartv.c +++ b/lapack-netlib/SRC/dlartv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlaruv.c b/lapack-netlib/SRC/dlaruv.c index c6a996a4b..2776b844d 100644 --- a/lapack-netlib/SRC/dlaruv.c +++ b/lapack-netlib/SRC/dlaruv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlarz.c b/lapack-netlib/SRC/dlarz.c index 611daefd8..2d8910b27 100644 --- a/lapack-netlib/SRC/dlarz.c +++ b/lapack-netlib/SRC/dlarz.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlarzb.c b/lapack-netlib/SRC/dlarzb.c index 61ca61992..0b076a5bb 100644 --- a/lapack-netlib/SRC/dlarzb.c +++ b/lapack-netlib/SRC/dlarzb.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlarzt.c b/lapack-netlib/SRC/dlarzt.c index fd508cb5d..cd798dbc6 100644 --- a/lapack-netlib/SRC/dlarzt.c +++ b/lapack-netlib/SRC/dlarzt.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlas2.c b/lapack-netlib/SRC/dlas2.c index 4090a4da7..af3f68219 100644 --- a/lapack-netlib/SRC/dlas2.c +++ b/lapack-netlib/SRC/dlas2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlascl.c b/lapack-netlib/SRC/dlascl.c index 87d6903b7..28af8c810 100644 --- a/lapack-netlib/SRC/dlascl.c +++ b/lapack-netlib/SRC/dlascl.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlascl2.c b/lapack-netlib/SRC/dlascl2.c index b677a534e..8b89b010c 100644 --- a/lapack-netlib/SRC/dlascl2.c +++ b/lapack-netlib/SRC/dlascl2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlasd0.c b/lapack-netlib/SRC/dlasd0.c index fdc8be7d4..d600d7cd0 100644 --- a/lapack-netlib/SRC/dlasd0.c +++ b/lapack-netlib/SRC/dlasd0.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlasd1.c b/lapack-netlib/SRC/dlasd1.c index c45c2fe7d..f66d89d1e 100644 --- a/lapack-netlib/SRC/dlasd1.c +++ b/lapack-netlib/SRC/dlasd1.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlasd2.c b/lapack-netlib/SRC/dlasd2.c index 457957a06..ee5b9b0b5 100644 --- a/lapack-netlib/SRC/dlasd2.c +++ b/lapack-netlib/SRC/dlasd2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlasd3.c b/lapack-netlib/SRC/dlasd3.c index d4b747295..9003b6e3e 100644 --- a/lapack-netlib/SRC/dlasd3.c +++ b/lapack-netlib/SRC/dlasd3.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlasd4.c b/lapack-netlib/SRC/dlasd4.c index a19c9d997..6d7829c30 100644 --- a/lapack-netlib/SRC/dlasd4.c +++ b/lapack-netlib/SRC/dlasd4.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlasd5.c b/lapack-netlib/SRC/dlasd5.c index aad2836af..3dba30989 100644 --- a/lapack-netlib/SRC/dlasd5.c +++ b/lapack-netlib/SRC/dlasd5.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlasd6.c b/lapack-netlib/SRC/dlasd6.c index 46b1c968e..a9294f331 100644 --- a/lapack-netlib/SRC/dlasd6.c +++ b/lapack-netlib/SRC/dlasd6.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlasd7.c b/lapack-netlib/SRC/dlasd7.c index 6ff2e9f11..ac2ef6785 100644 --- a/lapack-netlib/SRC/dlasd7.c +++ b/lapack-netlib/SRC/dlasd7.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlasd8.c b/lapack-netlib/SRC/dlasd8.c index e3e771c94..63e87febc 100644 --- a/lapack-netlib/SRC/dlasd8.c +++ b/lapack-netlib/SRC/dlasd8.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlasda.c b/lapack-netlib/SRC/dlasda.c index f9993150d..8eea06c57 100644 --- a/lapack-netlib/SRC/dlasda.c +++ b/lapack-netlib/SRC/dlasda.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlasdq.c b/lapack-netlib/SRC/dlasdq.c index 054dabbac..4201b593a 100644 --- a/lapack-netlib/SRC/dlasdq.c +++ b/lapack-netlib/SRC/dlasdq.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlasdt.c b/lapack-netlib/SRC/dlasdt.c index d651ab090..cbf4dd8ec 100644 --- a/lapack-netlib/SRC/dlasdt.c +++ b/lapack-netlib/SRC/dlasdt.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlaset.c b/lapack-netlib/SRC/dlaset.c index 7777c3059..f8d470a9d 100644 --- a/lapack-netlib/SRC/dlaset.c +++ b/lapack-netlib/SRC/dlaset.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlasq1.c b/lapack-netlib/SRC/dlasq1.c index d77f5653e..9618f8518 100644 --- a/lapack-netlib/SRC/dlasq1.c +++ b/lapack-netlib/SRC/dlasq1.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlasq2.c b/lapack-netlib/SRC/dlasq2.c index 4958580f2..0685a0ad8 100644 --- a/lapack-netlib/SRC/dlasq2.c +++ b/lapack-netlib/SRC/dlasq2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlasq3.c b/lapack-netlib/SRC/dlasq3.c index cb65b63e7..c2950da11 100644 --- a/lapack-netlib/SRC/dlasq3.c +++ b/lapack-netlib/SRC/dlasq3.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlasq4.c b/lapack-netlib/SRC/dlasq4.c index ce0322f0b..493f1da6d 100644 --- a/lapack-netlib/SRC/dlasq4.c +++ b/lapack-netlib/SRC/dlasq4.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlasq5.c b/lapack-netlib/SRC/dlasq5.c index cbf6af7e7..3f0fa9aa8 100644 --- a/lapack-netlib/SRC/dlasq5.c +++ b/lapack-netlib/SRC/dlasq5.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlasq6.c b/lapack-netlib/SRC/dlasq6.c index 3dc825211..161f50a4a 100644 --- a/lapack-netlib/SRC/dlasq6.c +++ b/lapack-netlib/SRC/dlasq6.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlasr.c b/lapack-netlib/SRC/dlasr.c index f4fc9cf2b..797d73e18 100644 --- a/lapack-netlib/SRC/dlasr.c +++ b/lapack-netlib/SRC/dlasr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlasrt.c b/lapack-netlib/SRC/dlasrt.c index 256737709..1f196d7b3 100644 --- a/lapack-netlib/SRC/dlasrt.c +++ b/lapack-netlib/SRC/dlasrt.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlassq.c b/lapack-netlib/SRC/dlassq.c index 53f30d4ec..ca0a5e888 100644 --- a/lapack-netlib/SRC/dlassq.c +++ b/lapack-netlib/SRC/dlassq.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlasv2.c b/lapack-netlib/SRC/dlasv2.c index 570f2a111..96541e1d3 100644 --- a/lapack-netlib/SRC/dlasv2.c +++ b/lapack-netlib/SRC/dlasv2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlaswlq.c b/lapack-netlib/SRC/dlaswlq.c index 83c2a0870..b1f5052a5 100644 --- a/lapack-netlib/SRC/dlaswlq.c +++ b/lapack-netlib/SRC/dlaswlq.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlaswp.c b/lapack-netlib/SRC/dlaswp.c index 06ce8e244..5af84589c 100644 --- a/lapack-netlib/SRC/dlaswp.c +++ b/lapack-netlib/SRC/dlaswp.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlasy2.c b/lapack-netlib/SRC/dlasy2.c index 8d48d4d4f..d0b1fdacf 100644 --- a/lapack-netlib/SRC/dlasy2.c +++ b/lapack-netlib/SRC/dlasy2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlasyf.c b/lapack-netlib/SRC/dlasyf.c index b63353a0c..88a38c301 100644 --- a/lapack-netlib/SRC/dlasyf.c +++ b/lapack-netlib/SRC/dlasyf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlasyf_aa.c b/lapack-netlib/SRC/dlasyf_aa.c index 2f4d34f3d..ac0a44169 100644 --- a/lapack-netlib/SRC/dlasyf_aa.c +++ b/lapack-netlib/SRC/dlasyf_aa.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlasyf_rk.c b/lapack-netlib/SRC/dlasyf_rk.c index c38bc9431..13d99c85b 100644 --- a/lapack-netlib/SRC/dlasyf_rk.c +++ b/lapack-netlib/SRC/dlasyf_rk.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlasyf_rook.c b/lapack-netlib/SRC/dlasyf_rook.c index 172e0a7b4..91511ab6f 100644 --- a/lapack-netlib/SRC/dlasyf_rook.c +++ b/lapack-netlib/SRC/dlasyf_rook.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlat2s.c b/lapack-netlib/SRC/dlat2s.c index 27fe21280..5a9671a8e 100644 --- a/lapack-netlib/SRC/dlat2s.c +++ b/lapack-netlib/SRC/dlat2s.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlatbs.c b/lapack-netlib/SRC/dlatbs.c index 98e64489f..75d4c3abb 100644 --- a/lapack-netlib/SRC/dlatbs.c +++ b/lapack-netlib/SRC/dlatbs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlatdf.c b/lapack-netlib/SRC/dlatdf.c index ef0d5c9eb..2bb986e1a 100644 --- a/lapack-netlib/SRC/dlatdf.c +++ b/lapack-netlib/SRC/dlatdf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlatps.c b/lapack-netlib/SRC/dlatps.c index 95446856a..660fa34d8 100644 --- a/lapack-netlib/SRC/dlatps.c +++ b/lapack-netlib/SRC/dlatps.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlatrd.c b/lapack-netlib/SRC/dlatrd.c index d1bf854d2..0d35576f7 100644 --- a/lapack-netlib/SRC/dlatrd.c +++ b/lapack-netlib/SRC/dlatrd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlatrs.c b/lapack-netlib/SRC/dlatrs.c index 13adcdfed..b736049ae 100644 --- a/lapack-netlib/SRC/dlatrs.c +++ b/lapack-netlib/SRC/dlatrs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlatrs3.c b/lapack-netlib/SRC/dlatrs3.c index 4de1f53c3..c6c68a902 100644 --- a/lapack-netlib/SRC/dlatrs3.c +++ b/lapack-netlib/SRC/dlatrs3.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -263,7 +263,7 @@ static int my_expfunc(double *x) {int e; (void)frexp(*x,&e); return e;} /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlatrz.c b/lapack-netlib/SRC/dlatrz.c index 496021ba1..af3b84f1f 100644 --- a/lapack-netlib/SRC/dlatrz.c +++ b/lapack-netlib/SRC/dlatrz.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlatsqr.c b/lapack-netlib/SRC/dlatsqr.c index 52ab4b6ec..28f8fa0e1 100644 --- a/lapack-netlib/SRC/dlatsqr.c +++ b/lapack-netlib/SRC/dlatsqr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlauu2.c b/lapack-netlib/SRC/dlauu2.c index a688bac1d..5c1c399a2 100644 --- a/lapack-netlib/SRC/dlauu2.c +++ b/lapack-netlib/SRC/dlauu2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlauum.c b/lapack-netlib/SRC/dlauum.c index e94f929ff..0181e9327 100644 --- a/lapack-netlib/SRC/dlauum.c +++ b/lapack-netlib/SRC/dlauum.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dopgtr.c b/lapack-netlib/SRC/dopgtr.c index e59efa17d..00028a156 100644 --- a/lapack-netlib/SRC/dopgtr.c +++ b/lapack-netlib/SRC/dopgtr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dopmtr.c b/lapack-netlib/SRC/dopmtr.c index 3497632f8..c50ff8f7a 100644 --- a/lapack-netlib/SRC/dopmtr.c +++ b/lapack-netlib/SRC/dopmtr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else From abea53b46783e67650b8a34eb9f19dc573d8771b Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Thu, 4 Apr 2024 01:11:37 +0200 Subject: [PATCH 288/311] fix typedef of logical to support INTERFACE64 --- lapack-netlib/SRC/dlabad.c | 6 +++--- lapack-netlib/SRC/dlabrd.c | 6 +++--- lapack-netlib/SRC/dlacn2.c | 6 +++--- lapack-netlib/SRC/dlacon.c | 6 +++--- lapack-netlib/SRC/dlacpy.c | 6 +++--- lapack-netlib/SRC/dladiv.c | 6 +++--- lapack-netlib/SRC/dlae2.c | 6 +++--- lapack-netlib/SRC/dlaebz.c | 6 +++--- lapack-netlib/SRC/dlaed0.c | 6 +++--- lapack-netlib/SRC/dlaed1.c | 6 +++--- lapack-netlib/SRC/dlaed2.c | 6 +++--- lapack-netlib/SRC/dlaed3.c | 6 +++--- lapack-netlib/SRC/dlaed4.c | 6 +++--- lapack-netlib/SRC/dlaed5.c | 6 +++--- lapack-netlib/SRC/dlaed6.c | 6 +++--- lapack-netlib/SRC/dlaed7.c | 6 +++--- lapack-netlib/SRC/dlaed8.c | 6 +++--- lapack-netlib/SRC/dlaed9.c | 6 +++--- lapack-netlib/SRC/dlaeda.c | 6 +++--- lapack-netlib/SRC/dlaein.c | 6 +++--- lapack-netlib/SRC/dlaev2.c | 6 +++--- lapack-netlib/SRC/dlaexc.c | 6 +++--- lapack-netlib/SRC/dlag2.c | 6 +++--- lapack-netlib/SRC/dlag2s.c | 6 +++--- lapack-netlib/SRC/dlags2.c | 6 +++--- lapack-netlib/SRC/dlagtf.c | 6 +++--- lapack-netlib/SRC/dlagtm.c | 6 +++--- lapack-netlib/SRC/dlagts.c | 6 +++--- lapack-netlib/SRC/dlagv2.c | 6 +++--- lapack-netlib/SRC/dlahqr.c | 6 +++--- lapack-netlib/SRC/dlahr2.c | 6 +++--- lapack-netlib/SRC/dlaic1.c | 6 +++--- lapack-netlib/SRC/dlaisnan.c | 6 +++--- lapack-netlib/SRC/dlaln2.c | 6 +++--- lapack-netlib/SRC/dlals0.c | 6 +++--- lapack-netlib/SRC/dlalsa.c | 6 +++--- lapack-netlib/SRC/dlalsd.c | 6 +++--- lapack-netlib/SRC/dlamrg.c | 6 +++--- lapack-netlib/SRC/dlamswlq.c | 6 +++--- lapack-netlib/SRC/dlamtsqr.c | 6 +++--- lapack-netlib/SRC/dlaneg.c | 6 +++--- lapack-netlib/SRC/dlangb.c | 6 +++--- lapack-netlib/SRC/dlange.c | 6 +++--- lapack-netlib/SRC/dlangt.c | 6 +++--- lapack-netlib/SRC/dlanhs.c | 6 +++--- lapack-netlib/SRC/dlansb.c | 6 +++--- lapack-netlib/SRC/dlansf.c | 6 +++--- lapack-netlib/SRC/dlansp.c | 6 +++--- lapack-netlib/SRC/dlanst.c | 6 +++--- lapack-netlib/SRC/dlansy.c | 6 +++--- lapack-netlib/SRC/dlantb.c | 6 +++--- lapack-netlib/SRC/dlantp.c | 6 +++--- lapack-netlib/SRC/dlantr.c | 6 +++--- lapack-netlib/SRC/dlanv2.c | 6 +++--- lapack-netlib/SRC/dlaorhr_col_getrfnp.c | 6 +++--- lapack-netlib/SRC/dlaorhr_col_getrfnp2.c | 6 +++--- lapack-netlib/SRC/dlapll.c | 6 +++--- lapack-netlib/SRC/dlapmr.c | 6 +++--- lapack-netlib/SRC/dlapmt.c | 6 +++--- lapack-netlib/SRC/dlapy2.c | 6 +++--- lapack-netlib/SRC/dlapy3.c | 6 +++--- lapack-netlib/SRC/dlaqgb.c | 6 +++--- lapack-netlib/SRC/dlaqge.c | 6 +++--- lapack-netlib/SRC/dlaqp2.c | 6 +++--- lapack-netlib/SRC/dlaqp2rk.c | 6 +++--- lapack-netlib/SRC/dlaqp3rk.c | 6 +++--- lapack-netlib/SRC/dlaqps.c | 6 +++--- 67 files changed, 201 insertions(+), 201 deletions(-) diff --git a/lapack-netlib/SRC/dlabad.c b/lapack-netlib/SRC/dlabad.c index f9ad54cae..f84fc9059 100644 --- a/lapack-netlib/SRC/dlabad.c +++ b/lapack-netlib/SRC/dlabad.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlabrd.c b/lapack-netlib/SRC/dlabrd.c index 4697defb2..80cd31b29 100644 --- a/lapack-netlib/SRC/dlabrd.c +++ b/lapack-netlib/SRC/dlabrd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlacn2.c b/lapack-netlib/SRC/dlacn2.c index d354699f0..bbeabdd11 100644 --- a/lapack-netlib/SRC/dlacn2.c +++ b/lapack-netlib/SRC/dlacn2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlacon.c b/lapack-netlib/SRC/dlacon.c index 69bb8261b..fcbb3ea32 100644 --- a/lapack-netlib/SRC/dlacon.c +++ b/lapack-netlib/SRC/dlacon.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlacpy.c b/lapack-netlib/SRC/dlacpy.c index b123a705a..4e908c173 100644 --- a/lapack-netlib/SRC/dlacpy.c +++ b/lapack-netlib/SRC/dlacpy.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dladiv.c b/lapack-netlib/SRC/dladiv.c index 158cf1a63..ad5ce654b 100644 --- a/lapack-netlib/SRC/dladiv.c +++ b/lapack-netlib/SRC/dladiv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlae2.c b/lapack-netlib/SRC/dlae2.c index b5784baea..2db6b7019 100644 --- a/lapack-netlib/SRC/dlae2.c +++ b/lapack-netlib/SRC/dlae2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlaebz.c b/lapack-netlib/SRC/dlaebz.c index 801e1b402..e2b6bbd6e 100644 --- a/lapack-netlib/SRC/dlaebz.c +++ b/lapack-netlib/SRC/dlaebz.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlaed0.c b/lapack-netlib/SRC/dlaed0.c index ccd364205..474189f2b 100644 --- a/lapack-netlib/SRC/dlaed0.c +++ b/lapack-netlib/SRC/dlaed0.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlaed1.c b/lapack-netlib/SRC/dlaed1.c index 64d2342eb..83ac2cfef 100644 --- a/lapack-netlib/SRC/dlaed1.c +++ b/lapack-netlib/SRC/dlaed1.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlaed2.c b/lapack-netlib/SRC/dlaed2.c index bdaf0e127..fcf9f270b 100644 --- a/lapack-netlib/SRC/dlaed2.c +++ b/lapack-netlib/SRC/dlaed2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlaed3.c b/lapack-netlib/SRC/dlaed3.c index b4fe8ce6c..ea25100f3 100644 --- a/lapack-netlib/SRC/dlaed3.c +++ b/lapack-netlib/SRC/dlaed3.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlaed4.c b/lapack-netlib/SRC/dlaed4.c index 13a400656..f2939ff60 100644 --- a/lapack-netlib/SRC/dlaed4.c +++ b/lapack-netlib/SRC/dlaed4.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlaed5.c b/lapack-netlib/SRC/dlaed5.c index 4b76eec7b..4d0a3621c 100644 --- a/lapack-netlib/SRC/dlaed5.c +++ b/lapack-netlib/SRC/dlaed5.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlaed6.c b/lapack-netlib/SRC/dlaed6.c index 2e0ea1d33..1e2e87329 100644 --- a/lapack-netlib/SRC/dlaed6.c +++ b/lapack-netlib/SRC/dlaed6.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlaed7.c b/lapack-netlib/SRC/dlaed7.c index 6826f29a5..546a9de89 100644 --- a/lapack-netlib/SRC/dlaed7.c +++ b/lapack-netlib/SRC/dlaed7.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlaed8.c b/lapack-netlib/SRC/dlaed8.c index e18ae05e0..c49e00642 100644 --- a/lapack-netlib/SRC/dlaed8.c +++ b/lapack-netlib/SRC/dlaed8.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlaed9.c b/lapack-netlib/SRC/dlaed9.c index a2ccbd483..3b598ca49 100644 --- a/lapack-netlib/SRC/dlaed9.c +++ b/lapack-netlib/SRC/dlaed9.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlaeda.c b/lapack-netlib/SRC/dlaeda.c index fc992d879..381144413 100644 --- a/lapack-netlib/SRC/dlaeda.c +++ b/lapack-netlib/SRC/dlaeda.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlaein.c b/lapack-netlib/SRC/dlaein.c index 009df2142..4ea91f035 100644 --- a/lapack-netlib/SRC/dlaein.c +++ b/lapack-netlib/SRC/dlaein.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlaev2.c b/lapack-netlib/SRC/dlaev2.c index 685a62fa8..b19c9b855 100644 --- a/lapack-netlib/SRC/dlaev2.c +++ b/lapack-netlib/SRC/dlaev2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlaexc.c b/lapack-netlib/SRC/dlaexc.c index be0c45dd9..7c70c7115 100644 --- a/lapack-netlib/SRC/dlaexc.c +++ b/lapack-netlib/SRC/dlaexc.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlag2.c b/lapack-netlib/SRC/dlag2.c index bddbf647b..846ba21e8 100644 --- a/lapack-netlib/SRC/dlag2.c +++ b/lapack-netlib/SRC/dlag2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlag2s.c b/lapack-netlib/SRC/dlag2s.c index 83f47eab7..20dfc0460 100644 --- a/lapack-netlib/SRC/dlag2s.c +++ b/lapack-netlib/SRC/dlag2s.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlags2.c b/lapack-netlib/SRC/dlags2.c index 023660b91..4a74eb633 100644 --- a/lapack-netlib/SRC/dlags2.c +++ b/lapack-netlib/SRC/dlags2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlagtf.c b/lapack-netlib/SRC/dlagtf.c index 1d55872e4..3107985be 100644 --- a/lapack-netlib/SRC/dlagtf.c +++ b/lapack-netlib/SRC/dlagtf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlagtm.c b/lapack-netlib/SRC/dlagtm.c index 7bce48edd..f99cacf16 100644 --- a/lapack-netlib/SRC/dlagtm.c +++ b/lapack-netlib/SRC/dlagtm.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlagts.c b/lapack-netlib/SRC/dlagts.c index 31cac2306..d3b3ff24a 100644 --- a/lapack-netlib/SRC/dlagts.c +++ b/lapack-netlib/SRC/dlagts.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlagv2.c b/lapack-netlib/SRC/dlagv2.c index e89877f5e..a43842402 100644 --- a/lapack-netlib/SRC/dlagv2.c +++ b/lapack-netlib/SRC/dlagv2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlahqr.c b/lapack-netlib/SRC/dlahqr.c index 6b78231cc..8ed61ecc8 100644 --- a/lapack-netlib/SRC/dlahqr.c +++ b/lapack-netlib/SRC/dlahqr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlahr2.c b/lapack-netlib/SRC/dlahr2.c index c4593e671..f56e68e60 100644 --- a/lapack-netlib/SRC/dlahr2.c +++ b/lapack-netlib/SRC/dlahr2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlaic1.c b/lapack-netlib/SRC/dlaic1.c index 5aff47dda..a54817fb8 100644 --- a/lapack-netlib/SRC/dlaic1.c +++ b/lapack-netlib/SRC/dlaic1.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlaisnan.c b/lapack-netlib/SRC/dlaisnan.c index 055034c5a..cf69169e0 100644 --- a/lapack-netlib/SRC/dlaisnan.c +++ b/lapack-netlib/SRC/dlaisnan.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlaln2.c b/lapack-netlib/SRC/dlaln2.c index 9964063b8..09bea80ea 100644 --- a/lapack-netlib/SRC/dlaln2.c +++ b/lapack-netlib/SRC/dlaln2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlals0.c b/lapack-netlib/SRC/dlals0.c index 3fb8b931e..0b0617e87 100644 --- a/lapack-netlib/SRC/dlals0.c +++ b/lapack-netlib/SRC/dlals0.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlalsa.c b/lapack-netlib/SRC/dlalsa.c index 2d20aaf8f..eb2d7db0b 100644 --- a/lapack-netlib/SRC/dlalsa.c +++ b/lapack-netlib/SRC/dlalsa.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlalsd.c b/lapack-netlib/SRC/dlalsd.c index 6be6155b7..938ae4d19 100644 --- a/lapack-netlib/SRC/dlalsd.c +++ b/lapack-netlib/SRC/dlalsd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlamrg.c b/lapack-netlib/SRC/dlamrg.c index 87eab4d7f..52979212e 100644 --- a/lapack-netlib/SRC/dlamrg.c +++ b/lapack-netlib/SRC/dlamrg.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlamswlq.c b/lapack-netlib/SRC/dlamswlq.c index 5d63419ec..4998f8f4c 100644 --- a/lapack-netlib/SRC/dlamswlq.c +++ b/lapack-netlib/SRC/dlamswlq.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlamtsqr.c b/lapack-netlib/SRC/dlamtsqr.c index ab6e329ae..892980548 100644 --- a/lapack-netlib/SRC/dlamtsqr.c +++ b/lapack-netlib/SRC/dlamtsqr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlaneg.c b/lapack-netlib/SRC/dlaneg.c index 7565a9736..3fffa13de 100644 --- a/lapack-netlib/SRC/dlaneg.c +++ b/lapack-netlib/SRC/dlaneg.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlangb.c b/lapack-netlib/SRC/dlangb.c index 5503198fa..c4c6a2746 100644 --- a/lapack-netlib/SRC/dlangb.c +++ b/lapack-netlib/SRC/dlangb.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlange.c b/lapack-netlib/SRC/dlange.c index 70b743c64..5ad00d06c 100644 --- a/lapack-netlib/SRC/dlange.c +++ b/lapack-netlib/SRC/dlange.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlangt.c b/lapack-netlib/SRC/dlangt.c index 2dd791d90..6840dd1bd 100644 --- a/lapack-netlib/SRC/dlangt.c +++ b/lapack-netlib/SRC/dlangt.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlanhs.c b/lapack-netlib/SRC/dlanhs.c index a1ddef031..69eab9d49 100644 --- a/lapack-netlib/SRC/dlanhs.c +++ b/lapack-netlib/SRC/dlanhs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlansb.c b/lapack-netlib/SRC/dlansb.c index 787679ef9..34e51dd78 100644 --- a/lapack-netlib/SRC/dlansb.c +++ b/lapack-netlib/SRC/dlansb.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlansf.c b/lapack-netlib/SRC/dlansf.c index 7563b7be9..e5456cdce 100644 --- a/lapack-netlib/SRC/dlansf.c +++ b/lapack-netlib/SRC/dlansf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlansp.c b/lapack-netlib/SRC/dlansp.c index fcf0e02d2..14a0a930e 100644 --- a/lapack-netlib/SRC/dlansp.c +++ b/lapack-netlib/SRC/dlansp.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlanst.c b/lapack-netlib/SRC/dlanst.c index b31ca3fdc..e1e89c49b 100644 --- a/lapack-netlib/SRC/dlanst.c +++ b/lapack-netlib/SRC/dlanst.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlansy.c b/lapack-netlib/SRC/dlansy.c index d001d8620..a0bcb9e01 100644 --- a/lapack-netlib/SRC/dlansy.c +++ b/lapack-netlib/SRC/dlansy.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlantb.c b/lapack-netlib/SRC/dlantb.c index 9c7c50f90..6d1fdf06e 100644 --- a/lapack-netlib/SRC/dlantb.c +++ b/lapack-netlib/SRC/dlantb.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlantp.c b/lapack-netlib/SRC/dlantp.c index 1733bd85f..fb57d3105 100644 --- a/lapack-netlib/SRC/dlantp.c +++ b/lapack-netlib/SRC/dlantp.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlantr.c b/lapack-netlib/SRC/dlantr.c index 20a40dc57..bc8a0e329 100644 --- a/lapack-netlib/SRC/dlantr.c +++ b/lapack-netlib/SRC/dlantr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlanv2.c b/lapack-netlib/SRC/dlanv2.c index b0254077c..d71742bcb 100644 --- a/lapack-netlib/SRC/dlanv2.c +++ b/lapack-netlib/SRC/dlanv2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlaorhr_col_getrfnp.c b/lapack-netlib/SRC/dlaorhr_col_getrfnp.c index e716a0efa..331bf375a 100644 --- a/lapack-netlib/SRC/dlaorhr_col_getrfnp.c +++ b/lapack-netlib/SRC/dlaorhr_col_getrfnp.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlaorhr_col_getrfnp2.c b/lapack-netlib/SRC/dlaorhr_col_getrfnp2.c index fe828f6d5..09f5a5f51 100644 --- a/lapack-netlib/SRC/dlaorhr_col_getrfnp2.c +++ b/lapack-netlib/SRC/dlaorhr_col_getrfnp2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlapll.c b/lapack-netlib/SRC/dlapll.c index e3d2c80b2..ddf6dde58 100644 --- a/lapack-netlib/SRC/dlapll.c +++ b/lapack-netlib/SRC/dlapll.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlapmr.c b/lapack-netlib/SRC/dlapmr.c index c4c4e169b..1c2240305 100644 --- a/lapack-netlib/SRC/dlapmr.c +++ b/lapack-netlib/SRC/dlapmr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlapmt.c b/lapack-netlib/SRC/dlapmt.c index 6c01575d4..9cd691f58 100644 --- a/lapack-netlib/SRC/dlapmt.c +++ b/lapack-netlib/SRC/dlapmt.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlapy2.c b/lapack-netlib/SRC/dlapy2.c index 9ffc8a45c..1a8236063 100644 --- a/lapack-netlib/SRC/dlapy2.c +++ b/lapack-netlib/SRC/dlapy2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlapy3.c b/lapack-netlib/SRC/dlapy3.c index fa8b218e8..d87851cdc 100644 --- a/lapack-netlib/SRC/dlapy3.c +++ b/lapack-netlib/SRC/dlapy3.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlaqgb.c b/lapack-netlib/SRC/dlaqgb.c index 6814ef750..6d10fc48f 100644 --- a/lapack-netlib/SRC/dlaqgb.c +++ b/lapack-netlib/SRC/dlaqgb.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlaqge.c b/lapack-netlib/SRC/dlaqge.c index 2191d7519..9725d1512 100644 --- a/lapack-netlib/SRC/dlaqge.c +++ b/lapack-netlib/SRC/dlaqge.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlaqp2.c b/lapack-netlib/SRC/dlaqp2.c index 00fbc5937..084131816 100644 --- a/lapack-netlib/SRC/dlaqp2.c +++ b/lapack-netlib/SRC/dlaqp2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlaqp2rk.c b/lapack-netlib/SRC/dlaqp2rk.c index de216ad97..42f26317c 100644 --- a/lapack-netlib/SRC/dlaqp2rk.c +++ b/lapack-netlib/SRC/dlaqp2rk.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlaqp3rk.c b/lapack-netlib/SRC/dlaqp3rk.c index e8c61c257..e4c1b3b4b 100644 --- a/lapack-netlib/SRC/dlaqp3rk.c +++ b/lapack-netlib/SRC/dlaqp3rk.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dlaqps.c b/lapack-netlib/SRC/dlaqps.c index f8944618b..fbf1ccc1b 100644 --- a/lapack-netlib/SRC/dlaqps.c +++ b/lapack-netlib/SRC/dlaqps.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else From 373e36377c06cec8b95e874271b43e3364996b67 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Thu, 4 Apr 2024 01:19:55 +0200 Subject: [PATCH 289/311] fix typedef of logical to support INTERFACE64 --- lapack-netlib/SRC/dgelst.c | 6 +++--- lapack-netlib/SRC/dgelsy.c | 6 +++--- lapack-netlib/SRC/dgemlq.c | 6 +++--- lapack-netlib/SRC/dgemlqt.c | 6 +++--- lapack-netlib/SRC/dgemqr.c | 6 +++--- lapack-netlib/SRC/dgemqrt.c | 6 +++--- lapack-netlib/SRC/dgeql2.c | 6 +++--- lapack-netlib/SRC/dgeqlf.c | 6 +++--- lapack-netlib/SRC/dgeqp3.c | 6 +++--- lapack-netlib/SRC/dgeqp3rk.c | 6 +++--- lapack-netlib/SRC/dgeqr.c | 6 +++--- lapack-netlib/SRC/dgeqr2.c | 6 +++--- lapack-netlib/SRC/dgeqr2p.c | 6 +++--- lapack-netlib/SRC/dgeqrf.c | 6 +++--- lapack-netlib/SRC/dgeqrfp.c | 6 +++--- lapack-netlib/SRC/dgeqrt.c | 6 +++--- lapack-netlib/SRC/dgeqrt2.c | 6 +++--- lapack-netlib/SRC/dgeqrt3.c | 6 +++--- lapack-netlib/SRC/dgerfs.c | 6 +++--- lapack-netlib/SRC/dgerfsx.c | 6 +++--- lapack-netlib/SRC/dgerq2.c | 6 +++--- lapack-netlib/SRC/dgerqf.c | 6 +++--- lapack-netlib/SRC/dgesc2.c | 6 +++--- lapack-netlib/SRC/dgesdd.c | 6 +++--- lapack-netlib/SRC/dgesv.c | 6 +++--- lapack-netlib/SRC/dgesvd.c | 6 +++--- lapack-netlib/SRC/dgesvdq.c | 6 +++--- lapack-netlib/SRC/dgesvdx.c | 6 +++--- lapack-netlib/SRC/dgesvj.c | 6 +++--- lapack-netlib/SRC/dgesvx.c | 6 +++--- lapack-netlib/SRC/dgesvxx.c | 6 +++--- lapack-netlib/SRC/dgetc2.c | 6 +++--- lapack-netlib/SRC/dgetf2.c | 6 +++--- lapack-netlib/SRC/dgetrf.c | 6 +++--- lapack-netlib/SRC/dgetrf2.c | 6 +++--- lapack-netlib/SRC/dgetri.c | 6 +++--- lapack-netlib/SRC/dgetrs.c | 6 +++--- lapack-netlib/SRC/dgetsls.c | 6 +++--- lapack-netlib/SRC/dgetsqrhrt.c | 6 +++--- lapack-netlib/SRC/dggbak.c | 6 +++--- lapack-netlib/SRC/dggbal.c | 6 +++--- lapack-netlib/SRC/dgges.c | 6 +++--- lapack-netlib/SRC/dgges3.c | 6 +++--- lapack-netlib/SRC/dggesx.c | 6 +++--- lapack-netlib/SRC/dggev.c | 6 +++--- lapack-netlib/SRC/dggev3.c | 6 +++--- lapack-netlib/SRC/dggevx.c | 6 +++--- lapack-netlib/SRC/dggglm.c | 6 +++--- lapack-netlib/SRC/dgghd3.c | 6 +++--- lapack-netlib/SRC/dgghrd.c | 6 +++--- lapack-netlib/SRC/dgglse.c | 6 +++--- lapack-netlib/SRC/dggqrf.c | 6 +++--- lapack-netlib/SRC/dggrqf.c | 6 +++--- lapack-netlib/SRC/dggsvd3.c | 6 +++--- lapack-netlib/SRC/dggsvp3.c | 6 +++--- lapack-netlib/SRC/dgsvj0.c | 6 +++--- lapack-netlib/SRC/dgsvj1.c | 6 +++--- lapack-netlib/SRC/dgtcon.c | 6 +++--- lapack-netlib/SRC/dgtrfs.c | 6 +++--- lapack-netlib/SRC/dgtsv.c | 6 +++--- lapack-netlib/SRC/dgtsvx.c | 6 +++--- lapack-netlib/SRC/dgttrf.c | 6 +++--- lapack-netlib/SRC/dgttrs.c | 6 +++--- lapack-netlib/SRC/dgtts2.c | 6 +++--- lapack-netlib/SRC/dhgeqz.c | 6 +++--- lapack-netlib/SRC/dhsein.c | 6 +++--- lapack-netlib/SRC/dhseqr.c | 6 +++--- lapack-netlib/SRC/disnan.c | 6 +++--- lapack-netlib/SRC/dla_gbamv.c | 6 +++--- lapack-netlib/SRC/dla_gbrcond.c | 6 +++--- lapack-netlib/SRC/dla_gbrfsx_extended.c | 6 +++--- lapack-netlib/SRC/dla_gbrpvgrw.c | 6 +++--- lapack-netlib/SRC/dla_geamv.c | 6 +++--- lapack-netlib/SRC/dla_gercond.c | 6 +++--- lapack-netlib/SRC/dla_gerfsx_extended.c | 6 +++--- lapack-netlib/SRC/dla_gerpvgrw.c | 6 +++--- lapack-netlib/SRC/dla_lin_berr.c | 6 +++--- lapack-netlib/SRC/dla_porcond.c | 6 +++--- lapack-netlib/SRC/dla_porfsx_extended.c | 6 +++--- lapack-netlib/SRC/dla_porpvgrw.c | 6 +++--- lapack-netlib/SRC/dla_syamv.c | 6 +++--- lapack-netlib/SRC/dla_syrcond.c | 6 +++--- lapack-netlib/SRC/dla_syrfsx_extended.c | 6 +++--- lapack-netlib/SRC/dla_syrpvgrw.c | 6 +++--- lapack-netlib/SRC/dla_wwaddw.c | 6 +++--- 85 files changed, 255 insertions(+), 255 deletions(-) diff --git a/lapack-netlib/SRC/dgelst.c b/lapack-netlib/SRC/dgelst.c index 9333bd5dd..afaeaf7cc 100644 --- a/lapack-netlib/SRC/dgelst.c +++ b/lapack-netlib/SRC/dgelst.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgelsy.c b/lapack-netlib/SRC/dgelsy.c index 5c625f939..c1a123bc0 100644 --- a/lapack-netlib/SRC/dgelsy.c +++ b/lapack-netlib/SRC/dgelsy.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgemlq.c b/lapack-netlib/SRC/dgemlq.c index acc56173a..f3e89dbe0 100644 --- a/lapack-netlib/SRC/dgemlq.c +++ b/lapack-netlib/SRC/dgemlq.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgemlqt.c b/lapack-netlib/SRC/dgemlqt.c index e188d3532..a306fe36f 100644 --- a/lapack-netlib/SRC/dgemlqt.c +++ b/lapack-netlib/SRC/dgemlqt.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgemqr.c b/lapack-netlib/SRC/dgemqr.c index a309b328b..fc4dc8c74 100644 --- a/lapack-netlib/SRC/dgemqr.c +++ b/lapack-netlib/SRC/dgemqr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgemqrt.c b/lapack-netlib/SRC/dgemqrt.c index f8f939385..449c475df 100644 --- a/lapack-netlib/SRC/dgemqrt.c +++ b/lapack-netlib/SRC/dgemqrt.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgeql2.c b/lapack-netlib/SRC/dgeql2.c index 125ede360..4cbe6deb7 100644 --- a/lapack-netlib/SRC/dgeql2.c +++ b/lapack-netlib/SRC/dgeql2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgeqlf.c b/lapack-netlib/SRC/dgeqlf.c index 94853a678..936552603 100644 --- a/lapack-netlib/SRC/dgeqlf.c +++ b/lapack-netlib/SRC/dgeqlf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgeqp3.c b/lapack-netlib/SRC/dgeqp3.c index dd966a50e..5891cdc91 100644 --- a/lapack-netlib/SRC/dgeqp3.c +++ b/lapack-netlib/SRC/dgeqp3.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgeqp3rk.c b/lapack-netlib/SRC/dgeqp3rk.c index 17a78dd5a..219d649bc 100644 --- a/lapack-netlib/SRC/dgeqp3rk.c +++ b/lapack-netlib/SRC/dgeqp3rk.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgeqr.c b/lapack-netlib/SRC/dgeqr.c index dbd0c7e4f..dbf7cdfb5 100644 --- a/lapack-netlib/SRC/dgeqr.c +++ b/lapack-netlib/SRC/dgeqr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgeqr2.c b/lapack-netlib/SRC/dgeqr2.c index f80cd2da8..f96cea469 100644 --- a/lapack-netlib/SRC/dgeqr2.c +++ b/lapack-netlib/SRC/dgeqr2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgeqr2p.c b/lapack-netlib/SRC/dgeqr2p.c index 83f21e878..0b8f4e93e 100644 --- a/lapack-netlib/SRC/dgeqr2p.c +++ b/lapack-netlib/SRC/dgeqr2p.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgeqrf.c b/lapack-netlib/SRC/dgeqrf.c index fc0bb6989..4b8b05930 100644 --- a/lapack-netlib/SRC/dgeqrf.c +++ b/lapack-netlib/SRC/dgeqrf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgeqrfp.c b/lapack-netlib/SRC/dgeqrfp.c index 5de166b5c..ae9ee6912 100644 --- a/lapack-netlib/SRC/dgeqrfp.c +++ b/lapack-netlib/SRC/dgeqrfp.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgeqrt.c b/lapack-netlib/SRC/dgeqrt.c index 2c0d8c12e..7b7d31b0e 100644 --- a/lapack-netlib/SRC/dgeqrt.c +++ b/lapack-netlib/SRC/dgeqrt.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgeqrt2.c b/lapack-netlib/SRC/dgeqrt2.c index 84a987387..f7760ea97 100644 --- a/lapack-netlib/SRC/dgeqrt2.c +++ b/lapack-netlib/SRC/dgeqrt2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgeqrt3.c b/lapack-netlib/SRC/dgeqrt3.c index 997a8e1d1..7f5964c15 100644 --- a/lapack-netlib/SRC/dgeqrt3.c +++ b/lapack-netlib/SRC/dgeqrt3.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgerfs.c b/lapack-netlib/SRC/dgerfs.c index a332ec33d..5d5b7bb07 100644 --- a/lapack-netlib/SRC/dgerfs.c +++ b/lapack-netlib/SRC/dgerfs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgerfsx.c b/lapack-netlib/SRC/dgerfsx.c index e003bfaa8..4fab4c3fb 100644 --- a/lapack-netlib/SRC/dgerfsx.c +++ b/lapack-netlib/SRC/dgerfsx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgerq2.c b/lapack-netlib/SRC/dgerq2.c index 777847384..e5d26ce58 100644 --- a/lapack-netlib/SRC/dgerq2.c +++ b/lapack-netlib/SRC/dgerq2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgerqf.c b/lapack-netlib/SRC/dgerqf.c index 1eb54dc84..cdee1efa3 100644 --- a/lapack-netlib/SRC/dgerqf.c +++ b/lapack-netlib/SRC/dgerqf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgesc2.c b/lapack-netlib/SRC/dgesc2.c index 3e7288bc6..23f8773d9 100644 --- a/lapack-netlib/SRC/dgesc2.c +++ b/lapack-netlib/SRC/dgesc2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgesdd.c b/lapack-netlib/SRC/dgesdd.c index a84ed5006..044732021 100644 --- a/lapack-netlib/SRC/dgesdd.c +++ b/lapack-netlib/SRC/dgesdd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgesv.c b/lapack-netlib/SRC/dgesv.c index ad0978250..b871271d7 100644 --- a/lapack-netlib/SRC/dgesv.c +++ b/lapack-netlib/SRC/dgesv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgesvd.c b/lapack-netlib/SRC/dgesvd.c index 32f136b7d..f7b3a74c6 100644 --- a/lapack-netlib/SRC/dgesvd.c +++ b/lapack-netlib/SRC/dgesvd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgesvdq.c b/lapack-netlib/SRC/dgesvdq.c index c7f2001c3..ec6343e01 100644 --- a/lapack-netlib/SRC/dgesvdq.c +++ b/lapack-netlib/SRC/dgesvdq.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgesvdx.c b/lapack-netlib/SRC/dgesvdx.c index 3f3a8eb4f..2a5ad587a 100644 --- a/lapack-netlib/SRC/dgesvdx.c +++ b/lapack-netlib/SRC/dgesvdx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgesvj.c b/lapack-netlib/SRC/dgesvj.c index 88ee26ce6..c2c89e69d 100644 --- a/lapack-netlib/SRC/dgesvj.c +++ b/lapack-netlib/SRC/dgesvj.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgesvx.c b/lapack-netlib/SRC/dgesvx.c index 646436f89..4ccb85463 100644 --- a/lapack-netlib/SRC/dgesvx.c +++ b/lapack-netlib/SRC/dgesvx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgesvxx.c b/lapack-netlib/SRC/dgesvxx.c index 6c80d6b6d..1b470b7db 100644 --- a/lapack-netlib/SRC/dgesvxx.c +++ b/lapack-netlib/SRC/dgesvxx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgetc2.c b/lapack-netlib/SRC/dgetc2.c index 1c33db5dc..574f4bb31 100644 --- a/lapack-netlib/SRC/dgetc2.c +++ b/lapack-netlib/SRC/dgetc2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgetf2.c b/lapack-netlib/SRC/dgetf2.c index e0f7dd74c..595da91d4 100644 --- a/lapack-netlib/SRC/dgetf2.c +++ b/lapack-netlib/SRC/dgetf2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgetrf.c b/lapack-netlib/SRC/dgetrf.c index 6e3faef5b..81f32f046 100644 --- a/lapack-netlib/SRC/dgetrf.c +++ b/lapack-netlib/SRC/dgetrf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgetrf2.c b/lapack-netlib/SRC/dgetrf2.c index 802868e7d..2dc95a3ab 100644 --- a/lapack-netlib/SRC/dgetrf2.c +++ b/lapack-netlib/SRC/dgetrf2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgetri.c b/lapack-netlib/SRC/dgetri.c index 6f5b386f6..3e7ced536 100644 --- a/lapack-netlib/SRC/dgetri.c +++ b/lapack-netlib/SRC/dgetri.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgetrs.c b/lapack-netlib/SRC/dgetrs.c index 50b962b61..876bb4bfe 100644 --- a/lapack-netlib/SRC/dgetrs.c +++ b/lapack-netlib/SRC/dgetrs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgetsls.c b/lapack-netlib/SRC/dgetsls.c index 221c4d5e0..1c4cf686b 100644 --- a/lapack-netlib/SRC/dgetsls.c +++ b/lapack-netlib/SRC/dgetsls.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgetsqrhrt.c b/lapack-netlib/SRC/dgetsqrhrt.c index ae9e16bb9..e4d25d723 100644 --- a/lapack-netlib/SRC/dgetsqrhrt.c +++ b/lapack-netlib/SRC/dgetsqrhrt.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dggbak.c b/lapack-netlib/SRC/dggbak.c index a81fe75e9..49f0d6e23 100644 --- a/lapack-netlib/SRC/dggbak.c +++ b/lapack-netlib/SRC/dggbak.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dggbal.c b/lapack-netlib/SRC/dggbal.c index 422dc2d1e..151418fea 100644 --- a/lapack-netlib/SRC/dggbal.c +++ b/lapack-netlib/SRC/dggbal.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgges.c b/lapack-netlib/SRC/dgges.c index 399d12bc6..a7f24de4a 100644 --- a/lapack-netlib/SRC/dgges.c +++ b/lapack-netlib/SRC/dgges.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgges3.c b/lapack-netlib/SRC/dgges3.c index 89fca0326..8e1139349 100644 --- a/lapack-netlib/SRC/dgges3.c +++ b/lapack-netlib/SRC/dgges3.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dggesx.c b/lapack-netlib/SRC/dggesx.c index 995b5f01e..3f5f6cd17 100644 --- a/lapack-netlib/SRC/dggesx.c +++ b/lapack-netlib/SRC/dggesx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dggev.c b/lapack-netlib/SRC/dggev.c index 7a8f34bb8..07d4b166c 100644 --- a/lapack-netlib/SRC/dggev.c +++ b/lapack-netlib/SRC/dggev.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dggev3.c b/lapack-netlib/SRC/dggev3.c index fa8f27dbf..ab080dcff 100644 --- a/lapack-netlib/SRC/dggev3.c +++ b/lapack-netlib/SRC/dggev3.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dggevx.c b/lapack-netlib/SRC/dggevx.c index 213beaf84..72f4c8bb3 100644 --- a/lapack-netlib/SRC/dggevx.c +++ b/lapack-netlib/SRC/dggevx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dggglm.c b/lapack-netlib/SRC/dggglm.c index 1299b3441..75913c497 100644 --- a/lapack-netlib/SRC/dggglm.c +++ b/lapack-netlib/SRC/dggglm.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgghd3.c b/lapack-netlib/SRC/dgghd3.c index c4507b8cb..5a4df0a0f 100644 --- a/lapack-netlib/SRC/dgghd3.c +++ b/lapack-netlib/SRC/dgghd3.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgghrd.c b/lapack-netlib/SRC/dgghrd.c index 03879f33e..2fc015905 100644 --- a/lapack-netlib/SRC/dgghrd.c +++ b/lapack-netlib/SRC/dgghrd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgglse.c b/lapack-netlib/SRC/dgglse.c index e9b555073..17bc5c94a 100644 --- a/lapack-netlib/SRC/dgglse.c +++ b/lapack-netlib/SRC/dgglse.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dggqrf.c b/lapack-netlib/SRC/dggqrf.c index 535db1cce..42fe5759e 100644 --- a/lapack-netlib/SRC/dggqrf.c +++ b/lapack-netlib/SRC/dggqrf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dggrqf.c b/lapack-netlib/SRC/dggrqf.c index 9b764d7b8..3cf0e3856 100644 --- a/lapack-netlib/SRC/dggrqf.c +++ b/lapack-netlib/SRC/dggrqf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dggsvd3.c b/lapack-netlib/SRC/dggsvd3.c index 347d0e08a..bd68d4f14 100644 --- a/lapack-netlib/SRC/dggsvd3.c +++ b/lapack-netlib/SRC/dggsvd3.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dggsvp3.c b/lapack-netlib/SRC/dggsvp3.c index b07984e11..ab4f1ae05 100644 --- a/lapack-netlib/SRC/dggsvp3.c +++ b/lapack-netlib/SRC/dggsvp3.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgsvj0.c b/lapack-netlib/SRC/dgsvj0.c index 4dc598578..283751f66 100644 --- a/lapack-netlib/SRC/dgsvj0.c +++ b/lapack-netlib/SRC/dgsvj0.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgsvj1.c b/lapack-netlib/SRC/dgsvj1.c index b191834ed..463a26105 100644 --- a/lapack-netlib/SRC/dgsvj1.c +++ b/lapack-netlib/SRC/dgsvj1.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgtcon.c b/lapack-netlib/SRC/dgtcon.c index 1244943e8..9af5a8880 100644 --- a/lapack-netlib/SRC/dgtcon.c +++ b/lapack-netlib/SRC/dgtcon.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgtrfs.c b/lapack-netlib/SRC/dgtrfs.c index 81add9aa0..4354a75fb 100644 --- a/lapack-netlib/SRC/dgtrfs.c +++ b/lapack-netlib/SRC/dgtrfs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgtsv.c b/lapack-netlib/SRC/dgtsv.c index c608f1c07..ce667e16e 100644 --- a/lapack-netlib/SRC/dgtsv.c +++ b/lapack-netlib/SRC/dgtsv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgtsvx.c b/lapack-netlib/SRC/dgtsvx.c index d6aaf1e17..043a1c103 100644 --- a/lapack-netlib/SRC/dgtsvx.c +++ b/lapack-netlib/SRC/dgtsvx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgttrf.c b/lapack-netlib/SRC/dgttrf.c index d4a9ebf13..fb16e7644 100644 --- a/lapack-netlib/SRC/dgttrf.c +++ b/lapack-netlib/SRC/dgttrf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgttrs.c b/lapack-netlib/SRC/dgttrs.c index 818bc0e09..325b39527 100644 --- a/lapack-netlib/SRC/dgttrs.c +++ b/lapack-netlib/SRC/dgttrs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgtts2.c b/lapack-netlib/SRC/dgtts2.c index 7ac39f706..663d3b31a 100644 --- a/lapack-netlib/SRC/dgtts2.c +++ b/lapack-netlib/SRC/dgtts2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dhgeqz.c b/lapack-netlib/SRC/dhgeqz.c index e24783316..87fcc7c59 100644 --- a/lapack-netlib/SRC/dhgeqz.c +++ b/lapack-netlib/SRC/dhgeqz.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dhsein.c b/lapack-netlib/SRC/dhsein.c index 299fe7d54..1c3ce19d5 100644 --- a/lapack-netlib/SRC/dhsein.c +++ b/lapack-netlib/SRC/dhsein.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dhseqr.c b/lapack-netlib/SRC/dhseqr.c index 2c3f9d9ce..85a6c3f73 100644 --- a/lapack-netlib/SRC/dhseqr.c +++ b/lapack-netlib/SRC/dhseqr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/disnan.c b/lapack-netlib/SRC/disnan.c index 434220090..4480c00bc 100644 --- a/lapack-netlib/SRC/disnan.c +++ b/lapack-netlib/SRC/disnan.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dla_gbamv.c b/lapack-netlib/SRC/dla_gbamv.c index 87d6e36bc..17ffdc4e7 100644 --- a/lapack-netlib/SRC/dla_gbamv.c +++ b/lapack-netlib/SRC/dla_gbamv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dla_gbrcond.c b/lapack-netlib/SRC/dla_gbrcond.c index 777b3ebd6..919ef90bd 100644 --- a/lapack-netlib/SRC/dla_gbrcond.c +++ b/lapack-netlib/SRC/dla_gbrcond.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dla_gbrfsx_extended.c b/lapack-netlib/SRC/dla_gbrfsx_extended.c index 6fba8a5de..1caa72357 100644 --- a/lapack-netlib/SRC/dla_gbrfsx_extended.c +++ b/lapack-netlib/SRC/dla_gbrfsx_extended.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dla_gbrpvgrw.c b/lapack-netlib/SRC/dla_gbrpvgrw.c index 460975e70..2e92711ec 100644 --- a/lapack-netlib/SRC/dla_gbrpvgrw.c +++ b/lapack-netlib/SRC/dla_gbrpvgrw.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dla_geamv.c b/lapack-netlib/SRC/dla_geamv.c index c52212090..6d9929d49 100644 --- a/lapack-netlib/SRC/dla_geamv.c +++ b/lapack-netlib/SRC/dla_geamv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dla_gercond.c b/lapack-netlib/SRC/dla_gercond.c index 3a6fa8eca..6fbc7d4b4 100644 --- a/lapack-netlib/SRC/dla_gercond.c +++ b/lapack-netlib/SRC/dla_gercond.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dla_gerfsx_extended.c b/lapack-netlib/SRC/dla_gerfsx_extended.c index 96959334e..ad528f475 100644 --- a/lapack-netlib/SRC/dla_gerfsx_extended.c +++ b/lapack-netlib/SRC/dla_gerfsx_extended.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dla_gerpvgrw.c b/lapack-netlib/SRC/dla_gerpvgrw.c index de3601d76..aa119c0e5 100644 --- a/lapack-netlib/SRC/dla_gerpvgrw.c +++ b/lapack-netlib/SRC/dla_gerpvgrw.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dla_lin_berr.c b/lapack-netlib/SRC/dla_lin_berr.c index 63fba703a..cb4208dfb 100644 --- a/lapack-netlib/SRC/dla_lin_berr.c +++ b/lapack-netlib/SRC/dla_lin_berr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dla_porcond.c b/lapack-netlib/SRC/dla_porcond.c index 75e3f7f7a..a058d60b7 100644 --- a/lapack-netlib/SRC/dla_porcond.c +++ b/lapack-netlib/SRC/dla_porcond.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dla_porfsx_extended.c b/lapack-netlib/SRC/dla_porfsx_extended.c index 482ff9cf6..e84a27343 100644 --- a/lapack-netlib/SRC/dla_porfsx_extended.c +++ b/lapack-netlib/SRC/dla_porfsx_extended.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dla_porpvgrw.c b/lapack-netlib/SRC/dla_porpvgrw.c index 2ab26d1d9..1bfbe5be3 100644 --- a/lapack-netlib/SRC/dla_porpvgrw.c +++ b/lapack-netlib/SRC/dla_porpvgrw.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dla_syamv.c b/lapack-netlib/SRC/dla_syamv.c index c696c3fab..27d30bf53 100644 --- a/lapack-netlib/SRC/dla_syamv.c +++ b/lapack-netlib/SRC/dla_syamv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dla_syrcond.c b/lapack-netlib/SRC/dla_syrcond.c index 9466eb0f2..6478edd92 100644 --- a/lapack-netlib/SRC/dla_syrcond.c +++ b/lapack-netlib/SRC/dla_syrcond.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dla_syrfsx_extended.c b/lapack-netlib/SRC/dla_syrfsx_extended.c index ff90972d1..b517ea246 100644 --- a/lapack-netlib/SRC/dla_syrfsx_extended.c +++ b/lapack-netlib/SRC/dla_syrfsx_extended.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dla_syrpvgrw.c b/lapack-netlib/SRC/dla_syrpvgrw.c index d27128b7e..4556fbaaf 100644 --- a/lapack-netlib/SRC/dla_syrpvgrw.c +++ b/lapack-netlib/SRC/dla_syrpvgrw.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dla_wwaddw.c b/lapack-netlib/SRC/dla_wwaddw.c index bdc0ff26b..007601bea 100644 --- a/lapack-netlib/SRC/dla_wwaddw.c +++ b/lapack-netlib/SRC/dla_wwaddw.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else From 7e470400c9392cc02e229445a4167c64531e639e Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Thu, 4 Apr 2024 01:24:27 +0200 Subject: [PATCH 290/311] fix typedef of logical to support INTERFACE64 --- lapack-netlib/SRC/cunbdb.c | 6 +++--- lapack-netlib/SRC/cunbdb1.c | 6 +++--- lapack-netlib/SRC/cunbdb2.c | 6 +++--- lapack-netlib/SRC/cunbdb3.c | 6 +++--- lapack-netlib/SRC/cunbdb4.c | 6 +++--- lapack-netlib/SRC/cunbdb5.c | 6 +++--- lapack-netlib/SRC/cunbdb6.c | 6 +++--- lapack-netlib/SRC/cuncsd.c | 6 +++--- lapack-netlib/SRC/cuncsd2by1.c | 6 +++--- lapack-netlib/SRC/cung2l.c | 6 +++--- lapack-netlib/SRC/cung2r.c | 6 +++--- lapack-netlib/SRC/cungbr.c | 6 +++--- lapack-netlib/SRC/cunghr.c | 6 +++--- lapack-netlib/SRC/cungl2.c | 6 +++--- lapack-netlib/SRC/cunglq.c | 6 +++--- lapack-netlib/SRC/cungql.c | 6 +++--- lapack-netlib/SRC/cungqr.c | 6 +++--- lapack-netlib/SRC/cungr2.c | 6 +++--- lapack-netlib/SRC/cungrq.c | 6 +++--- lapack-netlib/SRC/cungtr.c | 6 +++--- lapack-netlib/SRC/cungtsqr.c | 6 +++--- lapack-netlib/SRC/cungtsqr_row.c | 6 +++--- lapack-netlib/SRC/cunhr_col.c | 6 +++--- lapack-netlib/SRC/cunm22.c | 6 +++--- lapack-netlib/SRC/cunm2l.c | 6 +++--- lapack-netlib/SRC/cunm2r.c | 6 +++--- lapack-netlib/SRC/cunmbr.c | 6 +++--- lapack-netlib/SRC/cunmhr.c | 6 +++--- lapack-netlib/SRC/cunml2.c | 6 +++--- lapack-netlib/SRC/cunmlq.c | 6 +++--- lapack-netlib/SRC/cunmql.c | 6 +++--- lapack-netlib/SRC/cunmqr.c | 6 +++--- lapack-netlib/SRC/cunmr2.c | 6 +++--- lapack-netlib/SRC/cunmr3.c | 6 +++--- lapack-netlib/SRC/cunmrq.c | 6 +++--- lapack-netlib/SRC/cunmrz.c | 6 +++--- lapack-netlib/SRC/cunmtr.c | 6 +++--- lapack-netlib/SRC/cupgtr.c | 6 +++--- lapack-netlib/SRC/cupmtr.c | 6 +++--- lapack-netlib/SRC/dbbcsd.c | 6 +++--- lapack-netlib/SRC/dbdsdc.c | 6 +++--- lapack-netlib/SRC/dbdsqr.c | 6 +++--- lapack-netlib/SRC/dbdsvdx.c | 6 +++--- lapack-netlib/SRC/dcombssq.c | 6 +++--- lapack-netlib/SRC/ddisna.c | 6 +++--- lapack-netlib/SRC/dgbbrd.c | 6 +++--- lapack-netlib/SRC/dgbcon.c | 6 +++--- lapack-netlib/SRC/dgbequ.c | 6 +++--- lapack-netlib/SRC/dgbequb.c | 6 +++--- lapack-netlib/SRC/dgbrfs.c | 6 +++--- lapack-netlib/SRC/dgbrfsx.c | 6 +++--- lapack-netlib/SRC/dgbsv.c | 6 +++--- lapack-netlib/SRC/dgbsvx.c | 6 +++--- lapack-netlib/SRC/dgbsvxx.c | 6 +++--- lapack-netlib/SRC/dgbtf2.c | 6 +++--- lapack-netlib/SRC/dgbtrf.c | 6 +++--- lapack-netlib/SRC/dgbtrs.c | 6 +++--- lapack-netlib/SRC/dgebak.c | 6 +++--- lapack-netlib/SRC/dgebal.c | 6 +++--- lapack-netlib/SRC/dgebd2.c | 6 +++--- lapack-netlib/SRC/dgebrd.c | 6 +++--- lapack-netlib/SRC/dgecon.c | 6 +++--- lapack-netlib/SRC/dgedmd.c | 6 +++--- lapack-netlib/SRC/dgedmdq.c | 6 +++--- lapack-netlib/SRC/dgeequ.c | 6 +++--- lapack-netlib/SRC/dgeequb.c | 6 +++--- lapack-netlib/SRC/dgees.c | 6 +++--- lapack-netlib/SRC/dgeesx.c | 6 +++--- lapack-netlib/SRC/dgeev.c | 6 +++--- lapack-netlib/SRC/dgeevx.c | 6 +++--- lapack-netlib/SRC/dgehd2.c | 6 +++--- lapack-netlib/SRC/dgehrd.c | 6 +++--- lapack-netlib/SRC/dgejsv.c | 6 +++--- lapack-netlib/SRC/dgelq.c | 6 +++--- lapack-netlib/SRC/dgelq2.c | 6 +++--- lapack-netlib/SRC/dgelqf.c | 6 +++--- lapack-netlib/SRC/dgelqt.c | 6 +++--- lapack-netlib/SRC/dgelqt3.c | 6 +++--- lapack-netlib/SRC/dgels.c | 6 +++--- lapack-netlib/SRC/dgelsd.c | 6 +++--- lapack-netlib/SRC/dgelss.c | 6 +++--- 81 files changed, 243 insertions(+), 243 deletions(-) diff --git a/lapack-netlib/SRC/cunbdb.c b/lapack-netlib/SRC/cunbdb.c index 0e4473348..78409b649 100644 --- a/lapack-netlib/SRC/cunbdb.c +++ b/lapack-netlib/SRC/cunbdb.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cunbdb1.c b/lapack-netlib/SRC/cunbdb1.c index 124443921..6039b6dd8 100644 --- a/lapack-netlib/SRC/cunbdb1.c +++ b/lapack-netlib/SRC/cunbdb1.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cunbdb2.c b/lapack-netlib/SRC/cunbdb2.c index 982e05efa..ea0ab9659 100644 --- a/lapack-netlib/SRC/cunbdb2.c +++ b/lapack-netlib/SRC/cunbdb2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cunbdb3.c b/lapack-netlib/SRC/cunbdb3.c index ebff11d71..319cfaf87 100644 --- a/lapack-netlib/SRC/cunbdb3.c +++ b/lapack-netlib/SRC/cunbdb3.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cunbdb4.c b/lapack-netlib/SRC/cunbdb4.c index d9e1e3df9..0f1612161 100644 --- a/lapack-netlib/SRC/cunbdb4.c +++ b/lapack-netlib/SRC/cunbdb4.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cunbdb5.c b/lapack-netlib/SRC/cunbdb5.c index 2ab0644ef..a317cdd53 100644 --- a/lapack-netlib/SRC/cunbdb5.c +++ b/lapack-netlib/SRC/cunbdb5.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cunbdb6.c b/lapack-netlib/SRC/cunbdb6.c index 6023d70d4..e233312a1 100644 --- a/lapack-netlib/SRC/cunbdb6.c +++ b/lapack-netlib/SRC/cunbdb6.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cuncsd.c b/lapack-netlib/SRC/cuncsd.c index 30b37d506..f018e8b2b 100644 --- a/lapack-netlib/SRC/cuncsd.c +++ b/lapack-netlib/SRC/cuncsd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cuncsd2by1.c b/lapack-netlib/SRC/cuncsd2by1.c index 8d4dec521..02e0c2954 100644 --- a/lapack-netlib/SRC/cuncsd2by1.c +++ b/lapack-netlib/SRC/cuncsd2by1.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cung2l.c b/lapack-netlib/SRC/cung2l.c index ab80fd3f8..d088d3996 100644 --- a/lapack-netlib/SRC/cung2l.c +++ b/lapack-netlib/SRC/cung2l.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cung2r.c b/lapack-netlib/SRC/cung2r.c index d88e9285b..d6365f0f2 100644 --- a/lapack-netlib/SRC/cung2r.c +++ b/lapack-netlib/SRC/cung2r.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cungbr.c b/lapack-netlib/SRC/cungbr.c index f25d67f48..0b30a5447 100644 --- a/lapack-netlib/SRC/cungbr.c +++ b/lapack-netlib/SRC/cungbr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cunghr.c b/lapack-netlib/SRC/cunghr.c index e4c398d94..7f3de0e8e 100644 --- a/lapack-netlib/SRC/cunghr.c +++ b/lapack-netlib/SRC/cunghr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cungl2.c b/lapack-netlib/SRC/cungl2.c index 310866871..e437ae11e 100644 --- a/lapack-netlib/SRC/cungl2.c +++ b/lapack-netlib/SRC/cungl2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cunglq.c b/lapack-netlib/SRC/cunglq.c index d51e1e5f9..c36b3abf8 100644 --- a/lapack-netlib/SRC/cunglq.c +++ b/lapack-netlib/SRC/cunglq.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cungql.c b/lapack-netlib/SRC/cungql.c index ab09d8ccf..b4caf5439 100644 --- a/lapack-netlib/SRC/cungql.c +++ b/lapack-netlib/SRC/cungql.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cungqr.c b/lapack-netlib/SRC/cungqr.c index 7da1ebb44..2f8e43c85 100644 --- a/lapack-netlib/SRC/cungqr.c +++ b/lapack-netlib/SRC/cungqr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cungr2.c b/lapack-netlib/SRC/cungr2.c index 63d99e854..a7b057ef6 100644 --- a/lapack-netlib/SRC/cungr2.c +++ b/lapack-netlib/SRC/cungr2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cungrq.c b/lapack-netlib/SRC/cungrq.c index c257eeb8e..220d1120f 100644 --- a/lapack-netlib/SRC/cungrq.c +++ b/lapack-netlib/SRC/cungrq.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cungtr.c b/lapack-netlib/SRC/cungtr.c index f640f9fed..dfdb11c13 100644 --- a/lapack-netlib/SRC/cungtr.c +++ b/lapack-netlib/SRC/cungtr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cungtsqr.c b/lapack-netlib/SRC/cungtsqr.c index 7b8c1f674..07c4713b5 100644 --- a/lapack-netlib/SRC/cungtsqr.c +++ b/lapack-netlib/SRC/cungtsqr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cungtsqr_row.c b/lapack-netlib/SRC/cungtsqr_row.c index 02221c7c4..f91f27ff1 100644 --- a/lapack-netlib/SRC/cungtsqr_row.c +++ b/lapack-netlib/SRC/cungtsqr_row.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cunhr_col.c b/lapack-netlib/SRC/cunhr_col.c index f06755953..1ae2f7f44 100644 --- a/lapack-netlib/SRC/cunhr_col.c +++ b/lapack-netlib/SRC/cunhr_col.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cunm22.c b/lapack-netlib/SRC/cunm22.c index 91ae37fb7..ff6ded41f 100644 --- a/lapack-netlib/SRC/cunm22.c +++ b/lapack-netlib/SRC/cunm22.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cunm2l.c b/lapack-netlib/SRC/cunm2l.c index 004757b92..b4c9fc428 100644 --- a/lapack-netlib/SRC/cunm2l.c +++ b/lapack-netlib/SRC/cunm2l.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cunm2r.c b/lapack-netlib/SRC/cunm2r.c index 0118b2da1..184d488b5 100644 --- a/lapack-netlib/SRC/cunm2r.c +++ b/lapack-netlib/SRC/cunm2r.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cunmbr.c b/lapack-netlib/SRC/cunmbr.c index 34c478e45..9cb953736 100644 --- a/lapack-netlib/SRC/cunmbr.c +++ b/lapack-netlib/SRC/cunmbr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cunmhr.c b/lapack-netlib/SRC/cunmhr.c index c10671114..9bd57a281 100644 --- a/lapack-netlib/SRC/cunmhr.c +++ b/lapack-netlib/SRC/cunmhr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cunml2.c b/lapack-netlib/SRC/cunml2.c index 9e7c39b33..244d1f820 100644 --- a/lapack-netlib/SRC/cunml2.c +++ b/lapack-netlib/SRC/cunml2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cunmlq.c b/lapack-netlib/SRC/cunmlq.c index 573d94628..93c9f14d4 100644 --- a/lapack-netlib/SRC/cunmlq.c +++ b/lapack-netlib/SRC/cunmlq.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cunmql.c b/lapack-netlib/SRC/cunmql.c index 1b6e0b294..9bf7fc282 100644 --- a/lapack-netlib/SRC/cunmql.c +++ b/lapack-netlib/SRC/cunmql.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cunmqr.c b/lapack-netlib/SRC/cunmqr.c index c823aec11..82653cf2b 100644 --- a/lapack-netlib/SRC/cunmqr.c +++ b/lapack-netlib/SRC/cunmqr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cunmr2.c b/lapack-netlib/SRC/cunmr2.c index dc9afb06a..b3a40daa3 100644 --- a/lapack-netlib/SRC/cunmr2.c +++ b/lapack-netlib/SRC/cunmr2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cunmr3.c b/lapack-netlib/SRC/cunmr3.c index a6170360c..69026f058 100644 --- a/lapack-netlib/SRC/cunmr3.c +++ b/lapack-netlib/SRC/cunmr3.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cunmrq.c b/lapack-netlib/SRC/cunmrq.c index 972242232..c981c7870 100644 --- a/lapack-netlib/SRC/cunmrq.c +++ b/lapack-netlib/SRC/cunmrq.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cunmrz.c b/lapack-netlib/SRC/cunmrz.c index fd800099b..d89c7ccd0 100644 --- a/lapack-netlib/SRC/cunmrz.c +++ b/lapack-netlib/SRC/cunmrz.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cunmtr.c b/lapack-netlib/SRC/cunmtr.c index d741e1d24..8b01c0cd2 100644 --- a/lapack-netlib/SRC/cunmtr.c +++ b/lapack-netlib/SRC/cunmtr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cupgtr.c b/lapack-netlib/SRC/cupgtr.c index 208d30991..72b1a07f9 100644 --- a/lapack-netlib/SRC/cupgtr.c +++ b/lapack-netlib/SRC/cupgtr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cupmtr.c b/lapack-netlib/SRC/cupmtr.c index 6fc539768..d58f36415 100644 --- a/lapack-netlib/SRC/cupmtr.c +++ b/lapack-netlib/SRC/cupmtr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dbbcsd.c b/lapack-netlib/SRC/dbbcsd.c index efc696925..1f354d2b0 100644 --- a/lapack-netlib/SRC/dbbcsd.c +++ b/lapack-netlib/SRC/dbbcsd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dbdsdc.c b/lapack-netlib/SRC/dbdsdc.c index 5c361289a..f4fa7b4e8 100644 --- a/lapack-netlib/SRC/dbdsdc.c +++ b/lapack-netlib/SRC/dbdsdc.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dbdsqr.c b/lapack-netlib/SRC/dbdsqr.c index a79cf8585..65e30e2ad 100644 --- a/lapack-netlib/SRC/dbdsqr.c +++ b/lapack-netlib/SRC/dbdsqr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dbdsvdx.c b/lapack-netlib/SRC/dbdsvdx.c index 5ed8353ba..74bd33f44 100644 --- a/lapack-netlib/SRC/dbdsvdx.c +++ b/lapack-netlib/SRC/dbdsvdx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dcombssq.c b/lapack-netlib/SRC/dcombssq.c index d3bb7ac7f..d833ab660 100644 --- a/lapack-netlib/SRC/dcombssq.c +++ b/lapack-netlib/SRC/dcombssq.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ddisna.c b/lapack-netlib/SRC/ddisna.c index c656acc67..a59c1d4f9 100644 --- a/lapack-netlib/SRC/ddisna.c +++ b/lapack-netlib/SRC/ddisna.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgbbrd.c b/lapack-netlib/SRC/dgbbrd.c index e4375607f..2bad6bd40 100644 --- a/lapack-netlib/SRC/dgbbrd.c +++ b/lapack-netlib/SRC/dgbbrd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgbcon.c b/lapack-netlib/SRC/dgbcon.c index 19d0c3938..b04ad3f92 100644 --- a/lapack-netlib/SRC/dgbcon.c +++ b/lapack-netlib/SRC/dgbcon.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgbequ.c b/lapack-netlib/SRC/dgbequ.c index 5801abd8a..c1d775e26 100644 --- a/lapack-netlib/SRC/dgbequ.c +++ b/lapack-netlib/SRC/dgbequ.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgbequb.c b/lapack-netlib/SRC/dgbequb.c index f7f8adca5..c405c0b74 100644 --- a/lapack-netlib/SRC/dgbequb.c +++ b/lapack-netlib/SRC/dgbequb.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgbrfs.c b/lapack-netlib/SRC/dgbrfs.c index 6adfe7428..e403ce4f2 100644 --- a/lapack-netlib/SRC/dgbrfs.c +++ b/lapack-netlib/SRC/dgbrfs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgbrfsx.c b/lapack-netlib/SRC/dgbrfsx.c index e088a7892..dbc4ff951 100644 --- a/lapack-netlib/SRC/dgbrfsx.c +++ b/lapack-netlib/SRC/dgbrfsx.c @@ -54,8 +54,8 @@ static inline _Complex float * _pCf(complex *z) {return (_Complex float*)z;} static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double*)z;} #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -257,7 +257,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgbsv.c b/lapack-netlib/SRC/dgbsv.c index 80d3abdc7..42aff65c2 100644 --- a/lapack-netlib/SRC/dgbsv.c +++ b/lapack-netlib/SRC/dgbsv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgbsvx.c b/lapack-netlib/SRC/dgbsvx.c index d3bcb4737..638699386 100644 --- a/lapack-netlib/SRC/dgbsvx.c +++ b/lapack-netlib/SRC/dgbsvx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgbsvxx.c b/lapack-netlib/SRC/dgbsvxx.c index 2e130bf2c..b9712b4ef 100644 --- a/lapack-netlib/SRC/dgbsvxx.c +++ b/lapack-netlib/SRC/dgbsvxx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgbtf2.c b/lapack-netlib/SRC/dgbtf2.c index e171be8b3..95bae6819 100644 --- a/lapack-netlib/SRC/dgbtf2.c +++ b/lapack-netlib/SRC/dgbtf2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgbtrf.c b/lapack-netlib/SRC/dgbtrf.c index 47b5a0365..f48571092 100644 --- a/lapack-netlib/SRC/dgbtrf.c +++ b/lapack-netlib/SRC/dgbtrf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgbtrs.c b/lapack-netlib/SRC/dgbtrs.c index 57468ed01..5015d0caa 100644 --- a/lapack-netlib/SRC/dgbtrs.c +++ b/lapack-netlib/SRC/dgbtrs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgebak.c b/lapack-netlib/SRC/dgebak.c index f412bfe92..bf93c4096 100644 --- a/lapack-netlib/SRC/dgebak.c +++ b/lapack-netlib/SRC/dgebak.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgebal.c b/lapack-netlib/SRC/dgebal.c index 869c3e7de..600cfa079 100644 --- a/lapack-netlib/SRC/dgebal.c +++ b/lapack-netlib/SRC/dgebal.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgebd2.c b/lapack-netlib/SRC/dgebd2.c index 94496ba24..3f78a865e 100644 --- a/lapack-netlib/SRC/dgebd2.c +++ b/lapack-netlib/SRC/dgebd2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgebrd.c b/lapack-netlib/SRC/dgebrd.c index 1589355e4..bb669a32b 100644 --- a/lapack-netlib/SRC/dgebrd.c +++ b/lapack-netlib/SRC/dgebrd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgecon.c b/lapack-netlib/SRC/dgecon.c index f76919175..332445a7f 100644 --- a/lapack-netlib/SRC/dgecon.c +++ b/lapack-netlib/SRC/dgecon.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgedmd.c b/lapack-netlib/SRC/dgedmd.c index 66b4d5da6..174488c51 100644 --- a/lapack-netlib/SRC/dgedmd.c +++ b/lapack-netlib/SRC/dgedmd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgedmdq.c b/lapack-netlib/SRC/dgedmdq.c index a743a3156..8e11366b5 100644 --- a/lapack-netlib/SRC/dgedmdq.c +++ b/lapack-netlib/SRC/dgedmdq.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgeequ.c b/lapack-netlib/SRC/dgeequ.c index 90e98664f..620c0c1c1 100644 --- a/lapack-netlib/SRC/dgeequ.c +++ b/lapack-netlib/SRC/dgeequ.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgeequb.c b/lapack-netlib/SRC/dgeequb.c index e79854540..c7d1be03c 100644 --- a/lapack-netlib/SRC/dgeequb.c +++ b/lapack-netlib/SRC/dgeequb.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgees.c b/lapack-netlib/SRC/dgees.c index 4c9946227..b97c66575 100644 --- a/lapack-netlib/SRC/dgees.c +++ b/lapack-netlib/SRC/dgees.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgeesx.c b/lapack-netlib/SRC/dgeesx.c index 1394a7953..5fa122ab6 100644 --- a/lapack-netlib/SRC/dgeesx.c +++ b/lapack-netlib/SRC/dgeesx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgeev.c b/lapack-netlib/SRC/dgeev.c index 5afca3c42..fd8b654ff 100644 --- a/lapack-netlib/SRC/dgeev.c +++ b/lapack-netlib/SRC/dgeev.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgeevx.c b/lapack-netlib/SRC/dgeevx.c index 03010fbb6..60832aa5b 100644 --- a/lapack-netlib/SRC/dgeevx.c +++ b/lapack-netlib/SRC/dgeevx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgehd2.c b/lapack-netlib/SRC/dgehd2.c index 9f1f39f56..8e0883f11 100644 --- a/lapack-netlib/SRC/dgehd2.c +++ b/lapack-netlib/SRC/dgehd2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgehrd.c b/lapack-netlib/SRC/dgehrd.c index 9944187fe..6a6e3c8c8 100644 --- a/lapack-netlib/SRC/dgehrd.c +++ b/lapack-netlib/SRC/dgehrd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgejsv.c b/lapack-netlib/SRC/dgejsv.c index 73b43e471..e815e5393 100644 --- a/lapack-netlib/SRC/dgejsv.c +++ b/lapack-netlib/SRC/dgejsv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgelq.c b/lapack-netlib/SRC/dgelq.c index 013cc57b2..39f5a4714 100644 --- a/lapack-netlib/SRC/dgelq.c +++ b/lapack-netlib/SRC/dgelq.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgelq2.c b/lapack-netlib/SRC/dgelq2.c index 9d76a14c0..89551491f 100644 --- a/lapack-netlib/SRC/dgelq2.c +++ b/lapack-netlib/SRC/dgelq2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgelqf.c b/lapack-netlib/SRC/dgelqf.c index 723008a89..8e3f7caa2 100644 --- a/lapack-netlib/SRC/dgelqf.c +++ b/lapack-netlib/SRC/dgelqf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgelqt.c b/lapack-netlib/SRC/dgelqt.c index 358b4dd31..8b89f7ce6 100644 --- a/lapack-netlib/SRC/dgelqt.c +++ b/lapack-netlib/SRC/dgelqt.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgelqt3.c b/lapack-netlib/SRC/dgelqt3.c index a16f2568f..34dd010c4 100644 --- a/lapack-netlib/SRC/dgelqt3.c +++ b/lapack-netlib/SRC/dgelqt3.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgels.c b/lapack-netlib/SRC/dgels.c index 4ee0785f9..543ad8ec0 100644 --- a/lapack-netlib/SRC/dgels.c +++ b/lapack-netlib/SRC/dgels.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgelsd.c b/lapack-netlib/SRC/dgelsd.c index 5b1694bac..ad88d1df4 100644 --- a/lapack-netlib/SRC/dgelsd.c +++ b/lapack-netlib/SRC/dgelsd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/dgelss.c b/lapack-netlib/SRC/dgelss.c index e2168b2a6..0a85bdcad 100644 --- a/lapack-netlib/SRC/dgelss.c +++ b/lapack-netlib/SRC/dgelss.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else From 466fb61c957a4cafb6dc822c3020acf94aa7ed54 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Thu, 4 Apr 2024 01:27:57 +0200 Subject: [PATCH 291/311] fix typedef of logical to support INTERFACE64 --- lapack-netlib/SRC/csysvx.c | 6 +++--- lapack-netlib/SRC/csysvxx.c | 6 +++--- lapack-netlib/SRC/csyswapr.c | 6 +++--- lapack-netlib/SRC/csytf2.c | 6 +++--- lapack-netlib/SRC/csytf2_rk.c | 6 +++--- lapack-netlib/SRC/csytf2_rook.c | 6 +++--- lapack-netlib/SRC/csytrf.c | 6 +++--- lapack-netlib/SRC/csytrf_aa.c | 6 +++--- lapack-netlib/SRC/csytrf_aa_2stage.c | 6 +++--- lapack-netlib/SRC/csytrf_rk.c | 6 +++--- lapack-netlib/SRC/csytrf_rook.c | 6 +++--- lapack-netlib/SRC/csytri.c | 6 +++--- lapack-netlib/SRC/csytri2.c | 6 +++--- lapack-netlib/SRC/csytri2x.c | 6 +++--- lapack-netlib/SRC/csytri_3.c | 6 +++--- lapack-netlib/SRC/csytri_3x.c | 6 +++--- lapack-netlib/SRC/csytri_rook.c | 6 +++--- lapack-netlib/SRC/csytrs.c | 6 +++--- lapack-netlib/SRC/csytrs2.c | 6 +++--- lapack-netlib/SRC/csytrs_3.c | 6 +++--- lapack-netlib/SRC/csytrs_aa.c | 6 +++--- lapack-netlib/SRC/csytrs_aa_2stage.c | 6 +++--- lapack-netlib/SRC/csytrs_rook.c | 6 +++--- lapack-netlib/SRC/ctbcon.c | 6 +++--- lapack-netlib/SRC/ctbrfs.c | 6 +++--- lapack-netlib/SRC/ctbtrs.c | 6 +++--- lapack-netlib/SRC/ctfsm.c | 6 +++--- lapack-netlib/SRC/ctftri.c | 6 +++--- lapack-netlib/SRC/ctfttp.c | 6 +++--- lapack-netlib/SRC/ctfttr.c | 6 +++--- lapack-netlib/SRC/ctgevc.c | 6 +++--- lapack-netlib/SRC/ctgex2.c | 6 +++--- lapack-netlib/SRC/ctgexc.c | 6 +++--- lapack-netlib/SRC/ctgsen.c | 6 +++--- lapack-netlib/SRC/ctgsja.c | 6 +++--- lapack-netlib/SRC/ctgsna.c | 6 +++--- lapack-netlib/SRC/ctgsy2.c | 6 +++--- lapack-netlib/SRC/ctgsyl.c | 6 +++--- lapack-netlib/SRC/ctpcon.c | 6 +++--- lapack-netlib/SRC/ctplqt.c | 6 +++--- lapack-netlib/SRC/ctplqt2.c | 6 +++--- lapack-netlib/SRC/ctpmlqt.c | 6 +++--- lapack-netlib/SRC/ctpmqrt.c | 6 +++--- lapack-netlib/SRC/ctpqrt.c | 6 +++--- lapack-netlib/SRC/ctpqrt2.c | 6 +++--- lapack-netlib/SRC/ctprfb.c | 6 +++--- lapack-netlib/SRC/ctprfs.c | 6 +++--- lapack-netlib/SRC/ctptri.c | 6 +++--- lapack-netlib/SRC/ctptrs.c | 6 +++--- lapack-netlib/SRC/ctpttf.c | 6 +++--- lapack-netlib/SRC/ctpttr.c | 6 +++--- lapack-netlib/SRC/ctrcon.c | 6 +++--- lapack-netlib/SRC/ctrevc.c | 6 +++--- lapack-netlib/SRC/ctrevc3.c | 6 +++--- lapack-netlib/SRC/ctrexc.c | 6 +++--- lapack-netlib/SRC/ctrrfs.c | 6 +++--- lapack-netlib/SRC/ctrsen.c | 6 +++--- lapack-netlib/SRC/ctrsna.c | 6 +++--- lapack-netlib/SRC/ctrsyl.c | 6 +++--- lapack-netlib/SRC/ctrsyl3.c | 6 +++--- lapack-netlib/SRC/ctrti2.c | 6 +++--- lapack-netlib/SRC/ctrtri.c | 6 +++--- lapack-netlib/SRC/ctrtrs.c | 6 +++--- lapack-netlib/SRC/ctrttf.c | 6 +++--- lapack-netlib/SRC/ctrttp.c | 6 +++--- lapack-netlib/SRC/ctzrzf.c | 6 +++--- 66 files changed, 198 insertions(+), 198 deletions(-) diff --git a/lapack-netlib/SRC/csysvx.c b/lapack-netlib/SRC/csysvx.c index 42146a032..9a846eab6 100644 --- a/lapack-netlib/SRC/csysvx.c +++ b/lapack-netlib/SRC/csysvx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/csysvxx.c b/lapack-netlib/SRC/csysvxx.c index 5c0269d28..714bcedfd 100644 --- a/lapack-netlib/SRC/csysvxx.c +++ b/lapack-netlib/SRC/csysvxx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/csyswapr.c b/lapack-netlib/SRC/csyswapr.c index 69774cbc0..c61b90b8d 100644 --- a/lapack-netlib/SRC/csyswapr.c +++ b/lapack-netlib/SRC/csyswapr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/csytf2.c b/lapack-netlib/SRC/csytf2.c index eb6eeb4d0..2a7365d11 100644 --- a/lapack-netlib/SRC/csytf2.c +++ b/lapack-netlib/SRC/csytf2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/csytf2_rk.c b/lapack-netlib/SRC/csytf2_rk.c index fc5beefa8..018e64bdf 100644 --- a/lapack-netlib/SRC/csytf2_rk.c +++ b/lapack-netlib/SRC/csytf2_rk.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/csytf2_rook.c b/lapack-netlib/SRC/csytf2_rook.c index 9fab25bb3..08de556d6 100644 --- a/lapack-netlib/SRC/csytf2_rook.c +++ b/lapack-netlib/SRC/csytf2_rook.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/csytrf.c b/lapack-netlib/SRC/csytrf.c index 56aef71da..42d0d5ba5 100644 --- a/lapack-netlib/SRC/csytrf.c +++ b/lapack-netlib/SRC/csytrf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/csytrf_aa.c b/lapack-netlib/SRC/csytrf_aa.c index 986295a52..1e7d23442 100644 --- a/lapack-netlib/SRC/csytrf_aa.c +++ b/lapack-netlib/SRC/csytrf_aa.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/csytrf_aa_2stage.c b/lapack-netlib/SRC/csytrf_aa_2stage.c index 52f595dba..3407f0786 100644 --- a/lapack-netlib/SRC/csytrf_aa_2stage.c +++ b/lapack-netlib/SRC/csytrf_aa_2stage.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/csytrf_rk.c b/lapack-netlib/SRC/csytrf_rk.c index e26e6f8fa..4871cfef0 100644 --- a/lapack-netlib/SRC/csytrf_rk.c +++ b/lapack-netlib/SRC/csytrf_rk.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/csytrf_rook.c b/lapack-netlib/SRC/csytrf_rook.c index fbff30524..7b6d677ac 100644 --- a/lapack-netlib/SRC/csytrf_rook.c +++ b/lapack-netlib/SRC/csytrf_rook.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/csytri.c b/lapack-netlib/SRC/csytri.c index f7a9ac3fb..7a21c3765 100644 --- a/lapack-netlib/SRC/csytri.c +++ b/lapack-netlib/SRC/csytri.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/csytri2.c b/lapack-netlib/SRC/csytri2.c index d20e8fe1c..810a94a63 100644 --- a/lapack-netlib/SRC/csytri2.c +++ b/lapack-netlib/SRC/csytri2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/csytri2x.c b/lapack-netlib/SRC/csytri2x.c index 2e0083ccb..0b08383ba 100644 --- a/lapack-netlib/SRC/csytri2x.c +++ b/lapack-netlib/SRC/csytri2x.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/csytri_3.c b/lapack-netlib/SRC/csytri_3.c index 2622d4c45..793934502 100644 --- a/lapack-netlib/SRC/csytri_3.c +++ b/lapack-netlib/SRC/csytri_3.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/csytri_3x.c b/lapack-netlib/SRC/csytri_3x.c index 6d543a5a3..f32a69bdc 100644 --- a/lapack-netlib/SRC/csytri_3x.c +++ b/lapack-netlib/SRC/csytri_3x.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/csytri_rook.c b/lapack-netlib/SRC/csytri_rook.c index 9718a082a..9c482892e 100644 --- a/lapack-netlib/SRC/csytri_rook.c +++ b/lapack-netlib/SRC/csytri_rook.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/csytrs.c b/lapack-netlib/SRC/csytrs.c index 7a51af61f..c3b5bc3fb 100644 --- a/lapack-netlib/SRC/csytrs.c +++ b/lapack-netlib/SRC/csytrs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/csytrs2.c b/lapack-netlib/SRC/csytrs2.c index 8b100db3b..b34cba701 100644 --- a/lapack-netlib/SRC/csytrs2.c +++ b/lapack-netlib/SRC/csytrs2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/csytrs_3.c b/lapack-netlib/SRC/csytrs_3.c index 739718c1c..eaa441dfa 100644 --- a/lapack-netlib/SRC/csytrs_3.c +++ b/lapack-netlib/SRC/csytrs_3.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/csytrs_aa.c b/lapack-netlib/SRC/csytrs_aa.c index 719a494a6..cdb90e655 100644 --- a/lapack-netlib/SRC/csytrs_aa.c +++ b/lapack-netlib/SRC/csytrs_aa.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/csytrs_aa_2stage.c b/lapack-netlib/SRC/csytrs_aa_2stage.c index fedd0e468..1a3f3bd19 100644 --- a/lapack-netlib/SRC/csytrs_aa_2stage.c +++ b/lapack-netlib/SRC/csytrs_aa_2stage.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/csytrs_rook.c b/lapack-netlib/SRC/csytrs_rook.c index f80623ef2..a172f143d 100644 --- a/lapack-netlib/SRC/csytrs_rook.c +++ b/lapack-netlib/SRC/csytrs_rook.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ctbcon.c b/lapack-netlib/SRC/ctbcon.c index effcb30a0..77c8b2c91 100644 --- a/lapack-netlib/SRC/ctbcon.c +++ b/lapack-netlib/SRC/ctbcon.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ctbrfs.c b/lapack-netlib/SRC/ctbrfs.c index 08616fb37..2f44a336a 100644 --- a/lapack-netlib/SRC/ctbrfs.c +++ b/lapack-netlib/SRC/ctbrfs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ctbtrs.c b/lapack-netlib/SRC/ctbtrs.c index 560c1efef..215fce151 100644 --- a/lapack-netlib/SRC/ctbtrs.c +++ b/lapack-netlib/SRC/ctbtrs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ctfsm.c b/lapack-netlib/SRC/ctfsm.c index 695dbcff0..7d8413e3f 100644 --- a/lapack-netlib/SRC/ctfsm.c +++ b/lapack-netlib/SRC/ctfsm.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ctftri.c b/lapack-netlib/SRC/ctftri.c index adef1cab9..1bad044db 100644 --- a/lapack-netlib/SRC/ctftri.c +++ b/lapack-netlib/SRC/ctftri.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ctfttp.c b/lapack-netlib/SRC/ctfttp.c index 11e5be640..7b37de986 100644 --- a/lapack-netlib/SRC/ctfttp.c +++ b/lapack-netlib/SRC/ctfttp.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ctfttr.c b/lapack-netlib/SRC/ctfttr.c index 9afa0ef87..8143db540 100644 --- a/lapack-netlib/SRC/ctfttr.c +++ b/lapack-netlib/SRC/ctfttr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ctgevc.c b/lapack-netlib/SRC/ctgevc.c index fa36f7e9c..157d2e6e8 100644 --- a/lapack-netlib/SRC/ctgevc.c +++ b/lapack-netlib/SRC/ctgevc.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ctgex2.c b/lapack-netlib/SRC/ctgex2.c index bfd6afea0..7ab23e706 100644 --- a/lapack-netlib/SRC/ctgex2.c +++ b/lapack-netlib/SRC/ctgex2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ctgexc.c b/lapack-netlib/SRC/ctgexc.c index 75ca67860..784b53c78 100644 --- a/lapack-netlib/SRC/ctgexc.c +++ b/lapack-netlib/SRC/ctgexc.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ctgsen.c b/lapack-netlib/SRC/ctgsen.c index f5c3f6a9f..3e356fc66 100644 --- a/lapack-netlib/SRC/ctgsen.c +++ b/lapack-netlib/SRC/ctgsen.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ctgsja.c b/lapack-netlib/SRC/ctgsja.c index c968c9e7f..bc02dee49 100644 --- a/lapack-netlib/SRC/ctgsja.c +++ b/lapack-netlib/SRC/ctgsja.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ctgsna.c b/lapack-netlib/SRC/ctgsna.c index f11f2cd56..34f2d7717 100644 --- a/lapack-netlib/SRC/ctgsna.c +++ b/lapack-netlib/SRC/ctgsna.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ctgsy2.c b/lapack-netlib/SRC/ctgsy2.c index f3089d44b..e28957b0a 100644 --- a/lapack-netlib/SRC/ctgsy2.c +++ b/lapack-netlib/SRC/ctgsy2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ctgsyl.c b/lapack-netlib/SRC/ctgsyl.c index 0fb5e88ca..6e7bbdab5 100644 --- a/lapack-netlib/SRC/ctgsyl.c +++ b/lapack-netlib/SRC/ctgsyl.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ctpcon.c b/lapack-netlib/SRC/ctpcon.c index 0db65c2fe..b918f9b5b 100644 --- a/lapack-netlib/SRC/ctpcon.c +++ b/lapack-netlib/SRC/ctpcon.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ctplqt.c b/lapack-netlib/SRC/ctplqt.c index 2fb820e75..a94b1748c 100644 --- a/lapack-netlib/SRC/ctplqt.c +++ b/lapack-netlib/SRC/ctplqt.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ctplqt2.c b/lapack-netlib/SRC/ctplqt2.c index 78eaea487..8537afeaf 100644 --- a/lapack-netlib/SRC/ctplqt2.c +++ b/lapack-netlib/SRC/ctplqt2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ctpmlqt.c b/lapack-netlib/SRC/ctpmlqt.c index abd33f4ba..aaa8b4a05 100644 --- a/lapack-netlib/SRC/ctpmlqt.c +++ b/lapack-netlib/SRC/ctpmlqt.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ctpmqrt.c b/lapack-netlib/SRC/ctpmqrt.c index a1f04291f..760933096 100644 --- a/lapack-netlib/SRC/ctpmqrt.c +++ b/lapack-netlib/SRC/ctpmqrt.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ctpqrt.c b/lapack-netlib/SRC/ctpqrt.c index 63541ba53..dcf92a64e 100644 --- a/lapack-netlib/SRC/ctpqrt.c +++ b/lapack-netlib/SRC/ctpqrt.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ctpqrt2.c b/lapack-netlib/SRC/ctpqrt2.c index 39110b7b0..d9196e943 100644 --- a/lapack-netlib/SRC/ctpqrt2.c +++ b/lapack-netlib/SRC/ctpqrt2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ctprfb.c b/lapack-netlib/SRC/ctprfb.c index 25a042da7..a9284c00d 100644 --- a/lapack-netlib/SRC/ctprfb.c +++ b/lapack-netlib/SRC/ctprfb.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ctprfs.c b/lapack-netlib/SRC/ctprfs.c index f125c87e1..fc9112e3e 100644 --- a/lapack-netlib/SRC/ctprfs.c +++ b/lapack-netlib/SRC/ctprfs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ctptri.c b/lapack-netlib/SRC/ctptri.c index c24e75804..8f7548cc6 100644 --- a/lapack-netlib/SRC/ctptri.c +++ b/lapack-netlib/SRC/ctptri.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ctptrs.c b/lapack-netlib/SRC/ctptrs.c index fd1d98804..6aa7c04b7 100644 --- a/lapack-netlib/SRC/ctptrs.c +++ b/lapack-netlib/SRC/ctptrs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ctpttf.c b/lapack-netlib/SRC/ctpttf.c index 6672d195c..4d6a7c54c 100644 --- a/lapack-netlib/SRC/ctpttf.c +++ b/lapack-netlib/SRC/ctpttf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ctpttr.c b/lapack-netlib/SRC/ctpttr.c index b911d65f7..6ddcb6297 100644 --- a/lapack-netlib/SRC/ctpttr.c +++ b/lapack-netlib/SRC/ctpttr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ctrcon.c b/lapack-netlib/SRC/ctrcon.c index b21fdbcb4..852913d08 100644 --- a/lapack-netlib/SRC/ctrcon.c +++ b/lapack-netlib/SRC/ctrcon.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ctrevc.c b/lapack-netlib/SRC/ctrevc.c index 72d6c461c..9336764e2 100644 --- a/lapack-netlib/SRC/ctrevc.c +++ b/lapack-netlib/SRC/ctrevc.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ctrevc3.c b/lapack-netlib/SRC/ctrevc3.c index 5c71dfb21..f50268713 100644 --- a/lapack-netlib/SRC/ctrevc3.c +++ b/lapack-netlib/SRC/ctrevc3.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ctrexc.c b/lapack-netlib/SRC/ctrexc.c index c94094349..359b3284f 100644 --- a/lapack-netlib/SRC/ctrexc.c +++ b/lapack-netlib/SRC/ctrexc.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ctrrfs.c b/lapack-netlib/SRC/ctrrfs.c index a672a1647..df2b362c1 100644 --- a/lapack-netlib/SRC/ctrrfs.c +++ b/lapack-netlib/SRC/ctrrfs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ctrsen.c b/lapack-netlib/SRC/ctrsen.c index ca1dc3491..5f6501ad5 100644 --- a/lapack-netlib/SRC/ctrsen.c +++ b/lapack-netlib/SRC/ctrsen.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ctrsna.c b/lapack-netlib/SRC/ctrsna.c index 763072c35..79cc3edbb 100644 --- a/lapack-netlib/SRC/ctrsna.c +++ b/lapack-netlib/SRC/ctrsna.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ctrsyl.c b/lapack-netlib/SRC/ctrsyl.c index 1987a27cb..8e5ffad1b 100644 --- a/lapack-netlib/SRC/ctrsyl.c +++ b/lapack-netlib/SRC/ctrsyl.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ctrsyl3.c b/lapack-netlib/SRC/ctrsyl3.c index d1ee7aa16..e175c648e 100644 --- a/lapack-netlib/SRC/ctrsyl3.c +++ b/lapack-netlib/SRC/ctrsyl3.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -263,7 +263,7 @@ static int my_expfunc(float *x) {int e; (void)frexpf(*x,&e); return e;} /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ctrti2.c b/lapack-netlib/SRC/ctrti2.c index 6622f870f..145f2f599 100644 --- a/lapack-netlib/SRC/ctrti2.c +++ b/lapack-netlib/SRC/ctrti2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ctrtri.c b/lapack-netlib/SRC/ctrtri.c index 7b4b9191c..ade3ce9c7 100644 --- a/lapack-netlib/SRC/ctrtri.c +++ b/lapack-netlib/SRC/ctrtri.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ctrtrs.c b/lapack-netlib/SRC/ctrtrs.c index 024369220..c7fdfc347 100644 --- a/lapack-netlib/SRC/ctrtrs.c +++ b/lapack-netlib/SRC/ctrtrs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ctrttf.c b/lapack-netlib/SRC/ctrttf.c index 0f735e92e..1128ed548 100644 --- a/lapack-netlib/SRC/ctrttf.c +++ b/lapack-netlib/SRC/ctrttf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ctrttp.c b/lapack-netlib/SRC/ctrttp.c index b6487a943..116a080ec 100644 --- a/lapack-netlib/SRC/ctrttp.c +++ b/lapack-netlib/SRC/ctrttp.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/ctzrzf.c b/lapack-netlib/SRC/ctzrzf.c index 89e13e78c..453043c6b 100644 --- a/lapack-netlib/SRC/ctzrzf.c +++ b/lapack-netlib/SRC/ctzrzf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else From 8bed05a9368b981c66e207eb5b42f0edc30e5ca1 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Thu, 4 Apr 2024 01:32:37 +0200 Subject: [PATCH 292/311] fix typedef of logical to support INTERFACE64 --- lapack-netlib/SRC/claswp.c | 6 +++--- lapack-netlib/SRC/clasyf.c | 6 +++--- lapack-netlib/SRC/clasyf_aa.c | 6 +++--- lapack-netlib/SRC/clasyf_rk.c | 6 +++--- lapack-netlib/SRC/clasyf_rook.c | 6 +++--- lapack-netlib/SRC/clatbs.c | 6 +++--- lapack-netlib/SRC/clatdf.c | 6 +++--- lapack-netlib/SRC/clatps.c | 6 +++--- lapack-netlib/SRC/clatrd.c | 6 +++--- lapack-netlib/SRC/clatrs.c | 6 +++--- lapack-netlib/SRC/clatrs3.c | 6 +++--- lapack-netlib/SRC/clatrz.c | 6 +++--- lapack-netlib/SRC/clatsqr.c | 6 +++--- lapack-netlib/SRC/claunhr_col_getrfnp.c | 6 +++--- lapack-netlib/SRC/claunhr_col_getrfnp2.c | 6 +++--- lapack-netlib/SRC/clauu2.c | 6 +++--- lapack-netlib/SRC/clauum.c | 6 +++--- lapack-netlib/SRC/cpbcon.c | 6 +++--- lapack-netlib/SRC/cpbequ.c | 6 +++--- lapack-netlib/SRC/cpbrfs.c | 6 +++--- lapack-netlib/SRC/cpbstf.c | 6 +++--- lapack-netlib/SRC/cpbsv.c | 6 +++--- lapack-netlib/SRC/cpbsvx.c | 6 +++--- lapack-netlib/SRC/cpbtf2.c | 6 +++--- lapack-netlib/SRC/cpbtrf.c | 6 +++--- lapack-netlib/SRC/cpbtrs.c | 6 +++--- lapack-netlib/SRC/cpftrf.c | 6 +++--- lapack-netlib/SRC/cpftri.c | 6 +++--- lapack-netlib/SRC/cpftrs.c | 6 +++--- lapack-netlib/SRC/cpocon.c | 6 +++--- lapack-netlib/SRC/cpoequ.c | 6 +++--- lapack-netlib/SRC/cpoequb.c | 6 +++--- lapack-netlib/SRC/cporfs.c | 6 +++--- lapack-netlib/SRC/cporfsx.c | 6 +++--- lapack-netlib/SRC/cposv.c | 6 +++--- lapack-netlib/SRC/cposvx.c | 6 +++--- lapack-netlib/SRC/cposvxx.c | 6 +++--- lapack-netlib/SRC/cpotf2.c | 6 +++--- lapack-netlib/SRC/cpotrf.c | 6 +++--- lapack-netlib/SRC/cpotrf2.c | 6 +++--- lapack-netlib/SRC/cpotri.c | 6 +++--- lapack-netlib/SRC/cpotrs.c | 6 +++--- lapack-netlib/SRC/cppcon.c | 6 +++--- lapack-netlib/SRC/cppequ.c | 6 +++--- lapack-netlib/SRC/cpprfs.c | 6 +++--- lapack-netlib/SRC/cppsv.c | 6 +++--- lapack-netlib/SRC/cppsvx.c | 6 +++--- lapack-netlib/SRC/cpptrf.c | 6 +++--- lapack-netlib/SRC/cpptri.c | 6 +++--- lapack-netlib/SRC/cpptrs.c | 6 +++--- lapack-netlib/SRC/cpstf2.c | 6 +++--- lapack-netlib/SRC/cpstrf.c | 6 +++--- lapack-netlib/SRC/cptcon.c | 6 +++--- lapack-netlib/SRC/cpteqr.c | 6 +++--- lapack-netlib/SRC/cptrfs.c | 6 +++--- lapack-netlib/SRC/cptsv.c | 6 +++--- lapack-netlib/SRC/cptsvx.c | 6 +++--- lapack-netlib/SRC/cpttrf.c | 6 +++--- lapack-netlib/SRC/cpttrs.c | 6 +++--- lapack-netlib/SRC/cptts2.c | 6 +++--- lapack-netlib/SRC/crot.c | 6 +++--- lapack-netlib/SRC/crscl.c | 6 +++--- lapack-netlib/SRC/cspcon.c | 6 +++--- lapack-netlib/SRC/cspmv.c | 6 +++--- lapack-netlib/SRC/cspr.c | 6 +++--- lapack-netlib/SRC/csprfs.c | 6 +++--- lapack-netlib/SRC/cspsv.c | 6 +++--- lapack-netlib/SRC/cspsvx.c | 6 +++--- lapack-netlib/SRC/csptrf.c | 6 +++--- lapack-netlib/SRC/csptri.c | 6 +++--- lapack-netlib/SRC/csptrs.c | 6 +++--- lapack-netlib/SRC/csrscl.c | 6 +++--- lapack-netlib/SRC/cstedc.c | 6 +++--- lapack-netlib/SRC/cstegr.c | 6 +++--- lapack-netlib/SRC/cstein.c | 6 +++--- lapack-netlib/SRC/cstemr.c | 6 +++--- lapack-netlib/SRC/csteqr.c | 6 +++--- lapack-netlib/SRC/csycon.c | 6 +++--- lapack-netlib/SRC/csycon_3.c | 6 +++--- lapack-netlib/SRC/csycon_rook.c | 6 +++--- lapack-netlib/SRC/csyconv.c | 6 +++--- lapack-netlib/SRC/csyconvf.c | 6 +++--- lapack-netlib/SRC/csyconvf_rook.c | 6 +++--- lapack-netlib/SRC/csyequb.c | 6 +++--- lapack-netlib/SRC/csymv.c | 6 +++--- lapack-netlib/SRC/csyr.c | 6 +++--- lapack-netlib/SRC/csyrfs.c | 6 +++--- lapack-netlib/SRC/csyrfsx.c | 6 +++--- lapack-netlib/SRC/csysv.c | 6 +++--- lapack-netlib/SRC/csysv_aa.c | 6 +++--- lapack-netlib/SRC/csysv_aa_2stage.c | 6 +++--- lapack-netlib/SRC/csysv_rk.c | 6 +++--- lapack-netlib/SRC/csysv_rook.c | 6 +++--- 93 files changed, 279 insertions(+), 279 deletions(-) diff --git a/lapack-netlib/SRC/claswp.c b/lapack-netlib/SRC/claswp.c index 404e6aad5..372a7960d 100644 --- a/lapack-netlib/SRC/claswp.c +++ b/lapack-netlib/SRC/claswp.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/clasyf.c b/lapack-netlib/SRC/clasyf.c index df3a0d9f0..89b1f75f8 100644 --- a/lapack-netlib/SRC/clasyf.c +++ b/lapack-netlib/SRC/clasyf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/clasyf_aa.c b/lapack-netlib/SRC/clasyf_aa.c index 6f5898961..9f986aedf 100644 --- a/lapack-netlib/SRC/clasyf_aa.c +++ b/lapack-netlib/SRC/clasyf_aa.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/clasyf_rk.c b/lapack-netlib/SRC/clasyf_rk.c index f72b1c105..e592a19c3 100644 --- a/lapack-netlib/SRC/clasyf_rk.c +++ b/lapack-netlib/SRC/clasyf_rk.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/clasyf_rook.c b/lapack-netlib/SRC/clasyf_rook.c index a4613912f..1ed592bd4 100644 --- a/lapack-netlib/SRC/clasyf_rook.c +++ b/lapack-netlib/SRC/clasyf_rook.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/clatbs.c b/lapack-netlib/SRC/clatbs.c index 168aca749..df8e5e02e 100644 --- a/lapack-netlib/SRC/clatbs.c +++ b/lapack-netlib/SRC/clatbs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/clatdf.c b/lapack-netlib/SRC/clatdf.c index 68c1d63ef..7ab67315c 100644 --- a/lapack-netlib/SRC/clatdf.c +++ b/lapack-netlib/SRC/clatdf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/clatps.c b/lapack-netlib/SRC/clatps.c index 64563abbd..ff8f2172e 100644 --- a/lapack-netlib/SRC/clatps.c +++ b/lapack-netlib/SRC/clatps.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/clatrd.c b/lapack-netlib/SRC/clatrd.c index f1c30202b..3e8328522 100644 --- a/lapack-netlib/SRC/clatrd.c +++ b/lapack-netlib/SRC/clatrd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/clatrs.c b/lapack-netlib/SRC/clatrs.c index 61e43419d..9363e028b 100644 --- a/lapack-netlib/SRC/clatrs.c +++ b/lapack-netlib/SRC/clatrs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/clatrs3.c b/lapack-netlib/SRC/clatrs3.c index a53483ff0..91bd5cdfd 100644 --- a/lapack-netlib/SRC/clatrs3.c +++ b/lapack-netlib/SRC/clatrs3.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -263,7 +263,7 @@ static int my_expfunc(float *x) {int e; (void)frexpf(*x,&e); return e;} /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/clatrz.c b/lapack-netlib/SRC/clatrz.c index 2447fbac1..531c800da 100644 --- a/lapack-netlib/SRC/clatrz.c +++ b/lapack-netlib/SRC/clatrz.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/clatsqr.c b/lapack-netlib/SRC/clatsqr.c index d88e0da3a..42576d127 100644 --- a/lapack-netlib/SRC/clatsqr.c +++ b/lapack-netlib/SRC/clatsqr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/claunhr_col_getrfnp.c b/lapack-netlib/SRC/claunhr_col_getrfnp.c index 70f8c44dc..8c14b0578 100644 --- a/lapack-netlib/SRC/claunhr_col_getrfnp.c +++ b/lapack-netlib/SRC/claunhr_col_getrfnp.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/claunhr_col_getrfnp2.c b/lapack-netlib/SRC/claunhr_col_getrfnp2.c index 65fdc0027..6b405e255 100644 --- a/lapack-netlib/SRC/claunhr_col_getrfnp2.c +++ b/lapack-netlib/SRC/claunhr_col_getrfnp2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/clauu2.c b/lapack-netlib/SRC/clauu2.c index 2be32a3c0..07c021388 100644 --- a/lapack-netlib/SRC/clauu2.c +++ b/lapack-netlib/SRC/clauu2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/clauum.c b/lapack-netlib/SRC/clauum.c index 45a1de4a9..e0e9c992c 100644 --- a/lapack-netlib/SRC/clauum.c +++ b/lapack-netlib/SRC/clauum.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cpbcon.c b/lapack-netlib/SRC/cpbcon.c index e46ce643a..4ae81d084 100644 --- a/lapack-netlib/SRC/cpbcon.c +++ b/lapack-netlib/SRC/cpbcon.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cpbequ.c b/lapack-netlib/SRC/cpbequ.c index 0d69760da..49f42ad23 100644 --- a/lapack-netlib/SRC/cpbequ.c +++ b/lapack-netlib/SRC/cpbequ.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cpbrfs.c b/lapack-netlib/SRC/cpbrfs.c index fccc1f3d4..c80fe8a36 100644 --- a/lapack-netlib/SRC/cpbrfs.c +++ b/lapack-netlib/SRC/cpbrfs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cpbstf.c b/lapack-netlib/SRC/cpbstf.c index f0a88e4b4..ceb0a4d27 100644 --- a/lapack-netlib/SRC/cpbstf.c +++ b/lapack-netlib/SRC/cpbstf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cpbsv.c b/lapack-netlib/SRC/cpbsv.c index 83b0f63b1..b69809ecf 100644 --- a/lapack-netlib/SRC/cpbsv.c +++ b/lapack-netlib/SRC/cpbsv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cpbsvx.c b/lapack-netlib/SRC/cpbsvx.c index 49925c13c..b9f7c4493 100644 --- a/lapack-netlib/SRC/cpbsvx.c +++ b/lapack-netlib/SRC/cpbsvx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cpbtf2.c b/lapack-netlib/SRC/cpbtf2.c index de89747f9..e2cfb6ad9 100644 --- a/lapack-netlib/SRC/cpbtf2.c +++ b/lapack-netlib/SRC/cpbtf2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cpbtrf.c b/lapack-netlib/SRC/cpbtrf.c index b239f20b4..3aaa28744 100644 --- a/lapack-netlib/SRC/cpbtrf.c +++ b/lapack-netlib/SRC/cpbtrf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cpbtrs.c b/lapack-netlib/SRC/cpbtrs.c index 14b1bae6f..24939ae44 100644 --- a/lapack-netlib/SRC/cpbtrs.c +++ b/lapack-netlib/SRC/cpbtrs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cpftrf.c b/lapack-netlib/SRC/cpftrf.c index 67bdc365e..04b6a7def 100644 --- a/lapack-netlib/SRC/cpftrf.c +++ b/lapack-netlib/SRC/cpftrf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cpftri.c b/lapack-netlib/SRC/cpftri.c index 9005b128a..a0c598442 100644 --- a/lapack-netlib/SRC/cpftri.c +++ b/lapack-netlib/SRC/cpftri.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cpftrs.c b/lapack-netlib/SRC/cpftrs.c index 2feb7e53b..7fa6bd350 100644 --- a/lapack-netlib/SRC/cpftrs.c +++ b/lapack-netlib/SRC/cpftrs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cpocon.c b/lapack-netlib/SRC/cpocon.c index 6665d0037..e20c2994d 100644 --- a/lapack-netlib/SRC/cpocon.c +++ b/lapack-netlib/SRC/cpocon.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cpoequ.c b/lapack-netlib/SRC/cpoequ.c index f7f9e87cf..2006b12a2 100644 --- a/lapack-netlib/SRC/cpoequ.c +++ b/lapack-netlib/SRC/cpoequ.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cpoequb.c b/lapack-netlib/SRC/cpoequb.c index b7c246116..2c9f5a764 100644 --- a/lapack-netlib/SRC/cpoequb.c +++ b/lapack-netlib/SRC/cpoequb.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cporfs.c b/lapack-netlib/SRC/cporfs.c index 5c3237ec9..7c9b90d75 100644 --- a/lapack-netlib/SRC/cporfs.c +++ b/lapack-netlib/SRC/cporfs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cporfsx.c b/lapack-netlib/SRC/cporfsx.c index aa3ac4f72..61885f2fe 100644 --- a/lapack-netlib/SRC/cporfsx.c +++ b/lapack-netlib/SRC/cporfsx.c @@ -54,8 +54,8 @@ static inline _Complex float * _pCf(complex *z) {return (_Complex float*)z;} static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double*)z;} #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -257,7 +257,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cposv.c b/lapack-netlib/SRC/cposv.c index 2a24682ac..2616194fc 100644 --- a/lapack-netlib/SRC/cposv.c +++ b/lapack-netlib/SRC/cposv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cposvx.c b/lapack-netlib/SRC/cposvx.c index 10161efaf..60862279e 100644 --- a/lapack-netlib/SRC/cposvx.c +++ b/lapack-netlib/SRC/cposvx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cposvxx.c b/lapack-netlib/SRC/cposvxx.c index d36d9b4a3..6f64b6eb3 100644 --- a/lapack-netlib/SRC/cposvxx.c +++ b/lapack-netlib/SRC/cposvxx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cpotf2.c b/lapack-netlib/SRC/cpotf2.c index 6d6d4182f..1fffebc67 100644 --- a/lapack-netlib/SRC/cpotf2.c +++ b/lapack-netlib/SRC/cpotf2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cpotrf.c b/lapack-netlib/SRC/cpotrf.c index 5395ad952..155302fd9 100644 --- a/lapack-netlib/SRC/cpotrf.c +++ b/lapack-netlib/SRC/cpotrf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cpotrf2.c b/lapack-netlib/SRC/cpotrf2.c index ff478e774..a8b289161 100644 --- a/lapack-netlib/SRC/cpotrf2.c +++ b/lapack-netlib/SRC/cpotrf2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cpotri.c b/lapack-netlib/SRC/cpotri.c index 6681781e3..f82badadc 100644 --- a/lapack-netlib/SRC/cpotri.c +++ b/lapack-netlib/SRC/cpotri.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cpotrs.c b/lapack-netlib/SRC/cpotrs.c index dfedbef85..c614de522 100644 --- a/lapack-netlib/SRC/cpotrs.c +++ b/lapack-netlib/SRC/cpotrs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cppcon.c b/lapack-netlib/SRC/cppcon.c index ad4cbd1ee..66087fb86 100644 --- a/lapack-netlib/SRC/cppcon.c +++ b/lapack-netlib/SRC/cppcon.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cppequ.c b/lapack-netlib/SRC/cppequ.c index 27e735cdf..eb350ca0a 100644 --- a/lapack-netlib/SRC/cppequ.c +++ b/lapack-netlib/SRC/cppequ.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cpprfs.c b/lapack-netlib/SRC/cpprfs.c index 185f15996..72afc9c19 100644 --- a/lapack-netlib/SRC/cpprfs.c +++ b/lapack-netlib/SRC/cpprfs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cppsv.c b/lapack-netlib/SRC/cppsv.c index 4f2ae517d..e9320bf1f 100644 --- a/lapack-netlib/SRC/cppsv.c +++ b/lapack-netlib/SRC/cppsv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cppsvx.c b/lapack-netlib/SRC/cppsvx.c index 9798ed06f..178c3521a 100644 --- a/lapack-netlib/SRC/cppsvx.c +++ b/lapack-netlib/SRC/cppsvx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cpptrf.c b/lapack-netlib/SRC/cpptrf.c index 711fb200b..1f2a4a84e 100644 --- a/lapack-netlib/SRC/cpptrf.c +++ b/lapack-netlib/SRC/cpptrf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cpptri.c b/lapack-netlib/SRC/cpptri.c index 1d99d3e88..db7773862 100644 --- a/lapack-netlib/SRC/cpptri.c +++ b/lapack-netlib/SRC/cpptri.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cpptrs.c b/lapack-netlib/SRC/cpptrs.c index 6251b1e53..dadb90ce2 100644 --- a/lapack-netlib/SRC/cpptrs.c +++ b/lapack-netlib/SRC/cpptrs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cpstf2.c b/lapack-netlib/SRC/cpstf2.c index f0ac9bf92..ae7fb05c4 100644 --- a/lapack-netlib/SRC/cpstf2.c +++ b/lapack-netlib/SRC/cpstf2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cpstrf.c b/lapack-netlib/SRC/cpstrf.c index e8cb87df4..ab4811273 100644 --- a/lapack-netlib/SRC/cpstrf.c +++ b/lapack-netlib/SRC/cpstrf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cptcon.c b/lapack-netlib/SRC/cptcon.c index 829e7bd50..3920fd2da 100644 --- a/lapack-netlib/SRC/cptcon.c +++ b/lapack-netlib/SRC/cptcon.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cpteqr.c b/lapack-netlib/SRC/cpteqr.c index b382724e0..41f373ff3 100644 --- a/lapack-netlib/SRC/cpteqr.c +++ b/lapack-netlib/SRC/cpteqr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cptrfs.c b/lapack-netlib/SRC/cptrfs.c index 470465011..e56f94cb5 100644 --- a/lapack-netlib/SRC/cptrfs.c +++ b/lapack-netlib/SRC/cptrfs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cptsv.c b/lapack-netlib/SRC/cptsv.c index b2e3edbff..2d0ece1f4 100644 --- a/lapack-netlib/SRC/cptsv.c +++ b/lapack-netlib/SRC/cptsv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cptsvx.c b/lapack-netlib/SRC/cptsvx.c index 7c0c26251..f04b96eba 100644 --- a/lapack-netlib/SRC/cptsvx.c +++ b/lapack-netlib/SRC/cptsvx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cpttrf.c b/lapack-netlib/SRC/cpttrf.c index d071efc18..06f71abc4 100644 --- a/lapack-netlib/SRC/cpttrf.c +++ b/lapack-netlib/SRC/cpttrf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cpttrs.c b/lapack-netlib/SRC/cpttrs.c index 803ed3261..474596e6f 100644 --- a/lapack-netlib/SRC/cpttrs.c +++ b/lapack-netlib/SRC/cpttrs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cptts2.c b/lapack-netlib/SRC/cptts2.c index d6f5c0aff..ce3d90105 100644 --- a/lapack-netlib/SRC/cptts2.c +++ b/lapack-netlib/SRC/cptts2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/crot.c b/lapack-netlib/SRC/crot.c index eed83d90a..f001028fb 100644 --- a/lapack-netlib/SRC/crot.c +++ b/lapack-netlib/SRC/crot.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/crscl.c b/lapack-netlib/SRC/crscl.c index 7c87553d5..640842282 100644 --- a/lapack-netlib/SRC/crscl.c +++ b/lapack-netlib/SRC/crscl.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cspcon.c b/lapack-netlib/SRC/cspcon.c index c03725281..784be1728 100644 --- a/lapack-netlib/SRC/cspcon.c +++ b/lapack-netlib/SRC/cspcon.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cspmv.c b/lapack-netlib/SRC/cspmv.c index 03622bcfc..732372dea 100644 --- a/lapack-netlib/SRC/cspmv.c +++ b/lapack-netlib/SRC/cspmv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cspr.c b/lapack-netlib/SRC/cspr.c index 2ea2b048e..2a0e4e9b9 100644 --- a/lapack-netlib/SRC/cspr.c +++ b/lapack-netlib/SRC/cspr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/csprfs.c b/lapack-netlib/SRC/csprfs.c index 9b7979c89..bccda39eb 100644 --- a/lapack-netlib/SRC/csprfs.c +++ b/lapack-netlib/SRC/csprfs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cspsv.c b/lapack-netlib/SRC/cspsv.c index 84fe88f4e..253059704 100644 --- a/lapack-netlib/SRC/cspsv.c +++ b/lapack-netlib/SRC/cspsv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cspsvx.c b/lapack-netlib/SRC/cspsvx.c index 3caff1f52..59865d588 100644 --- a/lapack-netlib/SRC/cspsvx.c +++ b/lapack-netlib/SRC/cspsvx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/csptrf.c b/lapack-netlib/SRC/csptrf.c index 9c5b85374..c3aedf418 100644 --- a/lapack-netlib/SRC/csptrf.c +++ b/lapack-netlib/SRC/csptrf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/csptri.c b/lapack-netlib/SRC/csptri.c index 610ef8966..57ade8326 100644 --- a/lapack-netlib/SRC/csptri.c +++ b/lapack-netlib/SRC/csptri.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/csptrs.c b/lapack-netlib/SRC/csptrs.c index 0e1e7ffb5..ac3098a98 100644 --- a/lapack-netlib/SRC/csptrs.c +++ b/lapack-netlib/SRC/csptrs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/csrscl.c b/lapack-netlib/SRC/csrscl.c index d7d08c345..e82571d08 100644 --- a/lapack-netlib/SRC/csrscl.c +++ b/lapack-netlib/SRC/csrscl.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cstedc.c b/lapack-netlib/SRC/cstedc.c index 1d60e6a97..9d60c9aa9 100644 --- a/lapack-netlib/SRC/cstedc.c +++ b/lapack-netlib/SRC/cstedc.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cstegr.c b/lapack-netlib/SRC/cstegr.c index 836534ef6..7e56ff334 100644 --- a/lapack-netlib/SRC/cstegr.c +++ b/lapack-netlib/SRC/cstegr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cstein.c b/lapack-netlib/SRC/cstein.c index 335dbaa48..2002dcdf6 100644 --- a/lapack-netlib/SRC/cstein.c +++ b/lapack-netlib/SRC/cstein.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cstemr.c b/lapack-netlib/SRC/cstemr.c index ede8ea27e..b817c760e 100644 --- a/lapack-netlib/SRC/cstemr.c +++ b/lapack-netlib/SRC/cstemr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/csteqr.c b/lapack-netlib/SRC/csteqr.c index c85a56dd5..d2158f133 100644 --- a/lapack-netlib/SRC/csteqr.c +++ b/lapack-netlib/SRC/csteqr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/csycon.c b/lapack-netlib/SRC/csycon.c index 4f606a5fe..3842cdef7 100644 --- a/lapack-netlib/SRC/csycon.c +++ b/lapack-netlib/SRC/csycon.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/csycon_3.c b/lapack-netlib/SRC/csycon_3.c index 2bb7f3032..906266121 100644 --- a/lapack-netlib/SRC/csycon_3.c +++ b/lapack-netlib/SRC/csycon_3.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/csycon_rook.c b/lapack-netlib/SRC/csycon_rook.c index ac0fb0105..8936a85c8 100644 --- a/lapack-netlib/SRC/csycon_rook.c +++ b/lapack-netlib/SRC/csycon_rook.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/csyconv.c b/lapack-netlib/SRC/csyconv.c index f1f7c1c41..da9c4cec9 100644 --- a/lapack-netlib/SRC/csyconv.c +++ b/lapack-netlib/SRC/csyconv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/csyconvf.c b/lapack-netlib/SRC/csyconvf.c index edb900d16..9b9742ee9 100644 --- a/lapack-netlib/SRC/csyconvf.c +++ b/lapack-netlib/SRC/csyconvf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/csyconvf_rook.c b/lapack-netlib/SRC/csyconvf_rook.c index d453eda3e..7d05991a5 100644 --- a/lapack-netlib/SRC/csyconvf_rook.c +++ b/lapack-netlib/SRC/csyconvf_rook.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/csyequb.c b/lapack-netlib/SRC/csyequb.c index 223619d29..9f194854d 100644 --- a/lapack-netlib/SRC/csyequb.c +++ b/lapack-netlib/SRC/csyequb.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/csymv.c b/lapack-netlib/SRC/csymv.c index d07419db5..3148e83a8 100644 --- a/lapack-netlib/SRC/csymv.c +++ b/lapack-netlib/SRC/csymv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/csyr.c b/lapack-netlib/SRC/csyr.c index e684b2024..beeeb07c3 100644 --- a/lapack-netlib/SRC/csyr.c +++ b/lapack-netlib/SRC/csyr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/csyrfs.c b/lapack-netlib/SRC/csyrfs.c index 2bd501fc3..633afc41e 100644 --- a/lapack-netlib/SRC/csyrfs.c +++ b/lapack-netlib/SRC/csyrfs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/csyrfsx.c b/lapack-netlib/SRC/csyrfsx.c index aa3ac4f72..61885f2fe 100644 --- a/lapack-netlib/SRC/csyrfsx.c +++ b/lapack-netlib/SRC/csyrfsx.c @@ -54,8 +54,8 @@ static inline _Complex float * _pCf(complex *z) {return (_Complex float*)z;} static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double*)z;} #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -257,7 +257,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/csysv.c b/lapack-netlib/SRC/csysv.c index 1eecd1711..e52875c7b 100644 --- a/lapack-netlib/SRC/csysv.c +++ b/lapack-netlib/SRC/csysv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/csysv_aa.c b/lapack-netlib/SRC/csysv_aa.c index 065159fd3..3eb5f4803 100644 --- a/lapack-netlib/SRC/csysv_aa.c +++ b/lapack-netlib/SRC/csysv_aa.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/csysv_aa_2stage.c b/lapack-netlib/SRC/csysv_aa_2stage.c index 0a6827fd3..50a778026 100644 --- a/lapack-netlib/SRC/csysv_aa_2stage.c +++ b/lapack-netlib/SRC/csysv_aa_2stage.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/csysv_rk.c b/lapack-netlib/SRC/csysv_rk.c index 4e731fdf8..eaecbdd09 100644 --- a/lapack-netlib/SRC/csysv_rk.c +++ b/lapack-netlib/SRC/csysv_rk.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/csysv_rook.c b/lapack-netlib/SRC/csysv_rook.c index a55218a8a..97fff6a2a 100644 --- a/lapack-netlib/SRC/csysv_rook.c +++ b/lapack-netlib/SRC/csysv_rook.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else From 353b1180c1be65f0b439ed53216fa6f144c3d20b Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Thu, 4 Apr 2024 01:38:10 +0200 Subject: [PATCH 293/311] fix typedef of logical to support INTERFACE64 --- lapack-netlib/SRC/clabrd.c | 6 +++--- lapack-netlib/SRC/clacgv.c | 6 +++--- lapack-netlib/SRC/clacn2.c | 6 +++--- lapack-netlib/SRC/clacon.c | 6 +++--- lapack-netlib/SRC/clacp2.c | 6 +++--- lapack-netlib/SRC/clacpy.c | 6 +++--- lapack-netlib/SRC/clacrm.c | 6 +++--- lapack-netlib/SRC/clacrt.c | 6 +++--- lapack-netlib/SRC/cladiv.c | 6 +++--- lapack-netlib/SRC/claed0.c | 6 +++--- lapack-netlib/SRC/claed7.c | 6 +++--- lapack-netlib/SRC/claed8.c | 6 +++--- lapack-netlib/SRC/claein.c | 6 +++--- lapack-netlib/SRC/claesy.c | 6 +++--- lapack-netlib/SRC/claev2.c | 6 +++--- lapack-netlib/SRC/clag2z.c | 6 +++--- lapack-netlib/SRC/clags2.c | 6 +++--- lapack-netlib/SRC/clagtm.c | 6 +++--- lapack-netlib/SRC/clahef.c | 6 +++--- lapack-netlib/SRC/clahef_aa.c | 6 +++--- lapack-netlib/SRC/clahef_rk.c | 6 +++--- lapack-netlib/SRC/clahef_rook.c | 6 +++--- lapack-netlib/SRC/clahqr.c | 6 +++--- lapack-netlib/SRC/clahr2.c | 6 +++--- lapack-netlib/SRC/claic1.c | 6 +++--- lapack-netlib/SRC/clals0.c | 6 +++--- lapack-netlib/SRC/clalsa.c | 6 +++--- lapack-netlib/SRC/clalsd.c | 6 +++--- lapack-netlib/SRC/clamswlq.c | 6 +++--- lapack-netlib/SRC/clamtsqr.c | 6 +++--- lapack-netlib/SRC/clangb.c | 6 +++--- lapack-netlib/SRC/clange.c | 6 +++--- lapack-netlib/SRC/clangt.c | 6 +++--- lapack-netlib/SRC/clanhb.c | 6 +++--- lapack-netlib/SRC/clanhe.c | 6 +++--- lapack-netlib/SRC/clanhf.c | 6 +++--- lapack-netlib/SRC/clanhp.c | 6 +++--- lapack-netlib/SRC/clanhs.c | 6 +++--- lapack-netlib/SRC/clanht.c | 6 +++--- lapack-netlib/SRC/clansb.c | 6 +++--- lapack-netlib/SRC/clansp.c | 6 +++--- lapack-netlib/SRC/clansy.c | 6 +++--- lapack-netlib/SRC/clantb.c | 6 +++--- lapack-netlib/SRC/clantp.c | 6 +++--- lapack-netlib/SRC/clantr.c | 6 +++--- lapack-netlib/SRC/clapll.c | 6 +++--- lapack-netlib/SRC/clapmr.c | 6 +++--- lapack-netlib/SRC/clapmt.c | 6 +++--- lapack-netlib/SRC/claqgb.c | 6 +++--- lapack-netlib/SRC/claqge.c | 6 +++--- lapack-netlib/SRC/claqhb.c | 6 +++--- lapack-netlib/SRC/claqhe.c | 6 +++--- lapack-netlib/SRC/claqhp.c | 6 +++--- lapack-netlib/SRC/claqp2.c | 6 +++--- lapack-netlib/SRC/claqp2rk.c | 6 +++--- lapack-netlib/SRC/claqp3rk.c | 6 +++--- lapack-netlib/SRC/claqps.c | 6 +++--- lapack-netlib/SRC/claqr0.c | 6 +++--- lapack-netlib/SRC/claqr1.c | 6 +++--- lapack-netlib/SRC/claqr2.c | 6 +++--- lapack-netlib/SRC/claqr3.c | 6 +++--- lapack-netlib/SRC/claqr4.c | 6 +++--- lapack-netlib/SRC/claqr5.c | 6 +++--- lapack-netlib/SRC/claqsb.c | 6 +++--- lapack-netlib/SRC/claqsp.c | 6 +++--- lapack-netlib/SRC/claqsy.c | 6 +++--- lapack-netlib/SRC/clar1v.c | 6 +++--- lapack-netlib/SRC/clar2v.c | 6 +++--- lapack-netlib/SRC/clarcm.c | 6 +++--- lapack-netlib/SRC/clarf.c | 6 +++--- lapack-netlib/SRC/clarfb.c | 6 +++--- lapack-netlib/SRC/clarfb_gett.c | 6 +++--- lapack-netlib/SRC/clarfg.c | 6 +++--- lapack-netlib/SRC/clarfgp.c | 6 +++--- lapack-netlib/SRC/clarft.c | 6 +++--- lapack-netlib/SRC/clarfx.c | 6 +++--- lapack-netlib/SRC/clarfy.c | 6 +++--- lapack-netlib/SRC/clargv.c | 6 +++--- lapack-netlib/SRC/clarnv.c | 6 +++--- lapack-netlib/SRC/clarrv.c | 6 +++--- lapack-netlib/SRC/clarscl2.c | 6 +++--- lapack-netlib/SRC/clartg.c | 6 +++--- lapack-netlib/SRC/clartv.c | 6 +++--- lapack-netlib/SRC/clarz.c | 6 +++--- lapack-netlib/SRC/clarzb.c | 6 +++--- lapack-netlib/SRC/clarzt.c | 6 +++--- lapack-netlib/SRC/clascl.c | 6 +++--- lapack-netlib/SRC/clascl2.c | 6 +++--- lapack-netlib/SRC/claset.c | 6 +++--- lapack-netlib/SRC/clasr.c | 6 +++--- lapack-netlib/SRC/classq.c | 6 +++--- lapack-netlib/SRC/claswlq.c | 6 +++--- 92 files changed, 276 insertions(+), 276 deletions(-) diff --git a/lapack-netlib/SRC/clabrd.c b/lapack-netlib/SRC/clabrd.c index 08cbe07dc..0d1d299a8 100644 --- a/lapack-netlib/SRC/clabrd.c +++ b/lapack-netlib/SRC/clabrd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/clacgv.c b/lapack-netlib/SRC/clacgv.c index 1b8411e5e..46e8e115e 100644 --- a/lapack-netlib/SRC/clacgv.c +++ b/lapack-netlib/SRC/clacgv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/clacn2.c b/lapack-netlib/SRC/clacn2.c index e8ba4b0c7..f4138bdc7 100644 --- a/lapack-netlib/SRC/clacn2.c +++ b/lapack-netlib/SRC/clacn2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/clacon.c b/lapack-netlib/SRC/clacon.c index 243ecd11b..52187649f 100644 --- a/lapack-netlib/SRC/clacon.c +++ b/lapack-netlib/SRC/clacon.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/clacp2.c b/lapack-netlib/SRC/clacp2.c index f41ab9818..078018ef7 100644 --- a/lapack-netlib/SRC/clacp2.c +++ b/lapack-netlib/SRC/clacp2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/clacpy.c b/lapack-netlib/SRC/clacpy.c index e2b988a93..2395e0c98 100644 --- a/lapack-netlib/SRC/clacpy.c +++ b/lapack-netlib/SRC/clacpy.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/clacrm.c b/lapack-netlib/SRC/clacrm.c index f4633af64..ed7b9215a 100644 --- a/lapack-netlib/SRC/clacrm.c +++ b/lapack-netlib/SRC/clacrm.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/clacrt.c b/lapack-netlib/SRC/clacrt.c index 9f89ba906..7faa24779 100644 --- a/lapack-netlib/SRC/clacrt.c +++ b/lapack-netlib/SRC/clacrt.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cladiv.c b/lapack-netlib/SRC/cladiv.c index fb8c84aff..10ffa2a28 100644 --- a/lapack-netlib/SRC/cladiv.c +++ b/lapack-netlib/SRC/cladiv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/claed0.c b/lapack-netlib/SRC/claed0.c index 185f64844..381ca74c1 100644 --- a/lapack-netlib/SRC/claed0.c +++ b/lapack-netlib/SRC/claed0.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/claed7.c b/lapack-netlib/SRC/claed7.c index 2c9aef5a9..0a4f970dd 100644 --- a/lapack-netlib/SRC/claed7.c +++ b/lapack-netlib/SRC/claed7.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/claed8.c b/lapack-netlib/SRC/claed8.c index f6c3a3106..bc7c360f8 100644 --- a/lapack-netlib/SRC/claed8.c +++ b/lapack-netlib/SRC/claed8.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/claein.c b/lapack-netlib/SRC/claein.c index 21b2d45fe..cea6c9825 100644 --- a/lapack-netlib/SRC/claein.c +++ b/lapack-netlib/SRC/claein.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/claesy.c b/lapack-netlib/SRC/claesy.c index cd217e71d..81440412b 100644 --- a/lapack-netlib/SRC/claesy.c +++ b/lapack-netlib/SRC/claesy.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/claev2.c b/lapack-netlib/SRC/claev2.c index c1aaaae93..69736b44c 100644 --- a/lapack-netlib/SRC/claev2.c +++ b/lapack-netlib/SRC/claev2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/clag2z.c b/lapack-netlib/SRC/clag2z.c index 98bf82b8d..ff455c7e2 100644 --- a/lapack-netlib/SRC/clag2z.c +++ b/lapack-netlib/SRC/clag2z.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/clags2.c b/lapack-netlib/SRC/clags2.c index 2a58b634e..6323cde97 100644 --- a/lapack-netlib/SRC/clags2.c +++ b/lapack-netlib/SRC/clags2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/clagtm.c b/lapack-netlib/SRC/clagtm.c index d1db98464..0bc287e04 100644 --- a/lapack-netlib/SRC/clagtm.c +++ b/lapack-netlib/SRC/clagtm.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/clahef.c b/lapack-netlib/SRC/clahef.c index 1cf2bdbba..42bd1ac77 100644 --- a/lapack-netlib/SRC/clahef.c +++ b/lapack-netlib/SRC/clahef.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/clahef_aa.c b/lapack-netlib/SRC/clahef_aa.c index 535a770e1..10e024a75 100644 --- a/lapack-netlib/SRC/clahef_aa.c +++ b/lapack-netlib/SRC/clahef_aa.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/clahef_rk.c b/lapack-netlib/SRC/clahef_rk.c index 9b3d07453..a841b2515 100644 --- a/lapack-netlib/SRC/clahef_rk.c +++ b/lapack-netlib/SRC/clahef_rk.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/clahef_rook.c b/lapack-netlib/SRC/clahef_rook.c index ed3e91ecf..f77aedc3c 100644 --- a/lapack-netlib/SRC/clahef_rook.c +++ b/lapack-netlib/SRC/clahef_rook.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/clahqr.c b/lapack-netlib/SRC/clahqr.c index a862b32bc..05aaa484d 100644 --- a/lapack-netlib/SRC/clahqr.c +++ b/lapack-netlib/SRC/clahqr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/clahr2.c b/lapack-netlib/SRC/clahr2.c index 09f3ccc7c..f3877b07d 100644 --- a/lapack-netlib/SRC/clahr2.c +++ b/lapack-netlib/SRC/clahr2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/claic1.c b/lapack-netlib/SRC/claic1.c index bde27f376..0c51d41d2 100644 --- a/lapack-netlib/SRC/claic1.c +++ b/lapack-netlib/SRC/claic1.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/clals0.c b/lapack-netlib/SRC/clals0.c index b2d57e34e..c37066cac 100644 --- a/lapack-netlib/SRC/clals0.c +++ b/lapack-netlib/SRC/clals0.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/clalsa.c b/lapack-netlib/SRC/clalsa.c index 711d1a868..2d8d18757 100644 --- a/lapack-netlib/SRC/clalsa.c +++ b/lapack-netlib/SRC/clalsa.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/clalsd.c b/lapack-netlib/SRC/clalsd.c index bc6135f63..3c0ac35eb 100644 --- a/lapack-netlib/SRC/clalsd.c +++ b/lapack-netlib/SRC/clalsd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/clamswlq.c b/lapack-netlib/SRC/clamswlq.c index ed84b3074..cc666294b 100644 --- a/lapack-netlib/SRC/clamswlq.c +++ b/lapack-netlib/SRC/clamswlq.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/clamtsqr.c b/lapack-netlib/SRC/clamtsqr.c index 553013785..c8c6ce86c 100644 --- a/lapack-netlib/SRC/clamtsqr.c +++ b/lapack-netlib/SRC/clamtsqr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/clangb.c b/lapack-netlib/SRC/clangb.c index 727606003..75e3dc68a 100644 --- a/lapack-netlib/SRC/clangb.c +++ b/lapack-netlib/SRC/clangb.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/clange.c b/lapack-netlib/SRC/clange.c index 7e4e07389..da57e9cde 100644 --- a/lapack-netlib/SRC/clange.c +++ b/lapack-netlib/SRC/clange.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/clangt.c b/lapack-netlib/SRC/clangt.c index d9d55a9ca..e9a51eea5 100644 --- a/lapack-netlib/SRC/clangt.c +++ b/lapack-netlib/SRC/clangt.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/clanhb.c b/lapack-netlib/SRC/clanhb.c index 497c9ca2d..528a92b30 100644 --- a/lapack-netlib/SRC/clanhb.c +++ b/lapack-netlib/SRC/clanhb.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/clanhe.c b/lapack-netlib/SRC/clanhe.c index 6b9f8e826..c739ae829 100644 --- a/lapack-netlib/SRC/clanhe.c +++ b/lapack-netlib/SRC/clanhe.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/clanhf.c b/lapack-netlib/SRC/clanhf.c index 4755084e5..2bee60a46 100644 --- a/lapack-netlib/SRC/clanhf.c +++ b/lapack-netlib/SRC/clanhf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/clanhp.c b/lapack-netlib/SRC/clanhp.c index 7b21fdd38..7dd13d6da 100644 --- a/lapack-netlib/SRC/clanhp.c +++ b/lapack-netlib/SRC/clanhp.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/clanhs.c b/lapack-netlib/SRC/clanhs.c index 3ba45e7a0..7fd7d8dd0 100644 --- a/lapack-netlib/SRC/clanhs.c +++ b/lapack-netlib/SRC/clanhs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/clanht.c b/lapack-netlib/SRC/clanht.c index 8383b15a9..01b8ff0a0 100644 --- a/lapack-netlib/SRC/clanht.c +++ b/lapack-netlib/SRC/clanht.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/clansb.c b/lapack-netlib/SRC/clansb.c index 098afaea8..cf8227766 100644 --- a/lapack-netlib/SRC/clansb.c +++ b/lapack-netlib/SRC/clansb.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/clansp.c b/lapack-netlib/SRC/clansp.c index 120443574..7f276b854 100644 --- a/lapack-netlib/SRC/clansp.c +++ b/lapack-netlib/SRC/clansp.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/clansy.c b/lapack-netlib/SRC/clansy.c index 5855b365a..dce61068f 100644 --- a/lapack-netlib/SRC/clansy.c +++ b/lapack-netlib/SRC/clansy.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/clantb.c b/lapack-netlib/SRC/clantb.c index f13532ced..7c4ad4522 100644 --- a/lapack-netlib/SRC/clantb.c +++ b/lapack-netlib/SRC/clantb.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/clantp.c b/lapack-netlib/SRC/clantp.c index 29cde1868..2d063d39d 100644 --- a/lapack-netlib/SRC/clantp.c +++ b/lapack-netlib/SRC/clantp.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/clantr.c b/lapack-netlib/SRC/clantr.c index 1a7132a70..63df0252e 100644 --- a/lapack-netlib/SRC/clantr.c +++ b/lapack-netlib/SRC/clantr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/clapll.c b/lapack-netlib/SRC/clapll.c index 326317820..15116c55e 100644 --- a/lapack-netlib/SRC/clapll.c +++ b/lapack-netlib/SRC/clapll.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/clapmr.c b/lapack-netlib/SRC/clapmr.c index f61d1923b..d611167b9 100644 --- a/lapack-netlib/SRC/clapmr.c +++ b/lapack-netlib/SRC/clapmr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/clapmt.c b/lapack-netlib/SRC/clapmt.c index 6f3f22026..059424e88 100644 --- a/lapack-netlib/SRC/clapmt.c +++ b/lapack-netlib/SRC/clapmt.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/claqgb.c b/lapack-netlib/SRC/claqgb.c index 1a00478bd..5da1775b7 100644 --- a/lapack-netlib/SRC/claqgb.c +++ b/lapack-netlib/SRC/claqgb.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/claqge.c b/lapack-netlib/SRC/claqge.c index c1b2bd196..dcedde2a7 100644 --- a/lapack-netlib/SRC/claqge.c +++ b/lapack-netlib/SRC/claqge.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/claqhb.c b/lapack-netlib/SRC/claqhb.c index 53f04e3a5..3f6741b99 100644 --- a/lapack-netlib/SRC/claqhb.c +++ b/lapack-netlib/SRC/claqhb.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/claqhe.c b/lapack-netlib/SRC/claqhe.c index 050de301b..c41f85c98 100644 --- a/lapack-netlib/SRC/claqhe.c +++ b/lapack-netlib/SRC/claqhe.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/claqhp.c b/lapack-netlib/SRC/claqhp.c index 2597f0cbb..8d7b1987e 100644 --- a/lapack-netlib/SRC/claqhp.c +++ b/lapack-netlib/SRC/claqhp.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/claqp2.c b/lapack-netlib/SRC/claqp2.c index 58e4008d2..6e7ff04c1 100644 --- a/lapack-netlib/SRC/claqp2.c +++ b/lapack-netlib/SRC/claqp2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/claqp2rk.c b/lapack-netlib/SRC/claqp2rk.c index 4184c5927..9e64e2428 100644 --- a/lapack-netlib/SRC/claqp2rk.c +++ b/lapack-netlib/SRC/claqp2rk.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/claqp3rk.c b/lapack-netlib/SRC/claqp3rk.c index ca305fab7..92c570e61 100644 --- a/lapack-netlib/SRC/claqp3rk.c +++ b/lapack-netlib/SRC/claqp3rk.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/claqps.c b/lapack-netlib/SRC/claqps.c index 125823b24..5e834b9ea 100644 --- a/lapack-netlib/SRC/claqps.c +++ b/lapack-netlib/SRC/claqps.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/claqr0.c b/lapack-netlib/SRC/claqr0.c index 78c0ca850..25e589b23 100644 --- a/lapack-netlib/SRC/claqr0.c +++ b/lapack-netlib/SRC/claqr0.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/claqr1.c b/lapack-netlib/SRC/claqr1.c index 9a4d8b1e2..b69a6f635 100644 --- a/lapack-netlib/SRC/claqr1.c +++ b/lapack-netlib/SRC/claqr1.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/claqr2.c b/lapack-netlib/SRC/claqr2.c index cf50f81c2..ee1f8050b 100644 --- a/lapack-netlib/SRC/claqr2.c +++ b/lapack-netlib/SRC/claqr2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/claqr3.c b/lapack-netlib/SRC/claqr3.c index d72a00622..e0c84e6c8 100644 --- a/lapack-netlib/SRC/claqr3.c +++ b/lapack-netlib/SRC/claqr3.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/claqr4.c b/lapack-netlib/SRC/claqr4.c index 0abf2416e..3ebe723ba 100644 --- a/lapack-netlib/SRC/claqr4.c +++ b/lapack-netlib/SRC/claqr4.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/claqr5.c b/lapack-netlib/SRC/claqr5.c index f608c6498..e46480144 100644 --- a/lapack-netlib/SRC/claqr5.c +++ b/lapack-netlib/SRC/claqr5.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/claqsb.c b/lapack-netlib/SRC/claqsb.c index dd7f12403..a661a762b 100644 --- a/lapack-netlib/SRC/claqsb.c +++ b/lapack-netlib/SRC/claqsb.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/claqsp.c b/lapack-netlib/SRC/claqsp.c index 2380c8563..0eea85904 100644 --- a/lapack-netlib/SRC/claqsp.c +++ b/lapack-netlib/SRC/claqsp.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/claqsy.c b/lapack-netlib/SRC/claqsy.c index 6f78b1421..d332c59a8 100644 --- a/lapack-netlib/SRC/claqsy.c +++ b/lapack-netlib/SRC/claqsy.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/clar1v.c b/lapack-netlib/SRC/clar1v.c index c67a19c93..f96f97d41 100644 --- a/lapack-netlib/SRC/clar1v.c +++ b/lapack-netlib/SRC/clar1v.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/clar2v.c b/lapack-netlib/SRC/clar2v.c index abe5b226b..8e0c1a0b0 100644 --- a/lapack-netlib/SRC/clar2v.c +++ b/lapack-netlib/SRC/clar2v.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/clarcm.c b/lapack-netlib/SRC/clarcm.c index ff1af1043..6bc44f9d0 100644 --- a/lapack-netlib/SRC/clarcm.c +++ b/lapack-netlib/SRC/clarcm.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/clarf.c b/lapack-netlib/SRC/clarf.c index 5d08bee90..770f94b18 100644 --- a/lapack-netlib/SRC/clarf.c +++ b/lapack-netlib/SRC/clarf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/clarfb.c b/lapack-netlib/SRC/clarfb.c index e62517579..cf5d85071 100644 --- a/lapack-netlib/SRC/clarfb.c +++ b/lapack-netlib/SRC/clarfb.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/clarfb_gett.c b/lapack-netlib/SRC/clarfb_gett.c index 7cf3550e7..5cca69d24 100644 --- a/lapack-netlib/SRC/clarfb_gett.c +++ b/lapack-netlib/SRC/clarfb_gett.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/clarfg.c b/lapack-netlib/SRC/clarfg.c index 7fe91f1b5..9deed53d8 100644 --- a/lapack-netlib/SRC/clarfg.c +++ b/lapack-netlib/SRC/clarfg.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/clarfgp.c b/lapack-netlib/SRC/clarfgp.c index e87a6b7c0..5de4728f4 100644 --- a/lapack-netlib/SRC/clarfgp.c +++ b/lapack-netlib/SRC/clarfgp.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/clarft.c b/lapack-netlib/SRC/clarft.c index e26b8402e..76b4dcf1e 100644 --- a/lapack-netlib/SRC/clarft.c +++ b/lapack-netlib/SRC/clarft.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/clarfx.c b/lapack-netlib/SRC/clarfx.c index d5d61945f..4f70bb97e 100644 --- a/lapack-netlib/SRC/clarfx.c +++ b/lapack-netlib/SRC/clarfx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/clarfy.c b/lapack-netlib/SRC/clarfy.c index 15a83738d..086902c47 100644 --- a/lapack-netlib/SRC/clarfy.c +++ b/lapack-netlib/SRC/clarfy.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/clargv.c b/lapack-netlib/SRC/clargv.c index 6ed8623be..239f6ca7c 100644 --- a/lapack-netlib/SRC/clargv.c +++ b/lapack-netlib/SRC/clargv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/clarnv.c b/lapack-netlib/SRC/clarnv.c index aafd0ee70..e42cc0caf 100644 --- a/lapack-netlib/SRC/clarnv.c +++ b/lapack-netlib/SRC/clarnv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/clarrv.c b/lapack-netlib/SRC/clarrv.c index 5fb8764eb..92b3aa08c 100644 --- a/lapack-netlib/SRC/clarrv.c +++ b/lapack-netlib/SRC/clarrv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/clarscl2.c b/lapack-netlib/SRC/clarscl2.c index 920ee8e04..48641bc92 100644 --- a/lapack-netlib/SRC/clarscl2.c +++ b/lapack-netlib/SRC/clarscl2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/clartg.c b/lapack-netlib/SRC/clartg.c index 8d318f5cd..83a74a2b0 100644 --- a/lapack-netlib/SRC/clartg.c +++ b/lapack-netlib/SRC/clartg.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/clartv.c b/lapack-netlib/SRC/clartv.c index 04c23485d..bbbe553d2 100644 --- a/lapack-netlib/SRC/clartv.c +++ b/lapack-netlib/SRC/clartv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/clarz.c b/lapack-netlib/SRC/clarz.c index d50c2e74f..dbffdec65 100644 --- a/lapack-netlib/SRC/clarz.c +++ b/lapack-netlib/SRC/clarz.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/clarzb.c b/lapack-netlib/SRC/clarzb.c index f20a1fb2e..dd69c2a8e 100644 --- a/lapack-netlib/SRC/clarzb.c +++ b/lapack-netlib/SRC/clarzb.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/clarzt.c b/lapack-netlib/SRC/clarzt.c index e0665d081..09fbc5efc 100644 --- a/lapack-netlib/SRC/clarzt.c +++ b/lapack-netlib/SRC/clarzt.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/clascl.c b/lapack-netlib/SRC/clascl.c index 892c21908..31be8d40d 100644 --- a/lapack-netlib/SRC/clascl.c +++ b/lapack-netlib/SRC/clascl.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/clascl2.c b/lapack-netlib/SRC/clascl2.c index 7a1621463..fada47968 100644 --- a/lapack-netlib/SRC/clascl2.c +++ b/lapack-netlib/SRC/clascl2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/claset.c b/lapack-netlib/SRC/claset.c index a96a5b4c9..f16e734a6 100644 --- a/lapack-netlib/SRC/claset.c +++ b/lapack-netlib/SRC/claset.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/clasr.c b/lapack-netlib/SRC/clasr.c index 75e91ecd0..0a3c2e4da 100644 --- a/lapack-netlib/SRC/clasr.c +++ b/lapack-netlib/SRC/clasr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/classq.c b/lapack-netlib/SRC/classq.c index 346158f3b..a514ed6a1 100644 --- a/lapack-netlib/SRC/classq.c +++ b/lapack-netlib/SRC/classq.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/claswlq.c b/lapack-netlib/SRC/claswlq.c index 562dc4a65..cdbcbca0f 100644 --- a/lapack-netlib/SRC/claswlq.c +++ b/lapack-netlib/SRC/claswlq.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else From 03698f4c1dcfea45ffc232ebd6fd648a2f35fb0f Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Thu, 4 Apr 2024 01:46:46 +0200 Subject: [PATCH 294/311] fix typedef of logical to support INTERFACE64 --- lapack-netlib/SRC/cheev.c | 6 +++--- lapack-netlib/SRC/cheevd.c | 6 +++--- lapack-netlib/SRC/cheevd_2stage.c | 6 +++--- lapack-netlib/SRC/cheevr.c | 6 +++--- lapack-netlib/SRC/cheevr_2stage.c | 6 +++--- lapack-netlib/SRC/cheevx.c | 6 +++--- lapack-netlib/SRC/cheevx_2stage.c | 6 +++--- lapack-netlib/SRC/chegs2.c | 6 +++--- lapack-netlib/SRC/chegst.c | 6 +++--- lapack-netlib/SRC/chegv.c | 6 +++--- lapack-netlib/SRC/chegv_2stage.c | 6 +++--- lapack-netlib/SRC/chegvd.c | 6 +++--- lapack-netlib/SRC/chegvx.c | 6 +++--- lapack-netlib/SRC/cherfs.c | 6 +++--- lapack-netlib/SRC/cherfsx.c | 6 +++--- lapack-netlib/SRC/chesv.c | 6 +++--- lapack-netlib/SRC/chesv_aa.c | 6 +++--- lapack-netlib/SRC/chesv_aa_2stage.c | 6 +++--- lapack-netlib/SRC/chesv_rk.c | 6 +++--- lapack-netlib/SRC/chesv_rook.c | 6 +++--- lapack-netlib/SRC/chesvx.c | 6 +++--- lapack-netlib/SRC/chesvxx.c | 6 +++--- lapack-netlib/SRC/cheswapr.c | 6 +++--- lapack-netlib/SRC/chetd2.c | 6 +++--- lapack-netlib/SRC/chetf2.c | 6 +++--- lapack-netlib/SRC/chetf2_rk.c | 6 +++--- lapack-netlib/SRC/chetf2_rook.c | 6 +++--- lapack-netlib/SRC/chetrd.c | 6 +++--- lapack-netlib/SRC/chetrd_2stage.c | 6 +++--- lapack-netlib/SRC/chetrd_hb2st.c | 6 +++--- lapack-netlib/SRC/chetrd_he2hb.c | 6 +++--- lapack-netlib/SRC/chetrf.c | 6 +++--- lapack-netlib/SRC/chetrf_aa.c | 6 +++--- lapack-netlib/SRC/chetrf_aa_2stage.c | 6 +++--- lapack-netlib/SRC/chetrf_rk.c | 6 +++--- lapack-netlib/SRC/chetrf_rook.c | 6 +++--- lapack-netlib/SRC/chetri.c | 6 +++--- lapack-netlib/SRC/chetri2.c | 6 +++--- lapack-netlib/SRC/chetri2x.c | 6 +++--- lapack-netlib/SRC/chetri_3.c | 6 +++--- lapack-netlib/SRC/chetri_3x.c | 6 +++--- lapack-netlib/SRC/chetri_rook.c | 6 +++--- lapack-netlib/SRC/chetrs.c | 6 +++--- lapack-netlib/SRC/chetrs2.c | 6 +++--- lapack-netlib/SRC/chetrs_3.c | 6 +++--- lapack-netlib/SRC/chetrs_aa.c | 6 +++--- lapack-netlib/SRC/chetrs_aa_2stage.c | 6 +++--- lapack-netlib/SRC/chetrs_rook.c | 6 +++--- lapack-netlib/SRC/chfrk.c | 6 +++--- lapack-netlib/SRC/chgeqz.c | 6 +++--- lapack-netlib/SRC/chla_transtype.c | 6 +++--- lapack-netlib/SRC/chpcon.c | 6 +++--- lapack-netlib/SRC/chpev.c | 6 +++--- lapack-netlib/SRC/chpevd.c | 6 +++--- lapack-netlib/SRC/chpevx.c | 6 +++--- lapack-netlib/SRC/chpgst.c | 6 +++--- lapack-netlib/SRC/chpgv.c | 6 +++--- lapack-netlib/SRC/chpgvd.c | 6 +++--- lapack-netlib/SRC/chpgvx.c | 6 +++--- lapack-netlib/SRC/chprfs.c | 6 +++--- lapack-netlib/SRC/chpsv.c | 6 +++--- lapack-netlib/SRC/chpsvx.c | 6 +++--- lapack-netlib/SRC/chptrd.c | 6 +++--- lapack-netlib/SRC/chptrf.c | 6 +++--- lapack-netlib/SRC/chptri.c | 6 +++--- lapack-netlib/SRC/chptrs.c | 6 +++--- lapack-netlib/SRC/chsein.c | 6 +++--- lapack-netlib/SRC/chseqr.c | 6 +++--- lapack-netlib/SRC/cla_gbamv.c | 6 +++--- lapack-netlib/SRC/cla_gbrcond_c.c | 6 +++--- lapack-netlib/SRC/cla_gbrcond_x.c | 6 +++--- lapack-netlib/SRC/cla_gbrfsx_extended.c | 6 +++--- lapack-netlib/SRC/cla_gbrpvgrw.c | 6 +++--- lapack-netlib/SRC/cla_geamv.c | 6 +++--- lapack-netlib/SRC/cla_gercond_c.c | 6 +++--- lapack-netlib/SRC/cla_gercond_x.c | 6 +++--- lapack-netlib/SRC/cla_gerfsx_extended.c | 6 +++--- lapack-netlib/SRC/cla_gerpvgrw.c | 6 +++--- lapack-netlib/SRC/cla_heamv.c | 6 +++--- lapack-netlib/SRC/cla_hercond_c.c | 6 +++--- lapack-netlib/SRC/cla_hercond_x.c | 6 +++--- lapack-netlib/SRC/cla_herfsx_extended.c | 6 +++--- lapack-netlib/SRC/cla_herpvgrw.c | 6 +++--- lapack-netlib/SRC/cla_lin_berr.c | 6 +++--- lapack-netlib/SRC/cla_porcond_c.c | 6 +++--- lapack-netlib/SRC/cla_porcond_x.c | 6 +++--- lapack-netlib/SRC/cla_porfsx_extended.c | 6 +++--- lapack-netlib/SRC/cla_porpvgrw.c | 6 +++--- lapack-netlib/SRC/cla_syamv.c | 6 +++--- lapack-netlib/SRC/cla_syrcond_c.c | 6 +++--- lapack-netlib/SRC/cla_syrcond_x.c | 6 +++--- lapack-netlib/SRC/cla_syrfsx_extended.c | 6 +++--- lapack-netlib/SRC/cla_syrpvgrw.c | 6 +++--- lapack-netlib/SRC/cla_wwaddw.c | 6 +++--- 94 files changed, 282 insertions(+), 282 deletions(-) diff --git a/lapack-netlib/SRC/cheev.c b/lapack-netlib/SRC/cheev.c index 03e05dc60..2fd79fd89 100644 --- a/lapack-netlib/SRC/cheev.c +++ b/lapack-netlib/SRC/cheev.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cheevd.c b/lapack-netlib/SRC/cheevd.c index 0f494f426..c4d7f8802 100644 --- a/lapack-netlib/SRC/cheevd.c +++ b/lapack-netlib/SRC/cheevd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cheevd_2stage.c b/lapack-netlib/SRC/cheevd_2stage.c index 8ded0446c..21def564c 100644 --- a/lapack-netlib/SRC/cheevd_2stage.c +++ b/lapack-netlib/SRC/cheevd_2stage.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cheevr.c b/lapack-netlib/SRC/cheevr.c index 0799305ad..6bf522860 100644 --- a/lapack-netlib/SRC/cheevr.c +++ b/lapack-netlib/SRC/cheevr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cheevr_2stage.c b/lapack-netlib/SRC/cheevr_2stage.c index 73bbe617d..86da2b76b 100644 --- a/lapack-netlib/SRC/cheevr_2stage.c +++ b/lapack-netlib/SRC/cheevr_2stage.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cheevx.c b/lapack-netlib/SRC/cheevx.c index c68954121..2285ea596 100644 --- a/lapack-netlib/SRC/cheevx.c +++ b/lapack-netlib/SRC/cheevx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cheevx_2stage.c b/lapack-netlib/SRC/cheevx_2stage.c index 3bd68fd65..3287a0665 100644 --- a/lapack-netlib/SRC/cheevx_2stage.c +++ b/lapack-netlib/SRC/cheevx_2stage.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/chegs2.c b/lapack-netlib/SRC/chegs2.c index 14762a5cf..0c6af6139 100644 --- a/lapack-netlib/SRC/chegs2.c +++ b/lapack-netlib/SRC/chegs2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/chegst.c b/lapack-netlib/SRC/chegst.c index 5140e846d..9634a8036 100644 --- a/lapack-netlib/SRC/chegst.c +++ b/lapack-netlib/SRC/chegst.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/chegv.c b/lapack-netlib/SRC/chegv.c index 599f47ffb..00fad8162 100644 --- a/lapack-netlib/SRC/chegv.c +++ b/lapack-netlib/SRC/chegv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/chegv_2stage.c b/lapack-netlib/SRC/chegv_2stage.c index 340820c9b..2fbf3f49f 100644 --- a/lapack-netlib/SRC/chegv_2stage.c +++ b/lapack-netlib/SRC/chegv_2stage.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/chegvd.c b/lapack-netlib/SRC/chegvd.c index 1259b737f..0b33453be 100644 --- a/lapack-netlib/SRC/chegvd.c +++ b/lapack-netlib/SRC/chegvd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/chegvx.c b/lapack-netlib/SRC/chegvx.c index 198c480d5..fae6c1986 100644 --- a/lapack-netlib/SRC/chegvx.c +++ b/lapack-netlib/SRC/chegvx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cherfs.c b/lapack-netlib/SRC/cherfs.c index f10c671f8..1861a1885 100644 --- a/lapack-netlib/SRC/cherfs.c +++ b/lapack-netlib/SRC/cherfs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cherfsx.c b/lapack-netlib/SRC/cherfsx.c index aa3ac4f72..61885f2fe 100644 --- a/lapack-netlib/SRC/cherfsx.c +++ b/lapack-netlib/SRC/cherfsx.c @@ -54,8 +54,8 @@ static inline _Complex float * _pCf(complex *z) {return (_Complex float*)z;} static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double*)z;} #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -257,7 +257,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/chesv.c b/lapack-netlib/SRC/chesv.c index 8c438db95..1754443d2 100644 --- a/lapack-netlib/SRC/chesv.c +++ b/lapack-netlib/SRC/chesv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/chesv_aa.c b/lapack-netlib/SRC/chesv_aa.c index 9401ecb61..42a135731 100644 --- a/lapack-netlib/SRC/chesv_aa.c +++ b/lapack-netlib/SRC/chesv_aa.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/chesv_aa_2stage.c b/lapack-netlib/SRC/chesv_aa_2stage.c index 31c4127be..232369685 100644 --- a/lapack-netlib/SRC/chesv_aa_2stage.c +++ b/lapack-netlib/SRC/chesv_aa_2stage.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/chesv_rk.c b/lapack-netlib/SRC/chesv_rk.c index f1acea516..2b73e4455 100644 --- a/lapack-netlib/SRC/chesv_rk.c +++ b/lapack-netlib/SRC/chesv_rk.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/chesv_rook.c b/lapack-netlib/SRC/chesv_rook.c index b3311798c..6548818e4 100644 --- a/lapack-netlib/SRC/chesv_rook.c +++ b/lapack-netlib/SRC/chesv_rook.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/chesvx.c b/lapack-netlib/SRC/chesvx.c index 18a299a0d..fc99f57a4 100644 --- a/lapack-netlib/SRC/chesvx.c +++ b/lapack-netlib/SRC/chesvx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/chesvxx.c b/lapack-netlib/SRC/chesvxx.c index ce9759166..751f0871c 100644 --- a/lapack-netlib/SRC/chesvxx.c +++ b/lapack-netlib/SRC/chesvxx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cheswapr.c b/lapack-netlib/SRC/cheswapr.c index 9c475e78d..2f018e015 100644 --- a/lapack-netlib/SRC/cheswapr.c +++ b/lapack-netlib/SRC/cheswapr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/chetd2.c b/lapack-netlib/SRC/chetd2.c index b52f5e8d7..f459875db 100644 --- a/lapack-netlib/SRC/chetd2.c +++ b/lapack-netlib/SRC/chetd2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/chetf2.c b/lapack-netlib/SRC/chetf2.c index 6c186962c..d66480760 100644 --- a/lapack-netlib/SRC/chetf2.c +++ b/lapack-netlib/SRC/chetf2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/chetf2_rk.c b/lapack-netlib/SRC/chetf2_rk.c index 2d1754531..1ee4af941 100644 --- a/lapack-netlib/SRC/chetf2_rk.c +++ b/lapack-netlib/SRC/chetf2_rk.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/chetf2_rook.c b/lapack-netlib/SRC/chetf2_rook.c index d623cc5ab..922c29fbb 100644 --- a/lapack-netlib/SRC/chetf2_rook.c +++ b/lapack-netlib/SRC/chetf2_rook.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/chetrd.c b/lapack-netlib/SRC/chetrd.c index 67ff572d2..075071e34 100644 --- a/lapack-netlib/SRC/chetrd.c +++ b/lapack-netlib/SRC/chetrd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/chetrd_2stage.c b/lapack-netlib/SRC/chetrd_2stage.c index d61672b83..861051794 100644 --- a/lapack-netlib/SRC/chetrd_2stage.c +++ b/lapack-netlib/SRC/chetrd_2stage.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/chetrd_hb2st.c b/lapack-netlib/SRC/chetrd_hb2st.c index cbcebf3dd..cb3344fc7 100644 --- a/lapack-netlib/SRC/chetrd_hb2st.c +++ b/lapack-netlib/SRC/chetrd_hb2st.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/chetrd_he2hb.c b/lapack-netlib/SRC/chetrd_he2hb.c index 8461cc778..1bf08ed68 100644 --- a/lapack-netlib/SRC/chetrd_he2hb.c +++ b/lapack-netlib/SRC/chetrd_he2hb.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/chetrf.c b/lapack-netlib/SRC/chetrf.c index 0b1a12cf0..112140771 100644 --- a/lapack-netlib/SRC/chetrf.c +++ b/lapack-netlib/SRC/chetrf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/chetrf_aa.c b/lapack-netlib/SRC/chetrf_aa.c index 707043942..4937a007a 100644 --- a/lapack-netlib/SRC/chetrf_aa.c +++ b/lapack-netlib/SRC/chetrf_aa.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/chetrf_aa_2stage.c b/lapack-netlib/SRC/chetrf_aa_2stage.c index 47de92e10..bb34f96f0 100644 --- a/lapack-netlib/SRC/chetrf_aa_2stage.c +++ b/lapack-netlib/SRC/chetrf_aa_2stage.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/chetrf_rk.c b/lapack-netlib/SRC/chetrf_rk.c index 953c497f2..0bd16a089 100644 --- a/lapack-netlib/SRC/chetrf_rk.c +++ b/lapack-netlib/SRC/chetrf_rk.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/chetrf_rook.c b/lapack-netlib/SRC/chetrf_rook.c index 5025d7d27..d873296cf 100644 --- a/lapack-netlib/SRC/chetrf_rook.c +++ b/lapack-netlib/SRC/chetrf_rook.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/chetri.c b/lapack-netlib/SRC/chetri.c index 01a8b298e..543221273 100644 --- a/lapack-netlib/SRC/chetri.c +++ b/lapack-netlib/SRC/chetri.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/chetri2.c b/lapack-netlib/SRC/chetri2.c index 529a24fc7..8f319e4e9 100644 --- a/lapack-netlib/SRC/chetri2.c +++ b/lapack-netlib/SRC/chetri2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/chetri2x.c b/lapack-netlib/SRC/chetri2x.c index 00869fead..a839fa707 100644 --- a/lapack-netlib/SRC/chetri2x.c +++ b/lapack-netlib/SRC/chetri2x.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/chetri_3.c b/lapack-netlib/SRC/chetri_3.c index f174298e4..b966d1dbd 100644 --- a/lapack-netlib/SRC/chetri_3.c +++ b/lapack-netlib/SRC/chetri_3.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/chetri_3x.c b/lapack-netlib/SRC/chetri_3x.c index 145dcccef..491ca4d25 100644 --- a/lapack-netlib/SRC/chetri_3x.c +++ b/lapack-netlib/SRC/chetri_3x.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/chetri_rook.c b/lapack-netlib/SRC/chetri_rook.c index ae64d562a..808363a29 100644 --- a/lapack-netlib/SRC/chetri_rook.c +++ b/lapack-netlib/SRC/chetri_rook.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/chetrs.c b/lapack-netlib/SRC/chetrs.c index e8f259cce..32d58c7b1 100644 --- a/lapack-netlib/SRC/chetrs.c +++ b/lapack-netlib/SRC/chetrs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/chetrs2.c b/lapack-netlib/SRC/chetrs2.c index 854cfd69c..31e7c817d 100644 --- a/lapack-netlib/SRC/chetrs2.c +++ b/lapack-netlib/SRC/chetrs2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/chetrs_3.c b/lapack-netlib/SRC/chetrs_3.c index 9e46d445c..1a22b2a96 100644 --- a/lapack-netlib/SRC/chetrs_3.c +++ b/lapack-netlib/SRC/chetrs_3.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/chetrs_aa.c b/lapack-netlib/SRC/chetrs_aa.c index 464bc9667..0e0b5f316 100644 --- a/lapack-netlib/SRC/chetrs_aa.c +++ b/lapack-netlib/SRC/chetrs_aa.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/chetrs_aa_2stage.c b/lapack-netlib/SRC/chetrs_aa_2stage.c index d4cca77e5..38c21852b 100644 --- a/lapack-netlib/SRC/chetrs_aa_2stage.c +++ b/lapack-netlib/SRC/chetrs_aa_2stage.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/chetrs_rook.c b/lapack-netlib/SRC/chetrs_rook.c index f2c4c30c0..1662d373d 100644 --- a/lapack-netlib/SRC/chetrs_rook.c +++ b/lapack-netlib/SRC/chetrs_rook.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/chfrk.c b/lapack-netlib/SRC/chfrk.c index 3604d0566..23d23355c 100644 --- a/lapack-netlib/SRC/chfrk.c +++ b/lapack-netlib/SRC/chfrk.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/chgeqz.c b/lapack-netlib/SRC/chgeqz.c index 2781ce630..109709139 100644 --- a/lapack-netlib/SRC/chgeqz.c +++ b/lapack-netlib/SRC/chgeqz.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/chla_transtype.c b/lapack-netlib/SRC/chla_transtype.c index 7bb53987e..7b0781d0f 100644 --- a/lapack-netlib/SRC/chla_transtype.c +++ b/lapack-netlib/SRC/chla_transtype.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/chpcon.c b/lapack-netlib/SRC/chpcon.c index 54f4a8159..02af5ed6d 100644 --- a/lapack-netlib/SRC/chpcon.c +++ b/lapack-netlib/SRC/chpcon.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/chpev.c b/lapack-netlib/SRC/chpev.c index 2a704ec06..25e2fa5bd 100644 --- a/lapack-netlib/SRC/chpev.c +++ b/lapack-netlib/SRC/chpev.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/chpevd.c b/lapack-netlib/SRC/chpevd.c index 9e5224da0..3e70bc1d9 100644 --- a/lapack-netlib/SRC/chpevd.c +++ b/lapack-netlib/SRC/chpevd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/chpevx.c b/lapack-netlib/SRC/chpevx.c index 843547191..e12763389 100644 --- a/lapack-netlib/SRC/chpevx.c +++ b/lapack-netlib/SRC/chpevx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/chpgst.c b/lapack-netlib/SRC/chpgst.c index 30898fc84..03320d36b 100644 --- a/lapack-netlib/SRC/chpgst.c +++ b/lapack-netlib/SRC/chpgst.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/chpgv.c b/lapack-netlib/SRC/chpgv.c index 9028fa5d6..1c079e753 100644 --- a/lapack-netlib/SRC/chpgv.c +++ b/lapack-netlib/SRC/chpgv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/chpgvd.c b/lapack-netlib/SRC/chpgvd.c index 18e1100df..295a975d1 100644 --- a/lapack-netlib/SRC/chpgvd.c +++ b/lapack-netlib/SRC/chpgvd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/chpgvx.c b/lapack-netlib/SRC/chpgvx.c index da649dd47..f35272510 100644 --- a/lapack-netlib/SRC/chpgvx.c +++ b/lapack-netlib/SRC/chpgvx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/chprfs.c b/lapack-netlib/SRC/chprfs.c index 612976b28..ca33e648e 100644 --- a/lapack-netlib/SRC/chprfs.c +++ b/lapack-netlib/SRC/chprfs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/chpsv.c b/lapack-netlib/SRC/chpsv.c index ee137647c..b10f9503e 100644 --- a/lapack-netlib/SRC/chpsv.c +++ b/lapack-netlib/SRC/chpsv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/chpsvx.c b/lapack-netlib/SRC/chpsvx.c index b6377469b..7bd76d1be 100644 --- a/lapack-netlib/SRC/chpsvx.c +++ b/lapack-netlib/SRC/chpsvx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/chptrd.c b/lapack-netlib/SRC/chptrd.c index 8a42cd4d1..1882f68d6 100644 --- a/lapack-netlib/SRC/chptrd.c +++ b/lapack-netlib/SRC/chptrd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/chptrf.c b/lapack-netlib/SRC/chptrf.c index 8e0c5f166..9bbcd22f0 100644 --- a/lapack-netlib/SRC/chptrf.c +++ b/lapack-netlib/SRC/chptrf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/chptri.c b/lapack-netlib/SRC/chptri.c index 334da92b1..054664681 100644 --- a/lapack-netlib/SRC/chptri.c +++ b/lapack-netlib/SRC/chptri.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/chptrs.c b/lapack-netlib/SRC/chptrs.c index 941362df1..919330f67 100644 --- a/lapack-netlib/SRC/chptrs.c +++ b/lapack-netlib/SRC/chptrs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/chsein.c b/lapack-netlib/SRC/chsein.c index eeaaffb0c..87c177bc6 100644 --- a/lapack-netlib/SRC/chsein.c +++ b/lapack-netlib/SRC/chsein.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/chseqr.c b/lapack-netlib/SRC/chseqr.c index 002313ba2..b98db683b 100644 --- a/lapack-netlib/SRC/chseqr.c +++ b/lapack-netlib/SRC/chseqr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cla_gbamv.c b/lapack-netlib/SRC/cla_gbamv.c index a5978c82d..1d3b54921 100644 --- a/lapack-netlib/SRC/cla_gbamv.c +++ b/lapack-netlib/SRC/cla_gbamv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cla_gbrcond_c.c b/lapack-netlib/SRC/cla_gbrcond_c.c index e6ade5424..7172f59f6 100644 --- a/lapack-netlib/SRC/cla_gbrcond_c.c +++ b/lapack-netlib/SRC/cla_gbrcond_c.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cla_gbrcond_x.c b/lapack-netlib/SRC/cla_gbrcond_x.c index 2c00c8f76..a3a55b9ea 100644 --- a/lapack-netlib/SRC/cla_gbrcond_x.c +++ b/lapack-netlib/SRC/cla_gbrcond_x.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cla_gbrfsx_extended.c b/lapack-netlib/SRC/cla_gbrfsx_extended.c index f793251d4..fb7db29db 100644 --- a/lapack-netlib/SRC/cla_gbrfsx_extended.c +++ b/lapack-netlib/SRC/cla_gbrfsx_extended.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cla_gbrpvgrw.c b/lapack-netlib/SRC/cla_gbrpvgrw.c index 47bbb51cc..cabf167e2 100644 --- a/lapack-netlib/SRC/cla_gbrpvgrw.c +++ b/lapack-netlib/SRC/cla_gbrpvgrw.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cla_geamv.c b/lapack-netlib/SRC/cla_geamv.c index 4b936d3fb..7cb9d33db 100644 --- a/lapack-netlib/SRC/cla_geamv.c +++ b/lapack-netlib/SRC/cla_geamv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cla_gercond_c.c b/lapack-netlib/SRC/cla_gercond_c.c index d94e84f9e..53c8728dc 100644 --- a/lapack-netlib/SRC/cla_gercond_c.c +++ b/lapack-netlib/SRC/cla_gercond_c.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cla_gercond_x.c b/lapack-netlib/SRC/cla_gercond_x.c index ac5eb1867..905c6e186 100644 --- a/lapack-netlib/SRC/cla_gercond_x.c +++ b/lapack-netlib/SRC/cla_gercond_x.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cla_gerfsx_extended.c b/lapack-netlib/SRC/cla_gerfsx_extended.c index 1adc015bb..3984f1d17 100644 --- a/lapack-netlib/SRC/cla_gerfsx_extended.c +++ b/lapack-netlib/SRC/cla_gerfsx_extended.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cla_gerpvgrw.c b/lapack-netlib/SRC/cla_gerpvgrw.c index 4a5e5867e..873e087c9 100644 --- a/lapack-netlib/SRC/cla_gerpvgrw.c +++ b/lapack-netlib/SRC/cla_gerpvgrw.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cla_heamv.c b/lapack-netlib/SRC/cla_heamv.c index cb7a35624..40ff92caa 100644 --- a/lapack-netlib/SRC/cla_heamv.c +++ b/lapack-netlib/SRC/cla_heamv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cla_hercond_c.c b/lapack-netlib/SRC/cla_hercond_c.c index 56d922f1c..57f94b21a 100644 --- a/lapack-netlib/SRC/cla_hercond_c.c +++ b/lapack-netlib/SRC/cla_hercond_c.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cla_hercond_x.c b/lapack-netlib/SRC/cla_hercond_x.c index 271eab4ba..a2a2ea493 100644 --- a/lapack-netlib/SRC/cla_hercond_x.c +++ b/lapack-netlib/SRC/cla_hercond_x.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cla_herfsx_extended.c b/lapack-netlib/SRC/cla_herfsx_extended.c index f721e573f..289c8c0eb 100644 --- a/lapack-netlib/SRC/cla_herfsx_extended.c +++ b/lapack-netlib/SRC/cla_herfsx_extended.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cla_herpvgrw.c b/lapack-netlib/SRC/cla_herpvgrw.c index 769454927..d0fd9afaa 100644 --- a/lapack-netlib/SRC/cla_herpvgrw.c +++ b/lapack-netlib/SRC/cla_herpvgrw.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cla_lin_berr.c b/lapack-netlib/SRC/cla_lin_berr.c index e4a356f01..f7b11e567 100644 --- a/lapack-netlib/SRC/cla_lin_berr.c +++ b/lapack-netlib/SRC/cla_lin_berr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cla_porcond_c.c b/lapack-netlib/SRC/cla_porcond_c.c index c8c18f102..e282fb42a 100644 --- a/lapack-netlib/SRC/cla_porcond_c.c +++ b/lapack-netlib/SRC/cla_porcond_c.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cla_porcond_x.c b/lapack-netlib/SRC/cla_porcond_x.c index 849104923..192a49889 100644 --- a/lapack-netlib/SRC/cla_porcond_x.c +++ b/lapack-netlib/SRC/cla_porcond_x.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cla_porfsx_extended.c b/lapack-netlib/SRC/cla_porfsx_extended.c index 4346519f5..42f41e241 100644 --- a/lapack-netlib/SRC/cla_porfsx_extended.c +++ b/lapack-netlib/SRC/cla_porfsx_extended.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cla_porpvgrw.c b/lapack-netlib/SRC/cla_porpvgrw.c index 7fe941c9e..dedfc61d2 100644 --- a/lapack-netlib/SRC/cla_porpvgrw.c +++ b/lapack-netlib/SRC/cla_porpvgrw.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cla_syamv.c b/lapack-netlib/SRC/cla_syamv.c index bfd3a03a3..2e9c91cec 100644 --- a/lapack-netlib/SRC/cla_syamv.c +++ b/lapack-netlib/SRC/cla_syamv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cla_syrcond_c.c b/lapack-netlib/SRC/cla_syrcond_c.c index 21b09af46..b36da6fa2 100644 --- a/lapack-netlib/SRC/cla_syrcond_c.c +++ b/lapack-netlib/SRC/cla_syrcond_c.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cla_syrcond_x.c b/lapack-netlib/SRC/cla_syrcond_x.c index f14c0925a..2801b6ee3 100644 --- a/lapack-netlib/SRC/cla_syrcond_x.c +++ b/lapack-netlib/SRC/cla_syrcond_x.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cla_syrfsx_extended.c b/lapack-netlib/SRC/cla_syrfsx_extended.c index f76de3855..3ad595ebe 100644 --- a/lapack-netlib/SRC/cla_syrfsx_extended.c +++ b/lapack-netlib/SRC/cla_syrfsx_extended.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cla_syrpvgrw.c b/lapack-netlib/SRC/cla_syrpvgrw.c index 9ff5f2d19..1a722d1d9 100644 --- a/lapack-netlib/SRC/cla_syrpvgrw.c +++ b/lapack-netlib/SRC/cla_syrpvgrw.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cla_wwaddw.c b/lapack-netlib/SRC/cla_wwaddw.c index 34f2f6a78..999bee392 100644 --- a/lapack-netlib/SRC/cla_wwaddw.c +++ b/lapack-netlib/SRC/cla_wwaddw.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else From d93944466c7c1e1b45e5a06c4f7daf523fb84e0a Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Thu, 4 Apr 2024 01:54:47 +0200 Subject: [PATCH 295/311] fix typedef of logical to support INTERFACE64 --- lapack-netlib/SRC/cgelst.c | 6 +++--- lapack-netlib/SRC/cgelsy.c | 6 +++--- lapack-netlib/SRC/cgemlq.c | 6 +++--- lapack-netlib/SRC/cgemlqt.c | 6 +++--- lapack-netlib/SRC/cgemqr.c | 6 +++--- lapack-netlib/SRC/cgemqrt.c | 6 +++--- lapack-netlib/SRC/cgeql2.c | 6 +++--- lapack-netlib/SRC/cgeqlf.c | 6 +++--- lapack-netlib/SRC/cgeqp3.c | 6 +++--- lapack-netlib/SRC/cgeqp3rk.c | 6 +++--- lapack-netlib/SRC/cgeqr.c | 6 +++--- lapack-netlib/SRC/cgeqr2.c | 6 +++--- lapack-netlib/SRC/cgeqr2p.c | 6 +++--- lapack-netlib/SRC/cgeqrf.c | 6 +++--- lapack-netlib/SRC/cgeqrfp.c | 6 +++--- lapack-netlib/SRC/cgeqrt.c | 6 +++--- lapack-netlib/SRC/cgeqrt2.c | 6 +++--- lapack-netlib/SRC/cgeqrt3.c | 6 +++--- lapack-netlib/SRC/cgerfs.c | 6 +++--- lapack-netlib/SRC/cgerfsx.c | 6 +++--- lapack-netlib/SRC/cgerq2.c | 6 +++--- lapack-netlib/SRC/cgerqf.c | 6 +++--- lapack-netlib/SRC/cgesc2.c | 6 +++--- lapack-netlib/SRC/cgesdd.c | 6 +++--- lapack-netlib/SRC/cgesv.c | 6 +++--- lapack-netlib/SRC/cgesvd.c | 6 +++--- lapack-netlib/SRC/cgesvdq.c | 6 +++--- lapack-netlib/SRC/cgesvdx.c | 6 +++--- lapack-netlib/SRC/cgesvj.c | 6 +++--- lapack-netlib/SRC/cgesvx.c | 6 +++--- lapack-netlib/SRC/cgesvxx.c | 6 +++--- lapack-netlib/SRC/cgetc2.c | 6 +++--- lapack-netlib/SRC/cgetf2.c | 6 +++--- lapack-netlib/SRC/cgetrf.c | 6 +++--- lapack-netlib/SRC/cgetrf2.c | 6 +++--- lapack-netlib/SRC/cgetri.c | 6 +++--- lapack-netlib/SRC/cgetrs.c | 6 +++--- lapack-netlib/SRC/cgetsls.c | 6 +++--- lapack-netlib/SRC/cgetsqrhrt.c | 6 +++--- lapack-netlib/SRC/cggbak.c | 6 +++--- lapack-netlib/SRC/cggbal.c | 6 +++--- lapack-netlib/SRC/cgges.c | 6 +++--- lapack-netlib/SRC/cgges3.c | 6 +++--- lapack-netlib/SRC/cggesx.c | 6 +++--- lapack-netlib/SRC/cggev.c | 6 +++--- lapack-netlib/SRC/cggev3.c | 6 +++--- lapack-netlib/SRC/cggevx.c | 6 +++--- lapack-netlib/SRC/cggglm.c | 6 +++--- lapack-netlib/SRC/cgghd3.c | 6 +++--- lapack-netlib/SRC/cgghrd.c | 6 +++--- lapack-netlib/SRC/cgglse.c | 6 +++--- lapack-netlib/SRC/cggqrf.c | 6 +++--- lapack-netlib/SRC/cggrqf.c | 6 +++--- lapack-netlib/SRC/cggsvd3.c | 6 +++--- lapack-netlib/SRC/cggsvp3.c | 6 +++--- lapack-netlib/SRC/cgsvj0.c | 6 +++--- lapack-netlib/SRC/cgsvj1.c | 6 +++--- lapack-netlib/SRC/cgtcon.c | 6 +++--- lapack-netlib/SRC/cgtrfs.c | 6 +++--- lapack-netlib/SRC/cgtsv.c | 6 +++--- lapack-netlib/SRC/cgtsvx.c | 6 +++--- lapack-netlib/SRC/cgttrf.c | 6 +++--- lapack-netlib/SRC/cgttrs.c | 6 +++--- lapack-netlib/SRC/cgtts2.c | 6 +++--- lapack-netlib/SRC/chb2st_kernels.c | 6 +++--- lapack-netlib/SRC/chbev.c | 6 +++--- lapack-netlib/SRC/chbev_2stage.c | 6 +++--- lapack-netlib/SRC/chbevd.c | 6 +++--- lapack-netlib/SRC/chbevd_2stage.c | 6 +++--- lapack-netlib/SRC/chbevx.c | 6 +++--- lapack-netlib/SRC/chbevx_2stage.c | 6 +++--- lapack-netlib/SRC/chbgst.c | 6 +++--- lapack-netlib/SRC/chbgv.c | 6 +++--- lapack-netlib/SRC/chbgvd.c | 6 +++--- lapack-netlib/SRC/chbgvx.c | 6 +++--- lapack-netlib/SRC/chbtrd.c | 6 +++--- lapack-netlib/SRC/checon.c | 6 +++--- lapack-netlib/SRC/checon_3.c | 6 +++--- lapack-netlib/SRC/checon_rook.c | 6 +++--- lapack-netlib/SRC/cheequb.c | 6 +++--- lapack-netlib/SRC/cheev_2stage.c | 6 +++--- 81 files changed, 243 insertions(+), 243 deletions(-) diff --git a/lapack-netlib/SRC/cgelst.c b/lapack-netlib/SRC/cgelst.c index 21187e28d..2378d4074 100644 --- a/lapack-netlib/SRC/cgelst.c +++ b/lapack-netlib/SRC/cgelst.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgelsy.c b/lapack-netlib/SRC/cgelsy.c index a9db55ea3..dc1e5158f 100644 --- a/lapack-netlib/SRC/cgelsy.c +++ b/lapack-netlib/SRC/cgelsy.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgemlq.c b/lapack-netlib/SRC/cgemlq.c index 527ab2fed..cbc80360b 100644 --- a/lapack-netlib/SRC/cgemlq.c +++ b/lapack-netlib/SRC/cgemlq.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgemlqt.c b/lapack-netlib/SRC/cgemlqt.c index ef6e1cfab..6087b28a4 100644 --- a/lapack-netlib/SRC/cgemlqt.c +++ b/lapack-netlib/SRC/cgemlqt.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgemqr.c b/lapack-netlib/SRC/cgemqr.c index 0ec64b796..dbe3bf753 100644 --- a/lapack-netlib/SRC/cgemqr.c +++ b/lapack-netlib/SRC/cgemqr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgemqrt.c b/lapack-netlib/SRC/cgemqrt.c index f374c4a64..08c69c151 100644 --- a/lapack-netlib/SRC/cgemqrt.c +++ b/lapack-netlib/SRC/cgemqrt.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgeql2.c b/lapack-netlib/SRC/cgeql2.c index 240c0dc95..bfc106698 100644 --- a/lapack-netlib/SRC/cgeql2.c +++ b/lapack-netlib/SRC/cgeql2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgeqlf.c b/lapack-netlib/SRC/cgeqlf.c index 08a18a335..e923ace8a 100644 --- a/lapack-netlib/SRC/cgeqlf.c +++ b/lapack-netlib/SRC/cgeqlf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgeqp3.c b/lapack-netlib/SRC/cgeqp3.c index 8376d54dc..e34adf700 100644 --- a/lapack-netlib/SRC/cgeqp3.c +++ b/lapack-netlib/SRC/cgeqp3.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgeqp3rk.c b/lapack-netlib/SRC/cgeqp3rk.c index 54e7fb140..3afd9fc89 100644 --- a/lapack-netlib/SRC/cgeqp3rk.c +++ b/lapack-netlib/SRC/cgeqp3rk.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgeqr.c b/lapack-netlib/SRC/cgeqr.c index 2389e358a..bd3fb9825 100644 --- a/lapack-netlib/SRC/cgeqr.c +++ b/lapack-netlib/SRC/cgeqr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgeqr2.c b/lapack-netlib/SRC/cgeqr2.c index a3adcb7a8..a403450b9 100644 --- a/lapack-netlib/SRC/cgeqr2.c +++ b/lapack-netlib/SRC/cgeqr2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgeqr2p.c b/lapack-netlib/SRC/cgeqr2p.c index cdefd0c9b..f93abd79e 100644 --- a/lapack-netlib/SRC/cgeqr2p.c +++ b/lapack-netlib/SRC/cgeqr2p.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgeqrf.c b/lapack-netlib/SRC/cgeqrf.c index 42aa20b31..9ddcd20ab 100644 --- a/lapack-netlib/SRC/cgeqrf.c +++ b/lapack-netlib/SRC/cgeqrf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgeqrfp.c b/lapack-netlib/SRC/cgeqrfp.c index 3f577aa74..4cf0ddd73 100644 --- a/lapack-netlib/SRC/cgeqrfp.c +++ b/lapack-netlib/SRC/cgeqrfp.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgeqrt.c b/lapack-netlib/SRC/cgeqrt.c index 362ae322d..55f0ab829 100644 --- a/lapack-netlib/SRC/cgeqrt.c +++ b/lapack-netlib/SRC/cgeqrt.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgeqrt2.c b/lapack-netlib/SRC/cgeqrt2.c index fb7ceb441..80ce2cbd3 100644 --- a/lapack-netlib/SRC/cgeqrt2.c +++ b/lapack-netlib/SRC/cgeqrt2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgeqrt3.c b/lapack-netlib/SRC/cgeqrt3.c index 8471a6f05..c4fe4c6ce 100644 --- a/lapack-netlib/SRC/cgeqrt3.c +++ b/lapack-netlib/SRC/cgeqrt3.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgerfs.c b/lapack-netlib/SRC/cgerfs.c index 91b60c677..3931e4716 100644 --- a/lapack-netlib/SRC/cgerfs.c +++ b/lapack-netlib/SRC/cgerfs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgerfsx.c b/lapack-netlib/SRC/cgerfsx.c index aa3ac4f72..61885f2fe 100644 --- a/lapack-netlib/SRC/cgerfsx.c +++ b/lapack-netlib/SRC/cgerfsx.c @@ -54,8 +54,8 @@ static inline _Complex float * _pCf(complex *z) {return (_Complex float*)z;} static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double*)z;} #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -257,7 +257,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgerq2.c b/lapack-netlib/SRC/cgerq2.c index 05e6d6c9c..205f6d3b9 100644 --- a/lapack-netlib/SRC/cgerq2.c +++ b/lapack-netlib/SRC/cgerq2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgerqf.c b/lapack-netlib/SRC/cgerqf.c index f13a5b245..5e988d06e 100644 --- a/lapack-netlib/SRC/cgerqf.c +++ b/lapack-netlib/SRC/cgerqf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgesc2.c b/lapack-netlib/SRC/cgesc2.c index 6bde5e427..0f438be4f 100644 --- a/lapack-netlib/SRC/cgesc2.c +++ b/lapack-netlib/SRC/cgesc2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgesdd.c b/lapack-netlib/SRC/cgesdd.c index 3ff545231..15f270501 100644 --- a/lapack-netlib/SRC/cgesdd.c +++ b/lapack-netlib/SRC/cgesdd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgesv.c b/lapack-netlib/SRC/cgesv.c index f74542d12..35402e442 100644 --- a/lapack-netlib/SRC/cgesv.c +++ b/lapack-netlib/SRC/cgesv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgesvd.c b/lapack-netlib/SRC/cgesvd.c index 67a2c0030..64de714a2 100644 --- a/lapack-netlib/SRC/cgesvd.c +++ b/lapack-netlib/SRC/cgesvd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgesvdq.c b/lapack-netlib/SRC/cgesvdq.c index 77f1b45f3..5e39f1cd1 100644 --- a/lapack-netlib/SRC/cgesvdq.c +++ b/lapack-netlib/SRC/cgesvdq.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgesvdx.c b/lapack-netlib/SRC/cgesvdx.c index 0274709a3..999e6e40f 100644 --- a/lapack-netlib/SRC/cgesvdx.c +++ b/lapack-netlib/SRC/cgesvdx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgesvj.c b/lapack-netlib/SRC/cgesvj.c index 82837435b..c31a71edb 100644 --- a/lapack-netlib/SRC/cgesvj.c +++ b/lapack-netlib/SRC/cgesvj.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgesvx.c b/lapack-netlib/SRC/cgesvx.c index cc7485672..952ac564c 100644 --- a/lapack-netlib/SRC/cgesvx.c +++ b/lapack-netlib/SRC/cgesvx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgesvxx.c b/lapack-netlib/SRC/cgesvxx.c index c17d8f599..a0f997545 100644 --- a/lapack-netlib/SRC/cgesvxx.c +++ b/lapack-netlib/SRC/cgesvxx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgetc2.c b/lapack-netlib/SRC/cgetc2.c index 46362ce92..c6b3a46ee 100644 --- a/lapack-netlib/SRC/cgetc2.c +++ b/lapack-netlib/SRC/cgetc2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgetf2.c b/lapack-netlib/SRC/cgetf2.c index e7b8f558c..8418162db 100644 --- a/lapack-netlib/SRC/cgetf2.c +++ b/lapack-netlib/SRC/cgetf2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgetrf.c b/lapack-netlib/SRC/cgetrf.c index a5fc71f1d..6202fc149 100644 --- a/lapack-netlib/SRC/cgetrf.c +++ b/lapack-netlib/SRC/cgetrf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgetrf2.c b/lapack-netlib/SRC/cgetrf2.c index 4d0a8ecc1..4592fbafb 100644 --- a/lapack-netlib/SRC/cgetrf2.c +++ b/lapack-netlib/SRC/cgetrf2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgetri.c b/lapack-netlib/SRC/cgetri.c index aed0fbd54..9d9aebab6 100644 --- a/lapack-netlib/SRC/cgetri.c +++ b/lapack-netlib/SRC/cgetri.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgetrs.c b/lapack-netlib/SRC/cgetrs.c index 3d895187d..ad5dfe7ce 100644 --- a/lapack-netlib/SRC/cgetrs.c +++ b/lapack-netlib/SRC/cgetrs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgetsls.c b/lapack-netlib/SRC/cgetsls.c index b2a87f4f0..33c7b192a 100644 --- a/lapack-netlib/SRC/cgetsls.c +++ b/lapack-netlib/SRC/cgetsls.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgetsqrhrt.c b/lapack-netlib/SRC/cgetsqrhrt.c index 922a911c3..0ad22aff7 100644 --- a/lapack-netlib/SRC/cgetsqrhrt.c +++ b/lapack-netlib/SRC/cgetsqrhrt.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cggbak.c b/lapack-netlib/SRC/cggbak.c index d55caff2e..c3aa83945 100644 --- a/lapack-netlib/SRC/cggbak.c +++ b/lapack-netlib/SRC/cggbak.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cggbal.c b/lapack-netlib/SRC/cggbal.c index b68f6c362..c3710b983 100644 --- a/lapack-netlib/SRC/cggbal.c +++ b/lapack-netlib/SRC/cggbal.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgges.c b/lapack-netlib/SRC/cgges.c index 1c1db9a87..ade0a3816 100644 --- a/lapack-netlib/SRC/cgges.c +++ b/lapack-netlib/SRC/cgges.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgges3.c b/lapack-netlib/SRC/cgges3.c index e7b2e877e..4cc9411a0 100644 --- a/lapack-netlib/SRC/cgges3.c +++ b/lapack-netlib/SRC/cgges3.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cggesx.c b/lapack-netlib/SRC/cggesx.c index d33dad339..375332cdb 100644 --- a/lapack-netlib/SRC/cggesx.c +++ b/lapack-netlib/SRC/cggesx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cggev.c b/lapack-netlib/SRC/cggev.c index bb7b0b4f6..cb7099565 100644 --- a/lapack-netlib/SRC/cggev.c +++ b/lapack-netlib/SRC/cggev.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cggev3.c b/lapack-netlib/SRC/cggev3.c index 511635d3d..a5768ca11 100644 --- a/lapack-netlib/SRC/cggev3.c +++ b/lapack-netlib/SRC/cggev3.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cggevx.c b/lapack-netlib/SRC/cggevx.c index 4b72816d8..8c17497ce 100644 --- a/lapack-netlib/SRC/cggevx.c +++ b/lapack-netlib/SRC/cggevx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cggglm.c b/lapack-netlib/SRC/cggglm.c index 8165d277b..a71d656f0 100644 --- a/lapack-netlib/SRC/cggglm.c +++ b/lapack-netlib/SRC/cggglm.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgghd3.c b/lapack-netlib/SRC/cgghd3.c index 71f56c6bb..4394805ab 100644 --- a/lapack-netlib/SRC/cgghd3.c +++ b/lapack-netlib/SRC/cgghd3.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgghrd.c b/lapack-netlib/SRC/cgghrd.c index f67b1460b..649c69b42 100644 --- a/lapack-netlib/SRC/cgghrd.c +++ b/lapack-netlib/SRC/cgghrd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgglse.c b/lapack-netlib/SRC/cgglse.c index 7b35f8fe4..67871b318 100644 --- a/lapack-netlib/SRC/cgglse.c +++ b/lapack-netlib/SRC/cgglse.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cggqrf.c b/lapack-netlib/SRC/cggqrf.c index 27da14abe..e59ef8f8b 100644 --- a/lapack-netlib/SRC/cggqrf.c +++ b/lapack-netlib/SRC/cggqrf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cggrqf.c b/lapack-netlib/SRC/cggrqf.c index d499d7083..9cdcf275e 100644 --- a/lapack-netlib/SRC/cggrqf.c +++ b/lapack-netlib/SRC/cggrqf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cggsvd3.c b/lapack-netlib/SRC/cggsvd3.c index b467a606c..c22c621bc 100644 --- a/lapack-netlib/SRC/cggsvd3.c +++ b/lapack-netlib/SRC/cggsvd3.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cggsvp3.c b/lapack-netlib/SRC/cggsvp3.c index a3fc3e4e7..e394ab905 100644 --- a/lapack-netlib/SRC/cggsvp3.c +++ b/lapack-netlib/SRC/cggsvp3.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgsvj0.c b/lapack-netlib/SRC/cgsvj0.c index 50c00aa63..baf6410f5 100644 --- a/lapack-netlib/SRC/cgsvj0.c +++ b/lapack-netlib/SRC/cgsvj0.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgsvj1.c b/lapack-netlib/SRC/cgsvj1.c index 9ee9d043a..d52880f3b 100644 --- a/lapack-netlib/SRC/cgsvj1.c +++ b/lapack-netlib/SRC/cgsvj1.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgtcon.c b/lapack-netlib/SRC/cgtcon.c index 284fc2584..bf0c32e9f 100644 --- a/lapack-netlib/SRC/cgtcon.c +++ b/lapack-netlib/SRC/cgtcon.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgtrfs.c b/lapack-netlib/SRC/cgtrfs.c index dd0316af4..bcb2d9465 100644 --- a/lapack-netlib/SRC/cgtrfs.c +++ b/lapack-netlib/SRC/cgtrfs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgtsv.c b/lapack-netlib/SRC/cgtsv.c index acff81cdf..7982e59bc 100644 --- a/lapack-netlib/SRC/cgtsv.c +++ b/lapack-netlib/SRC/cgtsv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgtsvx.c b/lapack-netlib/SRC/cgtsvx.c index 93956c767..34585d9ce 100644 --- a/lapack-netlib/SRC/cgtsvx.c +++ b/lapack-netlib/SRC/cgtsvx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgttrf.c b/lapack-netlib/SRC/cgttrf.c index 2b6aa9ce8..13f80705a 100644 --- a/lapack-netlib/SRC/cgttrf.c +++ b/lapack-netlib/SRC/cgttrf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgttrs.c b/lapack-netlib/SRC/cgttrs.c index c846fae8b..e41b649a5 100644 --- a/lapack-netlib/SRC/cgttrs.c +++ b/lapack-netlib/SRC/cgttrs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgtts2.c b/lapack-netlib/SRC/cgtts2.c index 153537493..bcf53d4f1 100644 --- a/lapack-netlib/SRC/cgtts2.c +++ b/lapack-netlib/SRC/cgtts2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/chb2st_kernels.c b/lapack-netlib/SRC/chb2st_kernels.c index 58f3d3d94..efb4158d0 100644 --- a/lapack-netlib/SRC/chb2st_kernels.c +++ b/lapack-netlib/SRC/chb2st_kernels.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/chbev.c b/lapack-netlib/SRC/chbev.c index d5a40cc93..5b26dd38e 100644 --- a/lapack-netlib/SRC/chbev.c +++ b/lapack-netlib/SRC/chbev.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/chbev_2stage.c b/lapack-netlib/SRC/chbev_2stage.c index 6e75065d8..885e3ac48 100644 --- a/lapack-netlib/SRC/chbev_2stage.c +++ b/lapack-netlib/SRC/chbev_2stage.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/chbevd.c b/lapack-netlib/SRC/chbevd.c index a15df5cf4..5065c6ee4 100644 --- a/lapack-netlib/SRC/chbevd.c +++ b/lapack-netlib/SRC/chbevd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/chbevd_2stage.c b/lapack-netlib/SRC/chbevd_2stage.c index d5dbd357c..bb60ea807 100644 --- a/lapack-netlib/SRC/chbevd_2stage.c +++ b/lapack-netlib/SRC/chbevd_2stage.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/chbevx.c b/lapack-netlib/SRC/chbevx.c index e85480256..39ed25b11 100644 --- a/lapack-netlib/SRC/chbevx.c +++ b/lapack-netlib/SRC/chbevx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/chbevx_2stage.c b/lapack-netlib/SRC/chbevx_2stage.c index 157222257..4e34bddb4 100644 --- a/lapack-netlib/SRC/chbevx_2stage.c +++ b/lapack-netlib/SRC/chbevx_2stage.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/chbgst.c b/lapack-netlib/SRC/chbgst.c index 416ce9ec4..4a6125353 100644 --- a/lapack-netlib/SRC/chbgst.c +++ b/lapack-netlib/SRC/chbgst.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/chbgv.c b/lapack-netlib/SRC/chbgv.c index 1a5c67c60..fd25c6f78 100644 --- a/lapack-netlib/SRC/chbgv.c +++ b/lapack-netlib/SRC/chbgv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/chbgvd.c b/lapack-netlib/SRC/chbgvd.c index c1aada39f..f48490424 100644 --- a/lapack-netlib/SRC/chbgvd.c +++ b/lapack-netlib/SRC/chbgvd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/chbgvx.c b/lapack-netlib/SRC/chbgvx.c index 191399fa5..0cbeeeff5 100644 --- a/lapack-netlib/SRC/chbgvx.c +++ b/lapack-netlib/SRC/chbgvx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/chbtrd.c b/lapack-netlib/SRC/chbtrd.c index d748da917..ae8965d13 100644 --- a/lapack-netlib/SRC/chbtrd.c +++ b/lapack-netlib/SRC/chbtrd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/checon.c b/lapack-netlib/SRC/checon.c index 853900896..56b65a7ec 100644 --- a/lapack-netlib/SRC/checon.c +++ b/lapack-netlib/SRC/checon.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/checon_3.c b/lapack-netlib/SRC/checon_3.c index b5318afc4..ced3b6238 100644 --- a/lapack-netlib/SRC/checon_3.c +++ b/lapack-netlib/SRC/checon_3.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/checon_rook.c b/lapack-netlib/SRC/checon_rook.c index fda6cc631..796dc9a0d 100644 --- a/lapack-netlib/SRC/checon_rook.c +++ b/lapack-netlib/SRC/checon_rook.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cheequb.c b/lapack-netlib/SRC/cheequb.c index 141ceee14..f9f4c78ec 100644 --- a/lapack-netlib/SRC/cheequb.c +++ b/lapack-netlib/SRC/cheequb.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cheev_2stage.c b/lapack-netlib/SRC/cheev_2stage.c index 4aec6a933..f70ac96c6 100644 --- a/lapack-netlib/SRC/cheev_2stage.c +++ b/lapack-netlib/SRC/cheev_2stage.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else From 0bd0df84183790af36234322f19d6bf3a73a2707 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Thu, 4 Apr 2024 02:00:24 +0200 Subject: [PATCH 296/311] fix typedef of logical to support INTERFACE64 --- lapack-netlib/SRC/cbbcsd.c | 6 +++--- lapack-netlib/SRC/cbdsqr.c | 6 +++--- lapack-netlib/SRC/cgbbrd.c | 6 +++--- lapack-netlib/SRC/cgbcon.c | 6 +++--- lapack-netlib/SRC/cgbequ.c | 6 +++--- lapack-netlib/SRC/cgbequb.c | 6 +++--- lapack-netlib/SRC/cgbrfs.c | 6 +++--- lapack-netlib/SRC/cgbrfsx.c | 6 +++--- lapack-netlib/SRC/cgbsv.c | 6 +++--- lapack-netlib/SRC/cgbsvx.c | 6 +++--- lapack-netlib/SRC/cgbsvxx.c | 6 +++--- lapack-netlib/SRC/cgbtf2.c | 6 +++--- lapack-netlib/SRC/cgbtrf.c | 6 +++--- lapack-netlib/SRC/cgbtrs.c | 6 +++--- lapack-netlib/SRC/cgebak.c | 6 +++--- lapack-netlib/SRC/cgebal.c | 6 +++--- lapack-netlib/SRC/cgebd2.c | 6 +++--- lapack-netlib/SRC/cgebrd.c | 6 +++--- lapack-netlib/SRC/cgecon.c | 6 +++--- lapack-netlib/SRC/cgedmd.c | 6 +++--- lapack-netlib/SRC/cgedmdq.c | 6 +++--- lapack-netlib/SRC/cgeequ.c | 6 +++--- lapack-netlib/SRC/cgeequb.c | 6 +++--- lapack-netlib/SRC/cgees.c | 6 +++--- lapack-netlib/SRC/cgeesx.c | 6 +++--- lapack-netlib/SRC/cgeev.c | 6 +++--- lapack-netlib/SRC/cgeevx.c | 6 +++--- lapack-netlib/SRC/cgehd2.c | 6 +++--- lapack-netlib/SRC/cgehrd.c | 6 +++--- lapack-netlib/SRC/cgejsv.c | 6 +++--- lapack-netlib/SRC/cgelq.c | 6 +++--- lapack-netlib/SRC/cgelq2.c | 6 +++--- lapack-netlib/SRC/cgelqf.c | 6 +++--- lapack-netlib/SRC/cgelqt.c | 6 +++--- lapack-netlib/SRC/cgelqt3.c | 6 +++--- lapack-netlib/SRC/cgels.c | 6 +++--- lapack-netlib/SRC/cgelsd.c | 6 +++--- lapack-netlib/SRC/cgelss.c | 6 +++--- 38 files changed, 114 insertions(+), 114 deletions(-) diff --git a/lapack-netlib/SRC/cbbcsd.c b/lapack-netlib/SRC/cbbcsd.c index 5754ab80b..097b5ab93 100644 --- a/lapack-netlib/SRC/cbbcsd.c +++ b/lapack-netlib/SRC/cbbcsd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cbdsqr.c b/lapack-netlib/SRC/cbdsqr.c index c9b4d0098..f913307cf 100644 --- a/lapack-netlib/SRC/cbdsqr.c +++ b/lapack-netlib/SRC/cbdsqr.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgbbrd.c b/lapack-netlib/SRC/cgbbrd.c index 929f34d13..b4ec9b26b 100644 --- a/lapack-netlib/SRC/cgbbrd.c +++ b/lapack-netlib/SRC/cgbbrd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgbcon.c b/lapack-netlib/SRC/cgbcon.c index 87565510f..1945c221f 100644 --- a/lapack-netlib/SRC/cgbcon.c +++ b/lapack-netlib/SRC/cgbcon.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgbequ.c b/lapack-netlib/SRC/cgbequ.c index 149497aaf..a7abb8f4e 100644 --- a/lapack-netlib/SRC/cgbequ.c +++ b/lapack-netlib/SRC/cgbequ.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgbequb.c b/lapack-netlib/SRC/cgbequb.c index caa935499..fcc4b7447 100644 --- a/lapack-netlib/SRC/cgbequb.c +++ b/lapack-netlib/SRC/cgbequb.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgbrfs.c b/lapack-netlib/SRC/cgbrfs.c index 8b9ab20d9..886e4926e 100644 --- a/lapack-netlib/SRC/cgbrfs.c +++ b/lapack-netlib/SRC/cgbrfs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgbrfsx.c b/lapack-netlib/SRC/cgbrfsx.c index aa3ac4f72..61885f2fe 100644 --- a/lapack-netlib/SRC/cgbrfsx.c +++ b/lapack-netlib/SRC/cgbrfsx.c @@ -54,8 +54,8 @@ static inline _Complex float * _pCf(complex *z) {return (_Complex float*)z;} static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double*)z;} #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -257,7 +257,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgbsv.c b/lapack-netlib/SRC/cgbsv.c index 2bc88cc76..a5c1d7d12 100644 --- a/lapack-netlib/SRC/cgbsv.c +++ b/lapack-netlib/SRC/cgbsv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgbsvx.c b/lapack-netlib/SRC/cgbsvx.c index 92118b392..518a02dbd 100644 --- a/lapack-netlib/SRC/cgbsvx.c +++ b/lapack-netlib/SRC/cgbsvx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgbsvxx.c b/lapack-netlib/SRC/cgbsvxx.c index 7e0142b46..774bc30d7 100644 --- a/lapack-netlib/SRC/cgbsvxx.c +++ b/lapack-netlib/SRC/cgbsvxx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgbtf2.c b/lapack-netlib/SRC/cgbtf2.c index e09126c80..6493e7a14 100644 --- a/lapack-netlib/SRC/cgbtf2.c +++ b/lapack-netlib/SRC/cgbtf2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgbtrf.c b/lapack-netlib/SRC/cgbtrf.c index 36a782d54..cacdd6ec2 100644 --- a/lapack-netlib/SRC/cgbtrf.c +++ b/lapack-netlib/SRC/cgbtrf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgbtrs.c b/lapack-netlib/SRC/cgbtrs.c index 86df26e23..cd2232c14 100644 --- a/lapack-netlib/SRC/cgbtrs.c +++ b/lapack-netlib/SRC/cgbtrs.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgebak.c b/lapack-netlib/SRC/cgebak.c index a40b10ba2..92cb843d0 100644 --- a/lapack-netlib/SRC/cgebak.c +++ b/lapack-netlib/SRC/cgebak.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgebal.c b/lapack-netlib/SRC/cgebal.c index 26e827944..483e2b410 100644 --- a/lapack-netlib/SRC/cgebal.c +++ b/lapack-netlib/SRC/cgebal.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgebd2.c b/lapack-netlib/SRC/cgebd2.c index 6beb67a56..c0f164272 100644 --- a/lapack-netlib/SRC/cgebd2.c +++ b/lapack-netlib/SRC/cgebd2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgebrd.c b/lapack-netlib/SRC/cgebrd.c index e474cdac3..1427fa34e 100644 --- a/lapack-netlib/SRC/cgebrd.c +++ b/lapack-netlib/SRC/cgebrd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgecon.c b/lapack-netlib/SRC/cgecon.c index dd67491be..a8f084ec8 100644 --- a/lapack-netlib/SRC/cgecon.c +++ b/lapack-netlib/SRC/cgecon.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgedmd.c b/lapack-netlib/SRC/cgedmd.c index 570395c7b..8850d2848 100644 --- a/lapack-netlib/SRC/cgedmd.c +++ b/lapack-netlib/SRC/cgedmd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgedmdq.c b/lapack-netlib/SRC/cgedmdq.c index 6e3a1faca..afb5c7353 100644 --- a/lapack-netlib/SRC/cgedmdq.c +++ b/lapack-netlib/SRC/cgedmdq.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgeequ.c b/lapack-netlib/SRC/cgeequ.c index 466b9290d..5c043f865 100644 --- a/lapack-netlib/SRC/cgeequ.c +++ b/lapack-netlib/SRC/cgeequ.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgeequb.c b/lapack-netlib/SRC/cgeequb.c index 483403930..d107d7d8b 100644 --- a/lapack-netlib/SRC/cgeequb.c +++ b/lapack-netlib/SRC/cgeequb.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgees.c b/lapack-netlib/SRC/cgees.c index a0b44c4b3..9145dc659 100644 --- a/lapack-netlib/SRC/cgees.c +++ b/lapack-netlib/SRC/cgees.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgeesx.c b/lapack-netlib/SRC/cgeesx.c index 848125f1e..b4c408ce4 100644 --- a/lapack-netlib/SRC/cgeesx.c +++ b/lapack-netlib/SRC/cgeesx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgeev.c b/lapack-netlib/SRC/cgeev.c index b5022234b..1df44bca2 100644 --- a/lapack-netlib/SRC/cgeev.c +++ b/lapack-netlib/SRC/cgeev.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgeevx.c b/lapack-netlib/SRC/cgeevx.c index 1d59f2c70..531ec71be 100644 --- a/lapack-netlib/SRC/cgeevx.c +++ b/lapack-netlib/SRC/cgeevx.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgehd2.c b/lapack-netlib/SRC/cgehd2.c index 16d4fd76e..2330a27ae 100644 --- a/lapack-netlib/SRC/cgehd2.c +++ b/lapack-netlib/SRC/cgehd2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgehrd.c b/lapack-netlib/SRC/cgehrd.c index 86f3705a1..a3919624b 100644 --- a/lapack-netlib/SRC/cgehrd.c +++ b/lapack-netlib/SRC/cgehrd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgejsv.c b/lapack-netlib/SRC/cgejsv.c index e4bfd86ae..a3e356ff2 100644 --- a/lapack-netlib/SRC/cgejsv.c +++ b/lapack-netlib/SRC/cgejsv.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgelq.c b/lapack-netlib/SRC/cgelq.c index 0d9ca6399..889d8985a 100644 --- a/lapack-netlib/SRC/cgelq.c +++ b/lapack-netlib/SRC/cgelq.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgelq2.c b/lapack-netlib/SRC/cgelq2.c index 5dae7577f..4d4bfd549 100644 --- a/lapack-netlib/SRC/cgelq2.c +++ b/lapack-netlib/SRC/cgelq2.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgelqf.c b/lapack-netlib/SRC/cgelqf.c index 3aa95c177..d7bf1234e 100644 --- a/lapack-netlib/SRC/cgelqf.c +++ b/lapack-netlib/SRC/cgelqf.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgelqt.c b/lapack-netlib/SRC/cgelqt.c index 9f05cfa34..4ace1dd26 100644 --- a/lapack-netlib/SRC/cgelqt.c +++ b/lapack-netlib/SRC/cgelqt.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgelqt3.c b/lapack-netlib/SRC/cgelqt3.c index 0d7b3d051..64d8552ce 100644 --- a/lapack-netlib/SRC/cgelqt3.c +++ b/lapack-netlib/SRC/cgelqt3.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgels.c b/lapack-netlib/SRC/cgels.c index 6ac7240a8..1a84f97b3 100644 --- a/lapack-netlib/SRC/cgels.c +++ b/lapack-netlib/SRC/cgels.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgelsd.c b/lapack-netlib/SRC/cgelsd.c index 195e7b8d2..145c65274 100644 --- a/lapack-netlib/SRC/cgelsd.c +++ b/lapack-netlib/SRC/cgelsd.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else diff --git a/lapack-netlib/SRC/cgelss.c b/lapack-netlib/SRC/cgelss.c index 2fe469a91..71227e33a 100644 --- a/lapack-netlib/SRC/cgelss.c +++ b/lapack-netlib/SRC/cgelss.c @@ -52,8 +52,8 @@ static inline _Complex double * _pCd(doublecomplex *z) {return (_Complex double* #endif #define pCf(z) (*_pCf(z)) #define pCd(z) (*_pCd(z)) -typedef int logical; -typedef short int shortlogical; +typedef blasint logical; + typedef char logical1; typedef char integer1; @@ -260,7 +260,7 @@ static char junk[] = "\n@(#)LIBF77 VERSION 19990503\n"; /* procedure parameter types for -A and -C++ */ -#define F2C_proc_par_types 1 + #ifdef __cplusplus typedef logical (*L_fp)(...); #else From a721cac76a28566fc0269bb2951b575705148acc Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Thu, 4 Apr 2024 11:28:49 +0200 Subject: [PATCH 297/311] Add GEMM3M tests and logs --- .gitignore | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/.gitignore b/.gitignore index 9fa6a2c99..dc6804f1e 100644 --- a/.gitignore +++ b/.gitignore @@ -51,43 +51,55 @@ utest/openblas_utest_ext ctest/xccblat1 ctest/xccblat2 ctest/xccblat3 +ctest/xccblat3_3m ctest/xdcblat1 ctest/xdcblat2 ctest/xdcblat3 +ctest/xdcblat3_3m ctest/xscblat1 ctest/xscblat2 ctest/xscblat3 +ctest/xscblat3_3m ctest/xzcblat1 ctest/xzcblat2 ctest/xzcblat3 +ctest/xzcblat3_3m exports/linktest.c exports/linux.def kernel/setparam_*.c kernel/kernel_*.h test/CBLAT2.SUMM test/CBLAT3.SUMM +test/CBLAT3_3M.SUMM test/DBLAT2.SUMM test/DBLAT3.SUMM +test/DBLAT3_3M.SUMM test/SBLAT2.SUMM test/SBLAT3.SUMM +test/SBLAT3_3M.SUMM test/ZBLAT2.SUMM test/ZBLAT3.SUMM +test/ZBLAT3_3M.SUMM test/SHBLAT3.SUMM test/SBBLAT3.SUMM test/cblat1 test/cblat2 test/cblat3 +test/cblat3_3m test/dblat1 test/dblat2 test/dblat3 +test/dblat3_3m test/sblat1 test/sblat2 test/sblat3 +test/sblat3_3m test/test_shgemm test/test_sbgemm test/zblat1 test/zblat2 test/zblat3 +test/zblat3_3m build build.* *.swp From edcd5b1797061cff02a43fe30f21c9ec09c98a03 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Thu, 4 Apr 2024 11:40:46 +0200 Subject: [PATCH 298/311] Delete misplaced (and obsoleted) file --- lapack-netlib/zgejsv.f | 2234 ---------------------------------------- 1 file changed, 2234 deletions(-) delete mode 100644 lapack-netlib/zgejsv.f diff --git a/lapack-netlib/zgejsv.f b/lapack-netlib/zgejsv.f deleted file mode 100644 index 5fe899e50..000000000 --- a/lapack-netlib/zgejsv.f +++ /dev/null @@ -1,2234 +0,0 @@ -*> \brief \b ZGEJSV -* -* =========== DOCUMENTATION =========== -* -* Online html documentation available at -* http://www.netlib.org/lapack/explore-html/ -* -*> \htmlonly -*> Download ZGEJSV + dependencies -*> -*> [TGZ] -*> -*> [ZIP] -*> -*> [TXT] -*> \endhtmlonly -* -* Definition: -* =========== -* -* SUBROUTINE ZGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, -* M, N, A, LDA, SVA, U, LDU, V, LDV, -* CWORK, LWORK, RWORK, LRWORK, IWORK, INFO ) -* -* .. Scalar Arguments .. -* IMPLICIT NONE -* INTEGER INFO, LDA, LDU, LDV, LWORK, M, N -* .. -* .. Array Arguments .. -* COMPLEX*16 A( LDA, * ), U( LDU, * ), V( LDV, * ), CWORK( LWORK ) -* DOUBLE PRECISION SVA( N ), RWORK( LRWORK ) -* INTEGER IWORK( * ) -* CHARACTER*1 JOBA, JOBP, JOBR, JOBT, JOBU, JOBV -* .. -* -* -*> \par Purpose: -* ============= -*> -*> \verbatim -*> -*> ZGEJSV computes the singular value decomposition (SVD) of a complex M-by-N -*> matrix [A], where M >= N. The SVD of [A] is written as -*> -*> [A] = [U] * [SIGMA] * [V]^*, -*> -*> where [SIGMA] is an N-by-N (M-by-N) matrix which is zero except for its N -*> diagonal elements, [U] is an M-by-N (or M-by-M) unitary matrix, and -*> [V] is an N-by-N unitary matrix. The diagonal elements of [SIGMA] are -*> the singular values of [A]. The columns of [U] and [V] are the left and -*> the right singular vectors of [A], respectively. The matrices [U] and [V] -*> are computed and stored in the arrays U and V, respectively. The diagonal -*> of [SIGMA] is computed and stored in the array SVA. -*> \endverbatim -*> -*> Arguments: -*> ========== -*> -*> \param[in] JOBA -*> \verbatim -*> JOBA is CHARACTER*1 -*> Specifies the level of accuracy: -*> = 'C': This option works well (high relative accuracy) if A = B * D, -*> with well-conditioned B and arbitrary diagonal matrix D. -*> The accuracy cannot be spoiled by COLUMN scaling. The -*> accuracy of the computed output depends on the condition of -*> B, and the procedure aims at the best theoretical accuracy. -*> The relative error max_{i=1:N}|d sigma_i| / sigma_i is -*> bounded by f(M,N)*epsilon* cond(B), independent of D. -*> The input matrix is preprocessed with the QRF with column -*> pivoting. This initial preprocessing and preconditioning by -*> a rank revealing QR factorization is common for all values of -*> JOBA. Additional actions are specified as follows: -*> = 'E': Computation as with 'C' with an additional estimate of the -*> condition number of B. It provides a realistic error bound. -*> = 'F': If A = D1 * C * D2 with ill-conditioned diagonal scalings -*> D1, D2, and well-conditioned matrix C, this option gives -*> higher accuracy than the 'C' option. If the structure of the -*> input matrix is not known, and relative accuracy is -*> desirable, then this option is advisable. The input matrix A -*> is preprocessed with QR factorization with FULL (row and -*> column) pivoting. -*> = 'G': Computation as with 'F' with an additional estimate of the -*> condition number of B, where A=B*D. If A has heavily weighted -*> rows, then using this condition number gives too pessimistic -*> error bound. -*> = 'A': Small singular values are not well determined by the data -*> and are considered as noisy; the matrix is treated as -*> numerically rank deficient. The error in the computed -*> singular values is bounded by f(m,n)*epsilon*||A||. -*> The computed SVD A = U * S * V^* restores A up to -*> f(m,n)*epsilon*||A||. -*> This gives the procedure the licence to discard (set to zero) -*> all singular values below N*epsilon*||A||. -*> = 'R': Similar as in 'A'. Rank revealing property of the initial -*> QR factorization is used do reveal (using triangular factor) -*> a gap sigma_{r+1} < epsilon * sigma_r in which case the -*> numerical RANK is declared to be r. The SVD is computed with -*> absolute error bounds, but more accurately than with 'A'. -*> \endverbatim -*> -*> \param[in] JOBU -*> \verbatim -*> JOBU is CHARACTER*1 -*> Specifies whether to compute the columns of U: -*> = 'U': N columns of U are returned in the array U. -*> = 'F': full set of M left sing. vectors is returned in the array U. -*> = 'W': U may be used as workspace of length M*N. See the description -*> of U. -*> = 'N': U is not computed. -*> \endverbatim -*> -*> \param[in] JOBV -*> \verbatim -*> JOBV is CHARACTER*1 -*> Specifies whether to compute the matrix V: -*> = 'V': N columns of V are returned in the array V; Jacobi rotations -*> are not explicitly accumulated. -*> = 'J': N columns of V are returned in the array V, but they are -*> computed as the product of Jacobi rotations, if JOBT = 'N'. -*> = 'W': V may be used as workspace of length N*N. See the description -*> of V. -*> = 'N': V is not computed. -*> \endverbatim -*> -*> \param[in] JOBR -*> \verbatim -*> JOBR is CHARACTER*1 -*> Specifies the RANGE for the singular values. Issues the licence to -*> set to zero small positive singular values if they are outside -*> specified range. If A .NE. 0 is scaled so that the largest singular -*> value of c*A is around SQRT(BIG), BIG=DLAMCH('O'), then JOBR issues -*> the licence to kill columns of A whose norm in c*A is less than -*> SQRT(SFMIN) (for JOBR = 'R'), or less than SMALL=SFMIN/EPSLN, -*> where SFMIN=DLAMCH('S'), EPSLN=DLAMCH('E'). -*> = 'N': Do not kill small columns of c*A. This option assumes that -*> BLAS and QR factorizations and triangular solvers are -*> implemented to work in that range. If the condition of A -*> is greater than BIG, use ZGESVJ. -*> = 'R': RESTRICTED range for sigma(c*A) is [SQRT(SFMIN), SQRT(BIG)] -*> (roughly, as described above). This option is recommended. -*> =========================== -*> For computing the singular values in the FULL range [SFMIN,BIG] -*> use ZGESVJ. -*> \endverbatim -*> -*> \param[in] JOBT -*> \verbatim -*> JOBT is CHARACTER*1 -*> If the matrix is square then the procedure may determine to use -*> transposed A if A^* seems to be better with respect to convergence. -*> If the matrix is not square, JOBT is ignored. -*> The decision is based on two values of entropy over the adjoint -*> orbit of A^* * A. See the descriptions of RWORK(6) and RWORK(7). -*> = 'T': transpose if entropy test indicates possibly faster -*> convergence of Jacobi process if A^* is taken as input. If A is -*> replaced with A^*, then the row pivoting is included automatically. -*> = 'N': do not speculate. -*> The option 'T' can be used to compute only the singular values, or -*> the full SVD (U, SIGMA and V). For only one set of singular vectors -*> (U or V), the caller should provide both U and V, as one of the -*> matrices is used as workspace if the matrix A is transposed. -*> The implementer can easily remove this constraint and make the -*> code more complicated. See the descriptions of U and V. -*> In general, this option is considered experimental, and 'N'; should -*> be preferred. This is subject to changes in the future. -*> \endverbatim -*> -*> \param[in] JOBP -*> \verbatim -*> JOBP is CHARACTER*1 -*> Issues the licence to introduce structured perturbations to drown -*> denormalized numbers. This licence should be active if the -*> denormals are poorly implemented, causing slow computation, -*> especially in cases of fast convergence (!). For details see [1,2]. -*> For the sake of simplicity, this perturbations are included only -*> when the full SVD or only the singular values are requested. The -*> implementer/user can easily add the perturbation for the cases of -*> computing one set of singular vectors. -*> = 'P': introduce perturbation -*> = 'N': do not perturb -*> \endverbatim -*> -*> \param[in] M -*> \verbatim -*> M is INTEGER -*> The number of rows of the input matrix A. M >= 0. -*> \endverbatim -*> -*> \param[in] N -*> \verbatim -*> N is INTEGER -*> The number of columns of the input matrix A. M >= N >= 0. -*> \endverbatim -*> -*> \param[in,out] A -*> \verbatim -*> A is COMPLEX*16 array, dimension (LDA,N) -*> On entry, the M-by-N matrix A. -*> \endverbatim -*> -*> \param[in] LDA -*> \verbatim -*> LDA is INTEGER -*> The leading dimension of the array A. LDA >= max(1,M). -*> \endverbatim -*> -*> \param[out] SVA -*> \verbatim -*> SVA is DOUBLE PRECISION array, dimension (N) -*> On exit, -*> - For RWORK(1)/RWORK(2) = ONE: The singular values of A. During -*> the computation SVA contains Euclidean column norms of the -*> iterated matrices in the array A. -*> - For RWORK(1) .NE. RWORK(2): The singular values of A are -*> (RWORK(1)/RWORK(2)) * SVA(1:N). This factored form is used if -*> sigma_max(A) overflows or if small singular values have been -*> saved from underflow by scaling the input matrix A. -*> - If JOBR='R' then some of the singular values may be returned -*> as exact zeros obtained by "set to zero" because they are -*> below the numerical rank threshold or are denormalized numbers. -*> \endverbatim -*> -*> \param[out] U -*> \verbatim -*> U is COMPLEX*16 array, dimension ( LDU, N ) -*> If JOBU = 'U', then U contains on exit the M-by-N matrix of -*> the left singular vectors. -*> If JOBU = 'F', then U contains on exit the M-by-M matrix of -*> the left singular vectors, including an ONB -*> of the orthogonal complement of the Range(A). -*> If JOBU = 'W' .AND. (JOBV = 'V' .AND. JOBT = 'T' .AND. M = N), -*> then U is used as workspace if the procedure -*> replaces A with A^*. In that case, [V] is computed -*> in U as left singular vectors of A^* and then -*> copied back to the V array. This 'W' option is just -*> a reminder to the caller that in this case U is -*> reserved as workspace of length N*N. -*> If JOBU = 'N' U is not referenced, unless JOBT='T'. -*> \endverbatim -*> -*> \param[in] LDU -*> \verbatim -*> LDU is INTEGER -*> The leading dimension of the array U, LDU >= 1. -*> IF JOBU = 'U' or 'F' or 'W', then LDU >= M. -*> \endverbatim -*> -*> \param[out] V -*> \verbatim -*> V is COMPLEX*16 array, dimension ( LDV, N ) -*> If JOBV = 'V', 'J' then V contains on exit the N-by-N matrix of -*> the right singular vectors; -*> If JOBV = 'W', AND (JOBU = 'U' AND JOBT = 'T' AND M = N), -*> then V is used as workspace if the pprocedure -*> replaces A with A^*. In that case, [U] is computed -*> in V as right singular vectors of A^* and then -*> copied back to the U array. This 'W' option is just -*> a reminder to the caller that in this case V is -*> reserved as workspace of length N*N. -*> If JOBV = 'N' V is not referenced, unless JOBT='T'. -*> \endverbatim -*> -*> \param[in] LDV -*> \verbatim -*> LDV is INTEGER -*> The leading dimension of the array V, LDV >= 1. -*> If JOBV = 'V' or 'J' or 'W', then LDV >= N. -*> \endverbatim -*> -*> \param[out] CWORK -*> \verbatim -*> CWORK is COMPLEX*16 array, dimension (MAX(2,LWORK)) -*> If the call to ZGEJSV is a workspace query (indicated by LWORK=-1 or -*> LRWORK=-1), then on exit CWORK(1) contains the required length of -*> CWORK for the job parameters used in the call. -*> \endverbatim -*> -*> \param[in] LWORK -*> \verbatim -*> LWORK is INTEGER -*> Length of CWORK to confirm proper allocation of workspace. -*> LWORK depends on the job: -*> -*> 1. If only SIGMA is needed ( JOBU = 'N', JOBV = 'N' ) and -*> 1.1 .. no scaled condition estimate required (JOBA.NE.'E'.AND.JOBA.NE.'G'): -*> LWORK >= 2*N+1. This is the minimal requirement. -*> ->> For optimal performance (blocked code) the optimal value -*> is LWORK >= N + (N+1)*NB. Here NB is the optimal -*> block size for ZGEQP3 and ZGEQRF. -*> In general, optimal LWORK is computed as -*> LWORK >= max(N+LWORK(ZGEQP3),N+LWORK(ZGEQRF), LWORK(ZGESVJ)). -*> 1.2. .. an estimate of the scaled condition number of A is -*> required (JOBA='E', or 'G'). In this case, LWORK the minimal -*> requirement is LWORK >= N*N + 2*N. -*> ->> For optimal performance (blocked code) the optimal value -*> is LWORK >= max(N+(N+1)*NB, N*N+2*N)=N**2+2*N. -*> In general, the optimal length LWORK is computed as -*> LWORK >= max(N+LWORK(ZGEQP3),N+LWORK(ZGEQRF), LWORK(ZGESVJ), -*> N*N+LWORK(ZPOCON)). -*> 2. If SIGMA and the right singular vectors are needed (JOBV = 'V'), -*> (JOBU = 'N') -*> 2.1 .. no scaled condition estimate requested (JOBE = 'N'): -*> -> the minimal requirement is LWORK >= 3*N. -*> -> For optimal performance, -*> LWORK >= max(N+(N+1)*NB, 2*N+N*NB)=2*N+N*NB, -*> where NB is the optimal block size for ZGEQP3, ZGEQRF, ZGELQF, -*> ZUNMLQ. In general, the optimal length LWORK is computed as -*> LWORK >= max(N+LWORK(ZGEQP3), N+LWORK(ZGESVJ), -*> N+LWORK(ZGELQF), 2*N+LWORK(ZGEQRF), N+LWORK(ZUNMLQ)). -*> 2.2 .. an estimate of the scaled condition number of A is -*> required (JOBA='E', or 'G'). -*> -> the minimal requirement is LWORK >= 3*N. -*> -> For optimal performance, -*> LWORK >= max(N+(N+1)*NB, 2*N,2*N+N*NB)=2*N+N*NB, -*> where NB is the optimal block size for ZGEQP3, ZGEQRF, ZGELQF, -*> ZUNMLQ. In general, the optimal length LWORK is computed as -*> LWORK >= max(N+LWORK(ZGEQP3), LWORK(ZPOCON), N+LWORK(ZGESVJ), -*> N+LWORK(ZGELQF), 2*N+LWORK(ZGEQRF), N+LWORK(ZUNMLQ)). -*> 3. If SIGMA and the left singular vectors are needed -*> 3.1 .. no scaled condition estimate requested (JOBE = 'N'): -*> -> the minimal requirement is LWORK >= 3*N. -*> -> For optimal performance: -*> if JOBU = 'U' :: LWORK >= max(3*N, N+(N+1)*NB, 2*N+N*NB)=2*N+N*NB, -*> where NB is the optimal block size for ZGEQP3, ZGEQRF, ZUNMQR. -*> In general, the optimal length LWORK is computed as -*> LWORK >= max(N+LWORK(ZGEQP3), 2*N+LWORK(ZGEQRF), N+LWORK(ZUNMQR)). -*> 3.2 .. an estimate of the scaled condition number of A is -*> required (JOBA='E', or 'G'). -*> -> the minimal requirement is LWORK >= 3*N. -*> -> For optimal performance: -*> if JOBU = 'U' :: LWORK >= max(3*N, N+(N+1)*NB, 2*N+N*NB)=2*N+N*NB, -*> where NB is the optimal block size for ZGEQP3, ZGEQRF, ZUNMQR. -*> In general, the optimal length LWORK is computed as -*> LWORK >= max(N+LWORK(ZGEQP3),N+LWORK(ZPOCON), -*> 2*N+LWORK(ZGEQRF), N+LWORK(ZUNMQR)). -*> 4. If the full SVD is needed: (JOBU = 'U' or JOBU = 'F') and -*> 4.1. if JOBV = 'V' -*> the minimal requirement is LWORK >= 5*N+2*N*N. -*> 4.2. if JOBV = 'J' the minimal requirement is -*> LWORK >= 4*N+N*N. -*> In both cases, the allocated CWORK can accommodate blocked runs -*> of ZGEQP3, ZGEQRF, ZGELQF, SUNMQR, ZUNMLQ. -*> -*> If the call to ZGEJSV is a workspace query (indicated by LWORK=-1 or -*> LRWORK=-1), then on exit CWORK(1) contains the optimal and CWORK(2) contains the -*> minimal length of CWORK for the job parameters used in the call. -*> \endverbatim -*> -*> \param[out] RWORK -*> \verbatim -*> RWORK is DOUBLE PRECISION array, dimension (MAX(7,LRWORK)) -*> On exit, -*> RWORK(1) = Determines the scaling factor SCALE = RWORK(2) / RWORK(1) -*> such that SCALE*SVA(1:N) are the computed singular values -*> of A. (See the description of SVA().) -*> RWORK(2) = See the description of RWORK(1). -*> RWORK(3) = SCONDA is an estimate for the condition number of -*> column equilibrated A. (If JOBA = 'E' or 'G') -*> SCONDA is an estimate of SQRT(||(R^* * R)^(-1)||_1). -*> It is computed using ZPOCON. It holds -*> N^(-1/4) * SCONDA <= ||R^(-1)||_2 <= N^(1/4) * SCONDA -*> where R is the triangular factor from the QRF of A. -*> However, if R is truncated and the numerical rank is -*> determined to be strictly smaller than N, SCONDA is -*> returned as -1, thus indicating that the smallest -*> singular values might be lost. -*> -*> If full SVD is needed, the following two condition numbers are -*> useful for the analysis of the algorithm. They are provided for -*> a developer/implementer who is familiar with the details of -*> the method. -*> -*> RWORK(4) = an estimate of the scaled condition number of the -*> triangular factor in the first QR factorization. -*> RWORK(5) = an estimate of the scaled condition number of the -*> triangular factor in the second QR factorization. -*> The following two parameters are computed if JOBT = 'T'. -*> They are provided for a developer/implementer who is familiar -*> with the details of the method. -*> RWORK(6) = the entropy of A^* * A :: this is the Shannon entropy -*> of diag(A^* * A) / Trace(A^* * A) taken as point in the -*> probability simplex. -*> RWORK(7) = the entropy of A * A^*. (See the description of RWORK(6).) -*> If the call to ZGEJSV is a workspace query (indicated by LWORK=-1 or -*> LRWORK=-1), then on exit RWORK(1) contains the required length of -*> RWORK for the job parameters used in the call. -*> \endverbatim -*> -*> \param[in] LRWORK -*> \verbatim -*> LRWORK is INTEGER -*> Length of RWORK to confirm proper allocation of workspace. -*> LRWORK depends on the job: -*> -*> 1. If only the singular values are requested i.e. if -*> LSAME(JOBU,'N') .AND. LSAME(JOBV,'N') -*> then: -*> 1.1. If LSAME(JOBT,'T') .OR. LSAME(JOBA,'F') .OR. LSAME(JOBA,'G'), -*> then: LRWORK = max( 7, 2 * M ). -*> 1.2. Otherwise, LRWORK = max( 7, N ). -*> 2. If singular values with the right singular vectors are requested -*> i.e. if -*> (LSAME(JOBV,'V').OR.LSAME(JOBV,'J')) .AND. -*> .NOT.(LSAME(JOBU,'U').OR.LSAME(JOBU,'F')) -*> then: -*> 2.1. If LSAME(JOBT,'T') .OR. LSAME(JOBA,'F') .OR. LSAME(JOBA,'G'), -*> then LRWORK = max( 7, 2 * M ). -*> 2.2. Otherwise, LRWORK = max( 7, N ). -*> 3. If singular values with the left singular vectors are requested, i.e. if -*> (LSAME(JOBU,'U').OR.LSAME(JOBU,'F')) .AND. -*> .NOT.(LSAME(JOBV,'V').OR.LSAME(JOBV,'J')) -*> then: -*> 3.1. If LSAME(JOBT,'T') .OR. LSAME(JOBA,'F') .OR. LSAME(JOBA,'G'), -*> then LRWORK = max( 7, 2 * M ). -*> 3.2. Otherwise, LRWORK = max( 7, N ). -*> 4. If singular values with both the left and the right singular vectors -*> are requested, i.e. if -*> (LSAME(JOBU,'U').OR.LSAME(JOBU,'F')) .AND. -*> (LSAME(JOBV,'V').OR.LSAME(JOBV,'J')) -*> then: -*> 4.1. If LSAME(JOBT,'T') .OR. LSAME(JOBA,'F') .OR. LSAME(JOBA,'G'), -*> then LRWORK = max( 7, 2 * M ). -*> 4.2. Otherwise, LRWORK = max( 7, N ). -*> -*> If, on entry, LRWORK = -1 or LWORK=-1, a workspace query is assumed and -*> the length of RWORK is returned in RWORK(1). -*> \endverbatim -*> -*> \param[out] IWORK -*> \verbatim -*> IWORK is INTEGER array, of dimension at least 4, that further depends -*> on the job: -*> -*> 1. If only the singular values are requested then: -*> If ( LSAME(JOBT,'T') .OR. LSAME(JOBA,'F') .OR. LSAME(JOBA,'G') ) -*> then the length of IWORK is N+M; otherwise the length of IWORK is N. -*> 2. If the singular values and the right singular vectors are requested then: -*> If ( LSAME(JOBT,'T') .OR. LSAME(JOBA,'F') .OR. LSAME(JOBA,'G') ) -*> then the length of IWORK is N+M; otherwise the length of IWORK is N. -*> 3. If the singular values and the left singular vectors are requested then: -*> If ( LSAME(JOBT,'T') .OR. LSAME(JOBA,'F') .OR. LSAME(JOBA,'G') ) -*> then the length of IWORK is N+M; otherwise the length of IWORK is N. -*> 4. If the singular values with both the left and the right singular vectors -*> are requested, then: -*> 4.1. If LSAME(JOBV,'J') the length of IWORK is determined as follows: -*> If ( LSAME(JOBT,'T') .OR. LSAME(JOBA,'F') .OR. LSAME(JOBA,'G') ) -*> then the length of IWORK is N+M; otherwise the length of IWORK is N. -*> 4.2. If LSAME(JOBV,'V') the length of IWORK is determined as follows: -*> If ( LSAME(JOBT,'T') .OR. LSAME(JOBA,'F') .OR. LSAME(JOBA,'G') ) -*> then the length of IWORK is 2*N+M; otherwise the length of IWORK is 2*N. -*> -*> On exit, -*> IWORK(1) = the numerical rank determined after the initial -*> QR factorization with pivoting. See the descriptions -*> of JOBA and JOBR. -*> IWORK(2) = the number of the computed nonzero singular values -*> IWORK(3) = if nonzero, a warning message: -*> If IWORK(3) = 1 then some of the column norms of A -*> were denormalized floats. The requested high accuracy -*> is not warranted by the data. -*> IWORK(4) = 1 or -1. If IWORK(4) = 1, then the procedure used A^* to -*> do the job as specified by the JOB parameters. -*> If the call to ZGEJSV is a workspace query (indicated by LWORK = -1 or -*> LRWORK = -1), then on exit IWORK(1) contains the required length of -*> IWORK for the job parameters used in the call. -*> \endverbatim -*> -*> \param[out] INFO -*> \verbatim -*> INFO is INTEGER -*> < 0: if INFO = -i, then the i-th argument had an illegal value. -*> = 0: successful exit; -*> > 0: ZGEJSV did not converge in the maximal allowed number -*> of sweeps. The computed values may be inaccurate. -*> \endverbatim -* -* Authors: -* ======== -* -*> \author Univ. of Tennessee -*> \author Univ. of California Berkeley -*> \author Univ. of Colorado Denver -*> \author NAG Ltd. -* -*> \ingroup complex16GEsing -* -*> \par Further Details: -* ===================== -*> -*> \verbatim -*> -*> ZGEJSV implements a preconditioned Jacobi SVD algorithm. It uses ZGEQP3, -*> ZGEQRF, and ZGELQF as preprocessors and preconditioners. Optionally, an -*> additional row pivoting can be used as a preprocessor, which in some -*> cases results in much higher accuracy. An example is matrix A with the -*> structure A = D1 * C * D2, where D1, D2 are arbitrarily ill-conditioned -*> diagonal matrices and C is well-conditioned matrix. In that case, complete -*> pivoting in the first QR factorizations provides accuracy dependent on the -*> condition number of C, and independent of D1, D2. Such higher accuracy is -*> not completely understood theoretically, but it works well in practice. -*> Further, if A can be written as A = B*D, with well-conditioned B and some -*> diagonal D, then the high accuracy is guaranteed, both theoretically and -*> in software, independent of D. For more details see [1], [2]. -*> The computational range for the singular values can be the full range -*> ( UNDERFLOW,OVERFLOW ), provided that the machine arithmetic and the BLAS -*> & LAPACK routines called by ZGEJSV are implemented to work in that range. -*> If that is not the case, then the restriction for safe computation with -*> the singular values in the range of normalized IEEE numbers is that the -*> spectral condition number kappa(A)=sigma_max(A)/sigma_min(A) does not -*> overflow. This code (ZGEJSV) is best used in this restricted range, -*> meaning that singular values of magnitude below ||A||_2 / DLAMCH('O') are -*> returned as zeros. See JOBR for details on this. -*> Further, this implementation is somewhat slower than the one described -*> in [1,2] due to replacement of some non-LAPACK components, and because -*> the choice of some tuning parameters in the iterative part (ZGESVJ) is -*> left to the implementer on a particular machine. -*> The rank revealing QR factorization (in this code: ZGEQP3) should be -*> implemented as in [3]. We have a new version of ZGEQP3 under development -*> that is more robust than the current one in LAPACK, with a cleaner cut in -*> rank deficient cases. It will be available in the SIGMA library [4]. -*> If M is much larger than N, it is obvious that the initial QRF with -*> column pivoting can be preprocessed by the QRF without pivoting. That -*> well known trick is not used in ZGEJSV because in some cases heavy row -*> weighting can be treated with complete pivoting. The overhead in cases -*> M much larger than N is then only due to pivoting, but the benefits in -*> terms of accuracy have prevailed. The implementer/user can incorporate -*> this extra QRF step easily. The implementer can also improve data movement -*> (matrix transpose, matrix copy, matrix transposed copy) - this -*> implementation of ZGEJSV uses only the simplest, naive data movement. -*> \endverbatim -* -*> \par Contributor: -* ================== -*> -*> Zlatko Drmac, Department of Mathematics, Faculty of Science, -*> University of Zagreb (Zagreb, Croatia); drmac@math.hr -* -*> \par References: -* ================ -*> -*> \verbatim -*> -*> [1] Z. Drmac and K. Veselic: New fast and accurate Jacobi SVD algorithm I. -*> SIAM J. Matrix Anal. Appl. Vol. 35, No. 2 (2008), pp. 1322-1342. -*> LAPACK Working note 169. -*> [2] Z. Drmac and K. Veselic: New fast and accurate Jacobi SVD algorithm II. -*> SIAM J. Matrix Anal. Appl. Vol. 35, No. 2 (2008), pp. 1343-1362. -*> LAPACK Working note 170. -*> [3] Z. Drmac and Z. Bujanovic: On the failure of rank-revealing QR -*> factorization software - a case study. -*> ACM Trans. Math. Softw. Vol. 35, No 2 (2008), pp. 1-28. -*> LAPACK Working note 176. -*> [4] Z. Drmac: SIGMA - mathematical software library for accurate SVD, PSV, -*> QSVD, (H,K)-SVD computations. -*> Department of Mathematics, University of Zagreb, 2008, 2016. -*> \endverbatim -* -*> \par Bugs, examples and comments: -* ================================= -*> -*> Please report all bugs and send interesting examples and/or comments to -*> drmac@math.hr. Thank you. -*> -* ===================================================================== - SUBROUTINE ZGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, - $ M, N, A, LDA, SVA, U, LDU, V, LDV, - $ CWORK, LWORK, RWORK, LRWORK, IWORK, INFO ) -* -* -- LAPACK computational routine -- -* -- LAPACK is a software package provided by Univ. of Tennessee, -- -* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* -* .. Scalar Arguments .. - IMPLICIT NONE - INTEGER INFO, LDA, LDU, LDV, LWORK, LRWORK, M, N -* .. -* .. Array Arguments .. - COMPLEX*16 A( LDA, * ), U( LDU, * ), V( LDV, * ), - $ CWORK( LWORK ) - DOUBLE PRECISION SVA( N ), RWORK( LRWORK ) - INTEGER IWORK( * ) - CHARACTER*1 JOBA, JOBP, JOBR, JOBT, JOBU, JOBV -* .. -* -* =========================================================================== -* -* .. Local Parameters .. - DOUBLE PRECISION ZERO, ONE - PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 ) - COMPLEX*16 CZERO, CONE - PARAMETER ( CZERO = ( 0.0D0, 0.0D0 ), CONE = ( 1.0D0, 0.0D0 ) ) -* .. -* .. Local Scalars .. - COMPLEX*16 CTEMP - DOUBLE PRECISION AAPP, AAQQ, AATMAX, AATMIN, BIG, BIG1, - $ COND_OK, CONDR1, CONDR2, ENTRA, ENTRAT, EPSLN, - $ MAXPRJ, SCALEM, SCONDA, SFMIN, SMALL, TEMP1, - $ USCAL1, USCAL2, XSC - INTEGER IERR, N1, NR, NUMRANK, p, q, WARNING - LOGICAL ALMORT, DEFR, ERREST, GOSCAL, JRACC, KILL, LQUERY, - $ LSVEC, L2ABER, L2KILL, L2PERT, L2RANK, L2TRAN, NOSCAL, - $ ROWPIV, RSVEC, TRANSP -* - INTEGER OPTWRK, MINWRK, MINRWRK, MINIWRK - INTEGER LWCON, LWLQF, LWQP3, LWQRF, LWUNMLQ, LWUNMQR, LWUNMQRM, - $ LWSVDJ, LWSVDJV, LRWQP3, LRWCON, LRWSVDJ, IWOFF - INTEGER LWRK_ZGELQF, LWRK_ZGEQP3, LWRK_ZGEQP3N, LWRK_ZGEQRF, - $ LWRK_ZGESVJ, LWRK_ZGESVJV, LWRK_ZGESVJU, LWRK_ZUNMLQ, - $ LWRK_ZUNMQR, LWRK_ZUNMQRM -* .. -* .. Local Arrays - COMPLEX*16 CDUMMY(1) - DOUBLE PRECISION RDUMMY(1) -* -* .. Intrinsic Functions .. - INTRINSIC ABS, DCMPLX, CONJG, DLOG, MAX, MIN, DBLE, NINT, SQRT -* .. -* .. External Functions .. - DOUBLE PRECISION DLAMCH, DZNRM2 - INTEGER IDAMAX, IZAMAX - LOGICAL LSAME - EXTERNAL IDAMAX, IZAMAX, LSAME, DLAMCH, DZNRM2 -* .. -* .. External Subroutines .. - EXTERNAL DLASSQ, ZCOPY, ZGELQF, ZGEQP3, ZGEQRF, ZLACPY, ZLAPMR, - $ ZLASCL, DLASCL, ZLASET, ZLASSQ, ZLASWP, ZUNGQR, ZUNMLQ, - $ ZUNMQR, ZPOCON, DSCAL, ZDSCAL, ZSWAP, ZTRSM, ZLACGV, - $ XERBLA -* - EXTERNAL ZGESVJ -* .. -* -* Test the input arguments -* - LSVEC = LSAME( JOBU, 'U' ) .OR. LSAME( JOBU, 'F' ) - JRACC = LSAME( JOBV, 'J' ) - RSVEC = LSAME( JOBV, 'V' ) .OR. JRACC - ROWPIV = LSAME( JOBA, 'F' ) .OR. LSAME( JOBA, 'G' ) - L2RANK = LSAME( JOBA, 'R' ) - L2ABER = LSAME( JOBA, 'A' ) - ERREST = LSAME( JOBA, 'E' ) .OR. LSAME( JOBA, 'G' ) - L2TRAN = LSAME( JOBT, 'T' ) .AND. ( M .EQ. N ) - L2KILL = LSAME( JOBR, 'R' ) - DEFR = LSAME( JOBR, 'N' ) - L2PERT = LSAME( JOBP, 'P' ) -* - LQUERY = ( LWORK .EQ. -1 ) .OR. ( LRWORK .EQ. -1 ) -* - IF ( .NOT.(ROWPIV .OR. L2RANK .OR. L2ABER .OR. - $ ERREST .OR. LSAME( JOBA, 'C' ) )) THEN - INFO = - 1 - ELSE IF ( .NOT.( LSVEC .OR. LSAME( JOBU, 'N' ) .OR. - $ ( LSAME( JOBU, 'W' ) .AND. RSVEC .AND. L2TRAN ) ) ) THEN - INFO = - 2 - ELSE IF ( .NOT.( RSVEC .OR. LSAME( JOBV, 'N' ) .OR. - $ ( LSAME( JOBV, 'W' ) .AND. LSVEC .AND. L2TRAN ) ) ) THEN - INFO = - 3 - ELSE IF ( .NOT. ( L2KILL .OR. DEFR ) ) THEN - INFO = - 4 - ELSE IF ( .NOT. ( LSAME(JOBT,'T') .OR. LSAME(JOBT,'N') ) ) THEN - INFO = - 5 - ELSE IF ( .NOT. ( L2PERT .OR. LSAME( JOBP, 'N' ) ) ) THEN - INFO = - 6 - ELSE IF ( M .LT. 0 ) THEN - INFO = - 7 - ELSE IF ( ( N .LT. 0 ) .OR. ( N .GT. M ) ) THEN - INFO = - 8 - ELSE IF ( LDA .LT. M ) THEN - INFO = - 10 - ELSE IF ( LSVEC .AND. ( LDU .LT. M ) ) THEN - INFO = - 13 - ELSE IF ( RSVEC .AND. ( LDV .LT. N ) ) THEN - INFO = - 15 - ELSE -* #:) - INFO = 0 - END IF -* - IF ( INFO .EQ. 0 ) THEN -* .. compute the minimal and the optimal workspace lengths -* [[The expressions for computing the minimal and the optimal -* values of LCWORK, LRWORK are written with a lot of redundancy and -* can be simplified. However, this verbose form is useful for -* maintenance and modifications of the code.]] -* -* .. minimal workspace length for ZGEQP3 of an M x N matrix, -* ZGEQRF of an N x N matrix, ZGELQF of an N x N matrix, -* ZUNMLQ for computing N x N matrix, ZUNMQR for computing N x N -* matrix, ZUNMQR for computing M x N matrix, respectively. - LWQP3 = N+1 - LWQRF = MAX( 1, N ) - LWLQF = MAX( 1, N ) - LWUNMLQ = MAX( 1, N ) - LWUNMQR = MAX( 1, N ) - LWUNMQRM = MAX( 1, M ) -* .. minimal workspace length for ZPOCON of an N x N matrix - LWCON = 2 * N -* .. minimal workspace length for ZGESVJ of an N x N matrix, -* without and with explicit accumulation of Jacobi rotations - LWSVDJ = MAX( 2 * N, 1 ) - LWSVDJV = MAX( 2 * N, 1 ) -* .. minimal REAL workspace length for ZGEQP3, ZPOCON, ZGESVJ - LRWQP3 = 2 * N - LRWCON = N - LRWSVDJ = N - IF ( LQUERY ) THEN - CALL ZGEQP3( M, N, A, LDA, IWORK, CDUMMY, CDUMMY, -1, - $ RDUMMY, IERR ) - LWRK_ZGEQP3 = INT( CDUMMY(1) ) - CALL ZGEQRF( N, N, A, LDA, CDUMMY, CDUMMY,-1, IERR ) - LWRK_ZGEQRF = INT( CDUMMY(1) ) - CALL ZGELQF( N, N, A, LDA, CDUMMY, CDUMMY,-1, IERR ) - LWRK_ZGELQF = INT( CDUMMY(1) ) - END IF - MINWRK = 2 - OPTWRK = 2 - MINIWRK = N - IF ( .NOT. (LSVEC .OR. RSVEC ) ) THEN -* .. minimal and optimal sizes of the complex workspace if -* only the singular values are requested - IF ( ERREST ) THEN - MINWRK = MAX( N+LWQP3, N**2+LWCON, N+LWQRF, LWSVDJ ) - ELSE - MINWRK = MAX( N+LWQP3, N+LWQRF, LWSVDJ ) - END IF - IF ( LQUERY ) THEN - CALL ZGESVJ( 'L', 'N', 'N', N, N, A, LDA, SVA, N, V, - $ LDV, CDUMMY, -1, RDUMMY, -1, IERR ) - LWRK_ZGESVJ = INT( CDUMMY(1) ) - IF ( ERREST ) THEN - OPTWRK = MAX( N+LWRK_ZGEQP3, N**2+LWCON, - $ N+LWRK_ZGEQRF, LWRK_ZGESVJ ) - ELSE - OPTWRK = MAX( N+LWRK_ZGEQP3, N+LWRK_ZGEQRF, - $ LWRK_ZGESVJ ) - END IF - END IF - IF ( L2TRAN .OR. ROWPIV ) THEN - IF ( ERREST ) THEN - MINRWRK = MAX( 7, 2*M, LRWQP3, LRWCON, LRWSVDJ ) - ELSE - MINRWRK = MAX( 7, 2*M, LRWQP3, LRWSVDJ ) - END IF - ELSE - IF ( ERREST ) THEN - MINRWRK = MAX( 7, LRWQP3, LRWCON, LRWSVDJ ) - ELSE - MINRWRK = MAX( 7, LRWQP3, LRWSVDJ ) - END IF - END IF - IF ( ROWPIV .OR. L2TRAN ) MINIWRK = MINIWRK + M - ELSE IF ( RSVEC .AND. (.NOT.LSVEC) ) THEN -* .. minimal and optimal sizes of the complex workspace if the -* singular values and the right singular vectors are requested - IF ( ERREST ) THEN - MINWRK = MAX( N+LWQP3, LWCON, LWSVDJ, N+LWLQF, - $ 2*N+LWQRF, N+LWSVDJ, N+LWUNMLQ ) - ELSE - MINWRK = MAX( N+LWQP3, LWSVDJ, N+LWLQF, 2*N+LWQRF, - $ N+LWSVDJ, N+LWUNMLQ ) - END IF - IF ( LQUERY ) THEN - CALL ZGESVJ( 'L', 'U', 'N', N,N, U, LDU, SVA, N, A, - $ LDA, CDUMMY, -1, RDUMMY, -1, IERR ) - LWRK_ZGESVJ = INT( CDUMMY(1) ) - CALL ZUNMLQ( 'L', 'C', N, N, N, A, LDA, CDUMMY, - $ V, LDV, CDUMMY, -1, IERR ) - LWRK_ZUNMLQ = INT( CDUMMY(1) ) - IF ( ERREST ) THEN - OPTWRK = MAX( N+LWRK_ZGEQP3, LWCON, LWRK_ZGESVJ, - $ N+LWRK_ZGELQF, 2*N+LWRK_ZGEQRF, - $ N+LWRK_ZGESVJ, N+LWRK_ZUNMLQ ) - ELSE - OPTWRK = MAX( N+LWRK_ZGEQP3, LWRK_ZGESVJ,N+LWRK_ZGELQF, - $ 2*N+LWRK_ZGEQRF, N+LWRK_ZGESVJ, - $ N+LWRK_ZUNMLQ ) - END IF - END IF - IF ( L2TRAN .OR. ROWPIV ) THEN - IF ( ERREST ) THEN - MINRWRK = MAX( 7, 2*M, LRWQP3, LRWSVDJ, LRWCON ) - ELSE - MINRWRK = MAX( 7, 2*M, LRWQP3, LRWSVDJ ) - END IF - ELSE - IF ( ERREST ) THEN - MINRWRK = MAX( 7, LRWQP3, LRWSVDJ, LRWCON ) - ELSE - MINRWRK = MAX( 7, LRWQP3, LRWSVDJ ) - END IF - END IF - IF ( ROWPIV .OR. L2TRAN ) MINIWRK = MINIWRK + M - ELSE IF ( LSVEC .AND. (.NOT.RSVEC) ) THEN -* .. minimal and optimal sizes of the complex workspace if the -* singular values and the left singular vectors are requested - IF ( ERREST ) THEN - MINWRK = N + MAX( LWQP3,LWCON,N+LWQRF,LWSVDJ,LWUNMQRM ) - ELSE - MINWRK = N + MAX( LWQP3, N+LWQRF, LWSVDJ, LWUNMQRM ) - END IF - IF ( LQUERY ) THEN - CALL ZGESVJ( 'L', 'U', 'N', N,N, U, LDU, SVA, N, A, - $ LDA, CDUMMY, -1, RDUMMY, -1, IERR ) - LWRK_ZGESVJ = INT( CDUMMY(1) ) - CALL ZUNMQR( 'L', 'N', M, N, N, A, LDA, CDUMMY, U, - $ LDU, CDUMMY, -1, IERR ) - LWRK_ZUNMQRM = INT( CDUMMY(1) ) - IF ( ERREST ) THEN - OPTWRK = N + MAX( LWRK_ZGEQP3, LWCON, N+LWRK_ZGEQRF, - $ LWRK_ZGESVJ, LWRK_ZUNMQRM ) - ELSE - OPTWRK = N + MAX( LWRK_ZGEQP3, N+LWRK_ZGEQRF, - $ LWRK_ZGESVJ, LWRK_ZUNMQRM ) - END IF - END IF - IF ( L2TRAN .OR. ROWPIV ) THEN - IF ( ERREST ) THEN - MINRWRK = MAX( 7, 2*M, LRWQP3, LRWSVDJ, LRWCON ) - ELSE - MINRWRK = MAX( 7, 2*M, LRWQP3, LRWSVDJ ) - END IF - ELSE - IF ( ERREST ) THEN - MINRWRK = MAX( 7, LRWQP3, LRWSVDJ, LRWCON ) - ELSE - MINRWRK = MAX( 7, LRWQP3, LRWSVDJ ) - END IF - END IF - IF ( ROWPIV .OR. L2TRAN ) MINIWRK = MINIWRK + M - ELSE -* .. minimal and optimal sizes of the complex workspace if the -* full SVD is requested - IF ( .NOT. JRACC ) THEN - IF ( ERREST ) THEN - MINWRK = MAX( N+LWQP3, N+LWCON, 2*N+N**2+LWCON, - $ 2*N+LWQRF, 2*N+LWQP3, - $ 2*N+N**2+N+LWLQF, 2*N+N**2+N+N**2+LWCON, - $ 2*N+N**2+N+LWSVDJ, 2*N+N**2+N+LWSVDJV, - $ 2*N+N**2+N+LWUNMQR,2*N+N**2+N+LWUNMLQ, - $ N+N**2+LWSVDJ, N+LWUNMQRM ) - ELSE - MINWRK = MAX( N+LWQP3, 2*N+N**2+LWCON, - $ 2*N+LWQRF, 2*N+LWQP3, - $ 2*N+N**2+N+LWLQF, 2*N+N**2+N+N**2+LWCON, - $ 2*N+N**2+N+LWSVDJ, 2*N+N**2+N+LWSVDJV, - $ 2*N+N**2+N+LWUNMQR,2*N+N**2+N+LWUNMLQ, - $ N+N**2+LWSVDJ, N+LWUNMQRM ) - END IF - MINIWRK = MINIWRK + N - IF ( ROWPIV .OR. L2TRAN ) MINIWRK = MINIWRK + M - ELSE - IF ( ERREST ) THEN - MINWRK = MAX( N+LWQP3, N+LWCON, 2*N+LWQRF, - $ 2*N+N**2+LWSVDJV, 2*N+N**2+N+LWUNMQR, - $ N+LWUNMQRM ) - ELSE - MINWRK = MAX( N+LWQP3, 2*N+LWQRF, - $ 2*N+N**2+LWSVDJV, 2*N+N**2+N+LWUNMQR, - $ N+LWUNMQRM ) - END IF - IF ( ROWPIV .OR. L2TRAN ) MINIWRK = MINIWRK + M - END IF - IF ( LQUERY ) THEN - CALL ZUNMQR( 'L', 'N', M, N, N, A, LDA, CDUMMY, U, - $ LDU, CDUMMY, -1, IERR ) - LWRK_ZUNMQRM = INT( CDUMMY(1) ) - CALL ZUNMQR( 'L', 'N', N, N, N, A, LDA, CDUMMY, U, - $ LDU, CDUMMY, -1, IERR ) - LWRK_ZUNMQR = INT( CDUMMY(1) ) - IF ( .NOT. JRACC ) THEN - CALL ZGEQP3( N,N, A, LDA, IWORK, CDUMMY,CDUMMY, -1, - $ RDUMMY, IERR ) - LWRK_ZGEQP3N = INT( CDUMMY(1) ) - CALL ZGESVJ( 'L', 'U', 'N', N, N, U, LDU, SVA, - $ N, V, LDV, CDUMMY, -1, RDUMMY, -1, IERR ) - LWRK_ZGESVJ = INT( CDUMMY(1) ) - CALL ZGESVJ( 'U', 'U', 'N', N, N, U, LDU, SVA, - $ N, V, LDV, CDUMMY, -1, RDUMMY, -1, IERR ) - LWRK_ZGESVJU = INT( CDUMMY(1) ) - CALL ZGESVJ( 'L', 'U', 'V', N, N, U, LDU, SVA, - $ N, V, LDV, CDUMMY, -1, RDUMMY, -1, IERR ) - LWRK_ZGESVJV = INT( CDUMMY(1) ) - CALL ZUNMLQ( 'L', 'C', N, N, N, A, LDA, CDUMMY, - $ V, LDV, CDUMMY, -1, IERR ) - LWRK_ZUNMLQ = INT( CDUMMY(1) ) - IF ( ERREST ) THEN - OPTWRK = MAX( N+LWRK_ZGEQP3, N+LWCON, - $ 2*N+N**2+LWCON, 2*N+LWRK_ZGEQRF, - $ 2*N+LWRK_ZGEQP3N, - $ 2*N+N**2+N+LWRK_ZGELQF, - $ 2*N+N**2+N+N**2+LWCON, - $ 2*N+N**2+N+LWRK_ZGESVJ, - $ 2*N+N**2+N+LWRK_ZGESVJV, - $ 2*N+N**2+N+LWRK_ZUNMQR, - $ 2*N+N**2+N+LWRK_ZUNMLQ, - $ N+N**2+LWRK_ZGESVJU, - $ N+LWRK_ZUNMQRM ) - ELSE - OPTWRK = MAX( N+LWRK_ZGEQP3, - $ 2*N+N**2+LWCON, 2*N+LWRK_ZGEQRF, - $ 2*N+LWRK_ZGEQP3N, - $ 2*N+N**2+N+LWRK_ZGELQF, - $ 2*N+N**2+N+N**2+LWCON, - $ 2*N+N**2+N+LWRK_ZGESVJ, - $ 2*N+N**2+N+LWRK_ZGESVJV, - $ 2*N+N**2+N+LWRK_ZUNMQR, - $ 2*N+N**2+N+LWRK_ZUNMLQ, - $ N+N**2+LWRK_ZGESVJU, - $ N+LWRK_ZUNMQRM ) - END IF - ELSE - CALL ZGESVJ( 'L', 'U', 'V', N, N, U, LDU, SVA, - $ N, V, LDV, CDUMMY, -1, RDUMMY, -1, IERR ) - LWRK_ZGESVJV = INT( CDUMMY(1) ) - CALL ZUNMQR( 'L', 'N', N, N, N, CDUMMY, N, CDUMMY, - $ V, LDV, CDUMMY, -1, IERR ) - LWRK_ZUNMQR = INT( CDUMMY(1) ) - CALL ZUNMQR( 'L', 'N', M, N, N, A, LDA, CDUMMY, U, - $ LDU, CDUMMY, -1, IERR ) - LWRK_ZUNMQRM = INT( CDUMMY(1) ) - IF ( ERREST ) THEN - OPTWRK = MAX( N+LWRK_ZGEQP3, N+LWCON, - $ 2*N+LWRK_ZGEQRF, 2*N+N**2, - $ 2*N+N**2+LWRK_ZGESVJV, - $ 2*N+N**2+N+LWRK_ZUNMQR,N+LWRK_ZUNMQRM ) - ELSE - OPTWRK = MAX( N+LWRK_ZGEQP3, 2*N+LWRK_ZGEQRF, - $ 2*N+N**2, 2*N+N**2+LWRK_ZGESVJV, - $ 2*N+N**2+N+LWRK_ZUNMQR, - $ N+LWRK_ZUNMQRM ) - END IF - END IF - END IF - IF ( L2TRAN .OR. ROWPIV ) THEN - MINRWRK = MAX( 7, 2*M, LRWQP3, LRWSVDJ, LRWCON ) - ELSE - MINRWRK = MAX( 7, LRWQP3, LRWSVDJ, LRWCON ) - END IF - END IF - MINWRK = MAX( 2, MINWRK ) - OPTWRK = MAX( MINWRK, OPTWRK ) - IF ( LWORK .LT. MINWRK .AND. (.NOT.LQUERY) ) INFO = - 17 - IF ( LRWORK .LT. MINRWRK .AND. (.NOT.LQUERY) ) INFO = - 19 - END IF -* - IF ( INFO .NE. 0 ) THEN -* #:( - CALL XERBLA( 'ZGEJSV', - INFO ) - RETURN - ELSE IF ( LQUERY ) THEN - CWORK(1) = OPTWRK - CWORK(2) = MINWRK - RWORK(1) = MINRWRK - IWORK(1) = MAX( 4, MINIWRK ) - RETURN - END IF -* -* Quick return for void matrix (Y3K safe) -* #:) - IF ( ( M .EQ. 0 ) .OR. ( N .EQ. 0 ) ) THEN - IWORK(1:4) = 0 - RWORK(1:7) = 0 - RETURN - ENDIF -* -* Determine whether the matrix U should be M x N or M x M -* - IF ( LSVEC ) THEN - N1 = N - IF ( LSAME( JOBU, 'F' ) ) N1 = M - END IF -* -* Set numerical parameters -* -*! NOTE: Make sure DLAMCH() does not fail on the target architecture. -* - EPSLN = DLAMCH('Epsilon') - SFMIN = DLAMCH('SafeMinimum') - SMALL = SFMIN / EPSLN - BIG = DLAMCH('O') -* BIG = ONE / SFMIN -* -* Initialize SVA(1:N) = diag( ||A e_i||_2 )_1^N -* -*(!) If necessary, scale SVA() to protect the largest norm from -* overflow. It is possible that this scaling pushes the smallest -* column norm left from the underflow threshold (extreme case). -* - SCALEM = ONE / SQRT(DBLE(M)*DBLE(N)) - NOSCAL = .TRUE. - GOSCAL = .TRUE. - DO 1874 p = 1, N - AAPP = ZERO - AAQQ = ONE - CALL ZLASSQ( M, A(1,p), 1, AAPP, AAQQ ) - IF ( AAPP .GT. BIG ) THEN - INFO = - 9 - CALL XERBLA( 'ZGEJSV', -INFO ) - RETURN - END IF - AAQQ = SQRT(AAQQ) - IF ( ( AAPP .LT. (BIG / AAQQ) ) .AND. NOSCAL ) THEN - SVA(p) = AAPP * AAQQ - ELSE - NOSCAL = .FALSE. - SVA(p) = AAPP * ( AAQQ * SCALEM ) - IF ( GOSCAL ) THEN - GOSCAL = .FALSE. - CALL DSCAL( p-1, SCALEM, SVA, 1 ) - END IF - END IF - 1874 CONTINUE -* - IF ( NOSCAL ) SCALEM = ONE -* - AAPP = ZERO - AAQQ = BIG - DO 4781 p = 1, N - AAPP = MAX( AAPP, SVA(p) ) - IF ( SVA(p) .NE. ZERO ) AAQQ = MIN( AAQQ, SVA(p) ) - 4781 CONTINUE -* -* Quick return for zero M x N matrix -* #:) - IF ( AAPP .EQ. ZERO ) THEN - IF ( LSVEC ) CALL ZLASET( 'G', M, N1, CZERO, CONE, U, LDU ) - IF ( RSVEC ) CALL ZLASET( 'G', N, N, CZERO, CONE, V, LDV ) - RWORK(1) = ONE - RWORK(2) = ONE - IF ( ERREST ) RWORK(3) = ONE - IF ( LSVEC .AND. RSVEC ) THEN - RWORK(4) = ONE - RWORK(5) = ONE - END IF - IF ( L2TRAN ) THEN - RWORK(6) = ZERO - RWORK(7) = ZERO - END IF - IWORK(1) = 0 - IWORK(2) = 0 - IWORK(3) = 0 - IWORK(4) = -1 - RETURN - END IF -* -* Issue warning if denormalized column norms detected. Override the -* high relative accuracy request. Issue licence to kill nonzero columns -* (set them to zero) whose norm is less than sigma_max / BIG (roughly). -* #:( - WARNING = 0 - IF ( AAQQ .LE. SFMIN ) THEN - L2RANK = .TRUE. - L2KILL = .TRUE. - WARNING = 1 - END IF -* -* Quick return for one-column matrix -* #:) - IF ( N .EQ. 1 ) THEN -* - IF ( LSVEC ) THEN - CALL ZLASCL( 'G',0,0,SVA(1),SCALEM, M,1,A(1,1),LDA,IERR ) - CALL ZLACPY( 'A', M, 1, A, LDA, U, LDU ) -* computing all M left singular vectors of the M x 1 matrix - IF ( N1 .NE. N ) THEN - CALL ZGEQRF( M, N, U,LDU, CWORK, CWORK(N+1),LWORK-N,IERR ) - CALL ZUNGQR( M,N1,1, U,LDU,CWORK,CWORK(N+1),LWORK-N,IERR ) - CALL ZCOPY( M, A(1,1), 1, U(1,1), 1 ) - END IF - END IF - IF ( RSVEC ) THEN - V(1,1) = CONE - END IF - IF ( SVA(1) .LT. (BIG*SCALEM) ) THEN - SVA(1) = SVA(1) / SCALEM - SCALEM = ONE - END IF - RWORK(1) = ONE / SCALEM - RWORK(2) = ONE - IF ( SVA(1) .NE. ZERO ) THEN - IWORK(1) = 1 - IF ( ( SVA(1) / SCALEM) .GE. SFMIN ) THEN - IWORK(2) = 1 - ELSE - IWORK(2) = 0 - END IF - ELSE - IWORK(1) = 0 - IWORK(2) = 0 - END IF - IWORK(3) = 0 - IWORK(4) = -1 - IF ( ERREST ) RWORK(3) = ONE - IF ( LSVEC .AND. RSVEC ) THEN - RWORK(4) = ONE - RWORK(5) = ONE - END IF - IF ( L2TRAN ) THEN - RWORK(6) = ZERO - RWORK(7) = ZERO - END IF - RETURN -* - END IF -* - TRANSP = .FALSE. -* - AATMAX = -ONE - AATMIN = BIG - IF ( ROWPIV .OR. L2TRAN ) THEN -* -* Compute the row norms, needed to determine row pivoting sequence -* (in the case of heavily row weighted A, row pivoting is strongly -* advised) and to collect information needed to compare the -* structures of A * A^* and A^* * A (in the case L2TRAN.EQ..TRUE.). -* - IF ( L2TRAN ) THEN - DO 1950 p = 1, M - XSC = ZERO - TEMP1 = ONE - CALL ZLASSQ( N, A(p,1), LDA, XSC, TEMP1 ) -* ZLASSQ gets both the ell_2 and the ell_infinity norm -* in one pass through the vector - RWORK(M+p) = XSC * SCALEM - RWORK(p) = XSC * (SCALEM*SQRT(TEMP1)) - AATMAX = MAX( AATMAX, RWORK(p) ) - IF (RWORK(p) .NE. ZERO) - $ AATMIN = MIN(AATMIN,RWORK(p)) - 1950 CONTINUE - ELSE - DO 1904 p = 1, M - RWORK(M+p) = SCALEM*ABS( A(p,IZAMAX(N,A(p,1),LDA)) ) - AATMAX = MAX( AATMAX, RWORK(M+p) ) - AATMIN = MIN( AATMIN, RWORK(M+p) ) - 1904 CONTINUE - END IF -* - END IF -* -* For square matrix A try to determine whether A^* would be better -* input for the preconditioned Jacobi SVD, with faster convergence. -* The decision is based on an O(N) function of the vector of column -* and row norms of A, based on the Shannon entropy. This should give -* the right choice in most cases when the difference actually matters. -* It may fail and pick the slower converging side. -* - ENTRA = ZERO - ENTRAT = ZERO - IF ( L2TRAN ) THEN -* - XSC = ZERO - TEMP1 = ONE - CALL DLASSQ( N, SVA, 1, XSC, TEMP1 ) - TEMP1 = ONE / TEMP1 -* - ENTRA = ZERO - DO 1113 p = 1, N - BIG1 = ( ( SVA(p) / XSC )**2 ) * TEMP1 - IF ( BIG1 .NE. ZERO ) ENTRA = ENTRA + BIG1 * DLOG(BIG1) - 1113 CONTINUE - ENTRA = - ENTRA / DLOG(DBLE(N)) -* -* Now, SVA().^2/Trace(A^* * A) is a point in the probability simplex. -* It is derived from the diagonal of A^* * A. Do the same with the -* diagonal of A * A^*, compute the entropy of the corresponding -* probability distribution. Note that A * A^* and A^* * A have the -* same trace. -* - ENTRAT = ZERO - DO 1114 p = 1, M - BIG1 = ( ( RWORK(p) / XSC )**2 ) * TEMP1 - IF ( BIG1 .NE. ZERO ) ENTRAT = ENTRAT + BIG1 * DLOG(BIG1) - 1114 CONTINUE - ENTRAT = - ENTRAT / DLOG(DBLE(M)) -* -* Analyze the entropies and decide A or A^*. Smaller entropy -* usually means better input for the algorithm. -* - TRANSP = ( ENTRAT .LT. ENTRA ) -* -* If A^* is better than A, take the adjoint of A. This is allowed -* only for square matrices, M=N. - IF ( TRANSP ) THEN -* In an optimal implementation, this trivial transpose -* should be replaced with faster transpose. - DO 1115 p = 1, N - 1 - A(p,p) = CONJG(A(p,p)) - DO 1116 q = p + 1, N - CTEMP = CONJG(A(q,p)) - A(q,p) = CONJG(A(p,q)) - A(p,q) = CTEMP - 1116 CONTINUE - 1115 CONTINUE - A(N,N) = CONJG(A(N,N)) - DO 1117 p = 1, N - RWORK(M+p) = SVA(p) - SVA(p) = RWORK(p) -* previously computed row 2-norms are now column 2-norms -* of the transposed matrix - 1117 CONTINUE - TEMP1 = AAPP - AAPP = AATMAX - AATMAX = TEMP1 - TEMP1 = AAQQ - AAQQ = AATMIN - AATMIN = TEMP1 - KILL = LSVEC - LSVEC = RSVEC - RSVEC = KILL - IF ( LSVEC ) N1 = N -* - ROWPIV = .TRUE. - END IF -* - END IF -* END IF L2TRAN -* -* Scale the matrix so that its maximal singular value remains less -* than SQRT(BIG) -- the matrix is scaled so that its maximal column -* has Euclidean norm equal to SQRT(BIG/N). The only reason to keep -* SQRT(BIG) instead of BIG is the fact that ZGEJSV uses LAPACK and -* BLAS routines that, in some implementations, are not capable of -* working in the full interval [SFMIN,BIG] and that they may provoke -* overflows in the intermediate results. If the singular values spread -* from SFMIN to BIG, then ZGESVJ will compute them. So, in that case, -* one should use ZGESVJ instead of ZGEJSV. -* >> change in the April 2016 update: allow bigger range, i.e. the -* largest column is allowed up to BIG/N and ZGESVJ will do the rest. - BIG1 = SQRT( BIG ) - TEMP1 = SQRT( BIG / DBLE(N) ) -* TEMP1 = BIG/DBLE(N) -* - CALL DLASCL( 'G', 0, 0, AAPP, TEMP1, N, 1, SVA, N, IERR ) - IF ( AAQQ .GT. (AAPP * SFMIN) ) THEN - AAQQ = ( AAQQ / AAPP ) * TEMP1 - ELSE - AAQQ = ( AAQQ * TEMP1 ) / AAPP - END IF - TEMP1 = TEMP1 * SCALEM - CALL ZLASCL( 'G', 0, 0, AAPP, TEMP1, M, N, A, LDA, IERR ) -* -* To undo scaling at the end of this procedure, multiply the -* computed singular values with USCAL2 / USCAL1. -* - USCAL1 = TEMP1 - USCAL2 = AAPP -* - IF ( L2KILL ) THEN -* L2KILL enforces computation of nonzero singular values in -* the restricted range of condition number of the initial A, -* sigma_max(A) / sigma_min(A) approx. SQRT(BIG)/SQRT(SFMIN). - XSC = SQRT( SFMIN ) - ELSE - XSC = SMALL -* -* Now, if the condition number of A is too big, -* sigma_max(A) / sigma_min(A) .GT. SQRT(BIG/N) * EPSLN / SFMIN, -* as a precaution measure, the full SVD is computed using ZGESVJ -* with accumulated Jacobi rotations. This provides numerically -* more robust computation, at the cost of slightly increased run -* time. Depending on the concrete implementation of BLAS and LAPACK -* (i.e. how they behave in presence of extreme ill-conditioning) the -* implementor may decide to remove this switch. - IF ( ( AAQQ.LT.SQRT(SFMIN) ) .AND. LSVEC .AND. RSVEC ) THEN - JRACC = .TRUE. - END IF -* - END IF - IF ( AAQQ .LT. XSC ) THEN - DO 700 p = 1, N - IF ( SVA(p) .LT. XSC ) THEN - CALL ZLASET( 'A', M, 1, CZERO, CZERO, A(1,p), LDA ) - SVA(p) = ZERO - END IF - 700 CONTINUE - END IF -* -* Preconditioning using QR factorization with pivoting -* - IF ( ROWPIV ) THEN -* Optional row permutation (Bjoerck row pivoting): -* A result by Cox and Higham shows that the Bjoerck's -* row pivoting combined with standard column pivoting -* has similar effect as Powell-Reid complete pivoting. -* The ell-infinity norms of A are made nonincreasing. - IF ( ( LSVEC .AND. RSVEC ) .AND. .NOT.( JRACC ) ) THEN - IWOFF = 2*N - ELSE - IWOFF = N - END IF - DO 1952 p = 1, M - 1 - q = IDAMAX( M-p+1, RWORK(M+p), 1 ) + p - 1 - IWORK(IWOFF+p) = q - IF ( p .NE. q ) THEN - TEMP1 = RWORK(M+p) - RWORK(M+p) = RWORK(M+q) - RWORK(M+q) = TEMP1 - END IF - 1952 CONTINUE - CALL ZLASWP( N, A, LDA, 1, M-1, IWORK(IWOFF+1), 1 ) - END IF -* -* End of the preparation phase (scaling, optional sorting and -* transposing, optional flushing of small columns). -* -* Preconditioning -* -* If the full SVD is needed, the right singular vectors are computed -* from a matrix equation, and for that we need theoretical analysis -* of the Businger-Golub pivoting. So we use ZGEQP3 as the first RR QRF. -* In all other cases the first RR QRF can be chosen by other criteria -* (eg speed by replacing global with restricted window pivoting, such -* as in xGEQPX from TOMS # 782). Good results will be obtained using -* xGEQPX with properly (!) chosen numerical parameters. -* Any improvement of ZGEQP3 improves overall performance of ZGEJSV. -* -* A * P1 = Q1 * [ R1^* 0]^*: - DO 1963 p = 1, N -* .. all columns are free columns - IWORK(p) = 0 - 1963 CONTINUE - CALL ZGEQP3( M, N, A, LDA, IWORK, CWORK, CWORK(N+1), LWORK-N, - $ RWORK, IERR ) -* -* The upper triangular matrix R1 from the first QRF is inspected for -* rank deficiency and possibilities for deflation, or possible -* ill-conditioning. Depending on the user specified flag L2RANK, -* the procedure explores possibilities to reduce the numerical -* rank by inspecting the computed upper triangular factor. If -* L2RANK or L2ABER are up, then ZGEJSV will compute the SVD of -* A + dA, where ||dA|| <= f(M,N)*EPSLN. -* - NR = 1 - IF ( L2ABER ) THEN -* Standard absolute error bound suffices. All sigma_i with -* sigma_i < N*EPSLN*||A|| are flushed to zero. This is an -* aggressive enforcement of lower numerical rank by introducing a -* backward error of the order of N*EPSLN*||A||. - TEMP1 = SQRT(DBLE(N))*EPSLN - DO 3001 p = 2, N - IF ( ABS(A(p,p)) .GE. (TEMP1*ABS(A(1,1))) ) THEN - NR = NR + 1 - ELSE - GO TO 3002 - END IF - 3001 CONTINUE - 3002 CONTINUE - ELSE IF ( L2RANK ) THEN -* .. similarly as above, only slightly more gentle (less aggressive). -* Sudden drop on the diagonal of R1 is used as the criterion for -* close-to-rank-deficient. - TEMP1 = SQRT(SFMIN) - DO 3401 p = 2, N - IF ( ( ABS(A(p,p)) .LT. (EPSLN*ABS(A(p-1,p-1))) ) .OR. - $ ( ABS(A(p,p)) .LT. SMALL ) .OR. - $ ( L2KILL .AND. (ABS(A(p,p)) .LT. TEMP1) ) ) GO TO 3402 - NR = NR + 1 - 3401 CONTINUE - 3402 CONTINUE -* - ELSE -* The goal is high relative accuracy. However, if the matrix -* has high scaled condition number the relative accuracy is in -* general not feasible. Later on, a condition number estimator -* will be deployed to estimate the scaled condition number. -* Here we just remove the underflowed part of the triangular -* factor. This prevents the situation in which the code is -* working hard to get the accuracy not warranted by the data. - TEMP1 = SQRT(SFMIN) - DO 3301 p = 2, N - IF ( ( ABS(A(p,p)) .LT. SMALL ) .OR. - $ ( L2KILL .AND. (ABS(A(p,p)) .LT. TEMP1) ) ) GO TO 3302 - NR = NR + 1 - 3301 CONTINUE - 3302 CONTINUE -* - END IF -* - ALMORT = .FALSE. - IF ( NR .EQ. N ) THEN - MAXPRJ = ONE - DO 3051 p = 2, N - TEMP1 = ABS(A(p,p)) / SVA(IWORK(p)) - MAXPRJ = MIN( MAXPRJ, TEMP1 ) - 3051 CONTINUE - IF ( MAXPRJ**2 .GE. ONE - DBLE(N)*EPSLN ) ALMORT = .TRUE. - END IF -* -* - SCONDA = - ONE - CONDR1 = - ONE - CONDR2 = - ONE -* - IF ( ERREST ) THEN - IF ( N .EQ. NR ) THEN - IF ( RSVEC ) THEN -* .. V is available as workspace - CALL ZLACPY( 'U', N, N, A, LDA, V, LDV ) - DO 3053 p = 1, N - TEMP1 = SVA(IWORK(p)) - CALL ZDSCAL( p, ONE/TEMP1, V(1,p), 1 ) - 3053 CONTINUE - IF ( LSVEC )THEN - CALL ZPOCON( 'U', N, V, LDV, ONE, TEMP1, - $ CWORK(N+1), RWORK, IERR ) - ELSE - CALL ZPOCON( 'U', N, V, LDV, ONE, TEMP1, - $ CWORK, RWORK, IERR ) - END IF -* - ELSE IF ( LSVEC ) THEN -* .. U is available as workspace - CALL ZLACPY( 'U', N, N, A, LDA, U, LDU ) - DO 3054 p = 1, N - TEMP1 = SVA(IWORK(p)) - CALL ZDSCAL( p, ONE/TEMP1, U(1,p), 1 ) - 3054 CONTINUE - CALL ZPOCON( 'U', N, U, LDU, ONE, TEMP1, - $ CWORK(N+1), RWORK, IERR ) - ELSE - CALL ZLACPY( 'U', N, N, A, LDA, CWORK, N ) -*[] CALL ZLACPY( 'U', N, N, A, LDA, CWORK(N+1), N ) -* Change: here index shifted by N to the left, CWORK(1:N) -* not needed for SIGMA only computation - DO 3052 p = 1, N - TEMP1 = SVA(IWORK(p)) -*[] CALL ZDSCAL( p, ONE/TEMP1, CWORK(N+(p-1)*N+1), 1 ) - CALL ZDSCAL( p, ONE/TEMP1, CWORK((p-1)*N+1), 1 ) - 3052 CONTINUE -* .. the columns of R are scaled to have unit Euclidean lengths. -*[] CALL ZPOCON( 'U', N, CWORK(N+1), N, ONE, TEMP1, -*[] $ CWORK(N+N*N+1), RWORK, IERR ) - CALL ZPOCON( 'U', N, CWORK, N, ONE, TEMP1, - $ CWORK(N*N+1), RWORK, IERR ) -* - END IF - IF ( TEMP1 .NE. ZERO ) THEN - SCONDA = ONE / SQRT(TEMP1) - ELSE - SCONDA = - ONE - END IF -* SCONDA is an estimate of SQRT(||(R^* * R)^(-1)||_1). -* N^(-1/4) * SCONDA <= ||R^(-1)||_2 <= N^(1/4) * SCONDA - ELSE - SCONDA = - ONE - END IF - END IF -* - L2PERT = L2PERT .AND. ( ABS( A(1,1)/A(NR,NR) ) .GT. SQRT(BIG1) ) -* If there is no violent scaling, artificial perturbation is not needed. -* -* Phase 3: -* - IF ( .NOT. ( RSVEC .OR. LSVEC ) ) THEN -* -* Singular Values only -* -* .. transpose A(1:NR,1:N) - DO 1946 p = 1, MIN( N-1, NR ) - CALL ZCOPY( N-p, A(p,p+1), LDA, A(p+1,p), 1 ) - CALL ZLACGV( N-p+1, A(p,p), 1 ) - 1946 CONTINUE - IF ( NR .EQ. N ) A(N,N) = CONJG(A(N,N)) -* -* The following two DO-loops introduce small relative perturbation -* into the strict upper triangle of the lower triangular matrix. -* Small entries below the main diagonal are also changed. -* This modification is useful if the computing environment does not -* provide/allow FLUSH TO ZERO underflow, for it prevents many -* annoying denormalized numbers in case of strongly scaled matrices. -* The perturbation is structured so that it does not introduce any -* new perturbation of the singular values, and it does not destroy -* the job done by the preconditioner. -* The licence for this perturbation is in the variable L2PERT, which -* should be .FALSE. if FLUSH TO ZERO underflow is active. -* - IF ( .NOT. ALMORT ) THEN -* - IF ( L2PERT ) THEN -* XSC = SQRT(SMALL) - XSC = EPSLN / DBLE(N) - DO 4947 q = 1, NR - CTEMP = DCMPLX(XSC*ABS(A(q,q)),ZERO) - DO 4949 p = 1, N - IF ( ( (p.GT.q) .AND. (ABS(A(p,q)).LE.TEMP1) ) - $ .OR. ( p .LT. q ) ) -* $ A(p,q) = TEMP1 * ( A(p,q) / ABS(A(p,q)) ) - $ A(p,q) = CTEMP - 4949 CONTINUE - 4947 CONTINUE - ELSE - CALL ZLASET( 'U', NR-1,NR-1, CZERO,CZERO, A(1,2),LDA ) - END IF -* -* .. second preconditioning using the QR factorization -* - CALL ZGEQRF( N,NR, A,LDA, CWORK, CWORK(N+1),LWORK-N, IERR ) -* -* .. and transpose upper to lower triangular - DO 1948 p = 1, NR - 1 - CALL ZCOPY( NR-p, A(p,p+1), LDA, A(p+1,p), 1 ) - CALL ZLACGV( NR-p+1, A(p,p), 1 ) - 1948 CONTINUE -* - END IF -* -* Row-cyclic Jacobi SVD algorithm with column pivoting -* -* .. again some perturbation (a "background noise") is added -* to drown denormals - IF ( L2PERT ) THEN -* XSC = SQRT(SMALL) - XSC = EPSLN / DBLE(N) - DO 1947 q = 1, NR - CTEMP = DCMPLX(XSC*ABS(A(q,q)),ZERO) - DO 1949 p = 1, NR - IF ( ( (p.GT.q) .AND. (ABS(A(p,q)).LE.TEMP1) ) - $ .OR. ( p .LT. q ) ) -* $ A(p,q) = TEMP1 * ( A(p,q) / ABS(A(p,q)) ) - $ A(p,q) = CTEMP - 1949 CONTINUE - 1947 CONTINUE - ELSE - CALL ZLASET( 'U', NR-1, NR-1, CZERO, CZERO, A(1,2), LDA ) - END IF -* -* .. and one-sided Jacobi rotations are started on a lower -* triangular matrix (plus perturbation which is ignored in -* the part which destroys triangular form (confusing?!)) -* - CALL ZGESVJ( 'L', 'N', 'N', NR, NR, A, LDA, SVA, - $ N, V, LDV, CWORK, LWORK, RWORK, LRWORK, INFO ) -* - SCALEM = RWORK(1) - NUMRANK = NINT(RWORK(2)) -* -* - ELSE IF ( ( RSVEC .AND. ( .NOT. LSVEC ) .AND. ( .NOT. JRACC ) ) - $ .OR. - $ ( JRACC .AND. ( .NOT. LSVEC ) .AND. ( NR .NE. N ) ) ) THEN -* -* -> Singular Values and Right Singular Vectors <- -* - IF ( ALMORT ) THEN -* -* .. in this case NR equals N - DO 1998 p = 1, NR - CALL ZCOPY( N-p+1, A(p,p), LDA, V(p,p), 1 ) - CALL ZLACGV( N-p+1, V(p,p), 1 ) - 1998 CONTINUE - CALL ZLASET( 'U', NR-1,NR-1, CZERO, CZERO, V(1,2), LDV ) -* - CALL ZGESVJ( 'L','U','N', N, NR, V, LDV, SVA, NR, A, LDA, - $ CWORK, LWORK, RWORK, LRWORK, INFO ) - SCALEM = RWORK(1) - NUMRANK = NINT(RWORK(2)) - - ELSE -* -* .. two more QR factorizations ( one QRF is not enough, two require -* accumulated product of Jacobi rotations, three are perfect ) -* - CALL ZLASET( 'L', NR-1,NR-1, CZERO, CZERO, A(2,1), LDA ) - CALL ZGELQF( NR,N, A, LDA, CWORK, CWORK(N+1), LWORK-N, IERR) - CALL ZLACPY( 'L', NR, NR, A, LDA, V, LDV ) - CALL ZLASET( 'U', NR-1,NR-1, CZERO, CZERO, V(1,2), LDV ) - CALL ZGEQRF( NR, NR, V, LDV, CWORK(N+1), CWORK(2*N+1), - $ LWORK-2*N, IERR ) - DO 8998 p = 1, NR - CALL ZCOPY( NR-p+1, V(p,p), LDV, V(p,p), 1 ) - CALL ZLACGV( NR-p+1, V(p,p), 1 ) - 8998 CONTINUE - CALL ZLASET('U', NR-1, NR-1, CZERO, CZERO, V(1,2), LDV) -* - CALL ZGESVJ( 'L', 'U','N', NR, NR, V,LDV, SVA, NR, U, - $ LDU, CWORK(N+1), LWORK-N, RWORK, LRWORK, INFO ) - SCALEM = RWORK(1) - NUMRANK = NINT(RWORK(2)) - IF ( NR .LT. N ) THEN - CALL ZLASET( 'A',N-NR, NR, CZERO,CZERO, V(NR+1,1), LDV ) - CALL ZLASET( 'A',NR, N-NR, CZERO,CZERO, V(1,NR+1), LDV ) - CALL ZLASET( 'A',N-NR,N-NR,CZERO,CONE, V(NR+1,NR+1),LDV ) - END IF -* - CALL ZUNMLQ( 'L', 'C', N, N, NR, A, LDA, CWORK, - $ V, LDV, CWORK(N+1), LWORK-N, IERR ) -* - END IF -* .. permute the rows of V -* DO 8991 p = 1, N -* CALL ZCOPY( N, V(p,1), LDV, A(IWORK(p),1), LDA ) -* 8991 CONTINUE -* CALL ZLACPY( 'All', N, N, A, LDA, V, LDV ) - CALL ZLAPMR( .FALSE., N, N, V, LDV, IWORK ) -* - IF ( TRANSP ) THEN - CALL ZLACPY( 'A', N, N, V, LDV, U, LDU ) - END IF -* - ELSE IF ( JRACC .AND. (.NOT. LSVEC) .AND. ( NR.EQ. N ) ) THEN -* - CALL ZLASET( 'L', N-1,N-1, CZERO, CZERO, A(2,1), LDA ) -* - CALL ZGESVJ( 'U','N','V', N, N, A, LDA, SVA, N, V, LDV, - $ CWORK, LWORK, RWORK, LRWORK, INFO ) - SCALEM = RWORK(1) - NUMRANK = NINT(RWORK(2)) - CALL ZLAPMR( .FALSE., N, N, V, LDV, IWORK ) -* - ELSE IF ( LSVEC .AND. ( .NOT. RSVEC ) ) THEN -* -* .. Singular Values and Left Singular Vectors .. -* -* .. second preconditioning step to avoid need to accumulate -* Jacobi rotations in the Jacobi iterations. - DO 1965 p = 1, NR - CALL ZCOPY( N-p+1, A(p,p), LDA, U(p,p), 1 ) - CALL ZLACGV( N-p+1, U(p,p), 1 ) - 1965 CONTINUE - CALL ZLASET( 'U', NR-1, NR-1, CZERO, CZERO, U(1,2), LDU ) -* - CALL ZGEQRF( N, NR, U, LDU, CWORK(N+1), CWORK(2*N+1), - $ LWORK-2*N, IERR ) -* - DO 1967 p = 1, NR - 1 - CALL ZCOPY( NR-p, U(p,p+1), LDU, U(p+1,p), 1 ) - CALL ZLACGV( N-p+1, U(p,p), 1 ) - 1967 CONTINUE - CALL ZLASET( 'U', NR-1, NR-1, CZERO, CZERO, U(1,2), LDU ) -* - CALL ZGESVJ( 'L', 'U', 'N', NR,NR, U, LDU, SVA, NR, A, - $ LDA, CWORK(N+1), LWORK-N, RWORK, LRWORK, INFO ) - SCALEM = RWORK(1) - NUMRANK = NINT(RWORK(2)) -* - IF ( NR .LT. M ) THEN - CALL ZLASET( 'A', M-NR, NR,CZERO, CZERO, U(NR+1,1), LDU ) - IF ( NR .LT. N1 ) THEN - CALL ZLASET( 'A',NR, N1-NR, CZERO, CZERO, U(1,NR+1),LDU ) - CALL ZLASET( 'A',M-NR,N1-NR,CZERO,CONE,U(NR+1,NR+1),LDU ) - END IF - END IF -* - CALL ZUNMQR( 'L', 'N', M, N1, N, A, LDA, CWORK, U, - $ LDU, CWORK(N+1), LWORK-N, IERR ) -* - IF ( ROWPIV ) - $ CALL ZLASWP( N1, U, LDU, 1, M-1, IWORK(IWOFF+1), -1 ) -* - DO 1974 p = 1, N1 - XSC = ONE / DZNRM2( M, U(1,p), 1 ) - CALL ZDSCAL( M, XSC, U(1,p), 1 ) - 1974 CONTINUE -* - IF ( TRANSP ) THEN - CALL ZLACPY( 'A', N, N, U, LDU, V, LDV ) - END IF -* - ELSE -* -* .. Full SVD .. -* - IF ( .NOT. JRACC ) THEN -* - IF ( .NOT. ALMORT ) THEN -* -* Second Preconditioning Step (QRF [with pivoting]) -* Note that the composition of TRANSPOSE, QRF and TRANSPOSE is -* equivalent to an LQF CALL. Since in many libraries the QRF -* seems to be better optimized than the LQF, we do explicit -* transpose and use the QRF. This is subject to changes in an -* optimized implementation of ZGEJSV. -* - DO 1968 p = 1, NR - CALL ZCOPY( N-p+1, A(p,p), LDA, V(p,p), 1 ) - CALL ZLACGV( N-p+1, V(p,p), 1 ) - 1968 CONTINUE -* -* .. the following two loops perturb small entries to avoid -* denormals in the second QR factorization, where they are -* as good as zeros. This is done to avoid painfully slow -* computation with denormals. The relative size of the perturbation -* is a parameter that can be changed by the implementer. -* This perturbation device will be obsolete on machines with -* properly implemented arithmetic. -* To switch it off, set L2PERT=.FALSE. To remove it from the -* code, remove the action under L2PERT=.TRUE., leave the ELSE part. -* The following two loops should be blocked and fused with the -* transposed copy above. -* - IF ( L2PERT ) THEN - XSC = SQRT(SMALL) - DO 2969 q = 1, NR - CTEMP = DCMPLX(XSC*ABS( V(q,q) ),ZERO) - DO 2968 p = 1, N - IF ( ( p .GT. q ) .AND. ( ABS(V(p,q)) .LE. TEMP1 ) - $ .OR. ( p .LT. q ) ) -* $ V(p,q) = TEMP1 * ( V(p,q) / ABS(V(p,q)) ) - $ V(p,q) = CTEMP - IF ( p .LT. q ) V(p,q) = - V(p,q) - 2968 CONTINUE - 2969 CONTINUE - ELSE - CALL ZLASET( 'U', NR-1, NR-1, CZERO, CZERO, V(1,2), LDV ) - END IF -* -* Estimate the row scaled condition number of R1 -* (If R1 is rectangular, N > NR, then the condition number -* of the leading NR x NR submatrix is estimated.) -* - CALL ZLACPY( 'L', NR, NR, V, LDV, CWORK(2*N+1), NR ) - DO 3950 p = 1, NR - TEMP1 = DZNRM2(NR-p+1,CWORK(2*N+(p-1)*NR+p),1) - CALL ZDSCAL(NR-p+1,ONE/TEMP1,CWORK(2*N+(p-1)*NR+p),1) - 3950 CONTINUE - CALL ZPOCON('L',NR,CWORK(2*N+1),NR,ONE,TEMP1, - $ CWORK(2*N+NR*NR+1),RWORK,IERR) - CONDR1 = ONE / SQRT(TEMP1) -* .. here need a second opinion on the condition number -* .. then assume worst case scenario -* R1 is OK for inverse <=> CONDR1 .LT. DBLE(N) -* more conservative <=> CONDR1 .LT. SQRT(DBLE(N)) -* - COND_OK = SQRT(SQRT(DBLE(NR))) -*[TP] COND_OK is a tuning parameter. -* - IF ( CONDR1 .LT. COND_OK ) THEN -* .. the second QRF without pivoting. Note: in an optimized -* implementation, this QRF should be implemented as the QRF -* of a lower triangular matrix. -* R1^* = Q2 * R2 - CALL ZGEQRF( N, NR, V, LDV, CWORK(N+1), CWORK(2*N+1), - $ LWORK-2*N, IERR ) -* - IF ( L2PERT ) THEN - XSC = SQRT(SMALL)/EPSLN - DO 3959 p = 2, NR - DO 3958 q = 1, p - 1 - CTEMP=DCMPLX(XSC*MIN(ABS(V(p,p)),ABS(V(q,q))), - $ ZERO) - IF ( ABS(V(q,p)) .LE. TEMP1 ) -* $ V(q,p) = TEMP1 * ( V(q,p) / ABS(V(q,p)) ) - $ V(q,p) = CTEMP - 3958 CONTINUE - 3959 CONTINUE - END IF -* - IF ( NR .NE. N ) - $ CALL ZLACPY( 'A', N, NR, V, LDV, CWORK(2*N+1), N ) -* .. save ... -* -* .. this transposed copy should be better than naive - DO 1969 p = 1, NR - 1 - CALL ZCOPY( NR-p, V(p,p+1), LDV, V(p+1,p), 1 ) - CALL ZLACGV(NR-p+1, V(p,p), 1 ) - 1969 CONTINUE - V(NR,NR)=CONJG(V(NR,NR)) -* - CONDR2 = CONDR1 -* - ELSE -* -* .. ill-conditioned case: second QRF with pivoting -* Note that windowed pivoting would be equally good -* numerically, and more run-time efficient. So, in -* an optimal implementation, the next call to ZGEQP3 -* should be replaced with eg. CALL ZGEQPX (ACM TOMS #782) -* with properly (carefully) chosen parameters. -* -* R1^* * P2 = Q2 * R2 - DO 3003 p = 1, NR - IWORK(N+p) = 0 - 3003 CONTINUE - CALL ZGEQP3( N, NR, V, LDV, IWORK(N+1), CWORK(N+1), - $ CWORK(2*N+1), LWORK-2*N, RWORK, IERR ) -** CALL ZGEQRF( N, NR, V, LDV, CWORK(N+1), CWORK(2*N+1), -** $ LWORK-2*N, IERR ) - IF ( L2PERT ) THEN - XSC = SQRT(SMALL) - DO 3969 p = 2, NR - DO 3968 q = 1, p - 1 - CTEMP=DCMPLX(XSC*MIN(ABS(V(p,p)),ABS(V(q,q))), - $ ZERO) - IF ( ABS(V(q,p)) .LE. TEMP1 ) -* $ V(q,p) = TEMP1 * ( V(q,p) / ABS(V(q,p)) ) - $ V(q,p) = CTEMP - 3968 CONTINUE - 3969 CONTINUE - END IF -* - CALL ZLACPY( 'A', N, NR, V, LDV, CWORK(2*N+1), N ) -* - IF ( L2PERT ) THEN - XSC = SQRT(SMALL) - DO 8970 p = 2, NR - DO 8971 q = 1, p - 1 - CTEMP=DCMPLX(XSC*MIN(ABS(V(p,p)),ABS(V(q,q))), - $ ZERO) -* V(p,q) = - TEMP1*( V(q,p) / ABS(V(q,p)) ) - V(p,q) = - CTEMP - 8971 CONTINUE - 8970 CONTINUE - ELSE - CALL ZLASET( 'L',NR-1,NR-1,CZERO,CZERO,V(2,1),LDV ) - END IF -* Now, compute R2 = L3 * Q3, the LQ factorization. - CALL ZGELQF( NR, NR, V, LDV, CWORK(2*N+N*NR+1), - $ CWORK(2*N+N*NR+NR+1), LWORK-2*N-N*NR-NR, IERR ) -* .. and estimate the condition number - CALL ZLACPY( 'L',NR,NR,V,LDV,CWORK(2*N+N*NR+NR+1),NR ) - DO 4950 p = 1, NR - TEMP1 = DZNRM2( p, CWORK(2*N+N*NR+NR+p), NR ) - CALL ZDSCAL( p, ONE/TEMP1, CWORK(2*N+N*NR+NR+p), NR ) - 4950 CONTINUE - CALL ZPOCON( 'L',NR,CWORK(2*N+N*NR+NR+1),NR,ONE,TEMP1, - $ CWORK(2*N+N*NR+NR+NR*NR+1),RWORK,IERR ) - CONDR2 = ONE / SQRT(TEMP1) -* -* - IF ( CONDR2 .GE. COND_OK ) THEN -* .. save the Householder vectors used for Q3 -* (this overwrites the copy of R2, as it will not be -* needed in this branch, but it does not overwritte the -* Huseholder vectors of Q2.). - CALL ZLACPY( 'U', NR, NR, V, LDV, CWORK(2*N+1), N ) -* .. and the rest of the information on Q3 is in -* WORK(2*N+N*NR+1:2*N+N*NR+N) - END IF -* - END IF -* - IF ( L2PERT ) THEN - XSC = SQRT(SMALL) - DO 4968 q = 2, NR - CTEMP = XSC * V(q,q) - DO 4969 p = 1, q - 1 -* V(p,q) = - TEMP1*( V(p,q) / ABS(V(p,q)) ) - V(p,q) = - CTEMP - 4969 CONTINUE - 4968 CONTINUE - ELSE - CALL ZLASET( 'U', NR-1,NR-1, CZERO,CZERO, V(1,2), LDV ) - END IF -* -* Second preconditioning finished; continue with Jacobi SVD -* The input matrix is lower trinagular. -* -* Recover the right singular vectors as solution of a well -* conditioned triangular matrix equation. -* - IF ( CONDR1 .LT. COND_OK ) THEN -* - CALL ZGESVJ( 'L','U','N',NR,NR,V,LDV,SVA,NR,U, LDU, - $ CWORK(2*N+N*NR+NR+1),LWORK-2*N-N*NR-NR,RWORK, - $ LRWORK, INFO ) - SCALEM = RWORK(1) - NUMRANK = NINT(RWORK(2)) - DO 3970 p = 1, NR - CALL ZCOPY( NR, V(1,p), 1, U(1,p), 1 ) - CALL ZDSCAL( NR, SVA(p), V(1,p), 1 ) - 3970 CONTINUE - -* .. pick the right matrix equation and solve it -* - IF ( NR .EQ. N ) THEN -* :)) .. best case, R1 is inverted. The solution of this matrix -* equation is Q2*V2 = the product of the Jacobi rotations -* used in ZGESVJ, premultiplied with the orthogonal matrix -* from the second QR factorization. - CALL ZTRSM('L','U','N','N', NR,NR,CONE, A,LDA, V,LDV) - ELSE -* .. R1 is well conditioned, but non-square. Adjoint of R2 -* is inverted to get the product of the Jacobi rotations -* used in ZGESVJ. The Q-factor from the second QR -* factorization is then built in explicitly. - CALL ZTRSM('L','U','C','N',NR,NR,CONE,CWORK(2*N+1), - $ N,V,LDV) - IF ( NR .LT. N ) THEN - CALL ZLASET('A',N-NR,NR,CZERO,CZERO,V(NR+1,1),LDV) - CALL ZLASET('A',NR,N-NR,CZERO,CZERO,V(1,NR+1),LDV) - CALL ZLASET('A',N-NR,N-NR,CZERO,CONE,V(NR+1,NR+1),LDV) - END IF - CALL ZUNMQR('L','N',N,N,NR,CWORK(2*N+1),N,CWORK(N+1), - $ V,LDV,CWORK(2*N+N*NR+NR+1),LWORK-2*N-N*NR-NR,IERR) - END IF -* - ELSE IF ( CONDR2 .LT. COND_OK ) THEN -* -* The matrix R2 is inverted. The solution of the matrix equation -* is Q3^* * V3 = the product of the Jacobi rotations (appplied to -* the lower triangular L3 from the LQ factorization of -* R2=L3*Q3), pre-multiplied with the transposed Q3. - CALL ZGESVJ( 'L', 'U', 'N', NR, NR, V, LDV, SVA, NR, U, - $ LDU, CWORK(2*N+N*NR+NR+1), LWORK-2*N-N*NR-NR, - $ RWORK, LRWORK, INFO ) - SCALEM = RWORK(1) - NUMRANK = NINT(RWORK(2)) - DO 3870 p = 1, NR - CALL ZCOPY( NR, V(1,p), 1, U(1,p), 1 ) - CALL ZDSCAL( NR, SVA(p), U(1,p), 1 ) - 3870 CONTINUE - CALL ZTRSM('L','U','N','N',NR,NR,CONE,CWORK(2*N+1),N, - $ U,LDU) -* .. apply the permutation from the second QR factorization - DO 873 q = 1, NR - DO 872 p = 1, NR - CWORK(2*N+N*NR+NR+IWORK(N+p)) = U(p,q) - 872 CONTINUE - DO 874 p = 1, NR - U(p,q) = CWORK(2*N+N*NR+NR+p) - 874 CONTINUE - 873 CONTINUE - IF ( NR .LT. N ) THEN - CALL ZLASET( 'A',N-NR,NR,CZERO,CZERO,V(NR+1,1),LDV ) - CALL ZLASET( 'A',NR,N-NR,CZERO,CZERO,V(1,NR+1),LDV ) - CALL ZLASET('A',N-NR,N-NR,CZERO,CONE,V(NR+1,NR+1),LDV) - END IF - CALL ZUNMQR( 'L','N',N,N,NR,CWORK(2*N+1),N,CWORK(N+1), - $ V,LDV,CWORK(2*N+N*NR+NR+1),LWORK-2*N-N*NR-NR,IERR ) - ELSE -* Last line of defense. -* #:( This is a rather pathological case: no scaled condition -* improvement after two pivoted QR factorizations. Other -* possibility is that the rank revealing QR factorization -* or the condition estimator has failed, or the COND_OK -* is set very close to ONE (which is unnecessary). Normally, -* this branch should never be executed, but in rare cases of -* failure of the RRQR or condition estimator, the last line of -* defense ensures that ZGEJSV completes the task. -* Compute the full SVD of L3 using ZGESVJ with explicit -* accumulation of Jacobi rotations. - CALL ZGESVJ( 'L', 'U', 'V', NR, NR, V, LDV, SVA, NR, U, - $ LDU, CWORK(2*N+N*NR+NR+1), LWORK-2*N-N*NR-NR, - $ RWORK, LRWORK, INFO ) - SCALEM = RWORK(1) - NUMRANK = NINT(RWORK(2)) - IF ( NR .LT. N ) THEN - CALL ZLASET( 'A',N-NR,NR,CZERO,CZERO,V(NR+1,1),LDV ) - CALL ZLASET( 'A',NR,N-NR,CZERO,CZERO,V(1,NR+1),LDV ) - CALL ZLASET('A',N-NR,N-NR,CZERO,CONE,V(NR+1,NR+1),LDV) - END IF - CALL ZUNMQR( 'L','N',N,N,NR,CWORK(2*N+1),N,CWORK(N+1), - $ V,LDV,CWORK(2*N+N*NR+NR+1),LWORK-2*N-N*NR-NR,IERR ) -* - CALL ZUNMLQ( 'L', 'C', NR, NR, NR, CWORK(2*N+1), N, - $ CWORK(2*N+N*NR+1), U, LDU, CWORK(2*N+N*NR+NR+1), - $ LWORK-2*N-N*NR-NR, IERR ) - DO 773 q = 1, NR - DO 772 p = 1, NR - CWORK(2*N+N*NR+NR+IWORK(N+p)) = U(p,q) - 772 CONTINUE - DO 774 p = 1, NR - U(p,q) = CWORK(2*N+N*NR+NR+p) - 774 CONTINUE - 773 CONTINUE -* - END IF -* -* Permute the rows of V using the (column) permutation from the -* first QRF. Also, scale the columns to make them unit in -* Euclidean norm. This applies to all cases. -* - TEMP1 = SQRT(DBLE(N)) * EPSLN - DO 1972 q = 1, N - DO 972 p = 1, N - CWORK(2*N+N*NR+NR+IWORK(p)) = V(p,q) - 972 CONTINUE - DO 973 p = 1, N - V(p,q) = CWORK(2*N+N*NR+NR+p) - 973 CONTINUE - XSC = ONE / DZNRM2( N, V(1,q), 1 ) - IF ( (XSC .LT. (ONE-TEMP1)) .OR. (XSC .GT. (ONE+TEMP1)) ) - $ CALL ZDSCAL( N, XSC, V(1,q), 1 ) - 1972 CONTINUE -* At this moment, V contains the right singular vectors of A. -* Next, assemble the left singular vector matrix U (M x N). - IF ( NR .LT. M ) THEN - CALL ZLASET('A', M-NR, NR, CZERO, CZERO, U(NR+1,1), LDU) - IF ( NR .LT. N1 ) THEN - CALL ZLASET('A',NR,N1-NR,CZERO,CZERO,U(1,NR+1),LDU) - CALL ZLASET('A',M-NR,N1-NR,CZERO,CONE, - $ U(NR+1,NR+1),LDU) - END IF - END IF -* -* The Q matrix from the first QRF is built into the left singular -* matrix U. This applies to all cases. -* - CALL ZUNMQR( 'L', 'N', M, N1, N, A, LDA, CWORK, U, - $ LDU, CWORK(N+1), LWORK-N, IERR ) - -* The columns of U are normalized. The cost is O(M*N) flops. - TEMP1 = SQRT(DBLE(M)) * EPSLN - DO 1973 p = 1, NR - XSC = ONE / DZNRM2( M, U(1,p), 1 ) - IF ( (XSC .LT. (ONE-TEMP1)) .OR. (XSC .GT. (ONE+TEMP1)) ) - $ CALL ZDSCAL( M, XSC, U(1,p), 1 ) - 1973 CONTINUE -* -* If the initial QRF is computed with row pivoting, the left -* singular vectors must be adjusted. -* - IF ( ROWPIV ) - $ CALL ZLASWP( N1, U, LDU, 1, M-1, IWORK(IWOFF+1), -1 ) -* - ELSE -* -* .. the initial matrix A has almost orthogonal columns and -* the second QRF is not needed -* - CALL ZLACPY( 'U', N, N, A, LDA, CWORK(N+1), N ) - IF ( L2PERT ) THEN - XSC = SQRT(SMALL) - DO 5970 p = 2, N - CTEMP = XSC * CWORK( N + (p-1)*N + p ) - DO 5971 q = 1, p - 1 -* CWORK(N+(q-1)*N+p)=-TEMP1 * ( CWORK(N+(p-1)*N+q) / -* $ ABS(CWORK(N+(p-1)*N+q)) ) - CWORK(N+(q-1)*N+p)=-CTEMP - 5971 CONTINUE - 5970 CONTINUE - ELSE - CALL ZLASET( 'L',N-1,N-1,CZERO,CZERO,CWORK(N+2),N ) - END IF -* - CALL ZGESVJ( 'U', 'U', 'N', N, N, CWORK(N+1), N, SVA, - $ N, U, LDU, CWORK(N+N*N+1), LWORK-N-N*N, RWORK, LRWORK, - $ INFO ) -* - SCALEM = RWORK(1) - NUMRANK = NINT(RWORK(2)) - DO 6970 p = 1, N - CALL ZCOPY( N, CWORK(N+(p-1)*N+1), 1, U(1,p), 1 ) - CALL ZDSCAL( N, SVA(p), CWORK(N+(p-1)*N+1), 1 ) - 6970 CONTINUE -* - CALL ZTRSM( 'L', 'U', 'N', 'N', N, N, - $ CONE, A, LDA, CWORK(N+1), N ) - DO 6972 p = 1, N - CALL ZCOPY( N, CWORK(N+p), N, V(IWORK(p),1), LDV ) - 6972 CONTINUE - TEMP1 = SQRT(DBLE(N))*EPSLN - DO 6971 p = 1, N - XSC = ONE / DZNRM2( N, V(1,p), 1 ) - IF ( (XSC .LT. (ONE-TEMP1)) .OR. (XSC .GT. (ONE+TEMP1)) ) - $ CALL ZDSCAL( N, XSC, V(1,p), 1 ) - 6971 CONTINUE -* -* Assemble the left singular vector matrix U (M x N). -* - IF ( N .LT. M ) THEN - CALL ZLASET( 'A', M-N, N, CZERO, CZERO, U(N+1,1), LDU ) - IF ( N .LT. N1 ) THEN - CALL ZLASET('A',N, N1-N, CZERO, CZERO, U(1,N+1),LDU) - CALL ZLASET( 'A',M-N,N1-N, CZERO, CONE,U(N+1,N+1),LDU) - END IF - END IF - CALL ZUNMQR( 'L', 'N', M, N1, N, A, LDA, CWORK, U, - $ LDU, CWORK(N+1), LWORK-N, IERR ) - TEMP1 = SQRT(DBLE(M))*EPSLN - DO 6973 p = 1, N1 - XSC = ONE / DZNRM2( M, U(1,p), 1 ) - IF ( (XSC .LT. (ONE-TEMP1)) .OR. (XSC .GT. (ONE+TEMP1)) ) - $ CALL ZDSCAL( M, XSC, U(1,p), 1 ) - 6973 CONTINUE -* - IF ( ROWPIV ) - $ CALL ZLASWP( N1, U, LDU, 1, M-1, IWORK(IWOFF+1), -1 ) -* - END IF -* -* end of the >> almost orthogonal case << in the full SVD -* - ELSE -* -* This branch deploys a preconditioned Jacobi SVD with explicitly -* accumulated rotations. It is included as optional, mainly for -* experimental purposes. It does perform well, and can also be used. -* In this implementation, this branch will be automatically activated -* if the condition number sigma_max(A) / sigma_min(A) is predicted -* to be greater than the overflow threshold. This is because the -* a posteriori computation of the singular vectors assumes robust -* implementation of BLAS and some LAPACK procedures, capable of working -* in presence of extreme values, e.g. when the singular values spread from -* the underflow to the overflow threshold. -* - DO 7968 p = 1, NR - CALL ZCOPY( N-p+1, A(p,p), LDA, V(p,p), 1 ) - CALL ZLACGV( N-p+1, V(p,p), 1 ) - 7968 CONTINUE -* - IF ( L2PERT ) THEN - XSC = SQRT(SMALL/EPSLN) - DO 5969 q = 1, NR - CTEMP = DCMPLX(XSC*ABS( V(q,q) ),ZERO) - DO 5968 p = 1, N - IF ( ( p .GT. q ) .AND. ( ABS(V(p,q)) .LE. TEMP1 ) - $ .OR. ( p .LT. q ) ) -* $ V(p,q) = TEMP1 * ( V(p,q) / ABS(V(p,q)) ) - $ V(p,q) = CTEMP - IF ( p .LT. q ) V(p,q) = - V(p,q) - 5968 CONTINUE - 5969 CONTINUE - ELSE - CALL ZLASET( 'U', NR-1, NR-1, CZERO, CZERO, V(1,2), LDV ) - END IF - - CALL ZGEQRF( N, NR, V, LDV, CWORK(N+1), CWORK(2*N+1), - $ LWORK-2*N, IERR ) - CALL ZLACPY( 'L', N, NR, V, LDV, CWORK(2*N+1), N ) -* - DO 7969 p = 1, NR - CALL ZCOPY( NR-p+1, V(p,p), LDV, U(p,p), 1 ) - CALL ZLACGV( NR-p+1, U(p,p), 1 ) - 7969 CONTINUE - - IF ( L2PERT ) THEN - XSC = SQRT(SMALL/EPSLN) - DO 9970 q = 2, NR - DO 9971 p = 1, q - 1 - CTEMP = DCMPLX(XSC * MIN(ABS(U(p,p)),ABS(U(q,q))), - $ ZERO) -* U(p,q) = - TEMP1 * ( U(q,p) / ABS(U(q,p)) ) - U(p,q) = - CTEMP - 9971 CONTINUE - 9970 CONTINUE - ELSE - CALL ZLASET('U', NR-1, NR-1, CZERO, CZERO, U(1,2), LDU ) - END IF - - CALL ZGESVJ( 'L', 'U', 'V', NR, NR, U, LDU, SVA, - $ N, V, LDV, CWORK(2*N+N*NR+1), LWORK-2*N-N*NR, - $ RWORK, LRWORK, INFO ) - SCALEM = RWORK(1) - NUMRANK = NINT(RWORK(2)) - - IF ( NR .LT. N ) THEN - CALL ZLASET( 'A',N-NR,NR,CZERO,CZERO,V(NR+1,1),LDV ) - CALL ZLASET( 'A',NR,N-NR,CZERO,CZERO,V(1,NR+1),LDV ) - CALL ZLASET( 'A',N-NR,N-NR,CZERO,CONE,V(NR+1,NR+1),LDV ) - END IF - - CALL ZUNMQR( 'L','N',N,N,NR,CWORK(2*N+1),N,CWORK(N+1), - $ V,LDV,CWORK(2*N+N*NR+NR+1),LWORK-2*N-N*NR-NR,IERR ) -* -* Permute the rows of V using the (column) permutation from the -* first QRF. Also, scale the columns to make them unit in -* Euclidean norm. This applies to all cases. -* - TEMP1 = SQRT(DBLE(N)) * EPSLN - DO 7972 q = 1, N - DO 8972 p = 1, N - CWORK(2*N+N*NR+NR+IWORK(p)) = V(p,q) - 8972 CONTINUE - DO 8973 p = 1, N - V(p,q) = CWORK(2*N+N*NR+NR+p) - 8973 CONTINUE - XSC = ONE / DZNRM2( N, V(1,q), 1 ) - IF ( (XSC .LT. (ONE-TEMP1)) .OR. (XSC .GT. (ONE+TEMP1)) ) - $ CALL ZDSCAL( N, XSC, V(1,q), 1 ) - 7972 CONTINUE -* -* At this moment, V contains the right singular vectors of A. -* Next, assemble the left singular vector matrix U (M x N). -* - IF ( NR .LT. M ) THEN - CALL ZLASET( 'A', M-NR, NR, CZERO, CZERO, U(NR+1,1), LDU ) - IF ( NR .LT. N1 ) THEN - CALL ZLASET('A',NR, N1-NR, CZERO, CZERO, U(1,NR+1),LDU) - CALL ZLASET('A',M-NR,N1-NR, CZERO, CONE,U(NR+1,NR+1),LDU) - END IF - END IF -* - CALL ZUNMQR( 'L', 'N', M, N1, N, A, LDA, CWORK, U, - $ LDU, CWORK(N+1), LWORK-N, IERR ) -* - IF ( ROWPIV ) - $ CALL ZLASWP( N1, U, LDU, 1, M-1, IWORK(IWOFF+1), -1 ) -* -* - END IF - IF ( TRANSP ) THEN -* .. swap U and V because the procedure worked on A^* - DO 6974 p = 1, N - CALL ZSWAP( N, U(1,p), 1, V(1,p), 1 ) - 6974 CONTINUE - END IF -* - END IF -* end of the full SVD -* -* Undo scaling, if necessary (and possible) -* - IF ( USCAL2 .LE. (BIG/SVA(1))*USCAL1 ) THEN - CALL DLASCL( 'G', 0, 0, USCAL1, USCAL2, NR, 1, SVA, N, IERR ) - USCAL1 = ONE - USCAL2 = ONE - END IF -* - IF ( NR .LT. N ) THEN - DO 3004 p = NR+1, N - SVA(p) = ZERO - 3004 CONTINUE - END IF -* - RWORK(1) = USCAL2 * SCALEM - RWORK(2) = USCAL1 - IF ( ERREST ) RWORK(3) = SCONDA - IF ( LSVEC .AND. RSVEC ) THEN - RWORK(4) = CONDR1 - RWORK(5) = CONDR2 - END IF - IF ( L2TRAN ) THEN - RWORK(6) = ENTRA - RWORK(7) = ENTRAT - END IF -* - IWORK(1) = NR - IWORK(2) = NUMRANK - IWORK(3) = WARNING - IF ( TRANSP ) THEN - IWORK(4) = 1 - ELSE - IWORK(4) = -1 - END IF - -* - RETURN -* .. -* .. END OF ZGEJSV -* .. - END -* From 18d9759650f2c0547019cb3667622f5fbe446daa Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Thu, 4 Apr 2024 11:41:20 +0200 Subject: [PATCH 299/311] Delete misplaced (and obsoleted) file --- lapack-netlib/cgejsv.f | 2232 ---------------------------------------- 1 file changed, 2232 deletions(-) delete mode 100644 lapack-netlib/cgejsv.f diff --git a/lapack-netlib/cgejsv.f b/lapack-netlib/cgejsv.f deleted file mode 100644 index 51a6cee4e..000000000 --- a/lapack-netlib/cgejsv.f +++ /dev/null @@ -1,2232 +0,0 @@ -*> \brief \b CGEJSV -* -* =========== DOCUMENTATION =========== -* -* Online html documentation available at -* http://www.netlib.org/lapack/explore-html/ -* -*> \htmlonly -*> Download CGEJSV + dependencies -*> -*> [TGZ] -*> -*> [ZIP] -*> -*> [TXT] -*> \endhtmlonly -* -* Definition: -* =========== -* -* SUBROUTINE CGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, -* M, N, A, LDA, SVA, U, LDU, V, LDV, -* CWORK, LWORK, RWORK, LRWORK, IWORK, INFO ) -* -* .. Scalar Arguments .. -* IMPLICIT NONE -* INTEGER INFO, LDA, LDU, LDV, LWORK, M, N -* .. -* .. Array Arguments .. -* COMPLEX A( LDA, * ), U( LDU, * ), V( LDV, * ), CWORK( LWORK ) -* REAL SVA( N ), RWORK( LRWORK ) -* INTEGER IWORK( * ) -* CHARACTER*1 JOBA, JOBP, JOBR, JOBT, JOBU, JOBV -* .. -* -* -*> \par Purpose: -* ============= -*> -*> \verbatim -*> -*> CGEJSV computes the singular value decomposition (SVD) of a complex M-by-N -*> matrix [A], where M >= N. The SVD of [A] is written as -*> -*> [A] = [U] * [SIGMA] * [V]^*, -*> -*> where [SIGMA] is an N-by-N (M-by-N) matrix which is zero except for its N -*> diagonal elements, [U] is an M-by-N (or M-by-M) unitary matrix, and -*> [V] is an N-by-N unitary matrix. The diagonal elements of [SIGMA] are -*> the singular values of [A]. The columns of [U] and [V] are the left and -*> the right singular vectors of [A], respectively. The matrices [U] and [V] -*> are computed and stored in the arrays U and V, respectively. The diagonal -*> of [SIGMA] is computed and stored in the array SVA. -*> \endverbatim -*> -*> Arguments: -*> ========== -*> -*> \param[in] JOBA -*> \verbatim -*> JOBA is CHARACTER*1 -*> Specifies the level of accuracy: -*> = 'C': This option works well (high relative accuracy) if A = B * D, -*> with well-conditioned B and arbitrary diagonal matrix D. -*> The accuracy cannot be spoiled by COLUMN scaling. The -*> accuracy of the computed output depends on the condition of -*> B, and the procedure aims at the best theoretical accuracy. -*> The relative error max_{i=1:N}|d sigma_i| / sigma_i is -*> bounded by f(M,N)*epsilon* cond(B), independent of D. -*> The input matrix is preprocessed with the QRF with column -*> pivoting. This initial preprocessing and preconditioning by -*> a rank revealing QR factorization is common for all values of -*> JOBA. Additional actions are specified as follows: -*> = 'E': Computation as with 'C' with an additional estimate of the -*> condition number of B. It provides a realistic error bound. -*> = 'F': If A = D1 * C * D2 with ill-conditioned diagonal scalings -*> D1, D2, and well-conditioned matrix C, this option gives -*> higher accuracy than the 'C' option. If the structure of the -*> input matrix is not known, and relative accuracy is -*> desirable, then this option is advisable. The input matrix A -*> is preprocessed with QR factorization with FULL (row and -*> column) pivoting. -*> = 'G': Computation as with 'F' with an additional estimate of the -*> condition number of B, where A=B*D. If A has heavily weighted -*> rows, then using this condition number gives too pessimistic -*> error bound. -*> = 'A': Small singular values are not well determined by the data -*> and are considered as noisy; the matrix is treated as -*> numerically rank deficient. The error in the computed -*> singular values is bounded by f(m,n)*epsilon*||A||. -*> The computed SVD A = U * S * V^* restores A up to -*> f(m,n)*epsilon*||A||. -*> This gives the procedure the licence to discard (set to zero) -*> all singular values below N*epsilon*||A||. -*> = 'R': Similar as in 'A'. Rank revealing property of the initial -*> QR factorization is used do reveal (using triangular factor) -*> a gap sigma_{r+1} < epsilon * sigma_r in which case the -*> numerical RANK is declared to be r. The SVD is computed with -*> absolute error bounds, but more accurately than with 'A'. -*> \endverbatim -*> -*> \param[in] JOBU -*> \verbatim -*> JOBU is CHARACTER*1 -*> Specifies whether to compute the columns of U: -*> = 'U': N columns of U are returned in the array U. -*> = 'F': full set of M left sing. vectors is returned in the array U. -*> = 'W': U may be used as workspace of length M*N. See the description -*> of U. -*> = 'N': U is not computed. -*> \endverbatim -*> -*> \param[in] JOBV -*> \verbatim -*> JOBV is CHARACTER*1 -*> Specifies whether to compute the matrix V: -*> = 'V': N columns of V are returned in the array V; Jacobi rotations -*> are not explicitly accumulated. -*> = 'J': N columns of V are returned in the array V, but they are -*> computed as the product of Jacobi rotations, if JOBT = 'N'. -*> = 'W': V may be used as workspace of length N*N. See the description -*> of V. -*> = 'N': V is not computed. -*> \endverbatim -*> -*> \param[in] JOBR -*> \verbatim -*> JOBR is CHARACTER*1 -*> Specifies the RANGE for the singular values. Issues the licence to -*> set to zero small positive singular values if they are outside -*> specified range. If A .NE. 0 is scaled so that the largest singular -*> value of c*A is around SQRT(BIG), BIG=SLAMCH('O'), then JOBR issues -*> the licence to kill columns of A whose norm in c*A is less than -*> SQRT(SFMIN) (for JOBR = 'R'), or less than SMALL=SFMIN/EPSLN, -*> where SFMIN=SLAMCH('S'), EPSLN=SLAMCH('E'). -*> = 'N': Do not kill small columns of c*A. This option assumes that -*> BLAS and QR factorizations and triangular solvers are -*> implemented to work in that range. If the condition of A -*> is greater than BIG, use CGESVJ. -*> = 'R': RESTRICTED range for sigma(c*A) is [SQRT(SFMIN), SQRT(BIG)] -*> (roughly, as described above). This option is recommended. -*> =========================== -*> For computing the singular values in the FULL range [SFMIN,BIG] -*> use CGESVJ. -*> \endverbatim -*> -*> \param[in] JOBT -*> \verbatim -*> JOBT is CHARACTER*1 -*> If the matrix is square then the procedure may determine to use -*> transposed A if A^* seems to be better with respect to convergence. -*> If the matrix is not square, JOBT is ignored. -*> The decision is based on two values of entropy over the adjoint -*> orbit of A^* * A. See the descriptions of RWORK(6) and RWORK(7). -*> = 'T': transpose if entropy test indicates possibly faster -*> convergence of Jacobi process if A^* is taken as input. If A is -*> replaced with A^*, then the row pivoting is included automatically. -*> = 'N': do not speculate. -*> The option 'T' can be used to compute only the singular values, or -*> the full SVD (U, SIGMA and V). For only one set of singular vectors -*> (U or V), the caller should provide both U and V, as one of the -*> matrices is used as workspace if the matrix A is transposed. -*> The implementer can easily remove this constraint and make the -*> code more complicated. See the descriptions of U and V. -*> In general, this option is considered experimental, and 'N'; should -*> be preferred. This is subject to changes in the future. -*> \endverbatim -*> -*> \param[in] JOBP -*> \verbatim -*> JOBP is CHARACTER*1 -*> Issues the licence to introduce structured perturbations to drown -*> denormalized numbers. This licence should be active if the -*> denormals are poorly implemented, causing slow computation, -*> especially in cases of fast convergence (!). For details see [1,2]. -*> For the sake of simplicity, this perturbations are included only -*> when the full SVD or only the singular values are requested. The -*> implementer/user can easily add the perturbation for the cases of -*> computing one set of singular vectors. -*> = 'P': introduce perturbation -*> = 'N': do not perturb -*> \endverbatim -*> -*> \param[in] M -*> \verbatim -*> M is INTEGER -*> The number of rows of the input matrix A. M >= 0. -*> \endverbatim -*> -*> \param[in] N -*> \verbatim -*> N is INTEGER -*> The number of columns of the input matrix A. M >= N >= 0. -*> \endverbatim -*> -*> \param[in,out] A -*> \verbatim -*> A is COMPLEX array, dimension (LDA,N) -*> On entry, the M-by-N matrix A. -*> \endverbatim -*> -*> \param[in] LDA -*> \verbatim -*> LDA is INTEGER -*> The leading dimension of the array A. LDA >= max(1,M). -*> \endverbatim -*> -*> \param[out] SVA -*> \verbatim -*> SVA is REAL array, dimension (N) -*> On exit, -*> - For RWORK(1)/RWORK(2) = ONE: The singular values of A. During -*> the computation SVA contains Euclidean column norms of the -*> iterated matrices in the array A. -*> - For RWORK(1) .NE. RWORK(2): The singular values of A are -*> (RWORK(1)/RWORK(2)) * SVA(1:N). This factored form is used if -*> sigma_max(A) overflows or if small singular values have been -*> saved from underflow by scaling the input matrix A. -*> - If JOBR='R' then some of the singular values may be returned -*> as exact zeros obtained by "set to zero" because they are -*> below the numerical rank threshold or are denormalized numbers. -*> \endverbatim -*> -*> \param[out] U -*> \verbatim -*> U is COMPLEX array, dimension ( LDU, N ) or ( LDU, M ) -*> If JOBU = 'U', then U contains on exit the M-by-N matrix of -*> the left singular vectors. -*> If JOBU = 'F', then U contains on exit the M-by-M matrix of -*> the left singular vectors, including an ONB -*> of the orthogonal complement of the Range(A). -*> If JOBU = 'W' .AND. (JOBV = 'V' .AND. JOBT = 'T' .AND. M = N), -*> then U is used as workspace if the procedure -*> replaces A with A^*. In that case, [V] is computed -*> in U as left singular vectors of A^* and then -*> copied back to the V array. This 'W' option is just -*> a reminder to the caller that in this case U is -*> reserved as workspace of length N*N. -*> If JOBU = 'N' U is not referenced, unless JOBT='T'. -*> \endverbatim -*> -*> \param[in] LDU -*> \verbatim -*> LDU is INTEGER -*> The leading dimension of the array U, LDU >= 1. -*> IF JOBU = 'U' or 'F' or 'W', then LDU >= M. -*> \endverbatim -*> -*> \param[out] V -*> \verbatim -*> V is COMPLEX array, dimension ( LDV, N ) -*> If JOBV = 'V', 'J' then V contains on exit the N-by-N matrix of -*> the right singular vectors; -*> If JOBV = 'W', AND (JOBU = 'U' AND JOBT = 'T' AND M = N), -*> then V is used as workspace if the pprocedure -*> replaces A with A^*. In that case, [U] is computed -*> in V as right singular vectors of A^* and then -*> copied back to the U array. This 'W' option is just -*> a reminder to the caller that in this case V is -*> reserved as workspace of length N*N. -*> If JOBV = 'N' V is not referenced, unless JOBT='T'. -*> \endverbatim -*> -*> \param[in] LDV -*> \verbatim -*> LDV is INTEGER -*> The leading dimension of the array V, LDV >= 1. -*> If JOBV = 'V' or 'J' or 'W', then LDV >= N. -*> \endverbatim -*> -*> \param[out] CWORK -*> \verbatim -*> CWORK is COMPLEX array, dimension (MAX(2,LWORK)) -*> If the call to CGEJSV is a workspace query (indicated by LWORK=-1 or -*> LRWORK=-1), then on exit CWORK(1) contains the required length of -*> CWORK for the job parameters used in the call. -*> \endverbatim -*> -*> \param[in] LWORK -*> \verbatim -*> LWORK is INTEGER -*> Length of CWORK to confirm proper allocation of workspace. -*> LWORK depends on the job: -*> -*> 1. If only SIGMA is needed ( JOBU = 'N', JOBV = 'N' ) and -*> 1.1 .. no scaled condition estimate required (JOBA.NE.'E'.AND.JOBA.NE.'G'): -*> LWORK >= 2*N+1. This is the minimal requirement. -*> ->> For optimal performance (blocked code) the optimal value -*> is LWORK >= N + (N+1)*NB. Here NB is the optimal -*> block size for CGEQP3 and CGEQRF. -*> In general, optimal LWORK is computed as -*> LWORK >= max(N+LWORK(CGEQP3),N+LWORK(CGEQRF), LWORK(CGESVJ)). -*> 1.2. .. an estimate of the scaled condition number of A is -*> required (JOBA='E', or 'G'). In this case, LWORK the minimal -*> requirement is LWORK >= N*N + 2*N. -*> ->> For optimal performance (blocked code) the optimal value -*> is LWORK >= max(N+(N+1)*NB, N*N+2*N)=N**2+2*N. -*> In general, the optimal length LWORK is computed as -*> LWORK >= max(N+LWORK(CGEQP3),N+LWORK(CGEQRF), LWORK(CGESVJ), -*> N*N+LWORK(CPOCON)). -*> 2. If SIGMA and the right singular vectors are needed (JOBV = 'V'), -*> (JOBU = 'N') -*> 2.1 .. no scaled condition estimate requested (JOBE = 'N'): -*> -> the minimal requirement is LWORK >= 3*N. -*> -> For optimal performance, -*> LWORK >= max(N+(N+1)*NB, 2*N+N*NB)=2*N+N*NB, -*> where NB is the optimal block size for CGEQP3, CGEQRF, CGELQF, -*> CUNMLQ. In general, the optimal length LWORK is computed as -*> LWORK >= max(N+LWORK(CGEQP3), N+LWORK(CGESVJ), -*> N+LWORK(CGELQF), 2*N+LWORK(CGEQRF), N+LWORK(CUNMLQ)). -*> 2.2 .. an estimate of the scaled condition number of A is -*> required (JOBA='E', or 'G'). -*> -> the minimal requirement is LWORK >= 3*N. -*> -> For optimal performance, -*> LWORK >= max(N+(N+1)*NB, 2*N,2*N+N*NB)=2*N+N*NB, -*> where NB is the optimal block size for CGEQP3, CGEQRF, CGELQF, -*> CUNMLQ. In general, the optimal length LWORK is computed as -*> LWORK >= max(N+LWORK(CGEQP3), LWORK(CPOCON), N+LWORK(CGESVJ), -*> N+LWORK(CGELQF), 2*N+LWORK(CGEQRF), N+LWORK(CUNMLQ)). -*> 3. If SIGMA and the left singular vectors are needed -*> 3.1 .. no scaled condition estimate requested (JOBE = 'N'): -*> -> the minimal requirement is LWORK >= 3*N. -*> -> For optimal performance: -*> if JOBU = 'U' :: LWORK >= max(3*N, N+(N+1)*NB, 2*N+N*NB)=2*N+N*NB, -*> where NB is the optimal block size for CGEQP3, CGEQRF, CUNMQR. -*> In general, the optimal length LWORK is computed as -*> LWORK >= max(N+LWORK(CGEQP3), 2*N+LWORK(CGEQRF), N+LWORK(CUNMQR)). -*> 3.2 .. an estimate of the scaled condition number of A is -*> required (JOBA='E', or 'G'). -*> -> the minimal requirement is LWORK >= 3*N. -*> -> For optimal performance: -*> if JOBU = 'U' :: LWORK >= max(3*N, N+(N+1)*NB, 2*N+N*NB)=2*N+N*NB, -*> where NB is the optimal block size for CGEQP3, CGEQRF, CUNMQR. -*> In general, the optimal length LWORK is computed as -*> LWORK >= max(N+LWORK(CGEQP3),N+LWORK(CPOCON), -*> 2*N+LWORK(CGEQRF), N+LWORK(CUNMQR)). -*> -*> 4. If the full SVD is needed: (JOBU = 'U' or JOBU = 'F') and -*> 4.1. if JOBV = 'V' -*> the minimal requirement is LWORK >= 5*N+2*N*N. -*> 4.2. if JOBV = 'J' the minimal requirement is -*> LWORK >= 4*N+N*N. -*> In both cases, the allocated CWORK can accommodate blocked runs -*> of CGEQP3, CGEQRF, CGELQF, CUNMQR, CUNMLQ. -*> -*> If the call to CGEJSV is a workspace query (indicated by LWORK=-1 or -*> LRWORK=-1), then on exit CWORK(1) contains the optimal and CWORK(2) contains the -*> minimal length of CWORK for the job parameters used in the call. -*> \endverbatim -*> -*> \param[out] RWORK -*> \verbatim -*> RWORK is REAL array, dimension (MAX(7,LRWORK)) -*> On exit, -*> RWORK(1) = Determines the scaling factor SCALE = RWORK(2) / RWORK(1) -*> such that SCALE*SVA(1:N) are the computed singular values -*> of A. (See the description of SVA().) -*> RWORK(2) = See the description of RWORK(1). -*> RWORK(3) = SCONDA is an estimate for the condition number of -*> column equilibrated A. (If JOBA = 'E' or 'G') -*> SCONDA is an estimate of SQRT(||(R^* * R)^(-1)||_1). -*> It is computed using CPOCON. It holds -*> N^(-1/4) * SCONDA <= ||R^(-1)||_2 <= N^(1/4) * SCONDA -*> where R is the triangular factor from the QRF of A. -*> However, if R is truncated and the numerical rank is -*> determined to be strictly smaller than N, SCONDA is -*> returned as -1, thus indicating that the smallest -*> singular values might be lost. -*> -*> If full SVD is needed, the following two condition numbers are -*> useful for the analysis of the algorithm. They are provided for -*> a developer/implementer who is familiar with the details of -*> the method. -*> -*> RWORK(4) = an estimate of the scaled condition number of the -*> triangular factor in the first QR factorization. -*> RWORK(5) = an estimate of the scaled condition number of the -*> triangular factor in the second QR factorization. -*> The following two parameters are computed if JOBT = 'T'. -*> They are provided for a developer/implementer who is familiar -*> with the details of the method. -*> RWORK(6) = the entropy of A^* * A :: this is the Shannon entropy -*> of diag(A^* * A) / Trace(A^* * A) taken as point in the -*> probability simplex. -*> RWORK(7) = the entropy of A * A^*. (See the description of RWORK(6).) -*> If the call to CGEJSV is a workspace query (indicated by LWORK=-1 or -*> LRWORK=-1), then on exit RWORK(1) contains the required length of -*> RWORK for the job parameters used in the call. -*> \endverbatim -*> -*> \param[in] LRWORK -*> \verbatim -*> LRWORK is INTEGER -*> Length of RWORK to confirm proper allocation of workspace. -*> LRWORK depends on the job: -*> -*> 1. If only the singular values are requested i.e. if -*> LSAME(JOBU,'N') .AND. LSAME(JOBV,'N') -*> then: -*> 1.1. If LSAME(JOBT,'T') .OR. LSAME(JOBA,'F') .OR. LSAME(JOBA,'G'), -*> then: LRWORK = max( 7, 2 * M ). -*> 1.2. Otherwise, LRWORK = max( 7, N ). -*> 2. If singular values with the right singular vectors are requested -*> i.e. if -*> (LSAME(JOBV,'V').OR.LSAME(JOBV,'J')) .AND. -*> .NOT.(LSAME(JOBU,'U').OR.LSAME(JOBU,'F')) -*> then: -*> 2.1. If LSAME(JOBT,'T') .OR. LSAME(JOBA,'F') .OR. LSAME(JOBA,'G'), -*> then LRWORK = max( 7, 2 * M ). -*> 2.2. Otherwise, LRWORK = max( 7, N ). -*> 3. If singular values with the left singular vectors are requested, i.e. if -*> (LSAME(JOBU,'U').OR.LSAME(JOBU,'F')) .AND. -*> .NOT.(LSAME(JOBV,'V').OR.LSAME(JOBV,'J')) -*> then: -*> 3.1. If LSAME(JOBT,'T') .OR. LSAME(JOBA,'F') .OR. LSAME(JOBA,'G'), -*> then LRWORK = max( 7, 2 * M ). -*> 3.2. Otherwise, LRWORK = max( 7, N ). -*> 4. If singular values with both the left and the right singular vectors -*> are requested, i.e. if -*> (LSAME(JOBU,'U').OR.LSAME(JOBU,'F')) .AND. -*> (LSAME(JOBV,'V').OR.LSAME(JOBV,'J')) -*> then: -*> 4.1. If LSAME(JOBT,'T') .OR. LSAME(JOBA,'F') .OR. LSAME(JOBA,'G'), -*> then LRWORK = max( 7, 2 * M ). -*> 4.2. Otherwise, LRWORK = max( 7, N ). -*> -*> If, on entry, LRWORK = -1 or LWORK=-1, a workspace query is assumed and -*> the length of RWORK is returned in RWORK(1). -*> \endverbatim -*> -*> \param[out] IWORK -*> \verbatim -*> IWORK is INTEGER array, of dimension at least 4, that further depends -*> on the job: -*> -*> 1. If only the singular values are requested then: -*> If ( LSAME(JOBT,'T') .OR. LSAME(JOBA,'F') .OR. LSAME(JOBA,'G') ) -*> then the length of IWORK is N+M; otherwise the length of IWORK is N. -*> 2. If the singular values and the right singular vectors are requested then: -*> If ( LSAME(JOBT,'T') .OR. LSAME(JOBA,'F') .OR. LSAME(JOBA,'G') ) -*> then the length of IWORK is N+M; otherwise the length of IWORK is N. -*> 3. If the singular values and the left singular vectors are requested then: -*> If ( LSAME(JOBT,'T') .OR. LSAME(JOBA,'F') .OR. LSAME(JOBA,'G') ) -*> then the length of IWORK is N+M; otherwise the length of IWORK is N. -*> 4. If the singular values with both the left and the right singular vectors -*> are requested, then: -*> 4.1. If LSAME(JOBV,'J') the length of IWORK is determined as follows: -*> If ( LSAME(JOBT,'T') .OR. LSAME(JOBA,'F') .OR. LSAME(JOBA,'G') ) -*> then the length of IWORK is N+M; otherwise the length of IWORK is N. -*> 4.2. If LSAME(JOBV,'V') the length of IWORK is determined as follows: -*> If ( LSAME(JOBT,'T') .OR. LSAME(JOBA,'F') .OR. LSAME(JOBA,'G') ) -*> then the length of IWORK is 2*N+M; otherwise the length of IWORK is 2*N. -*> -*> On exit, -*> IWORK(1) = the numerical rank determined after the initial -*> QR factorization with pivoting. See the descriptions -*> of JOBA and JOBR. -*> IWORK(2) = the number of the computed nonzero singular values -*> IWORK(3) = if nonzero, a warning message: -*> If IWORK(3) = 1 then some of the column norms of A -*> were denormalized floats. The requested high accuracy -*> is not warranted by the data. -*> IWORK(4) = 1 or -1. If IWORK(4) = 1, then the procedure used A^* to -*> do the job as specified by the JOB parameters. -*> If the call to CGEJSV is a workspace query (indicated by LWORK = -1 and -*> LRWORK = -1), then on exit IWORK(1) contains the required length of -*> IWORK for the job parameters used in the call. -*> \endverbatim -*> -*> \param[out] INFO -*> \verbatim -*> INFO is INTEGER -*> < 0: if INFO = -i, then the i-th argument had an illegal value. -*> = 0: successful exit; -*> > 0: CGEJSV did not converge in the maximal allowed number -*> of sweeps. The computed values may be inaccurate. -*> \endverbatim -* -* Authors: -* ======== -* -*> \author Univ. of Tennessee -*> \author Univ. of California Berkeley -*> \author Univ. of Colorado Denver -*> \author NAG Ltd. -* -*> \ingroup complexGEsing -* -*> \par Further Details: -* ===================== -*> -*> \verbatim -*> CGEJSV implements a preconditioned Jacobi SVD algorithm. It uses CGEQP3, -*> CGEQRF, and CGELQF as preprocessors and preconditioners. Optionally, an -*> additional row pivoting can be used as a preprocessor, which in some -*> cases results in much higher accuracy. An example is matrix A with the -*> structure A = D1 * C * D2, where D1, D2 are arbitrarily ill-conditioned -*> diagonal matrices and C is well-conditioned matrix. In that case, complete -*> pivoting in the first QR factorizations provides accuracy dependent on the -*> condition number of C, and independent of D1, D2. Such higher accuracy is -*> not completely understood theoretically, but it works well in practice. -*> Further, if A can be written as A = B*D, with well-conditioned B and some -*> diagonal D, then the high accuracy is guaranteed, both theoretically and -*> in software, independent of D. For more details see [1], [2]. -*> The computational range for the singular values can be the full range -*> ( UNDERFLOW,OVERFLOW ), provided that the machine arithmetic and the BLAS -*> & LAPACK routines called by CGEJSV are implemented to work in that range. -*> If that is not the case, then the restriction for safe computation with -*> the singular values in the range of normalized IEEE numbers is that the -*> spectral condition number kappa(A)=sigma_max(A)/sigma_min(A) does not -*> overflow. This code (CGEJSV) is best used in this restricted range, -*> meaning that singular values of magnitude below ||A||_2 / SLAMCH('O') are -*> returned as zeros. See JOBR for details on this. -*> Further, this implementation is somewhat slower than the one described -*> in [1,2] due to replacement of some non-LAPACK components, and because -*> the choice of some tuning parameters in the iterative part (CGESVJ) is -*> left to the implementer on a particular machine. -*> The rank revealing QR factorization (in this code: CGEQP3) should be -*> implemented as in [3]. We have a new version of CGEQP3 under development -*> that is more robust than the current one in LAPACK, with a cleaner cut in -*> rank deficient cases. It will be available in the SIGMA library [4]. -*> If M is much larger than N, it is obvious that the initial QRF with -*> column pivoting can be preprocessed by the QRF without pivoting. That -*> well known trick is not used in CGEJSV because in some cases heavy row -*> weighting can be treated with complete pivoting. The overhead in cases -*> M much larger than N is then only due to pivoting, but the benefits in -*> terms of accuracy have prevailed. The implementer/user can incorporate -*> this extra QRF step easily. The implementer can also improve data movement -*> (matrix transpose, matrix copy, matrix transposed copy) - this -*> implementation of CGEJSV uses only the simplest, naive data movement. -*> \endverbatim -* -*> \par Contributor: -* ================== -*> -*> Zlatko Drmac (Zagreb, Croatia) -* -*> \par References: -* ================ -*> -*> \verbatim -*> -*> [1] Z. Drmac and K. Veselic: New fast and accurate Jacobi SVD algorithm I. -*> SIAM J. Matrix Anal. Appl. Vol. 35, No. 2 (2008), pp. 1322-1342. -*> LAPACK Working note 169. -*> [2] Z. Drmac and K. Veselic: New fast and accurate Jacobi SVD algorithm II. -*> SIAM J. Matrix Anal. Appl. Vol. 35, No. 2 (2008), pp. 1343-1362. -*> LAPACK Working note 170. -*> [3] Z. Drmac and Z. Bujanovic: On the failure of rank-revealing QR -*> factorization software - a case study. -*> ACM Trans. Math. Softw. Vol. 35, No 2 (2008), pp. 1-28. -*> LAPACK Working note 176. -*> [4] Z. Drmac: SIGMA - mathematical software library for accurate SVD, PSV, -*> QSVD, (H,K)-SVD computations. -*> Department of Mathematics, University of Zagreb, 2008, 2016. -*> \endverbatim -* -*> \par Bugs, examples and comments: -* ================================= -*> -*> Please report all bugs and send interesting examples and/or comments to -*> drmac@math.hr. Thank you. -*> -* ===================================================================== - SUBROUTINE CGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, - $ M, N, A, LDA, SVA, U, LDU, V, LDV, - $ CWORK, LWORK, RWORK, LRWORK, IWORK, INFO ) -* -* -- LAPACK computational routine -- -* -- LAPACK is a software package provided by Univ. of Tennessee, -- -* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* -* .. Scalar Arguments .. - IMPLICIT NONE - INTEGER INFO, LDA, LDU, LDV, LWORK, LRWORK, M, N -* .. -* .. Array Arguments .. - COMPLEX A( LDA, * ), U( LDU, * ), V( LDV, * ), CWORK( LWORK ) - REAL SVA( N ), RWORK( LRWORK ) - INTEGER IWORK( * ) - CHARACTER*1 JOBA, JOBP, JOBR, JOBT, JOBU, JOBV -* .. -* -* =========================================================================== -* -* .. Local Parameters .. - REAL ZERO, ONE - PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0 ) - COMPLEX CZERO, CONE - PARAMETER ( CZERO = ( 0.0E0, 0.0E0 ), CONE = ( 1.0E0, 0.0E0 ) ) -* .. -* .. Local Scalars .. - COMPLEX CTEMP - REAL AAPP, AAQQ, AATMAX, AATMIN, BIG, BIG1, COND_OK, - $ CONDR1, CONDR2, ENTRA, ENTRAT, EPSLN, MAXPRJ, SCALEM, - $ SCONDA, SFMIN, SMALL, TEMP1, USCAL1, USCAL2, XSC - INTEGER IERR, N1, NR, NUMRANK, p, q, WARNING - LOGICAL ALMORT, DEFR, ERREST, GOSCAL, JRACC, KILL, LQUERY, - $ LSVEC, L2ABER, L2KILL, L2PERT, L2RANK, L2TRAN, NOSCAL, - $ ROWPIV, RSVEC, TRANSP -* - INTEGER OPTWRK, MINWRK, MINRWRK, MINIWRK - INTEGER LWCON, LWLQF, LWQP3, LWQRF, LWUNMLQ, LWUNMQR, LWUNMQRM, - $ LWSVDJ, LWSVDJV, LRWQP3, LRWCON, LRWSVDJ, IWOFF - INTEGER LWRK_CGELQF, LWRK_CGEQP3, LWRK_CGEQP3N, LWRK_CGEQRF, - $ LWRK_CGESVJ, LWRK_CGESVJV, LWRK_CGESVJU, LWRK_CUNMLQ, - $ LWRK_CUNMQR, LWRK_CUNMQRM -* .. -* .. Local Arrays - COMPLEX CDUMMY(1) - REAL RDUMMY(1) -* -* .. Intrinsic Functions .. - INTRINSIC ABS, CMPLX, CONJG, ALOG, MAX, MIN, REAL, NINT, SQRT -* .. -* .. External Functions .. - REAL SLAMCH, SCNRM2 - INTEGER ISAMAX, ICAMAX - LOGICAL LSAME - EXTERNAL ISAMAX, ICAMAX, LSAME, SLAMCH, SCNRM2 -* .. -* .. External Subroutines .. - EXTERNAL SLASSQ, CCOPY, CGELQF, CGEQP3, CGEQRF, CLACPY, CLAPMR, - $ CLASCL, SLASCL, CLASET, CLASSQ, CLASWP, CUNGQR, CUNMLQ, - $ CUNMQR, CPOCON, SSCAL, CSSCAL, CSWAP, CTRSM, CLACGV, - $ XERBLA -* - EXTERNAL CGESVJ -* .. -* -* Test the input arguments -* - LSVEC = LSAME( JOBU, 'U' ) .OR. LSAME( JOBU, 'F' ) - JRACC = LSAME( JOBV, 'J' ) - RSVEC = LSAME( JOBV, 'V' ) .OR. JRACC - ROWPIV = LSAME( JOBA, 'F' ) .OR. LSAME( JOBA, 'G' ) - L2RANK = LSAME( JOBA, 'R' ) - L2ABER = LSAME( JOBA, 'A' ) - ERREST = LSAME( JOBA, 'E' ) .OR. LSAME( JOBA, 'G' ) - L2TRAN = LSAME( JOBT, 'T' ) .AND. ( M .EQ. N ) - L2KILL = LSAME( JOBR, 'R' ) - DEFR = LSAME( JOBR, 'N' ) - L2PERT = LSAME( JOBP, 'P' ) -* - LQUERY = ( LWORK .EQ. -1 ) .OR. ( LRWORK .EQ. -1 ) -* - IF ( .NOT.(ROWPIV .OR. L2RANK .OR. L2ABER .OR. - $ ERREST .OR. LSAME( JOBA, 'C' ) )) THEN - INFO = - 1 - ELSE IF ( .NOT.( LSVEC .OR. LSAME( JOBU, 'N' ) .OR. - $ ( LSAME( JOBU, 'W' ) .AND. RSVEC .AND. L2TRAN ) ) ) THEN - INFO = - 2 - ELSE IF ( .NOT.( RSVEC .OR. LSAME( JOBV, 'N' ) .OR. - $ ( LSAME( JOBV, 'W' ) .AND. LSVEC .AND. L2TRAN ) ) ) THEN - INFO = - 3 - ELSE IF ( .NOT. ( L2KILL .OR. DEFR ) ) THEN - INFO = - 4 - ELSE IF ( .NOT. ( LSAME(JOBT,'T') .OR. LSAME(JOBT,'N') ) ) THEN - INFO = - 5 - ELSE IF ( .NOT. ( L2PERT .OR. LSAME( JOBP, 'N' ) ) ) THEN - INFO = - 6 - ELSE IF ( M .LT. 0 ) THEN - INFO = - 7 - ELSE IF ( ( N .LT. 0 ) .OR. ( N .GT. M ) ) THEN - INFO = - 8 - ELSE IF ( LDA .LT. M ) THEN - INFO = - 10 - ELSE IF ( LSVEC .AND. ( LDU .LT. M ) ) THEN - INFO = - 13 - ELSE IF ( RSVEC .AND. ( LDV .LT. N ) ) THEN - INFO = - 15 - ELSE -* #:) - INFO = 0 - END IF -* - IF ( INFO .EQ. 0 ) THEN -* .. compute the minimal and the optimal workspace lengths -* [[The expressions for computing the minimal and the optimal -* values of LCWORK, LRWORK are written with a lot of redundancy and -* can be simplified. However, this verbose form is useful for -* maintenance and modifications of the code.]] -* -* .. minimal workspace length for CGEQP3 of an M x N matrix, -* CGEQRF of an N x N matrix, CGELQF of an N x N matrix, -* CUNMLQ for computing N x N matrix, CUNMQR for computing N x N -* matrix, CUNMQR for computing M x N matrix, respectively. - LWQP3 = N+1 - LWQRF = MAX( 1, N ) - LWLQF = MAX( 1, N ) - LWUNMLQ = MAX( 1, N ) - LWUNMQR = MAX( 1, N ) - LWUNMQRM = MAX( 1, M ) -* .. minimal workspace length for CPOCON of an N x N matrix - LWCON = 2 * N -* .. minimal workspace length for CGESVJ of an N x N matrix, -* without and with explicit accumulation of Jacobi rotations - LWSVDJ = MAX( 2 * N, 1 ) - LWSVDJV = MAX( 2 * N, 1 ) -* .. minimal REAL workspace length for CGEQP3, CPOCON, CGESVJ - LRWQP3 = 2 * N - LRWCON = N - LRWSVDJ = N - IF ( LQUERY ) THEN - CALL CGEQP3( M, N, A, LDA, IWORK, CDUMMY, CDUMMY, -1, - $ RDUMMY, IERR ) - LWRK_CGEQP3 = INT( CDUMMY(1) ) - CALL CGEQRF( N, N, A, LDA, CDUMMY, CDUMMY,-1, IERR ) - LWRK_CGEQRF = INT( CDUMMY(1) ) - CALL CGELQF( N, N, A, LDA, CDUMMY, CDUMMY,-1, IERR ) - LWRK_CGELQF = INT( CDUMMY(1) ) - END IF - MINWRK = 2 - OPTWRK = 2 - MINIWRK = N - IF ( .NOT. (LSVEC .OR. RSVEC ) ) THEN -* .. minimal and optimal sizes of the complex workspace if -* only the singular values are requested - IF ( ERREST ) THEN - MINWRK = MAX( N+LWQP3, N**2+LWCON, N+LWQRF, LWSVDJ ) - ELSE - MINWRK = MAX( N+LWQP3, N+LWQRF, LWSVDJ ) - END IF - IF ( LQUERY ) THEN - CALL CGESVJ( 'L', 'N', 'N', N, N, A, LDA, SVA, N, V, - $ LDV, CDUMMY, -1, RDUMMY, -1, IERR ) - LWRK_CGESVJ = INT( CDUMMY(1) ) - IF ( ERREST ) THEN - OPTWRK = MAX( N+LWRK_CGEQP3, N**2+LWCON, - $ N+LWRK_CGEQRF, LWRK_CGESVJ ) - ELSE - OPTWRK = MAX( N+LWRK_CGEQP3, N+LWRK_CGEQRF, - $ LWRK_CGESVJ ) - END IF - END IF - IF ( L2TRAN .OR. ROWPIV ) THEN - IF ( ERREST ) THEN - MINRWRK = MAX( 7, 2*M, LRWQP3, LRWCON, LRWSVDJ ) - ELSE - MINRWRK = MAX( 7, 2*M, LRWQP3, LRWSVDJ ) - END IF - ELSE - IF ( ERREST ) THEN - MINRWRK = MAX( 7, LRWQP3, LRWCON, LRWSVDJ ) - ELSE - MINRWRK = MAX( 7, LRWQP3, LRWSVDJ ) - END IF - END IF - IF ( ROWPIV .OR. L2TRAN ) MINIWRK = MINIWRK + M - ELSE IF ( RSVEC .AND. (.NOT.LSVEC) ) THEN -* .. minimal and optimal sizes of the complex workspace if the -* singular values and the right singular vectors are requested - IF ( ERREST ) THEN - MINWRK = MAX( N+LWQP3, LWCON, LWSVDJ, N+LWLQF, - $ 2*N+LWQRF, N+LWSVDJ, N+LWUNMLQ ) - ELSE - MINWRK = MAX( N+LWQP3, LWSVDJ, N+LWLQF, 2*N+LWQRF, - $ N+LWSVDJ, N+LWUNMLQ ) - END IF - IF ( LQUERY ) THEN - CALL CGESVJ( 'L', 'U', 'N', N,N, U, LDU, SVA, N, A, - $ LDA, CDUMMY, -1, RDUMMY, -1, IERR ) - LWRK_CGESVJ = INT( CDUMMY(1) ) - CALL CUNMLQ( 'L', 'C', N, N, N, A, LDA, CDUMMY, - $ V, LDV, CDUMMY, -1, IERR ) - LWRK_CUNMLQ = INT( CDUMMY(1) ) - IF ( ERREST ) THEN - OPTWRK = MAX( N+LWRK_CGEQP3, LWCON, LWRK_CGESVJ, - $ N+LWRK_CGELQF, 2*N+LWRK_CGEQRF, - $ N+LWRK_CGESVJ, N+LWRK_CUNMLQ ) - ELSE - OPTWRK = MAX( N+LWRK_CGEQP3, LWRK_CGESVJ,N+LWRK_CGELQF, - $ 2*N+LWRK_CGEQRF, N+LWRK_CGESVJ, - $ N+LWRK_CUNMLQ ) - END IF - END IF - IF ( L2TRAN .OR. ROWPIV ) THEN - IF ( ERREST ) THEN - MINRWRK = MAX( 7, 2*M, LRWQP3, LRWSVDJ, LRWCON ) - ELSE - MINRWRK = MAX( 7, 2*M, LRWQP3, LRWSVDJ ) - END IF - ELSE - IF ( ERREST ) THEN - MINRWRK = MAX( 7, LRWQP3, LRWSVDJ, LRWCON ) - ELSE - MINRWRK = MAX( 7, LRWQP3, LRWSVDJ ) - END IF - END IF - IF ( ROWPIV .OR. L2TRAN ) MINIWRK = MINIWRK + M - ELSE IF ( LSVEC .AND. (.NOT.RSVEC) ) THEN -* .. minimal and optimal sizes of the complex workspace if the -* singular values and the left singular vectors are requested - IF ( ERREST ) THEN - MINWRK = N + MAX( LWQP3,LWCON,N+LWQRF,LWSVDJ,LWUNMQRM ) - ELSE - MINWRK = N + MAX( LWQP3, N+LWQRF, LWSVDJ, LWUNMQRM ) - END IF - IF ( LQUERY ) THEN - CALL CGESVJ( 'L', 'U', 'N', N,N, U, LDU, SVA, N, A, - $ LDA, CDUMMY, -1, RDUMMY, -1, IERR ) - LWRK_CGESVJ = INT( CDUMMY(1) ) - CALL CUNMQR( 'L', 'N', M, N, N, A, LDA, CDUMMY, U, - $ LDU, CDUMMY, -1, IERR ) - LWRK_CUNMQRM = INT( CDUMMY(1) ) - IF ( ERREST ) THEN - OPTWRK = N + MAX( LWRK_CGEQP3, LWCON, N+LWRK_CGEQRF, - $ LWRK_CGESVJ, LWRK_CUNMQRM ) - ELSE - OPTWRK = N + MAX( LWRK_CGEQP3, N+LWRK_CGEQRF, - $ LWRK_CGESVJ, LWRK_CUNMQRM ) - END IF - END IF - IF ( L2TRAN .OR. ROWPIV ) THEN - IF ( ERREST ) THEN - MINRWRK = MAX( 7, 2*M, LRWQP3, LRWSVDJ, LRWCON ) - ELSE - MINRWRK = MAX( 7, 2*M, LRWQP3, LRWSVDJ ) - END IF - ELSE - IF ( ERREST ) THEN - MINRWRK = MAX( 7, LRWQP3, LRWSVDJ, LRWCON ) - ELSE - MINRWRK = MAX( 7, LRWQP3, LRWSVDJ ) - END IF - END IF - IF ( ROWPIV .OR. L2TRAN ) MINIWRK = MINIWRK + M - ELSE -* .. minimal and optimal sizes of the complex workspace if the -* full SVD is requested - IF ( .NOT. JRACC ) THEN - IF ( ERREST ) THEN - MINWRK = MAX( N+LWQP3, N+LWCON, 2*N+N**2+LWCON, - $ 2*N+LWQRF, 2*N+LWQP3, - $ 2*N+N**2+N+LWLQF, 2*N+N**2+N+N**2+LWCON, - $ 2*N+N**2+N+LWSVDJ, 2*N+N**2+N+LWSVDJV, - $ 2*N+N**2+N+LWUNMQR,2*N+N**2+N+LWUNMLQ, - $ N+N**2+LWSVDJ, N+LWUNMQRM ) - ELSE - MINWRK = MAX( N+LWQP3, 2*N+N**2+LWCON, - $ 2*N+LWQRF, 2*N+LWQP3, - $ 2*N+N**2+N+LWLQF, 2*N+N**2+N+N**2+LWCON, - $ 2*N+N**2+N+LWSVDJ, 2*N+N**2+N+LWSVDJV, - $ 2*N+N**2+N+LWUNMQR,2*N+N**2+N+LWUNMLQ, - $ N+N**2+LWSVDJ, N+LWUNMQRM ) - END IF - MINIWRK = MINIWRK + N - IF ( ROWPIV .OR. L2TRAN ) MINIWRK = MINIWRK + M - ELSE - IF ( ERREST ) THEN - MINWRK = MAX( N+LWQP3, N+LWCON, 2*N+LWQRF, - $ 2*N+N**2+LWSVDJV, 2*N+N**2+N+LWUNMQR, - $ N+LWUNMQRM ) - ELSE - MINWRK = MAX( N+LWQP3, 2*N+LWQRF, - $ 2*N+N**2+LWSVDJV, 2*N+N**2+N+LWUNMQR, - $ N+LWUNMQRM ) - END IF - IF ( ROWPIV .OR. L2TRAN ) MINIWRK = MINIWRK + M - END IF - IF ( LQUERY ) THEN - CALL CUNMQR( 'L', 'N', M, N, N, A, LDA, CDUMMY, U, - $ LDU, CDUMMY, -1, IERR ) - LWRK_CUNMQRM = INT( CDUMMY(1) ) - CALL CUNMQR( 'L', 'N', N, N, N, A, LDA, CDUMMY, U, - $ LDU, CDUMMY, -1, IERR ) - LWRK_CUNMQR = INT( CDUMMY(1) ) - IF ( .NOT. JRACC ) THEN - CALL CGEQP3( N,N, A, LDA, IWORK, CDUMMY,CDUMMY, -1, - $ RDUMMY, IERR ) - LWRK_CGEQP3N = INT( CDUMMY(1) ) - CALL CGESVJ( 'L', 'U', 'N', N, N, U, LDU, SVA, - $ N, V, LDV, CDUMMY, -1, RDUMMY, -1, IERR ) - LWRK_CGESVJ = INT( CDUMMY(1) ) - CALL CGESVJ( 'U', 'U', 'N', N, N, U, LDU, SVA, - $ N, V, LDV, CDUMMY, -1, RDUMMY, -1, IERR ) - LWRK_CGESVJU = INT( CDUMMY(1) ) - CALL CGESVJ( 'L', 'U', 'V', N, N, U, LDU, SVA, - $ N, V, LDV, CDUMMY, -1, RDUMMY, -1, IERR ) - LWRK_CGESVJV = INT( CDUMMY(1) ) - CALL CUNMLQ( 'L', 'C', N, N, N, A, LDA, CDUMMY, - $ V, LDV, CDUMMY, -1, IERR ) - LWRK_CUNMLQ = INT( CDUMMY(1) ) - IF ( ERREST ) THEN - OPTWRK = MAX( N+LWRK_CGEQP3, N+LWCON, - $ 2*N+N**2+LWCON, 2*N+LWRK_CGEQRF, - $ 2*N+LWRK_CGEQP3N, - $ 2*N+N**2+N+LWRK_CGELQF, - $ 2*N+N**2+N+N**2+LWCON, - $ 2*N+N**2+N+LWRK_CGESVJ, - $ 2*N+N**2+N+LWRK_CGESVJV, - $ 2*N+N**2+N+LWRK_CUNMQR, - $ 2*N+N**2+N+LWRK_CUNMLQ, - $ N+N**2+LWRK_CGESVJU, - $ N+LWRK_CUNMQRM ) - ELSE - OPTWRK = MAX( N+LWRK_CGEQP3, - $ 2*N+N**2+LWCON, 2*N+LWRK_CGEQRF, - $ 2*N+LWRK_CGEQP3N, - $ 2*N+N**2+N+LWRK_CGELQF, - $ 2*N+N**2+N+N**2+LWCON, - $ 2*N+N**2+N+LWRK_CGESVJ, - $ 2*N+N**2+N+LWRK_CGESVJV, - $ 2*N+N**2+N+LWRK_CUNMQR, - $ 2*N+N**2+N+LWRK_CUNMLQ, - $ N+N**2+LWRK_CGESVJU, - $ N+LWRK_CUNMQRM ) - END IF - ELSE - CALL CGESVJ( 'L', 'U', 'V', N, N, U, LDU, SVA, - $ N, V, LDV, CDUMMY, -1, RDUMMY, -1, IERR ) - LWRK_CGESVJV = INT( CDUMMY(1) ) - CALL CUNMQR( 'L', 'N', N, N, N, CDUMMY, N, CDUMMY, - $ V, LDV, CDUMMY, -1, IERR ) - LWRK_CUNMQR = INT( CDUMMY(1) ) - CALL CUNMQR( 'L', 'N', M, N, N, A, LDA, CDUMMY, U, - $ LDU, CDUMMY, -1, IERR ) - LWRK_CUNMQRM = INT( CDUMMY(1) ) - IF ( ERREST ) THEN - OPTWRK = MAX( N+LWRK_CGEQP3, N+LWCON, - $ 2*N+LWRK_CGEQRF, 2*N+N**2, - $ 2*N+N**2+LWRK_CGESVJV, - $ 2*N+N**2+N+LWRK_CUNMQR,N+LWRK_CUNMQRM ) - ELSE - OPTWRK = MAX( N+LWRK_CGEQP3, 2*N+LWRK_CGEQRF, - $ 2*N+N**2, 2*N+N**2+LWRK_CGESVJV, - $ 2*N+N**2+N+LWRK_CUNMQR, - $ N+LWRK_CUNMQRM ) - END IF - END IF - END IF - IF ( L2TRAN .OR. ROWPIV ) THEN - MINRWRK = MAX( 7, 2*M, LRWQP3, LRWSVDJ, LRWCON ) - ELSE - MINRWRK = MAX( 7, LRWQP3, LRWSVDJ, LRWCON ) - END IF - END IF - MINWRK = MAX( 2, MINWRK ) - OPTWRK = MAX( OPTWRK, MINWRK ) - IF ( LWORK .LT. MINWRK .AND. (.NOT.LQUERY) ) INFO = - 17 - IF ( LRWORK .LT. MINRWRK .AND. (.NOT.LQUERY) ) INFO = - 19 - END IF -* - IF ( INFO .NE. 0 ) THEN -* #:( - CALL XERBLA( 'CGEJSV', - INFO ) - RETURN - ELSE IF ( LQUERY ) THEN - CWORK(1) = OPTWRK - CWORK(2) = MINWRK - RWORK(1) = MINRWRK - IWORK(1) = MAX( 4, MINIWRK ) - RETURN - END IF -* -* Quick return for void matrix (Y3K safe) -* #:) - IF ( ( M .EQ. 0 ) .OR. ( N .EQ. 0 ) ) THEN - IWORK(1:4) = 0 - RWORK(1:7) = 0 - RETURN - ENDIF -* -* Determine whether the matrix U should be M x N or M x M -* - IF ( LSVEC ) THEN - N1 = N - IF ( LSAME( JOBU, 'F' ) ) N1 = M - END IF -* -* Set numerical parameters -* -*! NOTE: Make sure SLAMCH() does not fail on the target architecture. -* - EPSLN = SLAMCH('Epsilon') - SFMIN = SLAMCH('SafeMinimum') - SMALL = SFMIN / EPSLN - BIG = SLAMCH('O') -* BIG = ONE / SFMIN -* -* Initialize SVA(1:N) = diag( ||A e_i||_2 )_1^N -* -*(!) If necessary, scale SVA() to protect the largest norm from -* overflow. It is possible that this scaling pushes the smallest -* column norm left from the underflow threshold (extreme case). -* - SCALEM = ONE / SQRT(REAL(M)*REAL(N)) - NOSCAL = .TRUE. - GOSCAL = .TRUE. - DO 1874 p = 1, N - AAPP = ZERO - AAQQ = ONE - CALL CLASSQ( M, A(1,p), 1, AAPP, AAQQ ) - IF ( AAPP .GT. BIG ) THEN - INFO = - 9 - CALL XERBLA( 'CGEJSV', -INFO ) - RETURN - END IF - AAQQ = SQRT(AAQQ) - IF ( ( AAPP .LT. (BIG / AAQQ) ) .AND. NOSCAL ) THEN - SVA(p) = AAPP * AAQQ - ELSE - NOSCAL = .FALSE. - SVA(p) = AAPP * ( AAQQ * SCALEM ) - IF ( GOSCAL ) THEN - GOSCAL = .FALSE. - CALL SSCAL( p-1, SCALEM, SVA, 1 ) - END IF - END IF - 1874 CONTINUE -* - IF ( NOSCAL ) SCALEM = ONE -* - AAPP = ZERO - AAQQ = BIG - DO 4781 p = 1, N - AAPP = MAX( AAPP, SVA(p) ) - IF ( SVA(p) .NE. ZERO ) AAQQ = MIN( AAQQ, SVA(p) ) - 4781 CONTINUE -* -* Quick return for zero M x N matrix -* #:) - IF ( AAPP .EQ. ZERO ) THEN - IF ( LSVEC ) CALL CLASET( 'G', M, N1, CZERO, CONE, U, LDU ) - IF ( RSVEC ) CALL CLASET( 'G', N, N, CZERO, CONE, V, LDV ) - RWORK(1) = ONE - RWORK(2) = ONE - IF ( ERREST ) RWORK(3) = ONE - IF ( LSVEC .AND. RSVEC ) THEN - RWORK(4) = ONE - RWORK(5) = ONE - END IF - IF ( L2TRAN ) THEN - RWORK(6) = ZERO - RWORK(7) = ZERO - END IF - IWORK(1) = 0 - IWORK(2) = 0 - IWORK(3) = 0 - IWORK(4) = -1 - RETURN - END IF -* -* Issue warning if denormalized column norms detected. Override the -* high relative accuracy request. Issue licence to kill nonzero columns -* (set them to zero) whose norm is less than sigma_max / BIG (roughly). -* #:( - WARNING = 0 - IF ( AAQQ .LE. SFMIN ) THEN - L2RANK = .TRUE. - L2KILL = .TRUE. - WARNING = 1 - END IF -* -* Quick return for one-column matrix -* #:) - IF ( N .EQ. 1 ) THEN -* - IF ( LSVEC ) THEN - CALL CLASCL( 'G',0,0,SVA(1),SCALEM, M,1,A(1,1),LDA,IERR ) - CALL CLACPY( 'A', M, 1, A, LDA, U, LDU ) -* computing all M left singular vectors of the M x 1 matrix - IF ( N1 .NE. N ) THEN - CALL CGEQRF( M, N, U,LDU, CWORK, CWORK(N+1),LWORK-N,IERR ) - CALL CUNGQR( M,N1,1, U,LDU,CWORK,CWORK(N+1),LWORK-N,IERR ) - CALL CCOPY( M, A(1,1), 1, U(1,1), 1 ) - END IF - END IF - IF ( RSVEC ) THEN - V(1,1) = CONE - END IF - IF ( SVA(1) .LT. (BIG*SCALEM) ) THEN - SVA(1) = SVA(1) / SCALEM - SCALEM = ONE - END IF - RWORK(1) = ONE / SCALEM - RWORK(2) = ONE - IF ( SVA(1) .NE. ZERO ) THEN - IWORK(1) = 1 - IF ( ( SVA(1) / SCALEM) .GE. SFMIN ) THEN - IWORK(2) = 1 - ELSE - IWORK(2) = 0 - END IF - ELSE - IWORK(1) = 0 - IWORK(2) = 0 - END IF - IWORK(3) = 0 - IWORK(4) = -1 - IF ( ERREST ) RWORK(3) = ONE - IF ( LSVEC .AND. RSVEC ) THEN - RWORK(4) = ONE - RWORK(5) = ONE - END IF - IF ( L2TRAN ) THEN - RWORK(6) = ZERO - RWORK(7) = ZERO - END IF - RETURN -* - END IF -* - TRANSP = .FALSE. -* - AATMAX = -ONE - AATMIN = BIG - IF ( ROWPIV .OR. L2TRAN ) THEN -* -* Compute the row norms, needed to determine row pivoting sequence -* (in the case of heavily row weighted A, row pivoting is strongly -* advised) and to collect information needed to compare the -* structures of A * A^* and A^* * A (in the case L2TRAN.EQ..TRUE.). -* - IF ( L2TRAN ) THEN - DO 1950 p = 1, M - XSC = ZERO - TEMP1 = ONE - CALL CLASSQ( N, A(p,1), LDA, XSC, TEMP1 ) -* CLASSQ gets both the ell_2 and the ell_infinity norm -* in one pass through the vector - RWORK(M+p) = XSC * SCALEM - RWORK(p) = XSC * (SCALEM*SQRT(TEMP1)) - AATMAX = MAX( AATMAX, RWORK(p) ) - IF (RWORK(p) .NE. ZERO) - $ AATMIN = MIN(AATMIN,RWORK(p)) - 1950 CONTINUE - ELSE - DO 1904 p = 1, M - RWORK(M+p) = SCALEM*ABS( A(p,ICAMAX(N,A(p,1),LDA)) ) - AATMAX = MAX( AATMAX, RWORK(M+p) ) - AATMIN = MIN( AATMIN, RWORK(M+p) ) - 1904 CONTINUE - END IF -* - END IF -* -* For square matrix A try to determine whether A^* would be better -* input for the preconditioned Jacobi SVD, with faster convergence. -* The decision is based on an O(N) function of the vector of column -* and row norms of A, based on the Shannon entropy. This should give -* the right choice in most cases when the difference actually matters. -* It may fail and pick the slower converging side. -* - ENTRA = ZERO - ENTRAT = ZERO - IF ( L2TRAN ) THEN -* - XSC = ZERO - TEMP1 = ONE - CALL SLASSQ( N, SVA, 1, XSC, TEMP1 ) - TEMP1 = ONE / TEMP1 -* - ENTRA = ZERO - DO 1113 p = 1, N - BIG1 = ( ( SVA(p) / XSC )**2 ) * TEMP1 - IF ( BIG1 .NE. ZERO ) ENTRA = ENTRA + BIG1 * ALOG(BIG1) - 1113 CONTINUE - ENTRA = - ENTRA / ALOG(REAL(N)) -* -* Now, SVA().^2/Trace(A^* * A) is a point in the probability simplex. -* It is derived from the diagonal of A^* * A. Do the same with the -* diagonal of A * A^*, compute the entropy of the corresponding -* probability distribution. Note that A * A^* and A^* * A have the -* same trace. -* - ENTRAT = ZERO - DO 1114 p = 1, M - BIG1 = ( ( RWORK(p) / XSC )**2 ) * TEMP1 - IF ( BIG1 .NE. ZERO ) ENTRAT = ENTRAT + BIG1 * ALOG(BIG1) - 1114 CONTINUE - ENTRAT = - ENTRAT / ALOG(REAL(M)) -* -* Analyze the entropies and decide A or A^*. Smaller entropy -* usually means better input for the algorithm. -* - TRANSP = ( ENTRAT .LT. ENTRA ) -* -* If A^* is better than A, take the adjoint of A. This is allowed -* only for square matrices, M=N. - IF ( TRANSP ) THEN -* In an optimal implementation, this trivial transpose -* should be replaced with faster transpose. - DO 1115 p = 1, N - 1 - A(p,p) = CONJG(A(p,p)) - DO 1116 q = p + 1, N - CTEMP = CONJG(A(q,p)) - A(q,p) = CONJG(A(p,q)) - A(p,q) = CTEMP - 1116 CONTINUE - 1115 CONTINUE - A(N,N) = CONJG(A(N,N)) - DO 1117 p = 1, N - RWORK(M+p) = SVA(p) - SVA(p) = RWORK(p) -* previously computed row 2-norms are now column 2-norms -* of the transposed matrix - 1117 CONTINUE - TEMP1 = AAPP - AAPP = AATMAX - AATMAX = TEMP1 - TEMP1 = AAQQ - AAQQ = AATMIN - AATMIN = TEMP1 - KILL = LSVEC - LSVEC = RSVEC - RSVEC = KILL - IF ( LSVEC ) N1 = N -* - ROWPIV = .TRUE. - END IF -* - END IF -* END IF L2TRAN -* -* Scale the matrix so that its maximal singular value remains less -* than SQRT(BIG) -- the matrix is scaled so that its maximal column -* has Euclidean norm equal to SQRT(BIG/N). The only reason to keep -* SQRT(BIG) instead of BIG is the fact that CGEJSV uses LAPACK and -* BLAS routines that, in some implementations, are not capable of -* working in the full interval [SFMIN,BIG] and that they may provoke -* overflows in the intermediate results. If the singular values spread -* from SFMIN to BIG, then CGESVJ will compute them. So, in that case, -* one should use CGESVJ instead of CGEJSV. - BIG1 = SQRT( BIG ) - TEMP1 = SQRT( BIG / REAL(N) ) -* >> for future updates: allow bigger range, i.e. the largest column -* will be allowed up to BIG/N and CGESVJ will do the rest. However, for -* this all other (LAPACK) components must allow such a range. -* TEMP1 = BIG/REAL(N) -* TEMP1 = BIG * EPSLN this should 'almost' work with current LAPACK components - CALL SLASCL( 'G', 0, 0, AAPP, TEMP1, N, 1, SVA, N, IERR ) - IF ( AAQQ .GT. (AAPP * SFMIN) ) THEN - AAQQ = ( AAQQ / AAPP ) * TEMP1 - ELSE - AAQQ = ( AAQQ * TEMP1 ) / AAPP - END IF - TEMP1 = TEMP1 * SCALEM - CALL CLASCL( 'G', 0, 0, AAPP, TEMP1, M, N, A, LDA, IERR ) -* -* To undo scaling at the end of this procedure, multiply the -* computed singular values with USCAL2 / USCAL1. -* - USCAL1 = TEMP1 - USCAL2 = AAPP -* - IF ( L2KILL ) THEN -* L2KILL enforces computation of nonzero singular values in -* the restricted range of condition number of the initial A, -* sigma_max(A) / sigma_min(A) approx. SQRT(BIG)/SQRT(SFMIN). - XSC = SQRT( SFMIN ) - ELSE - XSC = SMALL -* -* Now, if the condition number of A is too big, -* sigma_max(A) / sigma_min(A) .GT. SQRT(BIG/N) * EPSLN / SFMIN, -* as a precaution measure, the full SVD is computed using CGESVJ -* with accumulated Jacobi rotations. This provides numerically -* more robust computation, at the cost of slightly increased run -* time. Depending on the concrete implementation of BLAS and LAPACK -* (i.e. how they behave in presence of extreme ill-conditioning) the -* implementor may decide to remove this switch. - IF ( ( AAQQ.LT.SQRT(SFMIN) ) .AND. LSVEC .AND. RSVEC ) THEN - JRACC = .TRUE. - END IF -* - END IF - IF ( AAQQ .LT. XSC ) THEN - DO 700 p = 1, N - IF ( SVA(p) .LT. XSC ) THEN - CALL CLASET( 'A', M, 1, CZERO, CZERO, A(1,p), LDA ) - SVA(p) = ZERO - END IF - 700 CONTINUE - END IF -* -* Preconditioning using QR factorization with pivoting -* - IF ( ROWPIV ) THEN -* Optional row permutation (Bjoerck row pivoting): -* A result by Cox and Higham shows that the Bjoerck's -* row pivoting combined with standard column pivoting -* has similar effect as Powell-Reid complete pivoting. -* The ell-infinity norms of A are made nonincreasing. - IF ( ( LSVEC .AND. RSVEC ) .AND. .NOT.( JRACC ) ) THEN - IWOFF = 2*N - ELSE - IWOFF = N - END IF - DO 1952 p = 1, M - 1 - q = ISAMAX( M-p+1, RWORK(M+p), 1 ) + p - 1 - IWORK(IWOFF+p) = q - IF ( p .NE. q ) THEN - TEMP1 = RWORK(M+p) - RWORK(M+p) = RWORK(M+q) - RWORK(M+q) = TEMP1 - END IF - 1952 CONTINUE - CALL CLASWP( N, A, LDA, 1, M-1, IWORK(IWOFF+1), 1 ) - END IF -* -* End of the preparation phase (scaling, optional sorting and -* transposing, optional flushing of small columns). -* -* Preconditioning -* -* If the full SVD is needed, the right singular vectors are computed -* from a matrix equation, and for that we need theoretical analysis -* of the Businger-Golub pivoting. So we use CGEQP3 as the first RR QRF. -* In all other cases the first RR QRF can be chosen by other criteria -* (eg speed by replacing global with restricted window pivoting, such -* as in xGEQPX from TOMS # 782). Good results will be obtained using -* xGEQPX with properly (!) chosen numerical parameters. -* Any improvement of CGEQP3 improves overall performance of CGEJSV. -* -* A * P1 = Q1 * [ R1^* 0]^*: - DO 1963 p = 1, N -* .. all columns are free columns - IWORK(p) = 0 - 1963 CONTINUE - CALL CGEQP3( M, N, A, LDA, IWORK, CWORK, CWORK(N+1), LWORK-N, - $ RWORK, IERR ) -* -* The upper triangular matrix R1 from the first QRF is inspected for -* rank deficiency and possibilities for deflation, or possible -* ill-conditioning. Depending on the user specified flag L2RANK, -* the procedure explores possibilities to reduce the numerical -* rank by inspecting the computed upper triangular factor. If -* L2RANK or L2ABER are up, then CGEJSV will compute the SVD of -* A + dA, where ||dA|| <= f(M,N)*EPSLN. -* - NR = 1 - IF ( L2ABER ) THEN -* Standard absolute error bound suffices. All sigma_i with -* sigma_i < N*EPSLN*||A|| are flushed to zero. This is an -* aggressive enforcement of lower numerical rank by introducing a -* backward error of the order of N*EPSLN*||A||. - TEMP1 = SQRT(REAL(N))*EPSLN - DO 3001 p = 2, N - IF ( ABS(A(p,p)) .GE. (TEMP1*ABS(A(1,1))) ) THEN - NR = NR + 1 - ELSE - GO TO 3002 - END IF - 3001 CONTINUE - 3002 CONTINUE - ELSE IF ( L2RANK ) THEN -* .. similarly as above, only slightly more gentle (less aggressive). -* Sudden drop on the diagonal of R1 is used as the criterion for -* close-to-rank-deficient. - TEMP1 = SQRT(SFMIN) - DO 3401 p = 2, N - IF ( ( ABS(A(p,p)) .LT. (EPSLN*ABS(A(p-1,p-1))) ) .OR. - $ ( ABS(A(p,p)) .LT. SMALL ) .OR. - $ ( L2KILL .AND. (ABS(A(p,p)) .LT. TEMP1) ) ) GO TO 3402 - NR = NR + 1 - 3401 CONTINUE - 3402 CONTINUE -* - ELSE -* The goal is high relative accuracy. However, if the matrix -* has high scaled condition number the relative accuracy is in -* general not feasible. Later on, a condition number estimator -* will be deployed to estimate the scaled condition number. -* Here we just remove the underflowed part of the triangular -* factor. This prevents the situation in which the code is -* working hard to get the accuracy not warranted by the data. - TEMP1 = SQRT(SFMIN) - DO 3301 p = 2, N - IF ( ( ABS(A(p,p)) .LT. SMALL ) .OR. - $ ( L2KILL .AND. (ABS(A(p,p)) .LT. TEMP1) ) ) GO TO 3302 - NR = NR + 1 - 3301 CONTINUE - 3302 CONTINUE -* - END IF -* - ALMORT = .FALSE. - IF ( NR .EQ. N ) THEN - MAXPRJ = ONE - DO 3051 p = 2, N - TEMP1 = ABS(A(p,p)) / SVA(IWORK(p)) - MAXPRJ = MIN( MAXPRJ, TEMP1 ) - 3051 CONTINUE - IF ( MAXPRJ**2 .GE. ONE - REAL(N)*EPSLN ) ALMORT = .TRUE. - END IF -* -* - SCONDA = - ONE - CONDR1 = - ONE - CONDR2 = - ONE -* - IF ( ERREST ) THEN - IF ( N .EQ. NR ) THEN - IF ( RSVEC ) THEN -* .. V is available as workspace - CALL CLACPY( 'U', N, N, A, LDA, V, LDV ) - DO 3053 p = 1, N - TEMP1 = SVA(IWORK(p)) - CALL CSSCAL( p, ONE/TEMP1, V(1,p), 1 ) - 3053 CONTINUE - IF ( LSVEC )THEN - CALL CPOCON( 'U', N, V, LDV, ONE, TEMP1, - $ CWORK(N+1), RWORK, IERR ) - ELSE - CALL CPOCON( 'U', N, V, LDV, ONE, TEMP1, - $ CWORK, RWORK, IERR ) - END IF -* - ELSE IF ( LSVEC ) THEN -* .. U is available as workspace - CALL CLACPY( 'U', N, N, A, LDA, U, LDU ) - DO 3054 p = 1, N - TEMP1 = SVA(IWORK(p)) - CALL CSSCAL( p, ONE/TEMP1, U(1,p), 1 ) - 3054 CONTINUE - CALL CPOCON( 'U', N, U, LDU, ONE, TEMP1, - $ CWORK(N+1), RWORK, IERR ) - ELSE - CALL CLACPY( 'U', N, N, A, LDA, CWORK, N ) -*[] CALL CLACPY( 'U', N, N, A, LDA, CWORK(N+1), N ) -* Change: here index shifted by N to the left, CWORK(1:N) -* not needed for SIGMA only computation - DO 3052 p = 1, N - TEMP1 = SVA(IWORK(p)) -*[] CALL CSSCAL( p, ONE/TEMP1, CWORK(N+(p-1)*N+1), 1 ) - CALL CSSCAL( p, ONE/TEMP1, CWORK((p-1)*N+1), 1 ) - 3052 CONTINUE -* .. the columns of R are scaled to have unit Euclidean lengths. -*[] CALL CPOCON( 'U', N, CWORK(N+1), N, ONE, TEMP1, -*[] $ CWORK(N+N*N+1), RWORK, IERR ) - CALL CPOCON( 'U', N, CWORK, N, ONE, TEMP1, - $ CWORK(N*N+1), RWORK, IERR ) -* - END IF - IF ( TEMP1 .NE. ZERO ) THEN - SCONDA = ONE / SQRT(TEMP1) - ELSE - SCONDA = - ONE - END IF -* SCONDA is an estimate of SQRT(||(R^* * R)^(-1)||_1). -* N^(-1/4) * SCONDA <= ||R^(-1)||_2 <= N^(1/4) * SCONDA - ELSE - SCONDA = - ONE - END IF - END IF -* - L2PERT = L2PERT .AND. ( ABS( A(1,1)/A(NR,NR) ) .GT. SQRT(BIG1) ) -* If there is no violent scaling, artificial perturbation is not needed. -* -* Phase 3: -* - IF ( .NOT. ( RSVEC .OR. LSVEC ) ) THEN -* -* Singular Values only -* -* .. transpose A(1:NR,1:N) - DO 1946 p = 1, MIN( N-1, NR ) - CALL CCOPY( N-p, A(p,p+1), LDA, A(p+1,p), 1 ) - CALL CLACGV( N-p+1, A(p,p), 1 ) - 1946 CONTINUE - IF ( NR .EQ. N ) A(N,N) = CONJG(A(N,N)) -* -* The following two DO-loops introduce small relative perturbation -* into the strict upper triangle of the lower triangular matrix. -* Small entries below the main diagonal are also changed. -* This modification is useful if the computing environment does not -* provide/allow FLUSH TO ZERO underflow, for it prevents many -* annoying denormalized numbers in case of strongly scaled matrices. -* The perturbation is structured so that it does not introduce any -* new perturbation of the singular values, and it does not destroy -* the job done by the preconditioner. -* The licence for this perturbation is in the variable L2PERT, which -* should be .FALSE. if FLUSH TO ZERO underflow is active. -* - IF ( .NOT. ALMORT ) THEN -* - IF ( L2PERT ) THEN -* XSC = SQRT(SMALL) - XSC = EPSLN / REAL(N) - DO 4947 q = 1, NR - CTEMP = CMPLX(XSC*ABS(A(q,q)),ZERO) - DO 4949 p = 1, N - IF ( ( (p.GT.q) .AND. (ABS(A(p,q)).LE.TEMP1) ) - $ .OR. ( p .LT. q ) ) -* $ A(p,q) = TEMP1 * ( A(p,q) / ABS(A(p,q)) ) - $ A(p,q) = CTEMP - 4949 CONTINUE - 4947 CONTINUE - ELSE - CALL CLASET( 'U', NR-1,NR-1, CZERO,CZERO, A(1,2),LDA ) - END IF -* -* .. second preconditioning using the QR factorization -* - CALL CGEQRF( N,NR, A,LDA, CWORK, CWORK(N+1),LWORK-N, IERR ) -* -* .. and transpose upper to lower triangular - DO 1948 p = 1, NR - 1 - CALL CCOPY( NR-p, A(p,p+1), LDA, A(p+1,p), 1 ) - CALL CLACGV( NR-p+1, A(p,p), 1 ) - 1948 CONTINUE -* - END IF -* -* Row-cyclic Jacobi SVD algorithm with column pivoting -* -* .. again some perturbation (a "background noise") is added -* to drown denormals - IF ( L2PERT ) THEN -* XSC = SQRT(SMALL) - XSC = EPSLN / REAL(N) - DO 1947 q = 1, NR - CTEMP = CMPLX(XSC*ABS(A(q,q)),ZERO) - DO 1949 p = 1, NR - IF ( ( (p.GT.q) .AND. (ABS(A(p,q)).LE.TEMP1) ) - $ .OR. ( p .LT. q ) ) -* $ A(p,q) = TEMP1 * ( A(p,q) / ABS(A(p,q)) ) - $ A(p,q) = CTEMP - 1949 CONTINUE - 1947 CONTINUE - ELSE - CALL CLASET( 'U', NR-1, NR-1, CZERO, CZERO, A(1,2), LDA ) - END IF -* -* .. and one-sided Jacobi rotations are started on a lower -* triangular matrix (plus perturbation which is ignored in -* the part which destroys triangular form (confusing?!)) -* - CALL CGESVJ( 'L', 'N', 'N', NR, NR, A, LDA, SVA, - $ N, V, LDV, CWORK, LWORK, RWORK, LRWORK, INFO ) -* - SCALEM = RWORK(1) - NUMRANK = NINT(RWORK(2)) -* -* - ELSE IF ( ( RSVEC .AND. ( .NOT. LSVEC ) .AND. ( .NOT. JRACC ) ) - $ .OR. - $ ( JRACC .AND. ( .NOT. LSVEC ) .AND. ( NR .NE. N ) ) ) THEN -* -* -> Singular Values and Right Singular Vectors <- -* - IF ( ALMORT ) THEN -* -* .. in this case NR equals N - DO 1998 p = 1, NR - CALL CCOPY( N-p+1, A(p,p), LDA, V(p,p), 1 ) - CALL CLACGV( N-p+1, V(p,p), 1 ) - 1998 CONTINUE - CALL CLASET( 'U', NR-1,NR-1, CZERO, CZERO, V(1,2), LDV ) -* - CALL CGESVJ( 'L','U','N', N, NR, V, LDV, SVA, NR, A, LDA, - $ CWORK, LWORK, RWORK, LRWORK, INFO ) - SCALEM = RWORK(1) - NUMRANK = NINT(RWORK(2)) - - ELSE -* -* .. two more QR factorizations ( one QRF is not enough, two require -* accumulated product of Jacobi rotations, three are perfect ) -* - CALL CLASET( 'L', NR-1,NR-1, CZERO, CZERO, A(2,1), LDA ) - CALL CGELQF( NR,N, A, LDA, CWORK, CWORK(N+1), LWORK-N, IERR) - CALL CLACPY( 'L', NR, NR, A, LDA, V, LDV ) - CALL CLASET( 'U', NR-1,NR-1, CZERO, CZERO, V(1,2), LDV ) - CALL CGEQRF( NR, NR, V, LDV, CWORK(N+1), CWORK(2*N+1), - $ LWORK-2*N, IERR ) - DO 8998 p = 1, NR - CALL CCOPY( NR-p+1, V(p,p), LDV, V(p,p), 1 ) - CALL CLACGV( NR-p+1, V(p,p), 1 ) - 8998 CONTINUE - CALL CLASET('U', NR-1, NR-1, CZERO, CZERO, V(1,2), LDV) -* - CALL CGESVJ( 'L', 'U','N', NR, NR, V,LDV, SVA, NR, U, - $ LDU, CWORK(N+1), LWORK-N, RWORK, LRWORK, INFO ) - SCALEM = RWORK(1) - NUMRANK = NINT(RWORK(2)) - IF ( NR .LT. N ) THEN - CALL CLASET( 'A',N-NR, NR, CZERO,CZERO, V(NR+1,1), LDV ) - CALL CLASET( 'A',NR, N-NR, CZERO,CZERO, V(1,NR+1), LDV ) - CALL CLASET( 'A',N-NR,N-NR,CZERO,CONE, V(NR+1,NR+1),LDV ) - END IF -* - CALL CUNMLQ( 'L', 'C', N, N, NR, A, LDA, CWORK, - $ V, LDV, CWORK(N+1), LWORK-N, IERR ) -* - END IF -* .. permute the rows of V -* DO 8991 p = 1, N -* CALL CCOPY( N, V(p,1), LDV, A(IWORK(p),1), LDA ) -* 8991 CONTINUE -* CALL CLACPY( 'All', N, N, A, LDA, V, LDV ) - CALL CLAPMR( .FALSE., N, N, V, LDV, IWORK ) -* - IF ( TRANSP ) THEN - CALL CLACPY( 'A', N, N, V, LDV, U, LDU ) - END IF -* - ELSE IF ( JRACC .AND. (.NOT. LSVEC) .AND. ( NR.EQ. N ) ) THEN -* - CALL CLASET( 'L', N-1,N-1, CZERO, CZERO, A(2,1), LDA ) -* - CALL CGESVJ( 'U','N','V', N, N, A, LDA, SVA, N, V, LDV, - $ CWORK, LWORK, RWORK, LRWORK, INFO ) - SCALEM = RWORK(1) - NUMRANK = NINT(RWORK(2)) - CALL CLAPMR( .FALSE., N, N, V, LDV, IWORK ) -* - ELSE IF ( LSVEC .AND. ( .NOT. RSVEC ) ) THEN -* -* .. Singular Values and Left Singular Vectors .. -* -* .. second preconditioning step to avoid need to accumulate -* Jacobi rotations in the Jacobi iterations. - DO 1965 p = 1, NR - CALL CCOPY( N-p+1, A(p,p), LDA, U(p,p), 1 ) - CALL CLACGV( N-p+1, U(p,p), 1 ) - 1965 CONTINUE - CALL CLASET( 'U', NR-1, NR-1, CZERO, CZERO, U(1,2), LDU ) -* - CALL CGEQRF( N, NR, U, LDU, CWORK(N+1), CWORK(2*N+1), - $ LWORK-2*N, IERR ) -* - DO 1967 p = 1, NR - 1 - CALL CCOPY( NR-p, U(p,p+1), LDU, U(p+1,p), 1 ) - CALL CLACGV( N-p+1, U(p,p), 1 ) - 1967 CONTINUE - CALL CLASET( 'U', NR-1, NR-1, CZERO, CZERO, U(1,2), LDU ) -* - CALL CGESVJ( 'L', 'U', 'N', NR,NR, U, LDU, SVA, NR, A, - $ LDA, CWORK(N+1), LWORK-N, RWORK, LRWORK, INFO ) - SCALEM = RWORK(1) - NUMRANK = NINT(RWORK(2)) -* - IF ( NR .LT. M ) THEN - CALL CLASET( 'A', M-NR, NR,CZERO, CZERO, U(NR+1,1), LDU ) - IF ( NR .LT. N1 ) THEN - CALL CLASET( 'A',NR, N1-NR, CZERO, CZERO, U(1,NR+1),LDU ) - CALL CLASET( 'A',M-NR,N1-NR,CZERO,CONE,U(NR+1,NR+1),LDU ) - END IF - END IF -* - CALL CUNMQR( 'L', 'N', M, N1, N, A, LDA, CWORK, U, - $ LDU, CWORK(N+1), LWORK-N, IERR ) -* - IF ( ROWPIV ) - $ CALL CLASWP( N1, U, LDU, 1, M-1, IWORK(IWOFF+1), -1 ) -* - DO 1974 p = 1, N1 - XSC = ONE / SCNRM2( M, U(1,p), 1 ) - CALL CSSCAL( M, XSC, U(1,p), 1 ) - 1974 CONTINUE -* - IF ( TRANSP ) THEN - CALL CLACPY( 'A', N, N, U, LDU, V, LDV ) - END IF -* - ELSE -* -* .. Full SVD .. -* - IF ( .NOT. JRACC ) THEN -* - IF ( .NOT. ALMORT ) THEN -* -* Second Preconditioning Step (QRF [with pivoting]) -* Note that the composition of TRANSPOSE, QRF and TRANSPOSE is -* equivalent to an LQF CALL. Since in many libraries the QRF -* seems to be better optimized than the LQF, we do explicit -* transpose and use the QRF. This is subject to changes in an -* optimized implementation of CGEJSV. -* - DO 1968 p = 1, NR - CALL CCOPY( N-p+1, A(p,p), LDA, V(p,p), 1 ) - CALL CLACGV( N-p+1, V(p,p), 1 ) - 1968 CONTINUE -* -* .. the following two loops perturb small entries to avoid -* denormals in the second QR factorization, where they are -* as good as zeros. This is done to avoid painfully slow -* computation with denormals. The relative size of the perturbation -* is a parameter that can be changed by the implementer. -* This perturbation device will be obsolete on machines with -* properly implemented arithmetic. -* To switch it off, set L2PERT=.FALSE. To remove it from the -* code, remove the action under L2PERT=.TRUE., leave the ELSE part. -* The following two loops should be blocked and fused with the -* transposed copy above. -* - IF ( L2PERT ) THEN - XSC = SQRT(SMALL) - DO 2969 q = 1, NR - CTEMP = CMPLX(XSC*ABS( V(q,q) ),ZERO) - DO 2968 p = 1, N - IF ( ( p .GT. q ) .AND. ( ABS(V(p,q)) .LE. TEMP1 ) - $ .OR. ( p .LT. q ) ) -* $ V(p,q) = TEMP1 * ( V(p,q) / ABS(V(p,q)) ) - $ V(p,q) = CTEMP - IF ( p .LT. q ) V(p,q) = - V(p,q) - 2968 CONTINUE - 2969 CONTINUE - ELSE - CALL CLASET( 'U', NR-1, NR-1, CZERO, CZERO, V(1,2), LDV ) - END IF -* -* Estimate the row scaled condition number of R1 -* (If R1 is rectangular, N > NR, then the condition number -* of the leading NR x NR submatrix is estimated.) -* - CALL CLACPY( 'L', NR, NR, V, LDV, CWORK(2*N+1), NR ) - DO 3950 p = 1, NR - TEMP1 = SCNRM2(NR-p+1,CWORK(2*N+(p-1)*NR+p),1) - CALL CSSCAL(NR-p+1,ONE/TEMP1,CWORK(2*N+(p-1)*NR+p),1) - 3950 CONTINUE - CALL CPOCON('L',NR,CWORK(2*N+1),NR,ONE,TEMP1, - $ CWORK(2*N+NR*NR+1),RWORK,IERR) - CONDR1 = ONE / SQRT(TEMP1) -* .. here need a second opinion on the condition number -* .. then assume worst case scenario -* R1 is OK for inverse <=> CONDR1 .LT. REAL(N) -* more conservative <=> CONDR1 .LT. SQRT(REAL(N)) -* - COND_OK = SQRT(SQRT(REAL(NR))) -*[TP] COND_OK is a tuning parameter. -* - IF ( CONDR1 .LT. COND_OK ) THEN -* .. the second QRF without pivoting. Note: in an optimized -* implementation, this QRF should be implemented as the QRF -* of a lower triangular matrix. -* R1^* = Q2 * R2 - CALL CGEQRF( N, NR, V, LDV, CWORK(N+1), CWORK(2*N+1), - $ LWORK-2*N, IERR ) -* - IF ( L2PERT ) THEN - XSC = SQRT(SMALL)/EPSLN - DO 3959 p = 2, NR - DO 3958 q = 1, p - 1 - CTEMP=CMPLX(XSC*MIN(ABS(V(p,p)),ABS(V(q,q))), - $ ZERO) - IF ( ABS(V(q,p)) .LE. TEMP1 ) -* $ V(q,p) = TEMP1 * ( V(q,p) / ABS(V(q,p)) ) - $ V(q,p) = CTEMP - 3958 CONTINUE - 3959 CONTINUE - END IF -* - IF ( NR .NE. N ) - $ CALL CLACPY( 'A', N, NR, V, LDV, CWORK(2*N+1), N ) -* .. save ... -* -* .. this transposed copy should be better than naive - DO 1969 p = 1, NR - 1 - CALL CCOPY( NR-p, V(p,p+1), LDV, V(p+1,p), 1 ) - CALL CLACGV(NR-p+1, V(p,p), 1 ) - 1969 CONTINUE - V(NR,NR)=CONJG(V(NR,NR)) -* - CONDR2 = CONDR1 -* - ELSE -* -* .. ill-conditioned case: second QRF with pivoting -* Note that windowed pivoting would be equally good -* numerically, and more run-time efficient. So, in -* an optimal implementation, the next call to CGEQP3 -* should be replaced with eg. CALL CGEQPX (ACM TOMS #782) -* with properly (carefully) chosen parameters. -* -* R1^* * P2 = Q2 * R2 - DO 3003 p = 1, NR - IWORK(N+p) = 0 - 3003 CONTINUE - CALL CGEQP3( N, NR, V, LDV, IWORK(N+1), CWORK(N+1), - $ CWORK(2*N+1), LWORK-2*N, RWORK, IERR ) -** CALL CGEQRF( N, NR, V, LDV, CWORK(N+1), CWORK(2*N+1), -** $ LWORK-2*N, IERR ) - IF ( L2PERT ) THEN - XSC = SQRT(SMALL) - DO 3969 p = 2, NR - DO 3968 q = 1, p - 1 - CTEMP=CMPLX(XSC*MIN(ABS(V(p,p)),ABS(V(q,q))), - $ ZERO) - IF ( ABS(V(q,p)) .LE. TEMP1 ) -* $ V(q,p) = TEMP1 * ( V(q,p) / ABS(V(q,p)) ) - $ V(q,p) = CTEMP - 3968 CONTINUE - 3969 CONTINUE - END IF -* - CALL CLACPY( 'A', N, NR, V, LDV, CWORK(2*N+1), N ) -* - IF ( L2PERT ) THEN - XSC = SQRT(SMALL) - DO 8970 p = 2, NR - DO 8971 q = 1, p - 1 - CTEMP=CMPLX(XSC*MIN(ABS(V(p,p)),ABS(V(q,q))), - $ ZERO) -* V(p,q) = - TEMP1*( V(q,p) / ABS(V(q,p)) ) - V(p,q) = - CTEMP - 8971 CONTINUE - 8970 CONTINUE - ELSE - CALL CLASET( 'L',NR-1,NR-1,CZERO,CZERO,V(2,1),LDV ) - END IF -* Now, compute R2 = L3 * Q3, the LQ factorization. - CALL CGELQF( NR, NR, V, LDV, CWORK(2*N+N*NR+1), - $ CWORK(2*N+N*NR+NR+1), LWORK-2*N-N*NR-NR, IERR ) -* .. and estimate the condition number - CALL CLACPY( 'L',NR,NR,V,LDV,CWORK(2*N+N*NR+NR+1),NR ) - DO 4950 p = 1, NR - TEMP1 = SCNRM2( p, CWORK(2*N+N*NR+NR+p), NR ) - CALL CSSCAL( p, ONE/TEMP1, CWORK(2*N+N*NR+NR+p), NR ) - 4950 CONTINUE - CALL CPOCON( 'L',NR,CWORK(2*N+N*NR+NR+1),NR,ONE,TEMP1, - $ CWORK(2*N+N*NR+NR+NR*NR+1),RWORK,IERR ) - CONDR2 = ONE / SQRT(TEMP1) -* -* - IF ( CONDR2 .GE. COND_OK ) THEN -* .. save the Householder vectors used for Q3 -* (this overwrites the copy of R2, as it will not be -* needed in this branch, but it does not overwritte the -* Huseholder vectors of Q2.). - CALL CLACPY( 'U', NR, NR, V, LDV, CWORK(2*N+1), N ) -* .. and the rest of the information on Q3 is in -* WORK(2*N+N*NR+1:2*N+N*NR+N) - END IF -* - END IF -* - IF ( L2PERT ) THEN - XSC = SQRT(SMALL) - DO 4968 q = 2, NR - CTEMP = XSC * V(q,q) - DO 4969 p = 1, q - 1 -* V(p,q) = - TEMP1*( V(p,q) / ABS(V(p,q)) ) - V(p,q) = - CTEMP - 4969 CONTINUE - 4968 CONTINUE - ELSE - CALL CLASET( 'U', NR-1,NR-1, CZERO,CZERO, V(1,2), LDV ) - END IF -* -* Second preconditioning finished; continue with Jacobi SVD -* The input matrix is lower trinagular. -* -* Recover the right singular vectors as solution of a well -* conditioned triangular matrix equation. -* - IF ( CONDR1 .LT. COND_OK ) THEN -* - CALL CGESVJ( 'L','U','N',NR,NR,V,LDV,SVA,NR,U, LDU, - $ CWORK(2*N+N*NR+NR+1),LWORK-2*N-N*NR-NR,RWORK, - $ LRWORK, INFO ) - SCALEM = RWORK(1) - NUMRANK = NINT(RWORK(2)) - DO 3970 p = 1, NR - CALL CCOPY( NR, V(1,p), 1, U(1,p), 1 ) - CALL CSSCAL( NR, SVA(p), V(1,p), 1 ) - 3970 CONTINUE - -* .. pick the right matrix equation and solve it -* - IF ( NR .EQ. N ) THEN -* :)) .. best case, R1 is inverted. The solution of this matrix -* equation is Q2*V2 = the product of the Jacobi rotations -* used in CGESVJ, premultiplied with the orthogonal matrix -* from the second QR factorization. - CALL CTRSM('L','U','N','N', NR,NR,CONE, A,LDA, V,LDV) - ELSE -* .. R1 is well conditioned, but non-square. Adjoint of R2 -* is inverted to get the product of the Jacobi rotations -* used in CGESVJ. The Q-factor from the second QR -* factorization is then built in explicitly. - CALL CTRSM('L','U','C','N',NR,NR,CONE,CWORK(2*N+1), - $ N,V,LDV) - IF ( NR .LT. N ) THEN - CALL CLASET('A',N-NR,NR,CZERO,CZERO,V(NR+1,1),LDV) - CALL CLASET('A',NR,N-NR,CZERO,CZERO,V(1,NR+1),LDV) - CALL CLASET('A',N-NR,N-NR,CZERO,CONE,V(NR+1,NR+1),LDV) - END IF - CALL CUNMQR('L','N',N,N,NR,CWORK(2*N+1),N,CWORK(N+1), - $ V,LDV,CWORK(2*N+N*NR+NR+1),LWORK-2*N-N*NR-NR,IERR) - END IF -* - ELSE IF ( CONDR2 .LT. COND_OK ) THEN -* -* The matrix R2 is inverted. The solution of the matrix equation -* is Q3^* * V3 = the product of the Jacobi rotations (appplied to -* the lower triangular L3 from the LQ factorization of -* R2=L3*Q3), pre-multiplied with the transposed Q3. - CALL CGESVJ( 'L', 'U', 'N', NR, NR, V, LDV, SVA, NR, U, - $ LDU, CWORK(2*N+N*NR+NR+1), LWORK-2*N-N*NR-NR, - $ RWORK, LRWORK, INFO ) - SCALEM = RWORK(1) - NUMRANK = NINT(RWORK(2)) - DO 3870 p = 1, NR - CALL CCOPY( NR, V(1,p), 1, U(1,p), 1 ) - CALL CSSCAL( NR, SVA(p), U(1,p), 1 ) - 3870 CONTINUE - CALL CTRSM('L','U','N','N',NR,NR,CONE,CWORK(2*N+1),N, - $ U,LDU) -* .. apply the permutation from the second QR factorization - DO 873 q = 1, NR - DO 872 p = 1, NR - CWORK(2*N+N*NR+NR+IWORK(N+p)) = U(p,q) - 872 CONTINUE - DO 874 p = 1, NR - U(p,q) = CWORK(2*N+N*NR+NR+p) - 874 CONTINUE - 873 CONTINUE - IF ( NR .LT. N ) THEN - CALL CLASET( 'A',N-NR,NR,CZERO,CZERO,V(NR+1,1),LDV ) - CALL CLASET( 'A',NR,N-NR,CZERO,CZERO,V(1,NR+1),LDV ) - CALL CLASET('A',N-NR,N-NR,CZERO,CONE,V(NR+1,NR+1),LDV) - END IF - CALL CUNMQR( 'L','N',N,N,NR,CWORK(2*N+1),N,CWORK(N+1), - $ V,LDV,CWORK(2*N+N*NR+NR+1),LWORK-2*N-N*NR-NR,IERR ) - ELSE -* Last line of defense. -* #:( This is a rather pathological case: no scaled condition -* improvement after two pivoted QR factorizations. Other -* possibility is that the rank revealing QR factorization -* or the condition estimator has failed, or the COND_OK -* is set very close to ONE (which is unnecessary). Normally, -* this branch should never be executed, but in rare cases of -* failure of the RRQR or condition estimator, the last line of -* defense ensures that CGEJSV completes the task. -* Compute the full SVD of L3 using CGESVJ with explicit -* accumulation of Jacobi rotations. - CALL CGESVJ( 'L', 'U', 'V', NR, NR, V, LDV, SVA, NR, U, - $ LDU, CWORK(2*N+N*NR+NR+1), LWORK-2*N-N*NR-NR, - $ RWORK, LRWORK, INFO ) - SCALEM = RWORK(1) - NUMRANK = NINT(RWORK(2)) - IF ( NR .LT. N ) THEN - CALL CLASET( 'A',N-NR,NR,CZERO,CZERO,V(NR+1,1),LDV ) - CALL CLASET( 'A',NR,N-NR,CZERO,CZERO,V(1,NR+1),LDV ) - CALL CLASET('A',N-NR,N-NR,CZERO,CONE,V(NR+1,NR+1),LDV) - END IF - CALL CUNMQR( 'L','N',N,N,NR,CWORK(2*N+1),N,CWORK(N+1), - $ V,LDV,CWORK(2*N+N*NR+NR+1),LWORK-2*N-N*NR-NR,IERR ) -* - CALL CUNMLQ( 'L', 'C', NR, NR, NR, CWORK(2*N+1), N, - $ CWORK(2*N+N*NR+1), U, LDU, CWORK(2*N+N*NR+NR+1), - $ LWORK-2*N-N*NR-NR, IERR ) - DO 773 q = 1, NR - DO 772 p = 1, NR - CWORK(2*N+N*NR+NR+IWORK(N+p)) = U(p,q) - 772 CONTINUE - DO 774 p = 1, NR - U(p,q) = CWORK(2*N+N*NR+NR+p) - 774 CONTINUE - 773 CONTINUE -* - END IF -* -* Permute the rows of V using the (column) permutation from the -* first QRF. Also, scale the columns to make them unit in -* Euclidean norm. This applies to all cases. -* - TEMP1 = SQRT(REAL(N)) * EPSLN - DO 1972 q = 1, N - DO 972 p = 1, N - CWORK(2*N+N*NR+NR+IWORK(p)) = V(p,q) - 972 CONTINUE - DO 973 p = 1, N - V(p,q) = CWORK(2*N+N*NR+NR+p) - 973 CONTINUE - XSC = ONE / SCNRM2( N, V(1,q), 1 ) - IF ( (XSC .LT. (ONE-TEMP1)) .OR. (XSC .GT. (ONE+TEMP1)) ) - $ CALL CSSCAL( N, XSC, V(1,q), 1 ) - 1972 CONTINUE -* At this moment, V contains the right singular vectors of A. -* Next, assemble the left singular vector matrix U (M x N). - IF ( NR .LT. M ) THEN - CALL CLASET('A', M-NR, NR, CZERO, CZERO, U(NR+1,1), LDU) - IF ( NR .LT. N1 ) THEN - CALL CLASET('A',NR,N1-NR,CZERO,CZERO,U(1,NR+1),LDU) - CALL CLASET('A',M-NR,N1-NR,CZERO,CONE, - $ U(NR+1,NR+1),LDU) - END IF - END IF -* -* The Q matrix from the first QRF is built into the left singular -* matrix U. This applies to all cases. -* - CALL CUNMQR( 'L', 'N', M, N1, N, A, LDA, CWORK, U, - $ LDU, CWORK(N+1), LWORK-N, IERR ) - -* The columns of U are normalized. The cost is O(M*N) flops. - TEMP1 = SQRT(REAL(M)) * EPSLN - DO 1973 p = 1, NR - XSC = ONE / SCNRM2( M, U(1,p), 1 ) - IF ( (XSC .LT. (ONE-TEMP1)) .OR. (XSC .GT. (ONE+TEMP1)) ) - $ CALL CSSCAL( M, XSC, U(1,p), 1 ) - 1973 CONTINUE -* -* If the initial QRF is computed with row pivoting, the left -* singular vectors must be adjusted. -* - IF ( ROWPIV ) - $ CALL CLASWP( N1, U, LDU, 1, M-1, IWORK(IWOFF+1), -1 ) -* - ELSE -* -* .. the initial matrix A has almost orthogonal columns and -* the second QRF is not needed -* - CALL CLACPY( 'U', N, N, A, LDA, CWORK(N+1), N ) - IF ( L2PERT ) THEN - XSC = SQRT(SMALL) - DO 5970 p = 2, N - CTEMP = XSC * CWORK( N + (p-1)*N + p ) - DO 5971 q = 1, p - 1 -* CWORK(N+(q-1)*N+p)=-TEMP1 * ( CWORK(N+(p-1)*N+q) / -* $ ABS(CWORK(N+(p-1)*N+q)) ) - CWORK(N+(q-1)*N+p)=-CTEMP - 5971 CONTINUE - 5970 CONTINUE - ELSE - CALL CLASET( 'L',N-1,N-1,CZERO,CZERO,CWORK(N+2),N ) - END IF -* - CALL CGESVJ( 'U', 'U', 'N', N, N, CWORK(N+1), N, SVA, - $ N, U, LDU, CWORK(N+N*N+1), LWORK-N-N*N, RWORK, LRWORK, - $ INFO ) -* - SCALEM = RWORK(1) - NUMRANK = NINT(RWORK(2)) - DO 6970 p = 1, N - CALL CCOPY( N, CWORK(N+(p-1)*N+1), 1, U(1,p), 1 ) - CALL CSSCAL( N, SVA(p), CWORK(N+(p-1)*N+1), 1 ) - 6970 CONTINUE -* - CALL CTRSM( 'L', 'U', 'N', 'N', N, N, - $ CONE, A, LDA, CWORK(N+1), N ) - DO 6972 p = 1, N - CALL CCOPY( N, CWORK(N+p), N, V(IWORK(p),1), LDV ) - 6972 CONTINUE - TEMP1 = SQRT(REAL(N))*EPSLN - DO 6971 p = 1, N - XSC = ONE / SCNRM2( N, V(1,p), 1 ) - IF ( (XSC .LT. (ONE-TEMP1)) .OR. (XSC .GT. (ONE+TEMP1)) ) - $ CALL CSSCAL( N, XSC, V(1,p), 1 ) - 6971 CONTINUE -* -* Assemble the left singular vector matrix U (M x N). -* - IF ( N .LT. M ) THEN - CALL CLASET( 'A', M-N, N, CZERO, CZERO, U(N+1,1), LDU ) - IF ( N .LT. N1 ) THEN - CALL CLASET('A',N, N1-N, CZERO, CZERO, U(1,N+1),LDU) - CALL CLASET( 'A',M-N,N1-N, CZERO, CONE,U(N+1,N+1),LDU) - END IF - END IF - CALL CUNMQR( 'L', 'N', M, N1, N, A, LDA, CWORK, U, - $ LDU, CWORK(N+1), LWORK-N, IERR ) - TEMP1 = SQRT(REAL(M))*EPSLN - DO 6973 p = 1, N1 - XSC = ONE / SCNRM2( M, U(1,p), 1 ) - IF ( (XSC .LT. (ONE-TEMP1)) .OR. (XSC .GT. (ONE+TEMP1)) ) - $ CALL CSSCAL( M, XSC, U(1,p), 1 ) - 6973 CONTINUE -* - IF ( ROWPIV ) - $ CALL CLASWP( N1, U, LDU, 1, M-1, IWORK(IWOFF+1), -1 ) -* - END IF -* -* end of the >> almost orthogonal case << in the full SVD -* - ELSE -* -* This branch deploys a preconditioned Jacobi SVD with explicitly -* accumulated rotations. It is included as optional, mainly for -* experimental purposes. It does perform well, and can also be used. -* In this implementation, this branch will be automatically activated -* if the condition number sigma_max(A) / sigma_min(A) is predicted -* to be greater than the overflow threshold. This is because the -* a posteriori computation of the singular vectors assumes robust -* implementation of BLAS and some LAPACK procedures, capable of working -* in presence of extreme values, e.g. when the singular values spread from -* the underflow to the overflow threshold. -* - DO 7968 p = 1, NR - CALL CCOPY( N-p+1, A(p,p), LDA, V(p,p), 1 ) - CALL CLACGV( N-p+1, V(p,p), 1 ) - 7968 CONTINUE -* - IF ( L2PERT ) THEN - XSC = SQRT(SMALL/EPSLN) - DO 5969 q = 1, NR - CTEMP = CMPLX(XSC*ABS( V(q,q) ),ZERO) - DO 5968 p = 1, N - IF ( ( p .GT. q ) .AND. ( ABS(V(p,q)) .LE. TEMP1 ) - $ .OR. ( p .LT. q ) ) -* $ V(p,q) = TEMP1 * ( V(p,q) / ABS(V(p,q)) ) - $ V(p,q) = CTEMP - IF ( p .LT. q ) V(p,q) = - V(p,q) - 5968 CONTINUE - 5969 CONTINUE - ELSE - CALL CLASET( 'U', NR-1, NR-1, CZERO, CZERO, V(1,2), LDV ) - END IF - - CALL CGEQRF( N, NR, V, LDV, CWORK(N+1), CWORK(2*N+1), - $ LWORK-2*N, IERR ) - CALL CLACPY( 'L', N, NR, V, LDV, CWORK(2*N+1), N ) -* - DO 7969 p = 1, NR - CALL CCOPY( NR-p+1, V(p,p), LDV, U(p,p), 1 ) - CALL CLACGV( NR-p+1, U(p,p), 1 ) - 7969 CONTINUE - - IF ( L2PERT ) THEN - XSC = SQRT(SMALL/EPSLN) - DO 9970 q = 2, NR - DO 9971 p = 1, q - 1 - CTEMP = CMPLX(XSC * MIN(ABS(U(p,p)),ABS(U(q,q))), - $ ZERO) -* U(p,q) = - TEMP1 * ( U(q,p) / ABS(U(q,p)) ) - U(p,q) = - CTEMP - 9971 CONTINUE - 9970 CONTINUE - ELSE - CALL CLASET('U', NR-1, NR-1, CZERO, CZERO, U(1,2), LDU ) - END IF - - CALL CGESVJ( 'L', 'U', 'V', NR, NR, U, LDU, SVA, - $ N, V, LDV, CWORK(2*N+N*NR+1), LWORK-2*N-N*NR, - $ RWORK, LRWORK, INFO ) - SCALEM = RWORK(1) - NUMRANK = NINT(RWORK(2)) - - IF ( NR .LT. N ) THEN - CALL CLASET( 'A',N-NR,NR,CZERO,CZERO,V(NR+1,1),LDV ) - CALL CLASET( 'A',NR,N-NR,CZERO,CZERO,V(1,NR+1),LDV ) - CALL CLASET( 'A',N-NR,N-NR,CZERO,CONE,V(NR+1,NR+1),LDV ) - END IF - - CALL CUNMQR( 'L','N',N,N,NR,CWORK(2*N+1),N,CWORK(N+1), - $ V,LDV,CWORK(2*N+N*NR+NR+1),LWORK-2*N-N*NR-NR,IERR ) -* -* Permute the rows of V using the (column) permutation from the -* first QRF. Also, scale the columns to make them unit in -* Euclidean norm. This applies to all cases. -* - TEMP1 = SQRT(REAL(N)) * EPSLN - DO 7972 q = 1, N - DO 8972 p = 1, N - CWORK(2*N+N*NR+NR+IWORK(p)) = V(p,q) - 8972 CONTINUE - DO 8973 p = 1, N - V(p,q) = CWORK(2*N+N*NR+NR+p) - 8973 CONTINUE - XSC = ONE / SCNRM2( N, V(1,q), 1 ) - IF ( (XSC .LT. (ONE-TEMP1)) .OR. (XSC .GT. (ONE+TEMP1)) ) - $ CALL CSSCAL( N, XSC, V(1,q), 1 ) - 7972 CONTINUE -* -* At this moment, V contains the right singular vectors of A. -* Next, assemble the left singular vector matrix U (M x N). -* - IF ( NR .LT. M ) THEN - CALL CLASET( 'A', M-NR, NR, CZERO, CZERO, U(NR+1,1), LDU ) - IF ( NR .LT. N1 ) THEN - CALL CLASET('A',NR, N1-NR, CZERO, CZERO, U(1,NR+1),LDU) - CALL CLASET('A',M-NR,N1-NR, CZERO, CONE,U(NR+1,NR+1),LDU) - END IF - END IF -* - CALL CUNMQR( 'L', 'N', M, N1, N, A, LDA, CWORK, U, - $ LDU, CWORK(N+1), LWORK-N, IERR ) -* - IF ( ROWPIV ) - $ CALL CLASWP( N1, U, LDU, 1, M-1, IWORK(IWOFF+1), -1 ) -* -* - END IF - IF ( TRANSP ) THEN -* .. swap U and V because the procedure worked on A^* - DO 6974 p = 1, N - CALL CSWAP( N, U(1,p), 1, V(1,p), 1 ) - 6974 CONTINUE - END IF -* - END IF -* end of the full SVD -* -* Undo scaling, if necessary (and possible) -* - IF ( USCAL2 .LE. (BIG/SVA(1))*USCAL1 ) THEN - CALL SLASCL( 'G', 0, 0, USCAL1, USCAL2, NR, 1, SVA, N, IERR ) - USCAL1 = ONE - USCAL2 = ONE - END IF -* - IF ( NR .LT. N ) THEN - DO 3004 p = NR+1, N - SVA(p) = ZERO - 3004 CONTINUE - END IF -* - RWORK(1) = USCAL2 * SCALEM - RWORK(2) = USCAL1 - IF ( ERREST ) RWORK(3) = SCONDA - IF ( LSVEC .AND. RSVEC ) THEN - RWORK(4) = CONDR1 - RWORK(5) = CONDR2 - END IF - IF ( L2TRAN ) THEN - RWORK(6) = ENTRA - RWORK(7) = ENTRAT - END IF -* - IWORK(1) = NR - IWORK(2) = NUMRANK - IWORK(3) = WARNING - IF ( TRANSP ) THEN - IWORK(4) = 1 - ELSE - IWORK(4) = -1 - END IF - -* - RETURN -* .. -* .. END OF CGEJSV -* .. - END -* From bd07a6e7b2e36eeb6afc67ddc42463075c866d9b Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Thu, 4 Apr 2024 11:41:49 +0200 Subject: [PATCH 300/311] Delete misplaced (and obsoleted) file --- lapack-netlib/dgejsv.f | 1780 ---------------------------------------- 1 file changed, 1780 deletions(-) delete mode 100644 lapack-netlib/dgejsv.f diff --git a/lapack-netlib/dgejsv.f b/lapack-netlib/dgejsv.f deleted file mode 100644 index ee769bb38..000000000 --- a/lapack-netlib/dgejsv.f +++ /dev/null @@ -1,1780 +0,0 @@ -*> \brief \b DGEJSV -* -* =========== DOCUMENTATION =========== -* -* Online html documentation available at -* http://www.netlib.org/lapack/explore-html/ -* -*> \htmlonly -*> Download DGEJSV + dependencies -*> -*> [TGZ] -*> -*> [ZIP] -*> -*> [TXT] -*> \endhtmlonly -* -* Definition: -* =========== -* -* SUBROUTINE DGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, -* M, N, A, LDA, SVA, U, LDU, V, LDV, -* WORK, LWORK, IWORK, INFO ) -* -* .. Scalar Arguments .. -* IMPLICIT NONE -* INTEGER INFO, LDA, LDU, LDV, LWORK, M, N -* .. -* .. Array Arguments .. -* DOUBLE PRECISION A( LDA, * ), SVA( N ), U( LDU, * ), V( LDV, * ), -* $ WORK( LWORK ) -* INTEGER IWORK( * ) -* CHARACTER*1 JOBA, JOBP, JOBR, JOBT, JOBU, JOBV -* .. -* -* -*> \par Purpose: -* ============= -*> -*> \verbatim -*> -*> DGEJSV computes the singular value decomposition (SVD) of a real M-by-N -*> matrix [A], where M >= N. The SVD of [A] is written as -*> -*> [A] = [U] * [SIGMA] * [V]^t, -*> -*> where [SIGMA] is an N-by-N (M-by-N) matrix which is zero except for its N -*> diagonal elements, [U] is an M-by-N (or M-by-M) orthonormal matrix, and -*> [V] is an N-by-N orthogonal matrix. The diagonal elements of [SIGMA] are -*> the singular values of [A]. The columns of [U] and [V] are the left and -*> the right singular vectors of [A], respectively. The matrices [U] and [V] -*> are computed and stored in the arrays U and V, respectively. The diagonal -*> of [SIGMA] is computed and stored in the array SVA. -*> DGEJSV can sometimes compute tiny singular values and their singular vectors much -*> more accurately than other SVD routines, see below under Further Details. -*> \endverbatim -* -* Arguments: -* ========== -* -*> \param[in] JOBA -*> \verbatim -*> JOBA is CHARACTER*1 -*> Specifies the level of accuracy: -*> = 'C': This option works well (high relative accuracy) if A = B * D, -*> with well-conditioned B and arbitrary diagonal matrix D. -*> The accuracy cannot be spoiled by COLUMN scaling. The -*> accuracy of the computed output depends on the condition of -*> B, and the procedure aims at the best theoretical accuracy. -*> The relative error max_{i=1:N}|d sigma_i| / sigma_i is -*> bounded by f(M,N)*epsilon* cond(B), independent of D. -*> The input matrix is preprocessed with the QRF with column -*> pivoting. This initial preprocessing and preconditioning by -*> a rank revealing QR factorization is common for all values of -*> JOBA. Additional actions are specified as follows: -*> = 'E': Computation as with 'C' with an additional estimate of the -*> condition number of B. It provides a realistic error bound. -*> = 'F': If A = D1 * C * D2 with ill-conditioned diagonal scalings -*> D1, D2, and well-conditioned matrix C, this option gives -*> higher accuracy than the 'C' option. If the structure of the -*> input matrix is not known, and relative accuracy is -*> desirable, then this option is advisable. The input matrix A -*> is preprocessed with QR factorization with FULL (row and -*> column) pivoting. -*> = 'G': Computation as with 'F' with an additional estimate of the -*> condition number of B, where A=D*B. If A has heavily weighted -*> rows, then using this condition number gives too pessimistic -*> error bound. -*> = 'A': Small singular values are the noise and the matrix is treated -*> as numerically rank deficient. The error in the computed -*> singular values is bounded by f(m,n)*epsilon*||A||. -*> The computed SVD A = U * S * V^t restores A up to -*> f(m,n)*epsilon*||A||. -*> This gives the procedure the licence to discard (set to zero) -*> all singular values below N*epsilon*||A||. -*> = 'R': Similar as in 'A'. Rank revealing property of the initial -*> QR factorization is used do reveal (using triangular factor) -*> a gap sigma_{r+1} < epsilon * sigma_r in which case the -*> numerical RANK is declared to be r. The SVD is computed with -*> absolute error bounds, but more accurately than with 'A'. -*> \endverbatim -*> -*> \param[in] JOBU -*> \verbatim -*> JOBU is CHARACTER*1 -*> Specifies whether to compute the columns of U: -*> = 'U': N columns of U are returned in the array U. -*> = 'F': full set of M left sing. vectors is returned in the array U. -*> = 'W': U may be used as workspace of length M*N. See the description -*> of U. -*> = 'N': U is not computed. -*> \endverbatim -*> -*> \param[in] JOBV -*> \verbatim -*> JOBV is CHARACTER*1 -*> Specifies whether to compute the matrix V: -*> = 'V': N columns of V are returned in the array V; Jacobi rotations -*> are not explicitly accumulated. -*> = 'J': N columns of V are returned in the array V, but they are -*> computed as the product of Jacobi rotations. This option is -*> allowed only if JOBU .NE. 'N', i.e. in computing the full SVD. -*> = 'W': V may be used as workspace of length N*N. See the description -*> of V. -*> = 'N': V is not computed. -*> \endverbatim -*> -*> \param[in] JOBR -*> \verbatim -*> JOBR is CHARACTER*1 -*> Specifies the RANGE for the singular values. Issues the licence to -*> set to zero small positive singular values if they are outside -*> specified range. If A .NE. 0 is scaled so that the largest singular -*> value of c*A is around DSQRT(BIG), BIG=SLAMCH('O'), then JOBR issues -*> the licence to kill columns of A whose norm in c*A is less than -*> DSQRT(SFMIN) (for JOBR = 'R'), or less than SMALL=SFMIN/EPSLN, -*> where SFMIN=SLAMCH('S'), EPSLN=SLAMCH('E'). -*> = 'N': Do not kill small columns of c*A. This option assumes that -*> BLAS and QR factorizations and triangular solvers are -*> implemented to work in that range. If the condition of A -*> is greater than BIG, use DGESVJ. -*> = 'R': RESTRICTED range for sigma(c*A) is [DSQRT(SFMIN), DSQRT(BIG)] -*> (roughly, as described above). This option is recommended. -*> ~~~~~~~~~~~~~~~~~~~~~~~~~~~ -*> For computing the singular values in the FULL range [SFMIN,BIG] -*> use DGESVJ. -*> \endverbatim -*> -*> \param[in] JOBT -*> \verbatim -*> JOBT is CHARACTER*1 -*> If the matrix is square then the procedure may determine to use -*> transposed A if A^t seems to be better with respect to convergence. -*> If the matrix is not square, JOBT is ignored. This is subject to -*> changes in the future. -*> The decision is based on two values of entropy over the adjoint -*> orbit of A^t * A. See the descriptions of WORK(6) and WORK(7). -*> = 'T': transpose if entropy test indicates possibly faster -*> convergence of Jacobi process if A^t is taken as input. If A is -*> replaced with A^t, then the row pivoting is included automatically. -*> = 'N': do not speculate. -*> This option can be used to compute only the singular values, or the -*> full SVD (U, SIGMA and V). For only one set of singular vectors -*> (U or V), the caller should provide both U and V, as one of the -*> matrices is used as workspace if the matrix A is transposed. -*> The implementer can easily remove this constraint and make the -*> code more complicated. See the descriptions of U and V. -*> \endverbatim -*> -*> \param[in] JOBP -*> \verbatim -*> JOBP is CHARACTER*1 -*> Issues the licence to introduce structured perturbations to drown -*> denormalized numbers. This licence should be active if the -*> denormals are poorly implemented, causing slow computation, -*> especially in cases of fast convergence (!). For details see [1,2]. -*> For the sake of simplicity, this perturbations are included only -*> when the full SVD or only the singular values are requested. The -*> implementer/user can easily add the perturbation for the cases of -*> computing one set of singular vectors. -*> = 'P': introduce perturbation -*> = 'N': do not perturb -*> \endverbatim -*> -*> \param[in] M -*> \verbatim -*> M is INTEGER -*> The number of rows of the input matrix A. M >= 0. -*> \endverbatim -*> -*> \param[in] N -*> \verbatim -*> N is INTEGER -*> The number of columns of the input matrix A. M >= N >= 0. -*> \endverbatim -*> -*> \param[in,out] A -*> \verbatim -*> A is DOUBLE PRECISION array, dimension (LDA,N) -*> On entry, the M-by-N matrix A. -*> \endverbatim -*> -*> \param[in] LDA -*> \verbatim -*> LDA is INTEGER -*> The leading dimension of the array A. LDA >= max(1,M). -*> \endverbatim -*> -*> \param[out] SVA -*> \verbatim -*> SVA is DOUBLE PRECISION array, dimension (N) -*> On exit, -*> - For WORK(1)/WORK(2) = ONE: The singular values of A. During the -*> computation SVA contains Euclidean column norms of the -*> iterated matrices in the array A. -*> - For WORK(1) .NE. WORK(2): The singular values of A are -*> (WORK(1)/WORK(2)) * SVA(1:N). This factored form is used if -*> sigma_max(A) overflows or if small singular values have been -*> saved from underflow by scaling the input matrix A. -*> - If JOBR='R' then some of the singular values may be returned -*> as exact zeros obtained by "set to zero" because they are -*> below the numerical rank threshold or are denormalized numbers. -*> \endverbatim -*> -*> \param[out] U -*> \verbatim -*> U is DOUBLE PRECISION array, dimension ( LDU, N ) or ( LDU, M ) -*> If JOBU = 'U', then U contains on exit the M-by-N matrix of -*> the left singular vectors. -*> If JOBU = 'F', then U contains on exit the M-by-M matrix of -*> the left singular vectors, including an ONB -*> of the orthogonal complement of the Range(A). -*> If JOBU = 'W' .AND. (JOBV = 'V' .AND. JOBT = 'T' .AND. M = N), -*> then U is used as workspace if the procedure -*> replaces A with A^t. In that case, [V] is computed -*> in U as left singular vectors of A^t and then -*> copied back to the V array. This 'W' option is just -*> a reminder to the caller that in this case U is -*> reserved as workspace of length N*N. -*> If JOBU = 'N' U is not referenced, unless JOBT='T'. -*> \endverbatim -*> -*> \param[in] LDU -*> \verbatim -*> LDU is INTEGER -*> The leading dimension of the array U, LDU >= 1. -*> IF JOBU = 'U' or 'F' or 'W', then LDU >= M. -*> \endverbatim -*> -*> \param[out] V -*> \verbatim -*> V is DOUBLE PRECISION array, dimension ( LDV, N ) -*> If JOBV = 'V', 'J' then V contains on exit the N-by-N matrix of -*> the right singular vectors; -*> If JOBV = 'W', AND (JOBU = 'U' AND JOBT = 'T' AND M = N), -*> then V is used as workspace if the pprocedure -*> replaces A with A^t. In that case, [U] is computed -*> in V as right singular vectors of A^t and then -*> copied back to the U array. This 'W' option is just -*> a reminder to the caller that in this case V is -*> reserved as workspace of length N*N. -*> If JOBV = 'N' V is not referenced, unless JOBT='T'. -*> \endverbatim -*> -*> \param[in] LDV -*> \verbatim -*> LDV is INTEGER -*> The leading dimension of the array V, LDV >= 1. -*> If JOBV = 'V' or 'J' or 'W', then LDV >= N. -*> \endverbatim -*> -*> \param[out] WORK -*> \verbatim -*> WORK is DOUBLE PRECISION array, dimension (MAX(7,LWORK)) -*> On exit, if N > 0 .AND. M > 0 (else not referenced), -*> WORK(1) = SCALE = WORK(2) / WORK(1) is the scaling factor such -*> that SCALE*SVA(1:N) are the computed singular values -*> of A. (See the description of SVA().) -*> WORK(2) = See the description of WORK(1). -*> WORK(3) = SCONDA is an estimate for the condition number of -*> column equilibrated A. (If JOBA = 'E' or 'G') -*> SCONDA is an estimate of DSQRT(||(R^t * R)^(-1)||_1). -*> It is computed using DPOCON. It holds -*> N^(-1/4) * SCONDA <= ||R^(-1)||_2 <= N^(1/4) * SCONDA -*> where R is the triangular factor from the QRF of A. -*> However, if R is truncated and the numerical rank is -*> determined to be strictly smaller than N, SCONDA is -*> returned as -1, thus indicating that the smallest -*> singular values might be lost. -*> -*> If full SVD is needed, the following two condition numbers are -*> useful for the analysis of the algorithm. They are provided for -*> a developer/implementer who is familiar with the details of -*> the method. -*> -*> WORK(4) = an estimate of the scaled condition number of the -*> triangular factor in the first QR factorization. -*> WORK(5) = an estimate of the scaled condition number of the -*> triangular factor in the second QR factorization. -*> The following two parameters are computed if JOBT = 'T'. -*> They are provided for a developer/implementer who is familiar -*> with the details of the method. -*> -*> WORK(6) = the entropy of A^t*A :: this is the Shannon entropy -*> of diag(A^t*A) / Trace(A^t*A) taken as point in the -*> probability simplex. -*> WORK(7) = the entropy of A*A^t. -*> \endverbatim -*> -*> \param[in] LWORK -*> \verbatim -*> LWORK is INTEGER -*> Length of WORK to confirm proper allocation of work space. -*> LWORK depends on the job: -*> -*> If only SIGMA is needed (JOBU = 'N', JOBV = 'N') and -*> -> .. no scaled condition estimate required (JOBE = 'N'): -*> LWORK >= max(2*M+N,4*N+1,7). This is the minimal requirement. -*> ->> For optimal performance (blocked code) the optimal value -*> is LWORK >= max(2*M+N,3*N+(N+1)*NB,7). Here NB is the optimal -*> block size for DGEQP3 and DGEQRF. -*> In general, optimal LWORK is computed as -*> LWORK >= max(2*M+N,N+LWORK(DGEQP3),N+LWORK(DGEQRF), 7). -*> -> .. an estimate of the scaled condition number of A is -*> required (JOBA='E', 'G'). In this case, LWORK is the maximum -*> of the above and N*N+4*N, i.e. LWORK >= max(2*M+N,N*N+4*N,7). -*> ->> For optimal performance (blocked code) the optimal value -*> is LWORK >= max(2*M+N,3*N+(N+1)*NB, N*N+4*N, 7). -*> In general, the optimal length LWORK is computed as -*> LWORK >= max(2*M+N,N+LWORK(DGEQP3),N+LWORK(DGEQRF), -*> N+N*N+LWORK(DPOCON),7). -*> -*> If SIGMA and the right singular vectors are needed (JOBV = 'V'), -*> -> the minimal requirement is LWORK >= max(2*M+N,4*N+1,7). -*> -> For optimal performance, LWORK >= max(2*M+N,3*N+(N+1)*NB,7), -*> where NB is the optimal block size for DGEQP3, DGEQRF, DGELQF, -*> DORMLQ. In general, the optimal length LWORK is computed as -*> LWORK >= max(2*M+N,N+LWORK(DGEQP3), N+LWORK(DPOCON), -*> N+LWORK(DGELQF), 2*N+LWORK(DGEQRF), N+LWORK(DORMLQ)). -*> -*> If SIGMA and the left singular vectors are needed -*> -> the minimal requirement is LWORK >= max(2*M+N,4*N+1,7). -*> -> For optimal performance: -*> if JOBU = 'U' :: LWORK >= max(2*M+N,3*N+(N+1)*NB,7), -*> if JOBU = 'F' :: LWORK >= max(2*M+N,3*N+(N+1)*NB,N+M*NB,7), -*> where NB is the optimal block size for DGEQP3, DGEQRF, DORMQR. -*> In general, the optimal length LWORK is computed as -*> LWORK >= max(2*M+N,N+LWORK(DGEQP3),N+LWORK(DPOCON), -*> 2*N+LWORK(DGEQRF), N+LWORK(DORMQR)). -*> Here LWORK(DORMQR) equals N*NB (for JOBU = 'U') or -*> M*NB (for JOBU = 'F'). -*> -*> If the full SVD is needed: (JOBU = 'U' or JOBU = 'F') and -*> -> if JOBV = 'V' -*> the minimal requirement is LWORK >= max(2*M+N,6*N+2*N*N). -*> -> if JOBV = 'J' the minimal requirement is -*> LWORK >= max(2*M+N, 4*N+N*N,2*N+N*N+6). -*> -> For optimal performance, LWORK should be additionally -*> larger than N+M*NB, where NB is the optimal block size -*> for DORMQR. -*> \endverbatim -*> -*> \param[out] IWORK -*> \verbatim -*> IWORK is INTEGER array, dimension (MAX(3,M+3*N)). -*> On exit, -*> IWORK(1) = the numerical rank determined after the initial -*> QR factorization with pivoting. See the descriptions -*> of JOBA and JOBR. -*> IWORK(2) = the number of the computed nonzero singular values -*> IWORK(3) = if nonzero, a warning message: -*> If IWORK(3) = 1 then some of the column norms of A -*> were denormalized floats. The requested high accuracy -*> is not warranted by the data. -*> \endverbatim -*> -*> \param[out] INFO -*> \verbatim -*> INFO is INTEGER -*> < 0: if INFO = -i, then the i-th argument had an illegal value. -*> = 0: successful exit; -*> > 0: DGEJSV did not converge in the maximal allowed number -*> of sweeps. The computed values may be inaccurate. -*> \endverbatim -* -* Authors: -* ======== -* -*> \author Univ. of Tennessee -*> \author Univ. of California Berkeley -*> \author Univ. of Colorado Denver -*> \author NAG Ltd. -* -*> \ingroup doubleGEsing -* -*> \par Further Details: -* ===================== -*> -*> \verbatim -*> -*> DGEJSV implements a preconditioned Jacobi SVD algorithm. It uses DGEQP3, -*> DGEQRF, and DGELQF as preprocessors and preconditioners. Optionally, an -*> additional row pivoting can be used as a preprocessor, which in some -*> cases results in much higher accuracy. An example is matrix A with the -*> structure A = D1 * C * D2, where D1, D2 are arbitrarily ill-conditioned -*> diagonal matrices and C is well-conditioned matrix. In that case, complete -*> pivoting in the first QR factorizations provides accuracy dependent on the -*> condition number of C, and independent of D1, D2. Such higher accuracy is -*> not completely understood theoretically, but it works well in practice. -*> Further, if A can be written as A = B*D, with well-conditioned B and some -*> diagonal D, then the high accuracy is guaranteed, both theoretically and -*> in software, independent of D. For more details see [1], [2]. -*> The computational range for the singular values can be the full range -*> ( UNDERFLOW,OVERFLOW ), provided that the machine arithmetic and the BLAS -*> & LAPACK routines called by DGEJSV are implemented to work in that range. -*> If that is not the case, then the restriction for safe computation with -*> the singular values in the range of normalized IEEE numbers is that the -*> spectral condition number kappa(A)=sigma_max(A)/sigma_min(A) does not -*> overflow. This code (DGEJSV) is best used in this restricted range, -*> meaning that singular values of magnitude below ||A||_2 / DLAMCH('O') are -*> returned as zeros. See JOBR for details on this. -*> Further, this implementation is somewhat slower than the one described -*> in [1,2] due to replacement of some non-LAPACK components, and because -*> the choice of some tuning parameters in the iterative part (DGESVJ) is -*> left to the implementer on a particular machine. -*> The rank revealing QR factorization (in this code: DGEQP3) should be -*> implemented as in [3]. We have a new version of DGEQP3 under development -*> that is more robust than the current one in LAPACK, with a cleaner cut in -*> rank deficient cases. It will be available in the SIGMA library [4]. -*> If M is much larger than N, it is obvious that the initial QRF with -*> column pivoting can be preprocessed by the QRF without pivoting. That -*> well known trick is not used in DGEJSV because in some cases heavy row -*> weighting can be treated with complete pivoting. The overhead in cases -*> M much larger than N is then only due to pivoting, but the benefits in -*> terms of accuracy have prevailed. The implementer/user can incorporate -*> this extra QRF step easily. The implementer can also improve data movement -*> (matrix transpose, matrix copy, matrix transposed copy) - this -*> implementation of DGEJSV uses only the simplest, naive data movement. -*> \endverbatim -* -*> \par Contributors: -* ================== -*> -*> Zlatko Drmac (Zagreb, Croatia) and Kresimir Veselic (Hagen, Germany) -* -*> \par References: -* ================ -*> -*> \verbatim -*> -*> [1] Z. Drmac and K. Veselic: New fast and accurate Jacobi SVD algorithm I. -*> SIAM J. Matrix Anal. Appl. Vol. 35, No. 2 (2008), pp. 1322-1342. -*> LAPACK Working note 169. -*> [2] Z. Drmac and K. Veselic: New fast and accurate Jacobi SVD algorithm II. -*> SIAM J. Matrix Anal. Appl. Vol. 35, No. 2 (2008), pp. 1343-1362. -*> LAPACK Working note 170. -*> [3] Z. Drmac and Z. Bujanovic: On the failure of rank-revealing QR -*> factorization software - a case study. -*> ACM Trans. Math. Softw. Vol. 35, No 2 (2008), pp. 1-28. -*> LAPACK Working note 176. -*> [4] Z. Drmac: SIGMA - mathematical software library for accurate SVD, PSV, -*> QSVD, (H,K)-SVD computations. -*> Department of Mathematics, University of Zagreb, 2008. -*> \endverbatim -* -*> \par Bugs, examples and comments: -* ================================= -*> -*> Please report all bugs and send interesting examples and/or comments to -*> drmac@math.hr. Thank you. -*> -* ===================================================================== - SUBROUTINE DGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, - $ M, N, A, LDA, SVA, U, LDU, V, LDV, - $ WORK, LWORK, IWORK, INFO ) -* -* -- LAPACK computational routine -- -* -- LAPACK is a software package provided by Univ. of Tennessee, -- -* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* -* .. Scalar Arguments .. - IMPLICIT NONE - INTEGER INFO, LDA, LDU, LDV, LWORK, M, N -* .. -* .. Array Arguments .. - DOUBLE PRECISION A( LDA, * ), SVA( N ), U( LDU, * ), V( LDV, * ), - $ WORK( LWORK ) - INTEGER IWORK( * ) - CHARACTER*1 JOBA, JOBP, JOBR, JOBT, JOBU, JOBV -* .. -* -* =========================================================================== -* -* .. Local Parameters .. - DOUBLE PRECISION ZERO, ONE - PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 ) -* .. -* .. Local Scalars .. - DOUBLE PRECISION AAPP, AAQQ, AATMAX, AATMIN, BIG, BIG1, COND_OK, - $ CONDR1, CONDR2, ENTRA, ENTRAT, EPSLN, MAXPRJ, SCALEM, - $ SCONDA, SFMIN, SMALL, TEMP1, USCAL1, USCAL2, XSC - INTEGER IERR, N1, NR, NUMRANK, p, q, WARNING - LOGICAL ALMORT, DEFR, ERREST, GOSCAL, JRACC, KILL, LSVEC, - $ L2ABER, L2KILL, L2PERT, L2RANK, L2TRAN, - $ NOSCAL, ROWPIV, RSVEC, TRANSP -* .. -* .. Intrinsic Functions .. - INTRINSIC DABS, DLOG, MAX, MIN, DBLE, IDNINT, DSIGN, DSQRT -* .. -* .. External Functions .. - DOUBLE PRECISION DLAMCH, DNRM2 - INTEGER IDAMAX - LOGICAL LSAME - EXTERNAL IDAMAX, LSAME, DLAMCH, DNRM2 -* .. -* .. External Subroutines .. - EXTERNAL DCOPY, DGELQF, DGEQP3, DGEQRF, DLACPY, DLASCL, - $ DLASET, DLASSQ, DLASWP, DORGQR, DORMLQ, - $ DORMQR, DPOCON, DSCAL, DSWAP, DTRSM, XERBLA -* - EXTERNAL DGESVJ -* .. -* -* Test the input arguments -* - LSVEC = LSAME( JOBU, 'U' ) .OR. LSAME( JOBU, 'F' ) - JRACC = LSAME( JOBV, 'J' ) - RSVEC = LSAME( JOBV, 'V' ) .OR. JRACC - ROWPIV = LSAME( JOBA, 'F' ) .OR. LSAME( JOBA, 'G' ) - L2RANK = LSAME( JOBA, 'R' ) - L2ABER = LSAME( JOBA, 'A' ) - ERREST = LSAME( JOBA, 'E' ) .OR. LSAME( JOBA, 'G' ) - L2TRAN = LSAME( JOBT, 'T' ) - L2KILL = LSAME( JOBR, 'R' ) - DEFR = LSAME( JOBR, 'N' ) - L2PERT = LSAME( JOBP, 'P' ) -* - IF ( .NOT.(ROWPIV .OR. L2RANK .OR. L2ABER .OR. - $ ERREST .OR. LSAME( JOBA, 'C' ) )) THEN - INFO = - 1 - ELSE IF ( .NOT.( LSVEC .OR. LSAME( JOBU, 'N' ) .OR. - $ LSAME( JOBU, 'W' )) ) THEN - INFO = - 2 - ELSE IF ( .NOT.( RSVEC .OR. LSAME( JOBV, 'N' ) .OR. - $ LSAME( JOBV, 'W' )) .OR. ( JRACC .AND. (.NOT.LSVEC) ) ) THEN - INFO = - 3 - ELSE IF ( .NOT. ( L2KILL .OR. DEFR ) ) THEN - INFO = - 4 - ELSE IF ( .NOT. ( L2TRAN .OR. LSAME( JOBT, 'N' ) ) ) THEN - INFO = - 5 - ELSE IF ( .NOT. ( L2PERT .OR. LSAME( JOBP, 'N' ) ) ) THEN - INFO = - 6 - ELSE IF ( M .LT. 0 ) THEN - INFO = - 7 - ELSE IF ( ( N .LT. 0 ) .OR. ( N .GT. M ) ) THEN - INFO = - 8 - ELSE IF ( LDA .LT. M ) THEN - INFO = - 10 - ELSE IF ( LSVEC .AND. ( LDU .LT. M ) ) THEN - INFO = - 13 - ELSE IF ( RSVEC .AND. ( LDV .LT. N ) ) THEN - INFO = - 15 - ELSE IF ( (.NOT.(LSVEC .OR. RSVEC .OR. ERREST).AND. - & (LWORK .LT. MAX(7,4*N+1,2*M+N))) .OR. - & (.NOT.(LSVEC .OR. RSVEC) .AND. ERREST .AND. - & (LWORK .LT. MAX(7,4*N+N*N,2*M+N))) .OR. - & (LSVEC .AND. (.NOT.RSVEC) .AND. (LWORK .LT. MAX(7,2*M+N,4*N+1))) - & .OR. - & (RSVEC .AND. (.NOT.LSVEC) .AND. (LWORK .LT. MAX(7,2*M+N,4*N+1))) - & .OR. - & (LSVEC .AND. RSVEC .AND. (.NOT.JRACC) .AND. - & (LWORK.LT.MAX(2*M+N,6*N+2*N*N))) - & .OR. (LSVEC .AND. RSVEC .AND. JRACC .AND. - & LWORK.LT.MAX(2*M+N,4*N+N*N,2*N+N*N+6))) - & THEN - INFO = - 17 - ELSE -* #:) - INFO = 0 - END IF -* - IF ( INFO .NE. 0 ) THEN -* #:( - CALL XERBLA( 'DGEJSV', - INFO ) - RETURN - END IF -* -* Quick return for void matrix (Y3K safe) -* #:) - IF ( ( M .EQ. 0 ) .OR. ( N .EQ. 0 ) ) THEN - IWORK(1:3) = 0 - WORK(1:7) = 0 - RETURN - ENDIF -* -* Determine whether the matrix U should be M x N or M x M -* - IF ( LSVEC ) THEN - N1 = N - IF ( LSAME( JOBU, 'F' ) ) N1 = M - END IF -* -* Set numerical parameters -* -*! NOTE: Make sure DLAMCH() does not fail on the target architecture. -* - EPSLN = DLAMCH('Epsilon') - SFMIN = DLAMCH('SafeMinimum') - SMALL = SFMIN / EPSLN - BIG = DLAMCH('O') -* BIG = ONE / SFMIN -* -* Initialize SVA(1:N) = diag( ||A e_i||_2 )_1^N -* -*(!) If necessary, scale SVA() to protect the largest norm from -* overflow. It is possible that this scaling pushes the smallest -* column norm left from the underflow threshold (extreme case). -* - SCALEM = ONE / DSQRT(DBLE(M)*DBLE(N)) - NOSCAL = .TRUE. - GOSCAL = .TRUE. - DO 1874 p = 1, N - AAPP = ZERO - AAQQ = ONE - CALL DLASSQ( M, A(1,p), 1, AAPP, AAQQ ) - IF ( AAPP .GT. BIG ) THEN - INFO = - 9 - CALL XERBLA( 'DGEJSV', -INFO ) - RETURN - END IF - AAQQ = DSQRT(AAQQ) - IF ( ( AAPP .LT. (BIG / AAQQ) ) .AND. NOSCAL ) THEN - SVA(p) = AAPP * AAQQ - ELSE - NOSCAL = .FALSE. - SVA(p) = AAPP * ( AAQQ * SCALEM ) - IF ( GOSCAL ) THEN - GOSCAL = .FALSE. - CALL DSCAL( p-1, SCALEM, SVA, 1 ) - END IF - END IF - 1874 CONTINUE -* - IF ( NOSCAL ) SCALEM = ONE -* - AAPP = ZERO - AAQQ = BIG - DO 4781 p = 1, N - AAPP = MAX( AAPP, SVA(p) ) - IF ( SVA(p) .NE. ZERO ) AAQQ = MIN( AAQQ, SVA(p) ) - 4781 CONTINUE -* -* Quick return for zero M x N matrix -* #:) - IF ( AAPP .EQ. ZERO ) THEN - IF ( LSVEC ) CALL DLASET( 'G', M, N1, ZERO, ONE, U, LDU ) - IF ( RSVEC ) CALL DLASET( 'G', N, N, ZERO, ONE, V, LDV ) - WORK(1) = ONE - WORK(2) = ONE - IF ( ERREST ) WORK(3) = ONE - IF ( LSVEC .AND. RSVEC ) THEN - WORK(4) = ONE - WORK(5) = ONE - END IF - IF ( L2TRAN ) THEN - WORK(6) = ZERO - WORK(7) = ZERO - END IF - IWORK(1) = 0 - IWORK(2) = 0 - IWORK(3) = 0 - RETURN - END IF -* -* Issue warning if denormalized column norms detected. Override the -* high relative accuracy request. Issue licence to kill columns -* (set them to zero) whose norm is less than sigma_max / BIG (roughly). -* #:( - WARNING = 0 - IF ( AAQQ .LE. SFMIN ) THEN - L2RANK = .TRUE. - L2KILL = .TRUE. - WARNING = 1 - END IF -* -* Quick return for one-column matrix -* #:) - IF ( N .EQ. 1 ) THEN -* - IF ( LSVEC ) THEN - CALL DLASCL( 'G',0,0,SVA(1),SCALEM, M,1,A(1,1),LDA,IERR ) - CALL DLACPY( 'A', M, 1, A, LDA, U, LDU ) -* computing all M left singular vectors of the M x 1 matrix - IF ( N1 .NE. N ) THEN - CALL DGEQRF( M, N, U,LDU, WORK, WORK(N+1),LWORK-N,IERR ) - CALL DORGQR( M,N1,1, U,LDU,WORK,WORK(N+1),LWORK-N,IERR ) - CALL DCOPY( M, A(1,1), 1, U(1,1), 1 ) - END IF - END IF - IF ( RSVEC ) THEN - V(1,1) = ONE - END IF - IF ( SVA(1) .LT. (BIG*SCALEM) ) THEN - SVA(1) = SVA(1) / SCALEM - SCALEM = ONE - END IF - WORK(1) = ONE / SCALEM - WORK(2) = ONE - IF ( SVA(1) .NE. ZERO ) THEN - IWORK(1) = 1 - IF ( ( SVA(1) / SCALEM) .GE. SFMIN ) THEN - IWORK(2) = 1 - ELSE - IWORK(2) = 0 - END IF - ELSE - IWORK(1) = 0 - IWORK(2) = 0 - END IF - IWORK(3) = 0 - IF ( ERREST ) WORK(3) = ONE - IF ( LSVEC .AND. RSVEC ) THEN - WORK(4) = ONE - WORK(5) = ONE - END IF - IF ( L2TRAN ) THEN - WORK(6) = ZERO - WORK(7) = ZERO - END IF - RETURN -* - END IF -* - TRANSP = .FALSE. - L2TRAN = L2TRAN .AND. ( M .EQ. N ) -* - AATMAX = -ONE - AATMIN = BIG - IF ( ROWPIV .OR. L2TRAN ) THEN -* -* Compute the row norms, needed to determine row pivoting sequence -* (in the case of heavily row weighted A, row pivoting is strongly -* advised) and to collect information needed to compare the -* structures of A * A^t and A^t * A (in the case L2TRAN.EQ..TRUE.). -* - IF ( L2TRAN ) THEN - DO 1950 p = 1, M - XSC = ZERO - TEMP1 = ONE - CALL DLASSQ( N, A(p,1), LDA, XSC, TEMP1 ) -* DLASSQ gets both the ell_2 and the ell_infinity norm -* in one pass through the vector - WORK(M+N+p) = XSC * SCALEM - WORK(N+p) = XSC * (SCALEM*DSQRT(TEMP1)) - AATMAX = MAX( AATMAX, WORK(N+p) ) - IF (WORK(N+p) .NE. ZERO) AATMIN = MIN(AATMIN,WORK(N+p)) - 1950 CONTINUE - ELSE - DO 1904 p = 1, M - WORK(M+N+p) = SCALEM*DABS( A(p,IDAMAX(N,A(p,1),LDA)) ) - AATMAX = MAX( AATMAX, WORK(M+N+p) ) - AATMIN = MIN( AATMIN, WORK(M+N+p) ) - 1904 CONTINUE - END IF -* - END IF -* -* For square matrix A try to determine whether A^t would be better -* input for the preconditioned Jacobi SVD, with faster convergence. -* The decision is based on an O(N) function of the vector of column -* and row norms of A, based on the Shannon entropy. This should give -* the right choice in most cases when the difference actually matters. -* It may fail and pick the slower converging side. -* - ENTRA = ZERO - ENTRAT = ZERO - IF ( L2TRAN ) THEN -* - XSC = ZERO - TEMP1 = ONE - CALL DLASSQ( N, SVA, 1, XSC, TEMP1 ) - TEMP1 = ONE / TEMP1 -* - ENTRA = ZERO - DO 1113 p = 1, N - BIG1 = ( ( SVA(p) / XSC )**2 ) * TEMP1 - IF ( BIG1 .NE. ZERO ) ENTRA = ENTRA + BIG1 * DLOG(BIG1) - 1113 CONTINUE - ENTRA = - ENTRA / DLOG(DBLE(N)) -* -* Now, SVA().^2/Trace(A^t * A) is a point in the probability simplex. -* It is derived from the diagonal of A^t * A. Do the same with the -* diagonal of A * A^t, compute the entropy of the corresponding -* probability distribution. Note that A * A^t and A^t * A have the -* same trace. -* - ENTRAT = ZERO - DO 1114 p = N+1, N+M - BIG1 = ( ( WORK(p) / XSC )**2 ) * TEMP1 - IF ( BIG1 .NE. ZERO ) ENTRAT = ENTRAT + BIG1 * DLOG(BIG1) - 1114 CONTINUE - ENTRAT = - ENTRAT / DLOG(DBLE(M)) -* -* Analyze the entropies and decide A or A^t. Smaller entropy -* usually means better input for the algorithm. -* - TRANSP = ( ENTRAT .LT. ENTRA ) -* -* If A^t is better than A, transpose A. -* - IF ( TRANSP ) THEN -* In an optimal implementation, this trivial transpose -* should be replaced with faster transpose. - DO 1115 p = 1, N - 1 - DO 1116 q = p + 1, N - TEMP1 = A(q,p) - A(q,p) = A(p,q) - A(p,q) = TEMP1 - 1116 CONTINUE - 1115 CONTINUE - DO 1117 p = 1, N - WORK(M+N+p) = SVA(p) - SVA(p) = WORK(N+p) - 1117 CONTINUE - TEMP1 = AAPP - AAPP = AATMAX - AATMAX = TEMP1 - TEMP1 = AAQQ - AAQQ = AATMIN - AATMIN = TEMP1 - KILL = LSVEC - LSVEC = RSVEC - RSVEC = KILL - IF ( LSVEC ) N1 = N -* - ROWPIV = .TRUE. - END IF -* - END IF -* END IF L2TRAN -* -* Scale the matrix so that its maximal singular value remains less -* than DSQRT(BIG) -- the matrix is scaled so that its maximal column -* has Euclidean norm equal to DSQRT(BIG/N). The only reason to keep -* DSQRT(BIG) instead of BIG is the fact that DGEJSV uses LAPACK and -* BLAS routines that, in some implementations, are not capable of -* working in the full interval [SFMIN,BIG] and that they may provoke -* overflows in the intermediate results. If the singular values spread -* from SFMIN to BIG, then DGESVJ will compute them. So, in that case, -* one should use DGESVJ instead of DGEJSV. -* - BIG1 = DSQRT( BIG ) - TEMP1 = DSQRT( BIG / DBLE(N) ) -* - CALL DLASCL( 'G', 0, 0, AAPP, TEMP1, N, 1, SVA, N, IERR ) - IF ( AAQQ .GT. (AAPP * SFMIN) ) THEN - AAQQ = ( AAQQ / AAPP ) * TEMP1 - ELSE - AAQQ = ( AAQQ * TEMP1 ) / AAPP - END IF - TEMP1 = TEMP1 * SCALEM - CALL DLASCL( 'G', 0, 0, AAPP, TEMP1, M, N, A, LDA, IERR ) -* -* To undo scaling at the end of this procedure, multiply the -* computed singular values with USCAL2 / USCAL1. -* - USCAL1 = TEMP1 - USCAL2 = AAPP -* - IF ( L2KILL ) THEN -* L2KILL enforces computation of nonzero singular values in -* the restricted range of condition number of the initial A, -* sigma_max(A) / sigma_min(A) approx. DSQRT(BIG)/DSQRT(SFMIN). - XSC = DSQRT( SFMIN ) - ELSE - XSC = SMALL -* -* Now, if the condition number of A is too big, -* sigma_max(A) / sigma_min(A) .GT. DSQRT(BIG/N) * EPSLN / SFMIN, -* as a precaution measure, the full SVD is computed using DGESVJ -* with accumulated Jacobi rotations. This provides numerically -* more robust computation, at the cost of slightly increased run -* time. Depending on the concrete implementation of BLAS and LAPACK -* (i.e. how they behave in presence of extreme ill-conditioning) the -* implementor may decide to remove this switch. - IF ( ( AAQQ.LT.DSQRT(SFMIN) ) .AND. LSVEC .AND. RSVEC ) THEN - JRACC = .TRUE. - END IF -* - END IF - IF ( AAQQ .LT. XSC ) THEN - DO 700 p = 1, N - IF ( SVA(p) .LT. XSC ) THEN - CALL DLASET( 'A', M, 1, ZERO, ZERO, A(1,p), LDA ) - SVA(p) = ZERO - END IF - 700 CONTINUE - END IF -* -* Preconditioning using QR factorization with pivoting -* - IF ( ROWPIV ) THEN -* Optional row permutation (Bjoerck row pivoting): -* A result by Cox and Higham shows that the Bjoerck's -* row pivoting combined with standard column pivoting -* has similar effect as Powell-Reid complete pivoting. -* The ell-infinity norms of A are made nonincreasing. - DO 1952 p = 1, M - 1 - q = IDAMAX( M-p+1, WORK(M+N+p), 1 ) + p - 1 - IWORK(2*N+p) = q - IF ( p .NE. q ) THEN - TEMP1 = WORK(M+N+p) - WORK(M+N+p) = WORK(M+N+q) - WORK(M+N+q) = TEMP1 - END IF - 1952 CONTINUE - CALL DLASWP( N, A, LDA, 1, M-1, IWORK(2*N+1), 1 ) - END IF -* -* End of the preparation phase (scaling, optional sorting and -* transposing, optional flushing of small columns). -* -* Preconditioning -* -* If the full SVD is needed, the right singular vectors are computed -* from a matrix equation, and for that we need theoretical analysis -* of the Businger-Golub pivoting. So we use DGEQP3 as the first RR QRF. -* In all other cases the first RR QRF can be chosen by other criteria -* (eg speed by replacing global with restricted window pivoting, such -* as in SGEQPX from TOMS # 782). Good results will be obtained using -* SGEQPX with properly (!) chosen numerical parameters. -* Any improvement of DGEQP3 improves overall performance of DGEJSV. -* -* A * P1 = Q1 * [ R1^t 0]^t: - DO 1963 p = 1, N -* .. all columns are free columns - IWORK(p) = 0 - 1963 CONTINUE - CALL DGEQP3( M,N,A,LDA, IWORK,WORK, WORK(N+1),LWORK-N, IERR ) -* -* The upper triangular matrix R1 from the first QRF is inspected for -* rank deficiency and possibilities for deflation, or possible -* ill-conditioning. Depending on the user specified flag L2RANK, -* the procedure explores possibilities to reduce the numerical -* rank by inspecting the computed upper triangular factor. If -* L2RANK or L2ABER are up, then DGEJSV will compute the SVD of -* A + dA, where ||dA|| <= f(M,N)*EPSLN. -* - NR = 1 - IF ( L2ABER ) THEN -* Standard absolute error bound suffices. All sigma_i with -* sigma_i < N*EPSLN*||A|| are flushed to zero. This is an -* aggressive enforcement of lower numerical rank by introducing a -* backward error of the order of N*EPSLN*||A||. - TEMP1 = DSQRT(DBLE(N))*EPSLN - DO 3001 p = 2, N - IF ( DABS(A(p,p)) .GE. (TEMP1*DABS(A(1,1))) ) THEN - NR = NR + 1 - ELSE - GO TO 3002 - END IF - 3001 CONTINUE - 3002 CONTINUE - ELSE IF ( L2RANK ) THEN -* .. similarly as above, only slightly more gentle (less aggressive). -* Sudden drop on the diagonal of R1 is used as the criterion for -* close-to-rank-deficient. - TEMP1 = DSQRT(SFMIN) - DO 3401 p = 2, N - IF ( ( DABS(A(p,p)) .LT. (EPSLN*DABS(A(p-1,p-1))) ) .OR. - $ ( DABS(A(p,p)) .LT. SMALL ) .OR. - $ ( L2KILL .AND. (DABS(A(p,p)) .LT. TEMP1) ) ) GO TO 3402 - NR = NR + 1 - 3401 CONTINUE - 3402 CONTINUE -* - ELSE -* The goal is high relative accuracy. However, if the matrix -* has high scaled condition number the relative accuracy is in -* general not feasible. Later on, a condition number estimator -* will be deployed to estimate the scaled condition number. -* Here we just remove the underflowed part of the triangular -* factor. This prevents the situation in which the code is -* working hard to get the accuracy not warranted by the data. - TEMP1 = DSQRT(SFMIN) - DO 3301 p = 2, N - IF ( ( DABS(A(p,p)) .LT. SMALL ) .OR. - $ ( L2KILL .AND. (DABS(A(p,p)) .LT. TEMP1) ) ) GO TO 3302 - NR = NR + 1 - 3301 CONTINUE - 3302 CONTINUE -* - END IF -* - ALMORT = .FALSE. - IF ( NR .EQ. N ) THEN - MAXPRJ = ONE - DO 3051 p = 2, N - TEMP1 = DABS(A(p,p)) / SVA(IWORK(p)) - MAXPRJ = MIN( MAXPRJ, TEMP1 ) - 3051 CONTINUE - IF ( MAXPRJ**2 .GE. ONE - DBLE(N)*EPSLN ) ALMORT = .TRUE. - END IF -* -* - SCONDA = - ONE - CONDR1 = - ONE - CONDR2 = - ONE -* - IF ( ERREST ) THEN - IF ( N .EQ. NR ) THEN - IF ( RSVEC ) THEN -* .. V is available as workspace - CALL DLACPY( 'U', N, N, A, LDA, V, LDV ) - DO 3053 p = 1, N - TEMP1 = SVA(IWORK(p)) - CALL DSCAL( p, ONE/TEMP1, V(1,p), 1 ) - 3053 CONTINUE - CALL DPOCON( 'U', N, V, LDV, ONE, TEMP1, - $ WORK(N+1), IWORK(2*N+M+1), IERR ) - ELSE IF ( LSVEC ) THEN -* .. U is available as workspace - CALL DLACPY( 'U', N, N, A, LDA, U, LDU ) - DO 3054 p = 1, N - TEMP1 = SVA(IWORK(p)) - CALL DSCAL( p, ONE/TEMP1, U(1,p), 1 ) - 3054 CONTINUE - CALL DPOCON( 'U', N, U, LDU, ONE, TEMP1, - $ WORK(N+1), IWORK(2*N+M+1), IERR ) - ELSE - CALL DLACPY( 'U', N, N, A, LDA, WORK(N+1), N ) - DO 3052 p = 1, N - TEMP1 = SVA(IWORK(p)) - CALL DSCAL( p, ONE/TEMP1, WORK(N+(p-1)*N+1), 1 ) - 3052 CONTINUE -* .. the columns of R are scaled to have unit Euclidean lengths. - CALL DPOCON( 'U', N, WORK(N+1), N, ONE, TEMP1, - $ WORK(N+N*N+1), IWORK(2*N+M+1), IERR ) - END IF - SCONDA = ONE / DSQRT(TEMP1) -* SCONDA is an estimate of DSQRT(||(R^t * R)^(-1)||_1). -* N^(-1/4) * SCONDA <= ||R^(-1)||_2 <= N^(1/4) * SCONDA - ELSE - SCONDA = - ONE - END IF - END IF -* - L2PERT = L2PERT .AND. ( DABS( A(1,1)/A(NR,NR) ) .GT. DSQRT(BIG1) ) -* If there is no violent scaling, artificial perturbation is not needed. -* -* Phase 3: -* - IF ( .NOT. ( RSVEC .OR. LSVEC ) ) THEN -* -* Singular Values only -* -* .. transpose A(1:NR,1:N) - DO 1946 p = 1, MIN( N-1, NR ) - CALL DCOPY( N-p, A(p,p+1), LDA, A(p+1,p), 1 ) - 1946 CONTINUE -* -* The following two DO-loops introduce small relative perturbation -* into the strict upper triangle of the lower triangular matrix. -* Small entries below the main diagonal are also changed. -* This modification is useful if the computing environment does not -* provide/allow FLUSH TO ZERO underflow, for it prevents many -* annoying denormalized numbers in case of strongly scaled matrices. -* The perturbation is structured so that it does not introduce any -* new perturbation of the singular values, and it does not destroy -* the job done by the preconditioner. -* The licence for this perturbation is in the variable L2PERT, which -* should be .FALSE. if FLUSH TO ZERO underflow is active. -* - IF ( .NOT. ALMORT ) THEN -* - IF ( L2PERT ) THEN -* XSC = DSQRT(SMALL) - XSC = EPSLN / DBLE(N) - DO 4947 q = 1, NR - TEMP1 = XSC*DABS(A(q,q)) - DO 4949 p = 1, N - IF ( ( (p.GT.q) .AND. (DABS(A(p,q)).LE.TEMP1) ) - $ .OR. ( p .LT. q ) ) - $ A(p,q) = DSIGN( TEMP1, A(p,q) ) - 4949 CONTINUE - 4947 CONTINUE - ELSE - CALL DLASET( 'U', NR-1,NR-1, ZERO,ZERO, A(1,2),LDA ) - END IF -* -* .. second preconditioning using the QR factorization -* - CALL DGEQRF( N,NR, A,LDA, WORK, WORK(N+1),LWORK-N, IERR ) -* -* .. and transpose upper to lower triangular - DO 1948 p = 1, NR - 1 - CALL DCOPY( NR-p, A(p,p+1), LDA, A(p+1,p), 1 ) - 1948 CONTINUE -* - END IF -* -* Row-cyclic Jacobi SVD algorithm with column pivoting -* -* .. again some perturbation (a "background noise") is added -* to drown denormals - IF ( L2PERT ) THEN -* XSC = DSQRT(SMALL) - XSC = EPSLN / DBLE(N) - DO 1947 q = 1, NR - TEMP1 = XSC*DABS(A(q,q)) - DO 1949 p = 1, NR - IF ( ( (p.GT.q) .AND. (DABS(A(p,q)).LE.TEMP1) ) - $ .OR. ( p .LT. q ) ) - $ A(p,q) = DSIGN( TEMP1, A(p,q) ) - 1949 CONTINUE - 1947 CONTINUE - ELSE - CALL DLASET( 'U', NR-1, NR-1, ZERO, ZERO, A(1,2), LDA ) - END IF -* -* .. and one-sided Jacobi rotations are started on a lower -* triangular matrix (plus perturbation which is ignored in -* the part which destroys triangular form (confusing?!)) -* - CALL DGESVJ( 'L', 'NoU', 'NoV', NR, NR, A, LDA, SVA, - $ N, V, LDV, WORK, LWORK, INFO ) -* - SCALEM = WORK(1) - NUMRANK = IDNINT(WORK(2)) -* -* - ELSE IF ( RSVEC .AND. ( .NOT. LSVEC ) ) THEN -* -* -> Singular Values and Right Singular Vectors <- -* - IF ( ALMORT ) THEN -* -* .. in this case NR equals N - DO 1998 p = 1, NR - CALL DCOPY( N-p+1, A(p,p), LDA, V(p,p), 1 ) - 1998 CONTINUE - CALL DLASET( 'Upper', NR-1, NR-1, ZERO, ZERO, V(1,2), LDV ) -* - CALL DGESVJ( 'L','U','N', N, NR, V,LDV, SVA, NR, A,LDA, - $ WORK, LWORK, INFO ) - SCALEM = WORK(1) - NUMRANK = IDNINT(WORK(2)) - - ELSE -* -* .. two more QR factorizations ( one QRF is not enough, two require -* accumulated product of Jacobi rotations, three are perfect ) -* - CALL DLASET( 'Lower', NR-1, NR-1, ZERO, ZERO, A(2,1), LDA ) - CALL DGELQF( NR, N, A, LDA, WORK, WORK(N+1), LWORK-N, IERR) - CALL DLACPY( 'Lower', NR, NR, A, LDA, V, LDV ) - CALL DLASET( 'Upper', NR-1, NR-1, ZERO, ZERO, V(1,2), LDV ) - CALL DGEQRF( NR, NR, V, LDV, WORK(N+1), WORK(2*N+1), - $ LWORK-2*N, IERR ) - DO 8998 p = 1, NR - CALL DCOPY( NR-p+1, V(p,p), LDV, V(p,p), 1 ) - 8998 CONTINUE - CALL DLASET( 'Upper', NR-1, NR-1, ZERO, ZERO, V(1,2), LDV ) -* - CALL DGESVJ( 'Lower', 'U','N', NR, NR, V,LDV, SVA, NR, U, - $ LDU, WORK(N+1), LWORK, INFO ) - SCALEM = WORK(N+1) - NUMRANK = IDNINT(WORK(N+2)) - IF ( NR .LT. N ) THEN - CALL DLASET( 'A',N-NR, NR, ZERO,ZERO, V(NR+1,1), LDV ) - CALL DLASET( 'A',NR, N-NR, ZERO,ZERO, V(1,NR+1), LDV ) - CALL DLASET( 'A',N-NR,N-NR,ZERO,ONE, V(NR+1,NR+1), LDV ) - END IF -* - CALL DORMLQ( 'Left', 'Transpose', N, N, NR, A, LDA, WORK, - $ V, LDV, WORK(N+1), LWORK-N, IERR ) -* - END IF -* - DO 8991 p = 1, N - CALL DCOPY( N, V(p,1), LDV, A(IWORK(p),1), LDA ) - 8991 CONTINUE - CALL DLACPY( 'All', N, N, A, LDA, V, LDV ) -* - IF ( TRANSP ) THEN - CALL DLACPY( 'All', N, N, V, LDV, U, LDU ) - END IF -* - ELSE IF ( LSVEC .AND. ( .NOT. RSVEC ) ) THEN -* -* .. Singular Values and Left Singular Vectors .. -* -* .. second preconditioning step to avoid need to accumulate -* Jacobi rotations in the Jacobi iterations. - DO 1965 p = 1, NR - CALL DCOPY( N-p+1, A(p,p), LDA, U(p,p), 1 ) - 1965 CONTINUE - CALL DLASET( 'Upper', NR-1, NR-1, ZERO, ZERO, U(1,2), LDU ) -* - CALL DGEQRF( N, NR, U, LDU, WORK(N+1), WORK(2*N+1), - $ LWORK-2*N, IERR ) -* - DO 1967 p = 1, NR - 1 - CALL DCOPY( NR-p, U(p,p+1), LDU, U(p+1,p), 1 ) - 1967 CONTINUE - CALL DLASET( 'Upper', NR-1, NR-1, ZERO, ZERO, U(1,2), LDU ) -* - CALL DGESVJ( 'Lower', 'U', 'N', NR,NR, U, LDU, SVA, NR, A, - $ LDA, WORK(N+1), LWORK-N, INFO ) - SCALEM = WORK(N+1) - NUMRANK = IDNINT(WORK(N+2)) -* - IF ( NR .LT. M ) THEN - CALL DLASET( 'A', M-NR, NR,ZERO, ZERO, U(NR+1,1), LDU ) - IF ( NR .LT. N1 ) THEN - CALL DLASET( 'A',NR, N1-NR, ZERO, ZERO, U(1,NR+1), LDU ) - CALL DLASET( 'A',M-NR,N1-NR,ZERO,ONE,U(NR+1,NR+1), LDU ) - END IF - END IF -* - CALL DORMQR( 'Left', 'No Tr', M, N1, N, A, LDA, WORK, U, - $ LDU, WORK(N+1), LWORK-N, IERR ) -* - IF ( ROWPIV ) - $ CALL DLASWP( N1, U, LDU, 1, M-1, IWORK(2*N+1), -1 ) -* - DO 1974 p = 1, N1 - XSC = ONE / DNRM2( M, U(1,p), 1 ) - CALL DSCAL( M, XSC, U(1,p), 1 ) - 1974 CONTINUE -* - IF ( TRANSP ) THEN - CALL DLACPY( 'All', N, N, U, LDU, V, LDV ) - END IF -* - ELSE -* -* .. Full SVD .. -* - IF ( .NOT. JRACC ) THEN -* - IF ( .NOT. ALMORT ) THEN -* -* Second Preconditioning Step (QRF [with pivoting]) -* Note that the composition of TRANSPOSE, QRF and TRANSPOSE is -* equivalent to an LQF CALL. Since in many libraries the QRF -* seems to be better optimized than the LQF, we do explicit -* transpose and use the QRF. This is subject to changes in an -* optimized implementation of DGEJSV. -* - DO 1968 p = 1, NR - CALL DCOPY( N-p+1, A(p,p), LDA, V(p,p), 1 ) - 1968 CONTINUE -* -* .. the following two loops perturb small entries to avoid -* denormals in the second QR factorization, where they are -* as good as zeros. This is done to avoid painfully slow -* computation with denormals. The relative size of the perturbation -* is a parameter that can be changed by the implementer. -* This perturbation device will be obsolete on machines with -* properly implemented arithmetic. -* To switch it off, set L2PERT=.FALSE. To remove it from the -* code, remove the action under L2PERT=.TRUE., leave the ELSE part. -* The following two loops should be blocked and fused with the -* transposed copy above. -* - IF ( L2PERT ) THEN - XSC = DSQRT(SMALL) - DO 2969 q = 1, NR - TEMP1 = XSC*DABS( V(q,q) ) - DO 2968 p = 1, N - IF ( ( p .GT. q ) .AND. ( DABS(V(p,q)) .LE. TEMP1 ) - $ .OR. ( p .LT. q ) ) - $ V(p,q) = DSIGN( TEMP1, V(p,q) ) - IF ( p .LT. q ) V(p,q) = - V(p,q) - 2968 CONTINUE - 2969 CONTINUE - ELSE - CALL DLASET( 'U', NR-1, NR-1, ZERO, ZERO, V(1,2), LDV ) - END IF -* -* Estimate the row scaled condition number of R1 -* (If R1 is rectangular, N > NR, then the condition number -* of the leading NR x NR submatrix is estimated.) -* - CALL DLACPY( 'L', NR, NR, V, LDV, WORK(2*N+1), NR ) - DO 3950 p = 1, NR - TEMP1 = DNRM2(NR-p+1,WORK(2*N+(p-1)*NR+p),1) - CALL DSCAL(NR-p+1,ONE/TEMP1,WORK(2*N+(p-1)*NR+p),1) - 3950 CONTINUE - CALL DPOCON('Lower',NR,WORK(2*N+1),NR,ONE,TEMP1, - $ WORK(2*N+NR*NR+1),IWORK(M+2*N+1),IERR) - CONDR1 = ONE / DSQRT(TEMP1) -* .. here need a second opinion on the condition number -* .. then assume worst case scenario -* R1 is OK for inverse <=> CONDR1 .LT. DBLE(N) -* more conservative <=> CONDR1 .LT. DSQRT(DBLE(N)) -* - COND_OK = DSQRT(DBLE(NR)) -*[TP] COND_OK is a tuning parameter. - - IF ( CONDR1 .LT. COND_OK ) THEN -* .. the second QRF without pivoting. Note: in an optimized -* implementation, this QRF should be implemented as the QRF -* of a lower triangular matrix. -* R1^t = Q2 * R2 - CALL DGEQRF( N, NR, V, LDV, WORK(N+1), WORK(2*N+1), - $ LWORK-2*N, IERR ) -* - IF ( L2PERT ) THEN - XSC = DSQRT(SMALL)/EPSLN - DO 3959 p = 2, NR - DO 3958 q = 1, p - 1 - TEMP1 = XSC * MIN(DABS(V(p,p)),DABS(V(q,q))) - IF ( DABS(V(q,p)) .LE. TEMP1 ) - $ V(q,p) = DSIGN( TEMP1, V(q,p) ) - 3958 CONTINUE - 3959 CONTINUE - END IF -* - IF ( NR .NE. N ) - $ CALL DLACPY( 'A', N, NR, V, LDV, WORK(2*N+1), N ) -* .. save ... -* -* .. this transposed copy should be better than naive - DO 1969 p = 1, NR - 1 - CALL DCOPY( NR-p, V(p,p+1), LDV, V(p+1,p), 1 ) - 1969 CONTINUE -* - CONDR2 = CONDR1 -* - ELSE -* -* .. ill-conditioned case: second QRF with pivoting -* Note that windowed pivoting would be equally good -* numerically, and more run-time efficient. So, in -* an optimal implementation, the next call to DGEQP3 -* should be replaced with eg. CALL SGEQPX (ACM TOMS #782) -* with properly (carefully) chosen parameters. -* -* R1^t * P2 = Q2 * R2 - DO 3003 p = 1, NR - IWORK(N+p) = 0 - 3003 CONTINUE - CALL DGEQP3( N, NR, V, LDV, IWORK(N+1), WORK(N+1), - $ WORK(2*N+1), LWORK-2*N, IERR ) -** CALL DGEQRF( N, NR, V, LDV, WORK(N+1), WORK(2*N+1), -** $ LWORK-2*N, IERR ) - IF ( L2PERT ) THEN - XSC = DSQRT(SMALL) - DO 3969 p = 2, NR - DO 3968 q = 1, p - 1 - TEMP1 = XSC * MIN(DABS(V(p,p)),DABS(V(q,q))) - IF ( DABS(V(q,p)) .LE. TEMP1 ) - $ V(q,p) = DSIGN( TEMP1, V(q,p) ) - 3968 CONTINUE - 3969 CONTINUE - END IF -* - CALL DLACPY( 'A', N, NR, V, LDV, WORK(2*N+1), N ) -* - IF ( L2PERT ) THEN - XSC = DSQRT(SMALL) - DO 8970 p = 2, NR - DO 8971 q = 1, p - 1 - TEMP1 = XSC * MIN(DABS(V(p,p)),DABS(V(q,q))) - V(p,q) = - DSIGN( TEMP1, V(q,p) ) - 8971 CONTINUE - 8970 CONTINUE - ELSE - CALL DLASET( 'L',NR-1,NR-1,ZERO,ZERO,V(2,1),LDV ) - END IF -* Now, compute R2 = L3 * Q3, the LQ factorization. - CALL DGELQF( NR, NR, V, LDV, WORK(2*N+N*NR+1), - $ WORK(2*N+N*NR+NR+1), LWORK-2*N-N*NR-NR, IERR ) -* .. and estimate the condition number - CALL DLACPY( 'L',NR,NR,V,LDV,WORK(2*N+N*NR+NR+1),NR ) - DO 4950 p = 1, NR - TEMP1 = DNRM2( p, WORK(2*N+N*NR+NR+p), NR ) - CALL DSCAL( p, ONE/TEMP1, WORK(2*N+N*NR+NR+p), NR ) - 4950 CONTINUE - CALL DPOCON( 'L',NR,WORK(2*N+N*NR+NR+1),NR,ONE,TEMP1, - $ WORK(2*N+N*NR+NR+NR*NR+1),IWORK(M+2*N+1),IERR ) - CONDR2 = ONE / DSQRT(TEMP1) -* - IF ( CONDR2 .GE. COND_OK ) THEN -* .. save the Householder vectors used for Q3 -* (this overwrites the copy of R2, as it will not be -* needed in this branch, but it does not overwritte the -* Huseholder vectors of Q2.). - CALL DLACPY( 'U', NR, NR, V, LDV, WORK(2*N+1), N ) -* .. and the rest of the information on Q3 is in -* WORK(2*N+N*NR+1:2*N+N*NR+N) - END IF -* - END IF -* - IF ( L2PERT ) THEN - XSC = DSQRT(SMALL) - DO 4968 q = 2, NR - TEMP1 = XSC * V(q,q) - DO 4969 p = 1, q - 1 -* V(p,q) = - DSIGN( TEMP1, V(q,p) ) - V(p,q) = - DSIGN( TEMP1, V(p,q) ) - 4969 CONTINUE - 4968 CONTINUE - ELSE - CALL DLASET( 'U', NR-1,NR-1, ZERO,ZERO, V(1,2), LDV ) - END IF -* -* Second preconditioning finished; continue with Jacobi SVD -* The input matrix is lower trinagular. -* -* Recover the right singular vectors as solution of a well -* conditioned triangular matrix equation. -* - IF ( CONDR1 .LT. COND_OK ) THEN -* - CALL DGESVJ( 'L','U','N',NR,NR,V,LDV,SVA,NR,U, - $ LDU,WORK(2*N+N*NR+NR+1),LWORK-2*N-N*NR-NR,INFO ) - SCALEM = WORK(2*N+N*NR+NR+1) - NUMRANK = IDNINT(WORK(2*N+N*NR+NR+2)) - DO 3970 p = 1, NR - CALL DCOPY( NR, V(1,p), 1, U(1,p), 1 ) - CALL DSCAL( NR, SVA(p), V(1,p), 1 ) - 3970 CONTINUE - -* .. pick the right matrix equation and solve it -* - IF ( NR .EQ. N ) THEN -* :)) .. best case, R1 is inverted. The solution of this matrix -* equation is Q2*V2 = the product of the Jacobi rotations -* used in DGESVJ, premultiplied with the orthogonal matrix -* from the second QR factorization. - CALL DTRSM( 'L','U','N','N', NR,NR,ONE, A,LDA, V,LDV ) - ELSE -* .. R1 is well conditioned, but non-square. Transpose(R2) -* is inverted to get the product of the Jacobi rotations -* used in DGESVJ. The Q-factor from the second QR -* factorization is then built in explicitly. - CALL DTRSM('L','U','T','N',NR,NR,ONE,WORK(2*N+1), - $ N,V,LDV) - IF ( NR .LT. N ) THEN - CALL DLASET('A',N-NR,NR,ZERO,ZERO,V(NR+1,1),LDV) - CALL DLASET('A',NR,N-NR,ZERO,ZERO,V(1,NR+1),LDV) - CALL DLASET('A',N-NR,N-NR,ZERO,ONE,V(NR+1,NR+1),LDV) - END IF - CALL DORMQR('L','N',N,N,NR,WORK(2*N+1),N,WORK(N+1), - $ V,LDV,WORK(2*N+N*NR+NR+1),LWORK-2*N-N*NR-NR,IERR) - END IF -* - ELSE IF ( CONDR2 .LT. COND_OK ) THEN -* -* :) .. the input matrix A is very likely a relative of -* the Kahan matrix :) -* The matrix R2 is inverted. The solution of the matrix equation -* is Q3^T*V3 = the product of the Jacobi rotations (appplied to -* the lower triangular L3 from the LQ factorization of -* R2=L3*Q3), pre-multiplied with the transposed Q3. - CALL DGESVJ( 'L', 'U', 'N', NR, NR, V, LDV, SVA, NR, U, - $ LDU, WORK(2*N+N*NR+NR+1), LWORK-2*N-N*NR-NR, INFO ) - SCALEM = WORK(2*N+N*NR+NR+1) - NUMRANK = IDNINT(WORK(2*N+N*NR+NR+2)) - DO 3870 p = 1, NR - CALL DCOPY( NR, V(1,p), 1, U(1,p), 1 ) - CALL DSCAL( NR, SVA(p), U(1,p), 1 ) - 3870 CONTINUE - CALL DTRSM('L','U','N','N',NR,NR,ONE,WORK(2*N+1),N,U,LDU) -* .. apply the permutation from the second QR factorization - DO 873 q = 1, NR - DO 872 p = 1, NR - WORK(2*N+N*NR+NR+IWORK(N+p)) = U(p,q) - 872 CONTINUE - DO 874 p = 1, NR - U(p,q) = WORK(2*N+N*NR+NR+p) - 874 CONTINUE - 873 CONTINUE - IF ( NR .LT. N ) THEN - CALL DLASET( 'A',N-NR,NR,ZERO,ZERO,V(NR+1,1),LDV ) - CALL DLASET( 'A',NR,N-NR,ZERO,ZERO,V(1,NR+1),LDV ) - CALL DLASET( 'A',N-NR,N-NR,ZERO,ONE,V(NR+1,NR+1),LDV ) - END IF - CALL DORMQR( 'L','N',N,N,NR,WORK(2*N+1),N,WORK(N+1), - $ V,LDV,WORK(2*N+N*NR+NR+1),LWORK-2*N-N*NR-NR,IERR ) - ELSE -* Last line of defense. -* #:( This is a rather pathological case: no scaled condition -* improvement after two pivoted QR factorizations. Other -* possibility is that the rank revealing QR factorization -* or the condition estimator has failed, or the COND_OK -* is set very close to ONE (which is unnecessary). Normally, -* this branch should never be executed, but in rare cases of -* failure of the RRQR or condition estimator, the last line of -* defense ensures that DGEJSV completes the task. -* Compute the full SVD of L3 using DGESVJ with explicit -* accumulation of Jacobi rotations. - CALL DGESVJ( 'L', 'U', 'V', NR, NR, V, LDV, SVA, NR, U, - $ LDU, WORK(2*N+N*NR+NR+1), LWORK-2*N-N*NR-NR, INFO ) - SCALEM = WORK(2*N+N*NR+NR+1) - NUMRANK = IDNINT(WORK(2*N+N*NR+NR+2)) - IF ( NR .LT. N ) THEN - CALL DLASET( 'A',N-NR,NR,ZERO,ZERO,V(NR+1,1),LDV ) - CALL DLASET( 'A',NR,N-NR,ZERO,ZERO,V(1,NR+1),LDV ) - CALL DLASET( 'A',N-NR,N-NR,ZERO,ONE,V(NR+1,NR+1),LDV ) - END IF - CALL DORMQR( 'L','N',N,N,NR,WORK(2*N+1),N,WORK(N+1), - $ V,LDV,WORK(2*N+N*NR+NR+1),LWORK-2*N-N*NR-NR,IERR ) -* - CALL DORMLQ( 'L', 'T', NR, NR, NR, WORK(2*N+1), N, - $ WORK(2*N+N*NR+1), U, LDU, WORK(2*N+N*NR+NR+1), - $ LWORK-2*N-N*NR-NR, IERR ) - DO 773 q = 1, NR - DO 772 p = 1, NR - WORK(2*N+N*NR+NR+IWORK(N+p)) = U(p,q) - 772 CONTINUE - DO 774 p = 1, NR - U(p,q) = WORK(2*N+N*NR+NR+p) - 774 CONTINUE - 773 CONTINUE -* - END IF -* -* Permute the rows of V using the (column) permutation from the -* first QRF. Also, scale the columns to make them unit in -* Euclidean norm. This applies to all cases. -* - TEMP1 = DSQRT(DBLE(N)) * EPSLN - DO 1972 q = 1, N - DO 972 p = 1, N - WORK(2*N+N*NR+NR+IWORK(p)) = V(p,q) - 972 CONTINUE - DO 973 p = 1, N - V(p,q) = WORK(2*N+N*NR+NR+p) - 973 CONTINUE - XSC = ONE / DNRM2( N, V(1,q), 1 ) - IF ( (XSC .LT. (ONE-TEMP1)) .OR. (XSC .GT. (ONE+TEMP1)) ) - $ CALL DSCAL( N, XSC, V(1,q), 1 ) - 1972 CONTINUE -* At this moment, V contains the right singular vectors of A. -* Next, assemble the left singular vector matrix U (M x N). - IF ( NR .LT. M ) THEN - CALL DLASET( 'A', M-NR, NR, ZERO, ZERO, U(NR+1,1), LDU ) - IF ( NR .LT. N1 ) THEN - CALL DLASET('A',NR,N1-NR,ZERO,ZERO,U(1,NR+1),LDU) - CALL DLASET('A',M-NR,N1-NR,ZERO,ONE,U(NR+1,NR+1),LDU) - END IF - END IF -* -* The Q matrix from the first QRF is built into the left singular -* matrix U. This applies to all cases. -* - CALL DORMQR( 'Left', 'No_Tr', M, N1, N, A, LDA, WORK, U, - $ LDU, WORK(N+1), LWORK-N, IERR ) - -* The columns of U are normalized. The cost is O(M*N) flops. - TEMP1 = DSQRT(DBLE(M)) * EPSLN - DO 1973 p = 1, NR - XSC = ONE / DNRM2( M, U(1,p), 1 ) - IF ( (XSC .LT. (ONE-TEMP1)) .OR. (XSC .GT. (ONE+TEMP1)) ) - $ CALL DSCAL( M, XSC, U(1,p), 1 ) - 1973 CONTINUE -* -* If the initial QRF is computed with row pivoting, the left -* singular vectors must be adjusted. -* - IF ( ROWPIV ) - $ CALL DLASWP( N1, U, LDU, 1, M-1, IWORK(2*N+1), -1 ) -* - ELSE -* -* .. the initial matrix A has almost orthogonal columns and -* the second QRF is not needed -* - CALL DLACPY( 'Upper', N, N, A, LDA, WORK(N+1), N ) - IF ( L2PERT ) THEN - XSC = DSQRT(SMALL) - DO 5970 p = 2, N - TEMP1 = XSC * WORK( N + (p-1)*N + p ) - DO 5971 q = 1, p - 1 - WORK(N+(q-1)*N+p)=-DSIGN(TEMP1,WORK(N+(p-1)*N+q)) - 5971 CONTINUE - 5970 CONTINUE - ELSE - CALL DLASET( 'Lower',N-1,N-1,ZERO,ZERO,WORK(N+2),N ) - END IF -* - CALL DGESVJ( 'Upper', 'U', 'N', N, N, WORK(N+1), N, SVA, - $ N, U, LDU, WORK(N+N*N+1), LWORK-N-N*N, INFO ) -* - SCALEM = WORK(N+N*N+1) - NUMRANK = IDNINT(WORK(N+N*N+2)) - DO 6970 p = 1, N - CALL DCOPY( N, WORK(N+(p-1)*N+1), 1, U(1,p), 1 ) - CALL DSCAL( N, SVA(p), WORK(N+(p-1)*N+1), 1 ) - 6970 CONTINUE -* - CALL DTRSM( 'Left', 'Upper', 'NoTrans', 'No UD', N, N, - $ ONE, A, LDA, WORK(N+1), N ) - DO 6972 p = 1, N - CALL DCOPY( N, WORK(N+p), N, V(IWORK(p),1), LDV ) - 6972 CONTINUE - TEMP1 = DSQRT(DBLE(N))*EPSLN - DO 6971 p = 1, N - XSC = ONE / DNRM2( N, V(1,p), 1 ) - IF ( (XSC .LT. (ONE-TEMP1)) .OR. (XSC .GT. (ONE+TEMP1)) ) - $ CALL DSCAL( N, XSC, V(1,p), 1 ) - 6971 CONTINUE -* -* Assemble the left singular vector matrix U (M x N). -* - IF ( N .LT. M ) THEN - CALL DLASET( 'A', M-N, N, ZERO, ZERO, U(N+1,1), LDU ) - IF ( N .LT. N1 ) THEN - CALL DLASET( 'A',N, N1-N, ZERO, ZERO, U(1,N+1),LDU ) - CALL DLASET( 'A',M-N,N1-N, ZERO, ONE,U(N+1,N+1),LDU ) - END IF - END IF - CALL DORMQR( 'Left', 'No Tr', M, N1, N, A, LDA, WORK, U, - $ LDU, WORK(N+1), LWORK-N, IERR ) - TEMP1 = DSQRT(DBLE(M))*EPSLN - DO 6973 p = 1, N1 - XSC = ONE / DNRM2( M, U(1,p), 1 ) - IF ( (XSC .LT. (ONE-TEMP1)) .OR. (XSC .GT. (ONE+TEMP1)) ) - $ CALL DSCAL( M, XSC, U(1,p), 1 ) - 6973 CONTINUE -* - IF ( ROWPIV ) - $ CALL DLASWP( N1, U, LDU, 1, M-1, IWORK(2*N+1), -1 ) -* - END IF -* -* end of the >> almost orthogonal case << in the full SVD -* - ELSE -* -* This branch deploys a preconditioned Jacobi SVD with explicitly -* accumulated rotations. It is included as optional, mainly for -* experimental purposes. It does perform well, and can also be used. -* In this implementation, this branch will be automatically activated -* if the condition number sigma_max(A) / sigma_min(A) is predicted -* to be greater than the overflow threshold. This is because the -* a posteriori computation of the singular vectors assumes robust -* implementation of BLAS and some LAPACK procedures, capable of working -* in presence of extreme values. Since that is not always the case, ... -* - DO 7968 p = 1, NR - CALL DCOPY( N-p+1, A(p,p), LDA, V(p,p), 1 ) - 7968 CONTINUE -* - IF ( L2PERT ) THEN - XSC = DSQRT(SMALL/EPSLN) - DO 5969 q = 1, NR - TEMP1 = XSC*DABS( V(q,q) ) - DO 5968 p = 1, N - IF ( ( p .GT. q ) .AND. ( DABS(V(p,q)) .LE. TEMP1 ) - $ .OR. ( p .LT. q ) ) - $ V(p,q) = DSIGN( TEMP1, V(p,q) ) - IF ( p .LT. q ) V(p,q) = - V(p,q) - 5968 CONTINUE - 5969 CONTINUE - ELSE - CALL DLASET( 'U', NR-1, NR-1, ZERO, ZERO, V(1,2), LDV ) - END IF - - CALL DGEQRF( N, NR, V, LDV, WORK(N+1), WORK(2*N+1), - $ LWORK-2*N, IERR ) - CALL DLACPY( 'L', N, NR, V, LDV, WORK(2*N+1), N ) -* - DO 7969 p = 1, NR - CALL DCOPY( NR-p+1, V(p,p), LDV, U(p,p), 1 ) - 7969 CONTINUE - - IF ( L2PERT ) THEN - XSC = DSQRT(SMALL/EPSLN) - DO 9970 q = 2, NR - DO 9971 p = 1, q - 1 - TEMP1 = XSC * MIN(DABS(U(p,p)),DABS(U(q,q))) - U(p,q) = - DSIGN( TEMP1, U(q,p) ) - 9971 CONTINUE - 9970 CONTINUE - ELSE - CALL DLASET('U', NR-1, NR-1, ZERO, ZERO, U(1,2), LDU ) - END IF - - CALL DGESVJ( 'G', 'U', 'V', NR, NR, U, LDU, SVA, - $ N, V, LDV, WORK(2*N+N*NR+1), LWORK-2*N-N*NR, INFO ) - SCALEM = WORK(2*N+N*NR+1) - NUMRANK = IDNINT(WORK(2*N+N*NR+2)) - - IF ( NR .LT. N ) THEN - CALL DLASET( 'A',N-NR,NR,ZERO,ZERO,V(NR+1,1),LDV ) - CALL DLASET( 'A',NR,N-NR,ZERO,ZERO,V(1,NR+1),LDV ) - CALL DLASET( 'A',N-NR,N-NR,ZERO,ONE,V(NR+1,NR+1),LDV ) - END IF - - CALL DORMQR( 'L','N',N,N,NR,WORK(2*N+1),N,WORK(N+1), - $ V,LDV,WORK(2*N+N*NR+NR+1),LWORK-2*N-N*NR-NR,IERR ) -* -* Permute the rows of V using the (column) permutation from the -* first QRF. Also, scale the columns to make them unit in -* Euclidean norm. This applies to all cases. -* - TEMP1 = DSQRT(DBLE(N)) * EPSLN - DO 7972 q = 1, N - DO 8972 p = 1, N - WORK(2*N+N*NR+NR+IWORK(p)) = V(p,q) - 8972 CONTINUE - DO 8973 p = 1, N - V(p,q) = WORK(2*N+N*NR+NR+p) - 8973 CONTINUE - XSC = ONE / DNRM2( N, V(1,q), 1 ) - IF ( (XSC .LT. (ONE-TEMP1)) .OR. (XSC .GT. (ONE+TEMP1)) ) - $ CALL DSCAL( N, XSC, V(1,q), 1 ) - 7972 CONTINUE -* -* At this moment, V contains the right singular vectors of A. -* Next, assemble the left singular vector matrix U (M x N). -* - IF ( NR .LT. M ) THEN - CALL DLASET( 'A', M-NR, NR, ZERO, ZERO, U(NR+1,1), LDU ) - IF ( NR .LT. N1 ) THEN - CALL DLASET( 'A',NR, N1-NR, ZERO, ZERO, U(1,NR+1),LDU ) - CALL DLASET( 'A',M-NR,N1-NR, ZERO, ONE,U(NR+1,NR+1),LDU ) - END IF - END IF -* - CALL DORMQR( 'Left', 'No Tr', M, N1, N, A, LDA, WORK, U, - $ LDU, WORK(N+1), LWORK-N, IERR ) -* - IF ( ROWPIV ) - $ CALL DLASWP( N1, U, LDU, 1, M-1, IWORK(2*N+1), -1 ) -* -* - END IF - IF ( TRANSP ) THEN -* .. swap U and V because the procedure worked on A^t - DO 6974 p = 1, N - CALL DSWAP( N, U(1,p), 1, V(1,p), 1 ) - 6974 CONTINUE - END IF -* - END IF -* end of the full SVD -* -* Undo scaling, if necessary (and possible) -* - IF ( USCAL2 .LE. (BIG/SVA(1))*USCAL1 ) THEN - CALL DLASCL( 'G', 0, 0, USCAL1, USCAL2, NR, 1, SVA, N, IERR ) - USCAL1 = ONE - USCAL2 = ONE - END IF -* - IF ( NR .LT. N ) THEN - DO 3004 p = NR+1, N - SVA(p) = ZERO - 3004 CONTINUE - END IF -* - WORK(1) = USCAL2 * SCALEM - WORK(2) = USCAL1 - IF ( ERREST ) WORK(3) = SCONDA - IF ( LSVEC .AND. RSVEC ) THEN - WORK(4) = CONDR1 - WORK(5) = CONDR2 - END IF - IF ( L2TRAN ) THEN - WORK(6) = ENTRA - WORK(7) = ENTRAT - END IF -* - IWORK(1) = NR - IWORK(2) = NUMRANK - IWORK(3) = WARNING -* - RETURN -* .. -* .. END OF DGEJSV -* .. - END -* From e4b695d7982f7df0539a23932ab99c17938a2fc8 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Thu, 4 Apr 2024 11:44:55 +0200 Subject: [PATCH 301/311] Fix typos and errors in comments (Reference-LAPACK 809) --- lapack-netlib/SRC/cgbsvx.f | 2 +- lapack-netlib/SRC/cgesvx.f | 2 +- lapack-netlib/SRC/dgbsvx.f | 2 +- lapack-netlib/SRC/dgesvx.f | 2 +- lapack-netlib/SRC/sgbsvx.f | 2 +- lapack-netlib/SRC/sgesvx.f | 2 +- lapack-netlib/SRC/zgbsvx.f | 2 +- lapack-netlib/SRC/zgesvx.f | 2 +- 8 files changed, 8 insertions(+), 8 deletions(-) diff --git a/lapack-netlib/SRC/cgbsvx.f b/lapack-netlib/SRC/cgbsvx.f index 7b6770d20..eaab5682c 100644 --- a/lapack-netlib/SRC/cgbsvx.f +++ b/lapack-netlib/SRC/cgbsvx.f @@ -322,7 +322,7 @@ *> *> \param[out] RWORK *> \verbatim -*> RWORK is REAL array, dimension (N) +*> RWORK is REAL array, dimension (MAX(1,N)) *> On exit, RWORK(1) contains the reciprocal pivot growth *> factor norm(A)/norm(U). The "max absolute element" norm is *> used. If RWORK(1) is much less than 1, then the stability diff --git a/lapack-netlib/SRC/cgesvx.f b/lapack-netlib/SRC/cgesvx.f index 66c714bb1..74a37e9a0 100644 --- a/lapack-netlib/SRC/cgesvx.f +++ b/lapack-netlib/SRC/cgesvx.f @@ -302,7 +302,7 @@ *> *> \param[out] RWORK *> \verbatim -*> RWORK is REAL array, dimension (2*N) +*> RWORK is REAL array, dimension (MAX(1,2*N)) *> On exit, RWORK(1) contains the reciprocal pivot growth *> factor norm(A)/norm(U). The "max absolute element" norm is *> used. If RWORK(1) is much less than 1, then the stability diff --git a/lapack-netlib/SRC/dgbsvx.f b/lapack-netlib/SRC/dgbsvx.f index 030f28f0a..0ee5eecb3 100644 --- a/lapack-netlib/SRC/dgbsvx.f +++ b/lapack-netlib/SRC/dgbsvx.f @@ -316,7 +316,7 @@ *> *> \param[out] WORK *> \verbatim -*> WORK is DOUBLE PRECISION array, dimension (3*N) +*> WORK is DOUBLE PRECISION array, dimension (MAX(1,3*N)) *> On exit, WORK(1) contains the reciprocal pivot growth *> factor norm(A)/norm(U). The "max absolute element" norm is *> used. If WORK(1) is much less than 1, then the stability diff --git a/lapack-netlib/SRC/dgesvx.f b/lapack-netlib/SRC/dgesvx.f index 4dc1d83cf..f787488dc 100644 --- a/lapack-netlib/SRC/dgesvx.f +++ b/lapack-netlib/SRC/dgesvx.f @@ -296,7 +296,7 @@ *> *> \param[out] WORK *> \verbatim -*> WORK is DOUBLE PRECISION array, dimension (4*N) +*> WORK is DOUBLE PRECISION array, dimension (MAX(1,4*N)) *> On exit, WORK(1) contains the reciprocal pivot growth *> factor norm(A)/norm(U). The "max absolute element" norm is *> used. If WORK(1) is much less than 1, then the stability diff --git a/lapack-netlib/SRC/sgbsvx.f b/lapack-netlib/SRC/sgbsvx.f index 40829a71b..df3a721d9 100644 --- a/lapack-netlib/SRC/sgbsvx.f +++ b/lapack-netlib/SRC/sgbsvx.f @@ -316,7 +316,7 @@ *> *> \param[out] WORK *> \verbatim -*> WORK is REAL array, dimension (3*N) +*> WORK is REAL array, dimension (MAX(1,3*N)) *> On exit, WORK(1) contains the reciprocal pivot growth *> factor norm(A)/norm(U). The "max absolute element" norm is *> used. If WORK(1) is much less than 1, then the stability diff --git a/lapack-netlib/SRC/sgesvx.f b/lapack-netlib/SRC/sgesvx.f index 930b88c33..385e626cf 100644 --- a/lapack-netlib/SRC/sgesvx.f +++ b/lapack-netlib/SRC/sgesvx.f @@ -296,7 +296,7 @@ *> *> \param[out] WORK *> \verbatim -*> WORK is REAL array, dimension (4*N) +*> WORK is REAL array, dimension (MAX(1,4*N)) *> On exit, WORK(1) contains the reciprocal pivot growth *> factor norm(A)/norm(U). The "max absolute element" norm is *> used. If WORK(1) is much less than 1, then the stability diff --git a/lapack-netlib/SRC/zgbsvx.f b/lapack-netlib/SRC/zgbsvx.f index b6be78663..871564a81 100644 --- a/lapack-netlib/SRC/zgbsvx.f +++ b/lapack-netlib/SRC/zgbsvx.f @@ -322,7 +322,7 @@ *> *> \param[out] RWORK *> \verbatim -*> RWORK is DOUBLE PRECISION array, dimension (N) +*> RWORK is DOUBLE PRECISION array, dimension (MAX(1,N)) *> On exit, RWORK(1) contains the reciprocal pivot growth *> factor norm(A)/norm(U). The "max absolute element" norm is *> used. If RWORK(1) is much less than 1, then the stability diff --git a/lapack-netlib/SRC/zgesvx.f b/lapack-netlib/SRC/zgesvx.f index 87f36bba6..3b193a1b2 100644 --- a/lapack-netlib/SRC/zgesvx.f +++ b/lapack-netlib/SRC/zgesvx.f @@ -302,7 +302,7 @@ *> *> \param[out] RWORK *> \verbatim -*> RWORK is DOUBLE PRECISION array, dimension (2*N) +*> RWORK is DOUBLE PRECISION array, dimension (MAX(1,2*N)) *> On exit, RWORK(1) contains the reciprocal pivot growth *> factor norm(A)/norm(U). The "max absolute element" norm is *> used. If RWORK(1) is much less than 1, then the stability From 587b193e233af392f9a417c9dda5503c613bc658 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Thu, 4 Apr 2024 11:45:43 +0200 Subject: [PATCH 302/311] Delete misplaced file (move to SRC) --- lapack-netlib/cgbsvx.f | 644 ----------------------------------------- 1 file changed, 644 deletions(-) delete mode 100644 lapack-netlib/cgbsvx.f diff --git a/lapack-netlib/cgbsvx.f b/lapack-netlib/cgbsvx.f deleted file mode 100644 index eaab5682c..000000000 --- a/lapack-netlib/cgbsvx.f +++ /dev/null @@ -1,644 +0,0 @@ -*> \brief CGBSVX computes the solution to system of linear equations A * X = B for GB matrices -* -* =========== DOCUMENTATION =========== -* -* Online html documentation available at -* http://www.netlib.org/lapack/explore-html/ -* -*> \htmlonly -*> Download CGBSVX + dependencies -*> -*> [TGZ] -*> -*> [ZIP] -*> -*> [TXT] -*> \endhtmlonly -* -* Definition: -* =========== -* -* SUBROUTINE CGBSVX( FACT, TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, -* LDAFB, IPIV, EQUED, R, C, B, LDB, X, LDX, -* RCOND, FERR, BERR, WORK, RWORK, INFO ) -* -* .. Scalar Arguments .. -* CHARACTER EQUED, FACT, TRANS -* INTEGER INFO, KL, KU, LDAB, LDAFB, LDB, LDX, N, NRHS -* REAL RCOND -* .. -* .. Array Arguments .. -* INTEGER IPIV( * ) -* REAL BERR( * ), C( * ), FERR( * ), R( * ), -* $ RWORK( * ) -* COMPLEX AB( LDAB, * ), AFB( LDAFB, * ), B( LDB, * ), -* $ WORK( * ), X( LDX, * ) -* .. -* -* -*> \par Purpose: -* ============= -*> -*> \verbatim -*> -*> CGBSVX uses the LU factorization to compute the solution to a complex -*> system of linear equations A * X = B, A**T * X = B, or A**H * X = B, -*> where A is a band matrix of order N with KL subdiagonals and KU -*> superdiagonals, and X and B are N-by-NRHS matrices. -*> -*> Error bounds on the solution and a condition estimate are also -*> provided. -*> \endverbatim -* -*> \par Description: -* ================= -*> -*> \verbatim -*> -*> The following steps are performed by this subroutine: -*> -*> 1. If FACT = 'E', real scaling factors are computed to equilibrate -*> the system: -*> TRANS = 'N': diag(R)*A*diag(C) *inv(diag(C))*X = diag(R)*B -*> TRANS = 'T': (diag(R)*A*diag(C))**T *inv(diag(R))*X = diag(C)*B -*> TRANS = 'C': (diag(R)*A*diag(C))**H *inv(diag(R))*X = diag(C)*B -*> Whether or not the system will be equilibrated depends on the -*> scaling of the matrix A, but if equilibration is used, A is -*> overwritten by diag(R)*A*diag(C) and B by diag(R)*B (if TRANS='N') -*> or diag(C)*B (if TRANS = 'T' or 'C'). -*> -*> 2. If FACT = 'N' or 'E', the LU decomposition is used to factor the -*> matrix A (after equilibration if FACT = 'E') as -*> A = L * U, -*> where L is a product of permutation and unit lower triangular -*> matrices with KL subdiagonals, and U is upper triangular with -*> KL+KU superdiagonals. -*> -*> 3. If some U(i,i)=0, so that U is exactly singular, then the routine -*> returns with INFO = i. Otherwise, the factored form of A is used -*> to estimate the condition number of the matrix A. If the -*> reciprocal of the condition number is less than machine precision, -*> INFO = N+1 is returned as a warning, but the routine still goes on -*> to solve for X and compute error bounds as described below. -*> -*> 4. The system of equations is solved for X using the factored form -*> of A. -*> -*> 5. Iterative refinement is applied to improve the computed solution -*> matrix and calculate error bounds and backward error estimates -*> for it. -*> -*> 6. If equilibration was used, the matrix X is premultiplied by -*> diag(C) (if TRANS = 'N') or diag(R) (if TRANS = 'T' or 'C') so -*> that it solves the original system before equilibration. -*> \endverbatim -* -* Arguments: -* ========== -* -*> \param[in] FACT -*> \verbatim -*> FACT is CHARACTER*1 -*> Specifies whether or not the factored form of the matrix A is -*> supplied on entry, and if not, whether the matrix A should be -*> equilibrated before it is factored. -*> = 'F': On entry, AFB and IPIV contain the factored form of -*> A. If EQUED is not 'N', the matrix A has been -*> equilibrated with scaling factors given by R and C. -*> AB, AFB, and IPIV are not modified. -*> = 'N': The matrix A will be copied to AFB and factored. -*> = 'E': The matrix A will be equilibrated if necessary, then -*> copied to AFB and factored. -*> \endverbatim -*> -*> \param[in] TRANS -*> \verbatim -*> TRANS is CHARACTER*1 -*> Specifies the form of the system of equations. -*> = 'N': A * X = B (No transpose) -*> = 'T': A**T * X = B (Transpose) -*> = 'C': A**H * X = B (Conjugate transpose) -*> \endverbatim -*> -*> \param[in] N -*> \verbatim -*> N is INTEGER -*> The number of linear equations, i.e., the order of the -*> matrix A. N >= 0. -*> \endverbatim -*> -*> \param[in] KL -*> \verbatim -*> KL is INTEGER -*> The number of subdiagonals within the band of A. KL >= 0. -*> \endverbatim -*> -*> \param[in] KU -*> \verbatim -*> KU is INTEGER -*> The number of superdiagonals within the band of A. KU >= 0. -*> \endverbatim -*> -*> \param[in] NRHS -*> \verbatim -*> NRHS is INTEGER -*> The number of right hand sides, i.e., the number of columns -*> of the matrices B and X. NRHS >= 0. -*> \endverbatim -*> -*> \param[in,out] AB -*> \verbatim -*> AB is COMPLEX array, dimension (LDAB,N) -*> On entry, the matrix A in band storage, in rows 1 to KL+KU+1. -*> The j-th column of A is stored in the j-th column of the -*> array AB as follows: -*> AB(KU+1+i-j,j) = A(i,j) for max(1,j-KU)<=i<=min(N,j+kl) -*> -*> If FACT = 'F' and EQUED is not 'N', then A must have been -*> equilibrated by the scaling factors in R and/or C. AB is not -*> modified if FACT = 'F' or 'N', or if FACT = 'E' and -*> EQUED = 'N' on exit. -*> -*> On exit, if EQUED .ne. 'N', A is scaled as follows: -*> EQUED = 'R': A := diag(R) * A -*> EQUED = 'C': A := A * diag(C) -*> EQUED = 'B': A := diag(R) * A * diag(C). -*> \endverbatim -*> -*> \param[in] LDAB -*> \verbatim -*> LDAB is INTEGER -*> The leading dimension of the array AB. LDAB >= KL+KU+1. -*> \endverbatim -*> -*> \param[in,out] AFB -*> \verbatim -*> AFB is COMPLEX array, dimension (LDAFB,N) -*> If FACT = 'F', then AFB is an input argument and on entry -*> contains details of the LU factorization of the band matrix -*> A, as computed by CGBTRF. U is stored as an upper triangular -*> band matrix with KL+KU superdiagonals in rows 1 to KL+KU+1, -*> and the multipliers used during the factorization are stored -*> in rows KL+KU+2 to 2*KL+KU+1. If EQUED .ne. 'N', then AFB is -*> the factored form of the equilibrated matrix A. -*> -*> If FACT = 'N', then AFB is an output argument and on exit -*> returns details of the LU factorization of A. -*> -*> If FACT = 'E', then AFB is an output argument and on exit -*> returns details of the LU factorization of the equilibrated -*> matrix A (see the description of AB for the form of the -*> equilibrated matrix). -*> \endverbatim -*> -*> \param[in] LDAFB -*> \verbatim -*> LDAFB is INTEGER -*> The leading dimension of the array AFB. LDAFB >= 2*KL+KU+1. -*> \endverbatim -*> -*> \param[in,out] IPIV -*> \verbatim -*> IPIV is INTEGER array, dimension (N) -*> If FACT = 'F', then IPIV is an input argument and on entry -*> contains the pivot indices from the factorization A = L*U -*> as computed by CGBTRF; row i of the matrix was interchanged -*> with row IPIV(i). -*> -*> If FACT = 'N', then IPIV is an output argument and on exit -*> contains the pivot indices from the factorization A = L*U -*> of the original matrix A. -*> -*> If FACT = 'E', then IPIV is an output argument and on exit -*> contains the pivot indices from the factorization A = L*U -*> of the equilibrated matrix A. -*> \endverbatim -*> -*> \param[in,out] EQUED -*> \verbatim -*> EQUED is CHARACTER*1 -*> Specifies the form of equilibration that was done. -*> = 'N': No equilibration (always true if FACT = 'N'). -*> = 'R': Row equilibration, i.e., A has been premultiplied by -*> diag(R). -*> = 'C': Column equilibration, i.e., A has been postmultiplied -*> by diag(C). -*> = 'B': Both row and column equilibration, i.e., A has been -*> replaced by diag(R) * A * diag(C). -*> EQUED is an input argument if FACT = 'F'; otherwise, it is an -*> output argument. -*> \endverbatim -*> -*> \param[in,out] R -*> \verbatim -*> R is REAL array, dimension (N) -*> The row scale factors for A. If EQUED = 'R' or 'B', A is -*> multiplied on the left by diag(R); if EQUED = 'N' or 'C', R -*> is not accessed. R is an input argument if FACT = 'F'; -*> otherwise, R is an output argument. If FACT = 'F' and -*> EQUED = 'R' or 'B', each element of R must be positive. -*> \endverbatim -*> -*> \param[in,out] C -*> \verbatim -*> C is REAL array, dimension (N) -*> The column scale factors for A. If EQUED = 'C' or 'B', A is -*> multiplied on the right by diag(C); if EQUED = 'N' or 'R', C -*> is not accessed. C is an input argument if FACT = 'F'; -*> otherwise, C is an output argument. If FACT = 'F' and -*> EQUED = 'C' or 'B', each element of C must be positive. -*> \endverbatim -*> -*> \param[in,out] B -*> \verbatim -*> B is COMPLEX array, dimension (LDB,NRHS) -*> On entry, the right hand side matrix B. -*> On exit, -*> if EQUED = 'N', B is not modified; -*> if TRANS = 'N' and EQUED = 'R' or 'B', B is overwritten by -*> diag(R)*B; -*> if TRANS = 'T' or 'C' and EQUED = 'C' or 'B', B is -*> overwritten by diag(C)*B. -*> \endverbatim -*> -*> \param[in] LDB -*> \verbatim -*> LDB is INTEGER -*> The leading dimension of the array B. LDB >= max(1,N). -*> \endverbatim -*> -*> \param[out] X -*> \verbatim -*> X is COMPLEX array, dimension (LDX,NRHS) -*> If INFO = 0 or INFO = N+1, the N-by-NRHS solution matrix X -*> to the original system of equations. Note that A and B are -*> modified on exit if EQUED .ne. 'N', and the solution to the -*> equilibrated system is inv(diag(C))*X if TRANS = 'N' and -*> EQUED = 'C' or 'B', or inv(diag(R))*X if TRANS = 'T' or 'C' -*> and EQUED = 'R' or 'B'. -*> \endverbatim -*> -*> \param[in] LDX -*> \verbatim -*> LDX is INTEGER -*> The leading dimension of the array X. LDX >= max(1,N). -*> \endverbatim -*> -*> \param[out] RCOND -*> \verbatim -*> RCOND is REAL -*> The estimate of the reciprocal condition number of the matrix -*> A after equilibration (if done). If RCOND is less than the -*> machine precision (in particular, if RCOND = 0), the matrix -*> is singular to working precision. This condition is -*> indicated by a return code of INFO > 0. -*> \endverbatim -*> -*> \param[out] FERR -*> \verbatim -*> FERR is REAL array, dimension (NRHS) -*> The estimated forward error bound for each solution vector -*> X(j) (the j-th column of the solution matrix X). -*> If XTRUE is the true solution corresponding to X(j), FERR(j) -*> is an estimated upper bound for the magnitude of the largest -*> element in (X(j) - XTRUE) divided by the magnitude of the -*> largest element in X(j). The estimate is as reliable as -*> the estimate for RCOND, and is almost always a slight -*> overestimate of the true error. -*> \endverbatim -*> -*> \param[out] BERR -*> \verbatim -*> BERR is REAL array, dimension (NRHS) -*> The componentwise relative backward error of each solution -*> vector X(j) (i.e., the smallest relative change in -*> any element of A or B that makes X(j) an exact solution). -*> \endverbatim -*> -*> \param[out] WORK -*> \verbatim -*> WORK is COMPLEX array, dimension (2*N) -*> \endverbatim -*> -*> \param[out] RWORK -*> \verbatim -*> RWORK is REAL array, dimension (MAX(1,N)) -*> On exit, RWORK(1) contains the reciprocal pivot growth -*> factor norm(A)/norm(U). The "max absolute element" norm is -*> used. If RWORK(1) is much less than 1, then the stability -*> of the LU factorization of the (equilibrated) matrix A -*> could be poor. This also means that the solution X, condition -*> estimator RCOND, and forward error bound FERR could be -*> unreliable. If factorization fails with 0 RWORK(1) contains the reciprocal pivot growth factor for the -*> leading INFO columns of A. -*> \endverbatim -*> -*> \param[out] INFO -*> \verbatim -*> INFO is INTEGER -*> = 0: successful exit -*> < 0: if INFO = -i, the i-th argument had an illegal value -*> > 0: if INFO = i, and i is -*> <= N: U(i,i) is exactly zero. The factorization -*> has been completed, but the factor U is exactly -*> singular, so the solution and error bounds -*> could not be computed. RCOND = 0 is returned. -*> = N+1: U is nonsingular, but RCOND is less than machine -*> precision, meaning that the matrix is singular -*> to working precision. Nevertheless, the -*> solution and error bounds are computed because -*> there are a number of situations where the -*> computed solution can be more accurate than the -*> value of RCOND would suggest. -*> \endverbatim -* -* Authors: -* ======== -* -*> \author Univ. of Tennessee -*> \author Univ. of California Berkeley -*> \author Univ. of Colorado Denver -*> \author NAG Ltd. -* -*> \ingroup complexGBsolve -* -* ===================================================================== - SUBROUTINE CGBSVX( FACT, TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, - $ LDAFB, IPIV, EQUED, R, C, B, LDB, X, LDX, - $ RCOND, FERR, BERR, WORK, RWORK, INFO ) -* -* -- LAPACK driver routine -- -* -- LAPACK is a software package provided by Univ. of Tennessee, -- -* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* -* .. Scalar Arguments .. - CHARACTER EQUED, FACT, TRANS - INTEGER INFO, KL, KU, LDAB, LDAFB, LDB, LDX, N, NRHS - REAL RCOND -* .. -* .. Array Arguments .. - INTEGER IPIV( * ) - REAL BERR( * ), C( * ), FERR( * ), R( * ), - $ RWORK( * ) - COMPLEX AB( LDAB, * ), AFB( LDAFB, * ), B( LDB, * ), - $ WORK( * ), X( LDX, * ) -* .. -* -* ===================================================================== -* Moved setting of INFO = N+1 so INFO does not subsequently get -* overwritten. Sven, 17 Mar 05. -* ===================================================================== -* -* .. Parameters .. - REAL ZERO, ONE - PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 ) -* .. -* .. Local Scalars .. - LOGICAL COLEQU, EQUIL, NOFACT, NOTRAN, ROWEQU - CHARACTER NORM - INTEGER I, INFEQU, J, J1, J2 - REAL AMAX, ANORM, BIGNUM, COLCND, RCMAX, RCMIN, - $ ROWCND, RPVGRW, SMLNUM -* .. -* .. External Functions .. - LOGICAL LSAME - REAL CLANGB, CLANTB, SLAMCH - EXTERNAL LSAME, CLANGB, CLANTB, SLAMCH -* .. -* .. External Subroutines .. - EXTERNAL CCOPY, CGBCON, CGBEQU, CGBRFS, CGBTRF, CGBTRS, - $ CLACPY, CLAQGB, XERBLA -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS, MAX, MIN -* .. -* .. Executable Statements .. -* - INFO = 0 - NOFACT = LSAME( FACT, 'N' ) - EQUIL = LSAME( FACT, 'E' ) - NOTRAN = LSAME( TRANS, 'N' ) - IF( NOFACT .OR. EQUIL ) THEN - EQUED = 'N' - ROWEQU = .FALSE. - COLEQU = .FALSE. - ELSE - ROWEQU = LSAME( EQUED, 'R' ) .OR. LSAME( EQUED, 'B' ) - COLEQU = LSAME( EQUED, 'C' ) .OR. LSAME( EQUED, 'B' ) - SMLNUM = SLAMCH( 'Safe minimum' ) - BIGNUM = ONE / SMLNUM - END IF -* -* Test the input parameters. -* - IF( .NOT.NOFACT .AND. .NOT.EQUIL .AND. .NOT.LSAME( FACT, 'F' ) ) - $ THEN - INFO = -1 - ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT. - $ LSAME( TRANS, 'C' ) ) THEN - INFO = -2 - ELSE IF( N.LT.0 ) THEN - INFO = -3 - ELSE IF( KL.LT.0 ) THEN - INFO = -4 - ELSE IF( KU.LT.0 ) THEN - INFO = -5 - ELSE IF( NRHS.LT.0 ) THEN - INFO = -6 - ELSE IF( LDAB.LT.KL+KU+1 ) THEN - INFO = -8 - ELSE IF( LDAFB.LT.2*KL+KU+1 ) THEN - INFO = -10 - ELSE IF( LSAME( FACT, 'F' ) .AND. .NOT. - $ ( ROWEQU .OR. COLEQU .OR. LSAME( EQUED, 'N' ) ) ) THEN - INFO = -12 - ELSE - IF( ROWEQU ) THEN - RCMIN = BIGNUM - RCMAX = ZERO - DO 10 J = 1, N - RCMIN = MIN( RCMIN, R( J ) ) - RCMAX = MAX( RCMAX, R( J ) ) - 10 CONTINUE - IF( RCMIN.LE.ZERO ) THEN - INFO = -13 - ELSE IF( N.GT.0 ) THEN - ROWCND = MAX( RCMIN, SMLNUM ) / MIN( RCMAX, BIGNUM ) - ELSE - ROWCND = ONE - END IF - END IF - IF( COLEQU .AND. INFO.EQ.0 ) THEN - RCMIN = BIGNUM - RCMAX = ZERO - DO 20 J = 1, N - RCMIN = MIN( RCMIN, C( J ) ) - RCMAX = MAX( RCMAX, C( J ) ) - 20 CONTINUE - IF( RCMIN.LE.ZERO ) THEN - INFO = -14 - ELSE IF( N.GT.0 ) THEN - COLCND = MAX( RCMIN, SMLNUM ) / MIN( RCMAX, BIGNUM ) - ELSE - COLCND = ONE - END IF - END IF - IF( INFO.EQ.0 ) THEN - IF( LDB.LT.MAX( 1, N ) ) THEN - INFO = -16 - ELSE IF( LDX.LT.MAX( 1, N ) ) THEN - INFO = -18 - END IF - END IF - END IF -* - IF( INFO.NE.0 ) THEN - CALL XERBLA( 'CGBSVX', -INFO ) - RETURN - END IF -* - IF( EQUIL ) THEN -* -* Compute row and column scalings to equilibrate the matrix A. -* - CALL CGBEQU( N, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND, - $ AMAX, INFEQU ) - IF( INFEQU.EQ.0 ) THEN -* -* Equilibrate the matrix. -* - CALL CLAQGB( N, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND, - $ AMAX, EQUED ) - ROWEQU = LSAME( EQUED, 'R' ) .OR. LSAME( EQUED, 'B' ) - COLEQU = LSAME( EQUED, 'C' ) .OR. LSAME( EQUED, 'B' ) - END IF - END IF -* -* Scale the right hand side. -* - IF( NOTRAN ) THEN - IF( ROWEQU ) THEN - DO 40 J = 1, NRHS - DO 30 I = 1, N - B( I, J ) = R( I )*B( I, J ) - 30 CONTINUE - 40 CONTINUE - END IF - ELSE IF( COLEQU ) THEN - DO 60 J = 1, NRHS - DO 50 I = 1, N - B( I, J ) = C( I )*B( I, J ) - 50 CONTINUE - 60 CONTINUE - END IF -* - IF( NOFACT .OR. EQUIL ) THEN -* -* Compute the LU factorization of the band matrix A. -* - DO 70 J = 1, N - J1 = MAX( J-KU, 1 ) - J2 = MIN( J+KL, N ) - CALL CCOPY( J2-J1+1, AB( KU+1-J+J1, J ), 1, - $ AFB( KL+KU+1-J+J1, J ), 1 ) - 70 CONTINUE -* - CALL CGBTRF( N, N, KL, KU, AFB, LDAFB, IPIV, INFO ) -* -* Return if INFO is non-zero. -* - IF( INFO.GT.0 ) THEN -* -* Compute the reciprocal pivot growth factor of the -* leading rank-deficient INFO columns of A. -* - ANORM = ZERO - DO 90 J = 1, INFO - DO 80 I = MAX( KU+2-J, 1 ), MIN( N+KU+1-J, KL+KU+1 ) - ANORM = MAX( ANORM, ABS( AB( I, J ) ) ) - 80 CONTINUE - 90 CONTINUE - RPVGRW = CLANTB( 'M', 'U', 'N', INFO, MIN( INFO-1, KL+KU ), - $ AFB( MAX( 1, KL+KU+2-INFO ), 1 ), LDAFB, - $ RWORK ) - IF( RPVGRW.EQ.ZERO ) THEN - RPVGRW = ONE - ELSE - RPVGRW = ANORM / RPVGRW - END IF - RWORK( 1 ) = RPVGRW - RCOND = ZERO - RETURN - END IF - END IF -* -* Compute the norm of the matrix A and the -* reciprocal pivot growth factor RPVGRW. -* - IF( NOTRAN ) THEN - NORM = '1' - ELSE - NORM = 'I' - END IF - ANORM = CLANGB( NORM, N, KL, KU, AB, LDAB, RWORK ) - RPVGRW = CLANTB( 'M', 'U', 'N', N, KL+KU, AFB, LDAFB, RWORK ) - IF( RPVGRW.EQ.ZERO ) THEN - RPVGRW = ONE - ELSE - RPVGRW = CLANGB( 'M', N, KL, KU, AB, LDAB, RWORK ) / RPVGRW - END IF -* -* Compute the reciprocal of the condition number of A. -* - CALL CGBCON( NORM, N, KL, KU, AFB, LDAFB, IPIV, ANORM, RCOND, - $ WORK, RWORK, INFO ) -* -* Compute the solution matrix X. -* - CALL CLACPY( 'Full', N, NRHS, B, LDB, X, LDX ) - CALL CGBTRS( TRANS, N, KL, KU, NRHS, AFB, LDAFB, IPIV, X, LDX, - $ INFO ) -* -* Use iterative refinement to improve the computed solution and -* compute error bounds and backward error estimates for it. -* - CALL CGBRFS( TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB, IPIV, - $ B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO ) -* -* Transform the solution matrix X to a solution of the original -* system. -* - IF( NOTRAN ) THEN - IF( COLEQU ) THEN - DO 110 J = 1, NRHS - DO 100 I = 1, N - X( I, J ) = C( I )*X( I, J ) - 100 CONTINUE - 110 CONTINUE - DO 120 J = 1, NRHS - FERR( J ) = FERR( J ) / COLCND - 120 CONTINUE - END IF - ELSE IF( ROWEQU ) THEN - DO 140 J = 1, NRHS - DO 130 I = 1, N - X( I, J ) = R( I )*X( I, J ) - 130 CONTINUE - 140 CONTINUE - DO 150 J = 1, NRHS - FERR( J ) = FERR( J ) / ROWCND - 150 CONTINUE - END IF -* -* Set INFO = N+1 if the matrix is singular to working precision. -* - IF( RCOND.LT.SLAMCH( 'Epsilon' ) ) - $ INFO = N + 1 -* - RWORK( 1 ) = RPVGRW - RETURN -* -* End of CGBSVX -* - END From 34fcd687ebf53b8c4725b7de4be562e5200c492d Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Thu, 4 Apr 2024 11:46:12 +0200 Subject: [PATCH 303/311] Delete misplaced file (move to SRC) --- lapack-netlib/cgesvx.f | 602 ----------------------------------------- 1 file changed, 602 deletions(-) delete mode 100644 lapack-netlib/cgesvx.f diff --git a/lapack-netlib/cgesvx.f b/lapack-netlib/cgesvx.f deleted file mode 100644 index 74a37e9a0..000000000 --- a/lapack-netlib/cgesvx.f +++ /dev/null @@ -1,602 +0,0 @@ -*> \brief CGESVX computes the solution to system of linear equations A * X = B for GE matrices -* -* =========== DOCUMENTATION =========== -* -* Online html documentation available at -* http://www.netlib.org/lapack/explore-html/ -* -*> \htmlonly -*> Download CGESVX + dependencies -*> -*> [TGZ] -*> -*> [ZIP] -*> -*> [TXT] -*> \endhtmlonly -* -* Definition: -* =========== -* -* SUBROUTINE CGESVX( FACT, TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, -* EQUED, R, C, B, LDB, X, LDX, RCOND, FERR, BERR, -* WORK, RWORK, INFO ) -* -* .. Scalar Arguments .. -* CHARACTER EQUED, FACT, TRANS -* INTEGER INFO, LDA, LDAF, LDB, LDX, N, NRHS -* REAL RCOND -* .. -* .. Array Arguments .. -* INTEGER IPIV( * ) -* REAL BERR( * ), C( * ), FERR( * ), R( * ), -* $ RWORK( * ) -* COMPLEX A( LDA, * ), AF( LDAF, * ), B( LDB, * ), -* $ WORK( * ), X( LDX, * ) -* .. -* -* -*> \par Purpose: -* ============= -*> -*> \verbatim -*> -*> CGESVX uses the LU factorization to compute the solution to a complex -*> system of linear equations -*> A * X = B, -*> where A is an N-by-N matrix and X and B are N-by-NRHS matrices. -*> -*> Error bounds on the solution and a condition estimate are also -*> provided. -*> \endverbatim -* -*> \par Description: -* ================= -*> -*> \verbatim -*> -*> The following steps are performed: -*> -*> 1. If FACT = 'E', real scaling factors are computed to equilibrate -*> the system: -*> TRANS = 'N': diag(R)*A*diag(C) *inv(diag(C))*X = diag(R)*B -*> TRANS = 'T': (diag(R)*A*diag(C))**T *inv(diag(R))*X = diag(C)*B -*> TRANS = 'C': (diag(R)*A*diag(C))**H *inv(diag(R))*X = diag(C)*B -*> Whether or not the system will be equilibrated depends on the -*> scaling of the matrix A, but if equilibration is used, A is -*> overwritten by diag(R)*A*diag(C) and B by diag(R)*B (if TRANS='N') -*> or diag(C)*B (if TRANS = 'T' or 'C'). -*> -*> 2. If FACT = 'N' or 'E', the LU decomposition is used to factor the -*> matrix A (after equilibration if FACT = 'E') as -*> A = P * L * U, -*> where P is a permutation matrix, L is a unit lower triangular -*> matrix, and U is upper triangular. -*> -*> 3. If some U(i,i)=0, so that U is exactly singular, then the routine -*> returns with INFO = i. Otherwise, the factored form of A is used -*> to estimate the condition number of the matrix A. If the -*> reciprocal of the condition number is less than machine precision, -*> INFO = N+1 is returned as a warning, but the routine still goes on -*> to solve for X and compute error bounds as described below. -*> -*> 4. The system of equations is solved for X using the factored form -*> of A. -*> -*> 5. Iterative refinement is applied to improve the computed solution -*> matrix and calculate error bounds and backward error estimates -*> for it. -*> -*> 6. If equilibration was used, the matrix X is premultiplied by -*> diag(C) (if TRANS = 'N') or diag(R) (if TRANS = 'T' or 'C') so -*> that it solves the original system before equilibration. -*> \endverbatim -* -* Arguments: -* ========== -* -*> \param[in] FACT -*> \verbatim -*> FACT is CHARACTER*1 -*> Specifies whether or not the factored form of the matrix A is -*> supplied on entry, and if not, whether the matrix A should be -*> equilibrated before it is factored. -*> = 'F': On entry, AF and IPIV contain the factored form of A. -*> If EQUED is not 'N', the matrix A has been -*> equilibrated with scaling factors given by R and C. -*> A, AF, and IPIV are not modified. -*> = 'N': The matrix A will be copied to AF and factored. -*> = 'E': The matrix A will be equilibrated if necessary, then -*> copied to AF and factored. -*> \endverbatim -*> -*> \param[in] TRANS -*> \verbatim -*> TRANS is CHARACTER*1 -*> Specifies the form of the system of equations: -*> = 'N': A * X = B (No transpose) -*> = 'T': A**T * X = B (Transpose) -*> = 'C': A**H * X = B (Conjugate transpose) -*> \endverbatim -*> -*> \param[in] N -*> \verbatim -*> N is INTEGER -*> The number of linear equations, i.e., the order of the -*> matrix A. N >= 0. -*> \endverbatim -*> -*> \param[in] NRHS -*> \verbatim -*> NRHS is INTEGER -*> The number of right hand sides, i.e., the number of columns -*> of the matrices B and X. NRHS >= 0. -*> \endverbatim -*> -*> \param[in,out] A -*> \verbatim -*> A is COMPLEX array, dimension (LDA,N) -*> On entry, the N-by-N matrix A. If FACT = 'F' and EQUED is -*> not 'N', then A must have been equilibrated by the scaling -*> factors in R and/or C. A is not modified if FACT = 'F' or -*> 'N', or if FACT = 'E' and EQUED = 'N' on exit. -*> -*> On exit, if EQUED .ne. 'N', A is scaled as follows: -*> EQUED = 'R': A := diag(R) * A -*> EQUED = 'C': A := A * diag(C) -*> EQUED = 'B': A := diag(R) * A * diag(C). -*> \endverbatim -*> -*> \param[in] LDA -*> \verbatim -*> LDA is INTEGER -*> The leading dimension of the array A. LDA >= max(1,N). -*> \endverbatim -*> -*> \param[in,out] AF -*> \verbatim -*> AF is COMPLEX array, dimension (LDAF,N) -*> If FACT = 'F', then AF is an input argument and on entry -*> contains the factors L and U from the factorization -*> A = P*L*U as computed by CGETRF. If EQUED .ne. 'N', then -*> AF is the factored form of the equilibrated matrix A. -*> -*> If FACT = 'N', then AF is an output argument and on exit -*> returns the factors L and U from the factorization A = P*L*U -*> of the original matrix A. -*> -*> If FACT = 'E', then AF is an output argument and on exit -*> returns the factors L and U from the factorization A = P*L*U -*> of the equilibrated matrix A (see the description of A for -*> the form of the equilibrated matrix). -*> \endverbatim -*> -*> \param[in] LDAF -*> \verbatim -*> LDAF is INTEGER -*> The leading dimension of the array AF. LDAF >= max(1,N). -*> \endverbatim -*> -*> \param[in,out] IPIV -*> \verbatim -*> IPIV is INTEGER array, dimension (N) -*> If FACT = 'F', then IPIV is an input argument and on entry -*> contains the pivot indices from the factorization A = P*L*U -*> as computed by CGETRF; row i of the matrix was interchanged -*> with row IPIV(i). -*> -*> If FACT = 'N', then IPIV is an output argument and on exit -*> contains the pivot indices from the factorization A = P*L*U -*> of the original matrix A. -*> -*> If FACT = 'E', then IPIV is an output argument and on exit -*> contains the pivot indices from the factorization A = P*L*U -*> of the equilibrated matrix A. -*> \endverbatim -*> -*> \param[in,out] EQUED -*> \verbatim -*> EQUED is CHARACTER*1 -*> Specifies the form of equilibration that was done. -*> = 'N': No equilibration (always true if FACT = 'N'). -*> = 'R': Row equilibration, i.e., A has been premultiplied by -*> diag(R). -*> = 'C': Column equilibration, i.e., A has been postmultiplied -*> by diag(C). -*> = 'B': Both row and column equilibration, i.e., A has been -*> replaced by diag(R) * A * diag(C). -*> EQUED is an input argument if FACT = 'F'; otherwise, it is an -*> output argument. -*> \endverbatim -*> -*> \param[in,out] R -*> \verbatim -*> R is REAL array, dimension (N) -*> The row scale factors for A. If EQUED = 'R' or 'B', A is -*> multiplied on the left by diag(R); if EQUED = 'N' or 'C', R -*> is not accessed. R is an input argument if FACT = 'F'; -*> otherwise, R is an output argument. If FACT = 'F' and -*> EQUED = 'R' or 'B', each element of R must be positive. -*> \endverbatim -*> -*> \param[in,out] C -*> \verbatim -*> C is REAL array, dimension (N) -*> The column scale factors for A. If EQUED = 'C' or 'B', A is -*> multiplied on the right by diag(C); if EQUED = 'N' or 'R', C -*> is not accessed. C is an input argument if FACT = 'F'; -*> otherwise, C is an output argument. If FACT = 'F' and -*> EQUED = 'C' or 'B', each element of C must be positive. -*> \endverbatim -*> -*> \param[in,out] B -*> \verbatim -*> B is COMPLEX array, dimension (LDB,NRHS) -*> On entry, the N-by-NRHS right hand side matrix B. -*> On exit, -*> if EQUED = 'N', B is not modified; -*> if TRANS = 'N' and EQUED = 'R' or 'B', B is overwritten by -*> diag(R)*B; -*> if TRANS = 'T' or 'C' and EQUED = 'C' or 'B', B is -*> overwritten by diag(C)*B. -*> \endverbatim -*> -*> \param[in] LDB -*> \verbatim -*> LDB is INTEGER -*> The leading dimension of the array B. LDB >= max(1,N). -*> \endverbatim -*> -*> \param[out] X -*> \verbatim -*> X is COMPLEX array, dimension (LDX,NRHS) -*> If INFO = 0 or INFO = N+1, the N-by-NRHS solution matrix X -*> to the original system of equations. Note that A and B are -*> modified on exit if EQUED .ne. 'N', and the solution to the -*> equilibrated system is inv(diag(C))*X if TRANS = 'N' and -*> EQUED = 'C' or 'B', or inv(diag(R))*X if TRANS = 'T' or 'C' -*> and EQUED = 'R' or 'B'. -*> \endverbatim -*> -*> \param[in] LDX -*> \verbatim -*> LDX is INTEGER -*> The leading dimension of the array X. LDX >= max(1,N). -*> \endverbatim -*> -*> \param[out] RCOND -*> \verbatim -*> RCOND is REAL -*> The estimate of the reciprocal condition number of the matrix -*> A after equilibration (if done). If RCOND is less than the -*> machine precision (in particular, if RCOND = 0), the matrix -*> is singular to working precision. This condition is -*> indicated by a return code of INFO > 0. -*> \endverbatim -*> -*> \param[out] FERR -*> \verbatim -*> FERR is REAL array, dimension (NRHS) -*> The estimated forward error bound for each solution vector -*> X(j) (the j-th column of the solution matrix X). -*> If XTRUE is the true solution corresponding to X(j), FERR(j) -*> is an estimated upper bound for the magnitude of the largest -*> element in (X(j) - XTRUE) divided by the magnitude of the -*> largest element in X(j). The estimate is as reliable as -*> the estimate for RCOND, and is almost always a slight -*> overestimate of the true error. -*> \endverbatim -*> -*> \param[out] BERR -*> \verbatim -*> BERR is REAL array, dimension (NRHS) -*> The componentwise relative backward error of each solution -*> vector X(j) (i.e., the smallest relative change in -*> any element of A or B that makes X(j) an exact solution). -*> \endverbatim -*> -*> \param[out] WORK -*> \verbatim -*> WORK is COMPLEX array, dimension (2*N) -*> \endverbatim -*> -*> \param[out] RWORK -*> \verbatim -*> RWORK is REAL array, dimension (MAX(1,2*N)) -*> On exit, RWORK(1) contains the reciprocal pivot growth -*> factor norm(A)/norm(U). The "max absolute element" norm is -*> used. If RWORK(1) is much less than 1, then the stability -*> of the LU factorization of the (equilibrated) matrix A -*> could be poor. This also means that the solution X, condition -*> estimator RCOND, and forward error bound FERR could be -*> unreliable. If factorization fails with 0 RWORK(1) contains the reciprocal pivot growth factor for the -*> leading INFO columns of A. -*> \endverbatim -*> -*> \param[out] INFO -*> \verbatim -*> INFO is INTEGER -*> = 0: successful exit -*> < 0: if INFO = -i, the i-th argument had an illegal value -*> > 0: if INFO = i, and i is -*> <= N: U(i,i) is exactly zero. The factorization has -*> been completed, but the factor U is exactly -*> singular, so the solution and error bounds -*> could not be computed. RCOND = 0 is returned. -*> = N+1: U is nonsingular, but RCOND is less than machine -*> precision, meaning that the matrix is singular -*> to working precision. Nevertheless, the -*> solution and error bounds are computed because -*> there are a number of situations where the -*> computed solution can be more accurate than the -*> value of RCOND would suggest. -*> \endverbatim -* -* Authors: -* ======== -* -*> \author Univ. of Tennessee -*> \author Univ. of California Berkeley -*> \author Univ. of Colorado Denver -*> \author NAG Ltd. -* -*> \ingroup complexGEsolve -* -* ===================================================================== - SUBROUTINE CGESVX( FACT, TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, - $ EQUED, R, C, B, LDB, X, LDX, RCOND, FERR, BERR, - $ WORK, RWORK, INFO ) -* -* -- LAPACK driver routine -- -* -- LAPACK is a software package provided by Univ. of Tennessee, -- -* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* -* .. Scalar Arguments .. - CHARACTER EQUED, FACT, TRANS - INTEGER INFO, LDA, LDAF, LDB, LDX, N, NRHS - REAL RCOND -* .. -* .. Array Arguments .. - INTEGER IPIV( * ) - REAL BERR( * ), C( * ), FERR( * ), R( * ), - $ RWORK( * ) - COMPLEX A( LDA, * ), AF( LDAF, * ), B( LDB, * ), - $ WORK( * ), X( LDX, * ) -* .. -* -* ===================================================================== -* -* .. Parameters .. - REAL ZERO, ONE - PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 ) -* .. -* .. Local Scalars .. - LOGICAL COLEQU, EQUIL, NOFACT, NOTRAN, ROWEQU - CHARACTER NORM - INTEGER I, INFEQU, J - REAL AMAX, ANORM, BIGNUM, COLCND, RCMAX, RCMIN, - $ ROWCND, RPVGRW, SMLNUM -* .. -* .. External Functions .. - LOGICAL LSAME - REAL CLANGE, CLANTR, SLAMCH - EXTERNAL LSAME, CLANGE, CLANTR, SLAMCH -* .. -* .. External Subroutines .. - EXTERNAL CGECON, CGEEQU, CGERFS, CGETRF, CGETRS, CLACPY, - $ CLAQGE, XERBLA -* .. -* .. Intrinsic Functions .. - INTRINSIC MAX, MIN -* .. -* .. Executable Statements .. -* - INFO = 0 - NOFACT = LSAME( FACT, 'N' ) - EQUIL = LSAME( FACT, 'E' ) - NOTRAN = LSAME( TRANS, 'N' ) - IF( NOFACT .OR. EQUIL ) THEN - EQUED = 'N' - ROWEQU = .FALSE. - COLEQU = .FALSE. - ELSE - ROWEQU = LSAME( EQUED, 'R' ) .OR. LSAME( EQUED, 'B' ) - COLEQU = LSAME( EQUED, 'C' ) .OR. LSAME( EQUED, 'B' ) - SMLNUM = SLAMCH( 'Safe minimum' ) - BIGNUM = ONE / SMLNUM - END IF -* -* Test the input parameters. -* - IF( .NOT.NOFACT .AND. .NOT.EQUIL .AND. .NOT.LSAME( FACT, 'F' ) ) - $ THEN - INFO = -1 - ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT. - $ LSAME( TRANS, 'C' ) ) THEN - INFO = -2 - ELSE IF( N.LT.0 ) THEN - INFO = -3 - ELSE IF( NRHS.LT.0 ) THEN - INFO = -4 - ELSE IF( LDA.LT.MAX( 1, N ) ) THEN - INFO = -6 - ELSE IF( LDAF.LT.MAX( 1, N ) ) THEN - INFO = -8 - ELSE IF( LSAME( FACT, 'F' ) .AND. .NOT. - $ ( ROWEQU .OR. COLEQU .OR. LSAME( EQUED, 'N' ) ) ) THEN - INFO = -10 - ELSE - IF( ROWEQU ) THEN - RCMIN = BIGNUM - RCMAX = ZERO - DO 10 J = 1, N - RCMIN = MIN( RCMIN, R( J ) ) - RCMAX = MAX( RCMAX, R( J ) ) - 10 CONTINUE - IF( RCMIN.LE.ZERO ) THEN - INFO = -11 - ELSE IF( N.GT.0 ) THEN - ROWCND = MAX( RCMIN, SMLNUM ) / MIN( RCMAX, BIGNUM ) - ELSE - ROWCND = ONE - END IF - END IF - IF( COLEQU .AND. INFO.EQ.0 ) THEN - RCMIN = BIGNUM - RCMAX = ZERO - DO 20 J = 1, N - RCMIN = MIN( RCMIN, C( J ) ) - RCMAX = MAX( RCMAX, C( J ) ) - 20 CONTINUE - IF( RCMIN.LE.ZERO ) THEN - INFO = -12 - ELSE IF( N.GT.0 ) THEN - COLCND = MAX( RCMIN, SMLNUM ) / MIN( RCMAX, BIGNUM ) - ELSE - COLCND = ONE - END IF - END IF - IF( INFO.EQ.0 ) THEN - IF( LDB.LT.MAX( 1, N ) ) THEN - INFO = -14 - ELSE IF( LDX.LT.MAX( 1, N ) ) THEN - INFO = -16 - END IF - END IF - END IF -* - IF( INFO.NE.0 ) THEN - CALL XERBLA( 'CGESVX', -INFO ) - RETURN - END IF -* - IF( EQUIL ) THEN -* -* Compute row and column scalings to equilibrate the matrix A. -* - CALL CGEEQU( N, N, A, LDA, R, C, ROWCND, COLCND, AMAX, INFEQU ) - IF( INFEQU.EQ.0 ) THEN -* -* Equilibrate the matrix. -* - CALL CLAQGE( N, N, A, LDA, R, C, ROWCND, COLCND, AMAX, - $ EQUED ) - ROWEQU = LSAME( EQUED, 'R' ) .OR. LSAME( EQUED, 'B' ) - COLEQU = LSAME( EQUED, 'C' ) .OR. LSAME( EQUED, 'B' ) - END IF - END IF -* -* Scale the right hand side. -* - IF( NOTRAN ) THEN - IF( ROWEQU ) THEN - DO 40 J = 1, NRHS - DO 30 I = 1, N - B( I, J ) = R( I )*B( I, J ) - 30 CONTINUE - 40 CONTINUE - END IF - ELSE IF( COLEQU ) THEN - DO 60 J = 1, NRHS - DO 50 I = 1, N - B( I, J ) = C( I )*B( I, J ) - 50 CONTINUE - 60 CONTINUE - END IF -* - IF( NOFACT .OR. EQUIL ) THEN -* -* Compute the LU factorization of A. -* - CALL CLACPY( 'Full', N, N, A, LDA, AF, LDAF ) - CALL CGETRF( N, N, AF, LDAF, IPIV, INFO ) -* -* Return if INFO is non-zero. -* - IF( INFO.GT.0 ) THEN -* -* Compute the reciprocal pivot growth factor of the -* leading rank-deficient INFO columns of A. -* - RPVGRW = CLANTR( 'M', 'U', 'N', INFO, INFO, AF, LDAF, - $ RWORK ) - IF( RPVGRW.EQ.ZERO ) THEN - RPVGRW = ONE - ELSE - RPVGRW = CLANGE( 'M', N, INFO, A, LDA, RWORK ) / - $ RPVGRW - END IF - RWORK( 1 ) = RPVGRW - RCOND = ZERO - RETURN - END IF - END IF -* -* Compute the norm of the matrix A and the -* reciprocal pivot growth factor RPVGRW. -* - IF( NOTRAN ) THEN - NORM = '1' - ELSE - NORM = 'I' - END IF - ANORM = CLANGE( NORM, N, N, A, LDA, RWORK ) - RPVGRW = CLANTR( 'M', 'U', 'N', N, N, AF, LDAF, RWORK ) - IF( RPVGRW.EQ.ZERO ) THEN - RPVGRW = ONE - ELSE - RPVGRW = CLANGE( 'M', N, N, A, LDA, RWORK ) / RPVGRW - END IF -* -* Compute the reciprocal of the condition number of A. -* - CALL CGECON( NORM, N, AF, LDAF, ANORM, RCOND, WORK, RWORK, INFO ) -* -* Compute the solution matrix X. -* - CALL CLACPY( 'Full', N, NRHS, B, LDB, X, LDX ) - CALL CGETRS( TRANS, N, NRHS, AF, LDAF, IPIV, X, LDX, INFO ) -* -* Use iterative refinement to improve the computed solution and -* compute error bounds and backward error estimates for it. -* - CALL CGERFS( TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, - $ LDX, FERR, BERR, WORK, RWORK, INFO ) -* -* Transform the solution matrix X to a solution of the original -* system. -* - IF( NOTRAN ) THEN - IF( COLEQU ) THEN - DO 80 J = 1, NRHS - DO 70 I = 1, N - X( I, J ) = C( I )*X( I, J ) - 70 CONTINUE - 80 CONTINUE - DO 90 J = 1, NRHS - FERR( J ) = FERR( J ) / COLCND - 90 CONTINUE - END IF - ELSE IF( ROWEQU ) THEN - DO 110 J = 1, NRHS - DO 100 I = 1, N - X( I, J ) = R( I )*X( I, J ) - 100 CONTINUE - 110 CONTINUE - DO 120 J = 1, NRHS - FERR( J ) = FERR( J ) / ROWCND - 120 CONTINUE - END IF -* -* Set INFO = N+1 if the matrix is singular to working precision. -* - IF( RCOND.LT.SLAMCH( 'Epsilon' ) ) - $ INFO = N + 1 -* - RWORK( 1 ) = RPVGRW - RETURN -* -* End of CGESVX -* - END From 5e510a12893f5750f867b4848f1dbeb66f0673ef Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Thu, 4 Apr 2024 11:46:40 +0200 Subject: [PATCH 304/311] Delete misplaced file (move to SRC) --- lapack-netlib/dgbsvx.f | 639 ----------------------------------------- 1 file changed, 639 deletions(-) delete mode 100644 lapack-netlib/dgbsvx.f diff --git a/lapack-netlib/dgbsvx.f b/lapack-netlib/dgbsvx.f deleted file mode 100644 index 0ee5eecb3..000000000 --- a/lapack-netlib/dgbsvx.f +++ /dev/null @@ -1,639 +0,0 @@ -*> \brief DGBSVX computes the solution to system of linear equations A * X = B for GB matrices -* -* =========== DOCUMENTATION =========== -* -* Online html documentation available at -* http://www.netlib.org/lapack/explore-html/ -* -*> \htmlonly -*> Download DGBSVX + dependencies -*> -*> [TGZ] -*> -*> [ZIP] -*> -*> [TXT] -*> \endhtmlonly -* -* Definition: -* =========== -* -* SUBROUTINE DGBSVX( FACT, TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, -* LDAFB, IPIV, EQUED, R, C, B, LDB, X, LDX, -* RCOND, FERR, BERR, WORK, IWORK, INFO ) -* -* .. Scalar Arguments .. -* CHARACTER EQUED, FACT, TRANS -* INTEGER INFO, KL, KU, LDAB, LDAFB, LDB, LDX, N, NRHS -* DOUBLE PRECISION RCOND -* .. -* .. Array Arguments .. -* INTEGER IPIV( * ), IWORK( * ) -* DOUBLE PRECISION AB( LDAB, * ), AFB( LDAFB, * ), B( LDB, * ), -* $ BERR( * ), C( * ), FERR( * ), R( * ), -* $ WORK( * ), X( LDX, * ) -* .. -* -* -*> \par Purpose: -* ============= -*> -*> \verbatim -*> -*> DGBSVX uses the LU factorization to compute the solution to a real -*> system of linear equations A * X = B, A**T * X = B, or A**H * X = B, -*> where A is a band matrix of order N with KL subdiagonals and KU -*> superdiagonals, and X and B are N-by-NRHS matrices. -*> -*> Error bounds on the solution and a condition estimate are also -*> provided. -*> \endverbatim -* -*> \par Description: -* ================= -*> -*> \verbatim -*> -*> The following steps are performed by this subroutine: -*> -*> 1. If FACT = 'E', real scaling factors are computed to equilibrate -*> the system: -*> TRANS = 'N': diag(R)*A*diag(C) *inv(diag(C))*X = diag(R)*B -*> TRANS = 'T': (diag(R)*A*diag(C))**T *inv(diag(R))*X = diag(C)*B -*> TRANS = 'C': (diag(R)*A*diag(C))**H *inv(diag(R))*X = diag(C)*B -*> Whether or not the system will be equilibrated depends on the -*> scaling of the matrix A, but if equilibration is used, A is -*> overwritten by diag(R)*A*diag(C) and B by diag(R)*B (if TRANS='N') -*> or diag(C)*B (if TRANS = 'T' or 'C'). -*> -*> 2. If FACT = 'N' or 'E', the LU decomposition is used to factor the -*> matrix A (after equilibration if FACT = 'E') as -*> A = L * U, -*> where L is a product of permutation and unit lower triangular -*> matrices with KL subdiagonals, and U is upper triangular with -*> KL+KU superdiagonals. -*> -*> 3. If some U(i,i)=0, so that U is exactly singular, then the routine -*> returns with INFO = i. Otherwise, the factored form of A is used -*> to estimate the condition number of the matrix A. If the -*> reciprocal of the condition number is less than machine precision, -*> INFO = N+1 is returned as a warning, but the routine still goes on -*> to solve for X and compute error bounds as described below. -*> -*> 4. The system of equations is solved for X using the factored form -*> of A. -*> -*> 5. Iterative refinement is applied to improve the computed solution -*> matrix and calculate error bounds and backward error estimates -*> for it. -*> -*> 6. If equilibration was used, the matrix X is premultiplied by -*> diag(C) (if TRANS = 'N') or diag(R) (if TRANS = 'T' or 'C') so -*> that it solves the original system before equilibration. -*> \endverbatim -* -* Arguments: -* ========== -* -*> \param[in] FACT -*> \verbatim -*> FACT is CHARACTER*1 -*> Specifies whether or not the factored form of the matrix A is -*> supplied on entry, and if not, whether the matrix A should be -*> equilibrated before it is factored. -*> = 'F': On entry, AFB and IPIV contain the factored form of -*> A. If EQUED is not 'N', the matrix A has been -*> equilibrated with scaling factors given by R and C. -*> AB, AFB, and IPIV are not modified. -*> = 'N': The matrix A will be copied to AFB and factored. -*> = 'E': The matrix A will be equilibrated if necessary, then -*> copied to AFB and factored. -*> \endverbatim -*> -*> \param[in] TRANS -*> \verbatim -*> TRANS is CHARACTER*1 -*> Specifies the form of the system of equations. -*> = 'N': A * X = B (No transpose) -*> = 'T': A**T * X = B (Transpose) -*> = 'C': A**H * X = B (Transpose) -*> \endverbatim -*> -*> \param[in] N -*> \verbatim -*> N is INTEGER -*> The number of linear equations, i.e., the order of the -*> matrix A. N >= 0. -*> \endverbatim -*> -*> \param[in] KL -*> \verbatim -*> KL is INTEGER -*> The number of subdiagonals within the band of A. KL >= 0. -*> \endverbatim -*> -*> \param[in] KU -*> \verbatim -*> KU is INTEGER -*> The number of superdiagonals within the band of A. KU >= 0. -*> \endverbatim -*> -*> \param[in] NRHS -*> \verbatim -*> NRHS is INTEGER -*> The number of right hand sides, i.e., the number of columns -*> of the matrices B and X. NRHS >= 0. -*> \endverbatim -*> -*> \param[in,out] AB -*> \verbatim -*> AB is DOUBLE PRECISION array, dimension (LDAB,N) -*> On entry, the matrix A in band storage, in rows 1 to KL+KU+1. -*> The j-th column of A is stored in the j-th column of the -*> array AB as follows: -*> AB(KU+1+i-j,j) = A(i,j) for max(1,j-KU)<=i<=min(N,j+kl) -*> -*> If FACT = 'F' and EQUED is not 'N', then A must have been -*> equilibrated by the scaling factors in R and/or C. AB is not -*> modified if FACT = 'F' or 'N', or if FACT = 'E' and -*> EQUED = 'N' on exit. -*> -*> On exit, if EQUED .ne. 'N', A is scaled as follows: -*> EQUED = 'R': A := diag(R) * A -*> EQUED = 'C': A := A * diag(C) -*> EQUED = 'B': A := diag(R) * A * diag(C). -*> \endverbatim -*> -*> \param[in] LDAB -*> \verbatim -*> LDAB is INTEGER -*> The leading dimension of the array AB. LDAB >= KL+KU+1. -*> \endverbatim -*> -*> \param[in,out] AFB -*> \verbatim -*> AFB is DOUBLE PRECISION array, dimension (LDAFB,N) -*> If FACT = 'F', then AFB is an input argument and on entry -*> contains details of the LU factorization of the band matrix -*> A, as computed by DGBTRF. U is stored as an upper triangular -*> band matrix with KL+KU superdiagonals in rows 1 to KL+KU+1, -*> and the multipliers used during the factorization are stored -*> in rows KL+KU+2 to 2*KL+KU+1. If EQUED .ne. 'N', then AFB is -*> the factored form of the equilibrated matrix A. -*> -*> If FACT = 'N', then AFB is an output argument and on exit -*> returns details of the LU factorization of A. -*> -*> If FACT = 'E', then AFB is an output argument and on exit -*> returns details of the LU factorization of the equilibrated -*> matrix A (see the description of AB for the form of the -*> equilibrated matrix). -*> \endverbatim -*> -*> \param[in] LDAFB -*> \verbatim -*> LDAFB is INTEGER -*> The leading dimension of the array AFB. LDAFB >= 2*KL+KU+1. -*> \endverbatim -*> -*> \param[in,out] IPIV -*> \verbatim -*> IPIV is INTEGER array, dimension (N) -*> If FACT = 'F', then IPIV is an input argument and on entry -*> contains the pivot indices from the factorization A = L*U -*> as computed by DGBTRF; row i of the matrix was interchanged -*> with row IPIV(i). -*> -*> If FACT = 'N', then IPIV is an output argument and on exit -*> contains the pivot indices from the factorization A = L*U -*> of the original matrix A. -*> -*> If FACT = 'E', then IPIV is an output argument and on exit -*> contains the pivot indices from the factorization A = L*U -*> of the equilibrated matrix A. -*> \endverbatim -*> -*> \param[in,out] EQUED -*> \verbatim -*> EQUED is CHARACTER*1 -*> Specifies the form of equilibration that was done. -*> = 'N': No equilibration (always true if FACT = 'N'). -*> = 'R': Row equilibration, i.e., A has been premultiplied by -*> diag(R). -*> = 'C': Column equilibration, i.e., A has been postmultiplied -*> by diag(C). -*> = 'B': Both row and column equilibration, i.e., A has been -*> replaced by diag(R) * A * diag(C). -*> EQUED is an input argument if FACT = 'F'; otherwise, it is an -*> output argument. -*> \endverbatim -*> -*> \param[in,out] R -*> \verbatim -*> R is DOUBLE PRECISION array, dimension (N) -*> The row scale factors for A. If EQUED = 'R' or 'B', A is -*> multiplied on the left by diag(R); if EQUED = 'N' or 'C', R -*> is not accessed. R is an input argument if FACT = 'F'; -*> otherwise, R is an output argument. If FACT = 'F' and -*> EQUED = 'R' or 'B', each element of R must be positive. -*> \endverbatim -*> -*> \param[in,out] C -*> \verbatim -*> C is DOUBLE PRECISION array, dimension (N) -*> The column scale factors for A. If EQUED = 'C' or 'B', A is -*> multiplied on the right by diag(C); if EQUED = 'N' or 'R', C -*> is not accessed. C is an input argument if FACT = 'F'; -*> otherwise, C is an output argument. If FACT = 'F' and -*> EQUED = 'C' or 'B', each element of C must be positive. -*> \endverbatim -*> -*> \param[in,out] B -*> \verbatim -*> B is DOUBLE PRECISION array, dimension (LDB,NRHS) -*> On entry, the right hand side matrix B. -*> On exit, -*> if EQUED = 'N', B is not modified; -*> if TRANS = 'N' and EQUED = 'R' or 'B', B is overwritten by -*> diag(R)*B; -*> if TRANS = 'T' or 'C' and EQUED = 'C' or 'B', B is -*> overwritten by diag(C)*B. -*> \endverbatim -*> -*> \param[in] LDB -*> \verbatim -*> LDB is INTEGER -*> The leading dimension of the array B. LDB >= max(1,N). -*> \endverbatim -*> -*> \param[out] X -*> \verbatim -*> X is DOUBLE PRECISION array, dimension (LDX,NRHS) -*> If INFO = 0 or INFO = N+1, the N-by-NRHS solution matrix X -*> to the original system of equations. Note that A and B are -*> modified on exit if EQUED .ne. 'N', and the solution to the -*> equilibrated system is inv(diag(C))*X if TRANS = 'N' and -*> EQUED = 'C' or 'B', or inv(diag(R))*X if TRANS = 'T' or 'C' -*> and EQUED = 'R' or 'B'. -*> \endverbatim -*> -*> \param[in] LDX -*> \verbatim -*> LDX is INTEGER -*> The leading dimension of the array X. LDX >= max(1,N). -*> \endverbatim -*> -*> \param[out] RCOND -*> \verbatim -*> RCOND is DOUBLE PRECISION -*> The estimate of the reciprocal condition number of the matrix -*> A after equilibration (if done). If RCOND is less than the -*> machine precision (in particular, if RCOND = 0), the matrix -*> is singular to working precision. This condition is -*> indicated by a return code of INFO > 0. -*> \endverbatim -*> -*> \param[out] FERR -*> \verbatim -*> FERR is DOUBLE PRECISION array, dimension (NRHS) -*> The estimated forward error bound for each solution vector -*> X(j) (the j-th column of the solution matrix X). -*> If XTRUE is the true solution corresponding to X(j), FERR(j) -*> is an estimated upper bound for the magnitude of the largest -*> element in (X(j) - XTRUE) divided by the magnitude of the -*> largest element in X(j). The estimate is as reliable as -*> the estimate for RCOND, and is almost always a slight -*> overestimate of the true error. -*> \endverbatim -*> -*> \param[out] BERR -*> \verbatim -*> BERR is DOUBLE PRECISION array, dimension (NRHS) -*> The componentwise relative backward error of each solution -*> vector X(j) (i.e., the smallest relative change in -*> any element of A or B that makes X(j) an exact solution). -*> \endverbatim -*> -*> \param[out] WORK -*> \verbatim -*> WORK is DOUBLE PRECISION array, dimension (MAX(1,3*N)) -*> On exit, WORK(1) contains the reciprocal pivot growth -*> factor norm(A)/norm(U). The "max absolute element" norm is -*> used. If WORK(1) is much less than 1, then the stability -*> of the LU factorization of the (equilibrated) matrix A -*> could be poor. This also means that the solution X, condition -*> estimator RCOND, and forward error bound FERR could be -*> unreliable. If factorization fails with 0 WORK(1) contains the reciprocal pivot growth factor for the -*> leading INFO columns of A. -*> \endverbatim -*> -*> \param[out] IWORK -*> \verbatim -*> IWORK is INTEGER array, dimension (N) -*> \endverbatim -*> -*> \param[out] INFO -*> \verbatim -*> INFO is INTEGER -*> = 0: successful exit -*> < 0: if INFO = -i, the i-th argument had an illegal value -*> > 0: if INFO = i, and i is -*> <= N: U(i,i) is exactly zero. The factorization -*> has been completed, but the factor U is exactly -*> singular, so the solution and error bounds -*> could not be computed. RCOND = 0 is returned. -*> = N+1: U is nonsingular, but RCOND is less than machine -*> precision, meaning that the matrix is singular -*> to working precision. Nevertheless, the -*> solution and error bounds are computed because -*> there are a number of situations where the -*> computed solution can be more accurate than the -*> value of RCOND would suggest. -*> \endverbatim -* -* Authors: -* ======== -* -*> \author Univ. of Tennessee -*> \author Univ. of California Berkeley -*> \author Univ. of Colorado Denver -*> \author NAG Ltd. -* -*> \ingroup doubleGBsolve -* -* ===================================================================== - SUBROUTINE DGBSVX( FACT, TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, - $ LDAFB, IPIV, EQUED, R, C, B, LDB, X, LDX, - $ RCOND, FERR, BERR, WORK, IWORK, INFO ) -* -* -- LAPACK driver routine -- -* -- LAPACK is a software package provided by Univ. of Tennessee, -- -* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* -* .. Scalar Arguments .. - CHARACTER EQUED, FACT, TRANS - INTEGER INFO, KL, KU, LDAB, LDAFB, LDB, LDX, N, NRHS - DOUBLE PRECISION RCOND -* .. -* .. Array Arguments .. - INTEGER IPIV( * ), IWORK( * ) - DOUBLE PRECISION AB( LDAB, * ), AFB( LDAFB, * ), B( LDB, * ), - $ BERR( * ), C( * ), FERR( * ), R( * ), - $ WORK( * ), X( LDX, * ) -* .. -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ZERO, ONE - PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 ) -* .. -* .. Local Scalars .. - LOGICAL COLEQU, EQUIL, NOFACT, NOTRAN, ROWEQU - CHARACTER NORM - INTEGER I, INFEQU, J, J1, J2 - DOUBLE PRECISION AMAX, ANORM, BIGNUM, COLCND, RCMAX, RCMIN, - $ ROWCND, RPVGRW, SMLNUM -* .. -* .. External Functions .. - LOGICAL LSAME - DOUBLE PRECISION DLAMCH, DLANGB, DLANTB - EXTERNAL LSAME, DLAMCH, DLANGB, DLANTB -* .. -* .. External Subroutines .. - EXTERNAL DCOPY, DGBCON, DGBEQU, DGBRFS, DGBTRF, DGBTRS, - $ DLACPY, DLAQGB, XERBLA -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS, MAX, MIN -* .. -* .. Executable Statements .. -* - INFO = 0 - NOFACT = LSAME( FACT, 'N' ) - EQUIL = LSAME( FACT, 'E' ) - NOTRAN = LSAME( TRANS, 'N' ) - IF( NOFACT .OR. EQUIL ) THEN - EQUED = 'N' - ROWEQU = .FALSE. - COLEQU = .FALSE. - ELSE - ROWEQU = LSAME( EQUED, 'R' ) .OR. LSAME( EQUED, 'B' ) - COLEQU = LSAME( EQUED, 'C' ) .OR. LSAME( EQUED, 'B' ) - SMLNUM = DLAMCH( 'Safe minimum' ) - BIGNUM = ONE / SMLNUM - END IF -* -* Test the input parameters. -* - IF( .NOT.NOFACT .AND. .NOT.EQUIL .AND. .NOT.LSAME( FACT, 'F' ) ) - $ THEN - INFO = -1 - ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT. - $ LSAME( TRANS, 'C' ) ) THEN - INFO = -2 - ELSE IF( N.LT.0 ) THEN - INFO = -3 - ELSE IF( KL.LT.0 ) THEN - INFO = -4 - ELSE IF( KU.LT.0 ) THEN - INFO = -5 - ELSE IF( NRHS.LT.0 ) THEN - INFO = -6 - ELSE IF( LDAB.LT.KL+KU+1 ) THEN - INFO = -8 - ELSE IF( LDAFB.LT.2*KL+KU+1 ) THEN - INFO = -10 - ELSE IF( LSAME( FACT, 'F' ) .AND. .NOT. - $ ( ROWEQU .OR. COLEQU .OR. LSAME( EQUED, 'N' ) ) ) THEN - INFO = -12 - ELSE - IF( ROWEQU ) THEN - RCMIN = BIGNUM - RCMAX = ZERO - DO 10 J = 1, N - RCMIN = MIN( RCMIN, R( J ) ) - RCMAX = MAX( RCMAX, R( J ) ) - 10 CONTINUE - IF( RCMIN.LE.ZERO ) THEN - INFO = -13 - ELSE IF( N.GT.0 ) THEN - ROWCND = MAX( RCMIN, SMLNUM ) / MIN( RCMAX, BIGNUM ) - ELSE - ROWCND = ONE - END IF - END IF - IF( COLEQU .AND. INFO.EQ.0 ) THEN - RCMIN = BIGNUM - RCMAX = ZERO - DO 20 J = 1, N - RCMIN = MIN( RCMIN, C( J ) ) - RCMAX = MAX( RCMAX, C( J ) ) - 20 CONTINUE - IF( RCMIN.LE.ZERO ) THEN - INFO = -14 - ELSE IF( N.GT.0 ) THEN - COLCND = MAX( RCMIN, SMLNUM ) / MIN( RCMAX, BIGNUM ) - ELSE - COLCND = ONE - END IF - END IF - IF( INFO.EQ.0 ) THEN - IF( LDB.LT.MAX( 1, N ) ) THEN - INFO = -16 - ELSE IF( LDX.LT.MAX( 1, N ) ) THEN - INFO = -18 - END IF - END IF - END IF -* - IF( INFO.NE.0 ) THEN - CALL XERBLA( 'DGBSVX', -INFO ) - RETURN - END IF -* - IF( EQUIL ) THEN -* -* Compute row and column scalings to equilibrate the matrix A. -* - CALL DGBEQU( N, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND, - $ AMAX, INFEQU ) - IF( INFEQU.EQ.0 ) THEN -* -* Equilibrate the matrix. -* - CALL DLAQGB( N, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND, - $ AMAX, EQUED ) - ROWEQU = LSAME( EQUED, 'R' ) .OR. LSAME( EQUED, 'B' ) - COLEQU = LSAME( EQUED, 'C' ) .OR. LSAME( EQUED, 'B' ) - END IF - END IF -* -* Scale the right hand side. -* - IF( NOTRAN ) THEN - IF( ROWEQU ) THEN - DO 40 J = 1, NRHS - DO 30 I = 1, N - B( I, J ) = R( I )*B( I, J ) - 30 CONTINUE - 40 CONTINUE - END IF - ELSE IF( COLEQU ) THEN - DO 60 J = 1, NRHS - DO 50 I = 1, N - B( I, J ) = C( I )*B( I, J ) - 50 CONTINUE - 60 CONTINUE - END IF -* - IF( NOFACT .OR. EQUIL ) THEN -* -* Compute the LU factorization of the band matrix A. -* - DO 70 J = 1, N - J1 = MAX( J-KU, 1 ) - J2 = MIN( J+KL, N ) - CALL DCOPY( J2-J1+1, AB( KU+1-J+J1, J ), 1, - $ AFB( KL+KU+1-J+J1, J ), 1 ) - 70 CONTINUE -* - CALL DGBTRF( N, N, KL, KU, AFB, LDAFB, IPIV, INFO ) -* -* Return if INFO is non-zero. -* - IF( INFO.GT.0 ) THEN -* -* Compute the reciprocal pivot growth factor of the -* leading rank-deficient INFO columns of A. -* - ANORM = ZERO - DO 90 J = 1, INFO - DO 80 I = MAX( KU+2-J, 1 ), MIN( N+KU+1-J, KL+KU+1 ) - ANORM = MAX( ANORM, ABS( AB( I, J ) ) ) - 80 CONTINUE - 90 CONTINUE - RPVGRW = DLANTB( 'M', 'U', 'N', INFO, MIN( INFO-1, KL+KU ), - $ AFB( MAX( 1, KL+KU+2-INFO ), 1 ), LDAFB, - $ WORK ) - IF( RPVGRW.EQ.ZERO ) THEN - RPVGRW = ONE - ELSE - RPVGRW = ANORM / RPVGRW - END IF - WORK( 1 ) = RPVGRW - RCOND = ZERO - RETURN - END IF - END IF -* -* Compute the norm of the matrix A and the -* reciprocal pivot growth factor RPVGRW. -* - IF( NOTRAN ) THEN - NORM = '1' - ELSE - NORM = 'I' - END IF - ANORM = DLANGB( NORM, N, KL, KU, AB, LDAB, WORK ) - RPVGRW = DLANTB( 'M', 'U', 'N', N, KL+KU, AFB, LDAFB, WORK ) - IF( RPVGRW.EQ.ZERO ) THEN - RPVGRW = ONE - ELSE - RPVGRW = DLANGB( 'M', N, KL, KU, AB, LDAB, WORK ) / RPVGRW - END IF -* -* Compute the reciprocal of the condition number of A. -* - CALL DGBCON( NORM, N, KL, KU, AFB, LDAFB, IPIV, ANORM, RCOND, - $ WORK, IWORK, INFO ) -* -* Compute the solution matrix X. -* - CALL DLACPY( 'Full', N, NRHS, B, LDB, X, LDX ) - CALL DGBTRS( TRANS, N, KL, KU, NRHS, AFB, LDAFB, IPIV, X, LDX, - $ INFO ) -* -* Use iterative refinement to improve the computed solution and -* compute error bounds and backward error estimates for it. -* - CALL DGBRFS( TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB, IPIV, - $ B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO ) -* -* Transform the solution matrix X to a solution of the original -* system. -* - IF( NOTRAN ) THEN - IF( COLEQU ) THEN - DO 110 J = 1, NRHS - DO 100 I = 1, N - X( I, J ) = C( I )*X( I, J ) - 100 CONTINUE - 110 CONTINUE - DO 120 J = 1, NRHS - FERR( J ) = FERR( J ) / COLCND - 120 CONTINUE - END IF - ELSE IF( ROWEQU ) THEN - DO 140 J = 1, NRHS - DO 130 I = 1, N - X( I, J ) = R( I )*X( I, J ) - 130 CONTINUE - 140 CONTINUE - DO 150 J = 1, NRHS - FERR( J ) = FERR( J ) / ROWCND - 150 CONTINUE - END IF -* -* Set INFO = N+1 if the matrix is singular to working precision. -* - IF( RCOND.LT.DLAMCH( 'Epsilon' ) ) - $ INFO = N + 1 -* - WORK( 1 ) = RPVGRW - RETURN -* -* End of DGBSVX -* - END From bdcb5a23f648435c49fcba7f9a03fc96a59f1dee Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Thu, 4 Apr 2024 11:47:06 +0200 Subject: [PATCH 305/311] Delete misplaced file (move to SRC) --- lapack-netlib/dgesvx.f | 599 ----------------------------------------- 1 file changed, 599 deletions(-) delete mode 100644 lapack-netlib/dgesvx.f diff --git a/lapack-netlib/dgesvx.f b/lapack-netlib/dgesvx.f deleted file mode 100644 index f787488dc..000000000 --- a/lapack-netlib/dgesvx.f +++ /dev/null @@ -1,599 +0,0 @@ -*> \brief DGESVX computes the solution to system of linear equations A * X = B for GE matrices -* -* =========== DOCUMENTATION =========== -* -* Online html documentation available at -* http://www.netlib.org/lapack/explore-html/ -* -*> \htmlonly -*> Download DGESVX + dependencies -*> -*> [TGZ] -*> -*> [ZIP] -*> -*> [TXT] -*> \endhtmlonly -* -* Definition: -* =========== -* -* SUBROUTINE DGESVX( FACT, TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, -* EQUED, R, C, B, LDB, X, LDX, RCOND, FERR, BERR, -* WORK, IWORK, INFO ) -* -* .. Scalar Arguments .. -* CHARACTER EQUED, FACT, TRANS -* INTEGER INFO, LDA, LDAF, LDB, LDX, N, NRHS -* DOUBLE PRECISION RCOND -* .. -* .. Array Arguments .. -* INTEGER IPIV( * ), IWORK( * ) -* DOUBLE PRECISION A( LDA, * ), AF( LDAF, * ), B( LDB, * ), -* $ BERR( * ), C( * ), FERR( * ), R( * ), -* $ WORK( * ), X( LDX, * ) -* .. -* -* -*> \par Purpose: -* ============= -*> -*> \verbatim -*> -*> DGESVX uses the LU factorization to compute the solution to a real -*> system of linear equations -*> A * X = B, -*> where A is an N-by-N matrix and X and B are N-by-NRHS matrices. -*> -*> Error bounds on the solution and a condition estimate are also -*> provided. -*> \endverbatim -* -*> \par Description: -* ================= -*> -*> \verbatim -*> -*> The following steps are performed: -*> -*> 1. If FACT = 'E', real scaling factors are computed to equilibrate -*> the system: -*> TRANS = 'N': diag(R)*A*diag(C) *inv(diag(C))*X = diag(R)*B -*> TRANS = 'T': (diag(R)*A*diag(C))**T *inv(diag(R))*X = diag(C)*B -*> TRANS = 'C': (diag(R)*A*diag(C))**H *inv(diag(R))*X = diag(C)*B -*> Whether or not the system will be equilibrated depends on the -*> scaling of the matrix A, but if equilibration is used, A is -*> overwritten by diag(R)*A*diag(C) and B by diag(R)*B (if TRANS='N') -*> or diag(C)*B (if TRANS = 'T' or 'C'). -*> -*> 2. If FACT = 'N' or 'E', the LU decomposition is used to factor the -*> matrix A (after equilibration if FACT = 'E') as -*> A = P * L * U, -*> where P is a permutation matrix, L is a unit lower triangular -*> matrix, and U is upper triangular. -*> -*> 3. If some U(i,i)=0, so that U is exactly singular, then the routine -*> returns with INFO = i. Otherwise, the factored form of A is used -*> to estimate the condition number of the matrix A. If the -*> reciprocal of the condition number is less than machine precision, -*> INFO = N+1 is returned as a warning, but the routine still goes on -*> to solve for X and compute error bounds as described below. -*> -*> 4. The system of equations is solved for X using the factored form -*> of A. -*> -*> 5. Iterative refinement is applied to improve the computed solution -*> matrix and calculate error bounds and backward error estimates -*> for it. -*> -*> 6. If equilibration was used, the matrix X is premultiplied by -*> diag(C) (if TRANS = 'N') or diag(R) (if TRANS = 'T' or 'C') so -*> that it solves the original system before equilibration. -*> \endverbatim -* -* Arguments: -* ========== -* -*> \param[in] FACT -*> \verbatim -*> FACT is CHARACTER*1 -*> Specifies whether or not the factored form of the matrix A is -*> supplied on entry, and if not, whether the matrix A should be -*> equilibrated before it is factored. -*> = 'F': On entry, AF and IPIV contain the factored form of A. -*> If EQUED is not 'N', the matrix A has been -*> equilibrated with scaling factors given by R and C. -*> A, AF, and IPIV are not modified. -*> = 'N': The matrix A will be copied to AF and factored. -*> = 'E': The matrix A will be equilibrated if necessary, then -*> copied to AF and factored. -*> \endverbatim -*> -*> \param[in] TRANS -*> \verbatim -*> TRANS is CHARACTER*1 -*> Specifies the form of the system of equations: -*> = 'N': A * X = B (No transpose) -*> = 'T': A**T * X = B (Transpose) -*> = 'C': A**H * X = B (Transpose) -*> \endverbatim -*> -*> \param[in] N -*> \verbatim -*> N is INTEGER -*> The number of linear equations, i.e., the order of the -*> matrix A. N >= 0. -*> \endverbatim -*> -*> \param[in] NRHS -*> \verbatim -*> NRHS is INTEGER -*> The number of right hand sides, i.e., the number of columns -*> of the matrices B and X. NRHS >= 0. -*> \endverbatim -*> -*> \param[in,out] A -*> \verbatim -*> A is DOUBLE PRECISION array, dimension (LDA,N) -*> On entry, the N-by-N matrix A. If FACT = 'F' and EQUED is -*> not 'N', then A must have been equilibrated by the scaling -*> factors in R and/or C. A is not modified if FACT = 'F' or -*> 'N', or if FACT = 'E' and EQUED = 'N' on exit. -*> -*> On exit, if EQUED .ne. 'N', A is scaled as follows: -*> EQUED = 'R': A := diag(R) * A -*> EQUED = 'C': A := A * diag(C) -*> EQUED = 'B': A := diag(R) * A * diag(C). -*> \endverbatim -*> -*> \param[in] LDA -*> \verbatim -*> LDA is INTEGER -*> The leading dimension of the array A. LDA >= max(1,N). -*> \endverbatim -*> -*> \param[in,out] AF -*> \verbatim -*> AF is DOUBLE PRECISION array, dimension (LDAF,N) -*> If FACT = 'F', then AF is an input argument and on entry -*> contains the factors L and U from the factorization -*> A = P*L*U as computed by DGETRF. If EQUED .ne. 'N', then -*> AF is the factored form of the equilibrated matrix A. -*> -*> If FACT = 'N', then AF is an output argument and on exit -*> returns the factors L and U from the factorization A = P*L*U -*> of the original matrix A. -*> -*> If FACT = 'E', then AF is an output argument and on exit -*> returns the factors L and U from the factorization A = P*L*U -*> of the equilibrated matrix A (see the description of A for -*> the form of the equilibrated matrix). -*> \endverbatim -*> -*> \param[in] LDAF -*> \verbatim -*> LDAF is INTEGER -*> The leading dimension of the array AF. LDAF >= max(1,N). -*> \endverbatim -*> -*> \param[in,out] IPIV -*> \verbatim -*> IPIV is INTEGER array, dimension (N) -*> If FACT = 'F', then IPIV is an input argument and on entry -*> contains the pivot indices from the factorization A = P*L*U -*> as computed by DGETRF; row i of the matrix was interchanged -*> with row IPIV(i). -*> -*> If FACT = 'N', then IPIV is an output argument and on exit -*> contains the pivot indices from the factorization A = P*L*U -*> of the original matrix A. -*> -*> If FACT = 'E', then IPIV is an output argument and on exit -*> contains the pivot indices from the factorization A = P*L*U -*> of the equilibrated matrix A. -*> \endverbatim -*> -*> \param[in,out] EQUED -*> \verbatim -*> EQUED is CHARACTER*1 -*> Specifies the form of equilibration that was done. -*> = 'N': No equilibration (always true if FACT = 'N'). -*> = 'R': Row equilibration, i.e., A has been premultiplied by -*> diag(R). -*> = 'C': Column equilibration, i.e., A has been postmultiplied -*> by diag(C). -*> = 'B': Both row and column equilibration, i.e., A has been -*> replaced by diag(R) * A * diag(C). -*> EQUED is an input argument if FACT = 'F'; otherwise, it is an -*> output argument. -*> \endverbatim -*> -*> \param[in,out] R -*> \verbatim -*> R is DOUBLE PRECISION array, dimension (N) -*> The row scale factors for A. If EQUED = 'R' or 'B', A is -*> multiplied on the left by diag(R); if EQUED = 'N' or 'C', R -*> is not accessed. R is an input argument if FACT = 'F'; -*> otherwise, R is an output argument. If FACT = 'F' and -*> EQUED = 'R' or 'B', each element of R must be positive. -*> \endverbatim -*> -*> \param[in,out] C -*> \verbatim -*> C is DOUBLE PRECISION array, dimension (N) -*> The column scale factors for A. If EQUED = 'C' or 'B', A is -*> multiplied on the right by diag(C); if EQUED = 'N' or 'R', C -*> is not accessed. C is an input argument if FACT = 'F'; -*> otherwise, C is an output argument. If FACT = 'F' and -*> EQUED = 'C' or 'B', each element of C must be positive. -*> \endverbatim -*> -*> \param[in,out] B -*> \verbatim -*> B is DOUBLE PRECISION array, dimension (LDB,NRHS) -*> On entry, the N-by-NRHS right hand side matrix B. -*> On exit, -*> if EQUED = 'N', B is not modified; -*> if TRANS = 'N' and EQUED = 'R' or 'B', B is overwritten by -*> diag(R)*B; -*> if TRANS = 'T' or 'C' and EQUED = 'C' or 'B', B is -*> overwritten by diag(C)*B. -*> \endverbatim -*> -*> \param[in] LDB -*> \verbatim -*> LDB is INTEGER -*> The leading dimension of the array B. LDB >= max(1,N). -*> \endverbatim -*> -*> \param[out] X -*> \verbatim -*> X is DOUBLE PRECISION array, dimension (LDX,NRHS) -*> If INFO = 0 or INFO = N+1, the N-by-NRHS solution matrix X -*> to the original system of equations. Note that A and B are -*> modified on exit if EQUED .ne. 'N', and the solution to the -*> equilibrated system is inv(diag(C))*X if TRANS = 'N' and -*> EQUED = 'C' or 'B', or inv(diag(R))*X if TRANS = 'T' or 'C' -*> and EQUED = 'R' or 'B'. -*> \endverbatim -*> -*> \param[in] LDX -*> \verbatim -*> LDX is INTEGER -*> The leading dimension of the array X. LDX >= max(1,N). -*> \endverbatim -*> -*> \param[out] RCOND -*> \verbatim -*> RCOND is DOUBLE PRECISION -*> The estimate of the reciprocal condition number of the matrix -*> A after equilibration (if done). If RCOND is less than the -*> machine precision (in particular, if RCOND = 0), the matrix -*> is singular to working precision. This condition is -*> indicated by a return code of INFO > 0. -*> \endverbatim -*> -*> \param[out] FERR -*> \verbatim -*> FERR is DOUBLE PRECISION array, dimension (NRHS) -*> The estimated forward error bound for each solution vector -*> X(j) (the j-th column of the solution matrix X). -*> If XTRUE is the true solution corresponding to X(j), FERR(j) -*> is an estimated upper bound for the magnitude of the largest -*> element in (X(j) - XTRUE) divided by the magnitude of the -*> largest element in X(j). The estimate is as reliable as -*> the estimate for RCOND, and is almost always a slight -*> overestimate of the true error. -*> \endverbatim -*> -*> \param[out] BERR -*> \verbatim -*> BERR is DOUBLE PRECISION array, dimension (NRHS) -*> The componentwise relative backward error of each solution -*> vector X(j) (i.e., the smallest relative change in -*> any element of A or B that makes X(j) an exact solution). -*> \endverbatim -*> -*> \param[out] WORK -*> \verbatim -*> WORK is DOUBLE PRECISION array, dimension (MAX(1,4*N)) -*> On exit, WORK(1) contains the reciprocal pivot growth -*> factor norm(A)/norm(U). The "max absolute element" norm is -*> used. If WORK(1) is much less than 1, then the stability -*> of the LU factorization of the (equilibrated) matrix A -*> could be poor. This also means that the solution X, condition -*> estimator RCOND, and forward error bound FERR could be -*> unreliable. If factorization fails with 0 WORK(1) contains the reciprocal pivot growth factor for the -*> leading INFO columns of A. -*> \endverbatim -*> -*> \param[out] IWORK -*> \verbatim -*> IWORK is INTEGER array, dimension (N) -*> \endverbatim -*> -*> \param[out] INFO -*> \verbatim -*> INFO is INTEGER -*> = 0: successful exit -*> < 0: if INFO = -i, the i-th argument had an illegal value -*> > 0: if INFO = i, and i is -*> <= N: U(i,i) is exactly zero. The factorization has -*> been completed, but the factor U is exactly -*> singular, so the solution and error bounds -*> could not be computed. RCOND = 0 is returned. -*> = N+1: U is nonsingular, but RCOND is less than machine -*> precision, meaning that the matrix is singular -*> to working precision. Nevertheless, the -*> solution and error bounds are computed because -*> there are a number of situations where the -*> computed solution can be more accurate than the -*> value of RCOND would suggest. -*> \endverbatim -* -* Authors: -* ======== -* -*> \author Univ. of Tennessee -*> \author Univ. of California Berkeley -*> \author Univ. of Colorado Denver -*> \author NAG Ltd. -* -*> \ingroup doubleGEsolve -* -* ===================================================================== - SUBROUTINE DGESVX( FACT, TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, - $ EQUED, R, C, B, LDB, X, LDX, RCOND, FERR, BERR, - $ WORK, IWORK, INFO ) -* -* -- LAPACK driver routine -- -* -- LAPACK is a software package provided by Univ. of Tennessee, -- -* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* -* .. Scalar Arguments .. - CHARACTER EQUED, FACT, TRANS - INTEGER INFO, LDA, LDAF, LDB, LDX, N, NRHS - DOUBLE PRECISION RCOND -* .. -* .. Array Arguments .. - INTEGER IPIV( * ), IWORK( * ) - DOUBLE PRECISION A( LDA, * ), AF( LDAF, * ), B( LDB, * ), - $ BERR( * ), C( * ), FERR( * ), R( * ), - $ WORK( * ), X( LDX, * ) -* .. -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ZERO, ONE - PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 ) -* .. -* .. Local Scalars .. - LOGICAL COLEQU, EQUIL, NOFACT, NOTRAN, ROWEQU - CHARACTER NORM - INTEGER I, INFEQU, J - DOUBLE PRECISION AMAX, ANORM, BIGNUM, COLCND, RCMAX, RCMIN, - $ ROWCND, RPVGRW, SMLNUM -* .. -* .. External Functions .. - LOGICAL LSAME - DOUBLE PRECISION DLAMCH, DLANGE, DLANTR - EXTERNAL LSAME, DLAMCH, DLANGE, DLANTR -* .. -* .. External Subroutines .. - EXTERNAL DGECON, DGEEQU, DGERFS, DGETRF, DGETRS, DLACPY, - $ DLAQGE, XERBLA -* .. -* .. Intrinsic Functions .. - INTRINSIC MAX, MIN -* .. -* .. Executable Statements .. -* - INFO = 0 - NOFACT = LSAME( FACT, 'N' ) - EQUIL = LSAME( FACT, 'E' ) - NOTRAN = LSAME( TRANS, 'N' ) - IF( NOFACT .OR. EQUIL ) THEN - EQUED = 'N' - ROWEQU = .FALSE. - COLEQU = .FALSE. - ELSE - ROWEQU = LSAME( EQUED, 'R' ) .OR. LSAME( EQUED, 'B' ) - COLEQU = LSAME( EQUED, 'C' ) .OR. LSAME( EQUED, 'B' ) - SMLNUM = DLAMCH( 'Safe minimum' ) - BIGNUM = ONE / SMLNUM - END IF -* -* Test the input parameters. -* - IF( .NOT.NOFACT .AND. .NOT.EQUIL .AND. .NOT.LSAME( FACT, 'F' ) ) - $ THEN - INFO = -1 - ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT. - $ LSAME( TRANS, 'C' ) ) THEN - INFO = -2 - ELSE IF( N.LT.0 ) THEN - INFO = -3 - ELSE IF( NRHS.LT.0 ) THEN - INFO = -4 - ELSE IF( LDA.LT.MAX( 1, N ) ) THEN - INFO = -6 - ELSE IF( LDAF.LT.MAX( 1, N ) ) THEN - INFO = -8 - ELSE IF( LSAME( FACT, 'F' ) .AND. .NOT. - $ ( ROWEQU .OR. COLEQU .OR. LSAME( EQUED, 'N' ) ) ) THEN - INFO = -10 - ELSE - IF( ROWEQU ) THEN - RCMIN = BIGNUM - RCMAX = ZERO - DO 10 J = 1, N - RCMIN = MIN( RCMIN, R( J ) ) - RCMAX = MAX( RCMAX, R( J ) ) - 10 CONTINUE - IF( RCMIN.LE.ZERO ) THEN - INFO = -11 - ELSE IF( N.GT.0 ) THEN - ROWCND = MAX( RCMIN, SMLNUM ) / MIN( RCMAX, BIGNUM ) - ELSE - ROWCND = ONE - END IF - END IF - IF( COLEQU .AND. INFO.EQ.0 ) THEN - RCMIN = BIGNUM - RCMAX = ZERO - DO 20 J = 1, N - RCMIN = MIN( RCMIN, C( J ) ) - RCMAX = MAX( RCMAX, C( J ) ) - 20 CONTINUE - IF( RCMIN.LE.ZERO ) THEN - INFO = -12 - ELSE IF( N.GT.0 ) THEN - COLCND = MAX( RCMIN, SMLNUM ) / MIN( RCMAX, BIGNUM ) - ELSE - COLCND = ONE - END IF - END IF - IF( INFO.EQ.0 ) THEN - IF( LDB.LT.MAX( 1, N ) ) THEN - INFO = -14 - ELSE IF( LDX.LT.MAX( 1, N ) ) THEN - INFO = -16 - END IF - END IF - END IF -* - IF( INFO.NE.0 ) THEN - CALL XERBLA( 'DGESVX', -INFO ) - RETURN - END IF -* - IF( EQUIL ) THEN -* -* Compute row and column scalings to equilibrate the matrix A. -* - CALL DGEEQU( N, N, A, LDA, R, C, ROWCND, COLCND, AMAX, INFEQU ) - IF( INFEQU.EQ.0 ) THEN -* -* Equilibrate the matrix. -* - CALL DLAQGE( N, N, A, LDA, R, C, ROWCND, COLCND, AMAX, - $ EQUED ) - ROWEQU = LSAME( EQUED, 'R' ) .OR. LSAME( EQUED, 'B' ) - COLEQU = LSAME( EQUED, 'C' ) .OR. LSAME( EQUED, 'B' ) - END IF - END IF -* -* Scale the right hand side. -* - IF( NOTRAN ) THEN - IF( ROWEQU ) THEN - DO 40 J = 1, NRHS - DO 30 I = 1, N - B( I, J ) = R( I )*B( I, J ) - 30 CONTINUE - 40 CONTINUE - END IF - ELSE IF( COLEQU ) THEN - DO 60 J = 1, NRHS - DO 50 I = 1, N - B( I, J ) = C( I )*B( I, J ) - 50 CONTINUE - 60 CONTINUE - END IF -* - IF( NOFACT .OR. EQUIL ) THEN -* -* Compute the LU factorization of A. -* - CALL DLACPY( 'Full', N, N, A, LDA, AF, LDAF ) - CALL DGETRF( N, N, AF, LDAF, IPIV, INFO ) -* -* Return if INFO is non-zero. -* - IF( INFO.GT.0 ) THEN -* -* Compute the reciprocal pivot growth factor of the -* leading rank-deficient INFO columns of A. -* - RPVGRW = DLANTR( 'M', 'U', 'N', INFO, INFO, AF, LDAF, - $ WORK ) - IF( RPVGRW.EQ.ZERO ) THEN - RPVGRW = ONE - ELSE - RPVGRW = DLANGE( 'M', N, INFO, A, LDA, WORK ) / RPVGRW - END IF - WORK( 1 ) = RPVGRW - RCOND = ZERO - RETURN - END IF - END IF -* -* Compute the norm of the matrix A and the -* reciprocal pivot growth factor RPVGRW. -* - IF( NOTRAN ) THEN - NORM = '1' - ELSE - NORM = 'I' - END IF - ANORM = DLANGE( NORM, N, N, A, LDA, WORK ) - RPVGRW = DLANTR( 'M', 'U', 'N', N, N, AF, LDAF, WORK ) - IF( RPVGRW.EQ.ZERO ) THEN - RPVGRW = ONE - ELSE - RPVGRW = DLANGE( 'M', N, N, A, LDA, WORK ) / RPVGRW - END IF -* -* Compute the reciprocal of the condition number of A. -* - CALL DGECON( NORM, N, AF, LDAF, ANORM, RCOND, WORK, IWORK, INFO ) -* -* Compute the solution matrix X. -* - CALL DLACPY( 'Full', N, NRHS, B, LDB, X, LDX ) - CALL DGETRS( TRANS, N, NRHS, AF, LDAF, IPIV, X, LDX, INFO ) -* -* Use iterative refinement to improve the computed solution and -* compute error bounds and backward error estimates for it. -* - CALL DGERFS( TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, - $ LDX, FERR, BERR, WORK, IWORK, INFO ) -* -* Transform the solution matrix X to a solution of the original -* system. -* - IF( NOTRAN ) THEN - IF( COLEQU ) THEN - DO 80 J = 1, NRHS - DO 70 I = 1, N - X( I, J ) = C( I )*X( I, J ) - 70 CONTINUE - 80 CONTINUE - DO 90 J = 1, NRHS - FERR( J ) = FERR( J ) / COLCND - 90 CONTINUE - END IF - ELSE IF( ROWEQU ) THEN - DO 110 J = 1, NRHS - DO 100 I = 1, N - X( I, J ) = R( I )*X( I, J ) - 100 CONTINUE - 110 CONTINUE - DO 120 J = 1, NRHS - FERR( J ) = FERR( J ) / ROWCND - 120 CONTINUE - END IF -* - WORK( 1 ) = RPVGRW -* -* Set INFO = N+1 if the matrix is singular to working precision. -* - IF( RCOND.LT.DLAMCH( 'Epsilon' ) ) - $ INFO = N + 1 - RETURN -* -* End of DGESVX -* - END From 099f10b7061be1fcc699e36295b403fac8a1514a Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Thu, 4 Apr 2024 11:47:34 +0200 Subject: [PATCH 306/311] Delete misplaced file (move to SRC) --- lapack-netlib/sgbsvx.f | 641 ----------------------------------------- 1 file changed, 641 deletions(-) delete mode 100644 lapack-netlib/sgbsvx.f diff --git a/lapack-netlib/sgbsvx.f b/lapack-netlib/sgbsvx.f deleted file mode 100644 index df3a721d9..000000000 --- a/lapack-netlib/sgbsvx.f +++ /dev/null @@ -1,641 +0,0 @@ -*> \brief SGBSVX computes the solution to system of linear equations A * X = B for GB matrices -* -* =========== DOCUMENTATION =========== -* -* Online html documentation available at -* http://www.netlib.org/lapack/explore-html/ -* -*> \htmlonly -*> Download SGBSVX + dependencies -*> -*> [TGZ] -*> -*> [ZIP] -*> -*> [TXT] -*> \endhtmlonly -* -* Definition: -* =========== -* -* SUBROUTINE SGBSVX( FACT, TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, -* LDAFB, IPIV, EQUED, R, C, B, LDB, X, LDX, -* RCOND, FERR, BERR, WORK, IWORK, INFO ) -* -* .. Scalar Arguments .. -* CHARACTER EQUED, FACT, TRANS -* INTEGER INFO, KL, KU, LDAB, LDAFB, LDB, LDX, N, NRHS -* REAL RCOND -* .. -* .. Array Arguments .. -* INTEGER IPIV( * ), IWORK( * ) -* REAL AB( LDAB, * ), AFB( LDAFB, * ), B( LDB, * ), -* $ BERR( * ), C( * ), FERR( * ), R( * ), -* $ WORK( * ), X( LDX, * ) -* .. -* -* -*> \par Purpose: -* ============= -*> -*> \verbatim -*> -*> SGBSVX uses the LU factorization to compute the solution to a real -*> system of linear equations A * X = B, A**T * X = B, or A**H * X = B, -*> where A is a band matrix of order N with KL subdiagonals and KU -*> superdiagonals, and X and B are N-by-NRHS matrices. -*> -*> Error bounds on the solution and a condition estimate are also -*> provided. -*> \endverbatim -* -*> \par Description: -* ================= -*> -*> \verbatim -*> -*> The following steps are performed by this subroutine: -*> -*> 1. If FACT = 'E', real scaling factors are computed to equilibrate -*> the system: -*> TRANS = 'N': diag(R)*A*diag(C) *inv(diag(C))*X = diag(R)*B -*> TRANS = 'T': (diag(R)*A*diag(C))**T *inv(diag(R))*X = diag(C)*B -*> TRANS = 'C': (diag(R)*A*diag(C))**H *inv(diag(R))*X = diag(C)*B -*> Whether or not the system will be equilibrated depends on the -*> scaling of the matrix A, but if equilibration is used, A is -*> overwritten by diag(R)*A*diag(C) and B by diag(R)*B (if TRANS='N') -*> or diag(C)*B (if TRANS = 'T' or 'C'). -*> -*> 2. If FACT = 'N' or 'E', the LU decomposition is used to factor the -*> matrix A (after equilibration if FACT = 'E') as -*> A = L * U, -*> where L is a product of permutation and unit lower triangular -*> matrices with KL subdiagonals, and U is upper triangular with -*> KL+KU superdiagonals. -*> -*> 3. If some U(i,i)=0, so that U is exactly singular, then the routine -*> returns with INFO = i. Otherwise, the factored form of A is used -*> to estimate the condition number of the matrix A. If the -*> reciprocal of the condition number is less than machine precision, -*> INFO = N+1 is returned as a warning, but the routine still goes on -*> to solve for X and compute error bounds as described below. -*> -*> 4. The system of equations is solved for X using the factored form -*> of A. -*> -*> 5. Iterative refinement is applied to improve the computed solution -*> matrix and calculate error bounds and backward error estimates -*> for it. -*> -*> 6. If equilibration was used, the matrix X is premultiplied by -*> diag(C) (if TRANS = 'N') or diag(R) (if TRANS = 'T' or 'C') so -*> that it solves the original system before equilibration. -*> \endverbatim -* -* Arguments: -* ========== -* -*> \param[in] FACT -*> \verbatim -*> FACT is CHARACTER*1 -*> Specifies whether or not the factored form of the matrix A is -*> supplied on entry, and if not, whether the matrix A should be -*> equilibrated before it is factored. -*> = 'F': On entry, AFB and IPIV contain the factored form of -*> A. If EQUED is not 'N', the matrix A has been -*> equilibrated with scaling factors given by R and C. -*> AB, AFB, and IPIV are not modified. -*> = 'N': The matrix A will be copied to AFB and factored. -*> = 'E': The matrix A will be equilibrated if necessary, then -*> copied to AFB and factored. -*> \endverbatim -*> -*> \param[in] TRANS -*> \verbatim -*> TRANS is CHARACTER*1 -*> Specifies the form of the system of equations. -*> = 'N': A * X = B (No transpose) -*> = 'T': A**T * X = B (Transpose) -*> = 'C': A**H * X = B (Transpose) -*> \endverbatim -*> -*> \param[in] N -*> \verbatim -*> N is INTEGER -*> The number of linear equations, i.e., the order of the -*> matrix A. N >= 0. -*> \endverbatim -*> -*> \param[in] KL -*> \verbatim -*> KL is INTEGER -*> The number of subdiagonals within the band of A. KL >= 0. -*> \endverbatim -*> -*> \param[in] KU -*> \verbatim -*> KU is INTEGER -*> The number of superdiagonals within the band of A. KU >= 0. -*> \endverbatim -*> -*> \param[in] NRHS -*> \verbatim -*> NRHS is INTEGER -*> The number of right hand sides, i.e., the number of columns -*> of the matrices B and X. NRHS >= 0. -*> \endverbatim -*> -*> \param[in,out] AB -*> \verbatim -*> AB is REAL array, dimension (LDAB,N) -*> On entry, the matrix A in band storage, in rows 1 to KL+KU+1. -*> The j-th column of A is stored in the j-th column of the -*> array AB as follows: -*> AB(KU+1+i-j,j) = A(i,j) for max(1,j-KU)<=i<=min(N,j+kl) -*> -*> If FACT = 'F' and EQUED is not 'N', then A must have been -*> equilibrated by the scaling factors in R and/or C. AB is not -*> modified if FACT = 'F' or 'N', or if FACT = 'E' and -*> EQUED = 'N' on exit. -*> -*> On exit, if EQUED .ne. 'N', A is scaled as follows: -*> EQUED = 'R': A := diag(R) * A -*> EQUED = 'C': A := A * diag(C) -*> EQUED = 'B': A := diag(R) * A * diag(C). -*> \endverbatim -*> -*> \param[in] LDAB -*> \verbatim -*> LDAB is INTEGER -*> The leading dimension of the array AB. LDAB >= KL+KU+1. -*> \endverbatim -*> -*> \param[in,out] AFB -*> \verbatim -*> AFB is REAL array, dimension (LDAFB,N) -*> If FACT = 'F', then AFB is an input argument and on entry -*> contains details of the LU factorization of the band matrix -*> A, as computed by SGBTRF. U is stored as an upper triangular -*> band matrix with KL+KU superdiagonals in rows 1 to KL+KU+1, -*> and the multipliers used during the factorization are stored -*> in rows KL+KU+2 to 2*KL+KU+1. If EQUED .ne. 'N', then AFB is -*> the factored form of the equilibrated matrix A. -*> -*> If FACT = 'N', then AFB is an output argument and on exit -*> returns details of the LU factorization of A. -*> -*> If FACT = 'E', then AFB is an output argument and on exit -*> returns details of the LU factorization of the equilibrated -*> matrix A (see the description of AB for the form of the -*> equilibrated matrix). -*> \endverbatim -*> -*> \param[in] LDAFB -*> \verbatim -*> LDAFB is INTEGER -*> The leading dimension of the array AFB. LDAFB >= 2*KL+KU+1. -*> \endverbatim -*> -*> \param[in,out] IPIV -*> \verbatim -*> IPIV is INTEGER array, dimension (N) -*> If FACT = 'F', then IPIV is an input argument and on entry -*> contains the pivot indices from the factorization A = L*U -*> as computed by SGBTRF; row i of the matrix was interchanged -*> with row IPIV(i). -*> -*> If FACT = 'N', then IPIV is an output argument and on exit -*> contains the pivot indices from the factorization A = L*U -*> of the original matrix A. -*> -*> If FACT = 'E', then IPIV is an output argument and on exit -*> contains the pivot indices from the factorization A = L*U -*> of the equilibrated matrix A. -*> \endverbatim -*> -*> \param[in,out] EQUED -*> \verbatim -*> EQUED is CHARACTER*1 -*> Specifies the form of equilibration that was done. -*> = 'N': No equilibration (always true if FACT = 'N'). -*> = 'R': Row equilibration, i.e., A has been premultiplied by -*> diag(R). -*> = 'C': Column equilibration, i.e., A has been postmultiplied -*> by diag(C). -*> = 'B': Both row and column equilibration, i.e., A has been -*> replaced by diag(R) * A * diag(C). -*> EQUED is an input argument if FACT = 'F'; otherwise, it is an -*> output argument. -*> \endverbatim -*> -*> \param[in,out] R -*> \verbatim -*> R is REAL array, dimension (N) -*> The row scale factors for A. If EQUED = 'R' or 'B', A is -*> multiplied on the left by diag(R); if EQUED = 'N' or 'C', R -*> is not accessed. R is an input argument if FACT = 'F'; -*> otherwise, R is an output argument. If FACT = 'F' and -*> EQUED = 'R' or 'B', each element of R must be positive. -*> \endverbatim -*> -*> \param[in,out] C -*> \verbatim -*> C is REAL array, dimension (N) -*> The column scale factors for A. If EQUED = 'C' or 'B', A is -*> multiplied on the right by diag(C); if EQUED = 'N' or 'R', C -*> is not accessed. C is an input argument if FACT = 'F'; -*> otherwise, C is an output argument. If FACT = 'F' and -*> EQUED = 'C' or 'B', each element of C must be positive. -*> \endverbatim -*> -*> \param[in,out] B -*> \verbatim -*> B is REAL array, dimension (LDB,NRHS) -*> On entry, the right hand side matrix B. -*> On exit, -*> if EQUED = 'N', B is not modified; -*> if TRANS = 'N' and EQUED = 'R' or 'B', B is overwritten by -*> diag(R)*B; -*> if TRANS = 'T' or 'C' and EQUED = 'C' or 'B', B is -*> overwritten by diag(C)*B. -*> \endverbatim -*> -*> \param[in] LDB -*> \verbatim -*> LDB is INTEGER -*> The leading dimension of the array B. LDB >= max(1,N). -*> \endverbatim -*> -*> \param[out] X -*> \verbatim -*> X is REAL array, dimension (LDX,NRHS) -*> If INFO = 0 or INFO = N+1, the N-by-NRHS solution matrix X -*> to the original system of equations. Note that A and B are -*> modified on exit if EQUED .ne. 'N', and the solution to the -*> equilibrated system is inv(diag(C))*X if TRANS = 'N' and -*> EQUED = 'C' or 'B', or inv(diag(R))*X if TRANS = 'T' or 'C' -*> and EQUED = 'R' or 'B'. -*> \endverbatim -*> -*> \param[in] LDX -*> \verbatim -*> LDX is INTEGER -*> The leading dimension of the array X. LDX >= max(1,N). -*> \endverbatim -*> -*> \param[out] RCOND -*> \verbatim -*> RCOND is REAL -*> The estimate of the reciprocal condition number of the matrix -*> A after equilibration (if done). If RCOND is less than the -*> machine precision (in particular, if RCOND = 0), the matrix -*> is singular to working precision. This condition is -*> indicated by a return code of INFO > 0. -*> \endverbatim -*> -*> \param[out] FERR -*> \verbatim -*> FERR is REAL array, dimension (NRHS) -*> The estimated forward error bound for each solution vector -*> X(j) (the j-th column of the solution matrix X). -*> If XTRUE is the true solution corresponding to X(j), FERR(j) -*> is an estimated upper bound for the magnitude of the largest -*> element in (X(j) - XTRUE) divided by the magnitude of the -*> largest element in X(j). The estimate is as reliable as -*> the estimate for RCOND, and is almost always a slight -*> overestimate of the true error. -*> \endverbatim -*> -*> \param[out] BERR -*> \verbatim -*> BERR is REAL array, dimension (NRHS) -*> The componentwise relative backward error of each solution -*> vector X(j) (i.e., the smallest relative change in -*> any element of A or B that makes X(j) an exact solution). -*> \endverbatim -*> -*> \param[out] WORK -*> \verbatim -*> WORK is REAL array, dimension (MAX(1,3*N)) -*> On exit, WORK(1) contains the reciprocal pivot growth -*> factor norm(A)/norm(U). The "max absolute element" norm is -*> used. If WORK(1) is much less than 1, then the stability -*> of the LU factorization of the (equilibrated) matrix A -*> could be poor. This also means that the solution X, condition -*> estimator RCOND, and forward error bound FERR could be -*> unreliable. If factorization fails with 0 WORK(1) contains the reciprocal pivot growth factor for the -*> leading INFO columns of A. -*> \endverbatim -*> -*> \param[out] IWORK -*> \verbatim -*> IWORK is INTEGER array, dimension (N) -*> \endverbatim -*> -*> \param[out] INFO -*> \verbatim -*> INFO is INTEGER -*> = 0: successful exit -*> < 0: if INFO = -i, the i-th argument had an illegal value -*> > 0: if INFO = i, and i is -*> <= N: U(i,i) is exactly zero. The factorization -*> has been completed, but the factor U is exactly -*> singular, so the solution and error bounds -*> could not be computed. RCOND = 0 is returned. -*> = N+1: U is nonsingular, but RCOND is less than machine -*> precision, meaning that the matrix is singular -*> to working precision. Nevertheless, the -*> solution and error bounds are computed because -*> there are a number of situations where the -*> computed solution can be more accurate than the -*> \endverbatim -* -* Authors: -* ======== -* -*> \author Univ. of Tennessee -*> \author Univ. of California Berkeley -*> \author Univ. of Colorado Denver -*> \author NAG Ltd. -* -*> \ingroup realGBsolve -* -* ===================================================================== - SUBROUTINE SGBSVX( FACT, TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, - $ LDAFB, IPIV, EQUED, R, C, B, LDB, X, LDX, - $ RCOND, FERR, BERR, WORK, IWORK, INFO ) -* -* -- LAPACK driver routine -- -* -- LAPACK is a software package provided by Univ. of Tennessee, -- -* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* -* .. Scalar Arguments .. - CHARACTER EQUED, FACT, TRANS - INTEGER INFO, KL, KU, LDAB, LDAFB, LDB, LDX, N, NRHS - REAL RCOND -* .. -* .. Array Arguments .. - INTEGER IPIV( * ), IWORK( * ) - REAL AB( LDAB, * ), AFB( LDAFB, * ), B( LDB, * ), - $ BERR( * ), C( * ), FERR( * ), R( * ), - $ WORK( * ), X( LDX, * ) -* .. -* -* ===================================================================== -* Moved setting of INFO = N+1 so INFO does not subsequently get -* overwritten. Sven, 17 Mar 05. -* ===================================================================== -* -* .. Parameters .. - REAL ZERO, ONE - PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 ) -* .. -* .. Local Scalars .. - LOGICAL COLEQU, EQUIL, NOFACT, NOTRAN, ROWEQU - CHARACTER NORM - INTEGER I, INFEQU, J, J1, J2 - REAL AMAX, ANORM, BIGNUM, COLCND, RCMAX, RCMIN, - $ ROWCND, RPVGRW, SMLNUM -* .. -* .. External Functions .. - LOGICAL LSAME - REAL SLAMCH, SLANGB, SLANTB - EXTERNAL LSAME, SLAMCH, SLANGB, SLANTB -* .. -* .. External Subroutines .. - EXTERNAL SCOPY, SGBCON, SGBEQU, SGBRFS, SGBTRF, SGBTRS, - $ SLACPY, SLAQGB, XERBLA -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS, MAX, MIN -* .. -* .. Executable Statements .. -* - INFO = 0 - NOFACT = LSAME( FACT, 'N' ) - EQUIL = LSAME( FACT, 'E' ) - NOTRAN = LSAME( TRANS, 'N' ) - IF( NOFACT .OR. EQUIL ) THEN - EQUED = 'N' - ROWEQU = .FALSE. - COLEQU = .FALSE. - ELSE - ROWEQU = LSAME( EQUED, 'R' ) .OR. LSAME( EQUED, 'B' ) - COLEQU = LSAME( EQUED, 'C' ) .OR. LSAME( EQUED, 'B' ) - SMLNUM = SLAMCH( 'Safe minimum' ) - BIGNUM = ONE / SMLNUM - END IF -* -* Test the input parameters. -* - IF( .NOT.NOFACT .AND. .NOT.EQUIL .AND. .NOT.LSAME( FACT, 'F' ) ) - $ THEN - INFO = -1 - ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT. - $ LSAME( TRANS, 'C' ) ) THEN - INFO = -2 - ELSE IF( N.LT.0 ) THEN - INFO = -3 - ELSE IF( KL.LT.0 ) THEN - INFO = -4 - ELSE IF( KU.LT.0 ) THEN - INFO = -5 - ELSE IF( NRHS.LT.0 ) THEN - INFO = -6 - ELSE IF( LDAB.LT.KL+KU+1 ) THEN - INFO = -8 - ELSE IF( LDAFB.LT.2*KL+KU+1 ) THEN - INFO = -10 - ELSE IF( LSAME( FACT, 'F' ) .AND. .NOT. - $ ( ROWEQU .OR. COLEQU .OR. LSAME( EQUED, 'N' ) ) ) THEN - INFO = -12 - ELSE - IF( ROWEQU ) THEN - RCMIN = BIGNUM - RCMAX = ZERO - DO 10 J = 1, N - RCMIN = MIN( RCMIN, R( J ) ) - RCMAX = MAX( RCMAX, R( J ) ) - 10 CONTINUE - IF( RCMIN.LE.ZERO ) THEN - INFO = -13 - ELSE IF( N.GT.0 ) THEN - ROWCND = MAX( RCMIN, SMLNUM ) / MIN( RCMAX, BIGNUM ) - ELSE - ROWCND = ONE - END IF - END IF - IF( COLEQU .AND. INFO.EQ.0 ) THEN - RCMIN = BIGNUM - RCMAX = ZERO - DO 20 J = 1, N - RCMIN = MIN( RCMIN, C( J ) ) - RCMAX = MAX( RCMAX, C( J ) ) - 20 CONTINUE - IF( RCMIN.LE.ZERO ) THEN - INFO = -14 - ELSE IF( N.GT.0 ) THEN - COLCND = MAX( RCMIN, SMLNUM ) / MIN( RCMAX, BIGNUM ) - ELSE - COLCND = ONE - END IF - END IF - IF( INFO.EQ.0 ) THEN - IF( LDB.LT.MAX( 1, N ) ) THEN - INFO = -16 - ELSE IF( LDX.LT.MAX( 1, N ) ) THEN - INFO = -18 - END IF - END IF - END IF -* - IF( INFO.NE.0 ) THEN - CALL XERBLA( 'SGBSVX', -INFO ) - RETURN - END IF -* - IF( EQUIL ) THEN -* -* Compute row and column scalings to equilibrate the matrix A. -* - CALL SGBEQU( N, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND, - $ AMAX, INFEQU ) - IF( INFEQU.EQ.0 ) THEN -* -* Equilibrate the matrix. -* - CALL SLAQGB( N, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND, - $ AMAX, EQUED ) - ROWEQU = LSAME( EQUED, 'R' ) .OR. LSAME( EQUED, 'B' ) - COLEQU = LSAME( EQUED, 'C' ) .OR. LSAME( EQUED, 'B' ) - END IF - END IF -* -* Scale the right hand side. -* - IF( NOTRAN ) THEN - IF( ROWEQU ) THEN - DO 40 J = 1, NRHS - DO 30 I = 1, N - B( I, J ) = R( I )*B( I, J ) - 30 CONTINUE - 40 CONTINUE - END IF - ELSE IF( COLEQU ) THEN - DO 60 J = 1, NRHS - DO 50 I = 1, N - B( I, J ) = C( I )*B( I, J ) - 50 CONTINUE - 60 CONTINUE - END IF -* - IF( NOFACT .OR. EQUIL ) THEN -* -* Compute the LU factorization of the band matrix A. -* - DO 70 J = 1, N - J1 = MAX( J-KU, 1 ) - J2 = MIN( J+KL, N ) - CALL SCOPY( J2-J1+1, AB( KU+1-J+J1, J ), 1, - $ AFB( KL+KU+1-J+J1, J ), 1 ) - 70 CONTINUE -* - CALL SGBTRF( N, N, KL, KU, AFB, LDAFB, IPIV, INFO ) -* -* Return if INFO is non-zero. -* - IF( INFO.GT.0 ) THEN -* -* Compute the reciprocal pivot growth factor of the -* leading rank-deficient INFO columns of A. -* - ANORM = ZERO - DO 90 J = 1, INFO - DO 80 I = MAX( KU+2-J, 1 ), MIN( N+KU+1-J, KL+KU+1 ) - ANORM = MAX( ANORM, ABS( AB( I, J ) ) ) - 80 CONTINUE - 90 CONTINUE - RPVGRW = SLANTB( 'M', 'U', 'N', INFO, MIN( INFO-1, KL+KU ), - $ AFB( MAX( 1, KL+KU+2-INFO ), 1 ), LDAFB, - $ WORK ) - IF( RPVGRW.EQ.ZERO ) THEN - RPVGRW = ONE - ELSE - RPVGRW = ANORM / RPVGRW - END IF - WORK( 1 ) = RPVGRW - RCOND = ZERO - RETURN - END IF - END IF -* -* Compute the norm of the matrix A and the -* reciprocal pivot growth factor RPVGRW. -* - IF( NOTRAN ) THEN - NORM = '1' - ELSE - NORM = 'I' - END IF - ANORM = SLANGB( NORM, N, KL, KU, AB, LDAB, WORK ) - RPVGRW = SLANTB( 'M', 'U', 'N', N, KL+KU, AFB, LDAFB, WORK ) - IF( RPVGRW.EQ.ZERO ) THEN - RPVGRW = ONE - ELSE - RPVGRW = SLANGB( 'M', N, KL, KU, AB, LDAB, WORK ) / RPVGRW - END IF -* -* Compute the reciprocal of the condition number of A. -* - CALL SGBCON( NORM, N, KL, KU, AFB, LDAFB, IPIV, ANORM, RCOND, - $ WORK, IWORK, INFO ) -* -* Compute the solution matrix X. -* - CALL SLACPY( 'Full', N, NRHS, B, LDB, X, LDX ) - CALL SGBTRS( TRANS, N, KL, KU, NRHS, AFB, LDAFB, IPIV, X, LDX, - $ INFO ) -* -* Use iterative refinement to improve the computed solution and -* compute error bounds and backward error estimates for it. -* - CALL SGBRFS( TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB, IPIV, - $ B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO ) -* -* Transform the solution matrix X to a solution of the original -* system. -* - IF( NOTRAN ) THEN - IF( COLEQU ) THEN - DO 110 J = 1, NRHS - DO 100 I = 1, N - X( I, J ) = C( I )*X( I, J ) - 100 CONTINUE - 110 CONTINUE - DO 120 J = 1, NRHS - FERR( J ) = FERR( J ) / COLCND - 120 CONTINUE - END IF - ELSE IF( ROWEQU ) THEN - DO 140 J = 1, NRHS - DO 130 I = 1, N - X( I, J ) = R( I )*X( I, J ) - 130 CONTINUE - 140 CONTINUE - DO 150 J = 1, NRHS - FERR( J ) = FERR( J ) / ROWCND - 150 CONTINUE - END IF -* -* Set INFO = N+1 if the matrix is singular to working precision. -* - IF( RCOND.LT.SLAMCH( 'Epsilon' ) ) - $ INFO = N + 1 -* - WORK( 1 ) = RPVGRW - RETURN -* -* End of SGBSVX -* - END From f58f097a51b7784a46046a7c243b13e4220510f8 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Thu, 4 Apr 2024 11:48:00 +0200 Subject: [PATCH 307/311] Delete misplaced file (move to SRC) --- lapack-netlib/sgesvx.f | 599 ----------------------------------------- 1 file changed, 599 deletions(-) delete mode 100644 lapack-netlib/sgesvx.f diff --git a/lapack-netlib/sgesvx.f b/lapack-netlib/sgesvx.f deleted file mode 100644 index 385e626cf..000000000 --- a/lapack-netlib/sgesvx.f +++ /dev/null @@ -1,599 +0,0 @@ -*> \brief SGESVX computes the solution to system of linear equations A * X = B for GE matrices -* -* =========== DOCUMENTATION =========== -* -* Online html documentation available at -* http://www.netlib.org/lapack/explore-html/ -* -*> \htmlonly -*> Download SGESVX + dependencies -*> -*> [TGZ] -*> -*> [ZIP] -*> -*> [TXT] -*> \endhtmlonly -* -* Definition: -* =========== -* -* SUBROUTINE SGESVX( FACT, TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, -* EQUED, R, C, B, LDB, X, LDX, RCOND, FERR, BERR, -* WORK, IWORK, INFO ) -* -* .. Scalar Arguments .. -* CHARACTER EQUED, FACT, TRANS -* INTEGER INFO, LDA, LDAF, LDB, LDX, N, NRHS -* REAL RCOND -* .. -* .. Array Arguments .. -* INTEGER IPIV( * ), IWORK( * ) -* REAL A( LDA, * ), AF( LDAF, * ), B( LDB, * ), -* $ BERR( * ), C( * ), FERR( * ), R( * ), -* $ WORK( * ), X( LDX, * ) -* .. -* -* -*> \par Purpose: -* ============= -*> -*> \verbatim -*> -*> SGESVX uses the LU factorization to compute the solution to a real -*> system of linear equations -*> A * X = B, -*> where A is an N-by-N matrix and X and B are N-by-NRHS matrices. -*> -*> Error bounds on the solution and a condition estimate are also -*> provided. -*> \endverbatim -* -*> \par Description: -* ================= -*> -*> \verbatim -*> -*> The following steps are performed: -*> -*> 1. If FACT = 'E', real scaling factors are computed to equilibrate -*> the system: -*> TRANS = 'N': diag(R)*A*diag(C) *inv(diag(C))*X = diag(R)*B -*> TRANS = 'T': (diag(R)*A*diag(C))**T *inv(diag(R))*X = diag(C)*B -*> TRANS = 'C': (diag(R)*A*diag(C))**H *inv(diag(R))*X = diag(C)*B -*> Whether or not the system will be equilibrated depends on the -*> scaling of the matrix A, but if equilibration is used, A is -*> overwritten by diag(R)*A*diag(C) and B by diag(R)*B (if TRANS='N') -*> or diag(C)*B (if TRANS = 'T' or 'C'). -*> -*> 2. If FACT = 'N' or 'E', the LU decomposition is used to factor the -*> matrix A (after equilibration if FACT = 'E') as -*> A = P * L * U, -*> where P is a permutation matrix, L is a unit lower triangular -*> matrix, and U is upper triangular. -*> -*> 3. If some U(i,i)=0, so that U is exactly singular, then the routine -*> returns with INFO = i. Otherwise, the factored form of A is used -*> to estimate the condition number of the matrix A. If the -*> reciprocal of the condition number is less than machine precision, -*> INFO = N+1 is returned as a warning, but the routine still goes on -*> to solve for X and compute error bounds as described below. -*> -*> 4. The system of equations is solved for X using the factored form -*> of A. -*> -*> 5. Iterative refinement is applied to improve the computed solution -*> matrix and calculate error bounds and backward error estimates -*> for it. -*> -*> 6. If equilibration was used, the matrix X is premultiplied by -*> diag(C) (if TRANS = 'N') or diag(R) (if TRANS = 'T' or 'C') so -*> that it solves the original system before equilibration. -*> \endverbatim -* -* Arguments: -* ========== -* -*> \param[in] FACT -*> \verbatim -*> FACT is CHARACTER*1 -*> Specifies whether or not the factored form of the matrix A is -*> supplied on entry, and if not, whether the matrix A should be -*> equilibrated before it is factored. -*> = 'F': On entry, AF and IPIV contain the factored form of A. -*> If EQUED is not 'N', the matrix A has been -*> equilibrated with scaling factors given by R and C. -*> A, AF, and IPIV are not modified. -*> = 'N': The matrix A will be copied to AF and factored. -*> = 'E': The matrix A will be equilibrated if necessary, then -*> copied to AF and factored. -*> \endverbatim -*> -*> \param[in] TRANS -*> \verbatim -*> TRANS is CHARACTER*1 -*> Specifies the form of the system of equations: -*> = 'N': A * X = B (No transpose) -*> = 'T': A**T * X = B (Transpose) -*> = 'C': A**H * X = B (Transpose) -*> \endverbatim -*> -*> \param[in] N -*> \verbatim -*> N is INTEGER -*> The number of linear equations, i.e., the order of the -*> matrix A. N >= 0. -*> \endverbatim -*> -*> \param[in] NRHS -*> \verbatim -*> NRHS is INTEGER -*> The number of right hand sides, i.e., the number of columns -*> of the matrices B and X. NRHS >= 0. -*> \endverbatim -*> -*> \param[in,out] A -*> \verbatim -*> A is REAL array, dimension (LDA,N) -*> On entry, the N-by-N matrix A. If FACT = 'F' and EQUED is -*> not 'N', then A must have been equilibrated by the scaling -*> factors in R and/or C. A is not modified if FACT = 'F' or -*> 'N', or if FACT = 'E' and EQUED = 'N' on exit. -*> -*> On exit, if EQUED .ne. 'N', A is scaled as follows: -*> EQUED = 'R': A := diag(R) * A -*> EQUED = 'C': A := A * diag(C) -*> EQUED = 'B': A := diag(R) * A * diag(C). -*> \endverbatim -*> -*> \param[in] LDA -*> \verbatim -*> LDA is INTEGER -*> The leading dimension of the array A. LDA >= max(1,N). -*> \endverbatim -*> -*> \param[in,out] AF -*> \verbatim -*> AF is REAL array, dimension (LDAF,N) -*> If FACT = 'F', then AF is an input argument and on entry -*> contains the factors L and U from the factorization -*> A = P*L*U as computed by SGETRF. If EQUED .ne. 'N', then -*> AF is the factored form of the equilibrated matrix A. -*> -*> If FACT = 'N', then AF is an output argument and on exit -*> returns the factors L and U from the factorization A = P*L*U -*> of the original matrix A. -*> -*> If FACT = 'E', then AF is an output argument and on exit -*> returns the factors L and U from the factorization A = P*L*U -*> of the equilibrated matrix A (see the description of A for -*> the form of the equilibrated matrix). -*> \endverbatim -*> -*> \param[in] LDAF -*> \verbatim -*> LDAF is INTEGER -*> The leading dimension of the array AF. LDAF >= max(1,N). -*> \endverbatim -*> -*> \param[in,out] IPIV -*> \verbatim -*> IPIV is INTEGER array, dimension (N) -*> If FACT = 'F', then IPIV is an input argument and on entry -*> contains the pivot indices from the factorization A = P*L*U -*> as computed by SGETRF; row i of the matrix was interchanged -*> with row IPIV(i). -*> -*> If FACT = 'N', then IPIV is an output argument and on exit -*> contains the pivot indices from the factorization A = P*L*U -*> of the original matrix A. -*> -*> If FACT = 'E', then IPIV is an output argument and on exit -*> contains the pivot indices from the factorization A = P*L*U -*> of the equilibrated matrix A. -*> \endverbatim -*> -*> \param[in,out] EQUED -*> \verbatim -*> EQUED is CHARACTER*1 -*> Specifies the form of equilibration that was done. -*> = 'N': No equilibration (always true if FACT = 'N'). -*> = 'R': Row equilibration, i.e., A has been premultiplied by -*> diag(R). -*> = 'C': Column equilibration, i.e., A has been postmultiplied -*> by diag(C). -*> = 'B': Both row and column equilibration, i.e., A has been -*> replaced by diag(R) * A * diag(C). -*> EQUED is an input argument if FACT = 'F'; otherwise, it is an -*> output argument. -*> \endverbatim -*> -*> \param[in,out] R -*> \verbatim -*> R is REAL array, dimension (N) -*> The row scale factors for A. If EQUED = 'R' or 'B', A is -*> multiplied on the left by diag(R); if EQUED = 'N' or 'C', R -*> is not accessed. R is an input argument if FACT = 'F'; -*> otherwise, R is an output argument. If FACT = 'F' and -*> EQUED = 'R' or 'B', each element of R must be positive. -*> \endverbatim -*> -*> \param[in,out] C -*> \verbatim -*> C is REAL array, dimension (N) -*> The column scale factors for A. If EQUED = 'C' or 'B', A is -*> multiplied on the right by diag(C); if EQUED = 'N' or 'R', C -*> is not accessed. C is an input argument if FACT = 'F'; -*> otherwise, C is an output argument. If FACT = 'F' and -*> EQUED = 'C' or 'B', each element of C must be positive. -*> \endverbatim -*> -*> \param[in,out] B -*> \verbatim -*> B is REAL array, dimension (LDB,NRHS) -*> On entry, the N-by-NRHS right hand side matrix B. -*> On exit, -*> if EQUED = 'N', B is not modified; -*> if TRANS = 'N' and EQUED = 'R' or 'B', B is overwritten by -*> diag(R)*B; -*> if TRANS = 'T' or 'C' and EQUED = 'C' or 'B', B is -*> overwritten by diag(C)*B. -*> \endverbatim -*> -*> \param[in] LDB -*> \verbatim -*> LDB is INTEGER -*> The leading dimension of the array B. LDB >= max(1,N). -*> \endverbatim -*> -*> \param[out] X -*> \verbatim -*> X is REAL array, dimension (LDX,NRHS) -*> If INFO = 0 or INFO = N+1, the N-by-NRHS solution matrix X -*> to the original system of equations. Note that A and B are -*> modified on exit if EQUED .ne. 'N', and the solution to the -*> equilibrated system is inv(diag(C))*X if TRANS = 'N' and -*> EQUED = 'C' or 'B', or inv(diag(R))*X if TRANS = 'T' or 'C' -*> and EQUED = 'R' or 'B'. -*> \endverbatim -*> -*> \param[in] LDX -*> \verbatim -*> LDX is INTEGER -*> The leading dimension of the array X. LDX >= max(1,N). -*> \endverbatim -*> -*> \param[out] RCOND -*> \verbatim -*> RCOND is REAL -*> The estimate of the reciprocal condition number of the matrix -*> A after equilibration (if done). If RCOND is less than the -*> machine precision (in particular, if RCOND = 0), the matrix -*> is singular to working precision. This condition is -*> indicated by a return code of INFO > 0. -*> \endverbatim -*> -*> \param[out] FERR -*> \verbatim -*> FERR is REAL array, dimension (NRHS) -*> The estimated forward error bound for each solution vector -*> X(j) (the j-th column of the solution matrix X). -*> If XTRUE is the true solution corresponding to X(j), FERR(j) -*> is an estimated upper bound for the magnitude of the largest -*> element in (X(j) - XTRUE) divided by the magnitude of the -*> largest element in X(j). The estimate is as reliable as -*> the estimate for RCOND, and is almost always a slight -*> overestimate of the true error. -*> \endverbatim -*> -*> \param[out] BERR -*> \verbatim -*> BERR is REAL array, dimension (NRHS) -*> The componentwise relative backward error of each solution -*> vector X(j) (i.e., the smallest relative change in -*> any element of A or B that makes X(j) an exact solution). -*> \endverbatim -*> -*> \param[out] WORK -*> \verbatim -*> WORK is REAL array, dimension (MAX(1,4*N)) -*> On exit, WORK(1) contains the reciprocal pivot growth -*> factor norm(A)/norm(U). The "max absolute element" norm is -*> used. If WORK(1) is much less than 1, then the stability -*> of the LU factorization of the (equilibrated) matrix A -*> could be poor. This also means that the solution X, condition -*> estimator RCOND, and forward error bound FERR could be -*> unreliable. If factorization fails with 0 WORK(1) contains the reciprocal pivot growth factor for the -*> leading INFO columns of A. -*> \endverbatim -*> -*> \param[out] IWORK -*> \verbatim -*> IWORK is INTEGER array, dimension (N) -*> \endverbatim -*> -*> \param[out] INFO -*> \verbatim -*> INFO is INTEGER -*> = 0: successful exit -*> < 0: if INFO = -i, the i-th argument had an illegal value -*> > 0: if INFO = i, and i is -*> <= N: U(i,i) is exactly zero. The factorization has -*> been completed, but the factor U is exactly -*> singular, so the solution and error bounds -*> could not be computed. RCOND = 0 is returned. -*> = N+1: U is nonsingular, but RCOND is less than machine -*> precision, meaning that the matrix is singular -*> to working precision. Nevertheless, the -*> solution and error bounds are computed because -*> there are a number of situations where the -*> computed solution can be more accurate than the -*> value of RCOND would suggest. -*> \endverbatim -* -* Authors: -* ======== -* -*> \author Univ. of Tennessee -*> \author Univ. of California Berkeley -*> \author Univ. of Colorado Denver -*> \author NAG Ltd. -* -*> \ingroup realGEsolve -* -* ===================================================================== - SUBROUTINE SGESVX( FACT, TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, - $ EQUED, R, C, B, LDB, X, LDX, RCOND, FERR, BERR, - $ WORK, IWORK, INFO ) -* -* -- LAPACK driver routine -- -* -- LAPACK is a software package provided by Univ. of Tennessee, -- -* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* -* .. Scalar Arguments .. - CHARACTER EQUED, FACT, TRANS - INTEGER INFO, LDA, LDAF, LDB, LDX, N, NRHS - REAL RCOND -* .. -* .. Array Arguments .. - INTEGER IPIV( * ), IWORK( * ) - REAL A( LDA, * ), AF( LDAF, * ), B( LDB, * ), - $ BERR( * ), C( * ), FERR( * ), R( * ), - $ WORK( * ), X( LDX, * ) -* .. -* -* ===================================================================== -* -* .. Parameters .. - REAL ZERO, ONE - PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 ) -* .. -* .. Local Scalars .. - LOGICAL COLEQU, EQUIL, NOFACT, NOTRAN, ROWEQU - CHARACTER NORM - INTEGER I, INFEQU, J - REAL AMAX, ANORM, BIGNUM, COLCND, RCMAX, RCMIN, - $ ROWCND, RPVGRW, SMLNUM -* .. -* .. External Functions .. - LOGICAL LSAME - REAL SLAMCH, SLANGE, SLANTR - EXTERNAL LSAME, SLAMCH, SLANGE, SLANTR -* .. -* .. External Subroutines .. - EXTERNAL SGECON, SGEEQU, SGERFS, SGETRF, SGETRS, SLACPY, - $ SLAQGE, XERBLA -* .. -* .. Intrinsic Functions .. - INTRINSIC MAX, MIN -* .. -* .. Executable Statements .. -* - INFO = 0 - NOFACT = LSAME( FACT, 'N' ) - EQUIL = LSAME( FACT, 'E' ) - NOTRAN = LSAME( TRANS, 'N' ) - IF( NOFACT .OR. EQUIL ) THEN - EQUED = 'N' - ROWEQU = .FALSE. - COLEQU = .FALSE. - ELSE - ROWEQU = LSAME( EQUED, 'R' ) .OR. LSAME( EQUED, 'B' ) - COLEQU = LSAME( EQUED, 'C' ) .OR. LSAME( EQUED, 'B' ) - SMLNUM = SLAMCH( 'Safe minimum' ) - BIGNUM = ONE / SMLNUM - END IF -* -* Test the input parameters. -* - IF( .NOT.NOFACT .AND. .NOT.EQUIL .AND. .NOT.LSAME( FACT, 'F' ) ) - $ THEN - INFO = -1 - ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT. - $ LSAME( TRANS, 'C' ) ) THEN - INFO = -2 - ELSE IF( N.LT.0 ) THEN - INFO = -3 - ELSE IF( NRHS.LT.0 ) THEN - INFO = -4 - ELSE IF( LDA.LT.MAX( 1, N ) ) THEN - INFO = -6 - ELSE IF( LDAF.LT.MAX( 1, N ) ) THEN - INFO = -8 - ELSE IF( LSAME( FACT, 'F' ) .AND. .NOT. - $ ( ROWEQU .OR. COLEQU .OR. LSAME( EQUED, 'N' ) ) ) THEN - INFO = -10 - ELSE - IF( ROWEQU ) THEN - RCMIN = BIGNUM - RCMAX = ZERO - DO 10 J = 1, N - RCMIN = MIN( RCMIN, R( J ) ) - RCMAX = MAX( RCMAX, R( J ) ) - 10 CONTINUE - IF( RCMIN.LE.ZERO ) THEN - INFO = -11 - ELSE IF( N.GT.0 ) THEN - ROWCND = MAX( RCMIN, SMLNUM ) / MIN( RCMAX, BIGNUM ) - ELSE - ROWCND = ONE - END IF - END IF - IF( COLEQU .AND. INFO.EQ.0 ) THEN - RCMIN = BIGNUM - RCMAX = ZERO - DO 20 J = 1, N - RCMIN = MIN( RCMIN, C( J ) ) - RCMAX = MAX( RCMAX, C( J ) ) - 20 CONTINUE - IF( RCMIN.LE.ZERO ) THEN - INFO = -12 - ELSE IF( N.GT.0 ) THEN - COLCND = MAX( RCMIN, SMLNUM ) / MIN( RCMAX, BIGNUM ) - ELSE - COLCND = ONE - END IF - END IF - IF( INFO.EQ.0 ) THEN - IF( LDB.LT.MAX( 1, N ) ) THEN - INFO = -14 - ELSE IF( LDX.LT.MAX( 1, N ) ) THEN - INFO = -16 - END IF - END IF - END IF -* - IF( INFO.NE.0 ) THEN - CALL XERBLA( 'SGESVX', -INFO ) - RETURN - END IF -* - IF( EQUIL ) THEN -* -* Compute row and column scalings to equilibrate the matrix A. -* - CALL SGEEQU( N, N, A, LDA, R, C, ROWCND, COLCND, AMAX, INFEQU ) - IF( INFEQU.EQ.0 ) THEN -* -* Equilibrate the matrix. -* - CALL SLAQGE( N, N, A, LDA, R, C, ROWCND, COLCND, AMAX, - $ EQUED ) - ROWEQU = LSAME( EQUED, 'R' ) .OR. LSAME( EQUED, 'B' ) - COLEQU = LSAME( EQUED, 'C' ) .OR. LSAME( EQUED, 'B' ) - END IF - END IF -* -* Scale the right hand side. -* - IF( NOTRAN ) THEN - IF( ROWEQU ) THEN - DO 40 J = 1, NRHS - DO 30 I = 1, N - B( I, J ) = R( I )*B( I, J ) - 30 CONTINUE - 40 CONTINUE - END IF - ELSE IF( COLEQU ) THEN - DO 60 J = 1, NRHS - DO 50 I = 1, N - B( I, J ) = C( I )*B( I, J ) - 50 CONTINUE - 60 CONTINUE - END IF -* - IF( NOFACT .OR. EQUIL ) THEN -* -* Compute the LU factorization of A. -* - CALL SLACPY( 'Full', N, N, A, LDA, AF, LDAF ) - CALL SGETRF( N, N, AF, LDAF, IPIV, INFO ) -* -* Return if INFO is non-zero. -* - IF( INFO.GT.0 ) THEN -* -* Compute the reciprocal pivot growth factor of the -* leading rank-deficient INFO columns of A. -* - RPVGRW = SLANTR( 'M', 'U', 'N', INFO, INFO, AF, LDAF, - $ WORK ) - IF( RPVGRW.EQ.ZERO ) THEN - RPVGRW = ONE - ELSE - RPVGRW = SLANGE( 'M', N, INFO, A, LDA, WORK ) / RPVGRW - END IF - WORK( 1 ) = RPVGRW - RCOND = ZERO - RETURN - END IF - END IF -* -* Compute the norm of the matrix A and the -* reciprocal pivot growth factor RPVGRW. -* - IF( NOTRAN ) THEN - NORM = '1' - ELSE - NORM = 'I' - END IF - ANORM = SLANGE( NORM, N, N, A, LDA, WORK ) - RPVGRW = SLANTR( 'M', 'U', 'N', N, N, AF, LDAF, WORK ) - IF( RPVGRW.EQ.ZERO ) THEN - RPVGRW = ONE - ELSE - RPVGRW = SLANGE( 'M', N, N, A, LDA, WORK ) / RPVGRW - END IF -* -* Compute the reciprocal of the condition number of A. -* - CALL SGECON( NORM, N, AF, LDAF, ANORM, RCOND, WORK, IWORK, INFO ) -* -* Compute the solution matrix X. -* - CALL SLACPY( 'Full', N, NRHS, B, LDB, X, LDX ) - CALL SGETRS( TRANS, N, NRHS, AF, LDAF, IPIV, X, LDX, INFO ) -* -* Use iterative refinement to improve the computed solution and -* compute error bounds and backward error estimates for it. -* - CALL SGERFS( TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, - $ LDX, FERR, BERR, WORK, IWORK, INFO ) -* -* Transform the solution matrix X to a solution of the original -* system. -* - IF( NOTRAN ) THEN - IF( COLEQU ) THEN - DO 80 J = 1, NRHS - DO 70 I = 1, N - X( I, J ) = C( I )*X( I, J ) - 70 CONTINUE - 80 CONTINUE - DO 90 J = 1, NRHS - FERR( J ) = FERR( J ) / COLCND - 90 CONTINUE - END IF - ELSE IF( ROWEQU ) THEN - DO 110 J = 1, NRHS - DO 100 I = 1, N - X( I, J ) = R( I )*X( I, J ) - 100 CONTINUE - 110 CONTINUE - DO 120 J = 1, NRHS - FERR( J ) = FERR( J ) / ROWCND - 120 CONTINUE - END IF -* -* Set INFO = N+1 if the matrix is singular to working precision. -* - IF( RCOND.LT.SLAMCH( 'Epsilon' ) ) - $ INFO = N + 1 -* - WORK( 1 ) = RPVGRW - RETURN -* -* End of SGESVX -* - END From 45164fe406b7746ebe3114a19e67a5f2f22b5e6b Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Thu, 4 Apr 2024 11:48:26 +0200 Subject: [PATCH 308/311] Delete misplaced file (move to SRC) --- lapack-netlib/zgbsvx.f | 644 ----------------------------------------- 1 file changed, 644 deletions(-) delete mode 100644 lapack-netlib/zgbsvx.f diff --git a/lapack-netlib/zgbsvx.f b/lapack-netlib/zgbsvx.f deleted file mode 100644 index 871564a81..000000000 --- a/lapack-netlib/zgbsvx.f +++ /dev/null @@ -1,644 +0,0 @@ -*> \brief ZGBSVX computes the solution to system of linear equations A * X = B for GB matrices -* -* =========== DOCUMENTATION =========== -* -* Online html documentation available at -* http://www.netlib.org/lapack/explore-html/ -* -*> \htmlonly -*> Download ZGBSVX + dependencies -*> -*> [TGZ] -*> -*> [ZIP] -*> -*> [TXT] -*> \endhtmlonly -* -* Definition: -* =========== -* -* SUBROUTINE ZGBSVX( FACT, TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, -* LDAFB, IPIV, EQUED, R, C, B, LDB, X, LDX, -* RCOND, FERR, BERR, WORK, RWORK, INFO ) -* -* .. Scalar Arguments .. -* CHARACTER EQUED, FACT, TRANS -* INTEGER INFO, KL, KU, LDAB, LDAFB, LDB, LDX, N, NRHS -* DOUBLE PRECISION RCOND -* .. -* .. Array Arguments .. -* INTEGER IPIV( * ) -* DOUBLE PRECISION BERR( * ), C( * ), FERR( * ), R( * ), -* $ RWORK( * ) -* COMPLEX*16 AB( LDAB, * ), AFB( LDAFB, * ), B( LDB, * ), -* $ WORK( * ), X( LDX, * ) -* .. -* -* -*> \par Purpose: -* ============= -*> -*> \verbatim -*> -*> ZGBSVX uses the LU factorization to compute the solution to a complex -*> system of linear equations A * X = B, A**T * X = B, or A**H * X = B, -*> where A is a band matrix of order N with KL subdiagonals and KU -*> superdiagonals, and X and B are N-by-NRHS matrices. -*> -*> Error bounds on the solution and a condition estimate are also -*> provided. -*> \endverbatim -* -*> \par Description: -* ================= -*> -*> \verbatim -*> -*> The following steps are performed by this subroutine: -*> -*> 1. If FACT = 'E', real scaling factors are computed to equilibrate -*> the system: -*> TRANS = 'N': diag(R)*A*diag(C) *inv(diag(C))*X = diag(R)*B -*> TRANS = 'T': (diag(R)*A*diag(C))**T *inv(diag(R))*X = diag(C)*B -*> TRANS = 'C': (diag(R)*A*diag(C))**H *inv(diag(R))*X = diag(C)*B -*> Whether or not the system will be equilibrated depends on the -*> scaling of the matrix A, but if equilibration is used, A is -*> overwritten by diag(R)*A*diag(C) and B by diag(R)*B (if TRANS='N') -*> or diag(C)*B (if TRANS = 'T' or 'C'). -*> -*> 2. If FACT = 'N' or 'E', the LU decomposition is used to factor the -*> matrix A (after equilibration if FACT = 'E') as -*> A = L * U, -*> where L is a product of permutation and unit lower triangular -*> matrices with KL subdiagonals, and U is upper triangular with -*> KL+KU superdiagonals. -*> -*> 3. If some U(i,i)=0, so that U is exactly singular, then the routine -*> returns with INFO = i. Otherwise, the factored form of A is used -*> to estimate the condition number of the matrix A. If the -*> reciprocal of the condition number is less than machine precision, -*> INFO = N+1 is returned as a warning, but the routine still goes on -*> to solve for X and compute error bounds as described below. -*> -*> 4. The system of equations is solved for X using the factored form -*> of A. -*> -*> 5. Iterative refinement is applied to improve the computed solution -*> matrix and calculate error bounds and backward error estimates -*> for it. -*> -*> 6. If equilibration was used, the matrix X is premultiplied by -*> diag(C) (if TRANS = 'N') or diag(R) (if TRANS = 'T' or 'C') so -*> that it solves the original system before equilibration. -*> \endverbatim -* -* Arguments: -* ========== -* -*> \param[in] FACT -*> \verbatim -*> FACT is CHARACTER*1 -*> Specifies whether or not the factored form of the matrix A is -*> supplied on entry, and if not, whether the matrix A should be -*> equilibrated before it is factored. -*> = 'F': On entry, AFB and IPIV contain the factored form of -*> A. If EQUED is not 'N', the matrix A has been -*> equilibrated with scaling factors given by R and C. -*> AB, AFB, and IPIV are not modified. -*> = 'N': The matrix A will be copied to AFB and factored. -*> = 'E': The matrix A will be equilibrated if necessary, then -*> copied to AFB and factored. -*> \endverbatim -*> -*> \param[in] TRANS -*> \verbatim -*> TRANS is CHARACTER*1 -*> Specifies the form of the system of equations. -*> = 'N': A * X = B (No transpose) -*> = 'T': A**T * X = B (Transpose) -*> = 'C': A**H * X = B (Conjugate transpose) -*> \endverbatim -*> -*> \param[in] N -*> \verbatim -*> N is INTEGER -*> The number of linear equations, i.e., the order of the -*> matrix A. N >= 0. -*> \endverbatim -*> -*> \param[in] KL -*> \verbatim -*> KL is INTEGER -*> The number of subdiagonals within the band of A. KL >= 0. -*> \endverbatim -*> -*> \param[in] KU -*> \verbatim -*> KU is INTEGER -*> The number of superdiagonals within the band of A. KU >= 0. -*> \endverbatim -*> -*> \param[in] NRHS -*> \verbatim -*> NRHS is INTEGER -*> The number of right hand sides, i.e., the number of columns -*> of the matrices B and X. NRHS >= 0. -*> \endverbatim -*> -*> \param[in,out] AB -*> \verbatim -*> AB is COMPLEX*16 array, dimension (LDAB,N) -*> On entry, the matrix A in band storage, in rows 1 to KL+KU+1. -*> The j-th column of A is stored in the j-th column of the -*> array AB as follows: -*> AB(KU+1+i-j,j) = A(i,j) for max(1,j-KU)<=i<=min(N,j+kl) -*> -*> If FACT = 'F' and EQUED is not 'N', then A must have been -*> equilibrated by the scaling factors in R and/or C. AB is not -*> modified if FACT = 'F' or 'N', or if FACT = 'E' and -*> EQUED = 'N' on exit. -*> -*> On exit, if EQUED .ne. 'N', A is scaled as follows: -*> EQUED = 'R': A := diag(R) * A -*> EQUED = 'C': A := A * diag(C) -*> EQUED = 'B': A := diag(R) * A * diag(C). -*> \endverbatim -*> -*> \param[in] LDAB -*> \verbatim -*> LDAB is INTEGER -*> The leading dimension of the array AB. LDAB >= KL+KU+1. -*> \endverbatim -*> -*> \param[in,out] AFB -*> \verbatim -*> AFB is COMPLEX*16 array, dimension (LDAFB,N) -*> If FACT = 'F', then AFB is an input argument and on entry -*> contains details of the LU factorization of the band matrix -*> A, as computed by ZGBTRF. U is stored as an upper triangular -*> band matrix with KL+KU superdiagonals in rows 1 to KL+KU+1, -*> and the multipliers used during the factorization are stored -*> in rows KL+KU+2 to 2*KL+KU+1. If EQUED .ne. 'N', then AFB is -*> the factored form of the equilibrated matrix A. -*> -*> If FACT = 'N', then AFB is an output argument and on exit -*> returns details of the LU factorization of A. -*> -*> If FACT = 'E', then AFB is an output argument and on exit -*> returns details of the LU factorization of the equilibrated -*> matrix A (see the description of AB for the form of the -*> equilibrated matrix). -*> \endverbatim -*> -*> \param[in] LDAFB -*> \verbatim -*> LDAFB is INTEGER -*> The leading dimension of the array AFB. LDAFB >= 2*KL+KU+1. -*> \endverbatim -*> -*> \param[in,out] IPIV -*> \verbatim -*> IPIV is INTEGER array, dimension (N) -*> If FACT = 'F', then IPIV is an input argument and on entry -*> contains the pivot indices from the factorization A = L*U -*> as computed by ZGBTRF; row i of the matrix was interchanged -*> with row IPIV(i). -*> -*> If FACT = 'N', then IPIV is an output argument and on exit -*> contains the pivot indices from the factorization A = L*U -*> of the original matrix A. -*> -*> If FACT = 'E', then IPIV is an output argument and on exit -*> contains the pivot indices from the factorization A = L*U -*> of the equilibrated matrix A. -*> \endverbatim -*> -*> \param[in,out] EQUED -*> \verbatim -*> EQUED is CHARACTER*1 -*> Specifies the form of equilibration that was done. -*> = 'N': No equilibration (always true if FACT = 'N'). -*> = 'R': Row equilibration, i.e., A has been premultiplied by -*> diag(R). -*> = 'C': Column equilibration, i.e., A has been postmultiplied -*> by diag(C). -*> = 'B': Both row and column equilibration, i.e., A has been -*> replaced by diag(R) * A * diag(C). -*> EQUED is an input argument if FACT = 'F'; otherwise, it is an -*> output argument. -*> \endverbatim -*> -*> \param[in,out] R -*> \verbatim -*> R is DOUBLE PRECISION array, dimension (N) -*> The row scale factors for A. If EQUED = 'R' or 'B', A is -*> multiplied on the left by diag(R); if EQUED = 'N' or 'C', R -*> is not accessed. R is an input argument if FACT = 'F'; -*> otherwise, R is an output argument. If FACT = 'F' and -*> EQUED = 'R' or 'B', each element of R must be positive. -*> \endverbatim -*> -*> \param[in,out] C -*> \verbatim -*> C is DOUBLE PRECISION array, dimension (N) -*> The column scale factors for A. If EQUED = 'C' or 'B', A is -*> multiplied on the right by diag(C); if EQUED = 'N' or 'R', C -*> is not accessed. C is an input argument if FACT = 'F'; -*> otherwise, C is an output argument. If FACT = 'F' and -*> EQUED = 'C' or 'B', each element of C must be positive. -*> \endverbatim -*> -*> \param[in,out] B -*> \verbatim -*> B is COMPLEX*16 array, dimension (LDB,NRHS) -*> On entry, the right hand side matrix B. -*> On exit, -*> if EQUED = 'N', B is not modified; -*> if TRANS = 'N' and EQUED = 'R' or 'B', B is overwritten by -*> diag(R)*B; -*> if TRANS = 'T' or 'C' and EQUED = 'C' or 'B', B is -*> overwritten by diag(C)*B. -*> \endverbatim -*> -*> \param[in] LDB -*> \verbatim -*> LDB is INTEGER -*> The leading dimension of the array B. LDB >= max(1,N). -*> \endverbatim -*> -*> \param[out] X -*> \verbatim -*> X is COMPLEX*16 array, dimension (LDX,NRHS) -*> If INFO = 0 or INFO = N+1, the N-by-NRHS solution matrix X -*> to the original system of equations. Note that A and B are -*> modified on exit if EQUED .ne. 'N', and the solution to the -*> equilibrated system is inv(diag(C))*X if TRANS = 'N' and -*> EQUED = 'C' or 'B', or inv(diag(R))*X if TRANS = 'T' or 'C' -*> and EQUED = 'R' or 'B'. -*> \endverbatim -*> -*> \param[in] LDX -*> \verbatim -*> LDX is INTEGER -*> The leading dimension of the array X. LDX >= max(1,N). -*> \endverbatim -*> -*> \param[out] RCOND -*> \verbatim -*> RCOND is DOUBLE PRECISION -*> The estimate of the reciprocal condition number of the matrix -*> A after equilibration (if done). If RCOND is less than the -*> machine precision (in particular, if RCOND = 0), the matrix -*> is singular to working precision. This condition is -*> indicated by a return code of INFO > 0. -*> \endverbatim -*> -*> \param[out] FERR -*> \verbatim -*> FERR is DOUBLE PRECISION array, dimension (NRHS) -*> The estimated forward error bound for each solution vector -*> X(j) (the j-th column of the solution matrix X). -*> If XTRUE is the true solution corresponding to X(j), FERR(j) -*> is an estimated upper bound for the magnitude of the largest -*> element in (X(j) - XTRUE) divided by the magnitude of the -*> largest element in X(j). The estimate is as reliable as -*> the estimate for RCOND, and is almost always a slight -*> overestimate of the true error. -*> \endverbatim -*> -*> \param[out] BERR -*> \verbatim -*> BERR is DOUBLE PRECISION array, dimension (NRHS) -*> The componentwise relative backward error of each solution -*> vector X(j) (i.e., the smallest relative change in -*> any element of A or B that makes X(j) an exact solution). -*> \endverbatim -*> -*> \param[out] WORK -*> \verbatim -*> WORK is COMPLEX*16 array, dimension (2*N) -*> \endverbatim -*> -*> \param[out] RWORK -*> \verbatim -*> RWORK is DOUBLE PRECISION array, dimension (MAX(1,N)) -*> On exit, RWORK(1) contains the reciprocal pivot growth -*> factor norm(A)/norm(U). The "max absolute element" norm is -*> used. If RWORK(1) is much less than 1, then the stability -*> of the LU factorization of the (equilibrated) matrix A -*> could be poor. This also means that the solution X, condition -*> estimator RCOND, and forward error bound FERR could be -*> unreliable. If factorization fails with 0 RWORK(1) contains the reciprocal pivot growth factor for the -*> leading INFO columns of A. -*> \endverbatim -*> -*> \param[out] INFO -*> \verbatim -*> INFO is INTEGER -*> = 0: successful exit -*> < 0: if INFO = -i, the i-th argument had an illegal value -*> > 0: if INFO = i, and i is -*> <= N: U(i,i) is exactly zero. The factorization -*> has been completed, but the factor U is exactly -*> singular, so the solution and error bounds -*> could not be computed. RCOND = 0 is returned. -*> = N+1: U is nonsingular, but RCOND is less than machine -*> precision, meaning that the matrix is singular -*> to working precision. Nevertheless, the -*> solution and error bounds are computed because -*> there are a number of situations where the -*> computed solution can be more accurate than the -*> value of RCOND would suggest. -*> \endverbatim -* -* Authors: -* ======== -* -*> \author Univ. of Tennessee -*> \author Univ. of California Berkeley -*> \author Univ. of Colorado Denver -*> \author NAG Ltd. -* -*> \ingroup complex16GBsolve -* -* ===================================================================== - SUBROUTINE ZGBSVX( FACT, TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, - $ LDAFB, IPIV, EQUED, R, C, B, LDB, X, LDX, - $ RCOND, FERR, BERR, WORK, RWORK, INFO ) -* -* -- LAPACK driver routine -- -* -- LAPACK is a software package provided by Univ. of Tennessee, -- -* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* -* .. Scalar Arguments .. - CHARACTER EQUED, FACT, TRANS - INTEGER INFO, KL, KU, LDAB, LDAFB, LDB, LDX, N, NRHS - DOUBLE PRECISION RCOND -* .. -* .. Array Arguments .. - INTEGER IPIV( * ) - DOUBLE PRECISION BERR( * ), C( * ), FERR( * ), R( * ), - $ RWORK( * ) - COMPLEX*16 AB( LDAB, * ), AFB( LDAFB, * ), B( LDB, * ), - $ WORK( * ), X( LDX, * ) -* .. -* -* ===================================================================== -* Moved setting of INFO = N+1 so INFO does not subsequently get -* overwritten. Sven, 17 Mar 05. -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ZERO, ONE - PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 ) -* .. -* .. Local Scalars .. - LOGICAL COLEQU, EQUIL, NOFACT, NOTRAN, ROWEQU - CHARACTER NORM - INTEGER I, INFEQU, J, J1, J2 - DOUBLE PRECISION AMAX, ANORM, BIGNUM, COLCND, RCMAX, RCMIN, - $ ROWCND, RPVGRW, SMLNUM -* .. -* .. External Functions .. - LOGICAL LSAME - DOUBLE PRECISION DLAMCH, ZLANGB, ZLANTB - EXTERNAL LSAME, DLAMCH, ZLANGB, ZLANTB -* .. -* .. External Subroutines .. - EXTERNAL XERBLA, ZCOPY, ZGBCON, ZGBEQU, ZGBRFS, ZGBTRF, - $ ZGBTRS, ZLACPY, ZLAQGB -* .. -* .. Intrinsic Functions .. - INTRINSIC ABS, MAX, MIN -* .. -* .. Executable Statements .. -* - INFO = 0 - NOFACT = LSAME( FACT, 'N' ) - EQUIL = LSAME( FACT, 'E' ) - NOTRAN = LSAME( TRANS, 'N' ) - IF( NOFACT .OR. EQUIL ) THEN - EQUED = 'N' - ROWEQU = .FALSE. - COLEQU = .FALSE. - ELSE - ROWEQU = LSAME( EQUED, 'R' ) .OR. LSAME( EQUED, 'B' ) - COLEQU = LSAME( EQUED, 'C' ) .OR. LSAME( EQUED, 'B' ) - SMLNUM = DLAMCH( 'Safe minimum' ) - BIGNUM = ONE / SMLNUM - END IF -* -* Test the input parameters. -* - IF( .NOT.NOFACT .AND. .NOT.EQUIL .AND. .NOT.LSAME( FACT, 'F' ) ) - $ THEN - INFO = -1 - ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT. - $ LSAME( TRANS, 'C' ) ) THEN - INFO = -2 - ELSE IF( N.LT.0 ) THEN - INFO = -3 - ELSE IF( KL.LT.0 ) THEN - INFO = -4 - ELSE IF( KU.LT.0 ) THEN - INFO = -5 - ELSE IF( NRHS.LT.0 ) THEN - INFO = -6 - ELSE IF( LDAB.LT.KL+KU+1 ) THEN - INFO = -8 - ELSE IF( LDAFB.LT.2*KL+KU+1 ) THEN - INFO = -10 - ELSE IF( LSAME( FACT, 'F' ) .AND. .NOT. - $ ( ROWEQU .OR. COLEQU .OR. LSAME( EQUED, 'N' ) ) ) THEN - INFO = -12 - ELSE - IF( ROWEQU ) THEN - RCMIN = BIGNUM - RCMAX = ZERO - DO 10 J = 1, N - RCMIN = MIN( RCMIN, R( J ) ) - RCMAX = MAX( RCMAX, R( J ) ) - 10 CONTINUE - IF( RCMIN.LE.ZERO ) THEN - INFO = -13 - ELSE IF( N.GT.0 ) THEN - ROWCND = MAX( RCMIN, SMLNUM ) / MIN( RCMAX, BIGNUM ) - ELSE - ROWCND = ONE - END IF - END IF - IF( COLEQU .AND. INFO.EQ.0 ) THEN - RCMIN = BIGNUM - RCMAX = ZERO - DO 20 J = 1, N - RCMIN = MIN( RCMIN, C( J ) ) - RCMAX = MAX( RCMAX, C( J ) ) - 20 CONTINUE - IF( RCMIN.LE.ZERO ) THEN - INFO = -14 - ELSE IF( N.GT.0 ) THEN - COLCND = MAX( RCMIN, SMLNUM ) / MIN( RCMAX, BIGNUM ) - ELSE - COLCND = ONE - END IF - END IF - IF( INFO.EQ.0 ) THEN - IF( LDB.LT.MAX( 1, N ) ) THEN - INFO = -16 - ELSE IF( LDX.LT.MAX( 1, N ) ) THEN - INFO = -18 - END IF - END IF - END IF -* - IF( INFO.NE.0 ) THEN - CALL XERBLA( 'ZGBSVX', -INFO ) - RETURN - END IF -* - IF( EQUIL ) THEN -* -* Compute row and column scalings to equilibrate the matrix A. -* - CALL ZGBEQU( N, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND, - $ AMAX, INFEQU ) - IF( INFEQU.EQ.0 ) THEN -* -* Equilibrate the matrix. -* - CALL ZLAQGB( N, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND, - $ AMAX, EQUED ) - ROWEQU = LSAME( EQUED, 'R' ) .OR. LSAME( EQUED, 'B' ) - COLEQU = LSAME( EQUED, 'C' ) .OR. LSAME( EQUED, 'B' ) - END IF - END IF -* -* Scale the right hand side. -* - IF( NOTRAN ) THEN - IF( ROWEQU ) THEN - DO 40 J = 1, NRHS - DO 30 I = 1, N - B( I, J ) = R( I )*B( I, J ) - 30 CONTINUE - 40 CONTINUE - END IF - ELSE IF( COLEQU ) THEN - DO 60 J = 1, NRHS - DO 50 I = 1, N - B( I, J ) = C( I )*B( I, J ) - 50 CONTINUE - 60 CONTINUE - END IF -* - IF( NOFACT .OR. EQUIL ) THEN -* -* Compute the LU factorization of the band matrix A. -* - DO 70 J = 1, N - J1 = MAX( J-KU, 1 ) - J2 = MIN( J+KL, N ) - CALL ZCOPY( J2-J1+1, AB( KU+1-J+J1, J ), 1, - $ AFB( KL+KU+1-J+J1, J ), 1 ) - 70 CONTINUE -* - CALL ZGBTRF( N, N, KL, KU, AFB, LDAFB, IPIV, INFO ) -* -* Return if INFO is non-zero. -* - IF( INFO.GT.0 ) THEN -* -* Compute the reciprocal pivot growth factor of the -* leading rank-deficient INFO columns of A. -* - ANORM = ZERO - DO 90 J = 1, INFO - DO 80 I = MAX( KU+2-J, 1 ), MIN( N+KU+1-J, KL+KU+1 ) - ANORM = MAX( ANORM, ABS( AB( I, J ) ) ) - 80 CONTINUE - 90 CONTINUE - RPVGRW = ZLANTB( 'M', 'U', 'N', INFO, MIN( INFO-1, KL+KU ), - $ AFB( MAX( 1, KL+KU+2-INFO ), 1 ), LDAFB, - $ RWORK ) - IF( RPVGRW.EQ.ZERO ) THEN - RPVGRW = ONE - ELSE - RPVGRW = ANORM / RPVGRW - END IF - RWORK( 1 ) = RPVGRW - RCOND = ZERO - RETURN - END IF - END IF -* -* Compute the norm of the matrix A and the -* reciprocal pivot growth factor RPVGRW. -* - IF( NOTRAN ) THEN - NORM = '1' - ELSE - NORM = 'I' - END IF - ANORM = ZLANGB( NORM, N, KL, KU, AB, LDAB, RWORK ) - RPVGRW = ZLANTB( 'M', 'U', 'N', N, KL+KU, AFB, LDAFB, RWORK ) - IF( RPVGRW.EQ.ZERO ) THEN - RPVGRW = ONE - ELSE - RPVGRW = ZLANGB( 'M', N, KL, KU, AB, LDAB, RWORK ) / RPVGRW - END IF -* -* Compute the reciprocal of the condition number of A. -* - CALL ZGBCON( NORM, N, KL, KU, AFB, LDAFB, IPIV, ANORM, RCOND, - $ WORK, RWORK, INFO ) -* -* Compute the solution matrix X. -* - CALL ZLACPY( 'Full', N, NRHS, B, LDB, X, LDX ) - CALL ZGBTRS( TRANS, N, KL, KU, NRHS, AFB, LDAFB, IPIV, X, LDX, - $ INFO ) -* -* Use iterative refinement to improve the computed solution and -* compute error bounds and backward error estimates for it. -* - CALL ZGBRFS( TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB, IPIV, - $ B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO ) -* -* Transform the solution matrix X to a solution of the original -* system. -* - IF( NOTRAN ) THEN - IF( COLEQU ) THEN - DO 110 J = 1, NRHS - DO 100 I = 1, N - X( I, J ) = C( I )*X( I, J ) - 100 CONTINUE - 110 CONTINUE - DO 120 J = 1, NRHS - FERR( J ) = FERR( J ) / COLCND - 120 CONTINUE - END IF - ELSE IF( ROWEQU ) THEN - DO 140 J = 1, NRHS - DO 130 I = 1, N - X( I, J ) = R( I )*X( I, J ) - 130 CONTINUE - 140 CONTINUE - DO 150 J = 1, NRHS - FERR( J ) = FERR( J ) / ROWCND - 150 CONTINUE - END IF -* -* Set INFO = N+1 if the matrix is singular to working precision. -* - IF( RCOND.LT.DLAMCH( 'Epsilon' ) ) - $ INFO = N + 1 -* - RWORK( 1 ) = RPVGRW - RETURN -* -* End of ZGBSVX -* - END From 20145ca8687cba800a8da8620468a75ae3d238ff Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Thu, 4 Apr 2024 11:48:54 +0200 Subject: [PATCH 309/311] Delete misplaced file (move to SRC) --- lapack-netlib/zgesvx.f | 602 ----------------------------------------- 1 file changed, 602 deletions(-) delete mode 100644 lapack-netlib/zgesvx.f diff --git a/lapack-netlib/zgesvx.f b/lapack-netlib/zgesvx.f deleted file mode 100644 index 3b193a1b2..000000000 --- a/lapack-netlib/zgesvx.f +++ /dev/null @@ -1,602 +0,0 @@ -*> \brief ZGESVX computes the solution to system of linear equations A * X = B for GE matrices -* -* =========== DOCUMENTATION =========== -* -* Online html documentation available at -* http://www.netlib.org/lapack/explore-html/ -* -*> \htmlonly -*> Download ZGESVX + dependencies -*> -*> [TGZ] -*> -*> [ZIP] -*> -*> [TXT] -*> \endhtmlonly -* -* Definition: -* =========== -* -* SUBROUTINE ZGESVX( FACT, TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, -* EQUED, R, C, B, LDB, X, LDX, RCOND, FERR, BERR, -* WORK, RWORK, INFO ) -* -* .. Scalar Arguments .. -* CHARACTER EQUED, FACT, TRANS -* INTEGER INFO, LDA, LDAF, LDB, LDX, N, NRHS -* DOUBLE PRECISION RCOND -* .. -* .. Array Arguments .. -* INTEGER IPIV( * ) -* DOUBLE PRECISION BERR( * ), C( * ), FERR( * ), R( * ), -* $ RWORK( * ) -* COMPLEX*16 A( LDA, * ), AF( LDAF, * ), B( LDB, * ), -* $ WORK( * ), X( LDX, * ) -* .. -* -* -*> \par Purpose: -* ============= -*> -*> \verbatim -*> -*> ZGESVX uses the LU factorization to compute the solution to a complex -*> system of linear equations -*> A * X = B, -*> where A is an N-by-N matrix and X and B are N-by-NRHS matrices. -*> -*> Error bounds on the solution and a condition estimate are also -*> provided. -*> \endverbatim -* -*> \par Description: -* ================= -*> -*> \verbatim -*> -*> The following steps are performed: -*> -*> 1. If FACT = 'E', real scaling factors are computed to equilibrate -*> the system: -*> TRANS = 'N': diag(R)*A*diag(C) *inv(diag(C))*X = diag(R)*B -*> TRANS = 'T': (diag(R)*A*diag(C))**T *inv(diag(R))*X = diag(C)*B -*> TRANS = 'C': (diag(R)*A*diag(C))**H *inv(diag(R))*X = diag(C)*B -*> Whether or not the system will be equilibrated depends on the -*> scaling of the matrix A, but if equilibration is used, A is -*> overwritten by diag(R)*A*diag(C) and B by diag(R)*B (if TRANS='N') -*> or diag(C)*B (if TRANS = 'T' or 'C'). -*> -*> 2. If FACT = 'N' or 'E', the LU decomposition is used to factor the -*> matrix A (after equilibration if FACT = 'E') as -*> A = P * L * U, -*> where P is a permutation matrix, L is a unit lower triangular -*> matrix, and U is upper triangular. -*> -*> 3. If some U(i,i)=0, so that U is exactly singular, then the routine -*> returns with INFO = i. Otherwise, the factored form of A is used -*> to estimate the condition number of the matrix A. If the -*> reciprocal of the condition number is less than machine precision, -*> INFO = N+1 is returned as a warning, but the routine still goes on -*> to solve for X and compute error bounds as described below. -*> -*> 4. The system of equations is solved for X using the factored form -*> of A. -*> -*> 5. Iterative refinement is applied to improve the computed solution -*> matrix and calculate error bounds and backward error estimates -*> for it. -*> -*> 6. If equilibration was used, the matrix X is premultiplied by -*> diag(C) (if TRANS = 'N') or diag(R) (if TRANS = 'T' or 'C') so -*> that it solves the original system before equilibration. -*> \endverbatim -* -* Arguments: -* ========== -* -*> \param[in] FACT -*> \verbatim -*> FACT is CHARACTER*1 -*> Specifies whether or not the factored form of the matrix A is -*> supplied on entry, and if not, whether the matrix A should be -*> equilibrated before it is factored. -*> = 'F': On entry, AF and IPIV contain the factored form of A. -*> If EQUED is not 'N', the matrix A has been -*> equilibrated with scaling factors given by R and C. -*> A, AF, and IPIV are not modified. -*> = 'N': The matrix A will be copied to AF and factored. -*> = 'E': The matrix A will be equilibrated if necessary, then -*> copied to AF and factored. -*> \endverbatim -*> -*> \param[in] TRANS -*> \verbatim -*> TRANS is CHARACTER*1 -*> Specifies the form of the system of equations: -*> = 'N': A * X = B (No transpose) -*> = 'T': A**T * X = B (Transpose) -*> = 'C': A**H * X = B (Conjugate transpose) -*> \endverbatim -*> -*> \param[in] N -*> \verbatim -*> N is INTEGER -*> The number of linear equations, i.e., the order of the -*> matrix A. N >= 0. -*> \endverbatim -*> -*> \param[in] NRHS -*> \verbatim -*> NRHS is INTEGER -*> The number of right hand sides, i.e., the number of columns -*> of the matrices B and X. NRHS >= 0. -*> \endverbatim -*> -*> \param[in,out] A -*> \verbatim -*> A is COMPLEX*16 array, dimension (LDA,N) -*> On entry, the N-by-N matrix A. If FACT = 'F' and EQUED is -*> not 'N', then A must have been equilibrated by the scaling -*> factors in R and/or C. A is not modified if FACT = 'F' or -*> 'N', or if FACT = 'E' and EQUED = 'N' on exit. -*> -*> On exit, if EQUED .ne. 'N', A is scaled as follows: -*> EQUED = 'R': A := diag(R) * A -*> EQUED = 'C': A := A * diag(C) -*> EQUED = 'B': A := diag(R) * A * diag(C). -*> \endverbatim -*> -*> \param[in] LDA -*> \verbatim -*> LDA is INTEGER -*> The leading dimension of the array A. LDA >= max(1,N). -*> \endverbatim -*> -*> \param[in,out] AF -*> \verbatim -*> AF is COMPLEX*16 array, dimension (LDAF,N) -*> If FACT = 'F', then AF is an input argument and on entry -*> contains the factors L and U from the factorization -*> A = P*L*U as computed by ZGETRF. If EQUED .ne. 'N', then -*> AF is the factored form of the equilibrated matrix A. -*> -*> If FACT = 'N', then AF is an output argument and on exit -*> returns the factors L and U from the factorization A = P*L*U -*> of the original matrix A. -*> -*> If FACT = 'E', then AF is an output argument and on exit -*> returns the factors L and U from the factorization A = P*L*U -*> of the equilibrated matrix A (see the description of A for -*> the form of the equilibrated matrix). -*> \endverbatim -*> -*> \param[in] LDAF -*> \verbatim -*> LDAF is INTEGER -*> The leading dimension of the array AF. LDAF >= max(1,N). -*> \endverbatim -*> -*> \param[in,out] IPIV -*> \verbatim -*> IPIV is INTEGER array, dimension (N) -*> If FACT = 'F', then IPIV is an input argument and on entry -*> contains the pivot indices from the factorization A = P*L*U -*> as computed by ZGETRF; row i of the matrix was interchanged -*> with row IPIV(i). -*> -*> If FACT = 'N', then IPIV is an output argument and on exit -*> contains the pivot indices from the factorization A = P*L*U -*> of the original matrix A. -*> -*> If FACT = 'E', then IPIV is an output argument and on exit -*> contains the pivot indices from the factorization A = P*L*U -*> of the equilibrated matrix A. -*> \endverbatim -*> -*> \param[in,out] EQUED -*> \verbatim -*> EQUED is CHARACTER*1 -*> Specifies the form of equilibration that was done. -*> = 'N': No equilibration (always true if FACT = 'N'). -*> = 'R': Row equilibration, i.e., A has been premultiplied by -*> diag(R). -*> = 'C': Column equilibration, i.e., A has been postmultiplied -*> by diag(C). -*> = 'B': Both row and column equilibration, i.e., A has been -*> replaced by diag(R) * A * diag(C). -*> EQUED is an input argument if FACT = 'F'; otherwise, it is an -*> output argument. -*> \endverbatim -*> -*> \param[in,out] R -*> \verbatim -*> R is DOUBLE PRECISION array, dimension (N) -*> The row scale factors for A. If EQUED = 'R' or 'B', A is -*> multiplied on the left by diag(R); if EQUED = 'N' or 'C', R -*> is not accessed. R is an input argument if FACT = 'F'; -*> otherwise, R is an output argument. If FACT = 'F' and -*> EQUED = 'R' or 'B', each element of R must be positive. -*> \endverbatim -*> -*> \param[in,out] C -*> \verbatim -*> C is DOUBLE PRECISION array, dimension (N) -*> The column scale factors for A. If EQUED = 'C' or 'B', A is -*> multiplied on the right by diag(C); if EQUED = 'N' or 'R', C -*> is not accessed. C is an input argument if FACT = 'F'; -*> otherwise, C is an output argument. If FACT = 'F' and -*> EQUED = 'C' or 'B', each element of C must be positive. -*> \endverbatim -*> -*> \param[in,out] B -*> \verbatim -*> B is COMPLEX*16 array, dimension (LDB,NRHS) -*> On entry, the N-by-NRHS right hand side matrix B. -*> On exit, -*> if EQUED = 'N', B is not modified; -*> if TRANS = 'N' and EQUED = 'R' or 'B', B is overwritten by -*> diag(R)*B; -*> if TRANS = 'T' or 'C' and EQUED = 'C' or 'B', B is -*> overwritten by diag(C)*B. -*> \endverbatim -*> -*> \param[in] LDB -*> \verbatim -*> LDB is INTEGER -*> The leading dimension of the array B. LDB >= max(1,N). -*> \endverbatim -*> -*> \param[out] X -*> \verbatim -*> X is COMPLEX*16 array, dimension (LDX,NRHS) -*> If INFO = 0 or INFO = N+1, the N-by-NRHS solution matrix X -*> to the original system of equations. Note that A and B are -*> modified on exit if EQUED .ne. 'N', and the solution to the -*> equilibrated system is inv(diag(C))*X if TRANS = 'N' and -*> EQUED = 'C' or 'B', or inv(diag(R))*X if TRANS = 'T' or 'C' -*> and EQUED = 'R' or 'B'. -*> \endverbatim -*> -*> \param[in] LDX -*> \verbatim -*> LDX is INTEGER -*> The leading dimension of the array X. LDX >= max(1,N). -*> \endverbatim -*> -*> \param[out] RCOND -*> \verbatim -*> RCOND is DOUBLE PRECISION -*> The estimate of the reciprocal condition number of the matrix -*> A after equilibration (if done). If RCOND is less than the -*> machine precision (in particular, if RCOND = 0), the matrix -*> is singular to working precision. This condition is -*> indicated by a return code of INFO > 0. -*> \endverbatim -*> -*> \param[out] FERR -*> \verbatim -*> FERR is DOUBLE PRECISION array, dimension (NRHS) -*> The estimated forward error bound for each solution vector -*> X(j) (the j-th column of the solution matrix X). -*> If XTRUE is the true solution corresponding to X(j), FERR(j) -*> is an estimated upper bound for the magnitude of the largest -*> element in (X(j) - XTRUE) divided by the magnitude of the -*> largest element in X(j). The estimate is as reliable as -*> the estimate for RCOND, and is almost always a slight -*> overestimate of the true error. -*> \endverbatim -*> -*> \param[out] BERR -*> \verbatim -*> BERR is DOUBLE PRECISION array, dimension (NRHS) -*> The componentwise relative backward error of each solution -*> vector X(j) (i.e., the smallest relative change in -*> any element of A or B that makes X(j) an exact solution). -*> \endverbatim -*> -*> \param[out] WORK -*> \verbatim -*> WORK is COMPLEX*16 array, dimension (2*N) -*> \endverbatim -*> -*> \param[out] RWORK -*> \verbatim -*> RWORK is DOUBLE PRECISION array, dimension (MAX(1,2*N)) -*> On exit, RWORK(1) contains the reciprocal pivot growth -*> factor norm(A)/norm(U). The "max absolute element" norm is -*> used. If RWORK(1) is much less than 1, then the stability -*> of the LU factorization of the (equilibrated) matrix A -*> could be poor. This also means that the solution X, condition -*> estimator RCOND, and forward error bound FERR could be -*> unreliable. If factorization fails with 0 RWORK(1) contains the reciprocal pivot growth factor for the -*> leading INFO columns of A. -*> \endverbatim -*> -*> \param[out] INFO -*> \verbatim -*> INFO is INTEGER -*> = 0: successful exit -*> < 0: if INFO = -i, the i-th argument had an illegal value -*> > 0: if INFO = i, and i is -*> <= N: U(i,i) is exactly zero. The factorization has -*> been completed, but the factor U is exactly -*> singular, so the solution and error bounds -*> could not be computed. RCOND = 0 is returned. -*> = N+1: U is nonsingular, but RCOND is less than machine -*> precision, meaning that the matrix is singular -*> to working precision. Nevertheless, the -*> solution and error bounds are computed because -*> there are a number of situations where the -*> computed solution can be more accurate than the -*> value of RCOND would suggest. -*> \endverbatim -* -* Authors: -* ======== -* -*> \author Univ. of Tennessee -*> \author Univ. of California Berkeley -*> \author Univ. of Colorado Denver -*> \author NAG Ltd. -* -*> \ingroup complex16GEsolve -* -* ===================================================================== - SUBROUTINE ZGESVX( FACT, TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, - $ EQUED, R, C, B, LDB, X, LDX, RCOND, FERR, BERR, - $ WORK, RWORK, INFO ) -* -* -- LAPACK driver routine -- -* -- LAPACK is a software package provided by Univ. of Tennessee, -- -* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* -* .. Scalar Arguments .. - CHARACTER EQUED, FACT, TRANS - INTEGER INFO, LDA, LDAF, LDB, LDX, N, NRHS - DOUBLE PRECISION RCOND -* .. -* .. Array Arguments .. - INTEGER IPIV( * ) - DOUBLE PRECISION BERR( * ), C( * ), FERR( * ), R( * ), - $ RWORK( * ) - COMPLEX*16 A( LDA, * ), AF( LDAF, * ), B( LDB, * ), - $ WORK( * ), X( LDX, * ) -* .. -* -* ===================================================================== -* -* .. Parameters .. - DOUBLE PRECISION ZERO, ONE - PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 ) -* .. -* .. Local Scalars .. - LOGICAL COLEQU, EQUIL, NOFACT, NOTRAN, ROWEQU - CHARACTER NORM - INTEGER I, INFEQU, J - DOUBLE PRECISION AMAX, ANORM, BIGNUM, COLCND, RCMAX, RCMIN, - $ ROWCND, RPVGRW, SMLNUM -* .. -* .. External Functions .. - LOGICAL LSAME - DOUBLE PRECISION DLAMCH, ZLANGE, ZLANTR - EXTERNAL LSAME, DLAMCH, ZLANGE, ZLANTR -* .. -* .. External Subroutines .. - EXTERNAL XERBLA, ZGECON, ZGEEQU, ZGERFS, ZGETRF, ZGETRS, - $ ZLACPY, ZLAQGE -* .. -* .. Intrinsic Functions .. - INTRINSIC MAX, MIN -* .. -* .. Executable Statements .. -* - INFO = 0 - NOFACT = LSAME( FACT, 'N' ) - EQUIL = LSAME( FACT, 'E' ) - NOTRAN = LSAME( TRANS, 'N' ) - IF( NOFACT .OR. EQUIL ) THEN - EQUED = 'N' - ROWEQU = .FALSE. - COLEQU = .FALSE. - ELSE - ROWEQU = LSAME( EQUED, 'R' ) .OR. LSAME( EQUED, 'B' ) - COLEQU = LSAME( EQUED, 'C' ) .OR. LSAME( EQUED, 'B' ) - SMLNUM = DLAMCH( 'Safe minimum' ) - BIGNUM = ONE / SMLNUM - END IF -* -* Test the input parameters. -* - IF( .NOT.NOFACT .AND. .NOT.EQUIL .AND. .NOT.LSAME( FACT, 'F' ) ) - $ THEN - INFO = -1 - ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT. - $ LSAME( TRANS, 'C' ) ) THEN - INFO = -2 - ELSE IF( N.LT.0 ) THEN - INFO = -3 - ELSE IF( NRHS.LT.0 ) THEN - INFO = -4 - ELSE IF( LDA.LT.MAX( 1, N ) ) THEN - INFO = -6 - ELSE IF( LDAF.LT.MAX( 1, N ) ) THEN - INFO = -8 - ELSE IF( LSAME( FACT, 'F' ) .AND. .NOT. - $ ( ROWEQU .OR. COLEQU .OR. LSAME( EQUED, 'N' ) ) ) THEN - INFO = -10 - ELSE - IF( ROWEQU ) THEN - RCMIN = BIGNUM - RCMAX = ZERO - DO 10 J = 1, N - RCMIN = MIN( RCMIN, R( J ) ) - RCMAX = MAX( RCMAX, R( J ) ) - 10 CONTINUE - IF( RCMIN.LE.ZERO ) THEN - INFO = -11 - ELSE IF( N.GT.0 ) THEN - ROWCND = MAX( RCMIN, SMLNUM ) / MIN( RCMAX, BIGNUM ) - ELSE - ROWCND = ONE - END IF - END IF - IF( COLEQU .AND. INFO.EQ.0 ) THEN - RCMIN = BIGNUM - RCMAX = ZERO - DO 20 J = 1, N - RCMIN = MIN( RCMIN, C( J ) ) - RCMAX = MAX( RCMAX, C( J ) ) - 20 CONTINUE - IF( RCMIN.LE.ZERO ) THEN - INFO = -12 - ELSE IF( N.GT.0 ) THEN - COLCND = MAX( RCMIN, SMLNUM ) / MIN( RCMAX, BIGNUM ) - ELSE - COLCND = ONE - END IF - END IF - IF( INFO.EQ.0 ) THEN - IF( LDB.LT.MAX( 1, N ) ) THEN - INFO = -14 - ELSE IF( LDX.LT.MAX( 1, N ) ) THEN - INFO = -16 - END IF - END IF - END IF -* - IF( INFO.NE.0 ) THEN - CALL XERBLA( 'ZGESVX', -INFO ) - RETURN - END IF -* - IF( EQUIL ) THEN -* -* Compute row and column scalings to equilibrate the matrix A. -* - CALL ZGEEQU( N, N, A, LDA, R, C, ROWCND, COLCND, AMAX, INFEQU ) - IF( INFEQU.EQ.0 ) THEN -* -* Equilibrate the matrix. -* - CALL ZLAQGE( N, N, A, LDA, R, C, ROWCND, COLCND, AMAX, - $ EQUED ) - ROWEQU = LSAME( EQUED, 'R' ) .OR. LSAME( EQUED, 'B' ) - COLEQU = LSAME( EQUED, 'C' ) .OR. LSAME( EQUED, 'B' ) - END IF - END IF -* -* Scale the right hand side. -* - IF( NOTRAN ) THEN - IF( ROWEQU ) THEN - DO 40 J = 1, NRHS - DO 30 I = 1, N - B( I, J ) = R( I )*B( I, J ) - 30 CONTINUE - 40 CONTINUE - END IF - ELSE IF( COLEQU ) THEN - DO 60 J = 1, NRHS - DO 50 I = 1, N - B( I, J ) = C( I )*B( I, J ) - 50 CONTINUE - 60 CONTINUE - END IF -* - IF( NOFACT .OR. EQUIL ) THEN -* -* Compute the LU factorization of A. -* - CALL ZLACPY( 'Full', N, N, A, LDA, AF, LDAF ) - CALL ZGETRF( N, N, AF, LDAF, IPIV, INFO ) -* -* Return if INFO is non-zero. -* - IF( INFO.GT.0 ) THEN -* -* Compute the reciprocal pivot growth factor of the -* leading rank-deficient INFO columns of A. -* - RPVGRW = ZLANTR( 'M', 'U', 'N', INFO, INFO, AF, LDAF, - $ RWORK ) - IF( RPVGRW.EQ.ZERO ) THEN - RPVGRW = ONE - ELSE - RPVGRW = ZLANGE( 'M', N, INFO, A, LDA, RWORK ) / - $ RPVGRW - END IF - RWORK( 1 ) = RPVGRW - RCOND = ZERO - RETURN - END IF - END IF -* -* Compute the norm of the matrix A and the -* reciprocal pivot growth factor RPVGRW. -* - IF( NOTRAN ) THEN - NORM = '1' - ELSE - NORM = 'I' - END IF - ANORM = ZLANGE( NORM, N, N, A, LDA, RWORK ) - RPVGRW = ZLANTR( 'M', 'U', 'N', N, N, AF, LDAF, RWORK ) - IF( RPVGRW.EQ.ZERO ) THEN - RPVGRW = ONE - ELSE - RPVGRW = ZLANGE( 'M', N, N, A, LDA, RWORK ) / RPVGRW - END IF -* -* Compute the reciprocal of the condition number of A. -* - CALL ZGECON( NORM, N, AF, LDAF, ANORM, RCOND, WORK, RWORK, INFO ) -* -* Compute the solution matrix X. -* - CALL ZLACPY( 'Full', N, NRHS, B, LDB, X, LDX ) - CALL ZGETRS( TRANS, N, NRHS, AF, LDAF, IPIV, X, LDX, INFO ) -* -* Use iterative refinement to improve the computed solution and -* compute error bounds and backward error estimates for it. -* - CALL ZGERFS( TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, - $ LDX, FERR, BERR, WORK, RWORK, INFO ) -* -* Transform the solution matrix X to a solution of the original -* system. -* - IF( NOTRAN ) THEN - IF( COLEQU ) THEN - DO 80 J = 1, NRHS - DO 70 I = 1, N - X( I, J ) = C( I )*X( I, J ) - 70 CONTINUE - 80 CONTINUE - DO 90 J = 1, NRHS - FERR( J ) = FERR( J ) / COLCND - 90 CONTINUE - END IF - ELSE IF( ROWEQU ) THEN - DO 110 J = 1, NRHS - DO 100 I = 1, N - X( I, J ) = R( I )*X( I, J ) - 100 CONTINUE - 110 CONTINUE - DO 120 J = 1, NRHS - FERR( J ) = FERR( J ) / ROWCND - 120 CONTINUE - END IF -* -* Set INFO = N+1 if the matrix is singular to working precision. -* - IF( RCOND.LT.DLAMCH( 'Epsilon' ) ) - $ INFO = N + 1 -* - RWORK( 1 ) = RPVGRW - RETURN -* -* End of ZGESVX -* - END From ba6d48510262a62e4728e83e9fd06214d9b4247a Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Thu, 4 Apr 2024 18:52:38 +0200 Subject: [PATCH 310/311] Adjust SWITCH_RATIO for ZEN and apply GEMM_PREFERRED_SIZE --- param.h | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/param.h b/param.h index 69f7c67a4..445bab083 100644 --- a/param.h +++ b/param.h @@ -614,7 +614,13 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #define SYMV_P 8 -#define SWITCH_RATIO 16 +#if defined(XDOUBLE) || defined(DOUBLE) +#define SWITCH_RATIO 4 +#define GEMM_PREFERED_SIZE 4 +#else +#define SWITCH_RATIO 8 +#define GEMM_PREFERED_SIZE 8 +#endif #ifdef ARCH_X86 From c5184078b4de6d7d5d7bc4c63a49046064c87e42 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Thu, 4 Apr 2024 19:07:51 +0200 Subject: [PATCH 311/311] Update Changelog.txt for 0.3.27 --- Changelog.txt | 100 ++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 100 insertions(+) diff --git a/Changelog.txt b/Changelog.txt index b6139d6b7..03c3cfbd9 100644 --- a/Changelog.txt +++ b/Changelog.txt @@ -1,4 +1,104 @@ OpenBLAS ChangeLog +==================================================================== +Version 0.3.27 + 4-Apr-2024 + +general: +- added initial (generic) support for the CSKY architecture +- capped the maximum number of threads used in GEMM, GETRF and POTRF to avoid creating + underutilized or idle threads +- sped up multithreaded POTRF on all platforms +- added extension openblas_set_num_threads_local() that returns the previous thread count +- re-evaluated the SGEMV and DGEMV load thresholds to avoid activating multithreading + for too small workloads +- improved the fallback code used when the precompiled number of threads is exceeded, + and made it callable multiple times during the lifetime of an instance +- added CBLAS interfaces for the BLAS extensions ?AMIN,?AMAX, CAXPYC and ZAXPYC +- fixed a potential buffer overflow in the interface to the GEMMT kernels +- fixed use of incompatible pointer types in GEMMT and C/ZAXPBY as flagged by GCC-14 +- fixed unwanted case sensitivity of the character parameters in ?TRTRS +- sped up the OpenMP thread management code +- fixed sizing of logical variables in INTERFACE64 builds of the C version of LAPACK +- fixed inclusion of new LAPACK and LAPACKE functions from LAPACK 3.11 in the shared library +- added a testsuite for the BLAS extensions +- modified the error thresholds for SGS/DGS functions in the LAPACK testsuite to suppress + spurious errors +- added support for building the benchmark collection with CMAKE +- added rewriting of linker options to avoid linking both libgomp and libomp in CMAKE builds + with OpenMP enabled that use clang with gfortran +- fixed building on systems with ucLibc +- added support for calling ?NRM2 with a negative increment value on all architectures +- added support for the LLVM18 version of the flang-new compiler +- fixed handling of the OPENBLAS_LOOPS variable in several benchmarks +- Integrated fixes from the Reference-LAPACK project: + - Increased accuracy in C/ZLARFGP (Reference-LAPACK PR 981) + +x86: +- fixed handling of NaN and Inf arguments in ZSCAL +- fixed GEMM3M functions failing in CMAKE builds + +x86-64: +- removed all instances of sched_yield() on Linux and BSD +- fixed a potential deadlock in the thread server on MSWindows (introduced in 0.3.26) +- fixed GEMM3M functions failing in CMAKE builds +- fixed handling of NaN and Inf arguments in ZSCAL +- added compiler checks for AVX512BF16 compatibility +- fixed LLVM compiler options for Sapphire Rapids +- fixed cpu handling fallbacks for Sapphire Rapids with + disabled AVX2 in DYNAMIC_ARCH mode +- fixed extensions SCSUM and DZSUM +- improved GEMM performance for ZEN targets + +arm: +- fixed handling of NaN and Inf arguments in ZSCAL + +arm64: +- added initial support for the Cortex-A76 cpu +- fixed handling of NaN and Inf arguments in ZSCAL +- fixed default compiler options for gcc (-march and -mtune) +- added support for ArmCompilerForLinux +- added support for the NeoverseV2 cpu in DYNAMIC_ARCH builds +- fixed mishandling of the INTERFACE64 option in CMAKE builds +- corrected SCSUM kernels (erroneously duplicating SCASUM behaviour) +- added SVE-enabled kernels for CSUM/ZSUM +- worked around an inaccuracy in the NRM2 kernels for NeoverseN1 and Apple M + +power: +- improved performance of SGEMM on POWER8/9/10 +- improved performance of DGEMM on POWER10 +- added support for OpenMP builds with xlc/xlf on AIX +- improved cpu autodetection for DYNAMIC_ARCH builds on older AIX +- fixed cpu core counting on AIX +- added support for building a shared library on AIX + +riscv64: +- added support for the X280 cpu +- added support for semi-generic RISCV models with vector length 128 or 256 +- added support for compiling with either RVV 0.7.1 or RVV 1.0 standard compilers +- fixed handling of NaN and Inf arguments in ZSCAL +- improved cpu model autodetection +- fixed corner cases in ?AXPBY for C910V +- fixed handling of zero increments in ?AXPY kernels for C910V + +loongarch64: +- added optimized kernels for ?AMIN and ?AMAX +- fixed handling of NaN and Inf arguments in ZSCAL +- fixed handling of corner cases in ?AXPBY +- fixed computation of SAMIN and DAMIN in LSX mode +- fixed computation of ?ROT +- added optimized SSYMV and DSYMV kernels for LSX and LASX mode +- added optimized CGEMM and ZGEMM kernels for LSX and LASX mode +- added optimized CGEMV and ZGEMV kernels + +mips: +- fixed utilizing MSA on P5600 and related cpus (broken in 0.3.22) +- fixed handling of NaN and Inf arguments in ZSCAL +- fixed mishandling of the INTERFACE64 option in CMAKE builds + +zarch: +- fixed handling of NaN and Inf arguments in ZSCAL +- fixed calculation of ?SUM on Z13 + ==================================================================== Version 0.3.26 2-Jan-2024