Update version to 0.3.34

Update from develop for 0.3.34 release

.github/workflows/c910v.yml

@@ -93,8 +93,9 @@ jobs:
         run: |
           run_with_retry() {
               local cmd="$1"
-              local time_out=10
-              local retries=10
+              local time_out="${2:-10}"
+              local retries="${3:-10}"
+              local timeout_step="${4:-5}"
               local attempt=0
 
               for ((i=1; i<=retries; i++)); do
@@ -106,7 +107,7 @@ jobs:
                       local exit_code=$?
                       if [ $exit_code -eq 140 ]; then
                           echo "Attempt $i timed out (retrying...)"
-                          time_out=$((time_out + 5))
+                          time_out=$((time_out + timeout_step))
                       else
                           echo "Attempt $i failed with exit code $exit_code. Aborting workflow."
                           exit $exit_code
@@ -121,7 +122,7 @@ jobs:
           export PATH=$GITHUB_WORKSPACE/qemu-install/bin:$PATH
           which qemu-riscv64
           export QEMU_BIN=$(which qemu-riscv64)
-          run_with_retry "$QEMU_BIN ./utest/openblas_utest"
+          run_with_retry "$QEMU_BIN ./utest/openblas_utest" 120 2 30
           run_with_retry "$QEMU_BIN ./utest/openblas_utest_ext"
 
           OPENBLAS_NUM_THREADS=2 qemu-riscv64 ./ctest/xscblat1

CMakeLists.txt

@@ -9,7 +9,7 @@ project(OpenBLAS C ASM)
 
 set(OpenBLAS_MAJOR_VERSION 0)
 set(OpenBLAS_MINOR_VERSION 3)
-set(OpenBLAS_PATCH_VERSION 33.dev)
+set(OpenBLAS_PATCH_VERSION 34)
 
 set(OpenBLAS_VERSION "${OpenBLAS_MAJOR_VERSION}.${OpenBLAS_MINOR_VERSION}.${OpenBLAS_PATCH_VERSION}")
 
@@ -734,18 +734,46 @@ if(NOT NO_CBLAS)
   set(CBLAS_H ${CMAKE_BINARY_DIR}/generated/cblas.h)
   file(READ ${CMAKE_CURRENT_SOURCE_DIR}/cblas.h CBLAS_H_CONTENTS)
   string(REPLACE "common" "openblas_config" CBLAS_H_CONTENTS_NEW "${CBLAS_H_CONTENTS}")
+
+  # Symbol prefix/suffix settings rename exported functions, not C typedefs.
+  # Protect callback type names from the textual function-name rewriting below.
+  string(REPLACE "openblas_dojob_callback" "OPENBLAS_DOJOB_CALLBACK_TYPE"
+    CBLAS_H_CONTENTS_NEW "${CBLAS_H_CONTENTS_NEW}")
+  string(REPLACE "openblas_threads_callback" "OPENBLAS_THREADS_CALLBACK_TYPE"
+    CBLAS_H_CONTENTS_NEW "${CBLAS_H_CONTENTS_NEW}")
+  string(REPLACE "openblas_xerbla_handler" "OPENBLAS_XERBLA_HANDLER_TYPE"
+    CBLAS_H_CONTENTS_NEW "${CBLAS_H_CONTENTS_NEW}")
+
   if (NOT ${SYMBOLPREFIX} STREQUAL "")
-    string(REPLACE " cblas" " ${SYMBOLPREFIX}cblas" CBLAS_H_CONTENTS	"${CBLAS_H_CONTENTS_NEW}")
-    string(REPLACE " openblas" " ${SYMBOLPREFIX}openblas" CBLAS_H_CONTENTS_NEW	"${CBLAS_H_CONTENTS}")
-    string (REPLACE " ${SYMBOLPREFIX}openblas_complex" " openblas_complex" CBLAS_H_CONTENTS	"${CBLAS_H_CONTENTS_NEW}")
-    string(REPLACE " goto" " ${SYMBOLPREFIX}goto" CBLAS_H_CONTENTS_NEW "${CBLAS_H_CONTENTS}")
+    string(REPLACE " cblas" " ${SYMBOLPREFIX}cblas"
+      CBLAS_H_CONTENTS_NEW "${CBLAS_H_CONTENTS_NEW}")
+    string(REPLACE " openblas" " ${SYMBOLPREFIX}openblas"
+      CBLAS_H_CONTENTS_NEW "${CBLAS_H_CONTENTS_NEW}")
+    string(REPLACE " ${SYMBOLPREFIX}openblas_complex" " openblas_complex"
+      CBLAS_H_CONTENTS_NEW "${CBLAS_H_CONTENTS_NEW}")
+    string(REPLACE " goto" " ${SYMBOLPREFIX}goto"
+      CBLAS_H_CONTENTS_NEW "${CBLAS_H_CONTENTS_NEW}")
   endif()
   if (NOT ${SYMBOLSUFFIX} STREQUAL "")
-    string(REGEX REPLACE "(cblas[^ (]*)" "\\1${SYMBOLSUFFIX}" CBLAS_H_CONTENTS	"${CBLAS_H_CONTENTS_NEW}")
-    string(REGEX REPLACE "(openblas[^ (]*)" "\\1${SYMBOLSUFFIX}" CBLAS_H_CONTENTS_NEW "${CBLAS_H_CONTENTS}")
-    string(REGEX REPLACE "(openblas_complex[^ ]*)${SYMBOLSUFFIX}" "\\1" CBLAS_H_CONTENTS	"${CBLAS_H_CONTENTS_NEW}")
-    string(REGEX REPLACE "(goto[^ (]*)" "\\1${SYMBOLSUFFIX}" CBLAS_H_CONTENTS_NEW	"${CBLAS_H_CONTENTS}")
+    string(REGEX REPLACE "(cblas[A-Za-z0-9_]*)" "\\1${SYMBOLSUFFIX}"
+      CBLAS_H_CONTENTS_NEW "${CBLAS_H_CONTENTS_NEW}")
+    string(REGEX REPLACE "(openblas[A-Za-z0-9_]*)" "\\1${SYMBOLSUFFIX}"
+      CBLAS_H_CONTENTS_NEW "${CBLAS_H_CONTENTS_NEW}")
+    string(REPLACE "openblas_config${SYMBOLSUFFIX}" "openblas_config"
+      CBLAS_H_CONTENTS_NEW "${CBLAS_H_CONTENTS_NEW}")
+    string(REGEX REPLACE "(openblas_complex[A-Za-z0-9_]*)${SYMBOLSUFFIX}" "\\1"
+      CBLAS_H_CONTENTS_NEW "${CBLAS_H_CONTENTS_NEW}")
+    string(REGEX REPLACE "(goto[A-Za-z0-9_]*)" "\\1${SYMBOLSUFFIX}"
+      CBLAS_H_CONTENTS_NEW "${CBLAS_H_CONTENTS_NEW}")
   endif()
+
+  string(REPLACE "OPENBLAS_DOJOB_CALLBACK_TYPE" "openblas_dojob_callback"
+    CBLAS_H_CONTENTS_NEW "${CBLAS_H_CONTENTS_NEW}")
+  string(REPLACE "OPENBLAS_THREADS_CALLBACK_TYPE" "openblas_threads_callback"
+    CBLAS_H_CONTENTS_NEW "${CBLAS_H_CONTENTS_NEW}")
+  string(REPLACE "OPENBLAS_XERBLA_HANDLER_TYPE" "openblas_xerbla_handler"
+    CBLAS_H_CONTENTS_NEW "${CBLAS_H_CONTENTS_NEW}")
+
   file(WRITE ${CBLAS_H} "${CBLAS_H_CONTENTS_NEW}")
   install (FILES ${CBLAS_H} DESTINATION ${CMAKE_INSTALL_INCLUDEDIR})
 endif()

CONTRIBUTORS.md

@@ -279,3 +279,8 @@ In chronological order:
 * Nathan Sircombe <nathan.sircombe@arm.com>
   * [2026-04-16] Add CPU ID for Neoverse V3
 hheei <hheei@users.noreply.github.com>
+
+* Aadityansha Verma <https://github.com/aadityansha06>
+  * [2026-07-14] Add independent transpose support for C in GEADD (sgeadd/dgeadd/cgeadd/zgeadd).
+
+

Changelog.txt

@@ -1,4 +1,114 @@
 OpenBLAS ChangeLog
+====================================================================
+Version 0.3.34
+16-Jul-2026
+
+general:
+ - Fixed potential race conditions between concurrent calls to level3 BLAS
+   functions (inadvertent use of non-unified locks)
+ - Fixed potential race condition in GETRF
+ - Added or improved multithreading thresholds in SPR,SPR2,SYR,SYR2,TBMV,TPMV
+ - Added multithreading thresholds to GETRS, LAED3, LASWP, LAUUM, TRTRS, ZTRTRI 
+ - Added a BLAS extension for overriding the default error handler (XERBLA) function
+ - Reimplemented the BLAS extension GEADD to support independent transposition of
+   both matrices (unlike the previous, ATLAS-like implementation)
+ - Guarded against spurious NaN values in the reimplemented ?LAED3
+ - Fixed compilation of the BLAS extension tests with CMake
+ - Fixed spurious and conflicting setting of job numbers in gmake builds
+ - Fixed a potential linking issue with the fortran runtime in the BLAS tests
+ - Fixed potential access to unrelated memory in the C fallback versions of LAPACK
+   functions ILAENV and IPARMQ
+ - Fixed the generated pkgfile to support spaces in path names
+ - Added support for compilation with the experimental, LLVM-based memory-safe C toolchain 
+   known as Fil-C
+ - Imported recent updates from Reference-LAPACK to realign with its upcoming 3.13.0 release:
+   - Added non-trivial terminating case to ?LARFT calculation (Reference-LAPACK PR 1163)
+   - Fixed workspace calculation for CUNMLQ with K=0 (Reference-LAPACK PR 1225)
+   - Rearranged computations in C/ZLARTG to avoid large intermediates (PR 1245)
+   - Fixed wrong Y increment used in ?ORDB3/?UNBDB3 (Reference-LAPACK PR 1265)
+   - Fixed wrong name reported in XERBLA call of ZLA_SYRFSX_EXTENDED (PR 1268)
+   - Fixed wrong JOBA type in SGESVJ call of SGEJSV (Reference-LAPACK PR 1269)
+   - Fixed wrong workspace in DGEJSV corrupting memory in DGESVJ (PR 1270)
+   - Fixed wrong or missing EXTERNAL declarations (Reference-LAPACK PR 1271)
+   - Fixed wrong operand number in errors of GGSVD3,UN/ORBDB4,UN/ORCSD (PR 1272)
+   - Fixed sign of error flag in LWORK check of LAQZ0 (Reference-LAPACK PR 1273)
+   - Fixed too small workspace query result from SGGEV3 (Reference-LAPACK PR 1274)
+   - Fixed DLASWLQ not rejecting NB=0 (Reference-LAPACK PR 1275)
+   - Avoid immediate overflows in GEJSV,GESVJ,GESVDX,GEDMD (Reference-LAPACK PR 1283)
+   - Ignore LDU value when U unused in LAPACKE_?GESVD_WORK (Reference-LAPACK PR 1284)
+   - Fixed premature return before fallback code in BDSQR (Reference-LAPACK PR 1285)
+   - Increased tolerance in LASD2 to improve BDSDC stability (Reference-LAPACK PR 1286)
+   - Fixed row-major A dimension for SIDE=R in LAPACKE_?TPRFB_WORK (PR 1287)
+   - Fixed seed advancement in SLARUV/DLARUV (Reference-LAPACK PR 1288)
+   - Fixed workspace queries for TZRZF/UNMRZ in GELSY (Reference-LAPACK PRs 1289/1325)
+   - Avoid immediate overflows in ?LARFGP (Reference-LAPACK PR 1290) 
+   - Added handling of degenerate cases in OR/UNCSD2BY1 (Reference-LAPACK PR 1291)
+   - Fixed workspace for tiny inputs in ORM/UNM-L/R-Q and -Q-L/R (PR 1292)
+   - Scaled convergence thresholds in ?BBCSD to improve accuracy (PR 1293)
+   - Fixed integer overflow in the LAPACKE nancheck helpers (Reference-LAPACK PR 1294)
+   - Relaxed eigenvalue consistency checks in testsuite (Reference-LAPACK PR 1297)
+   - Fixed test failures in ?CHKLQ with NB=1 and M=N (Reference-LAPACK PR 1298)
+   - Switched to QR algorithm in ?BDSDC for bidiagonal SVD with vectors (PR 1300)
+   - Replaced HUGE intrinsic in ?TGSJA with parameter for consistency (PR 1305)
+   - Corrected description of QMAX parameter in ?LASQ3 (Reference-LAPACK PR 1307)
+   - Fixed bad scaling in ?LARFF that slowed down DSYEVR/ZHEEVR (PR 1309)
+   - Fixed handling of negative increments in ?LARF/?LARF1F/?LARF1L (PR 1315)
+   - Increased tolerances in ?LAED to match changes in ?LASD (PR 1317)
+   - Fixed LAPACKE_?lacpy_work destroying data in row-major mode (PR 1318) 
+
+arm:
+ - Added a significantly faster SGEMM kernel
+
+arm64:
+ - Added optimized kernels for OMATCOPY_CT and OMATCOPY_RT on all targets
+ - Fixed SDOT/DDOT on non-SVE-capable cpus not initializing the result correctly
+ - Fixed miscompilation of CGETF2/ZGETF2 by LLVM on Apple M
+ - Fixed SSYRK miscalculation on Apple M systems bigger than the Mac mini
+ - Fixed remaining cases of CMake build failure due to long argument lists on OSX
+ - On OSX, reduced the list of DYNAMIC_ARCH targets to those relevant for this os
+ - Fixed platform detection and cross-builds to iOS on OSX with AppleClang
+ - Fixed gmake builds for SME targets on OSX with AppleClang
+ - Improved the compiler test for SME compatibility in the CMake build files
+ - Fixed runtime detection of SME in DYNAMIC_ARCH builds made with CMake
+ - Restored a fix for building DYNAMIC_ARCH under Windows on Arm that was inadvertently
+   dropped in 0.3.33)
+ - Corrected the selection criteria for the SME-based SGEMM kernel on Apple M
+ - Fixed DYNAMIC_ARCH builds on hosts without SVE capability
+ - Fixed building a shared library with NAG Fortran on OSX
+ - Fixed misdetection of C11 capability (and resulting race conditions during concurrent 
+   calls) in Clang builds under OSX
+ - Fixed miscalculation of Apple M cpu time leading to benchmarks 40 times too slow
+
+loongarch64:
+ - Corrected generation of the LSX/LASX status flags in the configuration files
+ - Fixed potential reads of memory beyond the array bounds in the LA464 SGEMM kernel
+ - Added optimized SDOT, ICAMIN/IZAMIN and ZGEMM kernels for 2K3000
+
+power:
+ - Fixed an incompatibility in the assembly kernels for SCAL on FreeBSD
+ - Fixed a potentially spurious check for gfortran in gmake builds with LLVM
+   that could make POWER9/10 builds fall back to POWER8 kernels
+ - Improved build flags and cpu register constraints for POWER10
+ - Fixed linking issues on BSD
+
+riscv64:
+ - Fixed compilation for DYNAMIC_ARCH with BUILD_BFLOAT16 defined
+ - Fixed SGEMM and DGEMM errors on ZVL256 introduced in 0.3.33
+ - Sped up GEMV on C910V and ZVL256B targets
+ - Improved the x280 S/DROTM kernel and enabled it on ZVL128B/ZVL256B
+ - Added optimized STRSM kernels for ZVL128B/ZVL256B
+ - Added optimized D/C/ZTRSM kernels (RN and RT cases) for ZVL128B/ZVL256B
+ - Added a dedicated target for the SiFive U74 with optimized SGEMM and DGEMM kernels
+ - Made L2 cache size available at runtime for scaling GEMM block sizes
+
+x86_64:
+ - Fixed remaining cases of CMake build failure due to long argument lists on OSX
+ - Improved cpu capability check for recent Zhaoxin cpus
+ - Fixed wrong TRSM results on AMD Barcelona (and Ryzen systems in 32bit builds) 
+ - Added autodetection support for the fake Opteron-like CPUID used by QEMU on AMD hardware
+ - Fixed automatic setting of the BINARY=32 option when building with 32bit toolchains
+ - Fixed miscompilation of GEMM,SYR2K and TPMV kernels with gcc15/gcc16 on 32bit FreeBSD
+
 ====================================================================
 Version 0.3.33
 23-Apr-2026

Makefile.install

@@ -73,7 +73,10 @@ install : 	lib.grd
 
 ifneq ($(NO_CBLAS),1)
 	@echo Generating cblas.h in $(DESTDIR)$(OPENBLAS_INCLUDE_DIR)
-	@cp cblas.h cblas.tmp
+	@sed -e 's/openblas_dojob_callback/OPENBLAS_DOJOB_CALLBACK_TYPE/g' \
+	     -e 's/openblas_threads_callback/OPENBLAS_THREADS_CALLBACK_TYPE/g' \
+	     -e 's/openblas_xerbla_handler/OPENBLAS_XERBLA_HANDLER_TYPE/g' \
+	     cblas.h > cblas.tmp
 ifdef SYMBOLPREFIX
 	@sed 's/cblas[^() ]*/$(SYMBOLPREFIX)&/g' cblas.tmp > cblas.tmp2
 	@sed 's/openblas[^() ]*/$(SYMBOLPREFIX)&/g'  cblas.tmp2 > cblas.tmp
@@ -88,7 +91,11 @@ ifdef SYMBOLSUFFIX
 	@sed 's/\(openblas_complex_\)\([^ ]*\)$(SYMBOLSUFFIX)/\1\2 /g'  cblas.tmp > cblas.tmp2
 	@sed 's/goto[^() ]*/&$(SYMBOLSUFFIX)/g'  cblas.tmp2 > cblas.tmp
 endif
-	@sed 's/common/openblas_config/g' cblas.tmp > "$(DESTDIR)$(OPENBLAS_INCLUDE_DIR)/cblas.h"
+	@sed -e 's/OPENBLAS_DOJOB_CALLBACK_TYPE/openblas_dojob_callback/g' \
+	     -e 's/OPENBLAS_THREADS_CALLBACK_TYPE/openblas_threads_callback/g' \
+	     -e 's/OPENBLAS_XERBLA_HANDLER_TYPE/openblas_xerbla_handler/g' \
+	     -e 's/common/openblas_config/g' \
+	     cblas.tmp > "$(DESTDIR)$(OPENBLAS_INCLUDE_DIR)/cblas.h"
 endif
 
 ifneq ($(OSNAME), AIX)

Makefile.power

@@ -111,7 +111,12 @@ endif
 endif
 
 ifeq ($(C_COMPILER), CLANG)
-CCOMMON_OPT += -fno-integrated-as -Wa,-mpwr10
+CCOMMON_OPT += -fno-integrated-as
+ifeq ($(OSNAME), FreeBSD)
+ifeq ($(CORE), $(filter $(CORE),POWER9 POWER10))
+CCOMMON_OPT += -Wa,-mpwr10
+endif
+endif
 endif
 # workaround for C->FORTRAN ABI violation in LAPACKE
 ifeq ($(F_COMPILER), GFORTRAN)

Makefile.prebuild

@@ -75,6 +75,10 @@ ifeq ($(TARGET), RISCV64_GENERIC)
 TARGET_FLAGS = -march=rv64imafdc -mabi=lp64d
 endif
 
+ifeq ($(TARGET), U74)
+TARGET_FLAGS = -march=rv64imafdc_zba_zbb -mabi=lp64d
+endif
+
 all: getarch_2nd
 	./getarch_2nd  0 >> $(TARGET_MAKE)
 	./getarch_2nd  1 >> $(TARGET_CONF)

Makefile.riscv64

@@ -25,3 +25,7 @@ ifeq ($(CORE), RISCV64_GENERIC)
 CCOMMON_OPT += -march=rv64imafdc -mabi=lp64d
 FCOMMON_OPT += -march=rv64imafdc -mabi=lp64d
 endif
+ifeq ($(CORE), U74)
+CCOMMON_OPT += -march=rv64imafdc_zba_zbb -mabi=lp64d -mtune=sifive-u74
+FCOMMON_OPT += -march=rv64imafdc_zba_zbb -mabi=lp64d -mtune=sifive-u74
+endif

Makefile.rule

@@ -3,17 +3,17 @@
 #
 
 # This library's version
-VERSION = 0.3.33.dev
+VERSION = 0.3.34
 
-# 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
-# 
+# If you set this prefix, the library name will be lib$(LIBNAMEPREFIX)openblas.a
+# and lib$(LIBNAMEPREFIX)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.
-# LIBNAMESUFFIX = omp
+# 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.
+# LIBNAMESUFFIX = _omp
 
 # You can specify the target architecture, otherwise it's
 # automatically detected.

Makefile.system

@@ -18,6 +18,10 @@ HOSTARCH := $(shell uname -m)
 ifeq ($(HOSTARCH), amd64)
 HOSTARCH=x86_64
 endif
+ifeq ($(HOSTARCH), i386)
+HOSTARCH=x86
+override BINARY=32
+endif
 
 # Catch conflicting usage of ARCH in some BSD environments
 ifeq ($(ARCH), amd64)

TargetList.txt

@@ -128,6 +128,7 @@ RISCV64_ZVL128B
 C910V
 x280
 RISCV64_ZVL256B
+U74 (e.g. SiFive U74 / StarFive JH7110 / VisionFive 2)
 
 11.LOONGARCH64:
 // LOONGSONGENERIC/LOONGSON2K1000/LOONGSON3R5 are legacy names,

cblas.h

@@ -59,6 +59,20 @@ typedef void (*openblas_dojob_callback)(int thread_num, void *jobdata, int dojob
 typedef void (*openblas_threads_callback)(int sync, openblas_dojob_callback dojob, int numjobs, size_t jobdata_elsize, void *jobdata, int dojob_data);
 void openblas_set_threads_callback_function(openblas_threads_callback callback);
 
+/* Replace the XERBLA handler for this OpenBLAS instance and return the
+ * previous handler. Passing NULL restores the default. Callbacks may run
+ * concurrently and must be thread-safe. The name and info pointers are valid
+ * only during the callback; name spans name_length bytes and need not be
+ * NUL-terminated. Replacement is thread-safe but does not wait for in-flight
+ * calls, so the previous handler must remain loaded until they complete. */
+#ifndef OPENBLAS_XERBLA_HANDLER_DEFINED
+#define OPENBLAS_XERBLA_HANDLER_DEFINED
+typedef void (*openblas_xerbla_handler)(const char *name,
+                                        const blasint *info,
+                                        size_t name_length);
+#endif
+openblas_xerbla_handler openblas_set_xerbla(openblas_xerbla_handler handler);
+
 #ifdef OPENBLAS_OS_LINUX
 /* Sets thread affinity for OpenBLAS threads. `thread_idx` is in [0, openblas_get_num_threads()-1]. */
 int openblas_setaffinity(int thread_idx, size_t cpusetsize, cpu_set_t* cpu_set);
@@ -435,13 +449,13 @@ void cblas_cimatcopy(OPENBLAS_CONST enum CBLAS_ORDER CORDER, OPENBLAS_CONST enum
 void cblas_zimatcopy(OPENBLAS_CONST enum CBLAS_ORDER CORDER, OPENBLAS_CONST enum CBLAS_TRANSPOSE CTRANS, OPENBLAS_CONST blasint crows, OPENBLAS_CONST blasint ccols, OPENBLAS_CONST double* calpha, double* a, 
 		     OPENBLAS_CONST blasint clda, OPENBLAS_CONST blasint cldb); 
 
-void cblas_sgeadd(OPENBLAS_CONST enum CBLAS_ORDER CORDER,OPENBLAS_CONST blasint crows, OPENBLAS_CONST blasint ccols, OPENBLAS_CONST float calpha, OPENBLAS_CONST float *a, OPENBLAS_CONST blasint clda, OPENBLAS_CONST float cbeta, 
-		  float *c, OPENBLAS_CONST blasint cldc); 
-void cblas_dgeadd(OPENBLAS_CONST enum CBLAS_ORDER CORDER,OPENBLAS_CONST blasint crows, OPENBLAS_CONST blasint ccols, OPENBLAS_CONST double calpha, OPENBLAS_CONST double *a, OPENBLAS_CONST blasint clda, OPENBLAS_CONST double cbeta, 
+void cblas_sgeadd(OPENBLAS_CONST enum CBLAS_ORDER CORDER,OPENBLAS_CONST enum CBLAS_TRANSPOSE CTRANS_A,OPENBLAS_CONST enum CBLAS_TRANSPOSE CTRANS_C,OPENBLAS_CONST blasint crows, OPENBLAS_CONST blasint ccols, OPENBLAS_CONST float calpha, OPENBLAS_CONST float *a, OPENBLAS_CONST blasint clda,OPENBLAS_CONST float cbeta, float *c, 
+                  OPENBLAS_CONST blasint cldc);
+void cblas_dgeadd(OPENBLAS_CONST enum CBLAS_ORDER CORDER,OPENBLAS_CONST enum CBLAS_TRANSPOSE CTRANS_A,OPENBLAS_CONST enum CBLAS_TRANSPOSE CTRANS_C,OPENBLAS_CONST blasint crows, OPENBLAS_CONST blasint ccols, OPENBLAS_CONST double calpha, OPENBLAS_CONST double *a, OPENBLAS_CONST blasint clda, OPENBLAS_CONST double cbeta, 
 		  double *c, OPENBLAS_CONST blasint cldc); 
-void cblas_cgeadd(OPENBLAS_CONST enum CBLAS_ORDER CORDER,OPENBLAS_CONST blasint crows, OPENBLAS_CONST blasint ccols, OPENBLAS_CONST float *calpha, OPENBLAS_CONST float *a, OPENBLAS_CONST blasint clda, OPENBLAS_CONST float *cbeta, 
+void cblas_cgeadd(OPENBLAS_CONST enum CBLAS_ORDER CORDER,OPENBLAS_CONST enum CBLAS_TRANSPOSE CTRANS_A,OPENBLAS_CONST enum CBLAS_TRANSPOSE CTRANS_C,OPENBLAS_CONST blasint crows, OPENBLAS_CONST blasint ccols, OPENBLAS_CONST float *calpha, OPENBLAS_CONST float *a, OPENBLAS_CONST blasint clda, OPENBLAS_CONST float *cbeta, 
 		  float *c, OPENBLAS_CONST blasint cldc); 
-void cblas_zgeadd(OPENBLAS_CONST enum CBLAS_ORDER CORDER,OPENBLAS_CONST blasint crows, OPENBLAS_CONST blasint ccols, OPENBLAS_CONST double *calpha, OPENBLAS_CONST double *a, OPENBLAS_CONST blasint clda, OPENBLAS_CONST double *cbeta, 
+void cblas_zgeadd(OPENBLAS_CONST enum CBLAS_ORDER CORDER,OPENBLAS_CONST enum CBLAS_TRANSPOSE CTRANS_A,OPENBLAS_CONST enum CBLAS_TRANSPOSE CTRANS_C,OPENBLAS_CONST blasint crows, OPENBLAS_CONST blasint ccols, OPENBLAS_CONST double *calpha, OPENBLAS_CONST double *a, OPENBLAS_CONST blasint clda, OPENBLAS_CONST double *cbeta, 
 		  double *c, OPENBLAS_CONST blasint cldc); 
 
 void cblas_sgemm_batch(OPENBLAS_CONST enum CBLAS_ORDER Order, OPENBLAS_CONST enum CBLAS_TRANSPOSE * TransA_array, OPENBLAS_CONST enum CBLAS_TRANSPOSE * TransB_array, OPENBLAS_CONST blasint * M_array, OPENBLAS_CONST blasint * N_array, OPENBLAS_CONST blasint * K_array,

cmake/cc.cmake

@@ -428,6 +428,9 @@ endif()
 if (${CORE} STREQUAL RISCV64_GENERIC)
   set (CCOMMON_OPT "${CCOMMON_OPT} -march=rv64imafdc -mabi=lp64d")
 endif()
+if (${CORE} STREQUAL U74)
+  set (CCOMMON_OPT "${CCOMMON_OPT} -march=rv64imafdc_zba_zbb -mabi=lp64d -mtune=sifive-u74")
+endif()
 if (${CORE} STREQUAL x280)
   set (CCOMMON_OPT "${CCOMMON_OPT} -march=rv64imafdcv_zba_zbb_zfh_zvl512b -mabi=lp64d")
 endif()

cmake/prebuild.cmake

@@ -1504,6 +1504,15 @@ endif ()
       "#define DTB_DEFAULT_ENTRIES 128\n"
       "#define DTB_SIZE 4096\n"
       "#define L2_ASSOCIATIVE 4\n")
+  elseif ("${TCORE}" STREQUAL "U74")
+    file(APPEND ${TARGET_CONF_TEMP}
+      "#define L1_DATA_SIZE 32768\n"
+      "#define L1_DATA_LINESIZE 64\n"
+      "#define L2_SIZE 2097152\n"
+      "#define L2_LINESIZE 64 \n"
+      "#define DTB_DEFAULT_ENTRIES 128\n"
+      "#define DTB_SIZE 4096\n"
+      "#define L2_ASSOCIATIVE 16\n")
   elseif ("${TCORE}" STREQUAL "WASM128_GENERIC")
     file(APPEND ${TARGET_CONF_TEMP}
       "#define L1_DATA_SIZE 32768\n"

cmake/system.cmake

@@ -409,6 +409,9 @@ if (${TARGET} STREQUAL NEOVERSEV1)
   if (${TARGET} STREQUAL RISCV64_GENERIC)
       set (KERNEL_DEFINITIONS "${KERNEL_DEFINITIONS} -march=rv64imafdc -mabi=lp64d")
     endif()
+    if (${TARGET} STREQUAL U74)
+      set (KERNEL_DEFINITIONS "${KERNEL_DEFINITIONS} -march=rv64imafdc_zba_zbb -mabi=lp64d -mtune=sifive-u74")
+    endif()
     if (${TARGET} STREQUAL x280)
       set (KERNEL_DEFINITIONS "${KERNEL_DEFINITIONS} -march=rv64imafdcv_zba_zbb_zfh_zvl512b -mabi=lp64d")
     endif()
@@ -648,8 +651,8 @@ endif()
   
 set(LIBPREFIX "lib${LIBNAMEPREFIX}openblas")
 
-if (DEFINED LIBNAMESUFFIX)
-  set(LIBPREFIX "${LIBNAMEPREFIX}_${LIBNAMESUFFIX}")
+if (DEFINED LIBNAMESUFFIX AND NOT "${LIBNAMESUFFIX}" STREQUAL "")
+  set(LIBPREFIX "lib${LIBNAMEPREFIX}openblas${LIBNAMESUFFIX}")
 endif ()
 
 if (NOT DEFINED SYMBOLPREFIX)

common.h

@@ -880,6 +880,26 @@ typedef struct {
 #endif
 
 #include "common_interface.h"
+
+/* Internal declaration of the public C XERBLA callback API. Keep this out of
+ * common_interface.h, whose contents are copied verbatim into f77blas.h and
+ * are not adjusted for SYMBOLPREFIX/SYMBOLSUFFIX by the CMake build. */
+#ifndef ASSEMBLER
+#ifdef __cplusplus
+extern "C" {
+#endif
+#ifndef OPENBLAS_XERBLA_HANDLER_DEFINED
+#define OPENBLAS_XERBLA_HANDLER_DEFINED
+typedef void (*openblas_xerbla_handler)(const char *name,
+                                        const blasint *info,
+                                        size_t name_length);
+#endif
+openblas_xerbla_handler openblas_set_xerbla(openblas_xerbla_handler handler);
+#ifdef __cplusplus
+}
+#endif
+#endif
+
 #ifdef SANITY_CHECK
 #include "common_reference.h"
 #endif

common_interface.h

@@ -801,10 +801,10 @@ void    BLASFUNC(dimatcopy) (char *, char *, blasint *, blasint *, double  *, do
 void    BLASFUNC(cimatcopy) (char *, char *, blasint *, blasint *, float  *, float  *, blasint *, blasint *);
 void    BLASFUNC(zimatcopy) (char *, char *, blasint *, blasint *, double  *, double  *, blasint *, blasint *);
 
-void    BLASFUNC(sgeadd) (blasint *, blasint *, float *, float *, blasint *, float *, float *, blasint*); 
-void    BLASFUNC(dgeadd) (blasint *, blasint *, double *, double *, blasint *, double *, double *, blasint*); 
-void    BLASFUNC(cgeadd) (blasint *, blasint *, float *, float *, blasint *, float *, float *, blasint*); 
-void    BLASFUNC(zgeadd) (blasint *, blasint *, double *, double *, blasint *, double *, double *, blasint*); 
+void    BLASFUNC(sgeadd) (blasint *, blasint *, float *, float *, blasint *, float *, float *, blasint*,char*, char*); 
+void    BLASFUNC(dgeadd) (blasint *, blasint *, double *, double *, blasint *, double *, double *, blasint*,char *, char *); 
+void    BLASFUNC(cgeadd) (blasint *, blasint *, float *, float *, blasint *, float *, float *, blasint*,char *, char *); 
+void    BLASFUNC(zgeadd) (blasint *, blasint *, double *, double *, blasint *, double *, double *, blasint*,char *, char *); 
 
 
 #ifdef __cplusplus

common_level3.h

@@ -2050,10 +2050,10 @@ int zimatcopy_k_rnc(BLASLONG, BLASLONG,  double, double, double *, BLASLONG);
 int zimatcopy_k_ctc(BLASLONG, BLASLONG,  double, double, double *, BLASLONG);
 int zimatcopy_k_rtc(BLASLONG, BLASLONG,  double, double, double *, BLASLONG);
 
-int sgeadd_k(BLASLONG, BLASLONG, float, float*, BLASLONG, float, float *, BLASLONG); 
-int dgeadd_k(BLASLONG, BLASLONG, double, double*, BLASLONG, double, double *, BLASLONG); 
-int cgeadd_k(BLASLONG, BLASLONG, float, float, float*, BLASLONG, float, float, float *, BLASLONG); 
-int zgeadd_k(BLASLONG, BLASLONG, double,double, double*, BLASLONG, double, double, double *, BLASLONG);
+int sgeadd_k(BLASLONG, BLASLONG, float, float*, BLASLONG, float, float *, BLASLONG,BLASLONG,BLASLONG); 
+int dgeadd_k(BLASLONG, BLASLONG, double, double*, BLASLONG, double, double *, BLASLONG,BLASLONG,BLASLONG); 
+int cgeadd_k(BLASLONG, BLASLONG, float, float, float*, BLASLONG, float, float, float *, BLASLONG,BLASLONG,BLASLONG); 
+int zgeadd_k(BLASLONG, BLASLONG, double,double, double*, BLASLONG, double, double, double *, BLASLONG,BLASLONG,BLASLONG);
 
 int sgemm_batch_thread(blas_arg_t * queue, BLASLONG nums);
 int dgemm_batch_thread(blas_arg_t * queue, BLASLONG nums);

common_macro.h

@@ -2712,7 +2712,7 @@
 #ifndef ASSEMBLER
 #if !defined(DYNAMIC_ARCH) \
   && (defined(ARCH_X86) || defined(ARCH_X86_64) || defined(ARCH_IA64) || defined(ARCH_MIPS64) || defined(ARCH_ARM64) \
-      || defined(ARCH_LOONGARCH64) || defined(ARCH_E2K) || defined(ARCH_ALPHA))
+      || defined(ARCH_LOONGARCH64) || defined(ARCH_E2K) || defined(ARCH_ALPHA) || defined(ARCH_RISCV64))
 extern BLASLONG gemm_offset_a;
 extern BLASLONG gemm_offset_b;
 extern BLASLONG bgemm_p;

common_param.h

@@ -1256,16 +1256,16 @@ int (*shgemv_t) (BLASLONG, BLASLONG, float, hfloat16 *, BLASLONG, hfloat16 *, BL
 #endif
 
 #if (BUILD_SINGLE==1)
-  int    (*sgeadd_k) (BLASLONG, BLASLONG, float, float *, BLASLONG, float, float *, BLASLONG); 
+  int    (*sgeadd_k) (BLASLONG, BLASLONG, float, float *, BLASLONG, float, float *, BLASLONG, BLASLONG, BLASLONG); 
 #endif
 #if (BUILD_DOUBLE==1)
-  int    (*dgeadd_k) (BLASLONG, BLASLONG, double, double *, BLASLONG, double, double *, BLASLONG); 
+  int    (*dgeadd_k) (BLASLONG, BLASLONG, double, double *, BLASLONG, double, double *, BLASLONG, BLASLONG, BLASLONG); 
 #endif
 #if (BUILD_COMPLEX==1)
-  int    (*cgeadd_k) (BLASLONG, BLASLONG, float, float,  float *,  BLASLONG, float, float, float *, BLASLONG); 
+  int    (*cgeadd_k) (BLASLONG, BLASLONG, float, float,  float *,  BLASLONG, float, float, float *, BLASLONG, BLASLONG, BLASLONG); 
 #endif
 #if (BUILD_COMPLEX16==1)
-  int    (*zgeadd_k) (BLASLONG, BLASLONG, double, double, double *, BLASLONG, double, double, double *, BLASLONG); 
+  int    (*zgeadd_k) (BLASLONG, BLASLONG, double, double, double *, BLASLONG, double, double, double *, BLASLONG, BLASLONG, BLASLONG); 
 #endif
 } gotoblas_t;
 

common_thread.h

@@ -138,10 +138,19 @@ typedef struct blas_queue {
 extern int blas_server_avail;
 extern int blas_omp_number_max;
 extern int blas_omp_threads_local;
+extern int blas_is_num_threads_set_explicitly;
 
 static __inline int num_cpu_avail(int level) {
 
 #ifdef USE_OPENMP
+  /* If the user explicitly called openblas_set_num_threads(),
+     respect that setting instead of overriding it with
+     `omp_get_max_threads()` below (which is to get a default
+     in case the user hasn't made an explicit choice). */
+  if (blas_is_num_threads_set_explicitly) {
+    return blas_cpu_number;
+  }
+
 int openmp_nthreads;
 	openmp_nthreads=omp_get_max_threads();
 	if (omp_in_parallel()) openmp_nthreads = blas_omp_threads_local;

cpuid_riscv64.c

@@ -75,13 +75,15 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 #define CPU_x280            2
 #define CPU_RISCV64_ZVL256B 3
 #define CPU_RISCV64_ZVL128B 4
+#define CPU_U74             5
 
 static char *cpuname[] = {
   "RISCV64_GENERIC",
   "C910V",
   "x280",
   "CPU_RISCV64_ZVL256B",
-  "CPU_RISCV64_ZVL128B"
+  "CPU_RISCV64_ZVL128B",
+  "U74"
 };
 
 static char *cpuname_lower[] = {
@@ -89,15 +91,17 @@ static char *cpuname_lower[] = {
   "c910v",
   "x280",
   "riscv64_zvl256b",
-  "riscv64_zvl128b"
+  "riscv64_zvl128b",
+  "u74"
 };
 
 int detect(void){
 #ifdef __linux
   FILE *infile;
-  char buffer[512],isa_buffer[512],model_buffer[512];
+  char buffer[512],isa_buffer[512],model_buffer[512], uarch_buffer[512];
   const char* check_c910_str = "T-HEAD C910";
-  char *pmodel = NULL, *pisa = NULL;
+  const char* check_u74_str = "sifive,u74";
+  char *pmodel = NULL, *pisa = NULL, *puarch = NULL;
 
   infile = fopen("/proc/cpuinfo", "r");
   if (!infile)
@@ -110,6 +114,13 @@ int detect(void){
         pmodel++;
     }
 
+    if(!strncmp(buffer, "uarch", 5)){
+      strcpy(uarch_buffer, buffer);
+      puarch = strchr(uarch_buffer, ':');
+      if (puarch)
+        puarch++;
+    }
+
     if(!strncmp(buffer, "isa", 3)){
       strcpy(isa_buffer, buffer);
       pisa = strchr(isa_buffer, '4');
@@ -120,12 +131,16 @@ int detect(void){
 
   fclose(infile);
 
-  if (!pmodel || !pisa)
+  if ((!pmodel && !puarch) || !pisa)
    return(CPU_GENERIC);
 
-  if (strstr(pmodel, check_c910_str) && strchr(pisa, 'v'))
-    return CPU_C910V;
-
+  if (pmodel) {
+    if (strstr(pmodel, check_c910_str) && strchr(pisa, 'v'))
+      return CPU_C910V;
+  } else if (puarch) {
+    if (strstr(puarch, check_u74_str) && !strchr(pisa, 'v'))
+      return CPU_U74;
+  }
   return CPU_GENERIC;
 #endif
 

ctest/CMakeLists.txt

@@ -18,6 +18,7 @@ if(WIN32)
 FILE(WRITE ${CMAKE_CURRENT_BINARY_DIR}/test_cblas_helper.ps1
 "$ErrorActionPreference = \"Stop\"\n"
 "Get-Content $args[1] | & $args[0]\n"
+"exit $LASTEXITCODE\n"
 )
 set(test_helper powershell -ExecutionPolicy Bypass "${CMAKE_CURRENT_BINARY_DIR}/test_cblas_helper.ps1")
 else()

ctest/c_c2chke.c

@@ -4,21 +4,14 @@
 #include "cblas_test.h"
 
 int cblas_ok, cblas_lerr, cblas_info;
-int link_xerbla=TRUE;
 char *cblas_rout;
 
-#ifdef F77_Char
-void F77_xerbla(F77_Char F77_srname, void *vinfo);
-#else
-void F77_xerbla(char *srname, void *vinfo);
-#endif
-
 void chkxer(void) {
    extern int cblas_ok, cblas_lerr, cblas_info;
-   extern int link_xerbla;
    extern char *cblas_rout;
    if (cblas_lerr == 1 ) {
-      printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %d NOT DETECTED BY %s *****\n", cblas_info, cblas_rout);
+      printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %lld NOT DETECTED BY %s *****\n",
+             (long long)cblas_info, cblas_rout);
       cblas_ok = 0 ;
    }
    cblas_lerr = 1 ;
@@ -36,11 +29,7 @@ void F77_c2chke(char *rout) {
    extern int RowMajorStrg;
    extern char *cblas_rout;
 
-   if (link_xerbla) /* call these first to link */
-   {
-      cblas_xerbla(cblas_info,cblas_rout,"");
-      F77_xerbla(cblas_rout,&cblas_info);
-   }
+   cblas_test_set_xerbla();
 
    cblas_ok = TRUE ;
    cblas_lerr = PASSED ;
@@ -821,6 +810,8 @@ void F77_c2chke(char *rout) {
    }
    if (cblas_ok == TRUE)
        printf(" %-12s PASSED THE TESTS OF ERROR-EXITS\n", cblas_rout);
-   else
+   else {
        printf("******* %s FAILED THE TESTS OF ERROR-EXITS *******\n",cblas_rout);
+       cblas_test_fail();
+   }
 }

ctest/c_c3chke.c

@@ -4,21 +4,14 @@
 #include "cblas_test.h"
 
 int cblas_ok, cblas_lerr, cblas_info;
-int link_xerbla=TRUE;
 char *cblas_rout;
 
-#ifdef F77_Char
-void F77_xerbla(F77_Char F77_srname, void *vinfo);
-#else
-void F77_xerbla(char *srname, void *vinfo);
-#endif
-
 void chkxer(void) {
    extern int cblas_ok, cblas_lerr, cblas_info;
-   extern int link_xerbla;
    extern char *cblas_rout;
    if (cblas_lerr == 1 ) {
-      printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %d NOT DETECTED BY %s *****\n", cblas_info, cblas_rout);
+      printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %lld NOT DETECTED BY %s *****\n",
+             (long long)cblas_info, cblas_rout);
       cblas_ok = 0 ;
    }
    cblas_lerr = 1 ;
@@ -39,11 +32,7 @@ void  F77_c3chke(char *  rout) {
    cblas_ok = TRUE ;
    cblas_lerr = PASSED ;
 
-   if (link_xerbla) /* call these first to link */
-   {
-      cblas_xerbla(cblas_info,cblas_rout,"");
-      F77_xerbla(cblas_rout,&cblas_info);
-   }
+   cblas_test_set_xerbla();
 
 
    if (strncmp( sf,"cblas_cgemm"   ,11)==0) {
@@ -1703,6 +1692,8 @@ void  F77_c3chke(char *  rout) {
 
    if (cblas_ok == 1 )
        printf(" %-12s PASSED THE TESTS OF ERROR-EXITS\n", cblas_rout);
-   else
+   else {
        printf("***** %s FAILED THE TESTS OF ERROR-EXITS *******\n",cblas_rout);
+       cblas_test_fail();
+   }
 }

ctest/c_c3chke_3m.c

@@ -4,21 +4,14 @@
 #include "cblas_test.h"
 
 int cblas_ok, cblas_lerr, cblas_info;
-int link_xerbla=TRUE;
 char *cblas_rout;
 
-#ifdef F77_Char
-void F77_xerbla(F77_Char F77_srname, void *vinfo);
-#else
-void F77_xerbla(char *srname, void *vinfo);
-#endif
-
 void chkxer(void) {
    extern int cblas_ok, cblas_lerr, cblas_info;
-   extern int link_xerbla;
    extern char *cblas_rout;
    if (cblas_lerr == 1 ) {
-      printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %d NOT DETECTED BY %s *****\n", cblas_info, cblas_rout);
+      printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %lld NOT DETECTED BY %s *****\n",
+             (long long)cblas_info, cblas_rout);
       cblas_ok = 0 ;
    }
    cblas_lerr = 1 ;
@@ -39,11 +32,7 @@ void  F77_c3chke(char *  rout) {
    cblas_ok = TRUE ;
    cblas_lerr = PASSED ;
 
-   if (link_xerbla) /* call these first to link */
-   {
-      cblas_xerbla(cblas_info,cblas_rout,"");
-      F77_xerbla(cblas_rout,&cblas_info);
-   }
+   cblas_test_set_xerbla();
 
 
    if (strncmp( sf,"cblas_cgemm3m"   ,13)==0) {
@@ -1931,6 +1920,8 @@ void  F77_c3chke(char *  rout) {
 
    if (cblas_ok == 1 )
        printf(" %-12s PASSED THE TESTS OF ERROR-EXITS\n", cblas_rout);
-   else
+   else {
        printf("***** %s FAILED THE TESTS OF ERROR-EXITS *******\n",cblas_rout);
+       cblas_test_fail();
+   }
 }

ctest/c_d2chke.c

@@ -4,21 +4,14 @@
 #include "cblas_test.h"
 
 int cblas_ok, cblas_lerr, cblas_info;
-int link_xerbla=TRUE;
 char *cblas_rout;
 
-#ifdef F77_Char
-void F77_xerbla(F77_Char F77_srname, void *vinfo);
-#else
-void F77_xerbla(char *srname, void *vinfo);
-#endif
-
 void chkxer(void) {
    extern int cblas_ok, cblas_lerr, cblas_info;
-   extern int link_xerbla;
    extern char *cblas_rout;
    if (cblas_lerr == 1 ) {
-      printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %d NOT DETECTED BY %s *****\n", cblas_info, cblas_rout);
+      printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %lld NOT DETECTED BY %s *****\n",
+             (long long)cblas_info, cblas_rout);
       cblas_ok = 0 ;
    }
    cblas_lerr = 1 ;
@@ -34,11 +27,7 @@ void F77_d2chke(char *rout) {
    extern int RowMajorStrg;
    extern char *cblas_rout;
 
-   if (link_xerbla) /* call these first to link */
-   {
-      cblas_xerbla(cblas_info,cblas_rout,"");
-      F77_xerbla(cblas_rout,&cblas_info);
-   }
+   cblas_test_set_xerbla();
 
    cblas_ok = TRUE ;
    cblas_lerr = PASSED ;
@@ -784,6 +773,8 @@ void F77_d2chke(char *rout) {
    }
    if (cblas_ok == TRUE)
        printf(" %-12s PASSED THE TESTS OF ERROR-EXITS\n", cblas_rout);
-   else
+   else {
        printf("******* %s FAILED THE TESTS OF ERROR-EXITS *******\n",cblas_rout);
+       cblas_test_fail();
+   }
 }

ctest/c_d3chke.c

@@ -4,21 +4,14 @@
 #include "cblas_test.h"
 
 int cblas_ok, cblas_lerr, cblas_info;
-int link_xerbla=TRUE;
 char *cblas_rout;
 
-#ifdef F77_Char
-void F77_xerbla(F77_Char F77_srname, void *vinfo);
-#else
-void F77_xerbla(char *srname, void *vinfo);
-#endif
-
 void chkxer(void) {
    extern int cblas_ok, cblas_lerr, cblas_info;
-   extern int link_xerbla;
    extern char *cblas_rout;
    if (cblas_lerr == 1 ) {
-      printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %d NOT DETECTED BY %s *****\n", cblas_info, cblas_rout);
+      printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %lld NOT DETECTED BY %s *****\n",
+             (long long)cblas_info, cblas_rout);
       cblas_ok = 0 ;
    }
    cblas_lerr = 1 ;
@@ -34,11 +27,7 @@ void F77_d3chke(char *rout) {
    extern int RowMajorStrg;
    extern char *cblas_rout;
 
-   if (link_xerbla) /* call these first to link */
-   {
-      cblas_xerbla(cblas_info,cblas_rout,"");
-      F77_xerbla(cblas_rout,&cblas_info);
-   }
+   cblas_test_set_xerbla();
 
    cblas_ok = TRUE ;
    cblas_lerr = PASSED ;
@@ -1266,6 +1255,8 @@ void F77_d3chke(char *rout) {
    }
    if (cblas_ok == TRUE )
        printf(" %-12s PASSED THE TESTS OF ERROR-EXITS\n", cblas_rout);
-   else
+   else {
        printf("***** %s FAILED THE TESTS OF ERROR-EXITS *******\n",cblas_rout);
+       cblas_test_fail();
+   }
 }

ctest/c_s2chke.c

@@ -4,21 +4,14 @@
 #include "cblas_test.h"
 
 int cblas_ok, cblas_lerr, cblas_info;
-int link_xerbla=TRUE;
 char *cblas_rout;
 
-#ifdef F77_Char
-void F77_xerbla(F77_Char F77_srname, void *vinfo);
-#else
-void F77_xerbla(char *srname, void *vinfo);
-#endif
-
 void chkxer(void) {
    extern int cblas_ok, cblas_lerr, cblas_info;
-   extern int link_xerbla;
    extern char *cblas_rout;
    if (cblas_lerr == 1 ) {
-      printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %d NOT DETECTED BY %s *****\n", cblas_info, cblas_rout);
+      printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %lld NOT DETECTED BY %s *****\n",
+             (long long)cblas_info, cblas_rout);
       cblas_ok = 0 ;
    }
    cblas_lerr = 1 ;
@@ -34,11 +27,7 @@ void F77_s2chke(char *rout) {
    extern int RowMajorStrg;
    extern char *cblas_rout;
 
-   if (link_xerbla) /* call these first to link */
-   {
-      cblas_xerbla(cblas_info,cblas_rout,"");
-      F77_xerbla(cblas_rout,&cblas_info);
-   }
+   cblas_test_set_xerbla();
 
    cblas_ok = TRUE ;
    cblas_lerr = PASSED ;
@@ -784,6 +773,8 @@ void F77_s2chke(char *rout) {
    }
    if (cblas_ok == TRUE)
        printf(" %-12s PASSED THE TESTS OF ERROR-EXITS\n", cblas_rout);
-   else
+   else {
        printf("******* %s FAILED THE TESTS OF ERROR-EXITS *******\n",cblas_rout);
+       cblas_test_fail();
+   }
 }

ctest/c_s3chke.c

@@ -4,21 +4,14 @@
 #include "cblas_test.h"
 
 int cblas_ok, cblas_lerr, cblas_info;
-int link_xerbla=TRUE;
 char *cblas_rout;
 
-#ifdef F77_Char
-void F77_xerbla(F77_Char F77_srname, void *vinfo);
-#else
-void F77_xerbla(char *srname, void *vinfo);
-#endif
-
 void chkxer(void) {
    extern int cblas_ok, cblas_lerr, cblas_info;
-   extern int link_xerbla;
    extern char *cblas_rout;
    if (cblas_lerr == 1 ) {
-      printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %d NOT DETECTED BY %s *****\n", cblas_info, cblas_rout);
+      printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %lld NOT DETECTED BY %s *****\n",
+             (long long)cblas_info, cblas_rout);
       cblas_ok = 0 ;
    }
    cblas_lerr = 1 ;
@@ -34,11 +27,7 @@ void F77_s3chke(char *rout) {
    extern int RowMajorStrg;
    extern char *cblas_rout;
 
-   if (link_xerbla) /* call these first to link */
-   {
-      cblas_xerbla(cblas_info,cblas_rout,"");
-      F77_xerbla(cblas_rout,&cblas_info);
-   }
+   cblas_test_set_xerbla();
 
    cblas_ok = TRUE ;
    cblas_lerr = PASSED ;
@@ -1268,6 +1257,8 @@ void F77_s3chke(char *rout) {
    }
    if (cblas_ok == TRUE )
        printf(" %-12s PASSED THE TESTS OF ERROR-EXITS\n", cblas_rout);
-   else
+   else {
        printf("***** %s FAILED THE TESTS OF ERROR-EXITS *******\n",cblas_rout);
+       cblas_test_fail();
+   }
 }

ctest/c_xerbla.c

@@ -1,4 +1,5 @@
 #include <stdio.h>
+#include <stdlib.h>
 #include <ctype.h>
 #include <stdarg.h>
 #include <string.h>
@@ -8,17 +9,9 @@
 void cblas_xerbla(blasint info, char *rout, char *form, ...)
 {
    extern int cblas_lerr, cblas_info, cblas_ok;
-   extern int link_xerbla;
    extern int RowMajorStrg;
    extern char *cblas_rout;
 
-   /* Initially, c__3chke will call this routine with
-    * global variable link_xerbla=1, and F77_xerbla will set link_xerbla=0.
-    * This is done to fool the linker into loading these subroutines first
-    * instead of ones in the CBLAS or the legacy BLAS library.
-    */
-   if (link_xerbla) return;
-
    if (cblas_rout != NULL && strcmp(cblas_rout, rout) != 0){
       printf("***** XERBLA WAS CALLED WITH SRNAME = <%s> INSTEAD OF <%s> *******\n", rout, cblas_rout);
       cblas_ok = FALSE;
@@ -78,44 +71,27 @@ void cblas_xerbla(blasint info, char *rout, char *form, ...)
    }
 
    if (info != cblas_info){
-      printf("***** XERBLA WAS CALLED WITH INFO = %d INSTEAD OF %d in %s *******\n",info, cblas_info, rout);
+      printf("***** XERBLA WAS CALLED WITH INFO = %lld INSTEAD OF %lld in %s *******\n",
+             (long long)info, (long long)cblas_info, rout);
       cblas_lerr = PASSED;
       cblas_ok = FALSE;
    } else cblas_lerr = FAILED;
 }
 
-#ifdef F77_Char
-void F77_xerbla(F77_Char F77_srname, void *vinfo)
-#else
-void F77_xerbla(char *srname, void *vinfo)
-#endif
+static void cblas_test_xerbla(const char *srname, const blasint *info,
+                              size_t length)
 {
-#ifdef F77_Char
-   char *srname;
-#endif
-
+   extern int cblas_ok;
    char rout[] = {'c','b','l','a','s','_','\0','\0','\0','\0','\0','\0','\0'};
+   blasint i;
 
-#ifdef F77_Integer
-   F77_Integer *info=vinfo;
-   F77_Integer i;
-   extern F77_Integer link_xerbla;
-#else
-   int *info=vinfo;
-   int i;
-   extern int link_xerbla;
-#endif
-#ifdef F77_Char
-   srname = F2C_STR(F77_srname, XerblaStrLen);
-#endif
-
-   /* See the comment in cblas_xerbla() above */
-   if (link_xerbla)
-   {
-      link_xerbla = 0;
+   if (length < 6) {
+      printf("***** XERBLA WAS CALLED WITH AN INVALID ROUTINE NAME LENGTH *******\n");
+      cblas_ok = FALSE;
       return;
    }
-   for(i=0;  i  < 6; i++) rout[i+6] = tolower(srname[i]);
+
+   for(i=0;  i  < 6; i++) rout[i+6] = tolower((unsigned char)srname[i]);
    for(i=11; i >= 9; i--) if (rout[i] == ' ') rout[i] = '\0';
 
    /* We increment *info by 1 since the CBLAS interface adds one more
@@ -124,14 +100,10 @@ void F77_xerbla(char *srname, void *vinfo)
    cblas_xerbla(*info+1,rout,"");
 }
 
-#ifdef USE64BITINT
-#undef int
-#endif
-
-int    BLASFUNC(xerbla)(char *name, blasint *info, blasint length) {
-
-  F77_xerbla(name, info);
-  return 0;
-};
-
+void cblas_test_set_xerbla(void) {
+   openblas_set_xerbla(cblas_test_xerbla);
+}
 
+void cblas_test_fail(void) {
+   exit(EXIT_FAILURE);
+}

ctest/c_z2chke.c

@@ -4,21 +4,14 @@
 #include "cblas_test.h"
 
 int cblas_ok, cblas_lerr, cblas_info;
-int link_xerbla=TRUE;
 char *cblas_rout;
 
-#ifdef F77_Char
-void F77_xerbla(F77_Char F77_srname, void *vinfo);
-#else
-void F77_xerbla(char *srname, void *vinfo);
-#endif
-
 void chkxer(void) {
    extern int cblas_ok, cblas_lerr, cblas_info;
-   extern int link_xerbla;
    extern char *cblas_rout;
    if (cblas_lerr == 1 ) {
-      printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %d NOT DETECTED BY %s *****\n", cblas_info, cblas_rout);
+      printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %lld NOT DETECTED BY %s *****\n",
+             (long long)cblas_info, cblas_rout);
       cblas_ok = 0 ;
    }
    cblas_lerr = 1 ;
@@ -36,11 +29,7 @@ void F77_z2chke(char *rout) {
    extern int RowMajorStrg;
    extern char *cblas_rout;
 
-   if (link_xerbla) /* call these first to link */
-   {
-      cblas_xerbla(cblas_info,cblas_rout,"");
-      F77_xerbla(cblas_rout,&cblas_info);
-   }
+   cblas_test_set_xerbla();
 
    cblas_ok = TRUE ;
    cblas_lerr = PASSED ;
@@ -821,6 +810,8 @@ void F77_z2chke(char *rout) {
    }
    if (cblas_ok == TRUE)
        printf(" %-12s PASSED THE TESTS OF ERROR-EXITS\n", cblas_rout);
-   else
+   else {
        printf("******* %s FAILED THE TESTS OF ERROR-EXITS *******\n",cblas_rout);
+       cblas_test_fail();
+   }
 }

ctest/c_z3chke.c

@@ -4,21 +4,14 @@
 #include "cblas_test.h"
 
 int cblas_ok, cblas_lerr, cblas_info;
-int link_xerbla=TRUE;
 char *cblas_rout;
 
-#ifdef F77_Char
-void F77_xerbla(F77_Char F77_srname, void *vinfo);
-#else
-void F77_xerbla(char *srname, void *vinfo);
-#endif
-
 void chkxer(void) {
    extern int cblas_ok, cblas_lerr, cblas_info;
-   extern int link_xerbla;
    extern char *cblas_rout;
    if (cblas_lerr == 1 ) {
-      printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %d NOT DETECTED BY %s *****\n", cblas_info, cblas_rout);
+      printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %lld NOT DETECTED BY %s *****\n",
+             (long long)cblas_info, cblas_rout);
       cblas_ok = 0 ;
    }
    cblas_lerr = 1 ;
@@ -39,11 +32,7 @@ void  F77_z3chke(char *  rout) {
    cblas_ok = TRUE ;
    cblas_lerr = PASSED ;
 
-   if (link_xerbla) /* call these first to link */
-   {
-      cblas_xerbla(cblas_info,cblas_rout,"");
-      F77_xerbla(cblas_rout,&cblas_info);
-   }
+   cblas_test_set_xerbla();
 
 
 
@@ -1705,6 +1694,8 @@ void  F77_z3chke(char *  rout) {
 
    if (cblas_ok == 1 )
        printf(" %-12s PASSED THE TESTS OF ERROR-EXITS\n", cblas_rout);
-   else
+   else {
        printf("***** %s FAILED THE TESTS OF ERROR-EXITS *******\n",cblas_rout);
+       cblas_test_fail();
+   }
 }

ctest/c_z3chke_3m.c

@@ -4,21 +4,14 @@
 #include "cblas_test.h"
 
 int cblas_ok, cblas_lerr, cblas_info;
-int link_xerbla=TRUE;
 char *cblas_rout;
 
-#ifdef F77_Char
-void F77_xerbla(F77_Char F77_srname, void *vinfo);
-#else
-void F77_xerbla(char *srname, void *vinfo);
-#endif
-
 void chkxer(void) {
    extern int cblas_ok, cblas_lerr, cblas_info;
-   extern int link_xerbla;
    extern char *cblas_rout;
    if (cblas_lerr == 1 ) {
-      printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %d NOT DETECTED BY %s *****\n", cblas_info, cblas_rout);
+      printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %lld NOT DETECTED BY %s *****\n",
+             (long long)cblas_info, cblas_rout);
       cblas_ok = 0 ;
    }
    cblas_lerr = 1 ;
@@ -39,11 +32,7 @@ void  F77_z3chke(char *  rout) {
    cblas_ok = TRUE ;
    cblas_lerr = PASSED ;
 
-   if (link_xerbla) /* call these first to link */
-   {
-      cblas_xerbla(cblas_info,cblas_rout,"");
-      F77_xerbla(cblas_rout,&cblas_info);
-   }
+   cblas_test_set_xerbla();
 
 
 
@@ -1935,6 +1924,8 @@ void  F77_z3chke(char *  rout) {
 
    if (cblas_ok == 1 )
        printf(" %-12s PASSED THE TESTS OF ERROR-EXITS\n", cblas_rout);
-   else
+   else {
        printf("***** %s FAILED THE TESTS OF ERROR-EXITS *******\n",cblas_rout);
+       cblas_test_fail();
+   }
 }

ctest/cblas_test.h

@@ -30,6 +30,9 @@
 #define  INVALID       -1
 #define  UNDEFINED     -1
 
+void cblas_test_set_xerbla(void);
+void cblas_test_fail(void);
+
 typedef struct { float real; float imag; } CBLAS_TEST_COMPLEX;
 typedef struct { double real; double imag; } CBLAS_TEST_ZOMPLEX;
 

docs/build_system.md

@@ -143,9 +143,8 @@ ensures that there are a sufficient number of buffer sets available.
   no symbolic linking to variant names (default is `0`)
 - `LIBNAMEPREFIX`: prefix that, if given, will be inserted in the library name
   before `openblas` (e.g., `xxx` will result in `libxxxopenblas.so`)
-- `LIBNAMESUFFIX`: suffix that, if given, will be inserted in the library name
-  after `openblas`, separated by an underscore (e.g., `yyy` will result in
-  `libopenblas_yyy.so`)
+- `LIBNAMESUFFIX`: suffix that, if given, will be appended to the library name
+  after `openblas` (e.g., `_yyy` will result in `libopenblas_yyy.so`)
 - `SYMBOLPREFIX`: prefix that, if given, will be added to all symbol names
   *and* to the library name
 - `SYMBOLSUFFIX`: suffix that, if given, will be added to all symbol names

docs/extensions.md

@@ -47,3 +47,7 @@ BLAS-like and conversion functions for `hfloat16` (available when OpenBLAS was c
 * `int openblas_set_affinity(int thread_index, size_t cpusetsize, cpu_set_t *cpuset)` sets the CPU affinity mask of the given thread
   to the provided cpuset. Only available on Linux, with semantics identical to `pthread_setaffinity_np`.
 * `openblas_set_thread_callback_function` overrides the default multithreading backend with the provided argument
+* `openblas_set_xerbla(openblas_xerbla_handler handler)` replaces the XERBLA handler for the current OpenBLAS
+  instance and returns the previous handler; passing `NULL` restores the default. Callbacks may be invoked concurrently
+  and therefore must be thread-safe. `name` is valid for `name_length` bytes during the callback and need not be
+  NUL-terminated. On ELF platforms, an application-provided strong `xerbla` symbol bypasses the registered handler.

driver/level2/tpmv_thread.c

@@ -71,7 +71,7 @@
 
 static int tpmv_kernel(blas_arg_t *args, BLASLONG *range_m, BLASLONG *range_n, FLOAT *dummy1, FLOAT *buffer, BLASLONG pos){
 
-  FLOAT *a, *x, *y;
+  volatile FLOAT *a, *x, *y;
 
   BLASLONG incx;
   BLASLONG m_from, m_to;

driver/level3/syr2k_kernel.c

@@ -47,7 +47,7 @@ int CNAME(BLASLONG m, BLASLONG n, BLASLONG k, FLOAT alpha_r,
 
   BLASLONG i, j;
   BLASLONG loop;
-  FLOAT subbuffer[GEMM_UNROLL_MN * GEMM_UNROLL_MN * COMPSIZE];
+  volatile FLOAT subbuffer[GEMM_UNROLL_MN * GEMM_UNROLL_MN * COMPSIZE];
 
   if (m + offset < 0) {
 #ifndef LOWER

driver/others/blas_server_omp.c

@@ -70,6 +70,7 @@
 int blas_server_avail = 0;
 int blas_omp_number_max = 0;
 int blas_omp_threads_local = 1;
+int blas_is_num_threads_set_explicitly = 0; // tracks whether the user called openblas_set_num_threads()
 
 extern int openblas_omp_adaptive_env(void);
 
@@ -118,7 +119,7 @@ void goto_set_num_threads(int num_threads) {
 
 }
 void openblas_set_num_threads(int num_threads) {
-
+	blas_is_num_threads_set_explicitly = 1;
 	goto_set_num_threads(num_threads);
 }
 
@@ -141,7 +142,7 @@ extern int openblas_omp_num_threads_env(void);
 
    if(blas_omp_number_max <= 0)
 	   blas_omp_number_max= openblas_omp_num_threads_env();
-   if (blas_omp_number_max <= 0) 
+   if (blas_omp_number_max <= 0)
 	   blas_omp_number_max=MAX_CPU_NUMBER;
 #else
     blas_omp_number_max = omp_get_max_threads();
@@ -361,14 +362,14 @@ static void exec_threads(int thread_num, blas_queue_t *queue, int buf_index){
 #ifdef BUILD_COMPLEX16
 	    sb = (void *)(((BLASLONG)sa + ((ZGEMM_P * ZGEMM_Q * 2 * sizeof(double)
 					    + GEMM_ALIGN) & ~GEMM_ALIGN)) + GEMM_OFFSET_B);
-#else 
+#else
 fprintf(stderr,"UNHANDLED COMPLEX16\n");
 #endif
 	  } else if ((queue -> mode & BLAS_PREC) == BLAS_SINGLE) {
 #ifdef BUILD_COMPLEX
 	    sb = (void *)(((BLASLONG)sa + ((CGEMM_P * CGEMM_Q * 2 * sizeof(float)
 					    + GEMM_ALIGN) & ~GEMM_ALIGN)) + GEMM_OFFSET_B);
-#else 
+#else
 fprintf(stderr,"UNHANDLED COMPLEX\n");
 #endif
 	  } else {

driver/others/memory.c

@@ -1220,7 +1220,7 @@ UNLOCK_COMMAND(&alloc_lock);
       if (!blas_num_threads) blas_cpu_number = blas_get_cpu_number();
 #endif
 
-#if defined(ARCH_X86) || defined(ARCH_X86_64) || defined(ARCH_IA64) || defined(ARCH_MIPS64) || defined(ARCH_ARM64) || defined(ARCH_LOONGARCH64)
+#if defined(ARCH_X86) || defined(ARCH_X86_64) || defined(ARCH_IA64) || defined(ARCH_MIPS64) || defined(ARCH_ARM64) || defined(ARCH_LOONGARCH64) || defined(ARCH_RISCV64)
 #ifndef DYNAMIC_ARCH
       blas_set_parameter();
 #endif
@@ -2822,7 +2822,7 @@ void *blas_memory_alloc(int procpos){
     if (!blas_num_threads) blas_cpu_number = blas_get_cpu_number();
 #endif
 
-#if defined(ARCH_X86) || defined(ARCH_X86_64) || defined(ARCH_IA64) || defined(ARCH_MIPS64) || defined(ARCH_ARM64) || defined(ARCH_LOONGARCH64)
+#if defined(ARCH_X86) || defined(ARCH_X86_64) || defined(ARCH_IA64) || defined(ARCH_MIPS64) || defined(ARCH_ARM64) || defined(ARCH_LOONGARCH64) || defined(ARCH_RISCV64)
 #ifndef DYNAMIC_ARCH
     blas_set_parameter();
 #endif

driver/others/parameter.c

@@ -902,3 +902,53 @@ void blas_set_parameter(void)
 }
 
 #endif
+
+#if defined(ARCH_RISCV64)
+
+#include <stdio.h>
+
+/* RISC-V has no architectural cache-size query (cf. x86 CPUID / LoongArch
+   CPUCFG), so read the L2 (level 2, unified) size from Linux sysfs and fall
+   back to 512 KB. Returns the L2 size in kilobytes. */
+int get_L2_size(void) {
+  int size = 0;
+#if defined(OS_LINUX) || defined(OS_ANDROID)
+  int idx;
+  for (idx = 0; idx <= 4; idx++) {
+    char path[80]; FILE *fp; int level = 0; long val = 0; char unit = 0;
+    snprintf(path, sizeof(path), "/sys/devices/system/cpu/cpu0/cache/index%d/level", idx);
+    fp = fopen(path, "r"); if (fp == NULL) continue;
+    if (fscanf(fp, "%d", &level) != 1) { fclose(fp); continue; }
+    fclose(fp); if (level != 2) continue;
+    snprintf(path, sizeof(path), "/sys/devices/system/cpu/cpu0/cache/index%d/size", idx);
+    fp = fopen(path, "r"); if (fp == NULL) continue;
+    if (fscanf(fp, "%ld%c", &val, &unit) >= 1) {
+      if (unit == 'M' || unit == 'm') val *= 1024;
+      if (unit == 'G' || unit == 'g') val *= 1024 * 1024;
+      size = (int)val;
+    }
+    fclose(fp); if (size > 0) break;
+  }
+#endif
+  if (size <= 0) size = 512;
+  return size;
+}
+
+void blas_set_parameter(void) {
+#if defined(SGEMM_DEFAULT_P_BASE)
+  /* Scale each precision's packed-A dimension P from the detected L2, relative
+     to the size the active core's base blocking targets (RISCV_L2_REFERENCE_KB).
+     The bases come from the core's own param.h block, so this is not tied to any
+     single core; Q and R keep their param.h defaults. */
+  int l2    = get_L2_size();   /* KB */
+  int scale = l2 / RISCV_L2_REFERENCE_KB;
+  if (scale < 1) scale = 1;
+  if (scale > 4) scale = 4;
+  sgemm_p = SGEMM_DEFAULT_P_BASE * scale;
+  dgemm_p = DGEMM_DEFAULT_P_BASE * scale;
+  cgemm_p = CGEMM_DEFAULT_P_BASE * scale;
+  zgemm_p = ZGEMM_DEFAULT_P_BASE * scale;
+#endif
+}
+
+#endif

driver/others/xerbla.c

@@ -36,8 +36,10 @@
 /* or implied, of The University of Texas at Austin.                 */
 /*********************************************************************/
 
+#include <limits.h>
 #include <stdio.h>
 #include <stdlib.h>
+#include <string.h>
 #include "common.h"
 
 #if defined(OS_WINDOWS) && (defined(__MINGW32__) || defined(__MINGW64__))
@@ -46,31 +48,67 @@
 #define printf	_cprintf
 #endif
 
-#ifdef INTERFACE64
-#define MSGFMT " ** On entry to %6s parameter number %2ld had an illegal value\n" 
-#else
-#define MSGFMT " ** On entry to %6s parameter number %2d had an illegal value\n"
-#endif
+#define MSGFMT " ** On entry to %6.*s parameter number %2lld had an illegal value\n"
+
+static size_t openblas_xerbla_name_length(const char *message,
+                                          blasint length) {
+  const char *terminator;
+
+  if (message == NULL || length <= 0) return 0;
+
+  terminator = memchr(message, '\0', (size_t)length);
+  if (terminator != NULL) return (size_t)(terminator - message);
+
+  return (size_t)length;
+}
+
+static void openblas_xerbla_default(const char *message, const blasint *info,
+                                    size_t length) {
+  int precision = length > INT_MAX ? INT_MAX : (int)length;
+
+  printf(MSGFMT, precision, message == NULL ? "" : message,
+         (long long)*info);
+}
+
+static openblas_xerbla_handler openblas_xerbla = openblas_xerbla_default;
+static volatile BLASULONG openblas_xerbla_lock = 0;
+
+openblas_xerbla_handler
+openblas_set_xerbla(openblas_xerbla_handler handler) {
+  openblas_xerbla_handler previous;
+
+  if (handler == NULL) handler = openblas_xerbla_default;
+
+  blas_lock(&openblas_xerbla_lock);
+  previous = openblas_xerbla;
+  openblas_xerbla = handler;
+  blas_unlock(&openblas_xerbla_lock);
+
+  return previous;
+}
+
+static int openblas_xerbla_dispatch(char *message, blasint *info,
+                                    blasint length) {
+  openblas_xerbla_handler handler;
+  size_t name_length = openblas_xerbla_name_length(message, length);
+
+  blas_lock(&openblas_xerbla_lock);
+  handler = openblas_xerbla;
+  blas_unlock(&openblas_xerbla_lock);
+
+  handler(message, info, name_length);
+  return 0;
+}
 
 #ifdef __ELF__
-int __xerbla(char *message, blasint *info, blasint length){
-
-  printf(MSGFMT,
-	  message, *info);
-
-  return 0;
+int __xerbla(char *message, blasint *info, blasint length) {
+  return openblas_xerbla_dispatch(message, info, length);
 }
 
-int BLASFUNC(xerbla)(char *, blasint *, blasint) __attribute__ ((weak, alias ("__xerbla")));
-
+int BLASFUNC(xerbla)(char *, blasint *, blasint)
+  __attribute__ ((weak, alias ("__xerbla")));
 #else
-
-int BLASFUNC(xerbla)(char *message, blasint *info, blasint length){
-
-  printf(MSGFMT,
-	  message, *info);
-
-  return 0;
+int BLASFUNC(xerbla)(char *message, blasint *info, blasint length) {
+  return openblas_xerbla_dispatch(message, info, length);
 }
-
 #endif

exports/gensymbol

@@ -182,6 +182,7 @@ misc_no_underscore_objs="
     openblas_get_config
     openblas_get_corename
     openblas_set_threads_callback_function
+    openblas_set_xerbla
 "
 
 misc_underscore_objs=""
@@ -4111,10 +4112,13 @@ case "$p1" in
         done
 
         for obj in $no_underscore_objs; do
+            [ "$obj" = "openblas_set_xerbla" ] && continue
             printf '\t%s%s%s=%s  @%s\n' \
                 "$symbolprefix" "$obj" "$symbolsuffix" "$obj" "$count"
             count=`expr $count + 1`
         done
+        printf '\t%sopenblas_set_xerbla%s=openblas_set_xerbla  @%s\n' \
+            "$symbolprefix" "$symbolsuffix" "$count"
     ;;
 
     win2khpl)

exports/gensymbol.pl

@@ -178,6 +178,7 @@
     openblas_get_config,
     openblas_get_corename,
     openblas_set_threads_callback_function,
+    openblas_set_xerbla,
 );
 
 @misc_underscore_objs = (
@@ -4053,9 +4054,11 @@ if ($ARGV[0] eq "win2k"){
 
 
     foreach $objs (@no_underscore_objs) {
+        next if $objs eq "openblas_set_xerbla";
         print "\t",$symbolprefix,$objs,$symbolsuffix,"=$objs","  \@", $count, "\n";
         $count ++;
     }
+    print "\t",$symbolprefix,"openblas_set_xerbla",$symbolsuffix,"=openblas_set_xerbla  \@",$count,"\n";
 
     exit(0);
 }

getarch.c

@@ -1232,6 +1232,20 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 #else
 #endif
 
+#ifdef FORCE_U74
+#define FORCE
+#define ARCHITECTURE    "RISCV64"
+#define SUBARCHITECTURE "U74"
+#define SUBDIRNAME      "riscv64"
+#define ARCHCONFIG   "-DU74 " \
+       "-DL1_DATA_SIZE=32768 -DL1_DATA_LINESIZE=64 " \
+       "-DL2_SIZE=2097152 -DL2_LINESIZE=64 " \
+       "-DDTB_DEFAULT_ENTRIES=128 -DDTB_SIZE=4096 -DL2_ASSOCIATIVE=16 "
+#define LIBNAME   "u74"
+#define CORENAME  "U74"
+#else
+#endif
+
 #ifdef FORCE_WASM128_GENERIC
 #define FORCE
 #define ARCHITECTURE    "WASM"

interface/geadd.c

@@ -51,7 +51,7 @@
 #ifndef CBLAS
 
 void NAME(blasint *M, blasint *N, FLOAT *ALPHA, FLOAT *a, blasint *LDA,
-		                  FLOAT *BETA,  FLOAT *c, blasint *LDC)
+                        FLOAT *BETA,  FLOAT *c, blasint *LDC, char *TRANS_A,char *TRANS_C)
 {
 
   blasint m = *M;
@@ -62,14 +62,31 @@ void NAME(blasint *M, blasint *N, FLOAT *ALPHA, FLOAT *a, blasint *LDA,
   FLOAT beta  = *BETA;
 
   blasint info;
+char transa = (*TRANS_A == 'T') || (*TRANS_A == 't') || (*TRANS_A == 'C') || (*TRANS_A == 'c');
+char transc = (*TRANS_C == 'T') || (*TRANS_C == 't') || (*TRANS_C == 'C') || (*TRANS_C == 'c');
+
 
   PRINT_DEBUG_NAME;
 
   info = 0;
+ if(transa){
+  if (lda < MAX(1, n))info = 5;
 
 
-  if (lda < MAX(1, m))	info = 5;
-  if (ldc < MAX(1, m))	info = 8;
+  }	else{
+
+   if (lda < MAX(1, m))	info = 5;
+  }
+ 
+
+  if(transc){
+        if (ldc < MAX(1, n))	info = 8;
+
+
+   }else{
+       
+      if (ldc < MAX(1, m))	info = 8;
+          }
 
   if (n < 0)		info = 2;
   if (m < 0)		info = 1;
@@ -80,7 +97,7 @@ void NAME(blasint *M, blasint *N, FLOAT *ALPHA, FLOAT *a, blasint *LDA,
   }
 
 #else
-void CNAME( enum CBLAS_ORDER order, blasint m,  blasint n,  FLOAT alpha, FLOAT *a,  blasint lda, FLOAT beta, 
+void CNAME( enum CBLAS_ORDER order,enum CBLAS_TRANSPOSE transa, enum CBLAS_TRANSPOSE transc,blasint m,  blasint n,  FLOAT alpha, FLOAT *a,  blasint lda, FLOAT beta, 
 		  FLOAT *c,  blasint ldc)
 {
 /* 
@@ -100,9 +117,17 @@ void CNAME(enum CBLAS_ORDER order,
   if (order == CblasColMajor) {
 
     info = -1;
+if ( (transc == CblasNoTrans) || (transc == CblasConjNoTrans) ) {
+      if (ldc < MAX(1, m))  info = 8;
+    } else {
+      if (ldc < MAX(1, n))  info = 8;
+    }
 
-    if (ldc < MAX(1, m))  info = 8;
-    if (lda < MAX(1, m))  info = 5;
+    if ( (transa == CblasNoTrans) || (transa == CblasConjNoTrans) ) {
+      if (lda < MAX(1, m))  info = 5;
+    } else {
+      if (lda < MAX(1, n))  info = 5;
+    }
     if (n < 0)		  info = 2;
     if (m < 0)		  info = 1;
 
@@ -115,8 +140,17 @@ void CNAME(enum CBLAS_ORDER order,
     n = m;
     m = t;
 
-    if (ldc < MAX(1, m))  info = 8;
-    if (lda < MAX(1, m))  info = 5;
+if ( (transc == CblasNoTrans) || (transc == CblasConjNoTrans) ) {
+      if (ldc < MAX(1, m))  info = 8;
+    } else {
+      if (ldc < MAX(1, n))  info = 8;
+    }
+
+    if ( (transa == CblasNoTrans) || (transa == CblasConjNoTrans) ) {
+      if (lda < MAX(1, m))  info = 5;
+    } else {
+      if (lda < MAX(1, n))  info = 5;
+    }
     if (n < 0)		  info = 1;
     if (m < 0)		  info = 2;
   }
@@ -136,7 +170,14 @@ void CNAME(enum CBLAS_ORDER order,
   FUNCTION_PROFILE_START();
 
 
-  GEADD_K(m,n,alpha, a, lda, beta, c, ldc); 
+  GEADD_K(m,n,alpha, a, lda, beta, c, ldc,
+#ifdef CBLAS
+          (transa == CblasTrans) || (transa == CblasConjTrans),
+          (transc == CblasTrans) || (transc == CblasConjTrans)
+#else
+          transa, transc
+#endif
+          ); 
 
 
   FUNCTION_PROFILE_END(1, 2* m * n ,  2 * m * n);

interface/zgeadd.c

@@ -51,7 +51,7 @@
 #ifndef CBLAS
 
 void NAME(blasint *M, blasint *N, FLOAT *ALPHA, FLOAT *a, blasint *LDA,
-		                  FLOAT *BETA,  FLOAT *c, blasint *LDC)
+		                  FLOAT *BETA,  FLOAT *c, blasint *LDC,char *TRANS_A,char *TRANS_C)
 {
 
   blasint m = *M;
@@ -60,14 +60,34 @@ void NAME(blasint *M, blasint *N, FLOAT *ALPHA, FLOAT *a, blasint *LDA,
   blasint ldc = *LDC; 
 
   blasint info;
+char transa = (*TRANS_A == 'T') || (*TRANS_A == 't') || (*TRANS_A == 'C') || (*TRANS_A == 'c');
+char transc = (*TRANS_C == 'T') || (*TRANS_C == 't') || (*TRANS_C == 'C') || (*TRANS_C == 'c');
+
 
   PRINT_DEBUG_NAME;
 
   info = 0;
 
 
-  if (lda < MAX(1, m))	info = 5;
-  if (ldc < MAX(1, m))	info = 8;
+if(transa){
+  if (lda < MAX(1, n))info = 5;
+
+
+  }	else{
+
+   if (lda < MAX(1, m))	info = 5;
+  }
+ 
+
+  if(transc){
+        if (ldc < MAX(1, n))	info = 8;
+
+
+   }else{
+       
+      if (ldc < MAX(1, m))	info = 8;
+          }
+
 
   if (n < 0)		info = 2;
   if (m < 0)		info = 1;
@@ -78,7 +98,7 @@ void NAME(blasint *M, blasint *N, FLOAT *ALPHA, FLOAT *a, blasint *LDA,
   }
 
 #else
-void CNAME( enum CBLAS_ORDER order, blasint m,  blasint n,  FLOAT *ALPHA, FLOAT *a,  blasint lda, FLOAT *BETA, 
+void CNAME( enum CBLAS_ORDER order,enum CBLAS_TRANSPOSE transa, enum CBLAS_TRANSPOSE transc, blasint m,  blasint n,  FLOAT *ALPHA, FLOAT *a,  blasint lda, FLOAT *BETA, 
 		  FLOAT *c,  blasint ldc)
 {
 /* 
@@ -99,11 +119,19 @@ void CNAME(enum CBLAS_ORDER order,
 
     info = -1;
 
-    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 ( (transc == CblasNoTrans) || (transc == CblasConjNoTrans) ) {
+      if (ldc < MAX(1, m))  info = 8;
+    } else {
+      if (ldc < MAX(1, n))  info = 8;
+    }
 
+    if ( (transa == CblasNoTrans) || (transa == CblasConjNoTrans) ) {
+      if (lda < MAX(1, m))  info = 5;
+    } else {
+      if (lda < MAX(1, n))  info = 5;
+    }
+    if (n < 0)		  info = 2;
+    if (m < 0)		  info = 1;  
   }
 
   if (order == CblasRowMajor) {
@@ -112,13 +140,24 @@ void CNAME(enum CBLAS_ORDER order,
     t = n;
     n = m;
     m = t;
+if ( (transc == CblasNoTrans) || (transc == CblasConjNoTrans) ) {
+      if (ldc < MAX(1, m))  info = 8;
+    } else {
+      if (ldc < MAX(1, n))  info = 8;
+    }
 
-    if (ldc < MAX(1, m))  info = 8;
-    if (lda < MAX(1, m))  info = 5;
+    if ( (transa == CblasNoTrans) || (transa == CblasConjNoTrans) ) {
+      if (lda < MAX(1, m))  info = 5;
+    } else {
+      if (lda < MAX(1, n))  info = 5;
+    }
     if (n < 0)		  info = 1;
     if (m < 0)		  info = 2;
   }
 
+ 
+  
+
   if (info >= 0) {
     BLASFUNC(xerbla)(ERROR_NAME, &info, sizeof(ERROR_NAME));
     return;
@@ -134,7 +173,18 @@ void CNAME(enum CBLAS_ORDER order,
   FUNCTION_PROFILE_START();
 
 
-  GEADD_K(m,n,ALPHA[0],ALPHA[1], a, lda, BETA[0], BETA[1], c, ldc); 
+  GEADD_K(m,n,ALPHA[0],ALPHA[1], a, lda, BETA[0], BETA[1], c, ldc,
+        
+          #ifdef CBLAS
+          (transa == CblasTrans) || (transa == CblasConjTrans),
+          (transc == CblasTrans) || (transc == CblasConjTrans)
+#else
+          transa, transc
+#endif
+          );
+
+
+           
 
 
   FUNCTION_PROFILE_END(1, 2* m * n ,  2 * m * n);

kernel/arm64/dot_kernel_asimd.c

@@ -262,16 +262,15 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
 static RETURN_TYPE dot_kernel_asimd(BLASLONG n, FLOAT *x, BLASLONG inc_x, FLOAT *y, BLASLONG inc_y)
 {
-#ifndef DOUBLE
-    volatile
-#endif
+
     RETURN_TYPE  dot = 0.0;
 	BLASLONG j = 0;
 
 	__asm__ __volatile__ (
 	"	fmov	"OUT", "REG0"			\n"
+	"	fmov	d0, xzr				\n"
 	"	fmov	d1, xzr				\n"
-	"	fmov	d2, xzr				\n"
+    "	fmov	d2, xzr				\n"
 	"	fmov	d3, xzr				\n"
 	"	fmov	d4, xzr				\n"
 	"	fmov	d5, xzr				\n"
@@ -342,7 +341,10 @@ static RETURN_TYPE dot_kernel_asimd(BLASLONG n, FLOAT *x, BLASLONG inc_x, FLOAT
           [J_]    "r"   (j)
 	: "cc",
 	  "memory",
-	  "d1", "d2", "d3", "d4", "d5", "d6", "d7"
+	  "d0", "d1", "d2", "d3", "d4", "d5", "d6", "d7",
+	  "v16", "v17", "v18", "v19", "v20", "v21", "v22",
+	  "v23", "v24", "v25", "v26", "v27", "v28", "v29",
+	  "v30", "v31"
 	);
 
 	return dot;

kernel/generic/geadd.c

@@ -17,48 +17,73 @@ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
 AND ANY EXPRESS OR IMPLIED 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.
+LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
+GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+LIABILITY, OR TORT (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"
 
+int CNAME(BLASLONG rows, BLASLONG cols, FLOAT alpha, FLOAT *a, BLASLONG lda,
+          FLOAT beta, FLOAT *b, BLASLONG ldb, BLASLONG transa,
+          BLASLONG transb) {
+  BLASLONG i;
+  FLOAT *aptr, *bptr;
 
-int CNAME(BLASLONG rows, BLASLONG cols, FLOAT alpha, FLOAT *a, BLASLONG lda, FLOAT beta, FLOAT *b, BLASLONG ldb)
-{
-	BLASLONG i;
-	FLOAT *aptr,*bptr;
+  if (rows <= 0)
+    return (0);
+  if (cols <= 0)
+    return (0);
 
-	if ( rows <= 0     )  return(0);
-	if ( cols <= 0     )  return(0);
+  aptr = a;
+  bptr = b;
 
-	
-	aptr = a;
-	bptr = b;
+  if (alpha == 0.0) {
+    if (!transb) {
+      for (i = 0; i < cols; i++) {
 
-	if ( alpha == 0.0 )
-	{
-		for ( i=0; i<cols ; i++ )
-		{
-			SCAL_K(rows, 0,0, beta, bptr, 1,  NULL, 0,NULL,0); 
-			bptr+=ldb; 
-		}
+        SCAL_K(rows, 0, 0, beta, bptr, 1, NULL, 0, NULL, 0);
+        bptr += ldb;
+      }
+    } else {
+      for (i = 0; i < cols; i++) {
 
-		return(0);
-	}
+        SCAL_K(rows, 0, 0, beta, bptr, ldb, NULL, 0, NULL, 0);
+        bptr += 1;
+      }
+    }
 
-	for (i = 0; i < cols; i++) {
-		AXPBY_K(rows, alpha, aptr, 1, beta, bptr, 1); 
-		aptr += lda; 
-		bptr += ldb; 
-	}
+    return (0);
+  }
+  if (!transa && !transb) {
+    for (i = 0; i < cols; i++) {
+      AXPBY_K(rows, alpha, aptr, 1, beta, bptr, 1);
+      aptr += lda;
+      bptr += ldb;
+    }
+  } else if (transa && !transb) {
+    for (i = 0; i < cols; i++) {
 
-	return(0);
+      AXPBY_K(rows, alpha, aptr, lda, beta, bptr, 1);
+      aptr += 1;
+      bptr += ldb;
+    }
+  } else if (!transa && transb) {
+    for (i = 0; i < cols; i++) {
 
+      AXPBY_K(rows, alpha, aptr, 1, beta, bptr, ldb);
+      aptr += lda;
+      bptr += 1;
+    }
+  } else if (transa && transb) {
+    for (i = 0; i < cols; i++) {
+      AXPBY_K(rows, alpha, aptr, lda, beta, bptr, ldb);
+      aptr += 1;
+      bptr += 1;
+    }
+  }
+  return (0);
 }
-
-

kernel/generic/gemmkernel_4x4.c

@@ -0,0 +1,264 @@
+/***************************************************************************
+ * Copyright (c) 2026, 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.
+ * *****************************************************************************/
+
+/*
+ * Portable C GEMM micro-kernel with a 4x4 register tile (16 accumulators).
+ *
+ * This is a wider companion to gemmkernel_2x2.c intended for in-order scalar
+ * cores whose FP FMA has a multi-cycle latency but 1/cycle throughput (e.g.
+ * SiFive U74: fmadd.d latency 7, repeat rate 1).  A 2x2 tile exposes only 4
+ * independent accumulator chains, which is fewer than the FMA latency and
+ * leaves the FP pipe stalled on the accumulator dependency.  A 4x4 tile keeps
+ * 16 independent chains -- comfortably above the latency -- and lowers the
+ * load:FMA ratio from 1:1 to 1:2, so the single load/store pipe stops being
+ * the bottleneck.  RV64G has 32 FP registers, so 16 accumulators + 4 A + 4 B
+ * fit without spilling.
+ *
+ * Packed-data contract (identical to the 2x2 kernel, verified against the
+ * generic tcopy_4 / ncopy_4 copy routines): the A operand is packed by
+ * tcopy_<UNROLL_M> into MR-row micro-panels [A(r0,k)..A(r3,k)] per k, and the
+ * B operand by ncopy_<UNROLL_N> into NR-col micro-panels [B(k,c0)..B(k,c3)]
+ * per k.  Both dimensions are decomposed as 4 / 2 / 1 sub-blocks at the edges.
+ */
+
+#include "common.h"
+
+#include "conversion_macros.h"
+
+#ifdef BGEMM
+#define C_TO_F32 TO_F32
+#else
+#define C_TO_F32
+#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;
+   IFLOAT *ptrba,*ptrbb;
+   FLOAT r0c0,r1c0,r2c0,r3c0;
+   FLOAT r0c1,r1c1,r2c1,r3c1;
+   FLOAT r0c2,r1c2,r2c2,r3c2;
+   FLOAT r0c3,r1c3,r2c3,r3c3;
+   IFLOAT a0,a1,a2,a3,b0,b1,b2,b3;
+
+   /* ==================== N panels of 4 ==================== */
+   for (j=0; j<bn/4; j+=1)
+     {
+        C0 = C;
+        C1 = C0+ldc;
+        C2 = C1+ldc;
+        C3 = C2+ldc;
+        ptrba = ba;
+
+        /* ---- 4x4 : 4 rows x 4 cols, 16 accumulators ---- */
+        for (i=0; i<bm/4; i+=1)
+          {
+             ptrbb = bb;
+             r0c0=r1c0=r2c0=r3c0=0;
+             r0c1=r1c1=r2c1=r3c1=0;
+             r0c2=r1c2=r2c2=r3c2=0;
+             r0c3=r1c3=r2c3=r3c3=0;
+             for (k=0; k<bk; k+=1)
+               {
+                  b0=ptrbb[0]; b1=ptrbb[1]; b2=ptrbb[2]; b3=ptrbb[3];
+                  a0=ptrba[0]; a1=ptrba[1]; a2=ptrba[2]; a3=ptrba[3];
+                  r0c0+=TO_F32(a0)*TO_F32(b0); r1c0+=TO_F32(a1)*TO_F32(b0); r2c0+=TO_F32(a2)*TO_F32(b0); r3c0+=TO_F32(a3)*TO_F32(b0);
+                  r0c1+=TO_F32(a0)*TO_F32(b1); r1c1+=TO_F32(a1)*TO_F32(b1); r2c1+=TO_F32(a2)*TO_F32(b1); r3c1+=TO_F32(a3)*TO_F32(b1);
+                  r0c2+=TO_F32(a0)*TO_F32(b2); r1c2+=TO_F32(a1)*TO_F32(b2); r2c2+=TO_F32(a2)*TO_F32(b2); r3c2+=TO_F32(a3)*TO_F32(b2);
+                  r0c3+=TO_F32(a0)*TO_F32(b3); r1c3+=TO_F32(a1)*TO_F32(b3); r2c3+=TO_F32(a2)*TO_F32(b3); r3c3+=TO_F32(a3)*TO_F32(b3);
+                  ptrba+=4; ptrbb+=4;
+               }
+             C0[0]=TO_OUTPUT(C_TO_F32(C0[0])+r0c0*ALPHA); C0[1]=TO_OUTPUT(C_TO_F32(C0[1])+r1c0*ALPHA); C0[2]=TO_OUTPUT(C_TO_F32(C0[2])+r2c0*ALPHA); C0[3]=TO_OUTPUT(C_TO_F32(C0[3])+r3c0*ALPHA);
+             C1[0]=TO_OUTPUT(C_TO_F32(C1[0])+r0c1*ALPHA); C1[1]=TO_OUTPUT(C_TO_F32(C1[1])+r1c1*ALPHA); C1[2]=TO_OUTPUT(C_TO_F32(C1[2])+r2c1*ALPHA); C1[3]=TO_OUTPUT(C_TO_F32(C1[3])+r3c1*ALPHA);
+             C2[0]=TO_OUTPUT(C_TO_F32(C2[0])+r0c2*ALPHA); C2[1]=TO_OUTPUT(C_TO_F32(C2[1])+r1c2*ALPHA); C2[2]=TO_OUTPUT(C_TO_F32(C2[2])+r2c2*ALPHA); C2[3]=TO_OUTPUT(C_TO_F32(C2[3])+r3c2*ALPHA);
+             C3[0]=TO_OUTPUT(C_TO_F32(C3[0])+r0c3*ALPHA); C3[1]=TO_OUTPUT(C_TO_F32(C3[1])+r1c3*ALPHA); C3[2]=TO_OUTPUT(C_TO_F32(C3[2])+r2c3*ALPHA); C3[3]=TO_OUTPUT(C_TO_F32(C3[3])+r3c3*ALPHA);
+             C0+=4; C1+=4; C2+=4; C3+=4;
+          }
+        /* ---- 2x4 : 2 rows x 4 cols ---- */
+        if (bm & 2)
+          {
+             ptrbb = bb;
+             r0c0=r1c0=0; r0c1=r1c1=0; r0c2=r1c2=0; r0c3=r1c3=0;
+             for (k=0; k<bk; k+=1)
+               {
+                  b0=ptrbb[0]; b1=ptrbb[1]; b2=ptrbb[2]; b3=ptrbb[3];
+                  a0=ptrba[0]; a1=ptrba[1];
+                  r0c0+=TO_F32(a0)*TO_F32(b0); r1c0+=TO_F32(a1)*TO_F32(b0);
+                  r0c1+=TO_F32(a0)*TO_F32(b1); r1c1+=TO_F32(a1)*TO_F32(b1);
+                  r0c2+=TO_F32(a0)*TO_F32(b2); r1c2+=TO_F32(a1)*TO_F32(b2);
+                  r0c3+=TO_F32(a0)*TO_F32(b3); r1c3+=TO_F32(a1)*TO_F32(b3);
+                  ptrba+=2; ptrbb+=4;
+               }
+             C0[0]=TO_OUTPUT(C_TO_F32(C0[0])+r0c0*ALPHA); C0[1]=TO_OUTPUT(C_TO_F32(C0[1])+r1c0*ALPHA);
+             C1[0]=TO_OUTPUT(C_TO_F32(C1[0])+r0c1*ALPHA); C1[1]=TO_OUTPUT(C_TO_F32(C1[1])+r1c1*ALPHA);
+             C2[0]=TO_OUTPUT(C_TO_F32(C2[0])+r0c2*ALPHA); C2[1]=TO_OUTPUT(C_TO_F32(C2[1])+r1c2*ALPHA);
+             C3[0]=TO_OUTPUT(C_TO_F32(C3[0])+r0c3*ALPHA); C3[1]=TO_OUTPUT(C_TO_F32(C3[1])+r1c3*ALPHA);
+             C0+=2; C1+=2; C2+=2; C3+=2;
+          }
+        /* ---- 1x4 : 1 row x 4 cols ---- */
+        if (bm & 1)
+          {
+             ptrbb = bb;
+             r0c0=0; r0c1=0; r0c2=0; r0c3=0;
+             for (k=0; k<bk; k+=1)
+               {
+                  b0=ptrbb[0]; b1=ptrbb[1]; b2=ptrbb[2]; b3=ptrbb[3];
+                  a0=ptrba[0];
+                  r0c0+=TO_F32(a0)*TO_F32(b0);
+                  r0c1+=TO_F32(a0)*TO_F32(b1);
+                  r0c2+=TO_F32(a0)*TO_F32(b2);
+                  r0c3+=TO_F32(a0)*TO_F32(b3);
+                  ptrba+=1; ptrbb+=4;
+               }
+             C0[0]=TO_OUTPUT(C_TO_F32(C0[0])+r0c0*ALPHA);
+             C1[0]=TO_OUTPUT(C_TO_F32(C1[0])+r0c1*ALPHA);
+             C2[0]=TO_OUTPUT(C_TO_F32(C2[0])+r0c2*ALPHA);
+             C3[0]=TO_OUTPUT(C_TO_F32(C3[0])+r0c3*ALPHA);
+             C0+=1; C1+=1; C2+=1; C3+=1;
+          }
+        bb = bb + bk*4;
+        C  = C  + ldc*4;
+     }
+
+   /* ==================== N panel of 2 ==================== */
+   if (bn & 2)
+     {
+        C0 = C;
+        C1 = C0+ldc;
+        ptrba = ba;
+
+        for (i=0; i<bm/4; i+=1)
+          {
+             ptrbb = bb;
+             r0c0=r1c0=r2c0=r3c0=0;
+             r0c1=r1c1=r2c1=r3c1=0;
+             for (k=0; k<bk; k+=1)
+               {
+                  b0=ptrbb[0]; b1=ptrbb[1];
+                  a0=ptrba[0]; a1=ptrba[1]; a2=ptrba[2]; a3=ptrba[3];
+                  r0c0+=TO_F32(a0)*TO_F32(b0); r1c0+=TO_F32(a1)*TO_F32(b0); r2c0+=TO_F32(a2)*TO_F32(b0); r3c0+=TO_F32(a3)*TO_F32(b0);
+                  r0c1+=TO_F32(a0)*TO_F32(b1); r1c1+=TO_F32(a1)*TO_F32(b1); r2c1+=TO_F32(a2)*TO_F32(b1); r3c1+=TO_F32(a3)*TO_F32(b1);
+                  ptrba+=4; ptrbb+=2;
+               }
+             C0[0]=TO_OUTPUT(C_TO_F32(C0[0])+r0c0*ALPHA); C0[1]=TO_OUTPUT(C_TO_F32(C0[1])+r1c0*ALPHA); C0[2]=TO_OUTPUT(C_TO_F32(C0[2])+r2c0*ALPHA); C0[3]=TO_OUTPUT(C_TO_F32(C0[3])+r3c0*ALPHA);
+             C1[0]=TO_OUTPUT(C_TO_F32(C1[0])+r0c1*ALPHA); C1[1]=TO_OUTPUT(C_TO_F32(C1[1])+r1c1*ALPHA); C1[2]=TO_OUTPUT(C_TO_F32(C1[2])+r2c1*ALPHA); C1[3]=TO_OUTPUT(C_TO_F32(C1[3])+r3c1*ALPHA);
+             C0+=4; C1+=4;
+          }
+        if (bm & 2)
+          {
+             ptrbb = bb;
+             r0c0=r1c0=0; r0c1=r1c1=0;
+             for (k=0; k<bk; k+=1)
+               {
+                  b0=ptrbb[0]; b1=ptrbb[1];
+                  a0=ptrba[0]; a1=ptrba[1];
+                  r0c0+=TO_F32(a0)*TO_F32(b0); r1c0+=TO_F32(a1)*TO_F32(b0);
+                  r0c1+=TO_F32(a0)*TO_F32(b1); r1c1+=TO_F32(a1)*TO_F32(b1);
+                  ptrba+=2; ptrbb+=2;
+               }
+             C0[0]=TO_OUTPUT(C_TO_F32(C0[0])+r0c0*ALPHA); C0[1]=TO_OUTPUT(C_TO_F32(C0[1])+r1c0*ALPHA);
+             C1[0]=TO_OUTPUT(C_TO_F32(C1[0])+r0c1*ALPHA); C1[1]=TO_OUTPUT(C_TO_F32(C1[1])+r1c1*ALPHA);
+             C0+=2; C1+=2;
+          }
+        if (bm & 1)
+          {
+             ptrbb = bb;
+             r0c0=0; r0c1=0;
+             for (k=0; k<bk; k+=1)
+               {
+                  b0=ptrbb[0]; b1=ptrbb[1];
+                  a0=ptrba[0];
+                  r0c0+=TO_F32(a0)*TO_F32(b0);
+                  r0c1+=TO_F32(a0)*TO_F32(b1);
+                  ptrba+=1; ptrbb+=2;
+               }
+             C0[0]=TO_OUTPUT(C_TO_F32(C0[0])+r0c0*ALPHA);
+             C1[0]=TO_OUTPUT(C_TO_F32(C1[0])+r0c1*ALPHA);
+             C0+=1; C1+=1;
+          }
+        bb = bb + bk*2;
+        C  = C  + ldc*2;
+     }
+
+   /* ==================== N panel of 1 ==================== */
+   if (bn & 1)
+     {
+        C0 = C;
+        ptrba = ba;
+
+        for (i=0; i<bm/4; i+=1)
+          {
+             ptrbb = bb;
+             r0c0=r1c0=r2c0=r3c0=0;
+             for (k=0; k<bk; k+=1)
+               {
+                  b0=ptrbb[0];
+                  a0=ptrba[0]; a1=ptrba[1]; a2=ptrba[2]; a3=ptrba[3];
+                  r0c0+=TO_F32(a0)*TO_F32(b0); r1c0+=TO_F32(a1)*TO_F32(b0); r2c0+=TO_F32(a2)*TO_F32(b0); r3c0+=TO_F32(a3)*TO_F32(b0);
+                  ptrba+=4; ptrbb+=1;
+               }
+             C0[0]=TO_OUTPUT(C_TO_F32(C0[0])+r0c0*ALPHA); C0[1]=TO_OUTPUT(C_TO_F32(C0[1])+r1c0*ALPHA); C0[2]=TO_OUTPUT(C_TO_F32(C0[2])+r2c0*ALPHA); C0[3]=TO_OUTPUT(C_TO_F32(C0[3])+r3c0*ALPHA);
+             C0+=4;
+          }
+        if (bm & 2)
+          {
+             ptrbb = bb;
+             r0c0=r1c0=0;
+             for (k=0; k<bk; k+=1)
+               {
+                  b0=ptrbb[0];
+                  a0=ptrba[0]; a1=ptrba[1];
+                  r0c0+=TO_F32(a0)*TO_F32(b0); r1c0+=TO_F32(a1)*TO_F32(b0);
+                  ptrba+=2; ptrbb+=1;
+               }
+             C0[0]=TO_OUTPUT(C_TO_F32(C0[0])+r0c0*ALPHA); C0[1]=TO_OUTPUT(C_TO_F32(C0[1])+r1c0*ALPHA);
+             C0+=2;
+          }
+        if (bm & 1)
+          {
+             ptrbb = bb;
+             r0c0=0;
+             for (k=0; k<bk; k+=1)
+               {
+                  r0c0+=TO_F32(ptrba[0])*TO_F32(ptrbb[0]);
+                  ptrba+=1; ptrbb+=1;
+               }
+             C0[0]=TO_OUTPUT(C_TO_F32(C0[0])+r0c0*ALPHA);
+             C0+=1;
+          }
+        bb = bb + bk;
+        C  = C  + ldc;
+     }
+
+   return 0;
+}

kernel/generic/trmm_lncopy_4.c

@@ -44,9 +44,9 @@ int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG posX, BLASLON
   BLASLONG i, js;
   BLASLONG X;
 
-  FLOAT data01, data02, data03, data04, data05, data06, data07, data08;
-  FLOAT data09, data10, data11, data12, data13, data14, data15, data16;
-  FLOAT *ao1, *ao2, *ao3, *ao4;
+  volatile FLOAT data01, data02, data03, data04, data05, data06, data07, data08;
+  volatile FLOAT data09, data10, data11, data12, data13, data14, data15, data16;
+  volatile FLOAT *ao1, *ao2, *ao3, *ao4;
 
   js = (n >> 2);
 

kernel/generic/trmm_ltcopy_4.c

@@ -44,9 +44,9 @@ int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG posX, BLASLON
   BLASLONG i, js;
   BLASLONG X;
 
-  FLOAT data01, data02, data03, data04, data05, data06, data07, data08;
-  FLOAT data09, data10, data11, data12, data13, data14, data15, data16;
-  FLOAT *ao1, *ao2, *ao3, *ao4;
+  volatile FLOAT data01, data02, data03, data04, data05, data06, data07, data08;
+  volatile FLOAT data09, data10, data11, data12, data13, data14, data15, data16;
+  volatile FLOAT *ao1, *ao2, *ao3, *ao4;
 
   js = (n >> 2);
 

kernel/generic/trmm_utcopy_4.c

@@ -44,9 +44,9 @@ int CNAME(BLASLONG m, BLASLONG n, FLOAT *a, BLASLONG lda, BLASLONG posX, BLASLON
   BLASLONG i, js;
   BLASLONG X;
 
-  FLOAT data01, data02, data03, data04, data05, data06, data07, data08;
-  FLOAT data09, data10, data11, data12, data13, data14, data15, data16;
-  FLOAT *ao1, *ao2, *ao3, *ao4;
+  volatile FLOAT data01, data02, data03, data04, data05, data06, data07, data08;
+  volatile FLOAT data09, data10, data11, data12, data13, data14, data15, data16;
+  volatile FLOAT *ao1, *ao2, *ao3, *ao4;
 
   js = (n >> 2);
 

kernel/generic/zgeadd.c

@@ -17,49 +17,72 @@ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
 AND ANY EXPRESS OR IMPLIED 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.
+LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
+GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+LIABILITY, OR TORT (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"
 
+int CNAME(BLASLONG rows, BLASLONG cols, FLOAT alphar, FLOAT alphai, FLOAT *a,
+          BLASLONG lda, FLOAT betar, FLOAT betai, FLOAT *b, BLASLONG ldb,
+          BLASLONG transa, BLASLONG transb) {
+  BLASLONG i;
+  FLOAT *aptr, *bptr;
+  BLASLONG lda_elem = lda;
+  BLASLONG ldb_elem = ldb;
+  if (rows <= 0)
+    return (0);
+  if (cols <= 0)
+    return (0);
 
-int CNAME(BLASLONG rows, BLASLONG cols, FLOAT alphar, FLOAT alphai, FLOAT *a, BLASLONG lda, FLOAT betar, FLOAT betai , FLOAT *b, BLASLONG ldb)
-{
-	BLASLONG i;
-	FLOAT *aptr,*bptr;
-
-	if ( rows <= 0     )  return(0);
-	if ( cols <= 0     )  return(0);
-
-	
-	aptr = a;
-	bptr = b;
-	lda *= 2; 
-	ldb *= 2; 
-
-	if ( alphar == 0.0 && alphai == 0.0 )
-	{
-		for ( i=0; i<cols ; i++ )
-		{
-			SCAL_K(rows, 0,0, betar, betai, bptr, 1,  NULL, 0,NULL,0); 
-			bptr+=ldb; 
-		}
-
-		return(0);
-	}
-
-	for (i = 0; i < cols; i++) {
-		AXPBY_K(rows, alphar, alphai, aptr, 1, betar, betai,  bptr, 1); 
-		aptr += lda; 
-		bptr += ldb; 
-	}
-	return(0);
+  aptr = a;
+  bptr = b;
+  lda *= 2;
+  ldb *= 2;
 
+  if (alphar == 0.0 && alphai == 0.0) {
+    if (!transb) {
+      for (i = 0; i < cols; i++) {
+        SCAL_K(rows, 0, 0, betar, betai, bptr, 1, NULL, 0, NULL, 0);
+        bptr += ldb;
+      }
+    } else {
+      for (i = 0; i < cols; i++) {
+        SCAL_K(rows, 0, 0, betar, betai, bptr, ldb_elem, NULL, 0, NULL, 0);
+        bptr += 2;
+      }
+    }
+    return (0);
+  }
+  if (!transa && !transb) {
+    for (i = 0; i < cols; i++) {
+      AXPBY_K(rows, alphar, alphai, aptr, 1, betar, betai, bptr, 1);
+      aptr += lda;
+      bptr += ldb;
+    }
+  } else if (transa && !transb) {
+    for (i = 0; i < cols; i++) {
+      AXPBY_K(rows, alphar, alphai, aptr, lda_elem, betar, betai, bptr, 1);
+      aptr += 2;
+      bptr += ldb;
+    }
+  } else if (!transa && transb) {
+    for (i = 0; i < cols; i++) {
+      AXPBY_K(rows, alphar, alphai, aptr, 1, betar, betai, bptr, ldb_elem);
+      aptr += lda;
+      bptr += 2;
+    }
+  } else if (transa && transb) {
+    for (i = 0; i < cols; i++) {
+      AXPBY_K(rows, alphar, alphai, aptr, lda_elem, betar, betai, bptr,
+              ldb_elem);
+      aptr += 2;
+      bptr += 2;
+    }
+  }
+  return (0);
 }
-
-

kernel/riscv64/KERNEL.U74

@@ -0,0 +1,177 @@
+SAMAXKERNEL  = ../riscv64/amax.c
+DAMAXKERNEL  = ../riscv64/amax.c
+CAMAXKERNEL  = ../riscv64/zamax.c
+ZAMAXKERNEL  = ../riscv64/zamax.c
+
+SAMINKERNEL  = ../riscv64/amin.c
+DAMINKERNEL  = ../riscv64/amin.c
+CAMINKERNEL  = ../riscv64/zamin.c
+ZAMINKERNEL  = ../riscv64/zamin.c
+
+SMAXKERNEL   = ../riscv64/max.c
+DMAXKERNEL   = ../riscv64/max.c
+
+SMINKERNEL   = ../riscv64/min.c
+DMINKERNEL   = ../riscv64/min.c
+
+ISAMAXKERNEL = ../riscv64/iamax.c
+IDAMAXKERNEL = ../riscv64/iamax.c
+ICAMAXKERNEL = ../riscv64/izamax.c
+IZAMAXKERNEL = ../riscv64/izamax.c
+
+ISAMINKERNEL = ../riscv64/iamin.c
+IDAMINKERNEL = ../riscv64/iamin.c
+ICAMINKERNEL = ../riscv64/izamin.c
+IZAMINKERNEL = ../riscv64/izamin.c
+
+ISMAXKERNEL  = ../riscv64/imax.c
+IDMAXKERNEL  = ../riscv64/imax.c
+
+ISMINKERNEL  = ../riscv64/imin.c
+IDMINKERNEL  = ../riscv64/imin.c
+
+SASUMKERNEL  = ../riscv64/asum.c
+DASUMKERNEL  = ../riscv64/asum.c
+CASUMKERNEL  = ../riscv64/zasum.c
+ZASUMKERNEL  = ../riscv64/zasum.c
+
+SSUMKERNEL  = ../arm/sum.c
+DSUMKERNEL  = ../arm/sum.c
+CSUMKERNEL  = ../arm/zsum.c
+ZSUMKERNEL  = ../arm/zsum.c
+
+SAXPYKERNEL  = ../riscv64/axpy.c
+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
+ZCOPYKERNEL  = ../riscv64/zcopy.c
+
+SDOTKERNEL   = ../riscv64/dot.c
+DDOTKERNEL   = ../riscv64/dot.c
+CDOTKERNEL   = ../riscv64/zdot.c
+ZDOTKERNEL   = ../riscv64/zdot.c
+DSDOTKERNEL  = ../generic/dot.c
+
+SNRM2KERNEL  = ../riscv64/nrm2.c
+DNRM2KERNEL  = ../riscv64/nrm2.c
+CNRM2KERNEL  = ../riscv64/znrm2.c
+ZNRM2KERNEL  = ../riscv64/znrm2.c
+
+SROTKERNEL   = ../riscv64/rot.c
+DROTKERNEL   = ../riscv64/rot.c
+CROTKERNEL   = ../riscv64/zrot.c
+ZROTKERNEL   = ../riscv64/zrot.c
+
+SROTMKERNEL  = ../generic/rotm.c
+DROTMKERNEL  = ../generic/rotm.c
+QROTMKERNEL = ../generic/rotm.c
+
+SSCALKERNEL  = ../riscv64/scal.c
+DSCALKERNEL  = ../riscv64/scal.c
+CSCALKERNEL  = ../riscv64/zscal.c
+ZSCALKERNEL  = ../riscv64/zscal.c
+
+SSWAPKERNEL  = ../riscv64/swap.c
+DSWAPKERNEL  = ../riscv64/swap.c
+CSWAPKERNEL  = ../riscv64/zswap.c
+ZSWAPKERNEL  = ../riscv64/zswap.c
+
+SGEMVNKERNEL = ../riscv64/gemv_n.c
+DGEMVNKERNEL = ../riscv64/gemv_n.c
+CGEMVNKERNEL = ../riscv64/zgemv_n.c
+ZGEMVNKERNEL = ../riscv64/zgemv_n.c
+
+SGEMVTKERNEL = ../riscv64/gemv_t.c
+DGEMVTKERNEL = ../riscv64/gemv_t.c
+CGEMVTKERNEL = ../riscv64/zgemv_t.c
+ZGEMVTKERNEL = ../riscv64/zgemv_t.c
+
+# Real S/D TRMM use the generic 4x4 kernel to match the 4x4 GEMM unroll.
+STRMMKERNEL	= ../generic/trmmkernel_4x4.c
+DTRMMKERNEL	= ../generic/trmmkernel_4x4.c
+CTRMMKERNEL	= ../generic/ztrmmkernel_2x2.c
+ZTRMMKERNEL	= ../generic/ztrmmkernel_2x2.c
+
+# Real S/D GEMM use the 4x4 register-tiled kernel (16 accumulators) with the
+# matching width-4 packing routines.  UNROLL_M == UNROLL_N == 4.
+SGEMMKERNEL    =  ../generic/gemmkernel_4x4.c
+SGEMMONCOPY    =  ../generic/gemm_ncopy_4.c
+SGEMMOTCOPY    =  ../generic/gemm_tcopy_4.c
+SGEMMONCOPYOBJ =  sgemm_oncopy$(TSUFFIX).$(SUFFIX)
+SGEMMOTCOPYOBJ =  sgemm_otcopy$(TSUFFIX).$(SUFFIX)
+
+DGEMMKERNEL    =  ../riscv64/gemmkernel_4x4_u74.c
+DGEMMONCOPY    = ../generic/gemm_ncopy_4.c
+DGEMMOTCOPY    = ../generic/gemm_tcopy_4.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
+
+SSYMV_U_KERNEL =  ../generic/symv_k.c
+SSYMV_L_KERNEL =  ../generic/symv_k.c
+DSYMV_U_KERNEL =  ../generic/symv_k.c
+DSYMV_L_KERNEL =  ../generic/symv_k.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 = ../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

kernel/riscv64/gemmkernel_4x4_u74.c

@@ -0,0 +1,526 @@
+/***************************************************************************
+ * Copyright (c) 2026, 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.
+ * *****************************************************************************/
+
+/*
+ * Portable C GEMM micro-kernel with a 4x4 register tile (16 accumulators).
+ *
+ * This is a wider companion to gemmkernel_2x2.c intended for in-order scalar
+ * cores whose FP FMA has a multi-cycle latency but 1/cycle throughput (e.g.
+ * SiFive U74: fmadd.d latency 7, repeat rate 1).  A 2x2 tile exposes only 4
+ * independent accumulator chains, which is fewer than the FMA latency and
+ * leaves the FP pipe stalled on the accumulator dependency.  A 4x4 tile keeps
+ * 16 independent chains -- comfortably above the latency -- and lowers the
+ * load:FMA ratio from 1:1 to 1:2, so the single load/store pipe stops being
+ * the bottleneck.  RV64G has 32 FP registers, so 16 accumulators + 4 A + 4 B
+ * fit without spilling.
+ *
+ * Packed-data contract (identical to the 2x2 kernel, verified against the
+ * generic tcopy_4 / ncopy_4 copy routines): the A operand is packed by
+ * tcopy_<UNROLL_M> into MR-row micro-panels [A(r0,k)..A(r3,k)] per k, and the
+ * B operand by ncopy_<UNROLL_N> into NR-col micro-panels [B(k,c0)..B(k,c3)]
+ * per k.  Both dimensions are decomposed as 4 / 2 / 1 sub-blocks at the edges.
+ */
+
+/*
+ * U74 hybrid variant.  The DGEMM fast path (bm, bn multiples of 4, even bk,
+ * non-TRMM) is served by a hand-scheduled scalar assembly micro-kernel,
+ * dgemm_u74_asm, embedded below via a top-level __asm__ (readable source in
+ * kern_u74.S in this directory): a 4x4 register tile with full operand
+ * double-buffering (P/Q ping-pong) and load-before-FMA issue ordering that
+ * reaches the U74 FP-pipe peak (~16.5 cycles per 16 fmadd.d).  All other
+ * shapes, odd bk, and the TRMM builds fall back to the portable C 4x4 code
+ * below.  Measured ~+20% single-core DGEMM over the C kernel; four-core HPL vs
+ * the tuned C kernel is +4% at N=10000 and +10.7% at N=27456 (5.99 GFLOPS,
+ * ~50% of the 12 GF peak - the best clean figure).  Validated against the full
+ * BLAS Level-3 suite (DGEMM 17,496 calls, 0 failures) and HPL (residual PASSED).
+ */
+
+#include "common.h"
+
+#include "../generic/conversion_macros.h"
+
+#ifdef BGEMM
+#define C_TO_F32 TO_F32
+#else
+#define C_TO_F32
+#endif
+
+
+extern int dgemm_u74_asm(BLASLONG,BLASLONG,BLASLONG,FLOAT,IFLOAT*,IFLOAT*,FLOAT*,BLASLONG);
+
+__asm__(
+	"	.text\n"
+	"	.p2align 4\n"
+	"	.type	dgemm_u74_asm,@function\n"
+	"dgemm_u74_asm:\n"
+	"	addi	sp, sp, -112\n"
+	"	fsd	fs0, 0(sp)\n"
+	"	fsd	fs1, 8(sp)\n"
+	"	fsd	fs2, 16(sp)\n"
+	"	fsd	fs3, 24(sp)\n"
+	"	fsd	fs4, 32(sp)\n"
+	"	fsd	fs5, 40(sp)\n"
+	"	fsd	fs6, 48(sp)\n"
+	"	fsd	fs7, 56(sp)\n"
+	"	fsd	fs8, 64(sp)\n"
+	"	fsd	fs9, 72(sp)\n"
+	"	fsd	fs10, 80(sp)\n"
+	"	fsd	fs11, 88(sp)\n"
+	"	fsd	fa0, 96(sp)\n"
+	"	slli	t0, a6, 3\n"
+	"	srli	t1, a0, 2\n"
+	"	srli	t2, a1, 2\n"
+	"	beqz	t2, .Lk4done\n"
+	".Lk4j:\n"
+	"	mv	a0, a5\n"
+	"	add	a1, a0, t0\n"
+	"	add	a6, a1, t0\n"
+	"	add	a7, a6, t0\n"
+	"	mv	t3, a3\n"
+	"	mv	t5, t1\n"
+	".Lk4i:\n"
+	"	mv	t4, a4\n"
+	"	fmv.d.x	ft0, zero\n"
+	"	fmv.d.x	ft1, zero\n"
+	"	fmv.d.x	ft2, zero\n"
+	"	fmv.d.x	ft3, zero\n"
+	"	fmv.d.x	ft4, zero\n"
+	"	fmv.d.x	ft5, zero\n"
+	"	fmv.d.x	ft6, zero\n"
+	"	fmv.d.x	ft7, zero\n"
+	"	fmv.d.x	ft8, zero\n"
+	"	fmv.d.x	ft9, zero\n"
+	"	fmv.d.x	ft10, zero\n"
+	"	fmv.d.x	ft11, zero\n"
+	"	fmv.d.x	fa2, zero\n"
+	"	fmv.d.x	fa3, zero\n"
+	"	fmv.d.x	fa4, zero\n"
+	"	fmv.d.x	fa5, zero\n"
+	"	fld	fa0, 0(t3)\n"
+	"	fld	fa1, 8(t3)\n"
+	"	fld	fa6, 16(t3)\n"
+	"	fld	fa7, 24(t3)\n"
+	"	fld	fs0, 0(t4)\n"
+	"	fld	fs1, 8(t4)\n"
+	"	fld	fs2, 16(t4)\n"
+	"	fld	fs3, 24(t4)\n"
+	"	addi	t3, t3, 32\n"
+	"	addi	t4, t4, 32\n"
+	"	srli	t6, a2, 1\n"
+	"	addi	t6, t6, -1\n"
+	"	beqz	t6, .Lk4epi\n"
+	"	.p2align 4\n"
+	".Lk4body:\n"
+	"	fld	fs4, 0(t3)\n"
+	"	fmadd.d	ft0, fa0, fs0, ft0\n"
+	"	fld	fs5, 8(t3)\n"
+	"	fmadd.d	ft1, fa1, fs0, ft1\n"
+	"	fld	fs6, 16(t3)\n"
+	"	fmadd.d	ft2, fa6, fs0, ft2\n"
+	"	fld	fs7, 24(t3)\n"
+	"	fmadd.d	ft3, fa7, fs0, ft3\n"
+	"	fld	fs8, 0(t4)\n"
+	"	fmadd.d	ft4, fa0, fs1, ft4\n"
+	"	fld	fs9, 8(t4)\n"
+	"	fmadd.d	ft5, fa1, fs1, ft5\n"
+	"	fld	fs10, 16(t4)\n"
+	"	fmadd.d	ft6, fa6, fs1, ft6\n"
+	"	fld	fs11, 24(t4)\n"
+	"	fmadd.d	ft7, fa7, fs1, ft7\n"
+	"	addi	t3, t3, 32\n"
+	"	fmadd.d	ft8, fa0, fs2, ft8\n"
+	"	addi	t4, t4, 32\n"
+	"	fmadd.d	ft9, fa1, fs2, ft9\n"
+	"	fmadd.d	ft10, fa6, fs2, ft10\n"
+	"	fmadd.d	ft11, fa7, fs2, ft11\n"
+	"	fmadd.d	fa2, fa0, fs3, fa2\n"
+	"	fmadd.d	fa3, fa1, fs3, fa3\n"
+	"	fmadd.d	fa4, fa6, fs3, fa4\n"
+	"	fmadd.d	fa5, fa7, fs3, fa5\n"
+	"	fld	fa0, 0(t3)\n"
+	"	fmadd.d	ft0, fs4, fs8, ft0\n"
+	"	fld	fa1, 8(t3)\n"
+	"	fmadd.d	ft1, fs5, fs8, ft1\n"
+	"	fld	fa6, 16(t3)\n"
+	"	fmadd.d	ft2, fs6, fs8, ft2\n"
+	"	fld	fa7, 24(t3)\n"
+	"	fmadd.d	ft3, fs7, fs8, ft3\n"
+	"	fld	fs0, 0(t4)\n"
+	"	fmadd.d	ft4, fs4, fs9, ft4\n"
+	"	fld	fs1, 8(t4)\n"
+	"	fmadd.d	ft5, fs5, fs9, ft5\n"
+	"	fld	fs2, 16(t4)\n"
+	"	fmadd.d	ft6, fs6, fs9, ft6\n"
+	"	fld	fs3, 24(t4)\n"
+	"	fmadd.d	ft7, fs7, fs9, ft7\n"
+	"	addi	t3, t3, 32\n"
+	"	fmadd.d	ft8, fs4, fs10, ft8\n"
+	"	addi	t4, t4, 32\n"
+	"	fmadd.d	ft9, fs5, fs10, ft9\n"
+	"	fmadd.d	ft10, fs6, fs10, ft10\n"
+	"	fmadd.d	ft11, fs7, fs10, ft11\n"
+	"	fmadd.d	fa2, fs4, fs11, fa2\n"
+	"	fmadd.d	fa3, fs5, fs11, fa3\n"
+	"	fmadd.d	fa4, fs6, fs11, fa4\n"
+	"	fmadd.d	fa5, fs7, fs11, fa5\n"
+	"	addi	t6, t6, -1\n"
+	"	bnez	t6, .Lk4body\n"
+	".Lk4epi:\n"
+	"	fld	fs4, 0(t3)\n"
+	"	fmadd.d	ft0, fa0, fs0, ft0\n"
+	"	fld	fs5, 8(t3)\n"
+	"	fmadd.d	ft1, fa1, fs0, ft1\n"
+	"	fld	fs6, 16(t3)\n"
+	"	fmadd.d	ft2, fa6, fs0, ft2\n"
+	"	fld	fs7, 24(t3)\n"
+	"	fmadd.d	ft3, fa7, fs0, ft3\n"
+	"	fld	fs8, 0(t4)\n"
+	"	fmadd.d	ft4, fa0, fs1, ft4\n"
+	"	fld	fs9, 8(t4)\n"
+	"	fmadd.d	ft5, fa1, fs1, ft5\n"
+	"	fld	fs10, 16(t4)\n"
+	"	fmadd.d	ft6, fa6, fs1, ft6\n"
+	"	fld	fs11, 24(t4)\n"
+	"	fmadd.d	ft7, fa7, fs1, ft7\n"
+	"	addi	t3, t3, 32\n"
+	"	fmadd.d	ft8, fa0, fs2, ft8\n"
+	"	addi	t4, t4, 32\n"
+	"	fmadd.d	ft9, fa1, fs2, ft9\n"
+	"	fmadd.d	ft10, fa6, fs2, ft10\n"
+	"	fmadd.d	ft11, fa7, fs2, ft11\n"
+	"	fmadd.d	fa2, fa0, fs3, fa2\n"
+	"	fmadd.d	fa3, fa1, fs3, fa3\n"
+	"	fmadd.d	fa4, fa6, fs3, fa4\n"
+	"	fmadd.d	fa5, fa7, fs3, fa5\n"
+	"	fmadd.d	ft0, fs4, fs8, ft0\n"
+	"	fmadd.d	ft1, fs5, fs8, ft1\n"
+	"	fmadd.d	ft2, fs6, fs8, ft2\n"
+	"	fmadd.d	ft3, fs7, fs8, ft3\n"
+	"	fmadd.d	ft4, fs4, fs9, ft4\n"
+	"	fmadd.d	ft5, fs5, fs9, ft5\n"
+	"	fmadd.d	ft6, fs6, fs9, ft6\n"
+	"	fmadd.d	ft7, fs7, fs9, ft7\n"
+	"	fmadd.d	ft8, fs4, fs10, ft8\n"
+	"	fmadd.d	ft9, fs5, fs10, ft9\n"
+	"	fmadd.d	ft10, fs6, fs10, ft10\n"
+	"	fmadd.d	ft11, fs7, fs10, ft11\n"
+	"	fmadd.d	fa2, fs4, fs11, fa2\n"
+	"	fmadd.d	fa3, fs5, fs11, fa3\n"
+	"	fmadd.d	fa4, fs6, fs11, fa4\n"
+	"	fmadd.d	fa5, fs7, fs11, fa5\n"
+	"	fld	fs4, 96(sp)\n"
+	"	fld	fs0, 0(a0)\n"
+	"	fmadd.d	fs0, ft0, fs4, fs0\n"
+	"	fsd	fs0, 0(a0)\n"
+	"	fld	fs1, 8(a0)\n"
+	"	fmadd.d	fs1, ft1, fs4, fs1\n"
+	"	fsd	fs1, 8(a0)\n"
+	"	fld	fs0, 16(a0)\n"
+	"	fmadd.d	fs0, ft2, fs4, fs0\n"
+	"	fsd	fs0, 16(a0)\n"
+	"	fld	fs1, 24(a0)\n"
+	"	fmadd.d	fs1, ft3, fs4, fs1\n"
+	"	fsd	fs1, 24(a0)\n"
+	"	fld	fs0, 0(a1)\n"
+	"	fmadd.d	fs0, ft4, fs4, fs0\n"
+	"	fsd	fs0, 0(a1)\n"
+	"	fld	fs1, 8(a1)\n"
+	"	fmadd.d	fs1, ft5, fs4, fs1\n"
+	"	fsd	fs1, 8(a1)\n"
+	"	fld	fs0, 16(a1)\n"
+	"	fmadd.d	fs0, ft6, fs4, fs0\n"
+	"	fsd	fs0, 16(a1)\n"
+	"	fld	fs1, 24(a1)\n"
+	"	fmadd.d	fs1, ft7, fs4, fs1\n"
+	"	fsd	fs1, 24(a1)\n"
+	"	fld	fs0, 0(a6)\n"
+	"	fmadd.d	fs0, ft8, fs4, fs0\n"
+	"	fsd	fs0, 0(a6)\n"
+	"	fld	fs1, 8(a6)\n"
+	"	fmadd.d	fs1, ft9, fs4, fs1\n"
+	"	fsd	fs1, 8(a6)\n"
+	"	fld	fs0, 16(a6)\n"
+	"	fmadd.d	fs0, ft10, fs4, fs0\n"
+	"	fsd	fs0, 16(a6)\n"
+	"	fld	fs1, 24(a6)\n"
+	"	fmadd.d	fs1, ft11, fs4, fs1\n"
+	"	fsd	fs1, 24(a6)\n"
+	"	fld	fs0, 0(a7)\n"
+	"	fmadd.d	fs0, fa2, fs4, fs0\n"
+	"	fsd	fs0, 0(a7)\n"
+	"	fld	fs1, 8(a7)\n"
+	"	fmadd.d	fs1, fa3, fs4, fs1\n"
+	"	fsd	fs1, 8(a7)\n"
+	"	fld	fs0, 16(a7)\n"
+	"	fmadd.d	fs0, fa4, fs4, fs0\n"
+	"	fsd	fs0, 16(a7)\n"
+	"	fld	fs1, 24(a7)\n"
+	"	fmadd.d	fs1, fa5, fs4, fs1\n"
+	"	fsd	fs1, 24(a7)\n"
+	"	addi	a0, a0, 32\n"
+	"	addi	a1, a1, 32\n"
+	"	addi	a6, a6, 32\n"
+	"	addi	a7, a7, 32\n"
+	"	addi	t5, t5, -1\n"
+	"	bnez	t5, .Lk4i\n"
+	"	slli	t6, a2, 5\n"
+	"	add	a4, a4, t6\n"
+	"	slli	t6, t0, 2\n"
+	"	add	a5, a5, t6\n"
+	"	addi	t2, t2, -1\n"
+	"	bnez	t2, .Lk4j\n"
+	".Lk4done:\n"
+	"	fld	fs0, 0(sp)\n"
+	"	fld	fs1, 8(sp)\n"
+	"	fld	fs2, 16(sp)\n"
+	"	fld	fs3, 24(sp)\n"
+	"	fld	fs4, 32(sp)\n"
+	"	fld	fs5, 40(sp)\n"
+	"	fld	fs6, 48(sp)\n"
+	"	fld	fs7, 56(sp)\n"
+	"	fld	fs8, 64(sp)\n"
+	"	fld	fs9, 72(sp)\n"
+	"	fld	fs10, 80(sp)\n"
+	"	fld	fs11, 88(sp)\n"
+	"	addi	sp, sp, 112\n"
+	"	li	a0, 0\n"
+	"	ret\n"
+	"	.size	dgemm_u74_asm, .-dgemm_u74_asm\n"
+);
+
+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;
+   FLOAT r0c0,r1c0,r2c0,r3c0;
+   FLOAT r0c1,r1c1,r2c1,r3c1;
+   FLOAT r0c2,r1c2,r2c2,r3c2;
+   FLOAT r0c3,r1c3,r2c3,r3c3;
+   IFLOAT a0,a1,a2,a3,b0,b1,b2,b3;
+
+   #if defined(DOUBLE) && !defined(TRMMKERNEL)
+   if (bm > 0 && bn > 0 && bk > 0 && ((bm & 3) == 0) && ((bn & 3) == 0) && ((bk & 1) == 0))
+      return dgemm_u74_asm(bm, bn, bk, alpha, ba, bb, C, ldc);
+#endif
+
+   /* ==================== N panels of 4 ==================== */
+   for (j=0; j<bn/4; j+=1)
+     {
+        C0 = C;
+        C1 = C0+ldc;
+        C2 = C1+ldc;
+        C3 = C2+ldc;
+        ptrba = ba;
+
+        /* ---- 4x4 : 4 rows x 4 cols, 16 accumulators ---- */
+        for (i=0; i<bm/4; i+=1)
+          {
+             ptrbb = bb;
+             r0c0=r1c0=r2c0=r3c0=0;
+             r0c1=r1c1=r2c1=r3c1=0;
+             r0c2=r1c2=r2c2=r3c2=0;
+             r0c3=r1c3=r2c3=r3c3=0;
+             for (k=0; k<bk; k+=1)
+               {
+                  b0=ptrbb[0]; b1=ptrbb[1]; b2=ptrbb[2]; b3=ptrbb[3];
+                  a0=ptrba[0]; a1=ptrba[1]; a2=ptrba[2]; a3=ptrba[3];
+                  r0c0+=TO_F32(a0)*TO_F32(b0); r1c0+=TO_F32(a1)*TO_F32(b0); r2c0+=TO_F32(a2)*TO_F32(b0); r3c0+=TO_F32(a3)*TO_F32(b0);
+                  r0c1+=TO_F32(a0)*TO_F32(b1); r1c1+=TO_F32(a1)*TO_F32(b1); r2c1+=TO_F32(a2)*TO_F32(b1); r3c1+=TO_F32(a3)*TO_F32(b1);
+                  r0c2+=TO_F32(a0)*TO_F32(b2); r1c2+=TO_F32(a1)*TO_F32(b2); r2c2+=TO_F32(a2)*TO_F32(b2); r3c2+=TO_F32(a3)*TO_F32(b2);
+                  r0c3+=TO_F32(a0)*TO_F32(b3); r1c3+=TO_F32(a1)*TO_F32(b3); r2c3+=TO_F32(a2)*TO_F32(b3); r3c3+=TO_F32(a3)*TO_F32(b3);
+                  ptrba+=4; ptrbb+=4;
+               }
+             C0[0]=TO_OUTPUT(C_TO_F32(C0[0])+r0c0*ALPHA); C0[1]=TO_OUTPUT(C_TO_F32(C0[1])+r1c0*ALPHA); C0[2]=TO_OUTPUT(C_TO_F32(C0[2])+r2c0*ALPHA); C0[3]=TO_OUTPUT(C_TO_F32(C0[3])+r3c0*ALPHA);
+             C1[0]=TO_OUTPUT(C_TO_F32(C1[0])+r0c1*ALPHA); C1[1]=TO_OUTPUT(C_TO_F32(C1[1])+r1c1*ALPHA); C1[2]=TO_OUTPUT(C_TO_F32(C1[2])+r2c1*ALPHA); C1[3]=TO_OUTPUT(C_TO_F32(C1[3])+r3c1*ALPHA);
+             C2[0]=TO_OUTPUT(C_TO_F32(C2[0])+r0c2*ALPHA); C2[1]=TO_OUTPUT(C_TO_F32(C2[1])+r1c2*ALPHA); C2[2]=TO_OUTPUT(C_TO_F32(C2[2])+r2c2*ALPHA); C2[3]=TO_OUTPUT(C_TO_F32(C2[3])+r3c2*ALPHA);
+             C3[0]=TO_OUTPUT(C_TO_F32(C3[0])+r0c3*ALPHA); C3[1]=TO_OUTPUT(C_TO_F32(C3[1])+r1c3*ALPHA); C3[2]=TO_OUTPUT(C_TO_F32(C3[2])+r2c3*ALPHA); C3[3]=TO_OUTPUT(C_TO_F32(C3[3])+r3c3*ALPHA);
+             C0+=4; C1+=4; C2+=4; C3+=4;
+          }
+        /* ---- 2x4 : 2 rows x 4 cols ---- */
+        if (bm & 2)
+          {
+             ptrbb = bb;
+             r0c0=r1c0=0; r0c1=r1c1=0; r0c2=r1c2=0; r0c3=r1c3=0;
+             for (k=0; k<bk; k+=1)
+               {
+                  b0=ptrbb[0]; b1=ptrbb[1]; b2=ptrbb[2]; b3=ptrbb[3];
+                  a0=ptrba[0]; a1=ptrba[1];
+                  r0c0+=TO_F32(a0)*TO_F32(b0); r1c0+=TO_F32(a1)*TO_F32(b0);
+                  r0c1+=TO_F32(a0)*TO_F32(b1); r1c1+=TO_F32(a1)*TO_F32(b1);
+                  r0c2+=TO_F32(a0)*TO_F32(b2); r1c2+=TO_F32(a1)*TO_F32(b2);
+                  r0c3+=TO_F32(a0)*TO_F32(b3); r1c3+=TO_F32(a1)*TO_F32(b3);
+                  ptrba+=2; ptrbb+=4;
+               }
+             C0[0]=TO_OUTPUT(C_TO_F32(C0[0])+r0c0*ALPHA); C0[1]=TO_OUTPUT(C_TO_F32(C0[1])+r1c0*ALPHA);
+             C1[0]=TO_OUTPUT(C_TO_F32(C1[0])+r0c1*ALPHA); C1[1]=TO_OUTPUT(C_TO_F32(C1[1])+r1c1*ALPHA);
+             C2[0]=TO_OUTPUT(C_TO_F32(C2[0])+r0c2*ALPHA); C2[1]=TO_OUTPUT(C_TO_F32(C2[1])+r1c2*ALPHA);
+             C3[0]=TO_OUTPUT(C_TO_F32(C3[0])+r0c3*ALPHA); C3[1]=TO_OUTPUT(C_TO_F32(C3[1])+r1c3*ALPHA);
+             C0+=2; C1+=2; C2+=2; C3+=2;
+          }
+        /* ---- 1x4 : 1 row x 4 cols ---- */
+        if (bm & 1)
+          {
+             ptrbb = bb;
+             r0c0=0; r0c1=0; r0c2=0; r0c3=0;
+             for (k=0; k<bk; k+=1)
+               {
+                  b0=ptrbb[0]; b1=ptrbb[1]; b2=ptrbb[2]; b3=ptrbb[3];
+                  a0=ptrba[0];
+                  r0c0+=TO_F32(a0)*TO_F32(b0);
+                  r0c1+=TO_F32(a0)*TO_F32(b1);
+                  r0c2+=TO_F32(a0)*TO_F32(b2);
+                  r0c3+=TO_F32(a0)*TO_F32(b3);
+                  ptrba+=1; ptrbb+=4;
+               }
+             C0[0]=TO_OUTPUT(C_TO_F32(C0[0])+r0c0*ALPHA);
+             C1[0]=TO_OUTPUT(C_TO_F32(C1[0])+r0c1*ALPHA);
+             C2[0]=TO_OUTPUT(C_TO_F32(C2[0])+r0c2*ALPHA);
+             C3[0]=TO_OUTPUT(C_TO_F32(C3[0])+r0c3*ALPHA);
+             C0+=1; C1+=1; C2+=1; C3+=1;
+          }
+        bb = bb + bk*4;
+        C  = C  + ldc*4;
+     }
+
+   /* ==================== N panel of 2 ==================== */
+   if (bn & 2)
+     {
+        C0 = C;
+        C1 = C0+ldc;
+        ptrba = ba;
+
+        for (i=0; i<bm/4; i+=1)
+          {
+             ptrbb = bb;
+             r0c0=r1c0=r2c0=r3c0=0;
+             r0c1=r1c1=r2c1=r3c1=0;
+             for (k=0; k<bk; k+=1)
+               {
+                  b0=ptrbb[0]; b1=ptrbb[1];
+                  a0=ptrba[0]; a1=ptrba[1]; a2=ptrba[2]; a3=ptrba[3];
+                  r0c0+=TO_F32(a0)*TO_F32(b0); r1c0+=TO_F32(a1)*TO_F32(b0); r2c0+=TO_F32(a2)*TO_F32(b0); r3c0+=TO_F32(a3)*TO_F32(b0);
+                  r0c1+=TO_F32(a0)*TO_F32(b1); r1c1+=TO_F32(a1)*TO_F32(b1); r2c1+=TO_F32(a2)*TO_F32(b1); r3c1+=TO_F32(a3)*TO_F32(b1);
+                  ptrba+=4; ptrbb+=2;
+               }
+             C0[0]=TO_OUTPUT(C_TO_F32(C0[0])+r0c0*ALPHA); C0[1]=TO_OUTPUT(C_TO_F32(C0[1])+r1c0*ALPHA); C0[2]=TO_OUTPUT(C_TO_F32(C0[2])+r2c0*ALPHA); C0[3]=TO_OUTPUT(C_TO_F32(C0[3])+r3c0*ALPHA);
+             C1[0]=TO_OUTPUT(C_TO_F32(C1[0])+r0c1*ALPHA); C1[1]=TO_OUTPUT(C_TO_F32(C1[1])+r1c1*ALPHA); C1[2]=TO_OUTPUT(C_TO_F32(C1[2])+r2c1*ALPHA); C1[3]=TO_OUTPUT(C_TO_F32(C1[3])+r3c1*ALPHA);
+             C0+=4; C1+=4;
+          }
+        if (bm & 2)
+          {
+             ptrbb = bb;
+             r0c0=r1c0=0; r0c1=r1c1=0;
+             for (k=0; k<bk; k+=1)
+               {
+                  b0=ptrbb[0]; b1=ptrbb[1];
+                  a0=ptrba[0]; a1=ptrba[1];
+                  r0c0+=TO_F32(a0)*TO_F32(b0); r1c0+=TO_F32(a1)*TO_F32(b0);
+                  r0c1+=TO_F32(a0)*TO_F32(b1); r1c1+=TO_F32(a1)*TO_F32(b1);
+                  ptrba+=2; ptrbb+=2;
+               }
+             C0[0]=TO_OUTPUT(C_TO_F32(C0[0])+r0c0*ALPHA); C0[1]=TO_OUTPUT(C_TO_F32(C0[1])+r1c0*ALPHA);
+             C1[0]=TO_OUTPUT(C_TO_F32(C1[0])+r0c1*ALPHA); C1[1]=TO_OUTPUT(C_TO_F32(C1[1])+r1c1*ALPHA);
+             C0+=2; C1+=2;
+          }
+        if (bm & 1)
+          {
+             ptrbb = bb;
+             r0c0=0; r0c1=0;
+             for (k=0; k<bk; k+=1)
+               {
+                  b0=ptrbb[0]; b1=ptrbb[1];
+                  a0=ptrba[0];
+                  r0c0+=TO_F32(a0)*TO_F32(b0);
+                  r0c1+=TO_F32(a0)*TO_F32(b1);
+                  ptrba+=1; ptrbb+=2;
+               }
+             C0[0]=TO_OUTPUT(C_TO_F32(C0[0])+r0c0*ALPHA);
+             C1[0]=TO_OUTPUT(C_TO_F32(C1[0])+r0c1*ALPHA);
+             C0+=1; C1+=1;
+          }
+        bb = bb + bk*2;
+        C  = C  + ldc*2;
+     }
+
+   /* ==================== N panel of 1 ==================== */
+   if (bn & 1)
+     {
+        C0 = C;
+        ptrba = ba;
+
+        for (i=0; i<bm/4; i+=1)
+          {
+             ptrbb = bb;
+             r0c0=r1c0=r2c0=r3c0=0;
+             for (k=0; k<bk; k+=1)
+               {
+                  b0=ptrbb[0];
+                  a0=ptrba[0]; a1=ptrba[1]; a2=ptrba[2]; a3=ptrba[3];
+                  r0c0+=TO_F32(a0)*TO_F32(b0); r1c0+=TO_F32(a1)*TO_F32(b0); r2c0+=TO_F32(a2)*TO_F32(b0); r3c0+=TO_F32(a3)*TO_F32(b0);
+                  ptrba+=4; ptrbb+=1;
+               }
+             C0[0]=TO_OUTPUT(C_TO_F32(C0[0])+r0c0*ALPHA); C0[1]=TO_OUTPUT(C_TO_F32(C0[1])+r1c0*ALPHA); C0[2]=TO_OUTPUT(C_TO_F32(C0[2])+r2c0*ALPHA); C0[3]=TO_OUTPUT(C_TO_F32(C0[3])+r3c0*ALPHA);
+             C0+=4;
+          }
+        if (bm & 2)
+          {
+             ptrbb = bb;
+             r0c0=r1c0=0;
+             for (k=0; k<bk; k+=1)
+               {
+                  b0=ptrbb[0];
+                  a0=ptrba[0]; a1=ptrba[1];
+                  r0c0+=TO_F32(a0)*TO_F32(b0); r1c0+=TO_F32(a1)*TO_F32(b0);
+                  ptrba+=2; ptrbb+=1;
+               }
+             C0[0]=TO_OUTPUT(C_TO_F32(C0[0])+r0c0*ALPHA); C0[1]=TO_OUTPUT(C_TO_F32(C0[1])+r1c0*ALPHA);
+             C0+=2;
+          }
+        if (bm & 1)
+          {
+             ptrbb = bb;
+             r0c0=0;
+             for (k=0; k<bk; k+=1)
+               {
+                  r0c0+=TO_F32(ptrba[0])*TO_F32(ptrbb[0]);
+                  ptrba+=1; ptrbb+=1;
+               }
+             C0[0]=TO_OUTPUT(C_TO_F32(C0[0])+r0c0*ALPHA);
+             C0+=1;
+          }
+        bb = bb + bk;
+        C  = C  + ldc;
+     }
+
+   return 0;
+}

kernel/riscv64/kern_u74.S

@@ -0,0 +1,267 @@
+/*
+ * dgemm 4x4 scalar micro-kernel for SiFive U74 (RV64GC, lp64d).  v3:
+ * software-pipelined, full operand double-buffering (P/Q ping-pong), one-
+ * iteration lookahead, LOAD-BEFORE-FMA issue ordering (the U74 dual-issue
+ * pairs a load/int in slot0 with an FP op in slot1, so each fld is emitted
+ * immediately before the fmadd it co-issues with).  16 FP accumulators + 16 FP
+ * operand regs = all 32 FP regs; alpha spilled for the k-loop.  Handles the
+ * bm%4==0 && bn%4==0 grid with EVEN bk (bk>=2); ragged edges + odd bk later.
+ *
+ * int kern_asm(long bm,long bn,long bk,double alpha,double* A,double* B,double* C,long ldc)
+ *   a0=bm a1=bn a2=bk fa0=alpha a3=A a4=B a5=C a6=ldc
+ * acc: col0 ft0..ft3  col1 ft4..ft7  col2 ft8..ft11  col3 fa2..fa5
+ * P: A=fa0,fa1,fa6,fa7  B=fs0,fs1,fs2,fs3    Q: A=fs4,fs5,fs6,fs7  B=fs8,fs9,fs10,fs11
+ * int: t0=ldc*8 t1=bm/4 t2=j t3=ptrA t4=ptrB t5=i t6=pair-cnt  C0..3=a0,a1,a6,a7
+ */
+	.text
+	.p2align 4
+	.globl	kern_asm
+	.type	kern_asm,@function
+kern_asm:
+	addi	sp, sp, -112
+	fsd	fs0, 0(sp)
+	fsd	fs1, 8(sp)
+	fsd	fs2, 16(sp)
+	fsd	fs3, 24(sp)
+	fsd	fs4, 32(sp)
+	fsd	fs5, 40(sp)
+	fsd	fs6, 48(sp)
+	fsd	fs7, 56(sp)
+	fsd	fs8, 64(sp)
+	fsd	fs9, 72(sp)
+	fsd	fs10, 80(sp)
+	fsd	fs11, 88(sp)
+	fsd	fa0, 96(sp)		# spill alpha
+
+	slli	t0, a6, 3		# ldc*8
+	srli	t1, a0, 2		# bm/4
+	srli	t2, a1, 2		# bn/4 (j)
+	beqz	t2, .Ldone
+
+.Lj:
+	mv	a0, a5			# C0 = Crun
+	add	a1, a0, t0		# C1
+	add	a6, a1, t0		# C2
+	add	a7, a6, t0		# C3
+	mv	t3, a3			# ptrA = ba
+	mv	t5, t1			# i = bm/4
+
+.Li:
+	mv	t4, a4			# ptrB = bb(run)
+	fmv.d.x	ft0, zero
+	fmv.d.x	ft1, zero
+	fmv.d.x	ft2, zero
+	fmv.d.x	ft3, zero
+	fmv.d.x	ft4, zero
+	fmv.d.x	ft5, zero
+	fmv.d.x	ft6, zero
+	fmv.d.x	ft7, zero
+	fmv.d.x	ft8, zero
+	fmv.d.x	ft9, zero
+	fmv.d.x	ft10, zero
+	fmv.d.x	ft11, zero
+	fmv.d.x	fa2, zero
+	fmv.d.x	fa3, zero
+	fmv.d.x	fa4, zero
+	fmv.d.x	fa5, zero
+
+	# preload P from k=0, advance to k=1
+	fld	fa0, 0(t3)
+	fld	fa1, 8(t3)
+	fld	fa6, 16(t3)
+	fld	fa7, 24(t3)
+	fld	fs0, 0(t4)
+	fld	fs1, 8(t4)
+	fld	fs2, 16(t4)
+	fld	fs3, 24(t4)
+	addi	t3, t3, 32
+	addi	t4, t4, 32
+	srli	t6, a2, 1		# bk/2
+	addi	t6, t6, -1		# pair-cnt = bk/2 - 1
+	beqz	t6, .Lepi
+
+	.p2align 4
+.Lbody:				# --- P current, load Q (load before paired fmadd) ---
+	fld	fs4, 0(t3)
+	fmadd.d	ft0, fa0, fs0, ft0
+	fld	fs5, 8(t3)
+	fmadd.d	ft1, fa1, fs0, ft1
+	fld	fs6, 16(t3)
+	fmadd.d	ft2, fa6, fs0, ft2
+	fld	fs7, 24(t3)
+	fmadd.d	ft3, fa7, fs0, ft3
+	fld	fs8, 0(t4)
+	fmadd.d	ft4, fa0, fs1, ft4
+	fld	fs9, 8(t4)
+	fmadd.d	ft5, fa1, fs1, ft5
+	fld	fs10, 16(t4)
+	fmadd.d	ft6, fa6, fs1, ft6
+	fld	fs11, 24(t4)
+	fmadd.d	ft7, fa7, fs1, ft7
+	addi	t3, t3, 32
+	fmadd.d	ft8, fa0, fs2, ft8
+	addi	t4, t4, 32
+	fmadd.d	ft9, fa1, fs2, ft9
+	fmadd.d	ft10, fa6, fs2, ft10
+	fmadd.d	ft11, fa7, fs2, ft11
+	fmadd.d	fa2, fa0, fs3, fa2
+	fmadd.d	fa3, fa1, fs3, fa3
+	fmadd.d	fa4, fa6, fs3, fa4
+	fmadd.d	fa5, fa7, fs3, fa5
+				# --- Q current, load P ---
+	fld	fa0, 0(t3)
+	fmadd.d	ft0, fs4, fs8, ft0
+	fld	fa1, 8(t3)
+	fmadd.d	ft1, fs5, fs8, ft1
+	fld	fa6, 16(t3)
+	fmadd.d	ft2, fs6, fs8, ft2
+	fld	fa7, 24(t3)
+	fmadd.d	ft3, fs7, fs8, ft3
+	fld	fs0, 0(t4)
+	fmadd.d	ft4, fs4, fs9, ft4
+	fld	fs1, 8(t4)
+	fmadd.d	ft5, fs5, fs9, ft5
+	fld	fs2, 16(t4)
+	fmadd.d	ft6, fs6, fs9, ft6
+	fld	fs3, 24(t4)
+	fmadd.d	ft7, fs7, fs9, ft7
+	addi	t3, t3, 32
+	fmadd.d	ft8, fs4, fs10, ft8
+	addi	t4, t4, 32
+	fmadd.d	ft9, fs5, fs10, ft9
+	fmadd.d	ft10, fs6, fs10, ft10
+	fmadd.d	ft11, fs7, fs10, ft11
+	fmadd.d	fa2, fs4, fs11, fa2
+	fmadd.d	fa3, fs5, fs11, fa3
+	fmadd.d	fa4, fs6, fs11, fa4
+	fmadd.d	fa5, fs7, fs11, fa5
+	addi	t6, t6, -1
+	bnez	t6, .Lbody
+
+.Lepi:				# --- P current, load last Q ---
+	fld	fs4, 0(t3)
+	fmadd.d	ft0, fa0, fs0, ft0
+	fld	fs5, 8(t3)
+	fmadd.d	ft1, fa1, fs0, ft1
+	fld	fs6, 16(t3)
+	fmadd.d	ft2, fa6, fs0, ft2
+	fld	fs7, 24(t3)
+	fmadd.d	ft3, fa7, fs0, ft3
+	fld	fs8, 0(t4)
+	fmadd.d	ft4, fa0, fs1, ft4
+	fld	fs9, 8(t4)
+	fmadd.d	ft5, fa1, fs1, ft5
+	fld	fs10, 16(t4)
+	fmadd.d	ft6, fa6, fs1, ft6
+	fld	fs11, 24(t4)
+	fmadd.d	ft7, fa7, fs1, ft7
+	addi	t3, t3, 32
+	fmadd.d	ft8, fa0, fs2, ft8
+	addi	t4, t4, 32
+	fmadd.d	ft9, fa1, fs2, ft9
+	fmadd.d	ft10, fa6, fs2, ft10
+	fmadd.d	ft11, fa7, fs2, ft11
+	fmadd.d	fa2, fa0, fs3, fa2
+	fmadd.d	fa3, fa1, fs3, fa3
+	fmadd.d	fa4, fa6, fs3, fa4
+	fmadd.d	fa5, fa7, fs3, fa5
+				# --- Q current, compute only ---
+	fmadd.d	ft0, fs4, fs8, ft0
+	fmadd.d	ft1, fs5, fs8, ft1
+	fmadd.d	ft2, fs6, fs8, ft2
+	fmadd.d	ft3, fs7, fs8, ft3
+	fmadd.d	ft4, fs4, fs9, ft4
+	fmadd.d	ft5, fs5, fs9, ft5
+	fmadd.d	ft6, fs6, fs9, ft6
+	fmadd.d	ft7, fs7, fs9, ft7
+	fmadd.d	ft8, fs4, fs10, ft8
+	fmadd.d	ft9, fs5, fs10, ft9
+	fmadd.d	ft10, fs6, fs10, ft10
+	fmadd.d	ft11, fs7, fs10, ft11
+	fmadd.d	fa2, fs4, fs11, fa2
+	fmadd.d	fa3, fs5, fs11, fa3
+	fmadd.d	fa4, fs6, fs11, fa4
+	fmadd.d	fa5, fs7, fs11, fa5
+
+	# ---- C += acc*alpha ; alpha->fs4, temps fs0/fs1 ----
+	fld	fs4, 96(sp)
+	fld	fs0, 0(a0)
+	fmadd.d	fs0, ft0, fs4, fs0
+	fsd	fs0, 0(a0)
+	fld	fs1, 8(a0)
+	fmadd.d	fs1, ft1, fs4, fs1
+	fsd	fs1, 8(a0)
+	fld	fs0, 16(a0)
+	fmadd.d	fs0, ft2, fs4, fs0
+	fsd	fs0, 16(a0)
+	fld	fs1, 24(a0)
+	fmadd.d	fs1, ft3, fs4, fs1
+	fsd	fs1, 24(a0)
+	fld	fs0, 0(a1)
+	fmadd.d	fs0, ft4, fs4, fs0
+	fsd	fs0, 0(a1)
+	fld	fs1, 8(a1)
+	fmadd.d	fs1, ft5, fs4, fs1
+	fsd	fs1, 8(a1)
+	fld	fs0, 16(a1)
+	fmadd.d	fs0, ft6, fs4, fs0
+	fsd	fs0, 16(a1)
+	fld	fs1, 24(a1)
+	fmadd.d	fs1, ft7, fs4, fs1
+	fsd	fs1, 24(a1)
+	fld	fs0, 0(a6)
+	fmadd.d	fs0, ft8, fs4, fs0
+	fsd	fs0, 0(a6)
+	fld	fs1, 8(a6)
+	fmadd.d	fs1, ft9, fs4, fs1
+	fsd	fs1, 8(a6)
+	fld	fs0, 16(a6)
+	fmadd.d	fs0, ft10, fs4, fs0
+	fsd	fs0, 16(a6)
+	fld	fs1, 24(a6)
+	fmadd.d	fs1, ft11, fs4, fs1
+	fsd	fs1, 24(a6)
+	fld	fs0, 0(a7)
+	fmadd.d	fs0, fa2, fs4, fs0
+	fsd	fs0, 0(a7)
+	fld	fs1, 8(a7)
+	fmadd.d	fs1, fa3, fs4, fs1
+	fsd	fs1, 8(a7)
+	fld	fs0, 16(a7)
+	fmadd.d	fs0, fa4, fs4, fs0
+	fsd	fs0, 16(a7)
+	fld	fs1, 24(a7)
+	fmadd.d	fs1, fa5, fs4, fs1
+	fsd	fs1, 24(a7)
+
+	addi	a0, a0, 32
+	addi	a1, a1, 32
+	addi	a6, a6, 32
+	addi	a7, a7, 32
+	addi	t5, t5, -1
+	bnez	t5, .Li
+
+	slli	t6, a2, 5		# bb(run) += bk*4
+	add	a4, a4, t6
+	slli	t6, t0, 2		# C(run) += 4*ldc
+	add	a5, a5, t6
+	addi	t2, t2, -1
+	bnez	t2, .Lj
+
+.Ldone:
+	fld	fs0, 0(sp)
+	fld	fs1, 8(sp)
+	fld	fs2, 16(sp)
+	fld	fs3, 24(sp)
+	fld	fs4, 32(sp)
+	fld	fs5, 40(sp)
+	fld	fs6, 48(sp)
+	fld	fs7, 56(sp)
+	fld	fs8, 64(sp)
+	fld	fs9, 72(sp)
+	fld	fs10, 80(sp)
+	fld	fs11, 88(sp)
+	addi	sp, sp, 112
+	li	a0, 0
+	ret
+	.size	kern_asm, .-kern_asm

lapack-netlib/SRC/cbbcsd.f

@@ -351,9 +351,9 @@
 *     .. Parameters ..
       INTEGER            MAXITR
       PARAMETER          ( MAXITR = 6 )
-      REAL               HUNDRED, MEIGHTH, ONE, TEN, ZERO
+      REAL               HUNDRED, MEIGHTH, ZERO, ONE, TEN
       PARAMETER          ( HUNDRED = 100.0E0, MEIGHTH = -0.125E0,
-     $                     ONE = 1.0E0, TEN = 10.0E0, ZERO = 0.0E0 )
+     $                     ZERO = 0.0E0, ONE = 1.0E0, TEN = 10.0E0 )
       COMPLEX            NEGONECOMPLEX
       PARAMETER          ( NEGONECOMPLEX = (-1.0E0,0.0E0) )
       REAL               PIOVER2
@@ -576,7 +576,7 @@
                END IF
             ELSE
                NU = SIGMA21
-               MU = SQRT( 1.0 - NU**2 )
+               MU = SQRT( ONE - NU**2 )
                IF( NU .LT. THRESH ) THEN
                   MU = ONE
                   NU = ZERO
@@ -1114,4 +1114,3 @@
 *     End of CBBCSD
 *
       END
-

lapack-netlib/SRC/cgelsy.f

@@ -5,7 +5,6 @@
 * Online html documentation available at
 *            http://www.netlib.org/lapack/explore-html/
 *
-*> \htmlonly
 *> Download CGELSY + dependencies
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cgelsy.f">
 *> [TGZ]</a>
@@ -13,7 +12,6 @@
 *> [ZIP]</a>
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cgelsy.f">
 *> [TXT]</a>
-*> \endhtmlonly
 *
 *  Definition:
 *  ===========
@@ -197,7 +195,7 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \ingroup complexGEsolve
+*> \ingroup gelsy
 *
 *> \par Contributors:
 *  ==================
@@ -207,8 +205,10 @@
 *>    G. Quintana-Orti, Depto. de Informatica, Universidad Jaime I, Spain \n
 *>
 *  =====================================================================
-      SUBROUTINE CGELSY( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK,
+      SUBROUTINE CGELSY( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND,
+     $                   RANK,
      $                   WORK, LWORK, RWORK, INFO )
+      IMPLICIT NONE
 *
 *  -- LAPACK driver routine --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
@@ -244,8 +244,9 @@
       COMPLEX            C1, C2, S1, S2
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           CCOPY, CGEQP3, CLAIC1, CLASCL, CLASET, CTRSM,
-     $                   CTZRZF, CUNMQR, CUNMRZ, SLABAD, XERBLA
+      EXTERNAL           CCOPY, CGEQP3, CLAIC1, CLASCL, CLASET,
+     $                   CTRSM,
+     $                   CTZRZF, CUNMQR, CUNMRZ, XERBLA
 *     ..
 *     .. External Functions ..
       INTEGER            ILAENV
@@ -265,9 +266,9 @@
 *
       INFO = 0
       NB1 = ILAENV( 1, 'CGEQRF', ' ', M, N, -1, -1 )
-      NB2 = ILAENV( 1, 'CGERQF', ' ', M, N, -1, -1 )
+      NB2 = ILAENV( 1, 'CTZRZF', ' ', M, N, -1, -1 )
       NB3 = ILAENV( 1, 'CUNMQR', ' ', M, N, NRHS, -1 )
-      NB4 = ILAENV( 1, 'CUNMRQ', ' ', M, N, NRHS, -1 )
+      NB4 = ILAENV( 1, 'CUNMRZ', ' ', M, N, NRHS, -1 )
       NB = MAX( NB1, NB2, NB3, NB4 )
       LWKOPT = MAX( 1, MN+2*N+NB*(N+1), 2*MN+NB*NRHS )
       WORK( 1 ) = CMPLX( LWKOPT )
@@ -305,7 +306,6 @@
 *
       SMLNUM = SLAMCH( 'S' ) / SLAMCH( 'P' )
       BIGNUM = ONE / SMLNUM
-      CALL SLABAD( SMLNUM, BIGNUM )
 *
 *     Scale A, B if max entries outside range [SMLNUM,BIGNUM]
 *
@@ -338,13 +338,15 @@
 *
 *        Scale matrix norm up to SMLNUM
 *
-         CALL CLASCL( 'G', 0, 0, BNRM, SMLNUM, M, NRHS, B, LDB, INFO )
+         CALL CLASCL( 'G', 0, 0, BNRM, SMLNUM, M, NRHS, B, LDB,
+     $                INFO )
          IBSCL = 1
       ELSE IF( BNRM.GT.BIGNUM ) THEN
 *
 *        Scale matrix norm down to BIGNUM
 *
-         CALL CLASCL( 'G', 0, 0, BNRM, BIGNUM, M, NRHS, B, LDB, INFO )
+         CALL CLASCL( 'G', 0, 0, BNRM, BIGNUM, M, NRHS, B, LDB,
+     $                INFO )
          IBSCL = 2
       END IF
 *
@@ -353,7 +355,7 @@
 *
       CALL CGEQP3( M, N, A, LDA, JPVT, WORK( 1 ), WORK( MN+1 ),
      $             LWORK-MN, RWORK, INFO )
-      WSIZE = MN + REAL( WORK( MN+1 ) )
+      WSIZE = REAL( MN ) + REAL( WORK( MN+1 ) )
 *
 *     complex workspace: MN+NB*(N+1). real workspace 2*N.
 *     Details of Householder rotations stored in WORK(1:MN).
@@ -411,9 +413,10 @@
 *
 *     B(1:M,1:NRHS) := Q**H * B(1:M,1:NRHS)
 *
-      CALL CUNMQR( 'Left', 'Conjugate transpose', M, NRHS, MN, A, LDA,
+      CALL CUNMQR( 'Left', 'Conjugate transpose', M, NRHS, MN, A,
+     $             LDA,
      $             WORK( 1 ), B, LDB, WORK( 2*MN+1 ), LWORK-2*MN, INFO )
-      WSIZE = MAX( WSIZE, 2*MN+REAL( WORK( 2*MN+1 ) ) )
+      WSIZE = MAX( WSIZE, REAL( 2*MN )+REAL( WORK( 2*MN+1 ) ) )
 *
 *     complex workspace: 2*MN+NB*NRHS.
 *
@@ -452,18 +455,22 @@
 *     Undo scaling
 *
       IF( IASCL.EQ.1 ) THEN
-         CALL CLASCL( 'G', 0, 0, ANRM, SMLNUM, N, NRHS, B, LDB, INFO )
+         CALL CLASCL( 'G', 0, 0, ANRM, SMLNUM, N, NRHS, B, LDB,
+     $                INFO )
          CALL CLASCL( 'U', 0, 0, SMLNUM, ANRM, RANK, RANK, A, LDA,
      $                INFO )
       ELSE IF( IASCL.EQ.2 ) THEN
-         CALL CLASCL( 'G', 0, 0, ANRM, BIGNUM, N, NRHS, B, LDB, INFO )
+         CALL CLASCL( 'G', 0, 0, ANRM, BIGNUM, N, NRHS, B, LDB,
+     $                INFO )
          CALL CLASCL( 'U', 0, 0, BIGNUM, ANRM, RANK, RANK, A, LDA,
      $                INFO )
       END IF
       IF( IBSCL.EQ.1 ) THEN
-         CALL CLASCL( 'G', 0, 0, SMLNUM, BNRM, N, NRHS, B, LDB, INFO )
+         CALL CLASCL( 'G', 0, 0, SMLNUM, BNRM, N, NRHS, B, LDB,
+     $                INFO )
       ELSE IF( IBSCL.EQ.2 ) THEN
-         CALL CLASCL( 'G', 0, 0, BIGNUM, BNRM, N, NRHS, B, LDB, INFO )
+         CALL CLASCL( 'G', 0, 0, BIGNUM, BNRM, N, NRHS, B, LDB,
+     $                INFO )
       END IF
 *
    70 CONTINUE

lapack-netlib/SRC/clartg.f90

@@ -203,7 +203,7 @@ subroutine CLARTG( f, g, c, s, r )
             rtmax = rtmax * 2
             if( f2 > rtmin .and. h2 < rtmax ) then
                ! safmin <= sqrt( f2*h2 ) <= safmax
-               s = conjg( g ) * ( f / sqrt( f2*h2 ) )
+               s = ( f / sqrt( f2 ) ) * ( conjg( g ) / sqrt( h2 ) )
             else
                s = conjg( g ) * ( r / h2 )
             end if
@@ -223,7 +223,7 @@ subroutine CLARTG( f, g, c, s, r )
                !  sqrt(safmin) <= f2 * sqrt(safmax) <= h2 / sqrt(f2 * h2) <= h2 * (safmin / f2) <= h2 <= safmax
                r = f * ( h2 / d )
             end if
-            s = conjg( g ) * ( f / d )
+            s = ( f / sqrt( f2 ) ) * ( conjg( g ) / sqrt( h2 ) )
          end if
       else
 !
@@ -259,7 +259,7 @@ subroutine CLARTG( f, g, c, s, r )
             rtmax = rtmax * 2
             if( f2 > rtmin .and. h2 < rtmax ) then
                ! safmin <= sqrt( f2*h2 ) <= safmax
-               s = conjg( gs ) * ( fs / sqrt( f2*h2 ) )
+               s = ( fs / sqrt( f2 ) ) * ( conjg( gs ) / sqrt( h2 ) )
             else
                s = conjg( gs ) * ( r / h2 )
             end if
@@ -279,7 +279,7 @@ subroutine CLARTG( f, g, c, s, r )
                !  sqrt(safmin) <= f2 * sqrt(safmax) <= h2 / sqrt(f2 * h2) <= h2 * (safmin / f2) <= h2 <= safmax
                r = fs * ( h2 / d )
             end if
-            s = conjg( gs ) * ( fs / d )
+            s = ( fs / sqrt( f2 ) ) * ( conjg( gs ) / sqrt( h2 ) )
          end if
          ! Rescale c and r
          c = c * w

lapack-netlib/SRC/ctgsja.f

@@ -414,17 +414,19 @@
 *     ..
 *     .. External Functions ..
       LOGICAL            LSAME
-      EXTERNAL           LSAME
+      REAL               SLAMCH
+      EXTERNAL           LSAME, SLAMCH
 *     ..
 *     .. External Subroutines ..
       EXTERNAL           CCOPY, CLAGS2, CLAPLL, CLASET, CROT, CSSCAL,
      $                   SLARTG, XERBLA
 *     ..
 *     .. Intrinsic Functions ..
-      INTRINSIC          ABS, CONJG, MAX, MIN, REAL, HUGE
-      PARAMETER          ( HUGENUM = HUGE(ZERO) )
+      INTRINSIC          ABS, CONJG, MAX, MIN, REAL
 *     ..
 *     .. Executable Statements ..
+*
+      HUGENUM = SLAMCH( 'O' )
 *
 *     Decode and test the input parameters
 *

lapack-netlib/SRC/dbbcsd.f

@@ -351,9 +351,9 @@
 *     .. Parameters ..
       INTEGER            MAXITR
       PARAMETER          ( MAXITR = 6 )
-      DOUBLE PRECISION   HUNDRED, MEIGHTH, ONE, TEN, ZERO
+      DOUBLE PRECISION   HUNDRED, MEIGHTH, ZERO, ONE, TEN
       PARAMETER          ( HUNDRED = 100.0D0, MEIGHTH = -0.125D0,
-     $                     ONE = 1.0D0, TEN = 10.0D0, ZERO = 0.0D0 )
+     $                     ZERO = 0.0D0, ONE = 1.0D0, TEN = 10.0D0 )
       DOUBLE PRECISION   NEGONE
       PARAMETER          ( NEGONE = -1.0D0 )
       DOUBLE PRECISION   PIOVER2
@@ -576,7 +576,7 @@
                END IF
             ELSE
                NU = SIGMA21
-               MU = SQRT( 1.0 - NU**2 )
+               MU = SQRT( ONE - NU**2 )
                IF( NU .LT. THRESH ) THEN
                   MU = ONE
                   NU = ZERO
@@ -1108,4 +1108,3 @@
 *     End of DBBCSD
 *
       END
-

lapack-netlib/SRC/dgelsy.f

@@ -5,7 +5,6 @@
 * Online html documentation available at
 *            http://www.netlib.org/lapack/explore-html/
 *
-*> \htmlonly
 *> Download DGELSY + dependencies
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgelsy.f">
 *> [TGZ]</a>
@@ -13,7 +12,6 @@
 *> [ZIP]</a>
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgelsy.f">
 *> [TXT]</a>
-*> \endhtmlonly
 *
 *  Definition:
 *  ===========
@@ -191,7 +189,7 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \ingroup doubleGEsolve
+*> \ingroup gelsy
 *
 *> \par Contributors:
 *  ==================
@@ -201,8 +199,10 @@
 *>    G. Quintana-Orti, Depto. de Informatica, Universidad Jaime I, Spain \n
 *>
 *  =====================================================================
-      SUBROUTINE DGELSY( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK,
+      SUBROUTINE DGELSY( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND,
+     $                   RANK,
      $                   WORK, LWORK, INFO )
+      IMPLICIT NONE
 *
 *  -- LAPACK driver routine --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
@@ -238,7 +238,8 @@
       EXTERNAL           ILAENV, DLAMCH, DLANGE
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           DCOPY, DGEQP3, DLABAD, DLAIC1, DLASCL, DLASET,
+      EXTERNAL           DCOPY, DGEQP3, DLAIC1, DLASCL,
+     $                   DLASET,
      $                   DORMQR, DORMRZ, DTRSM, DTZRZF, XERBLA
 *     ..
 *     .. Intrinsic Functions ..
@@ -274,9 +275,9 @@
             LWKOPT = 1
          ELSE
             NB1 = ILAENV( 1, 'DGEQRF', ' ', M, N, -1, -1 )
-            NB2 = ILAENV( 1, 'DGERQF', ' ', M, N, -1, -1 )
+            NB2 = ILAENV( 1, 'DTZRZF', ' ', M, N, -1, -1 )
             NB3 = ILAENV( 1, 'DORMQR', ' ', M, N, NRHS, -1 )
-            NB4 = ILAENV( 1, 'DORMRQ', ' ', M, N, NRHS, -1 )
+            NB4 = ILAENV( 1, 'DORMRZ', ' ', M, N, NRHS, -1 )
             NB = MAX( NB1, NB2, NB3, NB4 )
             LWKMIN = MN + MAX( 2*MN, N + 1, MN + NRHS )
             LWKOPT = MAX( LWKMIN,
@@ -307,7 +308,6 @@
 *
       SMLNUM = DLAMCH( 'S' ) / DLAMCH( 'P' )
       BIGNUM = ONE / SMLNUM
-      CALL DLABAD( SMLNUM, BIGNUM )
 *
 *     Scale A, B if max entries outside range [SMLNUM,BIGNUM]
 *
@@ -340,13 +340,15 @@
 *
 *        Scale matrix norm up to SMLNUM
 *
-         CALL DLASCL( 'G', 0, 0, BNRM, SMLNUM, M, NRHS, B, LDB, INFO )
+         CALL DLASCL( 'G', 0, 0, BNRM, SMLNUM, M, NRHS, B, LDB,
+     $                INFO )
          IBSCL = 1
       ELSE IF( BNRM.GT.BIGNUM ) THEN
 *
 *        Scale matrix norm down to BIGNUM
 *
-         CALL DLASCL( 'G', 0, 0, BNRM, BIGNUM, M, NRHS, B, LDB, INFO )
+         CALL DLASCL( 'G', 0, 0, BNRM, BIGNUM, M, NRHS, B, LDB,
+     $                INFO )
          IBSCL = 2
       END IF
 *
@@ -413,7 +415,8 @@
 *
 *     B(1:M,1:NRHS) := Q**T * B(1:M,1:NRHS)
 *
-      CALL DORMQR( 'Left', 'Transpose', M, NRHS, MN, A, LDA, WORK( 1 ),
+      CALL DORMQR( 'Left', 'Transpose', M, NRHS, MN, A, LDA,
+     $             WORK( 1 ),
      $             B, LDB, WORK( 2*MN+1 ), LWORK-2*MN, INFO )
       WSIZE = MAX( WSIZE, 2*MN+WORK( 2*MN+1 ) )
 *
@@ -454,18 +457,22 @@
 *     Undo scaling
 *
       IF( IASCL.EQ.1 ) THEN
-         CALL DLASCL( 'G', 0, 0, ANRM, SMLNUM, N, NRHS, B, LDB, INFO )
+         CALL DLASCL( 'G', 0, 0, ANRM, SMLNUM, N, NRHS, B, LDB,
+     $                INFO )
          CALL DLASCL( 'U', 0, 0, SMLNUM, ANRM, RANK, RANK, A, LDA,
      $                INFO )
       ELSE IF( IASCL.EQ.2 ) THEN
-         CALL DLASCL( 'G', 0, 0, ANRM, BIGNUM, N, NRHS, B, LDB, INFO )
+         CALL DLASCL( 'G', 0, 0, ANRM, BIGNUM, N, NRHS, B, LDB,
+     $                INFO )
          CALL DLASCL( 'U', 0, 0, BIGNUM, ANRM, RANK, RANK, A, LDA,
      $                INFO )
       END IF
       IF( IBSCL.EQ.1 ) THEN
-         CALL DLASCL( 'G', 0, 0, SMLNUM, BNRM, N, NRHS, B, LDB, INFO )
+         CALL DLASCL( 'G', 0, 0, SMLNUM, BNRM, N, NRHS, B, LDB,
+     $                INFO )
       ELSE IF( IBSCL.EQ.2 ) THEN
-         CALL DLASCL( 'G', 0, 0, BIGNUM, BNRM, N, NRHS, B, LDB, INFO )
+         CALL DLASCL( 'G', 0, 0, BIGNUM, BNRM, N, NRHS, B, LDB,
+     $                INFO )
       END IF
 *
    70 CONTINUE

lapack-netlib/SRC/dlaruv.f

@@ -426,10 +426,10 @@
 *           the statistically correct thing to do in this situation is
 *           simply to iterate again.
 *           N.B. the case X( I ) = 0.0 should not be possible.
-            I1 = I1 + 2
-            I2 = I2 + 2
-            I3 = I3 + 2
-            I4 = I4 + 2
+            I1 = IT1
+            I2 = IT2
+            I3 = IT3
+            I4 = IT4
             GOTO 20
          END IF
 *

lapack-netlib/SRC/dtgsja.f

@@ -409,17 +409,19 @@
 *     ..
 *     .. External Functions ..
       LOGICAL            LSAME
-      EXTERNAL           LSAME
+      DOUBLE PRECISION   DLAMCH
+      EXTERNAL           LSAME, DLAMCH
 *     ..
 *     .. External Subroutines ..
       EXTERNAL           DCOPY, DLAGS2, DLAPLL, DLARTG, DLASET, DROT,
      $                   DSCAL, XERBLA
 *     ..
 *     .. Intrinsic Functions ..
-      INTRINSIC          ABS, MAX, MIN, HUGE
-      PARAMETER          ( HUGENUM = HUGE(ZERO) )
+      INTRINSIC          ABS, MAX, MIN
 *     ..
 *     .. Executable Statements ..
+*
+      HUGENUM = DLAMCH( 'O' )
 *
 *     Decode and test the input parameters
 *

lapack-netlib/SRC/ilaenv.f

@@ -276,6 +276,16 @@
          ELSE
              NB = 32
          END IF
+      ELSE IF( SUBNAM(2:6).EQ.'TZRZF' ) THEN
+         IF( SNAME ) THEN
+             NB = 64
+         ELSE
+             NB = 32
+         END IF
+      ELSE IF( SUBNAM(2:6).EQ.'ORMRZ' ) THEN
+             NB = 64
+      ELSE IF( SUBNAM(2:6).EQ.'UNMRZ' ) THEN
+             NB = 32
       ELSE IF( C2.EQ.'GE' ) THEN
          IF( C3.EQ.'TRF' ) THEN
             IF( SNAME ) THEN

lapack-netlib/SRC/lapacke_cgesvdq_work.c

@@ -1,165 +0,0 @@
-/*****************************************************************************
-  Copyright (c) 2014, Intel Corp.
-  All rights reserved.
-
-  Redistribution and use in source and binary forms, with or without
-  modification, are permitted provided that the following conditions are met:
-
-    * Redistributions of source code must retain the above copyright notice,
-      this list of conditions and the following disclaimer.
-    * Redistributions in binary form must reproduce the above copyright
-      notice, this list of conditions and the following disclaimer in the
-      documentation and/or other materials provided with the distribution.
-    * Neither the name of Intel Corporation nor the names of its contributors
-      may be used to endorse or promote products derived from this software
-      without specific prior written permission.
-
-  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
-  AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
-  IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
-  ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
-  LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
-  CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
-  SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-  INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
-  CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
-  ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
-  THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function cgesvdq
-* Author: Intel Corporation
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_cgesvdq_work( int matrix_layout, char joba, char jobp,
-                           char jobr, char jobu, char jobv,
-                           lapack_int m, lapack_int n, lapack_complex_float* a,
-                           lapack_int lda, float* s, lapack_complex_float* u, lapack_int ldu,
-                           lapack_complex_float* v, lapack_int ldv, lapack_int* numrank,
-                           lapack_int* iwork, lapack_int liwork,
-                           lapack_complex_float* cwork, lapack_int lcwork,
-                           float* rwork, lapack_int lrwork )
-{
-    lapack_int info = 0;
-    if( matrix_layout == LAPACK_COL_MAJOR ) {
-        /* Call LAPACK function and adjust info */
-        LAPACK_cgesvdq( &joba, &jobp, &jobr, &jobu, &jobv, &m, &n, a, &lda, s, u, &ldu, v, &ldv,
-                       numrank, iwork, &liwork, cwork, &lcwork, rwork, &lrwork, &info );
-        if( info < 0 ) {
-            info = info - 1;
-        }
-    } else if( matrix_layout == LAPACK_ROW_MAJOR ) {
-        lapack_int nrows_u = LAPACKE_lsame( jobu, 'a' ) ||
-                             LAPACKE_lsame( jobu, 'u' ) ||
-                             LAPACKE_lsame( jobu, 'r' ) ||
-                             LAPACKE_lsame( jobu, 'f' ) ||
-                             LAPACKE_lsame( jobu, 's' ) ? m : 1;
-        lapack_int ncols_u = LAPACKE_lsame( jobu, 'a' ) ? m :
-                             ( LAPACKE_lsame( jobu, 's' ) ||
-                             (LAPACKE_lsame( jobu, 'u' ) ) ? MIN(m,n) : 1);
-        lapack_int nrows_v = ( LAPACKE_lsame( jobv, 'a' ) ||
-                             LAPACKE_lsame( jobv, 'v' ) ||
-                             LAPACKE_lsame( jobv, 'r' )) ? n : 1;
-        lapack_int lda_t = MAX(1,m);
-        lapack_int ldu_t = MAX(1,nrows_u);
-        lapack_int ldv_t = MAX(1,nrows_v);
-        lapack_complex_float* a_t = NULL;
-        lapack_complex_float* u_t = NULL;
-        lapack_complex_float* v_t = NULL;
-        /* Check leading dimension(s) */
-        if( lda < n ) {
-            info = -9;
-            LAPACKE_xerbla( "LAPACKE_cgesvdq_work", info );
-            return info;
-        }
-        if( ldu < ncols_u ) {
-            info = -12;
-            LAPACKE_xerbla( "LAPACKE_cgesvdq_work", info );
-            return info;
-        }
-        if( ldv < n ) {
-            info = -14;
-            LAPACKE_xerbla( "LAPACKE_cgesvdq_work", info );
-            return info;
-        }
-        /* Query optimal working array(s) size if requested */
-        if( lcwork == -1 ) {
-            LAPACK_cgesvdq( &joba, &jobp, &jobr, &jobu, &jobv, &m, &n, a, &lda_t,
-                             s, u, &ldu_t, v, &ldv_t, numrank, iwork, &liwork,
-                             cwork, &lcwork, rwork, &lrwork, &info );
-            return (info < 0) ? (info - 1) : info;
-        }
-        /* Allocate memory for temporary array(s) */
-        a_t = (lapack_complex_float*)LAPACKE_malloc( sizeof(lapack_complex_float) * lda_t * MAX(1,n) );
-        if( a_t == NULL ) {
-            info = LAPACK_TRANSPOSE_MEMORY_ERROR;
-            goto exit_level_0;
-        }
-        if( LAPACKE_lsame( jobu, 'a' ) || LAPACKE_lsame( jobu, 's' ) ||
-                LAPACKE_lsame( jobu, 'u' ) ||
-                LAPACKE_lsame( jobu, 'r' ) ||
-                LAPACKE_lsame( jobu, 'f' ) ) {
-            u_t = (lapack_complex_float*)
-                LAPACKE_malloc( sizeof(lapack_complex_float) * ldu_t * MAX(1,ncols_u) );
-            if( u_t == NULL ) {
-                info = LAPACK_TRANSPOSE_MEMORY_ERROR;
-                goto exit_level_1;
-            }
-        }
-        if( LAPACKE_lsame( jobv, 'a' ) || LAPACKE_lsame( jobv, 'v' ) ||
-                LAPACKE_lsame( jobv, 'r' ) ) {
-            v_t = (lapack_complex_float*)
-                LAPACKE_malloc( sizeof(lapack_complex_float) * ldv_t * MAX(1,n) );
-            if( v_t == NULL ) {
-                info = LAPACK_TRANSPOSE_MEMORY_ERROR;
-                goto exit_level_2;
-            }
-        }
-        /* Transpose input matrices */
-        LAPACKE_cge_trans( matrix_layout, m, n, a, lda, a_t, lda_t );
-        /* Call LAPACK function and adjust info */
-            LAPACK_cgesvdq( &joba, &jobp, &jobr, &jobu, &jobv, &m, &n, a, &lda_t,
-                             s, u, &ldu_t, v, &ldv_t, numrank, iwork, &liwork,
-                             cwork, &lcwork, rwork, &lrwork, &info );
-        if( info < 0 ) {
-            info = info - 1;
-        }
-        /* Transpose output matrices */
-        LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
-        if( LAPACKE_lsame( jobu, 'a' ) ||LAPACKE_lsame( jobu, 's' ) ||
-                LAPACKE_lsame( jobu, 'u' ) ||
-                LAPACKE_lsame( jobu, 'r' ) ||
-                LAPACKE_lsame( jobu, 'f' ) ) {
-            LAPACKE_cge_trans( LAPACK_COL_MAJOR, nrows_u, ncols_u, u_t, ldu_t,
-                               u, ldu );
-        }
-        if( LAPACKE_lsame( jobv, 'a' ) || LAPACKE_lsame( jobv, 'v' ) ||
-                LAPACKE_lsame( jobv, 'r' )) {
-            LAPACKE_cge_trans( LAPACK_COL_MAJOR, nrows_v, n, v_t, ldv_t, v,
-                               ldv );
-        }
-        /* Release memory and exit */
-        if( LAPACKE_lsame( jobv, 'a' ) || LAPACKE_lsame( jobv, 'v' ) ||
-                LAPACKE_lsame( jobv, 'r' ) ) {
-            LAPACKE_free( v_t );
-        }
-exit_level_2:
-        if( LAPACKE_lsame( jobu, 'a' ) || LAPACKE_lsame( jobu, 's' ) ||
-                LAPACKE_lsame( jobu, 'u' ) ||
-                LAPACKE_lsame( jobu, 'r' ) ||
-                LAPACKE_lsame( jobu, 'f' ) ) {
-            LAPACKE_free( u_t );
-        }
-exit_level_1:
-        LAPACKE_free( a_t );
-exit_level_0:
-        if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
-            LAPACKE_xerbla( "LAPACKE_cgesvdq_work", info );
-        }
-    } else {
-        info = -1;
-        LAPACKE_xerbla( "LAPACKE_cgesvdq_work", info );
-    }
-    return info;
-}

lapack-netlib/SRC/lapacke_dgesvdq_work.c

@@ -1,165 +0,0 @@
-/*****************************************************************************
-  Copyright (c) 2014, Intel Corp.
-  All rights reserved.
-
-  Redistribution and use in source and binary forms, with or without
-  modification, are permitted provided that the following conditions are met:
-
-    * Redistributions of source code must retain the above copyright notice,
-      this list of conditions and the following disclaimer.
-    * Redistributions in binary form must reproduce the above copyright
-      notice, this list of conditions and the following disclaimer in the
-      documentation and/or other materials provided with the distribution.
-    * Neither the name of Intel Corporation nor the names of its contributors
-      may be used to endorse or promote products derived from this software
-      without specific prior written permission.
-
-  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
-  AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
-  IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
-  ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
-  LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
-  CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
-  SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-  INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
-  CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
-  ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
-  THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function dgesvdq
-* Author: Intel Corporation
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_dgesvdq_work( int matrix_layout, char joba, char jobp,
-                           char jobr, char jobu, char jobv,
-                           lapack_int m, lapack_int n, double* a,
-                           lapack_int lda, double* s, double* u, lapack_int ldu,
-                           double* v, lapack_int ldv, lapack_int* numrank,
-                           lapack_int* iwork, lapack_int liwork,
-                           double* work, lapack_int lwork,
-                           double* rwork, lapack_int lrwork )
-{
-    lapack_int info = 0;
-    if( matrix_layout == LAPACK_COL_MAJOR ) {
-        /* Call LAPACK function and adjust info */
-        LAPACK_dgesvdq( &joba, &jobp, &jobr, &jobu, &jobv, &m, &n, a, &lda, s, u, &ldu, v, &ldv,
-                       numrank, iwork, &liwork, work, &lwork, rwork, &lrwork, &info );
-        if( info < 0 ) {
-            info = info - 1;
-        }
-    } else if( matrix_layout == LAPACK_ROW_MAJOR ) {
-        lapack_int nrows_u = ( LAPACKE_lsame( jobu, 'a' ) ||
-                             LAPACKE_lsame( jobu, 'u' ) ||
-                             LAPACKE_lsame( jobu, 'r' ) ||
-                             LAPACKE_lsame( jobu, 'f' ) ||
-                             LAPACKE_lsame( jobu, 's' ) ) ? m : 1;
-        lapack_int ncols_u = LAPACKE_lsame( jobu, 'a' ) ? m :
-                             ( (LAPACKE_lsame( jobu, 's' ) ||
-                             LAPACKE_lsame( jobu, 'u' ) ) ? MIN(m,n) : 1);
-        lapack_int nrows_v = ( LAPACKE_lsame( jobv, 'a' ) ||
-                             LAPACKE_lsame( jobu, 'v' ) ||
-                             LAPACKE_lsame( jobu, 'r' )) ? n : 1;
-        lapack_int lda_t = MAX(1,m);
-        lapack_int ldu_t = MAX(1,nrows_u);
-        lapack_int ldv_t = MAX(1,nrows_v);
-        double* a_t = NULL;
-        double* u_t = NULL;
-        double* v_t = NULL;
-        /* Check leading dimension(s) */
-        if( lda < n ) {
-            info = -9;
-            LAPACKE_xerbla( "LAPACKE_dgesvdq_work", info );
-            return info;
-        }
-        if( ldu < ncols_u ) {
-            info = -12;
-            LAPACKE_xerbla( "LAPACKE_dgesvdq_work", info );
-            return info;
-        }
-        if( ldv < n ) {
-            info = -14;
-            LAPACKE_xerbla( "LAPACKE_dgesvdq_work", info );
-            return info;
-        }
-        /* Query optimal working array(s) size if requested */
-        if( lwork == -1 ) {
-            LAPACK_dgesvdq( &joba, &jobp, &jobr, &jobu, &jobv, &m, &n, a, &lda_t,
-                             s, u, &ldu_t, v, &ldv_t, numrank, iwork, &liwork,
-                             work, &lwork, rwork, &lrwork, &info );
-            return (info < 0) ? (info - 1) : info;
-        }
-        /* Allocate memory for temporary array(s) */
-        a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
-        if( a_t == NULL ) {
-            info = LAPACK_TRANSPOSE_MEMORY_ERROR;
-            goto exit_level_0;
-        }
-        if( LAPACKE_lsame( jobu, 'a' ) || LAPACKE_lsame( jobu, 's' ) ||
-                LAPACKE_lsame( jobu, 'u' ) ||
-                LAPACKE_lsame( jobu, 'r' ) ||
-                LAPACKE_lsame( jobu, 'f' ) ) {
-            u_t = (double*)
-                LAPACKE_malloc( sizeof(double) * ldu_t * MAX(1,ncols_u) );
-            if( u_t == NULL ) {
-                info = LAPACK_TRANSPOSE_MEMORY_ERROR;
-                goto exit_level_1;
-            }
-        }
-        if( LAPACKE_lsame( jobv, 'a' ) || LAPACKE_lsame( jobv, 'v' ) ||
-                LAPACKE_lsame( jobu, 'r' ) ) {
-            v_t = (double*)
-                LAPACKE_malloc( sizeof(double) * ldv_t * MAX(1,n) );
-            if( v_t == NULL ) {
-                info = LAPACK_TRANSPOSE_MEMORY_ERROR;
-                goto exit_level_2;
-            }
-        }
-        /* Transpose input matrices */
-        LAPACKE_dge_trans( matrix_layout, m, n, a, lda, a_t, lda_t );
-        /* Call LAPACK function and adjust info */
-            LAPACK_dgesvdq( &joba, &jobp, &jobr, &jobu, &jobv, &m, &n, a, &lda_t,
-                             s, u, &ldu_t, v, &ldv_t, numrank, iwork, &liwork,
-                             work, &lwork, rwork, &lrwork, &info );
-        if( info < 0 ) {
-            info = info - 1;
-        }
-        /* Transpose output matrices */
-        LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
-        if( LAPACKE_lsame( jobu, 'a' ) || LAPACKE_lsame( jobu, 's' ) ||
-                LAPACKE_lsame( jobu, 'u' ) ||
-                LAPACKE_lsame( jobu, 'r' ) ||
-                LAPACKE_lsame( jobu, 'f' ) ) {
-            LAPACKE_dge_trans)( LAPACK_COL_MAJOR, nrows_u, ncols_u, u_t, ldu_t,
-                               u, ldu );
-        }
-        if( LAPACKE_lsame( jobv, 'a' ) || LAPACKE_lsame( jobv, 'v' ) ||
-                LAPACKE_lsame( jobu, 'r' )) {
-            LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrows_v, n, v_t, ldv_t, v,
-                               ldv );
-        }
-        /* Release memory and exit */
-        if( LAPACKE_lsame( jobv, 'a' ) || LAPACKE_lsame( jobv, 'v' ) ||
-                LAPACKE_lsame( jobu, 'r' ) ) {
-            LAPACKE_free( v_t );
-        }
-exit_level_2:
-        if( LAPACKE_lsame( jobu, 'a' ) || LAPACKE_lsame( jobu, 's' ) ||
-                LAPACKE_lsame( jobu, 'u' ) ||
-                LAPACKE_lsame( jobu, 'r' ) ||
-                LAPACKE_lsame( jobu, 'f' ) ) {
-            LAPACKE_free( u_t );
-        }
-exit_level_1:
-        LAPACKE_free( a_t );
-exit_level_0:
-        if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
-            LAPACKE_xerbla( "LAPACKE_dgesvdq_work", info );
-        }
-    } else {
-        info = -1;
-        LAPACKE_xerbla( "LAPACKE_dgesvdq_work", info );
-    }
-    return info;
-}

lapack-netlib/SRC/lapacke_sgesvdq_work.c

@@ -1,165 +0,0 @@
-/*****************************************************************************
-  Copyright (c) 2014, Intel Corp.
-  All rights reserved.
-
-  Redistribution and use in source and binary forms, with or without
-  modification, are permitted provided that the following conditions are met:
-
-    * Redistributions of source code must retain the above copyright notice,
-      this list of conditions and the following disclaimer.
-    * Redistributions in binary form must reproduce the above copyright
-      notice, this list of conditions and the following disclaimer in the
-      documentation and/or other materials provided with the distribution.
-    * Neither the name of Intel Corporation nor the names of its contributors
-      may be used to endorse or promote products derived from this software
-      without specific prior written permission.
-
-  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
-  AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
-  IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
-  ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
-  LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
-  CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
-  SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-  INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
-  CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
-  ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
-  THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function sgesvdq
-* Author: Intel Corporation
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_sgesvdq_work( int matrix_layout, char joba, char jobp,
-                           char jobr, char jobu, char jobv,
-                           lapack_int m, lapack_int n, float* a,
-                           lapack_int lda, float* s, float* u, lapack_int ldu,
-                           float* v, lapack_int ldv, lapack_int* numrank,
-                           lapack_int* iwork, lapack_int liwork,
-                           float* work, lapack_int lwork,
-                           float* rwork, lapack_int lrwork )
-{
-    lapack_int info = 0;
-    if( matrix_layout == LAPACK_COL_MAJOR ) {
-        /* Call LAPACK function and adjust info */
-        LAPACK_sgesvdq( &joba, &jobp, &jobr, &jobu, &jobv, &m, &n, a, &lda, s, u, &ldu, v, &ldv,
-                       numrank, iwork, &liwork, work, &lwork, rwork, &lrwork, &info );
-        if( info < 0 ) {
-            info = info - 1;
-        }
-    } else if( matrix_layout == LAPACK_ROW_MAJOR ) {
-        lapack_int nrows_u = ( LAPACKE_lsame( jobu, 'a' ) ||
-                             LAPACKE_lsame( jobu, 'u' ) ||
-                             LAPACKE_lsame( jobu, 'r' ) ||
-                             LAPACKE_lsame( jobu, 'f' ) ||
-                             LAPACKE_lsame( jobu, 's' ) ) ? m : 1;
-        lapack_int ncols_u = LAPACKE_lsame( jobu, 'a' ) ? m :
-                             ( (LAPACKE_lsame( jobu, 's' ) ||
-                             LAPACKE_lsame( jobu, 'u' ) ) ? MIN(m,n) : 1);
-        lapack_int nrows_v = ( LAPACKE_lsame( jobv, 'a' ) ||
-                             LAPACKE_lsame( jobv, 'v' ) ||
-                             LAPACKE_lsame( jobv, 'r' )) ? n : 1;
-        lapack_int lda_t = MAX(1,m);
-        lapack_int ldu_t = MAX(1,nrows_u);
-        lapack_int ldv_t = MAX(1,nrows_v);
-        float* a_t = NULL;
-        float* u_t = NULL;
-        float* v_t = NULL;
-        /* Check leading dimension(s) */
-        if( lda < n ) {
-            info = -9;
-            LAPACKE_xerbla( "LAPACKE_sgesvdq_work", info );
-            return info;
-        }
-        if( ldu < ncols_u ) {
-            info = -12;
-            LAPACKE_xerbla( "LAPACKE_sgesvdq_work", info );
-            return info;
-        }
-        if( ldv < n ) {
-            info = -14;
-            LAPACKE_xerbla( "LAPACKE_sgesvdq_work", info );
-            return info;
-        }
-        /* Query optimal working array(s) size if requested */
-        if( lwork == -1 ) {
-            LAPACK_sgesvdq( &joba, &jobp, &jobr, &jobu, &jobv, &m, &n, a, &lda_t,
-                             s, u, &ldu_t, v, &ldv_t, numrank, iwork, &liwork,
-                             work, &lwork, rwork, &lrwork, &info );
-            return (info < 0) ? (info - 1) : info;
-        }
-        /* Allocate memory for temporary array(s) */
-        a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
-        if( a_t == NULL ) {
-            info = LAPACK_TRANSPOSE_MEMORY_ERROR;
-            goto exit_level_0;
-        }
-        if( LAPACKE_lsame( jobu, 'a' ) || LAPACKE_lsame( jobu, 's' ) ||
-                LAPACKE_lsame( jobu, 'u' ) ||
-                LAPACKE_lsame( jobu, 'r' ) ||
-                LAPACKE_lsame( jobu, 'f' ) ) {
-            u_t = (float*)
-                LAPACKE_malloc( sizeof(float) * ldu_t * MAX(1,ncols_u) );
-            if( u_t == NULL ) {
-                info = LAPACK_TRANSPOSE_MEMORY_ERROR;
-                goto exit_level_1;
-            }
-        }
-        if( LAPACKE_lsame( jobv, 'a' ) || LAPACKE_lsame( jobv, 'v' ) ||
-                LAPACKE_lsame( jobv, 'r' ) ) {
-            v_t = (float*)
-                LAPACKE_malloc( sizeof(float) * ldv_t * MAX(1,n) );
-            if( v_t == NULL ) {
-                info = LAPACK_TRANSPOSE_MEMORY_ERROR;
-                goto exit_level_2;
-            }
-        }
-        /* Transpose input matrices */
-        LAPACKE_sge_trans( matrix_layout, m, n, a, lda, a_t, lda_t );
-        /* Call LAPACK function and adjust info */
-            LAPACK_sgesvdq( &joba, &jobp, &jobr, &jobu, &jobv, &m, &n, a, &lda_t,
-                             s, u, &ldu_t, v, &ldv_t, numrank, iwork, &liwork,
-                             work, &lwork, rwork, &lrwork, &info );
-        if( info < 0 ) {
-            info = info - 1;
-        }
-        /* Transpose output matrices */
-        LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
-        if( LAPACKE_lsame( jobu, 'a' ) || LAPACKE_lsame( jobu, 's' ) ||
-                LAPACKE_lsame( jobu, 'u' ) ||
-                LAPACKE_lsame( jobu, 'r' ) ||
-                LAPACKE_lsame( jobu, 'f' ) ) {
-            LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_u, ncols_u, u_t, ldu_t,
-                               u, ldu );
-        }
-        if( LAPACKE_lsame( jobv, 'a' ) || LAPACKE_lsame( jobv, 'v' ) ||
-                LAPACKE_lsame( jobv, 'r' )) {
-            LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_v, n, v_t, ldv_t, v,
-                               ldv );
-        }
-        /* Release memory and exit */
-        if( LAPACKE_lsame( jobv, 'a' ) || LAPACKE_lsame( jobv, 'v' ) ||
-                LAPACKE_lsame( jobv, 'r' ) ) {
-            LAPACKE_free( v_t );
-        }
-exit_level_2:
-        if( LAPACKE_lsame( jobu, 'a' ) || LAPACKE_lsame( jobu, 's' ) ||
-                LAPACKE_lsame( jobu, 'u' ) ||
-                LAPACKE_lsame( jobu, 'r' ) ||
-                LAPACKE_lsame( jobu, 'f' ) ) {
-            LAPACKE_free( u_t );
-        }
-exit_level_1:
-        LAPACKE_free( a_t );
-exit_level_0:
-        if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
-            LAPACKE_xerbla( "LAPACKE_sgesvdq_work", info );
-        }
-    } else {
-        info = -1;
-        LAPACKE_xerbla( "LAPACKE_sgesvdq_work", info );
-    }
-    return info;
-}

lapack-netlib/SRC/lapacke_zgesvdq_work.c

@@ -1,165 +0,0 @@
-/*****************************************************************************
-  Copyright (c) 2014, Intel Corp.
-  All rights reserved.
-
-  Redistribution and use in source and binary forms, with or without
-  modification, are permitted provided that the following conditions are met:
-
-    * Redistributions of source code must retain the above copyright notice,
-      this list of conditions and the following disclaimer.
-    * Redistributions in binary form must reproduce the above copyright
-      notice, this list of conditions and the following disclaimer in the
-      documentation and/or other materials provided with the distribution.
-    * Neither the name of Intel Corporation nor the names of its contributors
-      may be used to endorse or promote products derived from this software
-      without specific prior written permission.
-
-  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
-  AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
-  IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
-  ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
-  LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
-  CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
-  SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-  INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
-  CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
-  ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
-  THE POSSIBILITY OF SUCH DAMAGE.
-*****************************************************************************
-* Contents: Native middle-level C interface to LAPACK function zgesvdq
-* Author: Intel Corporation
-*****************************************************************************/
-
-#include "lapacke_utils.h"
-
-lapack_int LAPACKE_zgesvdq_work( int matrix_layout, char joba, char jobp,
-                           char jobr, char jobu, char jobv,
-                           lapack_int m, lapack_int n, lapack_complex_double* a,
-                           lapack_int lda, double* s, lapack_complex_double* u, lapack_int ldu,
-                           lapack_complex_double* v, lapack_int ldv, lapack_int* numrank,
-                           lapack_int* iwork, lapack_int liwork,
-                           lapack_complex_double* cwork, lapack_int lcwork,
-                           double* rwork, lapack_int lrwork )
-{
-    lapack_int info = 0;
-    if( matrix_layout == LAPACK_COL_MAJOR ) {
-        /* Call LAPACK function and adjust info */
-        LAPACK_zgesvdq( &joba, &jobp, &jobr, &jobu, &jobv, &m, &n, a, &lda, s, u, &ldu, v, &ldv,
-                       numrank, iwork, &liwork, cwork, &lcwork, rwork, &lrwork, &info );
-        if( info < 0 ) {
-            info = info - 1;
-        }
-    } else if( matrix_layout == LAPACK_ROW_MAJOR ) {
-        lapack_int nrows_u = ( LAPACKE_lsame( jobu, 'a' ) ||
-                             LAPACKE_lsame( jobu, 'u' ) ||
-                             LAPACKE_lsame( jobu, 'r' ) ||
-                             LAPACKE_lsame( jobu, 'f' ) ||
-                             LAPACKE_lsame( jobu, 's' ) ) ? m : 1;
-        lapack_int ncols_u = LAPACKE_lsame( jobu, 'a' ) ? m :
-                             ( (LAPACKE_lsame( jobu, 's' ) ||
-                             LAPACKE_lsame( jobu, 'u' ) ) ? MIN(m,n) : 1);
-        lapack_int nrows_v = ( LAPACKE_lsame( jobv, 'a' ) ||
-                             LAPACKE_lsame( jobv, 'v' ) ||
-                             LAPACKE_lsame( jobv, 'r' )) ? n : 1;
-        lapack_int lda_t = MAX(1,m);
-        lapack_int ldu_t = MAX(1,nrows_u);
-        lapack_int ldv_t = MAX(1,nrows_v);
-        lapack_complex_double* a_t = NULL;
-        lapack_complex_double* u_t = NULL;
-        lapack_complex_double* v_t = NULL;
-        /* Check leading dimension(s) */
-        if( lda < n ) {
-            info = -9;
-            LAPACKE_xerbla( "LAPACKE_zgesvdq_work", info );
-            return info;
-        }
-        if( ldu < ncols_u ) {
-            info = -12;
-            LAPACKE_xerbla( "LAPACKE_zgesvdq_work", info );
-            return info;
-        }
-        if( ldv < n ) {
-            info = -14;
-            LAPACKE_xerbla( "LAPACKE_zgesvdq_work", info );
-            return info;
-        }
-        /* Query optimal working array(s) size if requested */
-        if( lcwork == -1 ) {
-            LAPACK_zgesvdq( &joba, &jobp, &jobr, &jobu, &jobv, &m, &n, a, &lda_t,
-                             s, u, &ldu_t, v, &ldv_t, numrank, iwork, &liwork,
-                             cwork, &lcwork, rwork, &lrwork, &info );
-            return (info < 0) ? (info - 1) : info;
-        }
-        /* Allocate memory for temporary array(s) */
-        a_t = (lapack_complex_double*)LAPACKE_malloc( sizeof(lapack_complex_double) * lda_t * MAX(1,n) );
-        if( a_t == NULL ) {
-            info = LAPACK_TRANSPOSE_MEMORY_ERROR;
-            goto exit_level_0;
-        }
-        if( LAPACKE_lsame( jobu, 'a' ) || LAPACKE_lsame( jobu, 's' ) ||
-                LAPACKE_lsame( jobu, 'u' ) ||
-                LAPACKE_lsame( jobu, 'r' ) ||
-                LAPACKE_lsame( jobu, 'f' ) ) {
-            u_t = (lapack_complex_double*)
-                LAPACKE_malloc( sizeof(lapack_complex_double) * ldu_t * MAX(1,ncols_u) );
-            if( u_t == NULL ) {
-                info = LAPACK_TRANSPOSE_MEMORY_ERROR;
-                goto exit_level_1;
-            }
-        }
-        if( LAPACKE_lsame( jobv, 'a' ) || LAPACKE_lsame( jobv, 'v' ) ||
-                LAPACKE_lsame( jobv, 'r' ) ) {
-            v_t = (lapack_complex_double*)
-                LAPACKE_malloc( sizeof(lapack_complex_double) * ldv_t * MAX(1,n) );
-            if( v_t == NULL ) {
-                info = LAPACK_TRANSPOSE_MEMORY_ERROR;
-                goto exit_level_2;
-            }
-        }
-        /* Transpose input matrices */
-        LAPACKE_zge_trans( matrix_layout, m, n, a, lda, a_t, lda_t );
-        /* Call LAPACK function and adjust info */
-            LAPACK_zgesvdq( &joba, &jobp, &jobr, &jobu, &jobv, &m, &n, a, &lda_t,
-                             s, u, &ldu_t, v, &ldv_t, numrank, iwork, &liwork,
-                             cwork, &lcwork, rwork, &lrwork, &info );
-        if( info < 0 ) {
-            info = info - 1;
-        }
-        /* Transpose output matrices */
-        LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
-        if( LAPACKE_lsame( jobu, 'a' ) || LAPACKE_lsame( jobu, 's' ) ||
-                LAPACKE_lsame( jobu, 'u' ) ||
-                LAPACKE_lsame( jobu, 'r' ) ||
-                LAPACKE_lsame( jobu, 'f' ) ) {
-            LAPACKE_zge_trans( LAPACK_COL_MAJOR, nrows_u, ncols_u, u_t, ldu_t,
-                               u, ldu );
-        }
-        if( LAPACKE_lsame( jobv, 'a' ) || LAPACKE_lsame( jobv, 'v' ) ||
-                LAPACKE_lsame( jobv, 'r' )) {
-            LAPACKE_zge_trans( LAPACK_COL_MAJOR, nrows_v, n, v_t, ldv_t, v,
-                               ldv );
-        }
-        /* Release memory and exit */
-        if( LAPACKE_lsame( jobv, 'a' ) || LAPACKE_lsame( jobv, 'v' ) ||
-                LAPACKE_lsame( jobv, 'r' ) ) {
-            LAPACKE_free( v_t );
-        }
-exit_level_2:
-        if( LAPACKE_lsame( jobu, 'a' ) || LAPACKE_lsame( jobu, 's' ) ||
-                LAPACKE_lsame( jobu, 'u' ) ||
-                LAPACKE_lsame( jobu, 'r' ) ||
-                LAPACKE_lsame( jobu, 'f' ) ) {
-            LAPACKE_free( u_t );
-        }
-exit_level_1:
-        LAPACKE_free( a_t );
-exit_level_0:
-        if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
-            LAPACKE_xerbla( "LAPACKE_zgesvdq_work", info );
-        }
-    } else {
-        info = -1;
-        LAPACKE_xerbla( "LAPACKE_zgesvdq_work", info );
-    }
-    return info;
-}

lapack-netlib/SRC/sbbcsd.f

@@ -351,9 +351,9 @@
 *     .. Parameters ..
       INTEGER            MAXITR
       PARAMETER          ( MAXITR = 6 )
-      REAL               HUNDRED, MEIGHTH, ONE, TEN, ZERO
+      REAL               HUNDRED, MEIGHTH, ZERO, ONE, TEN
       PARAMETER          ( HUNDRED = 100.0E0, MEIGHTH = -0.125E0,
-     $                     ONE = 1.0E0, TEN = 10.0E0, ZERO = 0.0E0 )
+     $                     ZERO = 0.0E0, ONE = 1.0E0, TEN = 10.0E0 )
       REAL               NEGONE
       PARAMETER          ( NEGONE = -1.0E0 )
       REAL               PIOVER2
@@ -576,7 +576,7 @@
                END IF
             ELSE
                NU = SIGMA21
-               MU = SQRT( 1.0 - NU**2 )
+               MU = SQRT( ONE - NU**2 )
                IF( NU .LT. THRESH ) THEN
                   MU = ONE
                   NU = ZERO
@@ -1108,4 +1108,3 @@
 *     End of SBBCSD
 *
       END
-

lapack-netlib/SRC/sgelsy.f

@@ -5,7 +5,6 @@
 * Online html documentation available at
 *            http://www.netlib.org/lapack/explore-html/
 *
-*> \htmlonly
 *> Download SGELSY + dependencies
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgelsy.f">
 *> [TGZ]</a>
@@ -13,7 +12,6 @@
 *> [ZIP]</a>
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgelsy.f">
 *> [TXT]</a>
-*> \endhtmlonly
 *
 *  Definition:
 *  ===========
@@ -201,8 +199,10 @@
 *>    G. Quintana-Orti, Depto. de Informatica, Universidad Jaime I, Spain \n
 *>
 *  =====================================================================
-      SUBROUTINE SGELSY( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK,
+      SUBROUTINE SGELSY( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND,
+     $                   RANK,
      $                   WORK, LWORK, INFO )
+      IMPLICIT NONE
 *
 *  -- LAPACK driver routine --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
@@ -235,10 +235,12 @@
 *     .. External Functions ..
       INTEGER            ILAENV
       REAL               SLAMCH, SLANGE, SROUNDUP_LWORK
-      EXTERNAL           ILAENV, SLAMCH, SLANGE, SROUNDUP_LWORK
+      EXTERNAL           ILAENV, SLAMCH, SLANGE,
+     $                   SROUNDUP_LWORK
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           SCOPY, SGEQP3, SLAIC1, SLASCL, SLASET,
+      EXTERNAL           SCOPY, SGEQP3, SLAIC1, SLASCL,
+     $                   SLASET,
      $                   SORMQR, SORMRZ, STRSM, STZRZF, XERBLA
 *     ..
 *     .. Intrinsic Functions ..
@@ -274,9 +276,9 @@
             LWKOPT = 1
          ELSE
             NB1 = ILAENV( 1, 'SGEQRF', ' ', M, N, -1, -1 )
-            NB2 = ILAENV( 1, 'SGERQF', ' ', M, N, -1, -1 )
+            NB2 = ILAENV( 1, 'STZRZF', ' ', M, N, -1, -1 )
             NB3 = ILAENV( 1, 'SORMQR', ' ', M, N, NRHS, -1 )
-            NB4 = ILAENV( 1, 'SORMRQ', ' ', M, N, NRHS, -1 )
+            NB4 = ILAENV( 1, 'SORMRZ', ' ', M, N, NRHS, -1 )
             NB = MAX( NB1, NB2, NB3, NB4 )
             LWKMIN = MN + MAX( 2*MN, N + 1, MN + NRHS )
             LWKOPT = MAX( LWKMIN,
@@ -339,13 +341,15 @@
 *
 *        Scale matrix norm up to SMLNUM
 *
-         CALL SLASCL( 'G', 0, 0, BNRM, SMLNUM, M, NRHS, B, LDB, INFO )
+         CALL SLASCL( 'G', 0, 0, BNRM, SMLNUM, M, NRHS, B, LDB,
+     $                INFO )
          IBSCL = 1
       ELSE IF( BNRM.GT.BIGNUM ) THEN
 *
 *        Scale matrix norm down to BIGNUM
 *
-         CALL SLASCL( 'G', 0, 0, BNRM, BIGNUM, M, NRHS, B, LDB, INFO )
+         CALL SLASCL( 'G', 0, 0, BNRM, BIGNUM, M, NRHS, B, LDB,
+     $                INFO )
          IBSCL = 2
       END IF
 *
@@ -354,7 +358,7 @@
 *
       CALL SGEQP3( M, N, A, LDA, JPVT, WORK( 1 ), WORK( MN+1 ),
      $             LWORK-MN, INFO )
-      WSIZE = MN + WORK( MN+1 )
+      WSIZE = REAL( MN ) + WORK( MN+1 )
 *
 *     workspace: MN+2*N+NB*(N+1).
 *     Details of Householder rotations stored in WORK(1:MN).
@@ -412,9 +416,10 @@
 *
 *     B(1:M,1:NRHS) := Q**T * B(1:M,1:NRHS)
 *
-      CALL SORMQR( 'Left', 'Transpose', M, NRHS, MN, A, LDA, WORK( 1 ),
+      CALL SORMQR( 'Left', 'Transpose', M, NRHS, MN, A, LDA,
+     $             WORK( 1 ),
      $             B, LDB, WORK( 2*MN+1 ), LWORK-2*MN, INFO )
-      WSIZE = MAX( WSIZE, 2*MN+WORK( 2*MN+1 ) )
+      WSIZE = MAX( WSIZE, REAL( 2*MN )+WORK( 2*MN+1 ) )
 *
 *     workspace: 2*MN+NB*NRHS.
 *
@@ -453,18 +458,22 @@
 *     Undo scaling
 *
       IF( IASCL.EQ.1 ) THEN
-         CALL SLASCL( 'G', 0, 0, ANRM, SMLNUM, N, NRHS, B, LDB, INFO )
+         CALL SLASCL( 'G', 0, 0, ANRM, SMLNUM, N, NRHS, B, LDB,
+     $                INFO )
          CALL SLASCL( 'U', 0, 0, SMLNUM, ANRM, RANK, RANK, A, LDA,
      $                INFO )
       ELSE IF( IASCL.EQ.2 ) THEN
-         CALL SLASCL( 'G', 0, 0, ANRM, BIGNUM, N, NRHS, B, LDB, INFO )
+         CALL SLASCL( 'G', 0, 0, ANRM, BIGNUM, N, NRHS, B, LDB,
+     $                INFO )
          CALL SLASCL( 'U', 0, 0, BIGNUM, ANRM, RANK, RANK, A, LDA,
      $                INFO )
       END IF
       IF( IBSCL.EQ.1 ) THEN
-         CALL SLASCL( 'G', 0, 0, SMLNUM, BNRM, N, NRHS, B, LDB, INFO )
+         CALL SLASCL( 'G', 0, 0, SMLNUM, BNRM, N, NRHS, B, LDB,
+     $                INFO )
       ELSE IF( IBSCL.EQ.2 ) THEN
-         CALL SLASCL( 'G', 0, 0, BIGNUM, BNRM, N, NRHS, B, LDB, INFO )
+         CALL SLASCL( 'G', 0, 0, BIGNUM, BNRM, N, NRHS, B, LDB,
+     $                INFO )
       END IF
 *
    70 CONTINUE

lapack-netlib/SRC/slaruv.f

@@ -427,10 +427,10 @@
 *           the statistically correct thing to do in this situation is
 *           simply to iterate again.
 *           N.B. the case X( I ) = 0.0 should not be possible.
-            I1 = I1 + 2
-            I2 = I2 + 2
-            I3 = I3 + 2
-            I4 = I4 + 2
+            I1 = IT1
+            I2 = IT2
+            I3 = IT3
+            I4 = IT4
             GOTO 20
          END IF
 *

lapack-netlib/SRC/stgsja.f

@@ -409,17 +409,19 @@
 *     ..
 *     .. External Functions ..
       LOGICAL            LSAME
-      EXTERNAL           LSAME
+      REAL               SLAMCH
+      EXTERNAL           LSAME, SLAMCH
 *     ..
 *     .. External Subroutines ..
       EXTERNAL           SCOPY, SLAGS2, SLAPLL, SLARTG, SLASET, SROT,
      $                   SSCAL, XERBLA
 *     ..
 *     .. Intrinsic Functions ..
-      INTRINSIC          ABS, MAX, MIN, HUGE
-      PARAMETER          ( HUGENUM = HUGE(ZERO) )
+      INTRINSIC          ABS, MAX, MIN
 *     ..
 *     .. Executable Statements ..
+*
+      HUGENUM = SLAMCH( 'O' )
 *
 *     Decode and test the input parameters
 *

lapack-netlib/SRC/zbbcsd.f

@@ -351,9 +351,9 @@
 *     .. Parameters ..
       INTEGER            MAXITR
       PARAMETER          ( MAXITR = 6 )
-      DOUBLE PRECISION   HUNDRED, MEIGHTH, ONE, TEN, ZERO
+      DOUBLE PRECISION   HUNDRED, MEIGHTH, ZERO, ONE, TEN
       PARAMETER          ( HUNDRED = 100.0D0, MEIGHTH = -0.125D0,
-     $                     ONE = 1.0D0, TEN = 10.0D0, ZERO = 0.0D0 )
+     $                     ZERO = 0.0D0, ONE = 1.0D0, TEN = 10.0D0 )
       COMPLEX*16         NEGONECOMPLEX
       PARAMETER          ( NEGONECOMPLEX = (-1.0D0,0.0D0) )
       DOUBLE PRECISION   PIOVER2
@@ -575,7 +575,7 @@
                END IF
             ELSE
                NU = SIGMA21
-               MU = SQRT( 1.0 - NU**2 )
+               MU = SQRT( ONE - NU**2 )
                IF( NU .LT. THRESH ) THEN
                   MU = ONE
                   NU = ZERO
@@ -1113,4 +1113,3 @@
 *     End of ZBBCSD
 *
       END
-

lapack-netlib/SRC/zgelsy.f

@@ -5,7 +5,6 @@
 * Online html documentation available at
 *            http://www.netlib.org/lapack/explore-html/
 *
-*> \htmlonly
 *> Download ZGELSY + dependencies
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zgelsy.f">
 *> [TGZ]</a>
@@ -13,7 +12,6 @@
 *> [ZIP]</a>
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zgelsy.f">
 *> [TXT]</a>
-*> \endhtmlonly
 *
 *  Definition:
 *  ===========
@@ -197,7 +195,7 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \ingroup complex16GEsolve
+*> \ingroup gelsy
 *
 *> \par Contributors:
 *  ==================
@@ -207,8 +205,10 @@
 *>    G. Quintana-Orti, Depto. de Informatica, Universidad Jaime I, Spain \n
 *>
 *  =====================================================================
-      SUBROUTINE ZGELSY( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK,
+      SUBROUTINE ZGELSY( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND,
+     $                   RANK,
      $                   WORK, LWORK, RWORK, INFO )
+      IMPLICIT NONE
 *
 *  -- LAPACK driver routine --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
@@ -244,7 +244,8 @@
       COMPLEX*16         C1, C2, S1, S2
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           DLABAD, XERBLA, ZCOPY, ZGEQP3, ZLAIC1, ZLASCL,
+      EXTERNAL           XERBLA, ZCOPY, ZGEQP3, ZLAIC1,
+     $                   ZLASCL,
      $                   ZLASET, ZTRSM, ZTZRZF, ZUNMQR, ZUNMRZ
 *     ..
 *     .. External Functions ..
@@ -265,9 +266,9 @@
 *
       INFO = 0
       NB1 = ILAENV( 1, 'ZGEQRF', ' ', M, N, -1, -1 )
-      NB2 = ILAENV( 1, 'ZGERQF', ' ', M, N, -1, -1 )
+      NB2 = ILAENV( 1, 'ZTZRZF', ' ', M, N, -1, -1 )
       NB3 = ILAENV( 1, 'ZUNMQR', ' ', M, N, NRHS, -1 )
-      NB4 = ILAENV( 1, 'ZUNMRQ', ' ', M, N, NRHS, -1 )
+      NB4 = ILAENV( 1, 'ZUNMRZ', ' ', M, N, NRHS, -1 )
       NB = MAX( NB1, NB2, NB3, NB4 )
       LWKOPT = MAX( 1, MN+2*N+NB*( N+1 ), 2*MN+NB*NRHS )
       WORK( 1 ) = DCMPLX( LWKOPT )
@@ -305,7 +306,6 @@
 *
       SMLNUM = DLAMCH( 'S' ) / DLAMCH( 'P' )
       BIGNUM = ONE / SMLNUM
-      CALL DLABAD( SMLNUM, BIGNUM )
 *
 *     Scale A, B if max entries outside range [SMLNUM,BIGNUM]
 *
@@ -338,13 +338,15 @@
 *
 *        Scale matrix norm up to SMLNUM
 *
-         CALL ZLASCL( 'G', 0, 0, BNRM, SMLNUM, M, NRHS, B, LDB, INFO )
+         CALL ZLASCL( 'G', 0, 0, BNRM, SMLNUM, M, NRHS, B, LDB,
+     $                INFO )
          IBSCL = 1
       ELSE IF( BNRM.GT.BIGNUM ) THEN
 *
 *        Scale matrix norm down to BIGNUM
 *
-         CALL ZLASCL( 'G', 0, 0, BNRM, BIGNUM, M, NRHS, B, LDB, INFO )
+         CALL ZLASCL( 'G', 0, 0, BNRM, BIGNUM, M, NRHS, B, LDB,
+     $                INFO )
          IBSCL = 2
       END IF
 *
@@ -411,7 +413,8 @@
 *
 *     B(1:M,1:NRHS) := Q**H * B(1:M,1:NRHS)
 *
-      CALL ZUNMQR( 'Left', 'Conjugate transpose', M, NRHS, MN, A, LDA,
+      CALL ZUNMQR( 'Left', 'Conjugate transpose', M, NRHS, MN, A,
+     $             LDA,
      $             WORK( 1 ), B, LDB, WORK( 2*MN+1 ), LWORK-2*MN, INFO )
       WSIZE = MAX( WSIZE, 2*MN+DBLE( WORK( 2*MN+1 ) ) )
 *
@@ -452,18 +455,22 @@
 *     Undo scaling
 *
       IF( IASCL.EQ.1 ) THEN
-         CALL ZLASCL( 'G', 0, 0, ANRM, SMLNUM, N, NRHS, B, LDB, INFO )
+         CALL ZLASCL( 'G', 0, 0, ANRM, SMLNUM, N, NRHS, B, LDB,
+     $                INFO )
          CALL ZLASCL( 'U', 0, 0, SMLNUM, ANRM, RANK, RANK, A, LDA,
      $                INFO )
       ELSE IF( IASCL.EQ.2 ) THEN
-         CALL ZLASCL( 'G', 0, 0, ANRM, BIGNUM, N, NRHS, B, LDB, INFO )
+         CALL ZLASCL( 'G', 0, 0, ANRM, BIGNUM, N, NRHS, B, LDB,
+     $                INFO )
          CALL ZLASCL( 'U', 0, 0, BIGNUM, ANRM, RANK, RANK, A, LDA,
      $                INFO )
       END IF
       IF( IBSCL.EQ.1 ) THEN
-         CALL ZLASCL( 'G', 0, 0, SMLNUM, BNRM, N, NRHS, B, LDB, INFO )
+         CALL ZLASCL( 'G', 0, 0, SMLNUM, BNRM, N, NRHS, B, LDB,
+     $                INFO )
       ELSE IF( IBSCL.EQ.2 ) THEN
-         CALL ZLASCL( 'G', 0, 0, BIGNUM, BNRM, N, NRHS, B, LDB, INFO )
+         CALL ZLASCL( 'G', 0, 0, BIGNUM, BNRM, N, NRHS, B, LDB,
+     $                INFO )
       END IF
 *
    70 CONTINUE

lapack-netlib/SRC/zlartg.f90

@@ -203,7 +203,7 @@ subroutine ZLARTG( f, g, c, s, r )
             rtmax = rtmax * 2
             if( f2 > rtmin .and. h2 < rtmax ) then
                ! safmin <= sqrt( f2*h2 ) <= safmax
-               s = conjg( g ) * ( f / sqrt( f2*h2 ) )
+               s = ( f / sqrt( f2 ) ) * ( conjg( g ) / sqrt( h2 ) )
             else
                s = conjg( g ) * ( r / h2 )
             end if
@@ -223,7 +223,7 @@ subroutine ZLARTG( f, g, c, s, r )
                !  sqrt(safmin) <= f2 * sqrt(safmax) <= h2 / sqrt(f2 * h2) <= h2 * (safmin / f2) <= h2 <= safmax
                r = f * ( h2 / d )
             end if
-            s = conjg( g ) * ( f / d )
+            s = ( f / sqrt( f2 ) ) * ( conjg( g ) / sqrt( h2 ) )
          end if
       else
 !
@@ -259,7 +259,7 @@ subroutine ZLARTG( f, g, c, s, r )
             rtmax = rtmax * 2
             if( f2 > rtmin .and. h2 < rtmax ) then
                ! safmin <= sqrt( f2*h2 ) <= safmax
-               s = conjg( gs ) * ( fs / sqrt( f2*h2 ) )
+               s = ( fs / sqrt( f2 ) ) * ( conjg( gs ) / sqrt( h2 ) )
             else
                s = conjg( gs ) * ( r / h2 )
             end if
@@ -279,7 +279,7 @@ subroutine ZLARTG( f, g, c, s, r )
                !  sqrt(safmin) <= f2 * sqrt(safmax) <= h2 / sqrt(f2 * h2) <= h2 * (safmin / f2) <= h2 <= safmax
                r = fs * ( h2 / d )
             end if
-            s = conjg( gs ) * ( fs / d )
+            s = ( fs / sqrt( f2 ) ) * ( conjg( gs ) / sqrt( h2 ) )
          end if
          ! Rescale c and r
          c = c * w

lapack-netlib/SRC/ztgsja.f

@@ -414,17 +414,19 @@
 *     ..
 *     .. External Functions ..
       LOGICAL            LSAME
-      EXTERNAL           LSAME
+      DOUBLE PRECISION   DLAMCH
+      EXTERNAL           LSAME, DLAMCH
 *     ..
 *     .. External Subroutines ..
       EXTERNAL           DLARTG, XERBLA, ZCOPY, ZDSCAL, ZLAGS2, ZLAPLL,
      $                   ZLASET, ZROT
 *     ..
 *     .. Intrinsic Functions ..
-      INTRINSIC          ABS, DBLE, DCONJG, MAX, MIN, HUGE
-      PARAMETER          ( HUGENUM = HUGE(ZERO) )
+      INTRINSIC          ABS, DBLE, DCONJG, MAX, MIN
 *     ..
 *     .. Executable Statements ..
+*
+      HUGENUM = DLAMCH( 'O' )
 *
 *     Decode and test the input parameters
 *

lapack-netlib/TESTING/LIN/cchklq.f

@@ -394,12 +394,19 @@
                            CALL CLACPY( 'Full', M, N, A, LDA, AF, LDA )
 *
                            SRNAMT = 'CGELS'
-                           CALL CGELS( 'No transpose', M, N, NRHS, AF,
+                            CALL CGELS( 'No transpose', M, N, NRHS, AF,
      $                                 LDA, X, LDA, WORK, LWORK, INFO )
 *
+*                          Re-factorize AF with CGELQF for subsequent
+*                          LQ tests which expect LQ factorization in AF.
+*
+                            CALL CLACPY( 'Full', M, N, A, LDA, AF, LDA )
+                            CALL CGELQF( M, N, AF, LDA, TAU, WORK,
+     $                                   LWORK, INFO )
+*
 *                          Check error code from CGELS.
 *
-                           IF( INFO.NE.0 )
+                            IF( INFO.NE.0 )
      $                        CALL ALAERH( PATH, 'CGELS', INFO, 0, 'N',
      $                                     M, N, NRHS, -1, NB, IMAT,
      $                                     NFAIL, NERRS, NOUT )

lapack-netlib/TESTING/LIN/dchklq.f

@@ -397,12 +397,19 @@
                            CALL DLACPY( 'Full', M, N, A, LDA, AF, LDA )
 *
                            SRNAMT = 'DGELS'
-                           CALL DGELS( 'No transpose', M, N, NRHS, AF,
+                            CALL DGELS( 'No transpose', M, N, NRHS, AF,
      $                                 LDA, X, LDA, WORK, LWORK, INFO )
 *
+*                          Re-factorize AF with DGELQF for subsequent
+*                          LQ tests which expect LQ factorization in AF.
+*
+                            CALL DLACPY( 'Full', M, N, A, LDA, AF, LDA )
+                            CALL DGELQF( M, N, AF, LDA, TAU, WORK,
+     $                                   LWORK, INFO )
+*
 *                          Check error code from DGELS.
 *
-                           IF( INFO.NE.0 )
+                            IF( INFO.NE.0 )
      $                        CALL ALAERH( PATH, 'DGELS', INFO, 0, 'N',
      $                                     M, N, NRHS, -1, NB, IMAT,
      $                                     NFAIL, NERRS, NOUT )

lapack-netlib/TESTING/LIN/schklq.f

@@ -394,12 +394,19 @@
                            CALL SLACPY( 'Full', M, N, A, LDA, AF, LDA )
 *
                            SRNAMT = 'SGELS'
-                           CALL SGELS( 'No transpose', M, N, NRHS, AF,
+                            CALL SGELS( 'No transpose', M, N, NRHS, AF,
      $                                 LDA, X, LDA, WORK, LWORK, INFO )
 *
+*                          Re-factorize AF with SGELQF for subsequent
+*                          LQ tests which expect LQ factorization in AF.
+*
+                            CALL SLACPY( 'Full', M, N, A, LDA, AF, LDA )
+                            CALL SGELQF( M, N, AF, LDA, TAU, WORK,
+     $                                   LWORK, INFO )
+*
 *                          Check error code from SGELS.
 *
-                           IF( INFO.NE.0 )
+                            IF( INFO.NE.0 )
      $                        CALL ALAERH( PATH, 'SGELS', INFO, 0, 'N',
      $                                     M, N, NRHS, -1, NB, IMAT,
      $                                     NFAIL, NERRS, NOUT )

lapack-netlib/TESTING/LIN/zchklq.f

@@ -394,12 +394,19 @@
                            CALL ZLACPY( 'Full', M, N, A, LDA, AF, LDA )
 *
                            SRNAMT = 'ZGELS'
-                           CALL ZGELS( 'No transpose', M, N, NRHS, AF,
+                            CALL ZGELS( 'No transpose', M, N, NRHS, AF,
      $                                 LDA, X, LDA, WORK, LWORK, INFO )
 *
+*                          Re-factorize AF with ZGELQF for subsequent
+*                          LQ tests which expect LQ factorization in AF.
+*
+                            CALL ZLACPY( 'Full', M, N, A, LDA, AF, LDA )
+                            CALL ZGELQF( M, N, AF, LDA, TAU, WORK,
+     $                                   LWORK, INFO )
+*
 *                          Check error code from ZGELS.
 *
-                           IF( INFO.NE.0 )
+                            IF( INFO.NE.0 )
      $                        CALL ALAERH( PATH, 'ZGELS', INFO, 0, 'N',
      $                                     M, N, NRHS, -1, NB, IMAT,
      $                                     NFAIL, NERRS, NOUT )

param.h

@@ -3087,6 +3087,45 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
 #endif
 
+#if defined(U74)
+#define GEMM_DEFAULT_OFFSET_A 0
+#define GEMM_DEFAULT_OFFSET_B 0
+#define GEMM_DEFAULT_ALIGN (BLASLONG)0x03fffUL
+
+/* 4x4 register tile: 16 independent FMA accumulator chains hide the U74's
+ * 7-cycle fmadd.d latency (repeat rate 1); load:FMA ratio drops to 1:2. */
+#define SGEMM_DEFAULT_UNROLL_M  4
+#define SGEMM_DEFAULT_UNROLL_N  4
+
+#define DGEMM_DEFAULT_UNROLL_M  4
+#define DGEMM_DEFAULT_UNROLL_N  4
+
+/* complex GEMM keeps the generic 2x2 kernel */
+#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 256
+#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
+
+#endif
+
 #if defined(x280)
 #define GEMM_DEFAULT_OFFSET_A 0
 #define GEMM_DEFAULT_OFFSET_B 0
@@ -3265,10 +3304,27 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 #define SHGEMM_DEFAULT_P 128
 #undef SBGEMM_DEFAULT_P
 #define SBGEMM_DEFAULT_P 128
-#define SGEMM_DEFAULT_P 128
-#define DGEMM_DEFAULT_P 64
-#define CGEMM_DEFAULT_P 64
-#define ZGEMM_DEFAULT_P 64
+/* Base packed-A (P) blocking for this core. On static builds blas_set_parameter()
+   scales P from the L2 cache detected at runtime, relative to RISCV_L2_REFERENCE_KB
+   (the L2 size these bases target); Q and R keep their param.h defaults. A cache
+   equal to the reference reproduces the stock blocking. DYNAMIC_ARCH uses the
+   literals directly (kernel/setparam-ref.c fills the gotoblas table from them). */
+#define RISCV_L2_REFERENCE_KB 512
+#define SGEMM_DEFAULT_P_BASE 128
+#define DGEMM_DEFAULT_P_BASE 64
+#define CGEMM_DEFAULT_P_BASE 64
+#define ZGEMM_DEFAULT_P_BASE 64
+#if defined(DYNAMIC_ARCH)
+#define SGEMM_DEFAULT_P SGEMM_DEFAULT_P_BASE
+#define DGEMM_DEFAULT_P DGEMM_DEFAULT_P_BASE
+#define CGEMM_DEFAULT_P CGEMM_DEFAULT_P_BASE
+#define ZGEMM_DEFAULT_P ZGEMM_DEFAULT_P_BASE
+#else
+#define SGEMM_DEFAULT_P sgemm_p
+#define DGEMM_DEFAULT_P dgemm_p
+#define CGEMM_DEFAULT_P cgemm_p
+#define ZGEMM_DEFAULT_P zgemm_p
+#endif
 
 #undef SHGEMM_DEFAULT_Q
 #define SHGEMM_DEFAULT_Q 128

test/CMakeLists.txt

@@ -31,9 +31,22 @@ if (USE_GEMM3M)
 	endif ()
 endif ()
 
+add_library(openblas_test_xerbla OBJECT xerbla_test.c)
+# Static test executables provide their own XERBLA and must continue to test
+# link-time interposition. Shared-only tests use the explicit handler because
+# calls originating in a DLL or dylib cannot portably bind to that definition.
+if (BUILD_SHARED_LIBS AND NOT BUILD_STATIC_LIBS)
+	target_compile_definitions(openblas_test_xerbla PRIVATE
+		OPENBLAS_TEST_USE_XERBLA_HANDLER)
+endif()
+
 foreach(test_bin ${OpenBLAS_Tests})
 	add_executable(${test_bin} ${test_bin}.f)
-target_link_libraries(${test_bin} ${OpenBLAS_LIBNAME})
+	if (test_bin MATCHES "blat(2|3)(_3m)?$")
+		target_sources(${test_bin} PRIVATE
+			$<TARGET_OBJECTS:openblas_test_xerbla>)
+	endif()
+	target_link_libraries(${test_bin} ${OpenBLAS_LIBNAME})
 endforeach()
 
 if (BUILD_BFLOAT16)
@@ -62,29 +75,45 @@ endif()
 if(WIN32)
 FILE(WRITE ${CMAKE_CURRENT_BINARY_DIR}/test_helper.ps1
 "[Console]::InputEncoding = New-Object Text.UTF8Encoding $false\n"
-"if (Test-Path $args[2]) { Remove-Item -Force $args[2] } \n"
 "$ErrorActionPreference = \"Stop\"\n"
-"Get-Content $args[1] | & $args[0]\n" 
-"If ((Get-Content $args[2] | %{$_ -match \"FATAL\"}) -contains $true) {\n"
-"echo Error in $args[1]:\n"
-"Get-Content $args[2] \n"
-"exit 1\n"
-"} else {\n"
-"exit 0\n"
+"if (Test-Path -LiteralPath $args[2]) { Remove-Item -LiteralPath $args[2] -Force }\n"
+"Get-Content -LiteralPath $args[1] | & $args[0]\n"
+"$testExitCode = $LASTEXITCODE\n"
+"if ($testExitCode -ne 0) { exit $testExitCode }\n"
+"if (-not (Test-Path -LiteralPath $args[2])) {\n"
+"  Write-Host \"Missing test summary: $($args[2])\"\n"
+"  exit 1\n"
 "}\n"
+"if (Select-String -LiteralPath $args[2] -Pattern \"FATAL|FAILED\" -Quiet) {\n"
+"  Write-Host \"Error in $($args[1]):\"\n"
+"  Get-Content -LiteralPath $args[2]\n"
+"  exit 1\n"
+"}\n"
+"exit 0\n"
 )
 set(helper_prefix powershell -ExecutionPolicy Bypass "${CMAKE_CURRENT_BINARY_DIR}/test_helper.ps1")
 else()
 FILE(WRITE ${CMAKE_CURRENT_BINARY_DIR}/test_helper.sh
-"rm -f $3\n"
-"$1 < $2\n"
-"grep -q FATAL $3\n"
-"if [ $? -eq 0 ]; then\n"
-"echo Error\n"
-"exit 1\n"
-"else\n"
-"exit 0\n"
+"rm -f \"$3\"\n"
+"remove_status=$?\n"
+"if [ $remove_status -ne 0 ]; then\n"
+"  echo \"Unable to remove stale test summary: $3\"\n"
+"  exit $remove_status\n"
 "fi\n"
+"\"$1\" < \"$2\"\n"
+"test_exit_code=$?\n"
+"if [ $test_exit_code -ne 0 ]; then exit $test_exit_code; fi\n"
+"if [ ! -f \"$3\" ]; then\n"
+"  echo \"Missing test summary: $3\"\n"
+"  exit 1\n"
+"fi\n"
+"grep -q -e FATAL -e FAILED \"$3\"\n"
+"summary_status=$?\n"
+"case $summary_status in\n"
+"  0) echo \"Error in $2:\"; cat \"$3\"; exit 1 ;;\n"
+"  1) exit 0 ;;\n"
+"  *) echo \"Unable to read test summary: $3\"; exit $summary_status ;;\n"
+"esac\n"
 )
 set(helper_prefix sh "${CMAKE_CURRENT_BINARY_DIR}/test_helper.sh")
 endif()

test/Makefile

@@ -37,6 +37,16 @@ endif
 # override CFLAGS += -std=c11 -Wall -Werror
 
 SUPPORT_GEMM3M = 0
+XERBLA_TEST = xerbla_test.$(SUFFIX)
+
+define CHECK_TEST_SUMMARY
+@status=0; $(GREP) -q -e FATAL -e FAILED "$(1)" || status=$$?; \
+case $$status in \
+  0) cat "$(1)"; exit 1 ;; \
+  1) ;; \
+  *) echo "Unable to read test summary: $(1)"; exit $$status ;; \
+esac
+endef
 
 ifeq ($(ARCH), x86)
 SUPPORT_GEMM3M = 1
@@ -146,85 +156,85 @@ ifneq ($(CROSS), 1)
 	rm -f ?BLAT2.SUMM
 ifeq ($(BUILD_BFLOAT16),1)
 	OPENBLAS_NUM_THREADS=1 OMP_NUM_THREADS=1 ./test_bgemv$(EXE) > BBLAT2.SUMM
-	@$(GREP) -q FATAL BBLAT2.SUMM && cat BBLAT2.SUMM || exit 0
+	$(call CHECK_TEST_SUMMARY,BBLAT2.SUMM)
 	OPENBLAS_NUM_THREADS=1 OMP_NUM_THREADS=1 ./test_sbgemv$(EXE) > SBBLAT2.SUMM
-	@$(GREP) -q FATAL SBBLAT2.SUMM && cat SBBLAT2.SUMM || exit 0
+	$(call CHECK_TEST_SUMMARY,SBBLAT2.SUMM)
 endif
 ifeq ($(BUILD_HFLOAT16),1)
 	OPENBLAS_NUM_THREADS=1 OMP_NUM_THREADS=1 ./test_shgemv$(EXE) > SHBLAT2.SUMM
-	@$(GREP) -q FATAL SHBLAT2.SUMM && cat SHBLAT2.SUMM || exit 0
+	$(call CHECK_TEST_SUMMARY,SHBLAT2.SUMM)
 endif
 ifeq ($(BUILD_SINGLE),1)
 	OPENBLAS_NUM_THREADS=1 OMP_NUM_THREADS=1 ./sblat2$(EXE) < ./sblat2.dat
-	@$(GREP) -q FATAL SBLAT2.SUMM && cat SBLAT2.SUMM || exit 0
+	$(call CHECK_TEST_SUMMARY,SBLAT2.SUMM)
 endif
 ifeq ($(BUILD_DOUBLE),1)
 	OPENBLAS_NUM_THREADS=1 OMP_NUM_THREADS=1 ./dblat2$(EXE) < ./dblat2.dat
-	@$(GREP) -q FATAL DBLAT2.SUMM && cat DBLAT2.SUMM || exit 0
+	$(call CHECK_TEST_SUMMARY,DBLAT2.SUMM)
 endif
 ifeq ($(BUILD_COMPLEX),1)
 	OPENBLAS_NUM_THREADS=1 OMP_NUM_THREADS=1 ./cblat2$(EXE) < ./cblat2.dat
-	@$(GREP) -q FATAL CBLAT2.SUMM && cat CBLAT2.SUMM || exit 0
+	$(call CHECK_TEST_SUMMARY,CBLAT2.SUMM)
 endif
 ifeq ($(BUILD_COMPLEX16),1)
 	OPENBLAS_NUM_THREADS=1 OMP_NUM_THREADS=1 ./zblat2$(EXE) < ./zblat2.dat
-	@$(GREP) -q FATAL ZBLAT2.SUMM && cat ZBLAT2.SUMM || exit 0
+	$(call CHECK_TEST_SUMMARY,ZBLAT2.SUMM)
 endif
 ifdef SMP
 	rm -f ?BLAT2.SUMM
 ifeq ($(USE_OPENMP), 1)
 ifeq ($(BUILD_BFLOAT16),1)
 	OMP_NUM_THREADS=2 ./test_bgemv$(EXE) > BBLAT2.SUMM
-	@$(GREP) -q FATAL BBLAT2.SUMM && cat BBLAT2.SUMM || exit 0
+	$(call CHECK_TEST_SUMMARY,BBLAT2.SUMM)
 	OMP_NUM_THREADS=2 ./test_sbgemv$(EXE) > SBBLAT2.SUMM
-	@$(GREP) -q FATAL SBBLAT2.SUMM && cat SBBLAT2.SUMM || exit 0
+	$(call CHECK_TEST_SUMMARY,SBBLAT2.SUMM)
 endif
 ifeq ($(BUILD_HFLOAT16),1)
 	OMP_NUM_THREADS=2 ./test_shgemv$(EXE) > SHBLAT2.SUMM
-	@$(GREP) -q FATAL SHBLAT2.SUMM && cat SHBLAT2.SUMM || exit 0
+	$(call CHECK_TEST_SUMMARY,SHBLAT2.SUMM)
 endif
 ifeq ($(BUILD_SINGLE),1)
 	OMP_NUM_THREADS=2 ./sblat2$(EXE) < ./sblat2.dat
-	@$(GREP) -q FATAL SBLAT2.SUMM && cat SBLAT2.SUMM || exit 0
+	$(call CHECK_TEST_SUMMARY,SBLAT2.SUMM)
 endif
 ifeq ($(BUILD_DOUBLE),1)
 	OMP_NUM_THREADS=2 ./dblat2$(EXE) < ./dblat2.dat
-	@$(GREP) -q FATAL DBLAT2.SUMM && cat DBLAT2.SUMM || exit 0
+	$(call CHECK_TEST_SUMMARY,DBLAT2.SUMM)
 endif
 ifeq ($(BUILD_COMPLEX),1)
 	OMP_NUM_THREADS=2 ./cblat2$(EXE) < ./cblat2.dat
-	@$(GREP) -q FATAL CBLAT2.SUMM && cat CBLAT2.SUMM || exit 0
+	$(call CHECK_TEST_SUMMARY,CBLAT2.SUMM)
 endif
 ifeq ($(BUILD_COMPLEX16),1)
 	OMP_NUM_THREADS=2 ./zblat2$(EXE) < ./zblat2.dat
-	@$(GREP) -q FATAL ZBLAT2.SUMM && cat ZBLAT2.SUMM || exit 0
+	$(call CHECK_TEST_SUMMARY,ZBLAT2.SUMM)
 endif
 else
 ifeq ($(BUILD_BFLOAT16),1)
 	OMP_NUM_THREADS=2 ./test_bgemv$(EXE) > BBLAT2.SUMM
-	@$(GREP) -q FATAL BBLAT2.SUMM && cat BBLAT2.SUMM || exit 0
+	$(call CHECK_TEST_SUMMARY,BBLAT2.SUMM)
 	OMP_NUM_THREADS=2 ./test_sbgemv$(EXE) > SBBLAT2.SUMM
-	@$(GREP) -q FATAL SBBLAT2.SUMM && cat SBBLAT2.SUMM || exit 0
+	$(call CHECK_TEST_SUMMARY,SBBLAT2.SUMM)
 endif
 ifeq ($(BUILD_HFLOAT16),1)
 	OMP_NUM_THREADS=2 ./test_shgemv$(EXE) > SHBLAT2.SUMM
-	@$(GREP) -q FATAL SHBLAT2.SUMM && cat SHBLAT2.SUMM || exit 0
+	$(call CHECK_TEST_SUMMARY,SHBLAT2.SUMM)
 endif
 ifeq ($(BUILD_SINGLE),1)
 	OPENBLAS_NUM_THREADS=2 ./sblat2$(EXE) < ./sblat2.dat
-	@$(GREP) -q FATAL SBLAT2.SUMM && cat SBLAT2.SUMM || exit 0
+	$(call CHECK_TEST_SUMMARY,SBLAT2.SUMM)
 endif
 ifeq ($(BUILD_DOUBLE),1)
 	OPENBLAS_NUM_THREADS=2 ./dblat2$(EXE) < ./dblat2.dat
-	@$(GREP) -q FATAL DBLAT2.SUMM && cat DBLAT2.SUMM || exit 0
+	$(call CHECK_TEST_SUMMARY,DBLAT2.SUMM)
 endif
 ifeq ($(BUILD_COMPLEX),1)
 	OPENBLAS_NUM_THREADS=2 ./cblat2$(EXE) < ./cblat2.dat
-	@$(GREP) -q FATAL CBLAT2.SUMM && cat CBLAT2.SUMM || exit 0
+	$(call CHECK_TEST_SUMMARY,CBLAT2.SUMM)
 endif
 ifeq ($(BUILD_COMPLEX16),1)
 	OPENBLAS_NUM_THREADS=2 ./zblat2$(EXE) < ./zblat2.dat
-	@$(GREP) -q FATAL ZBLAT2.SUMM && cat ZBLAT2.SUMM || exit 0
+	$(call CHECK_TEST_SUMMARY,ZBLAT2.SUMM)
 endif
 endif
 endif
@@ -273,86 +283,86 @@ ifneq ($(CROSS), 1)
 	rm -f ?BLAT3.SUMM
 ifeq ($(BUILD_BFLOAT16),1)
 	OPENBLAS_NUM_THREADS=1 OMP_NUM_THREADS=1 ./test_sbgemm$(EXE) > SBBLAT3.SUMM
-	@$(GREP) -q FATAL SBBLAT3.SUMM && cat SBBLAT3.SUMM || exit 0
+	$(call CHECK_TEST_SUMMARY,SBBLAT3.SUMM)
 	OPENBLAS_NUM_THREADS=1 OMP_NUM_THREADS=1 ./test_bgemm$(EXE) > BBLAT3.SUMM
-	@$(GREP) -q FATAL BBLAT3.SUMM && cat BBLAT3.SUMM || exit 0
+	$(call CHECK_TEST_SUMMARY,BBLAT3.SUMM)
 endif
 ifeq ($(BUILD_HFLOAT16),1)
 	OPENBLAS_NUM_THREADS=1 OMP_NUM_THREADS=1 ./test_shgemm > SHBLAT3.SUMM
-	@$(GREP) -q FATAL SHBLAT3.SUMM && cat SHBLAT3.SUMM || exit 0
+	$(call CHECK_TEST_SUMMARY,SHBLAT3.SUMM)
 endif
 ifeq ($(BUILD_SINGLE),1)
 	OPENBLAS_NUM_THREADS=1 OMP_NUM_THREADS=1 ./sblat3$(EXE) < ./sblat3.dat
-	@$(GREP) -q FATAL SBLAT3.SUMM && cat SBLAT3.SUMM || exit 0
+	$(call CHECK_TEST_SUMMARY,SBLAT3.SUMM)
 endif
 ifeq ($(BUILD_DOUBLE),1)
 	OPENBLAS_NUM_THREADS=1 OMP_NUM_THREADS=1 ./dblat3$(EXE) < ./dblat3.dat
-	@$(GREP) -q FATAL DBLAT3.SUMM && cat DBLAT3.SUMM || exit 0
+	$(call CHECK_TEST_SUMMARY,DBLAT3.SUMM)
 endif
 ifeq ($(BUILD_COMPLEX),1)
 	OPENBLAS_NUM_THREADS=1 OMP_NUM_THREADS=1 ./cblat3$(EXE) < ./cblat3.dat
-	@$(GREP) -q FATAL CBLAT3.SUMM && cat CBLAT3.SUMM || exit 0
+	$(call CHECK_TEST_SUMMARY,CBLAT3.SUMM)
 endif
 ifeq ($(BUILD_COMPLEX16),1)
 	OPENBLAS_NUM_THREADS=1 OMP_NUM_THREADS=1 ./zblat3$(EXE) < ./zblat3.dat
-	@$(GREP) -q FATAL ZBLAT3.SUMM && cat ZBLAT3.SUMM || exit 0
+	$(call CHECK_TEST_SUMMARY,ZBLAT3.SUMM)
 endif
 ifdef SMP
 	rm -f ?BLAT3.SUMM
 ifeq ($(USE_OPENMP), 1)
 ifeq ($(BUILD_BFLOAT16),1)
 	OMP_NUM_THREADS=2 ./test_sbgemm$(EXE) > SBBLAT3.SUMM
-	@$(GREP) -q FATAL SBBLAT3.SUMM && cat SBBLAT3.SUMM || exit 0
+	$(call CHECK_TEST_SUMMARY,SBBLAT3.SUMM)
 	OMP_NUM_THREADS=2 ./test_bgemm$(EXE) > BBLAT3.SUMM
-	@$(GREP) -q FATAL BBLAT3.SUMM && cat BBLAT3.SUMM || exit 0
+	$(call CHECK_TEST_SUMMARY,BBLAT3.SUMM)
 endif
 ifeq ($(BUILD_HFLOAT16),1)
 	OMP_NUM_THREADS=2 ./test_shgemm > SHBLAT3.SUMM
-	@$(GREP) -q FATAL SHBLAT3.SUMM && cat SHBLAT3.SUMM || exit 0
+	$(call CHECK_TEST_SUMMARY,SHBLAT3.SUMM)
 endif
 
 ifeq ($(BUILD_SINGLE),1)
 	OMP_NUM_THREADS=2 ./sblat3$(EXE) < ./sblat3.dat
-	@$(GREP) -q FATAL SBLAT3.SUMM && cat SBLAT3.SUMM || exit 0
+	$(call CHECK_TEST_SUMMARY,SBLAT3.SUMM)
 endif
 ifeq ($(BUILD_DOUBLE),1)
 	OMP_NUM_THREADS=2 ./dblat3$(EXE) < ./dblat3.dat
-	@$(GREP) -q FATAL DBLAT3.SUMM && cat DBLAT3.SUMM || exit 0
+	$(call CHECK_TEST_SUMMARY,DBLAT3.SUMM)
 endif
 ifeq ($(BUILD_COMPLEX),1)
 	OMP_NUM_THREADS=2 ./cblat3$(EXE) < ./cblat3.dat
-	@$(GREP) -q FATAL CBLAT3.SUMM && cat CBLAT3.SUMM || exit 0
+	$(call CHECK_TEST_SUMMARY,CBLAT3.SUMM)
 endif
 ifeq ($(BUILD_COMPLEX16),1)
 	OMP_NUM_THREADS=2 ./zblat3$(EXE) < ./zblat3.dat
-	@$(GREP) -q FATAL ZBLAT3.SUMM && cat ZBLAT3.SUMM || exit 0
+	$(call CHECK_TEST_SUMMARY,ZBLAT3.SUMM)
 endif
 else
 ifeq ($(BUILD_BFLOAT16),1)
 	OPENBLAS_NUM_THREADS=2 ./test_sbgemm$(EXE) > SBBLAT3.SUMM
-	@$(GREP) -q FATAL SBBLAT3.SUMM && cat SBBLAT3.SUMM || exit 0
+	$(call CHECK_TEST_SUMMARY,SBBLAT3.SUMM)
 	OPENBLAS_NUM_THREADS=2 ./test_bgemm$(EXE) > BBLAT3.SUMM
-	@$(GREP) -q FATAL BBLAT3.SUMM && cat BBLAT3.SUMM || exit 0
+	$(call CHECK_TEST_SUMMARY,BBLAT3.SUMM)
 endif
 ifeq ($(BUILD_HFLOAT16),1)
 	OPENBLAS_NUM_THREADS=2 ./test_shgemm > SHBLAT3.SUMM
-	@$(GREP) -q FATAL SHBLAT3.SUMM && cat SHBLAT3.SUMM || exit 0
+	$(call CHECK_TEST_SUMMARY,SHBLAT3.SUMM)
 endif
 ifeq ($(BUILD_SINGLE),1)
 	OPENBLAS_NUM_THREADS=2 ./sblat3$(EXE) < ./sblat3.dat
-	@$(GREP) -q FATAL SBLAT3.SUMM && cat SBLAT3.SUMM || exit 0
+	$(call CHECK_TEST_SUMMARY,SBLAT3.SUMM)
 endif
 ifeq ($(BUILD_DOUBLE),1)
 	OPENBLAS_NUM_THREADS=2 ./dblat3$(EXE) < ./dblat3.dat
-	@$(GREP) -q FATAL DBLAT3.SUMM && cat DBLAT3.SUMM || exit 0
+	$(call CHECK_TEST_SUMMARY,DBLAT3.SUMM)
 endif
 ifeq ($(BUILD_COMPLEX),1)
 	OPENBLAS_NUM_THREADS=2 ./cblat3$(EXE) < ./cblat3.dat
-	@$(GREP) -q FATAL CBLAT3.SUMM && cat CBLAT3.SUMM || exit 0
+	$(call CHECK_TEST_SUMMARY,CBLAT3.SUMM)
 endif
 ifeq ($(BUILD_COMPLEX16),1)
 	OPENBLAS_NUM_THREADS=2 ./zblat3$(EXE) < ./zblat3.dat
-	@$(GREP) -q FATAL ZBLAT3.SUMM && cat ZBLAT3.SUMM || exit 0
+	$(call CHECK_TEST_SUMMARY,ZBLAT3.SUMM)
 endif
 endif
 endif
@@ -364,31 +374,31 @@ ifneq ($(CROSS), 1)
 	rm -f ?BLAT3_3M.SUMM
 ifeq ($(BUILD_COMPLEX),1)
 	OPENBLAS_NUM_THREADS=1 OMP_NUM_THREADS=1 ./cblat3_3m$(EXE) < ./cblat3_3m.dat
-	@$(GREP) -q FATAL CBLAT3_3M.SUMM && cat CBLAT3_3M.SUMM || exit 0
+	$(call CHECK_TEST_SUMMARY,CBLAT3_3M.SUMM)
 endif
 ifeq ($(BUILD_COMPLEX16),1)
 	OPENBLAS_NUM_THREADS=1 OMP_NUM_THREADS=1 ./zblat3_3m$(EXE) < ./zblat3_3m.dat
-	@$(GREP) -q FATAL ZBLAT3_3M.SUMM && cat ZBLAT3_3M.SUMM || exit 0
+	$(call CHECK_TEST_SUMMARY,ZBLAT3_3M.SUMM)
 endif
 ifdef SMP
 	rm -f ?BLAT3_3M.SUMM
 ifeq ($(USE_OPENMP), 1)
 ifeq ($(BUILD_COMPLEX),1)
 	OMP_NUM_THREADS=2 ./cblat3_3m$(EXE) < ./cblat3_3m.dat
-	@$(GREP) -q FATAL CBLAT3_3M.SUMM && cat CBLAT3_3M.SUMM || exit 0
+	$(call CHECK_TEST_SUMMARY,CBLAT3_3M.SUMM)
 endif
 ifeq ($(BUILD_COMPLEX16),1)
 	OMP_NUM_THREADS=2 ./zblat3_3m$(EXE) < ./zblat3_3m.dat
-	@$(GREP) -q FATAL ZBLAT3_3M.SUMM && cat ZBLAT3_3M.SUMM || exit 0
+	$(call CHECK_TEST_SUMMARY,ZBLAT3_3M.SUMM)
 endif
 else
 ifeq ($(BUILD_COMPLEX),1)
 	OPENBLAS_NUM_THREADS=2 ./cblat3_3m$(EXE) < ./cblat3_3m.dat
-	@$(GREP) -q FATAL CBLAT3_3M.SUMM && cat CBLAT3_3M.SUMM || exit 0
+	$(call CHECK_TEST_SUMMARY,CBLAT3_3M.SUMM)
 endif
 ifeq ($(BUILD_COMPLEX16),1)
 	OPENBLAS_NUM_THREADS=2 ./zblat3_3m$(EXE) < ./zblat3_3m.dat
-	@$(GREP) -q FATAL ZBLAT3_3M.SUMM && cat ZBLAT3_3M.SUMM || exit 0
+	$(call CHECK_TEST_SUMMARY,ZBLAT3_3M.SUMM)
 endif
 endif
 endif
@@ -420,26 +430,29 @@ endif
 endif
 endif
 
+$(XERBLA_TEST): xerbla_test.c
+	$(CC) $(CFLAGS) -c $< -o $@
+
 ifeq ($(BUILD_SINGLE),1)
 sblat1$(EXE) : sblat1.$(SUFFIX) ../$(LIBNAME)
 	$(FC) $(FLDFLAGS) -o $@ sblat1.$(SUFFIX) ../$(LIBNAME) $(EXTRALIB) $(CEXTRALIB)
 
-sblat2$(EXE) : sblat2.$(SUFFIX) ../$(LIBNAME)
-	$(FC) $(FLDFLAGS) -o $@ sblat2.$(SUFFIX) ../$(LIBNAME) $(EXTRALIB) $(CEXTRALIB)
+sblat2$(EXE) : sblat2.$(SUFFIX) $(XERBLA_TEST) ../$(LIBNAME)
+	$(FC) $(FLDFLAGS) -o $@ sblat2.$(SUFFIX) $(XERBLA_TEST) ../$(LIBNAME) $(EXTRALIB) $(CEXTRALIB)
 
-sblat3$(EXE) : sblat3.$(SUFFIX) ../$(LIBNAME)
-	$(FC) $(FLDFLAGS) -o $@ sblat3.$(SUFFIX) ../$(LIBNAME) $(EXTRALIB) $(CEXTRALIB)
+sblat3$(EXE) : sblat3.$(SUFFIX) $(XERBLA_TEST) ../$(LIBNAME)
+	$(FC) $(FLDFLAGS) -o $@ sblat3.$(SUFFIX) $(XERBLA_TEST) ../$(LIBNAME) $(EXTRALIB) $(CEXTRALIB)
 endif
 
 ifeq ($(BUILD_DOUBLE),1)
 dblat1$(EXE) : dblat1.$(SUFFIX) ../$(LIBNAME)
 	$(FC) $(FLDFLAGS) -o $@ dblat1.$(SUFFIX) ../$(LIBNAME) $(EXTRALIB) $(CEXTRALIB)
 
-dblat2$(EXE) : dblat2.$(SUFFIX) ../$(LIBNAME)
-	$(FC) $(FLDFLAGS) -o $@ dblat2.$(SUFFIX) ../$(LIBNAME) $(EXTRALIB) $(CEXTRALIB)
+dblat2$(EXE) : dblat2.$(SUFFIX) $(XERBLA_TEST) ../$(LIBNAME)
+	$(FC) $(FLDFLAGS) -o $@ dblat2.$(SUFFIX) $(XERBLA_TEST) ../$(LIBNAME) $(EXTRALIB) $(CEXTRALIB)
 
-dblat3$(EXE) : dblat3.$(SUFFIX) ../$(LIBNAME)
-	$(FC) $(FLDFLAGS) -o $@ dblat3.$(SUFFIX) ../$(LIBNAME) $(EXTRALIB) $(CEXTRALIB)
+dblat3$(EXE) : dblat3.$(SUFFIX) $(XERBLA_TEST) ../$(LIBNAME)
+	$(FC) $(FLDFLAGS) -o $@ dblat3.$(SUFFIX) $(XERBLA_TEST) ../$(LIBNAME) $(EXTRALIB) $(CEXTRALIB)
 else
 dblat2$(EXE):
 dblat3$(EXE):
@@ -453,22 +466,22 @@ ifeq ($(BUILD_COMPLEX),1)
 cblat1$(EXE) : cblat1.$(SUFFIX) ../$(LIBNAME)
 	$(FC) $(FLDFLAGS) -o $@ cblat1.$(SUFFIX) ../$(LIBNAME) $(EXTRALIB) $(CEXTRALIB)
 
-cblat2$(EXE) : cblat2.$(SUFFIX) ../$(LIBNAME)
-	$(FC) $(FLDFLAGS) -o $@ cblat2.$(SUFFIX) ../$(LIBNAME) $(EXTRALIB) $(CEXTRALIB)
+cblat2$(EXE) : cblat2.$(SUFFIX) $(XERBLA_TEST) ../$(LIBNAME)
+	$(FC) $(FLDFLAGS) -o $@ cblat2.$(SUFFIX) $(XERBLA_TEST) ../$(LIBNAME) $(EXTRALIB) $(CEXTRALIB)
 
-cblat3$(EXE) : cblat3.$(SUFFIX) ../$(LIBNAME)
-	$(FC) $(FLDFLAGS) -o $@ cblat3.$(SUFFIX) ../$(LIBNAME) $(EXTRALIB) $(CEXTRALIB)
+cblat3$(EXE) : cblat3.$(SUFFIX) $(XERBLA_TEST) ../$(LIBNAME)
+	$(FC) $(FLDFLAGS) -o $@ cblat3.$(SUFFIX) $(XERBLA_TEST) ../$(LIBNAME) $(EXTRALIB) $(CEXTRALIB)
 endif
 
 ifeq ($(BUILD_COMPLEX16),1)
 zblat1$(EXE) : zblat1.$(SUFFIX) ../$(LIBNAME)
 	$(FC) $(FLDFLAGS) -o $@ zblat1.$(SUFFIX) ../$(LIBNAME) $(EXTRALIB) $(CEXTRALIB)
 
-zblat2$(EXE) : zblat2.$(SUFFIX) ../$(LIBNAME)
-	$(FC) $(FLDFLAGS) -o $@ zblat2.$(SUFFIX) ../$(LIBNAME) $(EXTRALIB) $(CEXTRALIB)
+zblat2$(EXE) : zblat2.$(SUFFIX) $(XERBLA_TEST) ../$(LIBNAME)
+	$(FC) $(FLDFLAGS) -o $@ zblat2.$(SUFFIX) $(XERBLA_TEST) ../$(LIBNAME) $(EXTRALIB) $(CEXTRALIB)
 
-zblat3$(EXE) : zblat3.$(SUFFIX) ../$(LIBNAME)
-	$(FC) $(FLDFLAGS) -o $@ zblat3.$(SUFFIX) ../$(LIBNAME) $(EXTRALIB) $(CEXTRALIB)
+zblat3$(EXE) : zblat3.$(SUFFIX) $(XERBLA_TEST) ../$(LIBNAME)
+	$(FC) $(FLDFLAGS) -o $@ zblat3.$(SUFFIX) $(XERBLA_TEST) ../$(LIBNAME) $(EXTRALIB) $(CEXTRALIB)
 endif
 
 ifeq ($(BUILD_BFLOAT16),1)
@@ -495,13 +508,13 @@ endif
 
 
 ifeq ($(BUILD_COMPLEX),1)
-cblat3_3m$(EXE) : cblat3_3m.$(SUFFIX) ../$(LIBNAME)
-	$(FC) $(FLDFLAGS) -o $@ cblat3_3m.$(SUFFIX) ../$(LIBNAME) $(EXTRALIB) $(CEXTRALIB)
+cblat3_3m$(EXE) : cblat3_3m.$(SUFFIX) $(XERBLA_TEST) ../$(LIBNAME)
+	$(FC) $(FLDFLAGS) -o $@ cblat3_3m.$(SUFFIX) $(XERBLA_TEST) ../$(LIBNAME) $(EXTRALIB) $(CEXTRALIB)
 endif
 
 ifeq ($(BUILD_COMPLEX16),1)
-zblat3_3m$(EXE) : zblat3_3m.$(SUFFIX) ../$(LIBNAME)
-	$(FC) $(FLDFLAGS) -o $@ zblat3_3m.$(SUFFIX) ../$(LIBNAME) $(EXTRALIB) $(CEXTRALIB)
+zblat3_3m$(EXE) : zblat3_3m.$(SUFFIX) $(XERBLA_TEST) ../$(LIBNAME)
+	$(FC) $(FLDFLAGS) -o $@ zblat3_3m.$(SUFFIX) $(XERBLA_TEST) ../$(LIBNAME) $(EXTRALIB) $(CEXTRALIB)
 endif
 
 

test/cblat2.f

@@ -2401,6 +2401,7 @@
 *     .. Common blocks ..
       COMMON             /INFOC/INFOT, NOUTC, OK, LERR
 *     .. Executable Statements ..
+      CALL OPENBLAS_TEST_SET_XERBLA
 *     OK is set to .FALSE. by the special version of XERBLA or by CHKXER
 *     if anything is wrong.
       OK = .TRUE.

test/cblat3.f

@@ -2019,6 +2019,7 @@
 *     .. Common blocks ..
       COMMON             /INFOC/INFOT, NOUTC, OK, LERR
 *     .. Executable Statements ..
+      CALL OPENBLAS_TEST_SET_XERBLA
 *     OK is set to .FALSE. by the special version of XERBLA or by CHKXER
 *     if anything is wrong.
       OK = .TRUE.

test/cblat3_3m.f

@@ -1976,6 +1976,7 @@
 *     .. Common blocks ..
       COMMON             /INFOC/INFOT, NOUTC, OK, LERR
 *     .. Executable Statements ..
+      CALL OPENBLAS_TEST_SET_XERBLA
 *     OK is set to .FALSE. by the special version of XERBLA or by CHKXER
 *     if anything is wrong.
       OK = .TRUE.

test/dblat2.f

@@ -2351,6 +2351,7 @@
 *     .. Common blocks ..
       COMMON             /INFOC/INFOT, NOUTC, OK, LERR
 *     .. Executable Statements ..
+      CALL OPENBLAS_TEST_SET_XERBLA
 *     OK is set to .FALSE. by the special version of XERBLA or by CHKXER
 *     if anything is wrong.
       OK = .TRUE.

test/dblat3.f

@@ -1873,6 +1873,7 @@
 *     .. Common blocks ..
       COMMON             /INFOC/INFOT, NOUTC, OK, LERR
 *     .. Executable Statements ..
+      CALL OPENBLAS_TEST_SET_XERBLA
 *     OK is set to .FALSE. by the special version of XERBLA or by CHKXER
 *     if anything is wrong.
       OK = .TRUE.

test/sblat2.f

@@ -2351,6 +2351,7 @@
 *     .. Common blocks ..
       COMMON             /INFOC/INFOT, NOUTC, OK, LERR
 *     .. Executable Statements ..
+      CALL OPENBLAS_TEST_SET_XERBLA
 *     OK is set to .FALSE. by the special version of XERBLA or by CHKXER
 *     if anything is wrong.
       OK = .TRUE.

test/sblat3.f

@@ -1873,6 +1873,7 @@
 *     .. Common blocks ..
       COMMON             /INFOC/INFOT, NOUTC, OK, LERR
 *     .. Executable Statements ..
+      CALL OPENBLAS_TEST_SET_XERBLA
 *     OK is set to .FALSE. by the special version of XERBLA or by CHKXER
 *     if anything is wrong.
       OK = .TRUE.

test/xerbla_test.c

@@ -0,0 +1,51 @@
+/***************************************************************************
+Copyright (c) 2026, 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"
+
+#ifdef OPENBLAS_TEST_USE_XERBLA_HANDLER
+static void openblas_test_xerbla(const char *name, const blasint *info,
+                                 size_t name_length) {
+  blasint fortran_length = (blasint)name_length;
+  blasint fortran_info;
+
+  if (name == NULL || info == NULL || fortran_length < 0 ||
+      (size_t)fortran_length != name_length)
+    return;
+
+  fortran_info = *info;
+  BLASFUNC(xerbla)((char *)name, &fortran_info, fortran_length);
+}
+#endif
+
+void BLASFUNC(openblas_test_set_xerbla)(void) {
+#ifdef OPENBLAS_TEST_USE_XERBLA_HANDLER
+  openblas_set_xerbla(openblas_test_xerbla);
+#endif
+}

test/zblat2.f

@@ -2408,6 +2408,7 @@
 *     .. Common blocks ..
       COMMON             /INFOC/INFOT, NOUTC, OK, LERR
 *     .. Executable Statements ..
+      CALL OPENBLAS_TEST_SET_XERBLA
 *     OK is set to .FALSE. by the special version of XERBLA or by CHKXER
 *     if anything is wrong.
       OK = .TRUE.

test/zblat3.f

@@ -2026,6 +2026,7 @@
 *     .. Common blocks ..
       COMMON             /INFOC/INFOT, NOUTC, OK, LERR
 *     .. Executable Statements ..
+      CALL OPENBLAS_TEST_SET_XERBLA
 *     OK is set to .FALSE. by the special version of XERBLA or by CHKXER
 *     if anything is wrong.
       OK = .TRUE.

test/zblat3_3m.f

@@ -1979,6 +1979,7 @@
 *     .. Common blocks ..
       COMMON             /INFOC/INFOT, NOUTC, OK, LERR
 *     .. Executable Statements ..
+      CALL OPENBLAS_TEST_SET_XERBLA
 *     OK is set to .FALSE. by the special version of XERBLA or by CHKXER
 *     if anything is wrong.
       OK = .TRUE.

utest/test_dsdot.c

@@ -48,3 +48,29 @@ CTEST(dsdot,dsdot_n_1)
 
 }
 #endif
+#ifdef ARMV8
+#if defined(BUILD_SINGLE)
+CTEST(sdot,sdot_n_1)
+{
+    static float x[64], y[64];
+    for (int i = 0; i < 64; i++) { x[i] = 1.0f; y[i] = 1.0f; }
+    blasint n = 64, inc = 1;
+    float junk[4] = {1e6f, 1e6f, 1e6f, 1e6f};
+    __asm__ volatile("ld1 {v0.4s}, [%0]" :: "r"(junk) : "v0");
+    float r = BLASFUNC(sdot)(&n, x, &inc, y, &inc);
+    ASSERT_DBL_NEAR_TOL(64.,r, DOUBLE_EPS);
+}
+#endif
+#if defined(BUILD_DOUBLE)
+CTEST(ddot,ddot_n_1)
+{
+    static double x[64], y[64];
+    for (int i = 0; i < 64; i++) { x[i] = 1.0f; y[i] = 1.0f; }
+    blasint n = 64, inc = 1;
+    double junk[4] = {1e6f, 1e6f, 1e6f, 1e6f};
+    __asm__ volatile("ld1 {v0.4s}, [%0]" :: "r"(junk) : "v0");
+    double r = BLASFUNC(ddot)(&n, x, &inc, y, &inc);
+    ASSERT_DBL_NEAR_TOL(64.,r, DOUBLE_EPS);
+}
+#endif
+#endif

utest/test_extensions/common.h

@@ -45,7 +45,6 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
 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);

utest/test_extensions/test_cgeadd.c

@@ -57,21 +57,27 @@ static struct DATA_CGEADD data_cgeadd;
  * param beta - scaling factor for matrix C
  * param cptr - refer to matrix C
  * param ldc - leading dimension of C
+ * param transa - Traspose of A
+ * param transc - Transpose of C
  */
 static void cgeadd_trusted(blasint m, blasint n, float *alpha, float *aptr,
-                           blasint lda, float *beta, float *cptr, blasint ldc)
+                           blasint lda, float *beta, float *cptr, blasint ldc,
+                            OPENBLAS_CONST enum CBLAS_TRANSPOSE transa, 
+                           OPENBLAS_CONST enum CBLAS_TRANSPOSE transc)
 {
     blasint i;
-    blasint one=1;
+     blasint inc_a = (transa == CblasTrans) ? lda : 1;
+    blasint inc_c = (transc == CblasTrans) ? ldc : 1;
 
-    lda *= 2; 
-	ldc *= 2;
+ 
+    blasint step_a = (transa == CblasTrans) ? 1 : lda;
+    blasint step_c = (transc == CblasTrans) ? 1 : ldc;
 
     for (i = 0; i < n; i++)
     {
-        BLASFUNC(caxpby)(&m, alpha, aptr, &one, beta, cptr, &one);
-        aptr += lda;
-        cptr += ldc;
+        BLASFUNC(caxpby)(&m, alpha, aptr, &inc_a, beta, cptr, &inc_c);
+         aptr += step_a*2;
+        cptr += step_c*2;
     }
 }
 
@@ -91,6 +97,8 @@ static void cgeadd_trusted(blasint m, blasint n, float *alpha, float *aptr,
  * return norm of differences
  */
 static float check_cgeadd(char api, OPENBLAS_CONST enum CBLAS_ORDER order,
+                         OPENBLAS_CONST enum CBLAS_TRANSPOSE transa, 
+                        OPENBLAS_CONST enum CBLAS_TRANSPOSE transc,
                           blasint m, blasint n, float *alpha, blasint lda,
                           float *beta, blasint ldc)
 {
@@ -112,14 +120,19 @@ static float check_cgeadd(char api, OPENBLAS_CONST enum CBLAS_ORDER order,
         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);
+                   beta, data_cgeadd.c_verify, ldc,transa, transc);
 
-    if (api == 'F')
+    if (api == 'F'){
+
+              char transa_f = (transa == CblasTrans) ? 'T' : 'N';
+        char transc_f = (transc == CblasTrans) ? 'T' : 'N';
         BLASFUNC(cgeadd)(&m, &n, alpha, data_cgeadd.a_test, &lda,
-                         beta, data_cgeadd.c_test, &ldc);
+                         beta, data_cgeadd.c_test, &ldc,&transa_f, &transc_f);
+
+    }
 #ifndef NO_CBLAS
     else
-        cblas_cgeadd(order, m, n, alpha, data_cgeadd.a_test, lda,
+        cblas_cgeadd(order,transa,transc, m, n, alpha, data_cgeadd.a_test, lda,
                      beta, data_cgeadd.c_test, ldc);
 #endif
 
@@ -142,6 +155,8 @@ static float check_cgeadd(char api, OPENBLAS_CONST enum CBLAS_ORDER order,
  * return TRUE if everything is ok, otherwise FALSE
  */
 static int check_badargs(char api, OPENBLAS_CONST enum CBLAS_ORDER order,
+                         OPENBLAS_CONST enum CBLAS_TRANSPOSE transa,
+                            OPENBLAS_CONST enum CBLAS_TRANSPOSE transc,
                          blasint m, blasint n, blasint lda,
                          blasint ldc, int expected_info)
 {
@@ -150,12 +165,17 @@ static int check_badargs(char api, OPENBLAS_CONST enum CBLAS_ORDER order,
 
     set_xerbla("CGEADD ", expected_info);
 
-    if (api == 'F')
+    if (api == 'F'){
+                   char transa_f = (transa == CblasTrans) ? 'T' : 'N';
+    char transc_f = (transc == CblasTrans) ? 'T' : 'N';
         BLASFUNC(cgeadd)(&m, &n, alpha, data_cgeadd.a_test, &lda,
-                         beta, data_cgeadd.c_test, &ldc);
+                         beta, data_cgeadd.c_test, &ldc,&transa_f, &transc_f);
+
+    }
+
 #ifndef NO_CBLAS
     else 
-        cblas_cgeadd(order, m, n, alpha, data_cgeadd.a_test, lda,
+        cblas_cgeadd(order,transa, transc, m, n, alpha, data_cgeadd.a_test, lda,
                  beta, data_cgeadd.c_test, ldc);
 #endif
 
@@ -183,7 +203,7 @@ CTEST(cgeadd, matrix_n_100_m_100)
     float alpha[] = {3.0f, 2.0f};
     float beta[] = {1.0f, 3.0f};
 
-    float norm = check_cgeadd('F', order, m, n, alpha, lda, beta, ldc);
+    float norm = check_cgeadd('F', order,CblasNoTrans, CblasNoTrans,m, n, alpha, lda, beta, ldc);
 
     ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS);
 }
@@ -210,7 +230,7 @@ CTEST(cgeadd, matrix_n_100_m_100_alpha_zero)
     float alpha[] = {0.0f, 0.0f};
     float beta[] = {2.5f, 1.0f};
 
-    float norm = check_cgeadd('F', order, m, n, alpha, lda, beta, ldc);
+    float norm = check_cgeadd('F', order,CblasNoTrans, CblasNoTrans,  m, n, alpha, lda, beta, ldc);
 
     ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS);
 }
@@ -237,7 +257,7 @@ CTEST(cgeadd, matrix_n_100_m_100_beta_zero)
     float alpha[] = {3.0f, 1.5f};
     float beta[] = {0.0f, 0.0f};
 
-    float norm = check_cgeadd('F', order, m, n, alpha, lda, beta, ldc);
+    float norm = check_cgeadd('F', order,CblasNoTrans, CblasNoTrans,  m, n, alpha, lda, beta, ldc);
 
     ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS);
 }
@@ -264,7 +284,7 @@ CTEST(cgeadd, matrix_n_100_m_100_alpha_beta_zero)
     float alpha[] = {0.0f, 0.0f};
     float beta[] = {0.0f, 0.0f};
 
-    float norm = check_cgeadd('F', order, m, n, alpha, lda, beta, ldc);
+    float norm = check_cgeadd('F', order,CblasNoTrans, CblasNoTrans,  m, n, alpha, lda, beta, ldc);
 
     ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS);
 }
@@ -290,7 +310,7 @@ CTEST(cgeadd, matrix_n_100_m_50)
     float alpha[] = {1.0f, 1.0f};
     float beta[] = {1.0f, 1.0f};
 
-    float norm = check_cgeadd('F', order, m, n, alpha, lda, beta, ldc);
+    float norm = check_cgeadd('F', order,CblasNoTrans, CblasNoTrans,  m, n, alpha, lda, beta, ldc);
 
     ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS);
 }
@@ -313,7 +333,7 @@ CTEST(cgeadd, xerbla_n_invalid)
 
     int expected_info = 2;
 
-    int passed = check_badargs('F', order, m, n, lda, ldc, expected_info);
+    int passed = check_badargs('F', order,CblasNoTrans, CblasNoTrans,  m, n, lda, ldc, expected_info);
     ASSERT_EQUAL(TRUE, passed);
 }
 
@@ -335,7 +355,7 @@ CTEST(cgeadd, xerbla_m_invalid)
 
     int expected_info = 1;
 
-    int passed = check_badargs('F', order, m, n, lda, ldc, expected_info);
+    int passed = check_badargs('F', order,CblasNoTrans, CblasNoTrans,  m, n, lda, ldc, expected_info);
     ASSERT_EQUAL(TRUE, passed);
 }
 
@@ -356,7 +376,7 @@ CTEST(cgeadd, xerbla_lda_invalid)
 
     int expected_info = 5;
 
-    int passed = check_badargs('F', order, m, n, lda, ldc, expected_info);
+    int passed = check_badargs('F', order,CblasNoTrans, CblasNoTrans,  m, n, lda, ldc, expected_info);
     ASSERT_EQUAL(TRUE, passed);
 }
 
@@ -377,7 +397,7 @@ CTEST(cgeadd, xerbla_ldc_invalid)
 
     int expected_info = 8;
 
-    int passed = check_badargs('F', order, m, n, lda, ldc, expected_info);
+    int passed = check_badargs('F', order,CblasNoTrans, CblasNoTrans,  m, n, lda, ldc, expected_info);
     ASSERT_EQUAL(TRUE, passed);
 }
 
@@ -398,7 +418,7 @@ CTEST(cgeadd, n_zero)
     float alpha[] = {1.0f, 1.0f};
     float beta[] = {1.0f, 1.0f};
 
-    float norm = check_cgeadd('F', order, m, n, alpha, lda, beta, ldc);
+    float norm = check_cgeadd('F', order,CblasNoTrans, CblasNoTrans,  m, n, alpha, lda, beta, ldc);
 
     ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS);
 }
@@ -420,7 +440,7 @@ CTEST(cgeadd, m_zero)
     float alpha[] = {1.0f, 1.0f};
     float beta[] = {1.0f, 1.0f};
 
-    float norm = check_cgeadd('F', order, m, n, alpha, lda, beta, ldc);
+    float norm = check_cgeadd('F', order,CblasNoTrans, CblasNoTrans,  m, n, alpha, lda, beta, ldc);
 
     ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS);
 }
@@ -447,7 +467,7 @@ CTEST(cgeadd, c_api_matrix_n_100_m_100)
     float alpha[] = {2.0f, 1.0f};
     float beta[] = {1.0f, 3.0f};
 
-    float norm = check_cgeadd('C', order, m, n, alpha,
+    float norm = check_cgeadd('C', order,CblasNoTrans, CblasNoTrans,  m, n, alpha,
                                     lda, beta, ldc);
 
     ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS);
@@ -475,7 +495,7 @@ CTEST(cgeadd, c_api_matrix_n_100_m_100_row_major)
     float alpha[] = {4.0f, 1.5f};
     float beta[] = {2.0f, 1.0f};
 
-    float norm = check_cgeadd('C', order, m, n, alpha,
+    float norm = check_cgeadd('C', order,CblasNoTrans, CblasNoTrans,  m, n, alpha,
                                     lda, beta, ldc);
 
     ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS);
@@ -503,7 +523,7 @@ CTEST(cgeadd, c_api_matrix_n_50_m_100_row_major)
     float alpha[] = {3.0f, 2.5f};
     float beta[] = {1.0f, 2.0f};
 
-    float norm = check_cgeadd('C', order, m, n, alpha,
+    float norm = check_cgeadd('C', order,CblasNoTrans, CblasNoTrans,  m, n, alpha,
                                     lda, beta, ldc);
 
     ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS);
@@ -532,7 +552,7 @@ CTEST(cgeadd, c_api_matrix_n_100_m_100_alpha_zero)
     float alpha[] = {0.0f, 0.0f};
     float beta[] = {1.0f, 1.0f};
 
-    float norm = check_cgeadd('C', order, m, n, alpha,
+    float norm = check_cgeadd('C', order,CblasNoTrans, CblasNoTrans,  m, n, alpha,
                                     lda, beta, ldc);
 
     ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS);
@@ -561,7 +581,7 @@ CTEST(cgeadd, c_api_matrix_n_100_m_100_beta_zero)
     float alpha[] = {3.0f, 1.5f};
     float beta[] = {0.0f, 0.0f};
 
-    float norm = check_cgeadd('C', order, m, n, alpha,
+    float norm = check_cgeadd('C', order,CblasNoTrans, CblasNoTrans,  m, n, alpha,
                                     lda, beta, ldc);
 
     ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS);
@@ -590,7 +610,7 @@ CTEST(cgeadd, c_api_matrix_n_100_m_100_alpha_beta_zero)
     float alpha[] = {0.0f, 0.0f};
     float beta[] = {0.0f, 0.0f};
 
-    float norm = check_cgeadd('C', order, m, n, alpha,
+    float norm = check_cgeadd('C', order,CblasNoTrans, CblasNoTrans,  m, n, alpha,
                                     lda, beta, ldc);
 
     ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS);
@@ -617,7 +637,7 @@ CTEST(cgeadd, c_api_matrix_n_100_m_50)
     float alpha[] = {2.0f, 3.0f};
     float beta[] = {2.0f, 4.0f};
 
-    float norm = check_cgeadd('C', order, m, n, alpha,
+    float norm = check_cgeadd('C', order,CblasNoTrans, CblasNoTrans,  m, n, alpha,
                                     lda, beta, ldc);
 
     ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS);
@@ -641,7 +661,7 @@ CTEST(cgeadd, c_api_xerbla_invalid_order)
 
     int expected_info = 0;
 
-    int passed = check_badargs('C', order, m, n, lda, ldc, expected_info);
+    int passed = check_badargs('C', order,CblasNoTrans, CblasNoTrans,  m, n, lda, ldc, expected_info);
     ASSERT_EQUAL(TRUE, passed);
 }
 
@@ -665,7 +685,7 @@ CTEST(cgeadd, c_api_xerbla_n_invalid)
 
     int expected_info = 2;
 
-    int passed = check_badargs('C', order, m, n, lda, ldc, expected_info);
+    int passed = check_badargs('C', order,CblasNoTrans, CblasNoTrans,  m, n, lda, ldc, expected_info);
     ASSERT_EQUAL(TRUE, passed);
 }
 
@@ -689,7 +709,7 @@ CTEST(cgeadd, c_api_xerbla_n_invalid_row_major)
 
     int expected_info = 2;
 
-    int passed = check_badargs('C', order, m, n, lda, ldc, expected_info);
+    int passed = check_badargs('C', order,CblasNoTrans, CblasNoTrans,  m, n, lda, ldc, expected_info);
     ASSERT_EQUAL(TRUE, passed);
 }
 
@@ -713,7 +733,7 @@ CTEST(cgeadd, c_api_xerbla_m_invalid)
 
     int expected_info = 1;
 
-    int passed = check_badargs('C', order, m, n, lda, ldc, expected_info);
+    int passed = check_badargs('C', order,CblasNoTrans, CblasNoTrans,  m, n, lda, ldc, expected_info);
     ASSERT_EQUAL(TRUE, passed);
 }
 
@@ -737,7 +757,7 @@ CTEST(cgeadd, c_api_xerbla_m_invalid_row_major)
 
     int expected_info = 1;
 
-    int passed = check_badargs('C', order, m, n, lda, ldc, expected_info);
+    int passed = check_badargs('C', order,CblasNoTrans, CblasNoTrans,  m, n, lda, ldc, expected_info);
     ASSERT_EQUAL(TRUE, passed);
 }
 
@@ -760,7 +780,7 @@ CTEST(cgeadd, c_api_xerbla_lda_invalid)
 
     int expected_info = 5;
 
-    int passed = check_badargs('C', order, m, n, lda, ldc, expected_info);
+    int passed = check_badargs('C', order,CblasNoTrans, CblasNoTrans,  m, n, lda, ldc, expected_info);
     ASSERT_EQUAL(TRUE, passed);
 }
 
@@ -783,7 +803,7 @@ CTEST(cgeadd, c_api_xerbla_lda_invalid_row_major)
 
     int expected_info = 5;
 
-    int passed = check_badargs('C', order, m, n, lda, ldc, expected_info);
+    int passed = check_badargs('C', order,CblasNoTrans, CblasNoTrans,  m, n, lda, ldc, expected_info);
     ASSERT_EQUAL(TRUE, passed);
 }
 
@@ -806,7 +826,7 @@ CTEST(cgeadd, c_api_xerbla_ldc_invalid)
 
     int expected_info = 8;
 
-    int passed = check_badargs('C', order, m, n, lda, ldc, expected_info);
+    int passed = check_badargs('C', order,CblasNoTrans, CblasNoTrans,  m, n, lda, ldc, expected_info);
     ASSERT_EQUAL(TRUE, passed);
 }
 
@@ -829,7 +849,7 @@ CTEST(cgeadd, c_api_xerbla_ldc_invalid_row_major)
 
     int expected_info = 8;
 
-    int passed = check_badargs('C', order, m, n, lda, ldc, expected_info);
+    int passed = check_badargs('C', order,CblasNoTrans, CblasNoTrans,  m, n, lda, ldc, expected_info);
     ASSERT_EQUAL(TRUE, passed);
 }
 
@@ -852,7 +872,7 @@ CTEST(cgeadd, c_api_n_zero)
     float alpha[] = {1.0f, 1.0f};
     float beta[] = {1.0f, 1.0f};
 
-    float norm = check_cgeadd('C', order, m, n, alpha,
+    float norm = check_cgeadd('C', order,CblasNoTrans, CblasNoTrans,  m, n, alpha,
                                     lda, beta, ldc);
 
     ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS);
@@ -877,10 +897,83 @@ CTEST(cgeadd, c_api_m_zero)
     float alpha[] = {1.0f, 1.0f};
     float beta[] = {1.0f, 1.0f};
 
-    float norm = check_cgeadd('C', order, m, n, alpha,
+    float norm = check_cgeadd('C', order,CblasNoTrans, CblasNoTrans,  m, n, alpha,
                                     lda, beta, ldc);
 
     ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS);
 }
+
+
+CTEST(cgeadd, c_api_matrix_2x2_transA) {
+  blasint m = 2;
+  blasint n = 2;
+  blasint lda = 2;
+  blasint ldc = 2;
+
+  float alpha[] = {1.0f, 0.0f};
+  float beta[]  = {0.0f, 0.0f};
+
+  float a_test[8] = {1.0f, 2.0f, 3.0f, 4.0f, 5.0f, 6.0f, 7.0f, 8.0f};
+
+  float c_test[8]   = {0.0f, 0.0f, 0.0f, 0.0f, 0.0f, 0.0f, 0.0f, 0.0f};
+  float c_verify[8] = {1.0f, 2.0f, 5.0f, 6.0f, 3.0f, 4.0f, 7.0f, 8.0f};
+
+  cblas_cgeadd(CblasColMajor, CblasTrans, CblasNoTrans, m, n, alpha, a_test,
+               lda, beta, c_test, ldc);
+
+  blasint i;
+  for (i = 0; i < 8; i++) {
+    ASSERT_DBL_NEAR_TOL(c_verify[i], c_test[i], SINGLE_EPS);
+  }
+}
+
+/**
+ * Custom C API specific test
+ * Test BOTH transposed (C^T = A^T) with a simple 2x2 complex float matrix
+ */
+CTEST(cgeadd, c_api_matrix_2x2_transA_transC) {
+  blasint m = 2;
+  blasint n = 2;
+  blasint lda = 2;
+  blasint ldc = 2;
+
+  float alpha[] = {1.0f, 0.0f};
+  float beta[]  = {0.0f, 0.0f};
+
+  float a_test[8] = {1.0f, 2.0f, 3.0f, 4.0f, 5.0f, 6.0f, 7.0f, 8.0f};
+
+  float c_test[8]   = {0.0f, 0.0f, 0.0f, 0.0f, 0.0f, 0.0f, 0.0f, 0.0f};
+  float c_verify[8] = {1.0f, 2.0f, 3.0f, 4.0f, 5.0f, 6.0f, 7.0f, 8.0f};
+
+  cblas_cgeadd(CblasColMajor, CblasTrans, CblasTrans, m, n, alpha, a_test, lda,
+               beta, c_test, ldc);
+
+  blasint i;
+  for (i = 0; i < 8; i++) {
+    ASSERT_DBL_NEAR_TOL(c_verify[i], c_test[i], SINGLE_EPS);
+  }
+}
+
+/**
+ * C API specific test - Transposed A (Complex Single Precision)
+ * Fuzzes your core complex float pointer math against a large 100x100 random matrix.
+ */
+CTEST(cgeadd, c_api_matrix_n_100_m_100_transA) {
+  CBLAS_ORDER order = CblasColMajor;
+
+  blasint n = N;
+  blasint m = M;
+
+  blasint lda = n; 
+  blasint ldc = m;
+
+  float alpha[] = {2.0f, -1.0f};
+  float beta[]  = {1.5f, 3.0f};
+
+  float norm = check_cgeadd('C', order, CblasTrans, CblasNoTrans, m, n, alpha,
+                             lda, beta, ldc);
+
+  ASSERT_DBL_NEAR_TOL(0.0f, norm, SINGLE_EPS);
+}
 #endif
 #endif